expand the API to simplify working with article images and files
authorTony Cook <tony@develop-help.com>
Tue, 30 Aug 2011 06:57:31 +0000 (16:57 +1000)
committerTony Cook <tony@develop-help.com>
Tue, 30 Aug 2011 06:57:31 +0000 (16:57 +1000)
16 files changed:
MANIFEST
site/cgi-bin/modules/BSE/API.pm
site/cgi-bin/modules/BSE/Cache.pm
site/cgi-bin/modules/BSE/Cache/Cache.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Edit/Base.pm
site/cgi-bin/modules/BSE/TB/ArticleFile.pm
site/cgi-bin/modules/BSE/TB/Image.pm
site/cgi-bin/modules/BSE/TB/Images.pm
site/cgi-bin/modules/DevHelp/Cfg.pm
site/cgi-bin/modules/DevHelp/FileUpload.pm
site/data/db/bse_msg_base.data
site/data/db/bse_msg_defaults.data
t/data/govhouse.jpg [new file with mode: 0644]
t/data/t101.jpg [new file with mode: 0644]
t/t15api.t [new file with mode: 0644]

index 3677845..09f13e1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -799,6 +799,7 @@ t/cfg/cfg/00start.cfg
 t/cfg/cfg/99end.cfg
 t/cfg/isafile.cfg
 t/cfg/t/varinc.cfg
+t/data/t101.jpg
 t/t000load.t
 t/t00smoke.t                   makes a request to most of the scripts
 t/t010template.t               Tests Squirrel::Template
@@ -818,6 +819,7 @@ t/t11save.t
 t/t12cat.t
 t/t13parent.t
 t/t13steps.t
+t/t15api.t
 t/t20gen.t
 t/t21gencat.t                  Tests catalog generation
 t/t30rules.t                   Check for use strict and warnings
index d328620..ace5222 100644 (file)
@@ -1,17 +1,16 @@
 package BSE::API;
 use strict;
-use vars qw(@ISA @EXPORT_OK);
 use BSE::Util::SQL qw(sql_datetime now_sqldatetime);
 use BSE::DB;
 use BSE::Cfg;
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(bse_init bse_cfg bse_make_product bse_make_catalog bse_encoding bse_add_image bse_add_step_child bse_add_owned_file bse_delete_owned_file bse_replace_owned_file bse_make_article bse_add_step_parent);
+use Exporter qw(import);
+our @EXPORT_OK = qw(bse_init bse_cfg bse_make_product bse_make_catalog bse_encoding bse_add_image bse_save_image bse_add_step_child bse_add_owned_file bse_delete_owned_file bse_replace_owned_file bse_make_article bse_add_step_parent);
+our %EXPORT_TAGS = ( all => \@EXPORT_OK );
 use Carp qw(confess croak);
 use Fcntl qw(:seek);
 use Cwd;
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
 my %acticle_defaults =
   (
@@ -49,6 +48,7 @@ my %acticle_defaults =
    titleAlias => '',
    linkAlias => '',
    category => '',
+   parentid => -1,
   );
 
 my %product_defaults =
