site/cgi-bin/modules/BSE/Mail/SMTP.pm
site/cgi-bin/modules/BSE/Message.pm
site/cgi-bin/modules/BSE/MessageScanner.pm
+site/cgi-bin/modules/BSE/MetaMeta.pm
+site/cgi-bin/modules/BSE/MetaOwnerBase.pm
site/cgi-bin/modules/BSE/NLFilter/SQL.pm
site/cgi-bin/modules/BSE/NotifyFiles.pm
site/cgi-bin/modules/BSE/Password.pod
site/cgi-bin/modules/BSE/TB/AdminUsers.pm
site/cgi-bin/modules/BSE/TB/Article.pm
site/cgi-bin/modules/BSE/TB/ArticleFile.pm
-site/cgi-bin/modules/BSE/TB/ArticleFileMeta.pm
-site/cgi-bin/modules/BSE/TB/ArticleFileMetas.pm
site/cgi-bin/modules/BSE/TB/ArticleFiles.pm
site/cgi-bin/modules/BSE/TB/Articles.pm
site/cgi-bin/modules/BSE/TB/AuditEntry.pm
site/cgi-bin/modules/BSE/TB/IPLockouts.pm
site/cgi-bin/modules/BSE/TB/Location.pm
site/cgi-bin/modules/BSE/TB/Locations.pm
+site/cgi-bin/modules/BSE/TB/Metadata.pm
+site/cgi-bin/modules/BSE/TB/MetaEntry.pm
site/cgi-bin/modules/BSE/TB/Order.pm
site/cgi-bin/modules/BSE/TB/OrderItem.pm
site/cgi-bin/modules/BSE/TB/OrderItemOption.pm
primary key (id)
);
+-- this now stores metadata for more than just files
drop table if exists bse_article_file_meta;
create table bse_article_file_meta (
id integer not null auto_increment primary key,
-- regenerated
appdata integer not null default 0,
- unique file_name(file_id, name)
+ -- owner type
+ owner_type varchar(20) not null default 'bse_file',
+
+ unique file_name(file_id, owner_type, name)
);
-- these are mailing list subscriptions
foreign key (tier_id) references bse_price_tiers(id)
on delete cascade on update restrict
-) engine=InnoDB;
\ No newline at end of file
+) engine=InnoDB;
}
}
- my @meta;
- my @meta_delete;
- my @metafields = grep !$_->ro, $file->metafields($self->cfg);
- my %current_meta = map { $_ => 1 } $file->metanames;
- for my $meta (@metafields) {
- my $name = $meta->name;
- my $cgi_name = "meta_$name";
- if ($cgi->param("delete_$cgi_name")) {
- for my $metaname ($meta->metanames) {
- push @meta_delete, $metaname
- if $current_meta{$metaname};
- }
- }
- 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)) {
- 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) =
- BSE::ImageSize::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,
- },
- );
- }
- else {
- $errors{$cgi_name} = $type;
- }
- }
- }
- }
- }
+ require BSE::FileMetaMeta;
+ my $meta = BSE::FileMetaMeta->retrieve($req, $file, \%errors);
if ($cgi->param('save_file_flags')) {
my $download = 0 + defined $cgi->param("download");
and $req->flash("Could not move $file->{displayName} to $storage: $@");
}
- for my $meta_delete (@meta_delete, map $_->{name}, @meta) {
- $file->delete_meta_by_name($meta_delete);
- }
- for my $meta (@meta) {
- $file->add_meta(%$meta, appdata => 1);
- }
+ BSE::FileMetaMeta->save($file, $meta);
# remove the replaced files
if (my ($old_name, $old_storage) = @old_file) {
package BSE::FileMetaMeta;
use strict;
-use Carp qw(confess);
+use base 'BSE::MetaMeta';
-our $VERSION = "1.000";
+our $VERSION = "1.001";
-my %meta_rules =
- (
- meta_real =>
- {
- match => qr/^\s*[+-]?(?:\d+(?:\.\d+)|\.\d+)(?:[eE][+-]?\d+)?\s*\z/,
- error => '$n must be a number',
- },
- );
-
-my %rule_map =
- (
- integer => "integer",
- string => "dh_one_line",
- real => "meta_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 $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;
-
- 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";
- }
-
- 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};
- }
- }
-
- ref $opts{rules} or $opts{rules} = [ split /[,;]/, $opts{rules} ];
-
- 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 };
- }
-
- bless \%opts, $class;
-}
-
-sub name { $_[0]{name} }
-
-sub type { $_[0]{type} }
-
-sub title { $_[0]{title} }
-
-sub rules { @{$_[0]{rules}} }
-
-sub values { @{$_[0]{values}} }
-
-sub labels { @{$_[0]{labels}} }
-
-sub ro { $_[0]{ro} }
-
-sub unit { $_[0]{unit} }
-
-sub is_text {
- $_[0]{type} ne "image";
-}
-
-sub cond {
- my ($self, $file) = @_;
-
- return $self->{cond}->($file);
-}
-
-sub validate {
- my ($self, %opts) = @_;
-
- my $value = delete $opts{value};
- defined $value
- or confess "value not supplied\n";
- my $rerror = delete $opts{error}
- or confess "error ref not supplied\n";
-
- # kind of clumsy
- require DevHelp::Validate;
- my @field_rules = $self->rules;
- $rule_map{$self->type} && unshift @field_rules, $rule_map{$self->type};
- my %values =
- (
- value => $value
- );
- my %fields =
- (
- value =>
- {
- rules => \@field_rules,
- description => $self->title,
- },
- );
- my %rules = %meta_rules;
- if ($self->type eq "enum") {
- $rules{meta_enum} =
- {
- match => "^(?:" . join("|", map quotemeta, $self->values) . ")\\z",
- error => '$n must be one of ' . join(", ", $self->values),
- };
- }
-
- my $val = DevHelp::Validate::Hash->new
- (
- fields => \%fields,
- rules => \%rules,
- cfg => $self->{cfg},
- section => "file metadata validation",
- );
- my %errors;
- $val->validate(\%values, \%errors);
- if (keys %errors) {
- $$rerror = $errors{value};
- return;
- }
-
- return 1;
-}
-
-sub metanames {
- my ($self) = @_;
-
- if ($self->type eq 'image') {
- return ( $self->data_name, $self->width_name, $self->height_name );
- }
- else {
- return $self->name;
- }
-}
-
-sub data_name {
- $_[0]{data_name}
-}
-
-sub width_name {
- $_[0]{width_name}
-}
-
-sub height_name {
- $_[0]{height_name}
-}
-
-sub keys {
- qw/title help rules ro values labels type data_name width_name height_name cond unit/;
+sub validation_section {
+ "file metadata validation";
}
1;
--- /dev/null
+package BSE::MetaMeta;
+use strict;
+use Carp qw(confess);
+use Image::Size;
+
+our $VERSION = "1.001";
+
+my %meta_rules =
+ (
+ meta_real =>
+ {
+ match => qr/^\s*[+-]?(?:\d+(?:\.\d+)|\.\d+)(?:[eE][+-]?\d+)?\s*\z/,
+ error => '$n must be a number',
+ },
+ );
+
+my %rule_map =
+ (
+ integer => "integer",
+ string => "dh_one_line",
+ real => "meta_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 $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;
+
+ 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";
+ }
+
+ 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};
+ }
+ }
+
+ ref $opts{rules} or $opts{rules} = [ split /[,;]/, $opts{rules} ];
+
+ 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 };
+ }
+
+ bless \%opts, $class;
+}
+
+sub name { $_[0]{name} }
+
+sub type { $_[0]{type} }
+
+sub title { $_[0]{title} }
+
+sub rules { @{$_[0]{rules}} }
+
+sub values { @{$_[0]{values}} }
+
+sub labels { @{$_[0]{labels}} }
+
+sub ro { $_[0]{ro} }
+
+sub unit { $_[0]{unit} }
+
+sub is_text {
+ $_[0]{type} ne "image";
+}
+
+sub cond {
+ my ($self, $file) = @_;
+
+ return $self->{cond}->($file);
+}
+
+sub validate {
+ my ($self, %opts) = @_;
+
+ my $value = delete $opts{value};
+ defined $value
+ or confess "value not supplied\n";
+ my $rerror = delete $opts{error}
+ or confess "error ref not supplied\n";
+
+ # kind of clumsy
+ require DevHelp::Validate;
+ my @field_rules = $self->rules;
+ $rule_map{$self->type} && unshift @field_rules, $rule_map{$self->type};
+ my %values =
+ (
+ value => $value
+ );
+ my %fields =
+ (
+ value =>
+ {
+ rules => \@field_rules,
+ description => $self->title,
+ },
+ );
+ my %rules = %meta_rules;
+ if ($self->type eq "enum") {
+ $rules{meta_enum} =
+ {
+ match => "^(?:" . join("|", map quotemeta, $self->values) . ")\\z",
+ error => '$n must be one of ' . join(", ", $self->values),
+ };
+ }
+
+ my $val = DevHelp::Validate::Hash->new
+ (
+ fields => \%fields,
+ rules => \%rules,
+ cfg => $self->{cfg},
+ section => $self->validation_section,
+ );
+ my %errors;
+ $val->validate(\%values, \%errors);
+ if (keys %errors) {
+ $$rerror = $errors{value};
+ return;
+ }
+
+ return 1;
+}
+
+sub metanames {
+ my ($self) = @_;
+
+ if ($self->type eq 'image') {
+ return ( $self->data_name, $self->width_name, $self->height_name );
+ }
+ else {
+ return $self->name;
+ }
+}
+
+sub data_name {
+ $_[0]{data_name}
+}
+
+sub width_name {
+ $_[0]{width_name}
+}
+
+sub height_name {
+ $_[0]{height_name}
+}
+
+sub keys {
+ qw/title help rules ro values labels type data_name width_name height_name cond unit/;
+}
+
+sub retrieve {
+ my ($class, $req, $owner, $errors) = @_;
+
+ my @meta;
+ my @meta_delete;
+ my $cgi = $req->cgi;
+ my @metafields = grep !$_->ro, $owner->metafields($req->cfg);
+ my %current_meta = map { $_ => 1 } $owner->metanames;
+ for my $meta (@metafields) {
+ my $name = $meta->name;
+ my $cgi_name = "meta_$name";
+ if ($cgi->param("delete_$cgi_name")) {
+ for my $metaname ($meta->metanames) {
+ push @meta_delete, $metaname
+ if $current_meta{$metaname};
+ }
+ }
+ 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)) {
+ 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,
+ },
+ );
+ }
+ else {
+ $errors->{$cgi_name} = $type;
+ }
+ }
+ }
+ }
+ }
+
+ return { meta => \@meta, delete => \@meta_delete };
+}
+
+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 (@{$meta->{meta}}) {
+ $owner->add_meta(%$meta, appdata => 1);
+ }
+
+ 1;
+}
+
+1;
--- /dev/null
+package BSE::MetaOwnerBase;
+use strict;
+
+our $VERSION = "1.000";
+
+sub clear_metadata {
+ my ($self) = @_;
+
+ BSE::DB->run(bseClearArticleFileMetadata => $self->id, $self->meta_owner_type);
+}
+
+sub clear_app_metadata {
+ my ($self) = @_;
+
+ BSE::DB->run(bseClearArticleFileAppMetadata => $self->id, $self->meta_owner_type);
+}
+
+sub clear_sys_metadata {
+ my ($self) = @_;
+
+ BSE::DB->run(bseClearArticleFileSysMetadata => $self->id, $self->meta_owner_type);
+}
+
+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);
+}
+
+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 metadata {
+ my ($self) = @_;
+
+ require BSE::TB::Metadata;
+ return BSE::TB::Metadata->getBy
+ (
+ file_id => $self->id,
+ owner_type => $self->meta_owner_type,
+ );
+}
+
+sub text_metadata {
+ my ($self) = @_;
+
+ require BSE::TB::Metadata;
+ return BSE::TB::Metadata->getBy
+ (
+ file_id => $self->id,
+ owner_type => $self->meta_owner_type,
+ content_type => "text/plain",
+ );
+}
+
+sub meta_by_name {
+ my ($self, $name) = @_;
+
+ require BSE::TB::Metadata;
+ my ($result) = BSE::TB::Metadata->getBy
+ (
+ file_id => $self->id,
+ owner_type => $self->meta_owner_type,
+ name => $name
+ )
+ or return;
+
+ return $result;
+}
+
+1;
package BSE::TB::ArticleFile;
use strict;
# represents a file associated with an article from the database
-use Squirrel::Row;
-use vars qw/@ISA/;
-@ISA = qw/Squirrel::Row/;
+use base qw(Squirrel::Row BSE::MetaOwnerBase);
use Carp 'confess';
our $VERSION = "1.011";
return BSE::TB::ArticleFiles->handler($self->file_handler, $cfg);
}
-sub clear_metadata {
- my ($self) = @_;
-
- BSE::DB->run(bseClearArticleFileMetadata => $self->{id});
-}
-
-sub clear_app_metadata {
- my ($self) = @_;
-
- BSE::DB->run(bseClearArticleFileAppMetadata => $self->{id});
-}
-
-sub clear_sys_metadata {
- my ($self) = @_;
-
- BSE::DB->run(bseClearArticleFileSysMetadata => $self->{id});
-}
-
-sub delete_meta_by_name {
- my ($self, $name) = @_;
-
- BSE::DB->run(bseDeleteArticleFileMetaByName => $self->{id}, $name);
-}
-
sub set_handler {
my ($self, $cfg) = @_;
return;
}
-sub add_meta {
- my ($self, %opts) = @_;
-
- require BSE::TB::ArticleFileMetas;
- return BSE::TB::ArticleFileMetas->make
- (
- file_id => $self->{id},
- %opts,
- );
-}
-
-sub metadata {
- my ($self) = @_;
-
- require BSE::TB::ArticleFileMetas;
- return BSE::TB::ArticleFileMetas->getBy
- (
- file_id => $self->id
- );
-}
-
-sub text_metadata {
- my ($self) = @_;
-
- require BSE::TB::ArticleFileMetas;
- return BSE::TB::ArticleFileMetas->getBy
- (
- file_id => $self->id,
- content_type => "text/plain",
- );
-}
-
-sub meta_by_name {
- my ($self, $name) = @_;
-
- require BSE::TB::ArticleFileMetas;
- my ($result) = BSE::TB::ArticleFileMetas->getBy
- (
- file_id => $self->id,
- name => $name
- )
- or return;
-
- return $result;
-}
-
sub inline {
my ($file, %opts) = @_;
push @$warnings, "msg:bse/admin/edit/file/save/delfromstore:$msg";
};
}
+}
+sub meta_owner_type {
+ 'bse_file';
}
1;
+++ /dev/null
-package BSE::TB::ArticleFileMeta;
-use strict;
-use base 'Squirrel::Row';
-
-our $VERSION = "1.000";
-
-sub table {
- "bse_article_file_meta";
-}
-
-sub columns {
- qw/id file_id name content_type value appdata/;
-}
-
-sub defaults {
- content_type => "text/plain",
- appdata => 1,
-}
-
-sub is_text {
- $_[0]->content_type eq "text/plain"
-}
-
-1;
+++ /dev/null
-package BSE::TB::ArticleFileMetas;
-use strict;
-use base 'Squirrel::Table';
-use BSE::TB::ArticleFileMeta;
-
-our $VERSION = "1.000";
-
-sub rowClass { "BSE::TB::ArticleFileMeta" }
-
-1;
--- /dev/null
+package BSE::TB::MetaEntry;
+use strict;
+use base 'Squirrel::Row';
+
+our $VERSION = "1.001";
+
+sub table {
+ "bse_article_file_meta";
+}
+
+sub columns {
+ qw/id file_id name content_type value appdata owner_type/;
+}
+
+sub defaults {
+ content_type => "text/plain",
+ appdata => 1,
+}
+
+sub is_text {
+ $_[0]->content_type eq "text/plain"
+}
+
+1;
--- /dev/null
+package BSE::TB::Metadata;
+use strict;
+use base 'Squirrel::Table';
+use BSE::TB::MetaEntry;
+
+our $VERSION = "1.001";
+
+sub rowClass { "BSE::TB::MetaEntry" }
+
+1;
sql_statement: <<SQL
delete from bse_article_file_meta
where file_id = ?
+ and owner_type = ?
SQL
name: bseClearArticleFileAppMetadata
sql_statement: <<SQL
delete from bse_article_file_meta
-where file_id = ? and appdata <> 0
+where file_id = ?
+ and appdata <> 0
+ and owner_type = ?
SQL
name: bseClearArticleFileSysMetadata
sql_statement: <<SQL
delete from bse_article_file_meta
-where file_id = ? and appdata = 0
+where file_id = ?
+ and appdata = 0
+ and owner_type = ?
SQL
name: bseDeleteArticleFileMetaByName
sql_statement: <<SQL
delete from bse_article_file_meta
-where file_id = ? and name = ?
+where file_id = ?
+ and name = ?
+ and owner_type = ?
SQL
name: bseArticleKidSummary
Column content_type;varchar(80);NO;text/plain;
Column value;longblob;NO;NULL;
Column appdata;int(11);NO;0;
+Column owner_type;varchar(20);NO;bse_file;
Index PRIMARY;1;[id]
-Index file_name;1;[file_id;name]
+Index file_name;1;[file_id;owner_type;name]
Table bse_article_groups
Engine InnoDB
Column article_id;int(11);NO;NULL;
projects / bse.git / commitdiff