more metadata generalization and modification
authorTony Cook <tony@develop-help.com>
Wed, 19 Mar 2014 01:59:56 +0000 (12:59 +1100)
committerTony Cook <tony@develop-help.com>
Sat, 9 May 2015 04:06:40 +0000 (14:06 +1000)
12 files changed:
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/FileMetaMeta.pm
site/cgi-bin/modules/BSE/MetaMeta.pm
site/cgi-bin/modules/BSE/MetaOwnerBase.pm
site/cgi-bin/modules/BSE/Request/Test.pm
site/cgi-bin/modules/BSE/TB/ArticleFile.pm
site/cgi-bin/modules/BSE/TB/ArticleFiles.pm
site/cgi-bin/modules/DevHelp/Validate.pm
site/templates/admin/file_edit.tmpl
site/templates/preload.tmpl
t/050-local/010-api.t
t/t000load.t

index 4dc342e..14b1753 100644 (file)
@@ -16,7 +16,7 @@ use List::Util qw(first);
 use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
 use constant ARTICLE_CUSTOM_FIELDS_CFG => "article custom fields";
 
-our $VERSION = "1.049";
+our $VERSION = "1.050";
 
 =head1 NAME
 
@@ -4634,6 +4634,8 @@ sub req_edit_file {
 
   my @metafields = $file->metafields($self->cfg);
 
+  $req->set_variable(file => $file);
+
   my $it = BSE::Util::Iterate->new;
   my $current_meta;
   my %acts;
index 37dd699..b1b93d4 100644 (file)
@@ -2,10 +2,20 @@ package BSE::FileMetaMeta;
 use strict;
 use base 'BSE::MetaMeta';
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
 sub validation_section {
   "file metadata validation";
 }
 
+sub fields_section {
+  "global file metadata";
+}
+
+sub name_section {
+  my ($self, $name) = @_;
+
+  return "file metadata $name";
+}
+
 1;
index f90df2e..546139e 100644 (file)
@@ -3,117 +3,219 @@ use strict;
 use Carp qw(confess);
 use Image::Size;
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
-my %meta_rules =
-  (
-   meta_real =>
-   {
-    match => qr/^\s*[+-]?(?:\d+(?:\.\d+)|\.\d+)(?:[eE][+-]?\d+)?\s*\z/,
-    error => '$n must be a number',
-   },
-  );
+=head1 NAME
+
+BSE::MetaMeta - information about metadata.
+
+=head1 SYNOPSIS
+
+  my @metainfo = $class->all_metametadata;
+  ...
+
+=head1 INSTANCE METHODS
+
+=over
+
+=cut
+
+my %meta_rules;
 
 my %rule_map =
   (
+   image => "image",
    integer => "integer",
    string => "dh_one_line",
-   real => "meta_real",
+   real => "real",
    enum => "meta_enum", # generated
   );
 
-sub new {
-  my $class = shift;
-  my %opts = 
-    (
-     rules => '',
-     ro => 0,
-     values => [],
-     cond => "1",
-     type => "string",
-     unit => '',
-     help => '',
-     @_
-    );
-
-  $opts{cfg} && $opts{cfg}->can("entry")
-    or confess "Missing or invalid cfg parameter";
-  $opts{name}
-    or confess "Missing name parameter";
-  $opts{name} =~ /^[a-z]\w*$/i
-    or confess "Invalid metadata name parameter";
+my %field_defs =
+  (
+   image =>
+   {
+    htmltype => "file",
+   },
+   string =>
+   {
+    htmltype => "text",
+    width => 60,
+   },
+   text =>
+   {
+    htmltype => "textarea",
+    width => 60,
+    height => 20,
+   },
+   integer =>
+   {
+    htmltype => "text",
+    width => 8,
+   },
+   real =>
+   {
+    htmltype => "text",
+    width => 10,
+   },
+   enum =>
+   {
+    htmltype => "select",
+   },
+  );
 
-  my $name = $opts{name};
-  for my $subkey (qw/data width height/) {
-    my $key = $subkey . "_name";
-    defined $opts{$key} or $opts{$key} = $name . "_" . $subkey;
-  }
-  $opts{title} ||= $name;
+=item name
 
-  if ($opts{type} eq "enum") {
-    if ($opts{values}) {
-      unless (ref $opts{values}) {
-       $opts{values} = [ split /;/, $opts{values} ];
-      }
-      @{$opts{values}}
-       or confess "$opts{name} has enum type but no values";
-    }
-    else {
-      confess "$opts{name} has enum type but no values";
-    }
+The field name of the metadata.
 
-    if ($opts{labels}) {
-      unless (ref $opts{labels}) {
-       $opts{labels} = [ split /;/, $opts{labels} ];
-      }
-      @{$opts{labels}}
-       or confess "$opts{name} has enum type but no labels";
-    }
-    else {
-      $opts{labels} = $opts{values};
-    }
-  }
+=cut
 
-  ref $opts{rules} or $opts{rules} = [ split /[,;]/, $opts{rules} ];
+sub name { $_[0]{name} }
 
-  if ($opts{cond}) {
-    my $code = $opts{cond};
-    $opts{cond} = eval 'sub { my $file = shift; ' . $code . ' }'
-      or die "Cannot compile condition code <$code> for $opts{name}: $@";
-  }
-  else {
-    $opts{cond} = sub { 1 };
-  }
+=item type
 
-  bless \%opts, $class;
-}
+The type of the metadata.
 
-sub name { $_[0]{name} }
+=cut
 
 sub type { $_[0]{type} }
 
+=item title
+
+The display name of the metadata.
+
+=cut
+
 sub title { $_[0]{title} }
 
+=item rules
+
+The validation rules for the metadata.
+
+=cut
+
 sub rules { @{$_[0]{rules}} }
 
+=item values
+
+The permitted values for the metadata for enum types.
+
+=cut
+
 sub values { @{$_[0]{values}} }
 
+=item labels
+
+The display labels as a list.
+
+=cut
+
 sub labels { @{$_[0]{labels}} }
 
+=item htmltype
+
+How to display this field.  May be ignored depending on C<type>.
+
+=cut
+
+sub htmltype { $_[0]{htmltype} }
+
+=item width
+
+Display width.  May be ignored depending on C<type>.
+
+=cut
+
+sub width { $_[0]{width} }
+
+=item height
+
+Display height.  May be ignored depending on C<type>.
+
+=cut
+
+sub height { $_[0]{height} }
+
+=item ro
+
+Whether this field is read-only.
+
+=cut
+
 sub ro { $_[0]{ro} }
 
+=item unit
+
+Unit of measurement of this field (for display only)
+
+=cut
+
 sub unit { $_[0]{unit} }
 
+=item is_text
+
+True if this is representable as text.
+
+=cut
+
 sub is_text {
   $_[0]{type} ne "image";
 }
 
+=item cond
+
+True if the field should be prompted for if not present.
+
+=cut
+
 sub cond {
   my ($self, $file) = @_;
 
   return $self->{cond}->($file);
 }
 
+=item field
+
+Return a hash suitable as the validation parameter for the field (and
+for template field formatting).
+
+=cut
+
+sub field {
+  my ($self) = @_;
+
+  my %field =
+    (
+     %{$field_defs{$self->type}},
+     description => scalar $self->title,
+     units => scalar $self->unit,
+     rules => scalar $self->rules,
+     type => scalar $self->type,
+     htmltype => scalar $self->htmltype,
+    );
+  if ($self->type =~ /^(?:multi)?enum$/) {
+    my $values = [ $self->values ];
+    my $labels = [ $self->labels ];
+    my @values = map
+      +{ id => $values->[$_], label => $labels->[$_] },
+       0 .. $#$values;
+    $field{select} =
+      {
+       id => "id",
+       label => "label",
+       values => \@values,
+      };
+  }
+
+  return \%field;
+}
+
+=item name
+
+The field name of the metadata.
+
+=cut
+
 sub validate {
   my ($self, %opts) = @_;
 
@@ -122,6 +224,7 @@ sub validate {
     or confess "value not supplied\n";
   my $rerror = delete $opts{error}
     or confess "error ref not supplied\n";
+  my $section = $self->validation_section;
 
   # kind of clumsy
   require DevHelp::Validate;
@@ -153,7 +256,7 @@ sub validate {
      fields => \%fields,
      rules => \%rules,
      cfg => $self->{cfg},
-     section => $self->validation_section,
+     section => $section,
     );
   my %errors;
   $val->validate(\%values, \%errors);
@@ -165,6 +268,12 @@ sub validate {
   return 1;
 }
 
+=item name
+
+The field name of the metadata.
+
+=cut
+
 sub metanames {
   my ($self) = @_;
 
@@ -176,20 +285,129 @@ sub metanames {
   }
 }
 
+=item data_name
+
+The field name of the metadata.
+
+=cut
+
 sub data_name {
   $_[0]{data_name}
 }
 
+=item width_name
+
+Where width information is stored for this image
+
+=cut
+
 sub width_name {
   $_[0]{width_name}
 }
 
+=item height_name
+
+Where height information is stored for this image.
+
+=cut
+
 sub height_name {
   $_[0]{height_name}
 }
 
+=item display_name
+
+Where the original filename is stored for the image.
+
+=cut
+
+sub display_name {
+  $_[0]{display_name}
+}
+
+=head1 CLASS METHODS
+
+=over
+
+=item new
+
+=cut
+
+sub new {
+  my $class = shift;
+  my %opts = 
+    (
+     rules => '',
+     ro => 0,
+     values => [],
+     cond => "1",
+     type => "string",
+     unit => '',
+     help => '',
+     width => 60,
+     height => 40,
+     @_
+    );
+
+  $opts{cfg} && $opts{cfg}->can("entry")
+    or confess "Missing or invalid cfg parameter";
+  $opts{name}
+    or confess "Missing name parameter";
+  $opts{name} =~ /^[A-Za-z_][A-Za-z0-9_-]*$/
+    or confess "Invalid metadata name parameter";
+
+  $field_defs{$opts{type}} 
+    or confess "Unknown metadata type '$opts{type}' for field '$opts{name}'";
+
+  my $name = $opts{name};
+  for my $subkey (qw/data width height display/) {
+    my $key = $subkey . "_name";
+    defined $opts{$key} or $opts{$key} = $name . "_" . $subkey;
+  }
+  $opts{title} ||= $name;
+
+  if ($opts{type} =~ /^(?:multi)?enum/) {
+    if ($opts{values}) {
+      unless (ref $opts{values}) {
+       $opts{values} = [ split /;/, $opts{values} ];
+      }
+      @{$opts{values}}
+       or confess "$opts{name} has enum type but no values";
+    }
+    else {
+      confess "$opts{name} has enum type but no values";
+    }
+
+    if ($opts{labels}) {
+      unless (ref $opts{labels}) {
+       $opts{labels} = [ split /;/, $opts{labels} ];
+      }
+      @{$opts{labels}}
+       or confess "$opts{name} has enum type but no labels";
+    }
+    else {
+      $opts{labels} = $opts{values};
+    }
+  }
+
+  $opts{htmltype} ||= $field_defs{$opts{type}}{htmltype};
+
+  ref $opts{rules} or $opts{rules} = [ split /[,;]/, $opts{rules} ];
+
+  if ($opts{cond}) {
+    my $code = $opts{cond};
+    $opts{cond} = eval 'sub { my $file = shift; my $obj = $file; ' . $code . ' }'
+      or die "Cannot compile condition code <$code> for $opts{name}: $@";
+  }
+  else {
+    $opts{cond} = sub { 1 };
+  }
+
+  bless \%opts, $class;
+}
+
 sub keys {
-  qw/title help rules ro values labels type data_name width_name height_name cond unit/;
+  qw/title help rules ro values labels type data_name width_name height_name cond unit htmltype width height/;
 }
 
 sub retrieve {
@@ -251,6 +469,10 @@ sub retrieve {
                name => $meta->height_name,
                value => $height,
               },
+              {
+               name => $meta->display_name,
+               value => "" . $im,
+              },
              );
          }
          else {
@@ -277,4 +499,30 @@ sub save {
   1;
 }
 
+sub all_metametadata {
+  my ($class, $cfg) = @_;
+
+  $cfg ||= BSE::Cfg->new;
+
+  my @metafields;
+  my @keys = $cfg->orderCS($class->fields_section);
+  for my $name (@keys) {
+    my %opts = ( name => $name );
+    my $section = $class->name_section($name);
+    for my $key ($class->keys) {
+      my $value = $cfg->entry($section, $key);
+      if (defined $value) {
+       $opts{$key} = $value;
+      }
+    }
+    push @metafields, $class->new(%opts, cfg => $cfg);
+  }
+
+  return @metafields;
+}
+
 1;
+
+=back
+
+=cut
index 9935820..cb0c990 100644 (file)
@@ -1,44 +1,40 @@
 package BSE::MetaOwnerBase;
 use strict;
+use Carp 'confess';
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
-sub clear_metadata {
-  my ($self) = @_;
+=head1 NAME
 
-  BSE::DB->run(bseClearArticleFileMetadata => $self->id, $self->meta_owner_type);
-}
+BSE::MetaOwnerBase - mix-in for objects that have metadata.
 
-sub clear_app_metadata {
-  my ($self) = @_;
+=head1 SYNOPSIS
 
-  BSE::DB->run(bseClearArticleFileAppMetadata => $self->id, $self->meta_owner_type);
-}
+  my $file = ...
+  my @meta = $file->metadata;
+  my @text = $file->text_metadata;
+  my $meta = $file->meta_by_name($name);
+  my @names = $file->metanames;
+  my @info = $file->metainfo;
+  my @config = $file->meta_config;
 
-sub clear_sys_metadata {
-  my ($self) = @_;
+=head1 DESCRIPTION
 
-  BSE::DB->run(bseClearArticleFileSysMetadata => $self->id, $self->meta_owner_type);
-}
+Provides generic metadata support methods.  These can be called on any
+L<BSE::TB::ArticleFile> object, and possibly other objects in the
+future.
 
-sub delete_meta_by_name {
-  my ($self, $name) = @_;
+=head1 PUBLIC METHODS
 
-print STDERR "Delete ", $self->id, ",", $name, ",", $self->meta_owner_type, ")\n";
-  BSE::DB->run(bseDeleteArticleFileMetaByName => $self->id, $name, $self->meta_owner_type);
-}
+These can be called from anywhere, including templates:
 
-sub add_meta {
-  my ($self, %opts) = @_;
+=over
 
-  require BSE::TB::Metadata;
-  return BSE::TB::Metadata->make
-      (
-       file_id => $self->id,
-       owner_type => $self->meta_owner_type,
-       %opts,
-      );
-}
+=item metadata
+
+Return all metadata for the object (as metadata objects).
+
+=cut
 
 sub metadata {
   my ($self) = @_;
@@ -51,6 +47,13 @@ sub metadata {
     );
 }
 
+=item metadata
+
+Return all metadata for the object with a content type of
+C<text/plain>.
+
+=cut
+
 sub text_metadata {
   my ($self) = @_;
 
@@ -63,6 +66,14 @@ sub text_metadata {
     );
 }
 
+=item meta_by_name
+
+Retrieve metadata with a specific name.
+
+Returns nothing if there is no metadata of that name.
+
+=cut
+
 sub meta_by_name {
   my ($self, $name) = @_;
 
@@ -78,4 +89,174 @@ sub meta_by_name {
   return $result;
 }
 
+=item metanames
+
+Returns the names of each metadatum defined for the file.
+
+=cut
+
+sub metanames {
+  my ($self) = @_;
+
+  require BSE::TB::Metadata;
+  return BSE::TB::Metadata->getColumnBy
+    (
+     "name",
+     [
+      [ file_id => $self->id ],
+      [ owner_type => $self->meta_owner_type ],
+     ],
+    );
+
+}
+
+=item metainfo
+
+Returns all but the value for metadata defined for the file.
+
+This is useful to avoid loading large objects if the metadata happens
+to be file content.
+
+=cut
+
+sub metainfo {
+  my ($self) = @_;
+
+  require BSE::TB::Metadata;
+  my @cols = grep $_ ne "value", BSE::TB::MetaEntry->columns;
+  return BSE::TB::Metadata->getColumnsBy
+    (
+     \@cols,
+     [
+      [ file_id => $self->id ],
+      [ owner_type => $self->meta_owner_type ],
+     ],
+    );
+}
+
+=item meta_config
+
+Returns configured metadata fields for this object.
+
+=cut
+
+sub meta_config {
+  my ($self, $cfg) = @_;
+
+  $cfg || BSE::Cfg->single;
+
+  require BSE::MetaMeta;
+  my @metafields;
+  my $prefix = $self->meta_meta_cfg_prefix;
+  my @keys = $cfg->orderCS($self->meta_meta_cfg_section);
+  for my $name (@keys) {
+    my %opts = ( name => $name );
+    my $section = "$prefix $name";
+    for my $key (BSE::MetaMeta->keys) {
+      my $value = $cfg->entry($section, $key);
+      if (defined $value) {
+       $opts{$key} = $value;
+      }
+    }
+    push @metafields, BSE::MetaMeta->new(%opts, cfg => $cfg);
+  }
+
+  return @metafields;
+
+}
+
+=back
+
+=head1 RESTRICTED METHODS
+
+These are not accessible from templates.
+
+=item clear_metadata
+
+Remove all metadata for this object.  Should be called when the object
+is removed.
+
+Restricted.
+
+=cut
+
+sub clear_metadata {
+  my ($self) = @_;
+
+  BSE::DB->run(bseClearArticleFileMetadata => $self->id, $self->meta_owner_type);
+}
+
+=item clear_app_metadata
+
+Remove all application metadata for this object.
+
+Restricted.
+
+=cut
+
+sub clear_app_metadata {
+  my ($self) = @_;
+
+  BSE::DB->run(bseClearArticleFileAppMetadata => $self->id, $self->meta_owner_type);
+}
+
+=item clear_sys_metadata
+
+Remove all system metadata for this object.
+
+Restricted.
+
+=cut
+
+sub clear_sys_metadata {
+  my ($self) = @_;
+
+  BSE::DB->run(bseClearArticleFileSysMetadata => $self->id, $self->meta_owner_type);
+}
+
+=item delete_meta_by_name
+
+Remove a single piece of metadata from the object.
+
+Restricted.
+
+=cut
+
+sub delete_meta_by_name {
+  my ($self, $name) = @_;
+
+print STDERR "Delete ", $self->id, ",", $name, ",", $self->meta_owner_type, ")\n";
+  BSE::DB->run(bseDeleteArticleFileMetaByName => $self->id, $name, $self->meta_owner_type);
+}
+
+=item add_meta
+
+Add metadata to the object.
+
+Restricted.
+
+=cut
+
+sub add_meta {
+  my ($self, %opts) = @_;
+
+  require BSE::TB::Metadata;
+  return BSE::TB::Metadata->make
+      (
+       file_id => $self->id,
+       owner_type => $self->meta_owner_type,
+       %opts,
+      );
+}
+
+sub restricted_method {
+  my ($self, $name) = @_;
+
+  return $name =~ /^(?:clear_|delete_|add_)/;
+}
+
 1;
+
+=back
+
+=cut
index 90d2c47..311ce5f 100644 (file)
@@ -2,13 +2,22 @@ package BSE::Request::Test;
 use strict;
 use base 'BSE::Request::Base';
 
-our $VERSION = "1.003";
+our $VERSION = "1.004";
 
 sub new {
   my ($class, %opts) = @_;
 
   my $params = delete $opts{params} || {};
-  $opts{cgi} = bless $params, 'BSE::Request::Test::CGI';
+  my %params = %$params;
+  my $files = delete $opts{files} || {};
+  for my $key (%$files) {
+    $params{$key} = $files->{$key}{name};
+  }
+  $opts{cgi} = bless
+    {
+     params => \%params,
+     files => $files,
+    }, 'BSE::Request::Test::CGI';
   $opts{is_ajax} ||= 0;
   my $self = $class->SUPER::new(%opts);
 
@@ -31,6 +40,7 @@ sub is_ajax {
 
 package BSE::Request::Test::CGI;
 use Carp qw(confess);
+use File::Temp qw(:seekable);
 
 sub param {
   my $self = shift;
@@ -64,4 +74,48 @@ sub param {
   }
 }
 
+sub upload {
+  my ($self, $name) = @_;
+
+  my $entry = $self->{files}{$name}
+    or return;
+
+  $entry->{handle}
+    and return $entry->{handle};
+
+  my $fh;
+  if ($entry->{content}) {
+    my $temp = BSE::Request::CGI::File->new;
+    binmode $temp;
+    print $temp $entry->{content};
+    $temp->seek(0, SEEK_SET);
+
+    $fh = $temp;
+  }
+  else {
+    open $fh, "<", $entry->{filename}
+      or die "Cannot open file $entry->{filename}: $!";
+    binmode $fh;
+  }
+  $entry->{handle} = $fh;
+
+  return $fh;
+}
+
+sub uploadInfo {
+  my ($self, $name) = @_;
+
+  my $entry = $self->{files}{$name}
+    or return;
+
+  return $entry->{info} || {};
+}
+
+package BSE::Request::CGI::File;
+use base 'File::Temp';
+
+sub handle {
+  $_[0];
+}
+
 1;
index 78eb910..1fa3f0b 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use base qw(Squirrel::Row BSE::MetaOwnerBase);
 use Carp 'confess';
 
-our $VERSION = "1.011";
+our $VERSION = "1.012";
 
 sub columns {
   return qw/id articleId displayName filename sizeInBytes description 
@@ -215,47 +215,15 @@ sub apply_storage {
   }
 }
 
-=item metanames
-
-returns the names of each metadatum defined for the file.
-
-=cut
-
-sub metanames {
-  my ($self) = @_;
-
-  require BSE::TB::ArticleFileMetas;
-  return BSE::TB::ArticleFileMetas->getColumnBy
-    (
-     "name",
-     [ file_id => $self->id ],
-    );
-}
-
-=item metainfo
-
-Returns all but the value for metadata defined for the file.
-
-=cut
-
-sub metainfo {
-  my ($self) = @_;
-
-  require BSE::TB::ArticleFileMetas;
-  my @cols = grep $_ ne "value", BSE::TB::ArticleFileMeta->columns;
-  return BSE::TB::ArticleFileMetas->getColumnsBy
-    (
-     \@cols,
-     [ file_id => $self->id ],
-    );
-}
-
 sub metafields {
   my ($self, $cfg) = @_;
 
+  $cfg ||= BSE::Cfg->single;
+
   my %metanames = map { $_ => 1 } $self->metanames;
 
-  my @fields = grep $metanames{$_->name} || $_->cond($self), BSE::TB::ArticleFiles->all_metametadata($cfg);
+  require BSE::FileMetaMeta;
+  my @fields = grep $metanames{$_->name} || $_->cond($self), BSE::FileMetaMeta->all_metametadata($cfg);
 
   my $handler = $self->handler($cfg);
 
@@ -454,4 +422,19 @@ sub meta_owner_type {
   'bse_file';
 }
 
+sub meta_meta_cfg_section {
+  "global file metadata";
+}
+
+sub meta_meta_cfg_prefix {
+  "file metadata";
+}
+
+sub restricted_method {
+  my ($self, $name) = @_;
+
+  return $self->Squirrel::Row::restricted_method($name)
+    || $self->BSE::MetaOwnerBase::restricted_method($name);
+}
+
 1;
index be11f67..24e6b98 100644 (file)
@@ -6,7 +6,7 @@ use vars qw(@ISA $VERSION);
 use BSE::TB::ArticleFile;
 use Carp qw(confess);
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
 sub rowClass {
   return 'BSE::TB::ArticleFile';
@@ -71,30 +71,6 @@ sub file_manager {
   return BSE::StorageMgr::Files->new(cfg => $cfg);
 }
 
-sub all_metametadata {
-  my ($self, $cfg) = @_;
-
-  $cfg
-    or confess "Missing cfg parameter";
-
-  require BSE::FileMetaMeta;
-  my @metafields;
-  my @keys = $cfg->orderCS("global file metadata");
-  for my $name (@keys) {
-    my %opts = ( name => $name );
-    my $section = "file metadata $name";
-    for my $key (BSE::FileMetaMeta->keys) {
-      my $value = $cfg->entry($section, $key);
-      if (defined $value) {
-       $opts{$key} = $value;
-      }
-    }
-    push @metafields, BSE::FileMetaMeta->new(%opts, cfg => $cfg);
-  }
-
-  return @metafields;
-}
-
 sub downloads_must_be_paid {
   return BSE::Cfg->single->entryBool('downloads', 'must_be_paid', 0);
 }
index c8d2d29..467b51e 100644 (file)
@@ -6,7 +6,7 @@ use vars qw(@EXPORT_OK @ISA);
 @ISA = qw(Exporter);
 use Carp qw(confess);
 
-our $VERSION = "1.007";
+our $VERSION = "1.008";
 
 my $re_real =
   qr/
@@ -159,6 +159,10 @@ my %built_ins =
     nomatch => qr/[\x0D\x0A]/,
     error => '$n may only contain a single line',
    },
+   real =>
+   {
+    real => 1,
+   },
    time =>
    {
     # we accept 24-hour time, or 12 hour with (a|p|am|pm)
index 1cdfc8c..a159a3f 100644 (file)
             </td>
             <td class="help"><:help file hide_from_list:> <:error_img hide_from_list:></td>
           </tr>
-<:if Filemetas:>
-<tr>
-  <th colspan="3">File metadata</th>
-</tr>
-<:iterator begin filemetas:>
-<tr>
-  <th><:filemeta title:></th>
-  <td>
-<:if Filemeta ro:>
-<:switch:>
-<:case Match [filemeta type] "^(integer|string|real)$" |x:>
-<:filemeta_value [filemeta name] :> <:filemeta unit:>
-<:case Eq [filemeta type] "text":>
-<textarea name="meta_<:filemeta name:>" class="meta_text_ro"><:filemeta_value [filemeta name]:></textarea>
-<:case Eq [filemeta type] "enum":>
-<:filemeta_select_label:> <:filemeta unit:>
-<:case Eq [filemeta type] "image":>
-<:ifFilemeta_set [filemeta data_name]:><div class="file_display_trigger">Show
-<div class="file_display"><img src="<:filemeta_source [filemeta data_name]:>" width="<:filemeta_value [filemeta width_name]:>" height="<:filemeta_value [filemeta height_name]:>" /></div></div><:or:>(No image set)<:eif:>
-<:case default:>
-Unknown metadata type <:filemeta type:>
-<:endswitch:>
-<:or Filemeta:>
-<:switch:>
-<:case Match [filemeta type] "^(integer|string|real)$" |x:>
-<input type="text" name="meta_<:filemeta name:>" value="<:filemeta_value [filemeta name] :>" class="meta_<:filemeta type:>" /> <:filemeta unit:>
-<:case Eq [filemeta type] "text":>
-<textarea name="meta_<:filemeta name:>" class="meta_text"><:filemeta_value [filemeta name]:></textarea>
-<:case Eq [filemeta type] "enum":>
-<:filemeta_select:> <:filemeta unit:>
-<:case Eq [filemeta type] "image":>
-<input type="file" name="meta_<:filemeta name:>" />
-<:ifFilemeta_set [filemeta data_name]:><div class="file_display_trigger">Show
-<div class="file_display"><img src="<:filemeta_source [filemeta data_name]:>" width="<:filemeta_value [filemeta width_name]:>" height="<:filemeta_value [filemeta height_name]:>" /></div></div>
-<input type="checkbox" name="delete_meta_<:filemeta name:>" value="1" />&nbsp;Delete
-<:or:>(No image set)<:eif:>
-<:case default:>
-Unknown metadata type <:filemeta type:>
-<:endswitch:>
-<:if Match [filemeta type] "image":><:or Match:>
-<:ifFilemeta_set [filemeta name]:><input type="checkbox" name="delete_meta_<:filemeta name:>" value="1" />&nbsp;Delete<:or:><:eif:>
-<:eif Match:>
-<:eif Filemeta:>
-  </td>
-  <td class="help">
-<:if Filemeta help:>
-<div class="help_display_trigger"><img src="/images/admin/help.gif" alt="help" />
-<div class="help_display"><:filemeta help |z:></div></div>
-<:or Filemeta:><:eif Filemeta:>
-  </td>
-</tr>
-<:iterator end filemetas:>
-<:or Filemetas:><:eif Filemetas:>
+<tr><td colspan="3">
+<:.set metas = [ file.metafields ] :>
+<:.if metas.size :>
+<fieldset>
+  <legend>File metadata</legend>
+
+<:  .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 :>
+<:    .set tmpobj = {} :>
+<:%   tmpobj.set(name, def) :>
+<:    .if m.ro :>
+<:      .call "inlinefieldro", name: name, field: m.field, object: tmpobj :>
+<:    .else :>
+<:      .call "inlinefield", name: name, field: m.field, delete: 1, object: tmpobj :>
+<:    .end if :>
+<:  .end for :>
+</td></tr>
           <tr> 
             <td colspan="3" align="right"> 
               <input type="submit" name="a_save_file" value="Save File" />
index 99c6d39..1fff980 100644 (file)
@@ -142,7 +142,7 @@ Page <:= pages.page :> of <:= pages.pagecount :>
   name - field name
   field - entry from fields
   object - source for defaults in edit mode
-:>
+-:>
 <:  .if object -:>
 <:     .set default = object.$name -:>
 <:  .elsif field.default -:>
@@ -188,7 +188,12 @@ Page <:= pages.page :> of <:= pages.pagecount :>
     groups: field.select.groups ? (field.select.groups.is_code ? (field.select.groups)() : field.select.groups ) : 0,
     grouplabel: (field.select.grouplabel or "label")
 -:>
-<:  .else -:>
+<:  .elsif field.htmltype eq 'file' -:>
+<:   .if default.length -:>
+<span class="filename"><:= default :></span>
+<:   .end if -:>
+<input id="<:= name :>" type="file" name="<:= name :>" />
+<:- .else -:>
 <input id="<:= name | html :>" type="text" name="<:= name | html :>" value="<:=  default | html :>" 
 <:-= field.maxlength ? ' maxlength="' _ field.maxlength _ '"' : '' |raw:>
 <:-= field.width ? ' size="' _ field.width _ '"' : '' | raw :> />
@@ -212,7 +217,7 @@ Page <:= pages.page :> of <:= pages.pagecount :>
   <:.end if -:>
 <:.end define -:>
 
-<:.define inlinefield -:>
+<:.define inlinefield; object: 0 -:>
 <:# parameters:
   name - the field name
   field - a field, as an entry in fields
index d33b510..f9e3ef3 100644 (file)
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use BSE::Test qw(make_ua base_url);
-use Test::More tests => 76;
+use Test::More tests => 90;
 use File::Spec;
 use File::Slurp;
 use Carp qw(confess);
@@ -166,6 +166,42 @@ SKIP: {
   my $stored = read_file($file->full_filename);
   is($stored, $mine, "check contents");
 
+  # add some metadata
+  my $name = "n" . time();
+  my $meta = $file->add_meta
+     (
+      name => $name,
+      value => "Test text",
+     );
+  ok($meta, "add meta data");
+  is($meta->name, $name, "check name");
+  is($meta->content_type, "text/plain", "check content type");
+  ok($meta->is_text, "it qualifies as text");
+  is($meta->value, "Test text", "check value");
+
+  my @names = $file->metanames;
+  ok(@names, "we got some meta names");
+  my ($found) = grep $_ eq $name, @names;
+  ok($found, "and found the meta name we added");
+
+  my @meta = $file->metadata;
+  ok(@meta, "we have some metadata");
+  my ($found_meta) = grep $_->name eq $name, @meta;
+  ok($found_meta, "and found the one we added");
+
+  my @tmeta = $file->text_metadata;
+  ok(@tmeta, "we have some text metadata");
+  my ($found_tmeta) = grep $_->name eq $name, @tmeta;
+  ok($found_tmeta, "and found the one we added");
+
+  my $named = $file->meta_by_name($name);
+  ok($named, "found added meta by name");
+
+  my @info = $file->metainfo;
+  ok(@info, "found metainfo");
+  my ($info) = grep $_->{name} eq $name, @info;
+  ok($info, "and found the info we added");
+
   my @files = $art->files;
   is (@files, 1, "should be one file");
   is($files[0]->id, $file->id, "should be what we added");
@@ -180,9 +216,9 @@ SKIP: {
     );
   ok($file2, "add a second file (named)");
   $art->uncache_files;
-  my $named = $art->file_by_name("test");
-  ok($named, "got the named file");
-  is($named->id, $file2->id, "and it's the file we added");
+  my $named_test = $art->file_by_name("test");
+  ok($named_test, "got the named file");
+  is($named_test->id, $file2->id, "and it's the file we added");
 }
 
 {
index cf5aa24..d087714 100644 (file)
@@ -1,6 +1,6 @@
 #!perl -w
 use strict;
-use Test::More tests => 34;
+use Test::More tests => 37;
 use_ok("BSE::Cfg");
 use_ok("Squirrel::Template");
 use_ok("BSE::Template");
@@ -35,6 +35,9 @@ use_ok("BSE::ImageClean");
 use_ok("BSE::UI::AdminImageClean");
 use_ok("BSE::UI::Thumb");
 use_ok("BSE::UI::Interest");
+use_ok("BSE::Request::Base");
+use_ok("BSE::Request");
+use_ok("BSE::Request::Test");
 
 my $builder = Test::Builder->new;
 $builder->is_passing or $builder->BAIL_OUT;