@@ -224,8 +224,6 @@ sub bse_make_article {
 
   defined $opts{title} && length $opts{title}
     or confess "Missing title option\n";
-  defined $opts{body} && length $opts{body}
-    or confess "Missing body option\n";
 
   $opts{summary} ||= $opts{title};
   unless ($opts{displayOrder}) {
@@ -299,24 +297,70 @@ sub bse_add_image {
   my $editor;
   ($editor, $article) = _load_editor_class($article, $cfg);
 
-  my %image;
-  my $file = delete $opts{file};
-  $file
-    or croak "Missing image filename";
-  open IN, "< $file"
-    or croak "Failed opening image file $file: $!";
-  binmode IN;
+  my $fh;
+
+  my $filename = delete $opts{file};
+  if ($filename) {
+    open $fh, "< $filename"
+      or croak "Failed opening image file $filename: $!";
+    binmode $fh;
+  }
+  elsif ($opts{fh}) {
+    $filename = $opts{display_name}
+      or confess "No image display name supplied with fh";
+    $fh = $opts{fh};
+  }
+  else {
+    confess "Missing fh or file parameter";
+  }
   my %errors;
 
   $editor->do_add_image
     (
      $cfg,
      $article,
-     *IN,
+     $fh,
+     %opts,
+     errors => $opts{errors} || \%errors,
+     filename => $filename,
+    );
+}
+
+sub bse_language {
+  return $cfg->entry("site", "language", "en_AU");
+}
+
+{
+  my $msgs;
+
+  sub bse_msg_text {
+    my ($lang, $id, $parms, $def) = @_;
+
+    unless ($msgs) {
+      require BSE::Message;
+      $msgs = BSE::Message->new;
+    }
+
+    return $msgs->text($lang, $id, $parms, $def);
+  }
+}
+
+sub bse_save_image {
+  my ($image, %opts) = @_;
+
+  my @warn;
+  my $result = $image->update
+    (
+     _language => bse_language(),
+     _actor => "S",
+     _warnings => \@warn,
      %opts,
-     errors => \%errors,
-     filename => $file,
     );
+  if (@warn) {
+    warn "$_\n" for @warn;
+  }
+
+  return $result;
 }
 
 sub _load_editor_class {
index 99b8a42..1e8d306 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::Cache;
 use strict;
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
 sub load {
   my ($class, $cfg) = @_;
@@ -11,8 +11,27 @@ sub load {
   defined $cache_class
     or return;
   ( my $cache_mod_file = $cache_class . ".pm" ) =~ s(::)(/)g;
-  require $cache_mod_file;
-  return $cache_class->new($cfg);
+  my $result = eval {
+    require $cache_mod_file;
+    return $cache_class->new($cfg);
+  };
+  unless ($result) {
+    require BSE::TB::AuditLog;
+    BSE::TB::AuditLog->log
+       (
+        component => "cache::load",
+        level => "error",
+        actor => "S",
+        msg => "Failed to load or create cache object: $@",
+        dump => <<EOS
+Class: $cache_class
+Module: $cache_mod_file
+Error: $@
+EOS
+       );
+  }
+
+  return $result;
 }
 
 1;
index c308cb7..02b716c 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::Cache::Cache;
 use strict;
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
 # BSE cache interface for Cache interface compatible caches.
 
@@ -34,11 +34,18 @@ sub set {
 sub get {
   my ($self, $key) = @_;
 
-  my $entry = $self->{cache}->entry($key);
-  $entry->exists
-    or return;
+  my $result;
+  eval {
+    my $entry = $self->{cache}->entry($key);
+    $entry->exists
+      or return;
+
+    $result = $entry->thaw;
+  } or do {
+    return;
+  };
 
-  return $entry->thaw;
+  return $result;
 }
 
 sub delete {
index 606a6e8..8c3147a 100644 (file)
@@ -14,7 +14,7 @@ use DevHelp::Date qw(dh_parse_date dh_parse_sql_date);
 use List::Util qw(first);
 use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
 
-our $VERSION = "1.010";
+our $VERSION = "1.011";
 
 =head1 NAME
 
@@ -3115,14 +3115,12 @@ sub _service_success {
     };
 }
 
+# FIXME: eliminate this method and call get_ftype directly
 sub _image_ftype {
   my ($self, $type) = @_;
 
-  if ($type eq 'CWS' || $type eq 'SWF') {
-    return "flash";
-  }
-
-  return "img";
+  require BSE::TB::Images;
+  return BSE::TB::Images->get_ftype($type);
 }
 
 sub do_add_image {
@@ -3186,7 +3184,7 @@ sub do_add_image {
     $errors->{image} = $msg;
     return;
   }
-print STDERR "Gen filename '$filename'\n";
+
   # for OSs with special text line endings
   binmode $fh;
 
@@ -3323,9 +3321,8 @@ sub add_image {
 sub _image_manager {
   my ($self) = @_;
 
-  require BSE::StorageMgr::Images;
-
-  return BSE::StorageMgr::Images->new(cfg => $self->cfg);
+  require BSE::TB::Images;
+  return BSE::TB::Images->storage_manager;
 }
 
 # remove an image
index a9833a4..e7cb5f9 100644 (file)
@@ -1,14 +1,13 @@
 package BSE::Edit::Base;
 use strict;
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
 # one day I might put something useful here
 sub new {
   my ($class, %parms) = @_;
 
-  $parms{cfg}
-    or die "Missing cfg parameter";
+  $parms{cfg} ||= BSE::Cfg->single;
 
   return bless \%parms, $class;
 }
index fa40bbb..32f9275 100644 (file)
@@ -6,7 +6,7 @@ use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row/;
 use Carp 'confess';
 
-our $VERSION = "1.003";
+our $VERSION = "1.004";
 
 sub columns {
   return qw/id articleId displayName filename sizeInBytes description 
@@ -370,4 +370,142 @@ sub downloadable_by {
   return 1;
 }
 
+sub update {
+  my ($self, %opts) = @_;
+
+  my $actor = $opts{_actor}
+    or confess "Missing _actor parameter";
+
+  my $warnings = $opts{_warnings}
+    or confess "Missing _warnings parameter";
+
+  my $cfg = BSE::Cfg->single;
+  my $file_dir = BSE::TB::ArticleFiles->download_path($cfg);
+  my $old_storage = $self->storage;
+  my $delete_file;
+  if ($opts{filename} || $opts{file}) {
+    my $src_filename = delete $opts{filename};
+    my $filename;
+    if ($src_filename) {
+      if ($src_filename =~ /^\Q$file_dir\E/) {
+       # created in the right place, use it
+       $filename = $src_filename;
+      }
+      else {
+       open my $in_fh, "<", $src_filename
+         or die "Cannot open $src_filename: $!\n";
+       binmode $in_fh;
+
+       require DevHelp::FileUpload;
+       my $msg;
+       ($filename) = DevHelp::FileUpload->
+         make_img_copy($file_dir, $opts{displayName}, \$msg)
+           or die "$msg\n";
+      }
+    }
+    elsif ($opts{file}) {
+      my $file = delete $opts{file};
+      require DevHelp::FileUpload;
+      my $msg;
+      ($filename) = DevHelp::FileUpload->
+       make_fh_copy($file, $file_dir, $opts{displayName}, \$msg)
+         or die "$msg\n";
+    }
+
+    my $fullpath = $file_dir . '/' . $filename;
+    $self->set_filename($filename);
+    $self->set_sizeInBytes(-s $fullpath);
+    $self->setDisplayName($opts{displayName});
+
+    unless ($opts{contentType}) {
+      require BSE::Util::ContentType;
+      $self->set_contentType(BSE::Util::ContentType::content_type($cfg, $opts{displayName}));
+    }
+
+    $self->set_handler($cfg);
+  }
+
+  my $type = delete $opts{contentType};
+  if (defined $type) {
+    $self->set_contentType($type);
+  }
+
+  my $name = $opts{name};
+  $self->id != -1 || defined $name && $name =~ /\S/
+    or die "name is required for global files\n";
+  if (defined $name && $name =~ /\S/) {
+    $name =~ /^\w+$/
+      or die "name must be a single word\n";
+    my ($other) = BSE::TB::ArticleFiles->getBy(articleId => $self->id,
+                                              name => $name);
+    $other && $other->id != $self->id
+      and die "Duplicate file name (identifier)\n";
+
+    $self->set_name($name);
+  }
+
+  $self->save;
+
+  my $mgr = BSE::TB::ArticleFiles->file_manager($cfg);
+  if ($delete_file) {
+    if ($old_storage ne "local") {
+      $mgr->unstore($delete_file);
+    }
+    unlink "$file_dir/$delete_file";
+
+    $old_storage = "local";
+  }
+
+  my $storage = delete $opts{storage} || '';
+
+  my $new_storage;
+  eval {
+    $new_storage = 
+      $mgr->select_store($self->filename, $storage, $self);
+    if ($old_storage ne $new_storage) {
+      # handles both new images (which sets storage to local) and changing
+      # the storage for old images
+      my $src = $mgr->store($self->filename, $new_storage, $self);
+      $self->set_src($src);
+      $self->set_storage($new_storage);
+      $self->save;
+    }
+    1;
+  } or do {
+    my $msg = $@;
+    chomp $msg;
+    require BSE::TB::AuditLog;
+    BSE::TB::AuditLog->log
+      (
+       component => "admin:edit:saveimage",
+       level => "warn",
+       object => $self,
+       actor => $actor,
+       msg => "Error saving file to storage $new_storage: $msg",
+      );
+    push @$warnings, "msg:bse/admin/edit/file/save/savetostore:$msg";
+  };
+
+  if ($self->storage ne $old_storage && $old_storage ne "local") {
+    eval {
+      $mgr->unstore($self->filename, $old_storage);
+      1;
+    } or do {
+      my $msg = $@;
+      chomp $msg;
+      require BSE::TB::AuditLog;
+      BSE::TB::AuditLog->log
+       (
+        component => "admin:edit:savefile",
+        level => "warn",
+        object => $self,
+        actor => $actor,
+        msg => "Error saving file to storage $new_storage: $msg",
+       );
+      push @$warnings, "msg:bse/admin/edit/file/save/delfromstore:$msg";
+    };
+  }
+
+}
+
 1;
index ddd3ce6..068e39d 100644 (file)
@@ -7,7 +7,7 @@ use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row BSE::ThumbCommon/;
 use Carp qw(confess);
 
-our $VERSION = "1.002";
+our $VERSION = "1.003";
 
 sub columns {
   return qw/id articleId image alt width height url displayOrder name
@@ -62,7 +62,7 @@ sub popimage {
 sub image_url {
   my ($im) = @_;
 
-  $im->src || "/images/$im->{image}";
+  return $im->src || BSE::TB::Images->base_uri . $im->image;
 }
 
 sub json_data {
@@ -101,4 +101,172 @@ sub filename {
   return $self->image;
 }
 
+sub article {
+  my ($self) = @_;
+
+  if ($self->articleId == -1) {
+    require BSE::TB::Site;
+    return BSE::TB::Site->new;
+  }
+  else {
+    require Articles;
+    return Articles->getByPkey($self->articleId);
+  }
+}
+
+sub update {
+  my ($image, %opts) = @_;
+
+  my $errors = delete $opts{errors}
+    or confess "Missing errors parameter";
+
+  my $actor = $opts{_actor}
+    or confess "Missing _actor parameter";
+
+  my $warnings = $opts{_warnings}
+    or confess "Missing _warnings parameter";
+
+  require BSE::CfgInfo;
+  my $cfg = BSE::Cfg->single;
+  my $image_dir = BSE::CfgInfo::cfg_image_dir($cfg);
+  my $fh = $opts{fh};
+  my $fh_field = "fh";
+  my $delete_file;
+  my $old_storage = $image->storage;
+  my $filename;
+  if ($fh) {
+    $filename = $opts{display_name}
+      or confess "Missing display_name";
+  }
+  elsif ($opts{file}) {
+    unless (open $fh, "<", $opts{file}) {
+      $errors->{filename} = "Cannot open $opts{file}: $!";
+      return;
+    }
+    $fh_field = "file";
+    $filename = $opts{file};
+  }
+  if ($fh) {
+    local $SIG{__DIE__};
+    eval {
+      my $msg;
+      require DevHelp::FileUpload;
+      my ($image_name) = DevHelp::FileUpload->
+       make_fh_copy($fh, $image_dir, $filename, \$msg)
+         or die "$msg\n";
+
+      my $full_filename = "$image_dir/$image_name";
+      require Image::Size;
+      my ($width, $height, $type) = Image::Size::imgsize($full_filename);
+      if ($width) {
+       $delete_file = $image->image;
+       $image->set_image($image_name);
+       $image->set_width($width);
+       $image->set_height($height);
+       $image->set_storage("local");
+       $image->set_src(BSE::TB::Images->base_uri . $image_name);
+       $image->set_ftype(BSE::TB::Images->get_ftype($type));
+      }
+      else {
+       die "$type\n";
+      }
+
+      1;
+    } or do {
+      chomp($errors->{$fh_field} = $@);
+    };
+  }
+
+  my $name = $opts{name};
+  if (defined $name) {
+    unless ($name =~ /^[a-z_]\w*$/i) {
+      $errors->{name} = "msg:bse/admin/edit/image/save/nameformat:$name";
+    }
+    if (!$errors->{name} && length $name && $name ne $image->name) {
+      # check for a duplicate
+      my @other_images = grep $_->id != $image->id, $image->article->images;
+      if (grep $name eq $_->name, @other_images) {
+       $errors->{name} = "msg:bse/admin/edit/image/save/namedup:$name";
+      }
+    }
+  }
+
+  if (defined $opts{alt}) {
+    $image->set_alt($opts{alt});
+  }
+
+  if (defined $opts{url}) {
+    $image->set_url($opts{url});
+  }
+
+  keys %$errors
+    and return;
+
+  my $new_storage = $opts{storage};
+  defined $new_storage or $new_storage = $image->storage;
+  $image->save;
+
+  my $mgr = BSE::TB::Images->storage_manager;
+
+  if ($delete_file) {
+    if ($old_storage ne "local") {
+      $mgr->unstore($delete_file);
+    }
+    unlink "$image_dir/$delete_file";
+
+    $old_storage = "local";
+  }
+
+  # try to set the storage, this failing doesn't fail the save
+  eval {
+    $new_storage = 
+      $mgr->select_store($image->image, $new_storage, $image);
+    if ($image->storage ne $new_storage) {
+      # handles both new images (which sets storage to local) and changing
+      # the storage for old images
+      $old_storage = $image->storage;
+      my $src = $mgr->store($image->image, $new_storage, $image);
+      $image->set_src($src);
+      $image->set_storage($new_storage);
+      $image->save;
+    }
+    1;
+  } or do {
+    my $msg = $@;
+    chomp $msg;
+    require BSE::TB::AuditLog;
+    BSE::TB::AuditLog->log
+      (
+       component => "admin:edit:saveimage",
+       level => "warn",
+       object => $image,
+       actor => $actor,
+       msg => "Error saving image to storage $new_storage: $msg",
+      );
+    push @$warnings, "msg:bse/admin/edit/image/save/savetostore:$msg";
+  };
+
+  if ($image->storage ne $old_storage && $old_storage ne "local") {
+    eval {
+      $mgr->unstore($image->image, $old_storage);
+      1;
+    } or do {
+      my $msg = $@;
+      chomp $msg;
+      require BSE::TB::AuditLog;
+      BSE::TB::AuditLog->log
+       (
+        component => "admin:edit:saveimage",
+        level => "warn",
+        object => $image,
+        actor => $actor,
+        msg => "Error saving image to storage $new_storage: $msg",
+       );
+      push @$warnings, "msg:bse/admin/edit/image/save/delfromstore:$msg";
+    };
+  }
+
+  return 1;
+}
+
 1;
index 28c992b..f02820b 100644 (file)
@@ -5,7 +5,7 @@ use vars qw(@ISA $VERSION);
 @ISA = qw(Squirrel::Table);
 use BSE::TB::Image;
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
 sub rowClass {
   return 'BSE::TB::Image';
@@ -21,4 +21,45 @@ sub image_dir {
   return BSE::CfgInfo::cfg_image_dir(BSE::Cfg->single);
 }
 
+=item base_uri
+
+Return the base URI for images stored in the image_dir().
+
+Traditionally C</images/>, but it's meant to be configurable.
+
+=cut
+
+sub base_uri {
+  return BSE::Cfg->single->entryIfVar("site", "images", "/images/");
+}
+
+=item get_ftype($is_type)
+
+Translate an Image::Size file type into a value for the ftype
+attribute.
+
+=cut
+
+sub get_ftype {
+  my ($self, $type) = @_;
+
+  if ($type eq 'CWS' || $type eq 'SWF') {
+    return "flash";
+  }
+
+  return "img";
+}
+
+=item storage_manager
+
+Return the images storage manager.
+
+=cut
+
+sub storage_manager {
+  require BSE::StorageMgr::Images;
+
+  return BSE::StorageMgr::Images->new(cfg => BSE::Cfg->single);
+}
+
 1;
index 2919c3a..2c3d484 100644 (file)
@@ -6,7 +6,7 @@ use constant CFG_DEPTH => 5; # unused so far
 use constant CACHE_AGE => 30;
 use constant VAR_DEPTH => 10;
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
 my %cache;
 
@@ -218,22 +218,22 @@ sub entryVar {
   $value;
 }
 
-=item entryIfVar($section, $key)
+=item entryIfVar($section, $key, $def)
 
-Same as entryVar(), except that it returns undef if there is no value
+Same as entryVar(), except that it returns $def if there is no value
 for the given section/key.
 
 =cut
 
 sub entryIfVar {
-  my ($self, $section, $key) = @_;
+  my ($self, $section, $key, $def) = @_;
 
   my $value = $self->entry($section, $key);
   if (defined $value) {
-    $value = $self->entryVar($section, $key);
+    return $self->entryVar($section, $key);
   }
 
-  $value;
+  return $def;
 }
 
 =item entryBool($section, $key, [ $def ])
index cfb679f..3e9e7d4 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use IO::File;
 use File::Copy;
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
 =head1 NAME
 
@@ -51,6 +51,32 @@ sub make_img_copy {
   return $newname;
 }
 
+=item DevHelp::FileUpload->make_fh_copy($fh, $imgdir, $name, \$msg)
+
+=cut
+
+sub make_fh_copy {
+  my ($class, $fh, $imgdir, $name, $rmsg) = @_;
+
+  my ($newname, $out_fh) = $class->make_img_filename($imgdir, $name, $rmsg)
+    or return;
+
+  # $fh might be a CGI.pm special that confuses File::Copy
+  local $/ = \8192;
+  binmode $fh;
+  binmode $out_fh;
+  while (my $block = <$fh>) {
+    print $out_fh $block;
+  }
+  unless (close $out_fh) {
+    $$rmsg = "Cannot write work file: $!";
+    unlink "$imgdir/$newname";
+    return;
+  }
+
+  return $newname;
+}
+
 =item DevHelp::FileUpload->make_img_filename($imgdir, $name, \$msg)
 
 =cut
index dc0b690..525fb66 100644 (file)
@@ -71,6 +71,36 @@ description: BSE Administration
 id: bse/admin/edit/
 description: Article editor messages
 
+id: bse/admin/edit/image/
+description: Article editor image messages
+
+id: bse/admin/edit/image/save/
+description: Messages from saving images
+
+id: bse/admin/edit/image/save/namedup
+description: Message for a duplicate image name ($1 - the offending name)
+
+id: bse/admin/edit/image/save/nameformat
+description: Message for an invalid name ($1 - the offending name)
+
+id: bse/admin/edit/image/save/delfromstore
+description: If the image couldn't be deleted from an external store ($1 - the back end error message)
+
+id: bse/admin/edit/image/save/savetostore
+description: If the image couldn't saved to an external store ($1 - the back end error message)
+
+id: bse/admin/edit/file/
+description: Article file manipulation
+
+id: bse/admin/edit/file/save/
+description: Saving an article file
+
+id: bse/admin/edit/file/save/savetostore
+description: If the file couldn't saved to an external store ($1 - the back end error message)
+
+id: bse/admin/edit/file/save/delfromstore
+description: If the image couldn't be deleted from an external store ($1 - the back end error message)
+
 id: bse/admin/edit/uplabelsect
 description: label in parent list to make article a section
 
index 2e8392a..0ea8075 100644 (file)
@@ -1,5 +1,5 @@
 ---
-# VERSION=1.002
+# VERSION=1.003
 # defaults for the following
 language_code: en
 priority: 0
@@ -37,6 +37,24 @@ message: You haven't paid the order containing this file
 id: bse/user/downloaderror/unfilled
 message: The order containing this file hasn't been filled.  Please contact us.
 
+id: bse/admin/edit/image/save/nameformat
+message: Image identifiers must be a letter or underscore followed by zero or more letters, underscores or digits
+
+id: bse/admin/edit/image/save/namedup
+message: Duplicate image identifier '$1'
+
+id: bse/admin/edit/image/save/savetostore
+message: Could not save image to external store: $1
+
+id: bse/admin/edit/image/save/delfromstore
+message: Could not delete image from external store: $1
+
+id: bse/admin/edit/file/save/savetostore
+message: Could not save file to external store: $1
+
+id: bse/admin/edit/file/save/delfromstore
+message: Could not delete file from external store: $1
+
 id: bse/admin/edit/uplabelsect
 message: -- move up a level -- become a section
 
diff --git a/t/data/govhouse.jpg b/t/data/govhouse.jpg
new file mode 100644 (file)
index 0000000..2a9107d
Binary files /dev/null and b/t/data/govhouse.jpg differ
diff --git a/t/data/t101.jpg b/t/data/t101.jpg
new file mode 100644 (file)
index 0000000..9ca9f0b
Binary files /dev/null and b/t/data/t101.jpg differ
diff --git a/t/t15api.t b/t/t15api.t
new file mode 100644 (file)
index 0000000..26a4d66
--- /dev/null
@@ -0,0 +1,66 @@
+#!perl -w
+use strict;
+use BSE::Test ();
+use Test::More tests => 16;
+use File::Spec;
+use Carp qw(confess);
+
+$SIG{__DIE__} = sub { confess @_ };
+
+BEGIN {
+  unshift @INC, File::Spec->catdir(BSE::Test::base_dir(), "cgi-bin", "modules");
+}
+
+BEGIN { use_ok("BSE::API", ":all") }
+
+my $base_cgi = File::Spec->catdir(BSE::Test::base_dir(), "cgi-bin");
+ok(bse_init($base_cgi),   "initialize api")
+  or print "# failed to bse_init in $base_cgi\n";
+my $cfg = bse_cfg();
+ok($cfg, "we have a cfg object");
+
+my $art = bse_make_article(cfg => $cfg,
+                          title => "API test");
+ok($art, "make a basic article");
+
+my $im1 = bse_add_image($cfg, $art, file => "t/data/t101.jpg");
+ok($im1, "add an image, just a filename");
+
+my $im2;
+{
+  open my $fh, "<", "t/data/t101.jpg"
+    or die "Cannot open test image: $!\n";
+  $im2 = bse_add_image($cfg, $art, fh => $fh, display_name => "t101.jpg");
+  ok($im2, "add an image by fh");
+}
+
+# just set alt text
+{
+  my %errors;
+  ok(bse_save_image($im1, alt => "Test", errors => \%errors),
+     "update alt text");
+  my $im = BSE::TB::Images->getByPkey($im1->id);
+  ok($im, "found im1 independently");
+  is($im->alt, "Test", "alt is set");
+}
+
+{ # change the image content (by name)
+  my %errors;
+  ok(bse_save_image($im1, file => "t/data/govhouse.jpg", errors => \%errors),
+     "save new image content");
+  is_deeply(\%errors, {}, "no errors");
+  like($im1->src, qr(^/), "src should start with /, assuming no storage");
+}
+
+{ # change the image content (by fh)
+  my %errors;
+  open my $fh, "<", "t/data/govhouse.jpg"
+    or die "Cannot open t/data/govhouse.jpg: $!";
+  ok(bse_save_image($im2, fh => $fh, , display_name => "govhouse.jpg",
+                   errors => \%errors),
+     "save new image content (by fh)");
+  is_deeply(\%errors, {}, "no errors");
+  like($im2->src, qr(^/), "src should start with /, assuming no storage");
+}
+
+ok($art->remove($cfg), "remove article");