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
my @metafields = $file->metafields($self->cfg);
+ $req->set_variable(file => $file);
+
my $it = BSE::Util::Iterate->new;
my $current_meta;
my %acts;
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;
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) = @_;
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;
fields => \%fields,
rules => \%rules,
cfg => $self->{cfg},
- section => $self->validation_section,
+ section => $section,
);
my %errors;
$val->validate(\%values, \%errors);
return 1;
}
+=item name
+
+The field name of the metadata.
+
+=cut
+
sub metanames {
my ($self) = @_;
}
}
+=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 {
name => $meta->height_name,
value => $height,
},
+ {
+ name => $meta->display_name,
+ value => "" . $im,
+ },
);
}
else {
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
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) = @_;
);
}
+=item metadata
+
+Return all metadata for the object with a content type of
+C<text/plain>.
+
+=cut
+
sub text_metadata {
my ($self) = @_;
);
}
+=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) = @_;
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
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);
package BSE::Request::Test::CGI;
use Carp qw(confess);
+use File::Temp qw(:seekable);
sub param {
my $self = shift;
}
}
+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;
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
}
}
-=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);
'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;
use BSE::TB::ArticleFile;
use Carp qw(confess);
-our $VERSION = "1.001";
+our $VERSION = "1.002";
sub rowClass {
return 'BSE::TB::ArticleFile';
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);
}
@ISA = qw(Exporter);
use Carp qw(confess);
-our $VERSION = "1.007";
+our $VERSION = "1.008";
my $re_real =
qr/
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)
</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" /> 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" /> 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" />
name - field name
field - entry from fields
object - source for defaults in edit mode
-:>
+-:>
<: .if object -:>
<: .set default = object.$name -:>
<: .elsif field.default -:>
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 :> />
<:.end if -:>
<:.end define -:>
-<:.define inlinefield -:>
+<:.define inlinefield; object: 0 -:>
<:# parameters:
name - the field name
field - a field, as an entry in fields
#!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);
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");
);
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");
}
{
#!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");
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;
projects / bse.git / commitdiff