]> git.imager.perl.org - bse.git/blobdiff - site/cgi-bin/modules/BSE/Edit/Article.pm
modify the image editor page to use new style markup
[bse.git] / site / cgi-bin / modules / BSE / Edit / Article.pm
index 392910fc2291703d96e528950ab91ca9108b3c30..a9db59ed28e701b0e69b8f51f67948dddf2e04be 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.044";
+our $VERSION = "1.056";
 
 =head1 NAME
 
@@ -73,7 +73,8 @@ sub article_dispatch {
   my $action;
   my %actions = $self->article_actions;
   for my $check (keys %actions) {
-    if ($cgi->param($check) || $cgi->param("$check.x")) {
+    if ($cgi->param($check) || $cgi->param("$check.x")
+       || $cgi->param("a_$check") || $cgi->param("a_$check.x")) {
       $action = $check;
       last;
     }
@@ -249,7 +250,7 @@ sub should_be_catalog {
 
   return $article->{parentid} && $parent &&
     ($article->{parentid} == $shopid || 
-     $parent->{generator} eq 'Generate::Catalog');
+     $parent->{generator} eq 'BSE::Generate::Catalog');
 }
 
 sub possible_parents {
@@ -260,7 +261,7 @@ sub possible_parents {
 
   my $shopid = $self->cfg->entryErr('articles', 'shop');
   my @parents = $articles->getBy('level', $article->{level}-1);
-  @parents = grep { $_->{generator} eq 'Generate::Article' 
+  @parents = grep { $_->{generator} eq 'BSE::Generate::Article' 
                      && $_->{id} != $shopid } @parents;
 
   # user can only select parent they can add to
@@ -366,7 +367,7 @@ sub iter_get_kids {
 
   my @children;
   $article->{id} or return;
-  if (UNIVERSAL::isa($article, 'Article')) {
+  if (UNIVERSAL::isa($article, 'BSE::TB::Article')) {
     @children = $article->children;
   }
   elsif ($article->{id}) {
@@ -566,8 +567,8 @@ sub iter_allkids {
 sub _load_step_kids {
   my ($article, $step_kids) = @_;
 
-  require OtherParents;
-  my @stepkids = OtherParents->getBy(parentId=>$article->{id}) if $article->{id};
+  require BSE::TB::OtherParents;
+  my @stepkids = BSE::TB::OtherParents->getBy(parentId=>$article->{id}) if $article->{id};
   %$step_kids = map { $_->{childId} => $_ } @stepkids;
   $step_kids->{loaded} = 1;
 }
@@ -673,8 +674,8 @@ sub iter_get_stepparents {
 
   return unless $article->{id} && $article->{id} > 0;
 
-  require OtherParents;
-  OtherParents->getBy(childId=>$article->{id});
+  require BSE::TB::OtherParents;
+  BSE::TB::OtherParents->getBy(childId=>$article->{id});
 }
 
 sub tag_ifStepParents {
@@ -1241,6 +1242,49 @@ sub _custom_fields {
   return \%active;
 }
 
+=back
+
+=head1 Common Edit Page Tags
+
+Variables:
+
+=over
+
+=item *
+
+C<article> - the article being edited.  This is a dummy article when a
+new article is being created.
+
+=item *
+
+C<isnew> - true if a new article is being created.
+
+=item *
+
+C<custom> - describes custom tags.
+
+=item *
+
+C<errors> - errors from the last submission of the page.
+
+=item *
+
+C<image_stores> - a function returning an array of possible image
+storages.
+
+=item *
+
+C<thumbs> - for the image list, whether thumbs should be displayed
+instead of full size images.
+
+=item *
+
+C<can_thumbs> - true if thumbnails are available.
+
+=back
+
+=cut
+
 sub low_edit_tags {
   my ($self, $acts, $request, $article, $articles, $msg, $errors) = @_;
 
@@ -1293,6 +1337,14 @@ sub low_edit_tags {
   # only return the fields that are defined
   $request->set_variable(custom => $custom);
   $request->set_variable(errors => $errors || {});
+  my $article_type = $cfg->entry('level names', $article->{level}, 'Article');
+  $request->set_variable(article_type => $article_type);
+  $request->set_variable(thumbs => defined $thumbs_obj);
+  $request->set_variable(can_thumbs => defined $thumbs_obj_real);
+  $request->set_variable(image_stores =>
+                        sub {
+                          $self->iter_image_stores;
+                        });
 
   return
     (
@@ -1300,7 +1352,7 @@ sub low_edit_tags {
      article => sub { tag_article($article, $cfg, $_[0]) },
      old => [ \&tag_old, $article, $cgi ],
      default => [ \&tag_default, $self, $request, $article ],
-     articleType => [ \&tag_art_type, $article->{level}, $cfg ],
+     articleType => escape_html($article_type),
      parentType => [ \&tag_art_type, $article->{level}-1, $cfg ],
      ifNew => [ \&tag_if_new, $article ],
      list => [ \&tag_list, $self, $article, $articles, $cgi, $request ],
@@ -1542,7 +1594,7 @@ sub _dummy_article {
   }
   
   my %article;
-  my @cols = Article->columns;
+  my @cols = BSE::TB::Article->columns;
   @article{@cols} = ('') x @cols;
   $article{id} = '';
   $article{parentid} = $parentid;
@@ -1557,7 +1609,14 @@ sub _dummy_article {
     return;
   }
 
-  return \%article;
+  return $self->_make_dummy_article(\%article);
+}
+
+sub _make_dummy_article {
+  my ($self, $article) = @_;
+
+  require BSE::DummyArticle;
+  return bless $article, "BSE::DummyArticle";
 }
 
 sub add_form {
@@ -1566,7 +1625,7 @@ sub add_form {
   return $self->low_edit_form($req, $article, $articles, $msg, $errors);
 }
 
-sub generator { 'Generate::Article' }
+sub generator { 'BSE::Generate::Article' }
 
 sub typename {
   my ($self) = @_;
@@ -1767,7 +1826,7 @@ sub _validate_tags {
     my $error;
     if ($tag =~ /\S/
        && !BSE::TB::Tags->valid_name($tag, \$error)) {
-      push @errors, "msg:bse/admin/edit/tags/invalid_$error";
+      push @errors, "msg:bse/admin/edit/tags/invalid/$error";
       $errors->{tags} = \@errors;
       ++$fail;
     }
@@ -1813,6 +1872,12 @@ sub save_new {
     $self->_validate_tags(\@tags, \%errors);
   }
 
+  my $meta;
+  if ($cgi->param("_save_meta")) {
+    require BSE::ArticleMetaMeta;
+    $meta = BSE::ArticleMetaMeta->retrieve($req, $article, \%errors);
+  }
+
   if (keys %errors) {
     if ($req->is_ajax) {
       return $req->json_content
@@ -1956,7 +2021,7 @@ sub save_new {
 
   my ($after_id) = $cgi->param("_after");
   if (defined $after_id) {
-    Articles->reorder_child($article->{parentid}, $article->{id}, $after_id);
+    BSE::TB::Articles->reorder_child($article->{parentid}, $article->{id}, $after_id);
     # reload, the displayOrder probably changed
     $article = $articles->getByPkey($article->{id});
   }
@@ -1966,6 +2031,10 @@ sub save_new {
     $article->set_tags([ grep /\S/, @tags ], \$error);
   }
 
+  if ($meta) {
+    BSE::ArticleMetaMeta->save($article, $meta);
+  }
+
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   if ($req->is_ajax) {
@@ -1996,7 +2065,7 @@ sub fill_old_data {
     $data->{body} =~ s/\x0D\x0A/\n/g;
     $data->{body} =~ tr/\r/\n/;
   }
-  for my $col (Article->columns) {
+  for my $col (BSE::TB::Article->columns) {
     next if $col =~ /^custom/;
     $article->{$col} = $data->{$col}
       if exists $data->{$col} && $col ne 'id' && $col ne 'parentid';
@@ -2065,6 +2134,8 @@ sub save_new_more {
   # nothing to do here
 }
 
+=over
+
 =item save
 
 Error codes:
@@ -2134,6 +2205,12 @@ sub save {
     $errors{template} = "Please only select templates from the list provided";
   }
 
+  my $meta;
+  if ($cgi->param("_save_meta")) {
+    require BSE::ArticleMetaMeta;
+    $meta = BSE::ArticleMetaMeta->retrieve($req, $article, \%errors);
+  }
+
   my $save_tags = $cgi->param("_save_tags");
   my @tags;
   if ($save_tags) {
@@ -2243,6 +2320,12 @@ sub save {
     $article->set_tags([ grep /\S/, @tags ], \$error);
   }
 
+use Data::Dumper;
+print STDERR Dumper($meta);
+  if ($meta) {
+    BSE::ArticleMetaMeta->save($article, $meta);
+  }
+
   # fix the kids too
   my @extra_regen;
   @extra_regen = $self->update_child_dynamic($article, $articles, $req);
@@ -2258,7 +2341,7 @@ sub save {
 
   my ($after_id) = $cgi->param("_after");
   if (defined $after_id) {
-    Articles->reorder_child($article->{parentid}, $article->{id}, $after_id);
+    BSE::TB::Articles->reorder_child($article->{parentid}, $article->{id}, $after_id);
     # reload, the displayOrder probably changed
     $article = $articles->getByPkey($article->{id});
   }
@@ -2492,12 +2575,13 @@ sub save_thumbnail {
     close OUTPUT
       or die "Could not close image output file: $!";
 
-    use Image::Size;
+    require BSE::ImageSize;
 
     if ($original && $original->{thumbImage}) {
       #unlink("$imagedir/$original->{thumbImage}");
     }
-    @$newdata{qw/thumbWidth thumbHeight/} = imgsize("$imagedir/$filename");
+    @$newdata{qw/thumbWidth thumbHeight/} =
+      BSE::ImageSize::imgsize("$imagedir/$filename");
     $newdata->{thumbImage} = $filename;
   }
 }
@@ -2602,7 +2686,7 @@ sub add_stepkid {
 
   my $after_id = $cgi->param("_after");
   if (defined $after_id) {
-    Articles->reorder_child($article->id, $child->id, $after_id);
+    BSE::TB::Articles->reorder_child($article->id, $child->id, $after_id);
   }
 
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
@@ -2707,7 +2791,7 @@ sub save_stepkids {
 
   my $cgi = $req->cgi;
   require 'BSE/Admin/StepParents.pm';
-  my @stepcats = OtherParents->getBy(parentId=>$article->{id});
+  my @stepcats = BSE::TB::OtherParents->getBy(parentId=>$article->{id});
   my %stepcats = map { $_->{parentId}, $_ } @stepcats;
   my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
   for my $stepcat (@stepcats) {
@@ -2806,24 +2890,24 @@ sub req_restepkid {
 
   # first, identify the stepkid link
   my $cgi = $req->cgi;
-  require OtherParents;
+  require BSE::TB::OtherParents;
   my $parentid = $cgi->param("parentid");
   defined $parentid
     or return $self->_service_error($req, $article, $articles, "Missing parentid", {}, "NOPARENTID");
   $parentid =~ /^\d+$/
     or return $self->_service_error($req, $article, $articles, "Invalid parentid", {}, "BADPARENTID");
 
-  my ($step) = OtherParents->getBy(parentId => $parentid, childId => $article->id)
+  my ($step) = BSE::TB::OtherParents->getBy(parentId => $parentid, childId => $article->id)
     or return $self->_service_error($req, $article, $articles, "Unknown relationship", {}, "NOTFOUND");
 
   my $newparentid = $cgi->param("newparentid");
   if ($newparentid) {
     $newparentid =~ /^\d+$/
       or return $self->_service_error($req, $article, $articles, "Bad new parent id", {}, "BADNEWPARENT");
-    my $new_parent = Articles->getByPkey($newparentid)
+    my $new_parent = BSE::TB::Articles->getByPkey($newparentid)
       or return $self->_service_error($req, $article, $articles, "Unknown new parent id", {}, "UNKNOWNNEWPARENT");
     my $existing = 
-      OtherParents->getBy(parentId=>$newparentid, childId=>$article->id)
+      BSE::TB::OtherParents->getBy(parentId=>$newparentid, childId=>$article->id)
        and return $self->_service_error($req, $article, $articles, "New parent is duplicate", {}, "NEWPARENTDUP");
 
     $step->{parentId} = $newparentid;
@@ -2832,7 +2916,7 @@ sub req_restepkid {
 
   my $after_id = $cgi->param("_after");
   if (defined $after_id) {
-    Articles->reorder_child($step->{parentId}, $article->id, $after_id);
+    BSE::TB::Articles->reorder_child($step->{parentId}, $article->id, $after_id);
   }
 
   if ($req->is_ajax) {
@@ -2940,7 +3024,7 @@ sub save_stepparents {
   my $cgi = $req->cgi;
 
   require 'BSE/Admin/StepParents.pm';
-  my @stepparents = OtherParents->getBy(childId=>$article->{id});
+  my @stepparents = BSE::TB::OtherParents->getBy(childId=>$article->{id});
   my %stepparents = map { $_->{parentId}, $_ } @stepparents;
   my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
   for my $stepparent (@stepparents) {
@@ -3249,7 +3333,7 @@ sub _service_error {
     $article = $self->_dummy_article($req, $articles, \$mymsg);
     $article ||=
       {
-       map $_ => '', Article->columns
+       map $_ => '', BSE::TB::Article->columns
       };
   }
 
@@ -3348,14 +3432,11 @@ sub _validate_image {
   }
   my $imagename = $filename;
   $imagename .= ''; # force it into a string
-  my $basename = '';
-  $imagename =~ tr/ //d;
-  $imagename =~ /([\w.-]+)$/ and $basename = $1;
+  (my $basename = $imagename) =~ tr/A-Za-z0-9_./-/cs;
 
-  # for OSs with special text line endings
-  use Image::Size;
+  require BSE::ImageSize;
 
-  my($width,$height, $type) = imgsize($fh);
+  my ($width,$height, $type) = BSE::ImageSize::imgsize($fh);
 
   unless (defined $width) {
     $$error = "Unknown image file type";
@@ -3903,7 +3984,6 @@ sub req_save_image {
          }
 
          my $full_filename = "$image_dir/$image_name";
-         require Image::Size;
          $delete_file = $image->{image};
          $image->{image} = $image_name;
          $image->{width} = $width;
@@ -4634,6 +4714,9 @@ sub req_edit_file {
 
   my @metafields = $file->metafields($self->cfg);
 
+  $req->set_variable(file => $file);
+  $req->set_variable(fields => { BSE::TB::ArticleFile->fields });
+
   my $it = BSE::Util::Iterate->new;
   my $current_meta;
   my %acts;
@@ -4706,6 +4789,7 @@ sub req_save_file {
   my $notes = $cgi->param("notes");
   defined $notes and $file->{notes} = $notes;
   my $name = $cgi->param("name");
+  require BSE::ImageSize;
   if (defined $name) {
     $file->{name} = $name;
     if (length $name) {
@@ -4720,70 +4804,8 @@ sub req_save_file {
     }
   }
 
-  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) = 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");
@@ -4875,12 +4897,7 @@ sub req_save_file {
       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) {
@@ -5064,7 +5081,7 @@ sub default_value {
 
   if ($col eq 'threshold') {
     my $parent = defined $article->{parentid} && $article->{parentid} != -1 
-      && Articles->getByPkey($article->{parentid}); 
+      && BSE::TB::Articles->getByPkey($article->{parentid}); 
 
     $parent and return $parent->{threshold};
     
@@ -5073,7 +5090,7 @@ sub default_value {
   
   if ($col eq 'summaryLength') {
     my $parent = defined $article->{parentid} && $article->{parentid} != -1 
-      && Articles->getByPkey($article->{parentid}); 
+      && BSE::TB::Articles->getByPkey($article->{parentid}); 
 
     $parent and return $parent->{summaryLength};
     
@@ -5307,13 +5324,13 @@ sub csrf_error {
   my $msg = $req->csrf_error;
   $errors{_csrfp} = $msg;
   my $mymsg;
-  $article ||= $self->_dummy_article($req, 'Articles', \$mymsg);
+  $article ||= $self->_dummy_article($req, 'BSE::TB::Articles', \$mymsg);
   unless ($article) {
     require BSE::Edit::Site;
     my $site = BSE::Edit::Site->new(cfg=>$req->cfg, db=> BSE::DB->single);
-    return $site->edit_sections($req, 'Articles', $mymsg);
+    return $site->edit_sections($req, 'BSE::TB::Articles', $mymsg);
   }
-  return $self->_service_error($req, $article, 'Articles', $msg, \%errors);
+  return $self->_service_error($req, $article, 'BSE::TB::Articles', $msg, \%errors);
 }
 
 =item a_csrp
@@ -5336,7 +5353,7 @@ sub req_csrfp {
                                    "Only usable from Ajax", undef, "NOTAJAX");
 
   $ENV{REQUEST_METHOD} eq 'POST'
-    or return $self->_service_error($req, $article, "Articles",
+    or return $self->_service_error($req, $article, "BSE::TB::Articles",
                                    "POST required for this action", {}, "NOTPOST");
 
   my %errors;
@@ -5372,7 +5389,7 @@ sub _article_kid_summary {
   if (--$depth > 0) {
     for my $kid (@kids) {
       $kid->{children} = [ _article_kid_summary($kid->{id}, $depth) ];
-      $kid->{allkids} = [ Articles->allkid_summary($kid->{id}) ];
+      $kid->{allkids} = [ BSE::TB::Articles->allkid_summary($kid->{id}) ];
     }
   }
 
@@ -5409,7 +5426,7 @@ sub req_tree {
      ],
      allkids =>
      [
-      Articles->allkid_summary($article->id)
+      BSE::TB::Articles->allkid_summary($article->id)
      ],
     );
 }