Added GTIN field to releases and fixed a very old bug with form validation (this fix may break existing forms, will need a lot of testing)

git-svn-id: svn://vndb.org/vndb@26 1fe2e327-d9db-4752-bcf7-ef0cb4a1748b

3 files changed, 41 insertions, 16 deletions

diff --git a/lib/VNDB/Releases.pm b/lib/VNDB/Releases.pm
index abf3a786..0e95cc5a 100644
--- a/lib/VNDB/Releases.pm
+++ b/lib/VNDB/Releases.pm
@@ -60,7 +60,7 @@ sub REdit {
   return $self->ResDenied if !$self->AuthCan('edit') || ($r->{locked} && !$self->AuthCan('lock'));
 
   my %b4 = $rid ? (
-    (map { $_ => $r->{$_} } qw|title original language website notes minage type platforms|),
+    (map { $_ => $r->{$_} } qw|title original gtin language website notes minage type platforms|),
     released => $r->{released} =~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/ ? [ $1, $2, $3 ] : [ 0, 0, 0 ],
     media => join(',', map { $_->{medium} =~ /^(cd|dvd|gdr|blr)$/ ? ($_->{medium}.'_'.$_->{qty}) : $_->{medium} } @{$r->{media}}),
     producers => join('|||', map { $_->{id}.','.$_->{name} } @{$r->{producers}}),
@@ -73,6 +73,7 @@ sub REdit {
       { name => 'type',      required => 1, enum => [ 0..$#{$VNDB::RTYP} ] },
       { name => 'title',     required => 1, maxlength => 250 },
       { name => 'original',  required => 0, maxlength => 250, default => '' },
+      { name => 'gtin',      required => 0, template => 'gtin', default => '0' },
       { name => 'language',  required => 1, enum => [ keys %{$VNDB::LANG} ] },
       { name => 'website',   required => 0, template => 'url', default => '' },
       { name => 'released',  required => 0, multi => 1, template => 'int', default => 0 },
@@ -101,12 +102,12 @@ sub REdit {
     return $self->ResRedirect('/r'.$rid, 'post')
       if $rid && $released == $r->{released} &&
         (join(',', sort @{$b4{platforms}}) eq join(',', sort @{$frm->{platforms}})) &&
-        10 == scalar grep { $_ ne 'comm' && $_ ne 'released' && $_ ne 'platforms' && $frm->{$_} eq $b4{$_} } keys %b4;
+        11 == scalar grep { $_ ne 'comm' && $_ ne 'released' && $_ ne 'platforms' && $frm->{$_} eq $b4{$_} } keys %b4;
 
     if(!$frm->{_err}) {
       my %opts = (
         vn        => $new_vn,
-        (map { $_ => $frm->{$_} } qw|title original language website notes minage type comm platforms|),
+        (map { $_ => $frm->{$_} } qw|title original gtin language website notes minage type comm platforms|),
         released  => $released,
         media     => $media,
         producers => $producers,
diff --git a/lib/VNDB/Util/DB.pm b/lib/VNDB/Util/DB.pm
index 87b7ba89..b1372a54 100644
--- a/lib/VNDB/Util/DB.pm
+++ b/lib/VNDB/Util/DB.pm
@@ -865,7 +865,7 @@ sub DBGetRelease { # %options->{ id vid results page rev }
   push @join, 'JOIN users u ON u.id = c.requester' if $o{what} =~ /changes/;
   push @join, 'JOIN releases_vn rv ON rv.rid = rr.id' if $o{vid};
 
-  my $select = 'r.id, r.locked, r.hidden, rr.id AS cid, rr.title, rr.original, rr.language, rr.website, rr.released, rr.notes, rr.minage, rr.type';
+  my $select = 'r.id, r.locked, r.hidden, rr.id AS cid, rr.title, rr.original, rr.gtin, rr.language, rr.website, rr.released, rr.notes, rr.minage, rr.type';
   $select .= ', c.added, c.requester, c.comments, r.latest, u.username, c.prev' if $o{what} =~ /changes/;
 
   my $r = $s->DBAll(qq|
@@ -981,10 +981,11 @@ sub DBEditRelease { # id, %opts->{ columns in releases_rev table + comm + vn + p
 sub _insert_release_rev {
   my($s, $cid, $rid, $o) = @_;
 
+  # most GTIN numbers can't be represented in a 32bit integer, so make sure Perl doesn't interpret it as one (%s, not %d)
   $s->DBExec(q|
-    INSERT INTO releases_rev (id, rid, title, original, language, website, released, notes, minage, type)
-      VALUES (%d, %d, !s, !s, !s, !s, %d, !s, %d, %d)|,
-    $cid, $rid, @$o{qw| title original language website released notes minage type|});
+    INSERT INTO releases_rev (id, rid, title, original, gtin, language, website, released, notes, minage, type)
+      VALUES (%d, %d, !s, !s, %s, !s, !s, %d, !s, %d, %d)|,
+    $cid, $rid, @$o{qw| title original gtin language website released notes minage type|});
 
   $s->DBExec(q|
     INSERT INTO releases_producers (rid, pid)
diff --git a/lib/VNDB/Util/Tools.pm b/lib/VNDB/Util/Tools.pm
index f338ad7c..e537d5a2 100644
--- a/lib/VNDB/Util/Tools.pm
+++ b/lib/VNDB/Util/Tools.pm
@@ -8,12 +8,10 @@ use Tie::ShareLite ':lock';
 use Exporter 'import';
 
 our $VERSION = $VNDB::VERSION;
-our @EXPORT = qw| FormCheck AddHid SendMail AddDefaultStuff RunCmd |;
+our @EXPORT = qw| FormCheck AddHid GTINType SendMail AddDefaultStuff RunCmd |;
 
 
-# Improved version of ParamsCheck
-#  - hashref instead of hash
-#  - parameters don't start with form*
+# ...this function could use some serious rewriting
 sub FormCheck {
   my $self = shift;
   my @ps = @_;
@@ -39,20 +37,21 @@ sub FormCheck {
           || ($t eq 'pname' && $$val !~ /^[a-z0-9][a-z0-9\-]*$/)
           || ($t eq 'asciiprint' && $$val !~ /^[\x20-\x7E]*$/)
           || ($t eq 'int' && $$val !~ /^\-?[0-9]+$/)
-          || ($t eq 'date' && $$val !~ /^[0-9]{4}(-[0-9]{2}(-[0-9]{2})?)?$/);
+          || ($t eq 'date' && $$val !~ /^[0-9]{4}(-[0-9]{2}(-[0-9]{2})?)?$/)
+          || ($t eq 'gtin' && !GTINType($$val));
       }
       $e = 5 if !$e && $ps[$i]{enum} && ref($ps[$i]{enum}) eq "ARRAY" && !_inarray($$val, $ps[$i]{enum});
       if($e) {
-        if($ps[$i]{required}) {
+        if(!$ps[$i]{required} && !$$val && length($$val) < 1 && $$val ne '0') {
+          $hash{$k}[$j] = exists $ps[$i]{default} ? $ps[$i]{default} : undef;
+        } else {
           my $errc = $ps[$i]{name}.'_'.$e;
           $errc .= '_'.$ps[$i]{minlength} if $e == 2;
           $errc .= '_'.$ps[$i]{maxlength} if $e == 3;
           $errc .= '_'.$ps[$i]{template} if $e == 4;
           push(@err, $errc);
           last;
-        } else {
-          $hash{$k}[$j] = exists $ps[$i]{default} ? $ps[$i]{default} : undef;
-        }
+        } 
       }
       last if !$ps[$i]{multi};
     }
@@ -71,6 +70,30 @@ sub AddHid {
 }
 
 
+sub GTINType { # returns 'JAN', 'EAN', 'UPC' or undef
+  my $c = $_[0];
+  return undef if $c !~ /^[0-9]{12,14}$/; # only GTIN-12, 13 and 14 codes (for now...)
+  $c = ('0'x(14-length $c)) . $c; # pad with zeros
+
+ # calculate check digit according to
+ #  http://www.gs1.org/productssolutions/barcodes/support/check_digit_calculator.html#how
+  my @n = reverse split //, $c;
+  my $n=0;
+  $n += $n[$_] * ($_ % 2 == 0 ? 1 : 3) for (1..$#n);
+  $n = 10 - ($n % 10);
+  return undef if $n != $n[0];
+
+ # Do some rough guesses based on:
+ #  http://www.gs1.org/productssolutions/barcodes/support/prefix_list.html
+ #  and http://en.wikipedia.org/wiki/List_of_GS1_country_codes
+  local $_ = $c;
+  return 'JAN' if /^04[59]/; # prefix code 450-459 & 490-499
+  return 'UPC' if /^0(?:0[01]|0[6-9]|13|75[45])/; # prefix code 000-019 & 060-139 & 754-755
+  return  undef if /0(?:0[2-5]|2|97[789]|9[6-9])/; # some codes we don't want: 020–059 & 200-299 & 977-999
+  return 'EAN'; # let's just call everything else EAN :)
+}
+
+
 sub _inarray { # errr... this is from when I didn't know about grep
   foreach (@{$_[1]}) {
     (return 1) if $_[0] eq $_;