use cgi_fields() for metadata parsing, and other improvements
authorTony Cook <tony@develop-help.com>
Fri, 28 Mar 2014 11:46:40 +0000 (22:46 +1100)
committerTony Cook <tony@develop-help.com>
Sat, 9 May 2015 04:06:42 +0000 (14:06 +1000)
site/cgi-bin/modules/BSE/MetaMeta.pm
site/cgi-bin/modules/BSE/MetaOwnerBase.pm
site/cgi-bin/modules/BSE/Request/Base.pm
site/cgi-bin/modules/BSE/TB/ArticleFile.pm
site/cgi-bin/modules/BSE/TB/MetaEntry.pm
site/cgi-bin/modules/DevHelp/Validate.pm
site/templates/admin/file_edit.tmpl
site/templates/preload.tmpl
t/t000load.t

index adadc20..9a5ebfb 100644 (file)
@@ -2,8 +2,9 @@ package BSE::MetaMeta;
 use strict;
 use Carp qw(confess);
 use Image::Size;
+use Fcntl ':seek';
 
-our $VERSION = "1.003";
+our $VERSION = "1.004";
 
 =head1 NAME
 
@@ -35,6 +36,7 @@ my %field_defs =
   (
    image =>
    {
+    type => "image",
     htmltype => "file",
    },
    string =>
@@ -196,7 +198,7 @@ sub field {
     (
      description => scalar $self->title,
      units => scalar $self->unit,
-     rules => scalar $self->rules,
+     rules => [ $self->rules ],
      rawtype => scalar $self->type,
      htmltype => scalar $self->htmltype,
      type => scalar $self->fieldtype,
@@ -298,7 +300,7 @@ sub metanames {
   my ($self) = @_;
 
   if ($self->type eq 'image') {
-    return ( $self->data_name, $self->width_name, $self->height_name );
+    return ( $self->data_name, $self->width_name, $self->height_name, $self->display_name );
   }
   else {
     return $self->name;
@@ -414,6 +416,7 @@ sub new {
   $opts{htmltype} ||= $field_defs{$opts{type}}{htmltype};
 
   ref $opts{rules} or $opts{rules} = [ split /[,;]/, $opts{rules} ];
+  unshift @{$opts{rules}}, $rule_map{$opts{type}};
 
   if ($opts{cond}) {
     my $code = $opts{cond};
@@ -432,8 +435,9 @@ sub keys {
 }
 
 sub retrieve {
-  my ($class, $req, $owner, $errors) = @_;
+  my ($class, $req, $owner, $errors, %opts) = @_;
 
+  my $api = $opts{api};
   my @meta;
   my @meta_delete;
   my $cgi = $req->cgi;
@@ -450,54 +454,60 @@ sub retrieve {
     }
     else {
       my $new;
-      if ($meta->is_text) {
-       my ($value) = $cgi->param($cgi_name);
-       if (defined $value && 
-           ($value =~ /\S/ || $current_meta{$meta->name})) {
-         my $error;
-         if ($meta->validate(value => $value, error => \$error)) {
+      my %fields =
+       (
+        $cgi_name => $meta->field,
+       );
+      if ($req->validate(fields => \%fields,
+                        rules => \%meta_rules,
+                        errors => $errors)) {
+       my $values = $req->cgi_fields
+         (
+          fields => \%fields,
+          api => $api,
+         );
+       my $value = $values->{$cgi_name};
+       if ($meta->is_text) {
+         if (defined $value && 
+             ($value =~ /\S/ || $current_meta{$meta->name})) {
+           utf8::encode($value);
            push @meta,
              {
               name => $name,
               value => $value,
              };
          }
-         else {
-           $errors->{$cgi_name} = $error;
-         }
        }
-      }
-      else {
-       my $im = $cgi->param($cgi_name);
-       my $up = $cgi->upload($cgi_name);
-       if (defined $im && $up) {
-         my $data = do { local $/; <$up> };
-         my ($width, $height, $type) = imgsize(\$data);
-
-         if ($width && $height) {
-           push @meta,
-             (
-              {
-               name => $meta->data_name,
-               value => $data,
-               content_type => "image/\L$type",
-              },
-              {
-               name => $meta->width_name,
-               value => $width,
-              },
-              {
-               name => $meta->height_name,
-               value => $height,
-              },
-              {
-               name => $meta->display_name,
-               value => "" . $im,
-              },
-             );
-         }
-         else {
-           $errors->{$cgi_name} = $type;
+       else {
+         if ($value) {
+           my $up = $value->{fh};
+           binmode $up;
+           seek $up, 0, SEEK_SET;
+           my $data = do { local $/; <$up> };
+           my ($width, $height, $type) = imgsize(\$data);
+
+           if ($width && $height) {
+             push @meta,
+               (
+                {
+                 name => $meta->data_name,
+                 value => $data,
+                 content_type => "image/\L$type",
+                },
+                {
+                 name => $meta->width_name,
+                 value => $width,
+                },
+                {
+                 name => $meta->height_name,
+                 value => $height,
+                },
+                {
+                 name => $meta->display_name,
+                 value => "" . $value->{filename},
+                },
+               );
+           }
          }
        }
       }
@@ -510,8 +520,8 @@ sub retrieve {
 sub save {
   my ($class, $owner, $meta) = @_;
 
-  for my $meta_delete (@{$meta->{meta}}, map $_->{name}, @{$meta->{delete}}) {
-    $owner->delete_meta_by_name($meta_delete->{name});
+  for my $meta_delete (@{$meta->{delete}}, map $_->{name}, @{$meta->{meta}}) {
+    $owner->delete_meta_by_name($meta_delete);
   }
   for my $meta (@{$meta->{meta}}) {
     $owner->add_meta(%$meta, appdata => 1);
index cb0c990..19b211a 100644 (file)
@@ -2,7 +2,7 @@ package BSE::MetaOwnerBase;
 use strict;
 use Carp 'confess';
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
 =head1 NAME
 
@@ -240,6 +240,12 @@ Restricted.
 sub add_meta {
   my ($self, %opts) = @_;
 
+  my $value_text = delete $opts{value_text};
+  if ($value_text) {
+    utf8::encode($value_text);
+    $opts{value} = $value_text;
+  }
+
   require BSE::TB::Metadata;
   return BSE::TB::Metadata->make
       (
index 36bc7f2..131c56c 100644 (file)
@@ -5,7 +5,7 @@ use BSE::Cfg;
 use BSE::Util::HTML;
 use Carp qw(cluck confess);
 
-our $VERSION = "1.030";
+our $VERSION = "1.031";
 
 =head1 NAME
 
@@ -1780,7 +1780,14 @@ sub cgi_fields {
     $field->{readonly}
       and next FIELD;
     my $value;
-    if ($field->{htmltype} eq "checkbox") {
+    if ($field->{htmltype} eq "file") {
+      my $fh = $cgi->upload($name);
+      my $filename = $cgi->param($name);
+      if ($fh) {
+       $value = { fh => $fh, filename => "".$filename };
+      }
+    }
+    elsif ($field->{htmltype} eq "checkbox") {
       if ($field->{type} eq "int") {
        $value = $cgi->param($name) ? 1 : 0;
       }
index b24c939..cbdc107 100644 (file)
@@ -4,7 +4,9 @@ use strict;
 use base qw(Squirrel::Row BSE::MetaOwnerBase);
 use Carp 'confess';
 
-our $VERSION = "1.013";
+our $VERSION = "1.014";
+
+use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
 
 sub columns {
   return qw/id articleId displayName filename sizeInBytes description 
@@ -48,17 +50,20 @@ sub fields {
      {
       htmltype => "file",
       description => "File",
+      maxlength => MAX_FILE_DISPLAYNAME_LENGTH,
      },
      description =>
      {
       description => "Description",
       rules => "dh_one_line",
+      maxlength => 255,
      },
      name =>
      {
       description => "Identifier",
       htmltype => "text",
       width => 20,
+      maxlength => 80,
      },
      contentType =>
      {
@@ -110,6 +115,11 @@ sub fields {
        ],
       },
      },
+     category =>
+     {
+      description => "Category",
+      maxlength => 20,
+     },
     );
 }
 
index f8555d6..89988ef 100644 (file)
@@ -2,7 +2,7 @@ package BSE::TB::MetaEntry;
 use strict;
 use base 'Squirrel::Row';
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
 sub table {
   "bse_article_file_meta";
@@ -21,4 +21,31 @@ sub is_text {
   $_[0]->content_type eq "text/plain"
 }
 
+sub is_text_type {
+  $_[0]->content_type =~ m(^text/);
+}
+
+sub value_text {
+  my ($self) = @_;
+
+  $self->is_text_type or return;
+
+  my $value = $self->value;
+  utf8::decode($value) or return;
+
+  return $value;
+}
+
+sub set_value_text {
+  my ($self, $value) = @_;
+
+  $self->is_text_type or return;
+
+  utf8::encode($value);
+
+  $self->set_value($value);
+
+  1;
+}
+
 1;
index 467b51e..7b245e0 100644 (file)
@@ -6,7 +6,7 @@ use vars qw(@EXPORT_OK @ISA);
 @ISA = qw(Exporter);
 use Carp qw(confess);
 
-our $VERSION = "1.008";
+our $VERSION = "1.009";
 
 my $re_real =
   qr/
@@ -593,6 +593,85 @@ sub validate_field {
          }
        }
       }
+      if ($rule->{file} || $rule->{image}) {
+       my $fh = $self->upload($field);
+       if ($fh) {
+         my $size = -s $fh;
+         if ($rule->{maxsize} && $size > _kb($rule->{maxbytes})) {
+           $errors->{$field} = _make_error($field, $info, $rule,
+                                           $info->{maxbytes_error} ||
+                                           $rule->{maxbytes_error} ||
+                                           "\$n must be smaller than $rule->{maxsize}");
+           last RULE;
+         }
+         elsif ($rule->{minsize} && $size < _kb($rule->{minsize})) {
+           $errors->{$field} = _make_error($field, $info, $rule,
+                                           $info->{minbytes_error} ||
+                                           $rule->{minbytes_error} ||
+                                           "\$n must be larger than than $rule->{maxsize}");
+           last RULE;
+         }
+       }
+       else {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         $info->{nofile_error} ||
+                                         $rule->{nofile_error},
+                                         "\$n isn't a file");
+         last RULE;
+       }
+      }
+      if ($rule->{image}) {
+       my $fh = $self->upload($field);
+       require Image::Size;
+       my ($width, $height, $type) = Image::Size::imgsize($fh->handle);
+       if (!defined $width) {
+         $errors->{$field} =
+           _make_error($field, $info, $rule,
+                       $info->{notimage_error} || $rule->{notimage_error} ||
+                       "\$n isn't an image file");
+         last RULE;
+       }
+       elsif ($rule->{imagetype} &&
+              $rule->{imagetype} !~ /\b\Q$type\E\b/i) {
+         $errors->{$field} =
+           _make_error($field, $info, $rule,
+                       $info->{imagetype_error} || $rule->{imagetype_error} ||
+                       "\$n isn't a supported image format");
+         last RULE;
+       }
+       elsif ($rule->{minwidth} &&
+              $rule->{minwidth} > $width) {
+         $errors->{$field} =
+           _make_error($field, $info, $rule,
+                       $info->{minwidth_error} || $rule->{minwidth_error} ||
+                       "\$n must be at least $rule->{minwidth} pixels wide");
+         last RULE;
+       }
+       elsif ($rule->{minheight} &&
+              $rule->{minheight} > $height) {
+         $errors->{$field} =
+           _make_error($field, $info, $rule,
+                       $info->{minheight_error} || $rule->{minheight_error} ||
+                       "\$n must be at least $rule->{minwidth} pixels high");
+         last RULE;
+       }
+       elsif ($rule->{maxwidth} &&
+              $rule->{maxwidth} < $width) {
+         $errors->{$field} =
+           _make_error($field, $info, $rule,
+                       $info->{maxwidth_error} || $rule->{maxwidth_error} ||
+                       "\$n must be no more than $rule->{maxwidth} pixels wide");
+         last RULE;
+       }
+       elsif ($rule->{maxheight} &&
+              $rule->{maxheight} < $height) {
+         $errors->{$field} =
+           _make_error($field, $info, $rule,
+                       $info->{maxheight_error} || $rule->{maxheight_error} ||
+                       "\$n must be no more than $rule->{maxwidth} pixels high");
+         last RULE;
+       }
+      }
       if ($rule->{ref}) {
        my $method = $rule->{method}
          or confess "Missing method in ref rule $rule_name";
@@ -843,6 +922,12 @@ sub param {
   $self->{cgi}->param($field);
 }
 
+sub upload {
+  my ($self, $field) = @_;
+
+  $self->{cgi}->upload($field);
+}
+
 sub validate {
   my ($self, $cgi, $errors) = @_;
   
@@ -869,6 +954,10 @@ sub param {
   return $value;
 }
 
+sub upload {
+  return;
+}
+
 sub validate {
   my ($self, $hash, $errors) = @_;
 
index 4b75c2b..78276e8 100644 (file)
 <fieldset>
   <legend>File metadata</legend>
 
-<:  .for m in metas :>
-<:#= bse.dumper(m.field) |raw :>
+<:  .for m in metas -:>
+<:= bse.dumper(m.field) |raw :>
 <:#= bse.dumper(m) |raw :>
-<:    .set name = "meta_" _ m.name :>
-<:    .set mdata = file.meta_by_name(m.name) :>
-<:    .set def = mdata ? mdata.value : "" :>
-<:    .if m.type eq 'image' :>
-<:       .set def = file.meta_by_name(m.display_name).value :>
-<:    .end if :>
-<:    .if m.ro :>
+<:    .set name = "meta_" _ m.name -:>
+<:    .set mdata = file.meta_by_name(m.name) -:>
+<:    .if m.type eq 'image' -:>
+<:      .set def = file.meta_by_name(m.display_name) -:>
+<:      .set def = def ? def.value_text : "" -:>
+<:    .else -:>
+<:      .set def = mdata ? mdata.value_text : "" -:>
+<:    .end if -:>
+<:    .if m.ro -:>
 <:      .call "inlinefieldro", name: name, field: m.field,
-               options: { default: def } :>
-<:    .else :>
+               options: { default: def } -:>
+<:    .else -:>
 <:      .call "inlinefield", name: name, field: m.field, 
-                options: { delete: 1, default: def } :>
+                options: { delete: 1, default: def } -:>
 <:    .end if :>
-<:  .end for :>
+<:  .end for -:>
 </fieldset>
   <p class="buttons">
               <input type="submit" name="a_save_file" value="Save File" />
index b769b32..6fb9882 100644 (file)
@@ -226,10 +226,14 @@ Page <:= pages.page :> of <:= pages.pagecount :>
 <:# parameters:
   name - the field name
   field - a field, as an entry in fields
+  options - various options, including:
+     note - display this text as a note below the field
+     delete - add a delete checkbox
+     default - a custom default value, overrides object
 -:>
   <:.if field.is_hash -:>
 <div>
-  <label for="<:= name | html :>"><:= field.nolabel ? "" : field.description | html :>:</label>
+  <label for="<:= name :>"><:= field.nolabel ? "" : field.description | html :>:</label>
   <span>
     <:-.if field.readonly -:>
 <:-.call "display", name:name, options: options -:>
@@ -242,6 +246,9 @@ Page <:= pages.page :> of <:= pages.pagecount :>
     <:-.if options.note -:>
 <br /><:= options.note | raw :>
     <:-.end if -:>
+    <:-.if options["delete"] -:>
+<br /><input type="checkbox" name="delete_<:= name :>" value="1" id="delete_<:= name :>"><label for="delete_<:= name :>">Delete</label>
+    <:-.end if -:>
 </span>
 </div>
   <:.end if -:>
index d087714..a450386 100644 (file)
@@ -1,6 +1,6 @@
 #!perl -w
 use strict;
-use Test::More tests => 37;
+use Test::More tests => 38;
 use_ok("BSE::Cfg");
 use_ok("Squirrel::Template");
 use_ok("BSE::Template");
@@ -8,6 +8,7 @@ use_ok("BSE::Util::PasswordValidate");
 use_ok("DevHelp::Date");
 use_ok("DevHelp::Formatter");
 use_ok("DevHelp::HTML");
+use_ok("DevHelp::Validate");
 use_ok("BSE::Variables");
 use_ok("BSE::TB::AuditLog");
 use_ok("BSE::TB::Tag");