S3 storage support
authorTony Cook <tony@develop-help.com>
Tue, 12 Feb 2008 04:12:46 +0000 (04:12 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Tue, 12 Feb 2008 04:12:46 +0000 (04:12 +0000)
If you use this version you need to run:
  # update the database structure
  perl upgrade_mysql.pl

  # update the image src values
  perl bse_storage.pl fixsrc

37 files changed:
MANIFEST
schema/bse.sql
site/cgi-bin/admin/add.pl
site/cgi-bin/admin/shopadmin.pl
site/cgi-bin/modules/ArticleFile.pm
site/cgi-bin/modules/ArticleFiles.pm
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Edit/Base.pm
site/cgi-bin/modules/BSE/Formatter.pm
site/cgi-bin/modules/BSE/Request/Base.pm
site/cgi-bin/modules/BSE/Storage/AmazonS3.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Storage/Base.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Storage/FTP.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Storage/LocalBase.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Storage/LocalFiles.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Storage/LocalImages.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/StorageMgr/Base.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/StorageMgr/Files.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/StorageMgr/Images.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/UserReg.pm
site/cgi-bin/modules/BSE/Util/ContentType.pm [new file with mode: 0644]
site/cgi-bin/modules/DevHelp/Tags.pm
site/cgi-bin/modules/Generate.pm
site/cgi-bin/modules/Generate/Article.pm
site/cgi-bin/modules/Image.pm
site/cgi-bin/modules/Images.pm
site/docs/makedocs
site/docs/storages.pod [new file with mode: 0644]
site/templates/admin/article_img.tmpl
site/templates/admin/catalog.tmpl
site/templates/admin/file_edit.tmpl
site/templates/admin/filelist.tmpl
site/templates/admin/image_edit.tmpl
site/util/bse_s3.pl [new file with mode: 0644]
site/util/bse_storage.pl [new file with mode: 0644]
site/util/mysql.str

index 61aa4e7..f20ea1b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -56,6 +56,7 @@ site/cgi-bin/modules/BSE/Cfg.pm
 site/cgi-bin/modules/BSE/CfgInfo.pm
 site/cgi-bin/modules/BSE/ChangePW.pm
 site/cgi-bin/modules/BSE/ComposeMail.pm
+site/cgi-bin/modules/BSE/Util/ContentType.pm
 site/cgi-bin/modules/BSE/Custom.pm
 site/cgi-bin/modules/BSE/CustomBase.pm
 site/cgi-bin/modules/BSE/DB.pm
@@ -99,6 +100,15 @@ site/cgi-bin/modules/BSE/Search/BSE.pm
 site/cgi-bin/modules/BSE/Session.pm
 site/cgi-bin/modules/BSE/Shop/Util.pm
 site/cgi-bin/modules/BSE/Sort.pm
+site/cgi-bin/modules/BSE/Storage/AmazonS3.pm
+site/cgi-bin/modules/BSE/Storage/Base.pm
+site/cgi-bin/modules/BSE/Storage/LocalBase.pm
+site/cgi-bin/modules/BSE/Storage/LocalFiles.pm
+site/cgi-bin/modules/BSE/Storage/LocalImages.pm
+site/cgi-bin/modules/BSE/Storage/FTP.pm
+site/cgi-bin/modules/BSE/StorageMgr/Base.pm
+site/cgi-bin/modules/BSE/StorageMgr/Files.pm
+site/cgi-bin/modules/BSE/StorageMgr/Images.pm
 site/cgi-bin/modules/BSE/SubscribedUser.pm
 site/cgi-bin/modules/BSE/SubscribedUsers.pm
 site/cgi-bin/modules/BSE/SubscriptionType.pm
@@ -247,9 +257,11 @@ site/docs/secure.pod
 site/docs/shop.html
 site/docs/siteusers.html
 site/docs/siteusers.pod
+site/docs/shopadmin.html
 site/docs/standard.html
 site/docs/standard.pod
-site/docs/shopadmin.html
+site/docs/storages.html
+site/docs/storages.pod
 site/docs/templates.html
 site/docs/templates.pod
 site/docs/thumbnails.html
@@ -518,6 +530,8 @@ site/templates/user/unsubone_base.tmpl
 site/templates/user/userpage_base.tmpl
 site/templates/xbase.tmpl
 site/util/bseaddimages.pl
+site/util/bse_s3.pl
+site/util/bse_storage.pl
 site/util/gen.pl
 site/util/getpcode.pl  Example code
 site/util/initial.pl
index 425f32b..5de591e 100644 (file)
@@ -143,6 +143,8 @@ CREATE TABLE image (
   url varchar(255),
   displayOrder integer not null default 0,
   name varchar(255) default '' not null,
+  storage varchar(20) not null default 'local',
+  src varchar(255) not null default '',
 
   PRIMARY KEY (id)
 );
@@ -422,6 +424,9 @@ create table article_files (
 
   hide_from_list integer not null default 0,
 
+  storage varchar(20) not null default 'local',
+  src varchar(255) not null default '',
+
   primary key (id)
 );
 
index df5e0f1..181df87 100755 (executable)
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 # -d:ptkdb
-BEGIN { $ENV{DISPLAY} = '192.168.32.245:0.0' }
+BEGIN { $ENV{DISPLAY} = '192.168.32.51:0.0' }
 use strict;
 use FindBin;
 use lib "$FindBin::Bin/../modules";
index 75e7664..9383801 100755 (executable)
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 # -d:ptkdb
-BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0'; }
+BEGIN { $ENV{DISPLAY} = '192.168.32.51:0.0'; }
 
 use strict;
 use FindBin;
index 73e39ee..368eeaa 100644 (file)
@@ -9,7 +9,7 @@ use Carp 'confess';
 sub columns {
   return qw/id articleId displayName filename sizeInBytes description 
             contentType displayOrder forSale download whenUploaded
-            requireUser notes name hide_from_list/;
+            requireUser notes name hide_from_list storage src/;
 }
 
 sub remove {
@@ -31,4 +31,11 @@ sub remove {
   $self->SUPER::remove();
 }
 
+sub article {
+  my $self = shift;
+  require Articles;
+
+  return Articles->getByPkey($self->{articleId});
+}
+
 1;
index 737430f..ebde288 100644 (file)
@@ -9,4 +9,9 @@ sub rowClass {
   return 'ArticleFile';
 }
 
+sub file_storages {
+  my $self = shift;
+  return map [ $_->{filename}, $_->{storage}, $_ ], $self->all;
+}
+
 1;
index d332230..ec5d6f8 100644 (file)
@@ -70,8 +70,8 @@ EOS
 
    Images => 'select * from image',
    replaceImage =>
-     'replace image values (?,?,?,?,?,?,?,?,?)',
-   addImage => 'insert image values(null, ?, ?, ?, ?, ?, ?, ?, ?)',
+     'replace image values (?,?,?,?,?,?,?,?,?,?,?)',
+   addImage => 'insert image values(null, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)',
    deleteImage => 'delete from image where id = ?',
    getImageByArticleId => 'select * from image where articleId = ? order by displayOrder',
    getImageByPkey => 'select * from image where id = ?',
@@ -134,10 +134,11 @@ EOS
    'OtherParents.anylinks' => 
    'select * from other_parents where childId = ? or parentId = ?',
 
+   ArticleFiles => 'select * from article_files',
    addArticleFile =>
-   'insert into article_files values (null,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
+   'insert into article_files values (null,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
    replaceArticleFile =>
-   'replace article_files values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
+   'replace article_files values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
    deleteArticleFile => 'delete from article_files where id = ?',
    getArticleFileByArticleId =>
    'select * from article_files where articleId = ? order by displayOrder desc',
index bc9a3c2..e27942d 100644 (file)
@@ -10,6 +10,7 @@ use BSE::Arrows;
 use BSE::CfgInfo qw(custom_class admin_base_url cfg_image_dir);
 use BSE::Util::Iterate;
 use BSE::Template;
+use BSE::Util::ContentType qw(content_type);
 use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
 
 sub not_logged_on {
@@ -1029,16 +1030,7 @@ sub low_edit_tags {
   my $cgi = $request->cgi;
   my $show_full = $cgi->param('f_showfull');
   $msg ||= join "\n", map escape_html($_), $cgi->param('message'), $cgi->param('m');
-  $msg ||= '';
-  $errors ||= {};
-  if (keys %$errors && !$msg) {
-    # try to get the errors in the same order as the table
-    my @cols = $self->table_object($articles)->rowClass->columns;
-    my %work = %$errors;
-    my @out = grep defined, delete @work{@cols};
-
-    $msg = join "<br>", @out, values %work;
-  }
+  $msg ||= $request->message($errors);
   my $parent;
   if ($article->{id}) {
     if ($article->{parentid} > 0) {
@@ -1162,10 +1154,40 @@ sub low_edit_tags {
      $it->make_iterator([ \&iter_groups, $request ], 
                        'group', 'groups', \@groups, undef, undef,
                        \$current_group),
+     $it->make_iterator([ iter_image_stores => $self], 
+                       'image_store', 'image_stores'),
+     $it->make_iterator([ iter_file_stores => $self], 
+                       'file_store', 'file_stores'),
      ifGroupRequired => [ \&tag_ifGroupRequired, $article, \$current_group ],
     );
 }
 
+sub iter_image_stores {
+  my ($self) = @_;
+
+  my $mgr = $self->_image_manager;
+
+  return map +{ name => $_->name, description => $_->description },
+    $mgr->all_stores;
+}
+
+sub _file_manager {
+  my ($self) = @_;
+
+  require BSE::StorageMgr::Files;
+
+  return BSE::StorageMgr::Files->new(cfg => $self->cfg);
+}
+
+sub iter_file_stores {
+  my ($self) = @_;
+
+  my $mgr = $self->_file_manager;
+
+  return map +{ name => $_->name, description => $_->description },
+    $mgr->all_stores;
+}
+
 sub iter_groups {
   my ($req) = @_;
 
@@ -2203,7 +2225,7 @@ sub save_image_changes {
   my %changes;
   my %errors;
   my %names;
-  my @old_images;
+  my %old_images;
   my @new_images;
   for my $image (@images) {
     my $id = $image->{id};
@@ -2270,10 +2292,16 @@ sub save_image_changes {
          require Image::Size;
          my ($width, $height, $type) = Image::Size::imgsize($full_filename);
          if ($width) {
-           push @old_images, $image->{image};
+           $old_images{$id} = 
+             { 
+              image => $image->{image}, 
+              storage => $image->{storage}
+             };
            push @new_images, $image_name;
 
            $changes{$id}{image} = $image_name;
+           $changes{$id}{storage} = 'local';
+           $changes{$id}{src} = "/images/$image_name";
            $changes{$id}{width} = $width;
            $changes{$id}{height} = $height;
          }
@@ -2306,26 +2334,56 @@ sub save_image_changes {
     return $self->edit_form($req, $article, $articles, undef,
                            \%errors);
   }
-  if (keys %changes) {
-    for my $image (@images) {
-      my $id = $image->{id};
-      $changes{$id}
-       or next;
 
-      for my $field (keys %{$changes{$id}}) {
-       $image->{$field} = $changes{$id}{$field};
+  my $mgr = $self->_image_manager($req->cfg);
+  $req->flash('Image information saved');
+  my $changes_found = 0;
+  my $auto_store = $cgi->param('auto_storage');
+  for my $image (@images) {
+    my $id = $image->{id};
+
+    if ($changes{$id}) {
+      my $changes = $changes{$id};
+      ++$changes_found;
+      
+      for my $field (keys %$changes) {
+       $image->{$field} = $changes->{$field};
       }
       $image->save;
     }
 
-    # delete any image files that were replaced
-    unlink map "$image_dir/$_", @old_images;
-    
+    my $old_storage = $image->{storage};
+    my $new_storage = $auto_store ? '' : $cgi->param("storage$id");
+    defined $new_storage or $new_storage = $image->{storage};
+    $new_storage = $mgr->select_store($image->{image}, $new_storage, $image);
+    if ($new_storage ne $old_storage) {
+      eval {
+       $image->{src} = $mgr->store($image->{image}, $new_storage, $image);
+       $image->{storage} = $new_storage;
+       $image->save;
+      };
+      
+      if ($old_storage ne 'local') {
+       $mgr->unstore($image->{image}, $old_storage);
+      }
+    }
+  }
+
+  # delete any image files that were replaced
+  for my $old_image (values %old_images) {
+    my ($image, $storage) = @$old_image{qw/image storage/};
+    if ($storage ne 'local') {
+      $mgr->unstore($image->{image}, $storage);
+    }
+    unlink "$image_dir/$image";
+  }
+  
+  if ($changes_found) {
     use Util 'generate_article';
     generate_article($articles, $article) if $Constants::AUTO_GENERATE;
   }
-
-  return $self->refresh($article, $cgi, undef, 'Image information saved');
+    
+  return $self->refresh($article, $cgi);
 }
 
 sub _service_error {
@@ -2475,12 +2533,33 @@ sub add_image {
      url => $url,
      displayOrder=>time,
      name => $imageref,
+     storage => 'local',
+     src => '/images/' . $filename,
     );
   require Images;
   my @cols = Image->columns;
   shift @cols;
   my $imageobj = Images->add(@image{@cols});
 
+  my $storage = $cgi->param('storage');
+  defined $storage or $storage = 'local';
+  my $image_manager = $self->_image_manager($req->cfg);
+  local $SIG{__DIE__};
+  eval {
+    my $src;
+    $storage = $image_manager->select_store($filename, $storage, $imageobj);
+    $src = $image_manager->store($filename, $storage, $imageobj);
+      
+    if ($src) {
+      $imageobj->{src} = $src;
+      $imageobj->{storage} = $storage;
+      $imageobj->save;
+    }
+  };
+  if ($@) {
+    $req->flash($@);
+  }
+
   use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
@@ -2497,6 +2576,14 @@ sub add_image {
   }
 }
 
+sub _image_manager {
+  my ($self) = @_;
+
+  require BSE::StorageMgr::Images;
+
+  return BSE::StorageMgr::Images->new(cfg => $self->cfg);
+}
+
 # remove an image
 sub remove_img {
   my ($self, $req, $article, $articles, $imageid) = @_;
@@ -2510,6 +2597,12 @@ sub remove_img {
   my @images = $self->get_images($article);
   my ($image) = grep $_->{id} == $imageid, @images
     or return $self->show_images($req, $article, $articles, "No such image");
+
+  if ($image->{storage} ne 'local') {
+    my $mgr = $self->_image_manager($req->cfg);
+    $mgr->unstore($image->{image}, $image->{storage});
+  }
+
   my $imagedir = cfg_image_dir($req->cfg);
   unlink "$imagedir$image->{image}";
   $image->remove;
@@ -2678,6 +2771,8 @@ sub req_save_image {
 
   my $image_dir = cfg_image_dir($req->cfg);
 
+  my $old_storage = $image->{storage};
+
   my %errors;
   my $delete_file;
   my $alt = $cgi->param('alt');
@@ -2733,6 +2828,8 @@ sub req_save_image {
          $image->{image} = $image_name;
          $image->{width} = $width;
          $image->{height} = $height;
+         $image->{storage} = 'local'; # not on the remote store yet
+         $image->{src} = '/images/' . $image_name;
        }
        else {
          $errors{image} = $type;
@@ -2749,11 +2846,39 @@ sub req_save_image {
   keys %errors
     and return $self->req_edit_image($req, $article, $articles, \%errors);
 
+  my $new_storage = $cgi->param('storage');
+  defined $new_storage or $new_storage = $image->{storage};
   $image->save;
-  unlink "$image_dir/$delete_file"
-    if $delete_file;
+  my $mgr = $self->_image_manager($req->cfg);
+  if ($delete_file) {
+    if ($old_storage ne 'local') {
+      $mgr->unstore($delete_file, $old_storage);
+    }
+    unlink "$image_dir/$delete_file";
+  }
+  $req->flash("Image saved");
+  eval {
+    $new_storage = 
+      $mgr->select_store($image->{image}, $new_storage);
+    if ($image->{storage} ne $new_storage) {
+      # handles both new images (which sets storage to local) and changing
+      # the storage for old images
+      my $old_storage = $image->{storage};
+      my $src = $mgr->store($image->{image}, $new_storage, $image);
+      $image->{src} = $src;
+      $image->{storage} = $new_storage;
+      $image->save;
+    }
+  };
+  $@ and $req->flash("There was a problem adding it to the new storage: $@");
+  if ($image->{storage} ne $old_storage && $old_storage ne 'local') {
+    eval {
+      $mgr->unstore($image->{image}, $old_storage);
+    };
+    $@ and $req->flash("There was a problem removing if from the old storage: $@");
+  }
 
-  return $self->refresh($article, $cgi, undef, 'Image saved');
+  return $self->refresh($article, $cgi);
 }
 
 sub get_article {
@@ -2768,91 +2893,6 @@ sub table_object {
   $articles;
 }
 
-my %types =
-  (
-   qw(
-   bash text/plain
-   css  text/css
-   csv  text/plain
-   diff text/plain
-   htm  text/html
-   html text/html
-   ics  text/calendar
-   patch text/plain
-   pl   text/plain
-   pm   text/plain
-   pod  text/plain
-   py   text/plain
-   sgm  text/sgml
-   sgml text/sgml
-   sh   text/plain
-   tcsh text/plain
-   text text/plain
-   tsv  text/tab-separated-values
-   txt  text/plain
-   vcf  text/x-vcard
-   vcs  text/x-vcalendar
-   xml  text/xml
-   zsh  text/plain
-   bmp  image/bmp 
-   gif  image/gif
-   jp2  image/jpeg2000
-   jpeg image/jpeg
-   jpg  image/jpeg   
-   pct  image/pict 
-   pict image/pict
-   png  image/png
-   tif  image/tiff
-   tiff image/tiff
-   dcr  application/x-director
-   dir  application/x-director
-   doc  application/msword
-   dxr  application/x-director
-   eps  application/postscript
-   fla  application/x-shockwave-flash
-   flv  application/x-shockwave-flash
-   gz   application/gzip
-   hqx  application/mac-binhex40
-   js   application/x-javascript
-   lzh  application/x-lzh
-   pdf  application/pdf
-   pps  application/ms-powerpoint
-   ppt  application/ms-powerpoint
-   ps   application/postscript
-   rtf  application/rtf
-   sit  application/x-stuffit
-   swf  application/x-shockwave-flash
-   tar  application/x-tar
-   tgz  application/gzip
-   xls  application/ms-excel
-   Z    application/x-compress
-   zip  application/zip
-   asf  video/x-ms-asf
-   avi  video/avi
-   flc  video/flc
-   moov video/quicktime
-   mov  video/quicktime
-   mp4  video/mp4
-   mpeg video/mpeg
-   mpg  video/mpeg
-   wmv  video/x-ms-wmv
-   3gp  video/3gpp
-   aa   audio/audible
-   aif  audio/aiff
-   aiff audio/aiff
-   m4a  audio/m4a
-   mid  audio/midi
-   mp2  audio/x-mpeg
-   mp3  audio/x-mpeg
-   ra   audio/x-realaudio
-   ram  audio/x-pn-realaudio
-   rm   audio/vnd.rm-realmedia
-   swa  audio/mp3
-   wav  audio/wav
-   wma  audio/x-ms-wma
-   )
-  );
-
 sub _refresh_filelist {
   my ($self, $req, $article, $msg) = @_;
 
@@ -2935,14 +2975,7 @@ sub fileadd {
       $file{contentType} = "application/octet-stream";
     }
     unless ($file{contentType}) {
-      my $ext = lc $1;
-      my $type = $types{$ext};
-      unless ($type) {
-       $type = $self->{cfg}->entry('extensions', $ext)
-         || $self->{cfg}->entry('extensions', ".$ext")
-           || "application/octet-stream";
-      }
-      $file{contentType} = $type;
+      $file{contentType} = content_type($self->cfg, $file);
     }
   }
 
@@ -3016,10 +3049,32 @@ sub fileadd {
   require ArticleFiles;
   my $fileobj = ArticleFiles->add(@file{@cols});
 
+  $req->flash("New file added");
+
+  my $storage = $cgi->param('storage');
+  defined $storage or $storage = 'local';
+  my $file_manager = $self->_file_manager($req->cfg);
+
+  local $SIG{__DIE__};
+  eval {
+    my $src;
+    $storage = $self->_select_filestore($req, $file_manager, $storage, $fileobj);
+    $src = $file_manager->store($filename, $storage, $fileobj);
+      
+    if ($src) {
+      $fileobj->{src} = $src;
+      $fileobj->{storage} = $storage;
+      $fileobj->save;
+    }
+  };
+  if ($@) {
+    $req->flash($@);
+  }
+
   use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
-  $self->_refresh_filelist($req, $article, 'New file added');
+  $self->_refresh_filelist($req, $article);
 }
 
 sub fileswap {
@@ -3068,6 +3123,11 @@ sub filedel {
     my ($file) = grep $_->{id} == $fileid, @files;
 
     if ($file) {
+      if ($file->{storage} ne 'local') {
+       my $mgr = $self->_file_manager;
+       $mgr->unstore($self->{filename}, $self->{storage});
+      }
+
       $file->remove($req->cfg);
     }
   }
@@ -3078,6 +3138,25 @@ sub filedel {
   $self->_refresh_filelist($req, $article, 'File deleted');
 }
 
+# only some files can be stored remotely
+sub _select_filestore {
+  my ($self, $req, $mgr, $storage, $file) = @_;
+
+  my $store = $mgr->select_store($file->{filename}, $storage, $file);
+  if ($store ne 'local') {
+    if ($file->{forSale} || $file->{requireUser}) {
+      $store = 'local';
+      $req->flash("For sale or user required files can only be stored locally");
+    }
+    elsif ($file->{articleId} != -1 && $file->article->is_access_controlled) {
+      $store = 'local';
+      $req->flash("Files for access controlled articles can only be stored locally");
+    }
+  }
+
+  return $store;
+}
+
 sub filesave {
   my ($self, $req, $article, $articles) = @_;
 
@@ -3093,12 +3172,16 @@ sub filesave {
   my %errors;
   my @old_files;
   my @new_files;
+  my %store_anyway;
   for my $file (@files) {
     my $id = $file->{id};
     my $desc = $cgi->param("description_$id");
     defined $desc and $file->{description} = $desc;
     my $type = $cgi->param("contentType_$id");
-    defined $type and $file->{contentType} = $type;
+    if (defined $type and $type ne $file->{contentType}) {
+      ++$store_anyway{$id};
+      $file->{contentType} = $type;
+    }
     my $notes = $cgi->param("notes_$id");
     defined $notes and $file->{notes} = $notes;
     my $name = $cgi->param("name_$id");
@@ -3121,7 +3204,11 @@ sub filesave {
        if length $file->{name};
     }
     if ($cgi->param('save_file_flags')) {
-      $file->{download}              = 0 + defined $cgi->param("download_$id");
+      my $download = 0 + defined $cgi->param("download_$id");
+      if ($download != $file->{download}) {
+       ++$store_anyway{$file->{id}};
+       $file->{download}             = $download;
+      }
       $file->{forSale}       = 0 + defined $cgi->param("forSale_$id");
       $file->{requireUser}    = 0 + defined $cgi->param("requireUser_$id");
       $file->{hide_from_list} = 0 + defined $cgi->param("hide_from_list_$id");
@@ -3150,10 +3237,11 @@ sub filesave {
              $display_name =~ s!.*[\\:/]!!;
              $display_name =~ s/[^\w._-]+/_/g;
              my $full_name = "$download_path/$file_name";
-             push @old_files, $file->{filename};
+             push @old_files, [ $file->{filename}, $file->{storage} ];
              push @new_files, $file_name;
              
              $file->{filename} = $file_name;
+             $file->{storage} = 'local';
              $file->{sizeInBytes} = -s $full_name;
              $file->{whenUploaded} = now_datetime();
              $file->{displayName} = $display_name;
@@ -3188,17 +3276,47 @@ sub filesave {
 
     return $self->edit_form($req, $article, $articles, undef, \%errors);
   }
+  $req->flash('File information saved');
+  my $mgr = $self->_file_manager;
   for my $file (@files) {
     $file->save;
+
+    my $storage = $cgi->param("storage_$file->{id}");
+    defined $storage or $storage = 'local';
+    $storage = $self->_select_filestore($req, $mgr, $storage, $file);
+    if ($storage ne $file->{storage} || $store_anyway{$file->{id}}) {
+      my $old_storage = $file->{storage};
+      eval {
+       $file->{src} = $mgr->store($file->{filename}, $storage, $file);
+       $file->{storage} = $storage;
+       $file->save;
+
+       if ($old_storage ne $storage) {
+         $mgr->unstore($file->{filename}, $old_storage);
+       }
+      };
+      $@
+       and $req->flash("Could not move $file->{displayName} to $storage: $@");
+    }
   }
 
   # remove the replaced files
-  unlink map "$download_path/$_", @old_files;
+  for my $file (@old_files) {
+    my ($filename, $storage) = @$file;
+
+    eval {
+      $mgr->unstore($filename, $storage);
+    };
+    $@
+      and $req->flash("Error removing $filename from $storage: $@");
+
+    unlink "$download_path/$filename";
+  }
 
   use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
-  $self->_refresh_filelist($req, $article, 'File information saved');
+  $self->_refresh_filelist($req, $article);
 }
 
 sub tag_old_checked {
@@ -3260,10 +3378,14 @@ sub req_save_file {
                 fields => \%file_fields,
                 section => $article->{id} == -1 ? 'Global File Validation' : 'Article File Validation');
 
+  my $store_anyway = 0;
   my $desc = $cgi->param("description");
   defined $desc and $file->{description} = $desc;
   my $type = $cgi->param("contentType");
-  defined $type and $file->{contentType} = $type;
+  if (defined $type && $file->{contentType} ne $type) {
+    ++$store_anyway;
+    $file->{contentType} = $type;
+  }
   my $notes = $cgi->param("notes");
   defined $notes and $file->{notes} = $notes;
   my $name = $cgi->param("name");
@@ -3286,13 +3408,17 @@ sub req_save_file {
   }
 
   if ($cgi->param('save_file_flags')) {
-    $file->{download}      = 0 + defined $cgi->param("download");
+    my $download = 0 + defined $cgi->param("download");
+    if ($download ne $file->{download}) {
+      ++$store_anyway;
+      $file->{download}            = $download;
+    }
     $file->{forSale}       = 0 + defined $cgi->param("forSale");
     $file->{requireUser}    = 0 + defined $cgi->param("requireUser");
     $file->{hide_from_list} = 0 + defined $cgi->param("hide_from_list");
   }
   
-  my @old_files;
+  my @old_file;
   my @new_files;
   my $filex = $cgi->param("file");
   my $in_fh = $cgi->upload("file");
@@ -3316,13 +3442,14 @@ sub req_save_file {
          $display_name =~ s!.*[\\:/]!!;
          $display_name =~ s/[^\w._-]+/_/g;
          my $full_name = "$download_path/$file_name";
-         push @old_files, $file->{filename};
+         @old_file = ( $file->{filename}, $file->{storage} );
          push @new_files, $file_name;
          
          $file->{filename} = $file_name;
          $file->{sizeInBytes} = -s $full_name;
          $file->{whenUploaded} = now_datetime();
          $file->{displayName} = $display_name;
+         $file->{storage} = 'local';
        }
        else {
          $errors{"file"} = $msg;
@@ -3345,13 +3472,36 @@ sub req_save_file {
   }
   $file->save;
 
+  $req->flash('File information saved');
+  my $mgr = $self->_file_manager;
+
+  my $storage = $cgi->param('storage');
+  defined $storage or $storage = $file->{storage};
+  $storage = $self->_select_filestore($req, $mgr, $storage, $file);
+  if ($storage ne $file->{storage} || $store_anyway) {
+    my $old_storage = $file->{storage};
+    eval {
+      $file->{src} = $mgr->store($file->{filename}, $storage, $file);
+      $file->{storage} = $storage;
+      $file->save;
+
+      $mgr->unstore($file->{filename}, $old_storage)
+       if $old_storage ne $storage;
+    };
+    $@
+      and $req->flash("Could not move $file->{displayName} to $storage: $@");
+  }
+
   # remove the replaced files
-  unlink map "$download_path/$_", @old_files;
+  if (my ($old_name, $old_storage) = @old_file) {
+    $mgr->unstore($old_name, $old_storage);
+    unlink "$download_path/$old_name";
+  }
 
   use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
-  $self->_refresh_filelist($req, $article, 'File information saved');
+  $self->_refresh_filelist($req, $article);
 }
 
 sub can_remove {
index 964d850..fa845e4 100644 (file)
@@ -5,9 +5,16 @@ use strict;
 sub new {
   my ($class, %parms) = @_;
 
+  $parms{cfg}
+    or die "Missing cfg parameter";
+
   return bless \%parms, $class;
 }
 
+sub cfg {
+  $_[0]{cfg}
+}
+
 sub article_class_id {
   my ($class, $id, $articles, $cfg) = @_;
 
index 6d8d5e8..bada895 100644 (file)
@@ -48,13 +48,13 @@ sub new {
 sub image_url {
   my ($self, $im) = @_;
 
-  "/images/$im->{image}"
+  $im->{src} || "/images/$im->{image}"
 }
 
 sub _image {
   my ($self, $im, $align, $url, $style) = @_;
 
-  my $image_url = $self->image_url($im);
+  my $image_url = escape_html($self->image_url($im));
 
   my $text = qq!<img src="$image_url" width="$im->{width}"!
     . qq! height="$im->{height}" alt="! . escape_html($im->{alt}).'"'
index 0d40789..2c51a8a 100644 (file)
@@ -153,10 +153,21 @@ sub output_result {
   BSE::Template->output_result($req, $result);
 }
 
+sub flash {
+  my ($self, @msg) = @_;
+
+  my $msg = "@msg";
+  my @flash;
+  @flash = @{$self->session->{flash}} if $self->session->{flash};
+  push @flash, $msg;
+  $self->session->{flash} = \@flash;
+}
+
 sub message {
   my ($req, $errors) = @_;
 
   my $msg = '';
+  my @lines;
   if ($errors and keys %$errors) {
     my @fields = $req->cgi->param;
     my %work = %$errors;
@@ -176,8 +187,12 @@ sub message {
     }
     my %seen;
     @lines = grep !$seen{$_}++, @lines; # don't need duplicates
-    $msg = join "<br />", map escape_html($_), @lines;
   }
+  if ($req->session->{flash}) {
+    push @lines, @{$req->session->{flash}};
+    delete $req->session->{flash};
+  }
+  $msg = join "<br />", map escape_html($_), @lines;
   if (!$msg && $req->cgi->param('m')) {
     $msg = join(' ', $req->cgi->param('m'));
     $msg = escape_html($msg);
diff --git a/site/cgi-bin/modules/BSE/Storage/AmazonS3.pm b/site/cgi-bin/modules/BSE/Storage/AmazonS3.pm
new file mode 100644 (file)
index 0000000..37eefe2
--- /dev/null
@@ -0,0 +1,148 @@
+package BSE::Storage::AmazonS3;
+use strict;
+use BSE::Storage::Base;
+our @ISA = qw(BSE::Storage::Base);
+use Net::Amazon::S3;
+use Carp qw(confess);
+
+sub new {
+  my ($class, %opts) = @_;
+
+  my $self = $class->SUPER::new(%opts);
+
+  my $cfg = $self->cfg;
+  for my $key (qw/baseurl keyid accesskey bucket/) {
+    $self->{$key} = $self->configure($key);
+    defined $self->{$key}
+      or confess "Missing $key from configuration";
+  }
+  $self->{prefix} = $self->configure('prefix', '');
+
+  return $self;
+}
+
+sub _connect {
+  my $self = shift;
+
+  my $conn = Net::Amazon::S3->new
+    (
+     {
+      aws_access_key_id => $self->{keyid},
+      aws_secret_access_key => $self->{accesskey}
+     }
+    );
+
+  my $bucket = $conn->bucket($self->{bucket});
+
+  return ( $conn, $bucket );
+}
+
+sub store {
+  my ($self, $local_name, $basename, $http_extras) = @_;
+
+  #print STDERR "store($local_name, $basename)\n";
+
+  my ($conn, $bucket) = $self->_connect;
+  my %headers = %$http_extras;
+  $headers{acl_short} = "public-read";
+  $bucket->add_key_filename($self->{prefix} . $basename, $local_name, 
+                           \%headers)
+    or die "Cannot add file $local_name as $basename to S3: ", 
+      $bucket->errstr, "\n";
+
+  return $self->{baseurl} . $basename;
+}
+
+sub unstore {
+  my ($self, $basename) = @_;
+
+  my ($conn, $bucket) = $self->_connect;
+  my $success = $bucket->delete_key($self->{prefix} . $basename);
+
+  return $success;
+}
+
+sub list {
+  my ($self) = @_;
+
+  my ($conn, $bucket) = $self->_connect;
+  use Data::Dumper;
+  my $result = $bucket->list_all({ prefix => $self->{prefix} });
+  my @keys = map $_->{key}, @{$result->{keys}};
+  for my $key (@keys) {
+    $key =~ s/^\Q$self->{prefix}//;
+  }
+
+  return @keys;
+}
+
+sub url {
+  my ($self, $basename) = @_;
+
+  $self->{baseurl} . $basename;
+}
+
+sub cmd {
+  my ($self, $cmd, @args) = @_;
+
+  if ($cmd eq 'create') {
+    my ($conn) = $self->_connect;
+    if ($conn->add_bucket( 
+                         { 
+                          bucket => $self->{bucket},
+                          acl_short => 'public-read' 
+                         } 
+                        )) {
+      print "Bucket $self->{bucket} created\n";
+    }
+    else {
+      die "Could not create bucket $self->{bucket}: ", $conn->errstr;
+    }
+  }
+  elsif ($cmd eq 'delete') {
+    my ($conn, $bucket) = $self->_connect;
+    if ($bucket->delete_bucket) {
+      print "Bucket $self->{bucket} deleted\n";
+    }
+    else {
+      die "Could not delete bucket $self->{bucket}: ", $conn->errstr, "\n";
+    }
+  }
+  elsif ($cmd eq 'listbuckets') {
+    my ($conn) = $self->_connect;
+    my $buckets = $conn->buckets;
+    print $_->bucket, "\n" for @{$buckets->{buckets}};
+  }
+  elsif ($cmd eq 'help') {
+    print <<EOS;
+Usage: $0 storage command
+Possible commands:
+  create - the create the bucket for the given storage
+  delete - delete the bucket for the given storage
+  listbuckets - list the buckets for the account of the given storage
+  help - display this help
+EOS
+  }
+}
+
+1;
+
+=head1 NAME
+
+BSE::Storage::FTP - storage that stores via FTP.
+
+=head1 SYNOPSIS
+
+  [ftpimages]
+  class=BSE::Storage::FTP
+  baseurl=http://yourisp.com/images/
+  cwd=/public_html/images/
+  user=ftpuser
+  password=ftppassword
+  cond=...
+
+=head1 DESCRIPTION
+
+This is a BSE storage that accesses the remote store via FTP.
+
+=cut
diff --git a/site/cgi-bin/modules/BSE/Storage/Base.pm b/site/cgi-bin/modules/BSE/Storage/Base.pm
new file mode 100644 (file)
index 0000000..f070cc3
--- /dev/null
@@ -0,0 +1,83 @@
+package BSE::Storage::Base;
+use strict;
+use Carp qw(confess);
+
+sub new {
+  my ($class, %opts) = @_;
+
+  defined $opts{cfg} and $opts{cfg}->can('entry')
+    or confess "Missing or invalid cfg option";
+
+  defined $opts{name} and $opts{name} =~ /^\w+$/
+    or confess "Missing or invalid storage name";
+
+  return bless \%opts, $class;
+}
+
+sub cfg {
+  $_[0]{cfg};
+}
+
+sub name {
+  $_[0]{name};
+}
+
+sub description {
+  my $self = shift;
+
+  $self->configure('description', $self->name);
+}
+
+sub section {
+  my $self = shift;
+
+  "storage " . $self->name;
+}
+
+sub configure {
+  my ($self, $key, $default) = @_;
+
+  return $self->cfg->entry($self->section, $key, $default);
+}
+
+sub match_file {
+  my ($self, $pathname, $filename, $object) = @_;
+
+  my $cond = $self->configure('cond');
+  defined $cond
+    or return 1;
+
+  my $result = eval <<EOS;
+stat \$pathname; # put stat values into _
+return $cond;
+EOS
+  $@ and die $@;
+
+  return $result;
+}
+
+1;
+
+=head1 NAME
+
+BSE::Storage::Base - base class for all storages
+
+=head1 SYNOPSIS
+
+  package BSE::Storage::Foo;
+  use base 'BSE::Storage::Base';
+  ...
+
+  # somewhere else
+  require BSE::Storage::Foo;
+  my $store = BSE::Storage::Foo->new(cfg => $cfg, name => $name);
+
+=head1 DESCRIPTION
+
+This will provide default implementations where necessary.
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
diff --git a/site/cgi-bin/modules/BSE/Storage/FTP.pm b/site/cgi-bin/modules/BSE/Storage/FTP.pm
new file mode 100644 (file)
index 0000000..2056860
--- /dev/null
@@ -0,0 +1,119 @@
+package BSE::Storage::FTP;
+use strict;
+use BSE::Storage::Base;
+our @ISA = qw(BSE::Storage::Base);
+use Net::FTP;
+use Carp qw(confess);
+
+sub new {
+  my ($class, %opts) = @_;
+
+  my $self = $class->SUPER::new(%opts);
+
+  my $cfg = $self->cfg;
+  for my $key (qw/baseurl host cwd user password/) {
+    $self->{$key} = $self->configure($key);
+    defined $self->{$key}
+      or confess "Missing $key from configuration";
+  }
+  $self->{passive} = $self->configure('passive', 0);
+  $self->{chmod} = $self->configure('chmod');
+
+  return $self;
+}
+
+sub _connect {
+  my ($self) = @_;
+
+  my $ftp = Net::FTP->new($self->{host}, Passive => $self->{passive});
+  $ftp
+    or die "Cannot connect via ftp to $self->{host}: $@\n";
+
+  $ftp->login($self->{user}, $self->{password})
+    or die "Cannot login to $self->{host}: ", $ftp->message, "\n";
+
+  $ftp->cwd($self->{cwd})
+    or die "Cannot cwd to $self->{cwd} on $self->{host}: ", $ftp->message, "\n";
+
+  $ftp->binary
+    or die "Cannot switch to binary mode on $self->{host}: ", $ftp->message, "\n";
+
+  return $ftp;
+}
+
+sub store {
+  my ($self, $local_name, $basename, $http_extras) = @_;
+
+  my $ftp = $self->_connect;
+  unless ($ftp->put($local_name, $basename)) {
+    my $put_error = $ftp->message;
+    # remove it, in case of a partial transfer
+    $ftp->delete($basename);
+    $ftp->quit;
+
+    die "Cannot store $local_name to $basename on $self->{host}: $put_error\n";
+  }
+
+  if ($self->{chmod}) {
+    unless ($ftp->site("chmod $self->{chmod} $basename")) {
+      my $chmod_error = $ftp->message;
+      # remove it, in case of a partial transfer
+      $ftp->delete($basename);
+      $ftp->quit;
+      
+      die "Cannot chmod $local_name on $self->{host}: $chmod_error\n";
+    }
+  }
+
+  $ftp->quit;
+
+  return $self->{baseurl} . $basename;
+}
+
+sub unstore {
+  my ($self, $basename) = @_;
+
+  my $ftp = $self->_connect;
+  my $success = $ftp->delete($basename);
+  $ftp->quit;
+
+  return $success;
+}
+
+sub list {
+  my ($self) = @_;
+
+  my $ftp = $self->_connect;
+  my @files = $ftp->ls;
+  $ftp->quit;
+
+  return grep !/^\.\.?$/, @files;
+}
+
+sub url {
+  my ($self, $basename) = @_;
+
+  $self->{baseurl} . $basename;
+}
+
+1;
+
+=head1 NAME
+
+BSE::Storage::FTP - storage that stores via FTP.
+
+=head1 SYNOPSIS
+
+  [ftpimages]
+  class=BSE::Storage::FTP
+  baseurl=http://yourisp.com/images/
+  cwd=/public_html/images/
+  user=ftpuser
+  password=ftppassword
+  cond=...
+
+=head1 DESCRIPTION
+
+This is a BSE storage that accesses the remote store via FTP.
+
+=cut
diff --git a/site/cgi-bin/modules/BSE/Storage/LocalBase.pm b/site/cgi-bin/modules/BSE/Storage/LocalBase.pm
new file mode 100644 (file)
index 0000000..61453a6
--- /dev/null
@@ -0,0 +1,19 @@
+package BSE::Storage::LocalBase;
+use strict;
+use BSE::Storage::Base;
+our @ISA = qw(BSE::Storage::Base);
+
+sub unstore {
+  my ($self, $basename) = @_;
+  # nothing to do
+}
+
+sub sync {
+  # does nothing
+}
+
+sub description {
+  return 'Local';
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/Storage/LocalFiles.pm b/site/cgi-bin/modules/BSE/Storage/LocalFiles.pm
new file mode 100644 (file)
index 0000000..3e18ed7
--- /dev/null
@@ -0,0 +1,19 @@
+package BSE::Storage::LocalFiles;
+use strict;
+use BSE::Storage::LocalBase;
+our @ISA = qw(BSE::Storage::LocalBase);
+
+sub store {
+  my ($self, $path, $basename) = @_;
+  # nothing to do
+
+  return '';
+}
+
+sub url {
+  my ($self, $basename, $object) = @_;
+
+  return '';
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/Storage/LocalImages.pm b/site/cgi-bin/modules/BSE/Storage/LocalImages.pm
new file mode 100644 (file)
index 0000000..6be80fd
--- /dev/null
@@ -0,0 +1,18 @@
+package BSE::Storage::LocalImages;
+use strict;
+use BSE::Storage::LocalBase;
+our @ISA = qw(BSE::Storage::LocalBase);
+
+sub store {
+  my ($self, $path, $basename) = @_;
+  # nothing to do
+
+  return '/images/' . $basename;
+}
+
+sub url {
+  my ($self, $basename) = @_;
+  '/images/' . $basename;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/StorageMgr/Base.pm b/site/cgi-bin/modules/BSE/StorageMgr/Base.pm
new file mode 100644 (file)
index 0000000..01aba2b
--- /dev/null
@@ -0,0 +1,179 @@
+package BSE::StorageMgr::Base;
+use strict;
+use Carp 'confess';
+
+sub new {
+  my ($class, %opts) = @_;
+
+  $opts{cfg} && $opts{cfg}->can('entry')
+    or confess "cfg option missing";
+
+  $opts{debug} = $opts{cfg}->entry('storages', 'debug');
+
+  return bless \%opts, $class;
+}
+
+sub store {
+  my ($self, $filename, $key, $object) = @_;
+
+  my %http_extras = $self->metadata($object);
+
+  $self->{debug} and print STDERR "StorageMgr: store($filename, $key)\n";
+
+  return $self->_find_store($key)->
+    store($self->pathname($filename), $filename, \%http_extras);
+}
+
+sub select_store {
+  my ($self, $filename, $key, $object) = @_;
+
+  if ($key eq '') {
+    my $pathname = $self->pathname($filename);
+    for my $store ($self->all_stores) {
+      if ($store->match_file($pathname, $filename, $object)) {
+       return $store->name;
+      }
+    }
+
+    return 'local';
+  }
+  else {
+    return $key;
+  }
+}
+
+sub unstore {
+  my ($self, $filename, $key) = @_;
+
+  my $store = $self->_find_store($key)
+    or return;
+
+  return $store->unstore($filename);
+}
+
+sub cfg {
+  $_[0]{cfg};
+}
+
+sub all_stores {
+  my $self = shift;
+
+  $self->{loaded} or $self->_load_stores;
+
+  return @{$self->{ordered}};
+}
+
+sub local_store {
+  my $self = shift;
+
+  $self->{loaded} or $self->_load_stores;
+
+  return $self->{local_store};
+}
+
+sub pathname {
+  my ($self, $filename) = @_;
+
+  return $self->filebase . $filename;
+}
+
+sub sync {
+  my ($self, %opts) = @_;
+
+  my $print = $opts{print};
+
+  my @all_files = $self->files;
+  for my $store (grep $_->name ne 'local', $self->all_stores) {
+    my $name = $store->name;
+
+    $print and $print->("Storage ", $store->description, " ($name)");
+    
+    my @files = $store->list;
+    my %files = map { $_ => 1 } @files;
+    my @need_files = grep $_->[1] eq $name, @all_files;
+    my %good_files = map { $_->[0] => 1 } grep $files{$_->[0]}, @need_files;
+    my @missing_files = grep !$good_files{$_->[0]}, @need_files;
+    my @extra_files = grep !$good_files{$_}, @files;
+
+    if (@missing_files) {
+      $print
+       and $print->("  ", scalar(@missing_files), " missing - transferring:");
+      for my $file (@missing_files) {
+       print "    $file->[0]\n";
+       my $src = $self->store(@$file);
+       $self->set_src($file->[2], $src);
+      }
+    }
+    if (@extra_files) {
+      $print and
+       $print->("  ", scalar(@extra_files), " extra files found, removing:");
+      for my $file (@extra_files) {
+       $print
+         and $print->("    $file");
+       $self->unstore($file, $name);
+      }
+    }
+  }
+
+  my $local_store = $self->local_store;
+  for my $file (grep $_->[1] eq 'local', @all_files) {
+    $self->set_src($file->[2], $local_store->url($file->[0], $file->[2]));
+  }
+}
+
+sub fixsrc {
+  my $self = shift;
+
+  for my $file ($self->files) {
+    my $store = $self->_find_store($file->[1]);
+    $self->set_src($file->[2], $store->url($file->[0]));
+  }
+}
+
+sub _load_stores {
+  my ($self) = @_;
+
+  my @keys = split /,/, $self->cfg->entry('storages', $self->type, '');
+
+  if (grep $_ eq 'local', @keys) {
+    die "You cannot include the local storage in the configured storage list\n";
+  }
+
+  my %stores;
+  my @stores;
+  my $cfg = $self->cfg;
+  for my $key (@keys) {
+    my $section = "storage $key";
+    my $class = $cfg->entry($section, 'class')
+      or die "No class defined in [$section] for storage $key\n";
+
+    (my $file = $class . ".pm") =~ s(::)(/)g;
+    require $file;
+    my $store = $class->new(cfg => $cfg, name => $key);
+
+    $stores{$key} = $store;
+    push @stores, $store;
+  }
+  my $local = $self->local_class->new(cfg => $cfg, name => 'local');
+  $stores{local} = $local;
+  push @stores, $local;
+  
+  $self->{stores} = \%stores;
+  $self->{ordered} = \@stores;
+  $self->{local_store} = $local;
+
+  ++$self->{loaded};
+}
+
+sub _find_store {
+  my ($self, $key) = @_;
+
+  $self->{loaded} or $self->_load_stores;
+
+  my $store = $self->{stores}{$key} 
+    or die "Unknown store $key\n";
+
+  return $store;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/StorageMgr/Files.pm b/site/cgi-bin/modules/BSE/StorageMgr/Files.pm
new file mode 100644 (file)
index 0000000..3be76fa
--- /dev/null
@@ -0,0 +1,58 @@
+package BSE::StorageMgr::Files;
+use strict;
+use BSE::StorageMgr::Base;
+our @ISA = qw(BSE::StorageMgr::Base);
+use BSE::Storage::LocalFiles;
+use BSE::Util::ContentType qw(content_type);
+
+sub filebase {
+  my ($self) = @_;
+
+  my $path = $self->cfg->entryVar('paths', 'downloads');
+
+  $path =~ m!/$! or $path .= '/';
+
+  return $path;
+}
+
+sub local_class {
+  return 'BSE::Storage::LocalFiles';
+}
+
+sub type {
+  'files';
+}
+
+sub files {
+  require ArticleFiles;
+  return ArticleFiles->file_storages;
+}
+
+sub metadata {
+  my ($self, $file) = @_;
+
+  if ($file->{download}) {
+    return
+      (
+       content_type => "application/octet-stream",
+       content_disposition => "attachment; filename=$file->{displayName}",
+      );
+  }
+  else {
+    return
+      (
+       content_type => $file->{contentType},
+       content_disposition => "inline; filename=$file->{displayName}",
+      );
+  }
+}
+
+sub set_src {
+  my ($self, $file, $src) = @_;
+
+  $file->{src} = $src;
+  $file->save;
+}
+
+
+1;
diff --git a/site/cgi-bin/modules/BSE/StorageMgr/Images.pm b/site/cgi-bin/modules/BSE/StorageMgr/Images.pm
new file mode 100644 (file)
index 0000000..807977e
--- /dev/null
@@ -0,0 +1,44 @@
+package BSE::StorageMgr::Images;
+use strict;
+use BSE::StorageMgr::Base;
+our @ISA = qw(BSE::StorageMgr::Base);
+use BSE::CfgInfo qw(cfg_image_dir);
+use BSE::Storage::LocalImages;
+use BSE::Util::ContentType qw(content_type);
+
+sub filebase {
+  my ($self) = @_;
+
+  return cfg_image_dir($self->cfg);
+}
+
+sub local_class {
+  return 'BSE::Storage::LocalImages';
+}
+
+sub type {
+  'images';
+}
+
+sub files {
+  require Images;
+  return Images->image_storages;
+}
+
+sub metadata {
+  my ($self, $image) = @_;
+
+  return
+    (
+     content_type => content_type($self->{cfg}, $image->{image}) 
+    );
+}
+
+sub set_src {
+  my ($self, $image, $src) = @_;
+
+  $image->{src} = $src;
+  $image->save;
+}
+
+1;
index 5fefcb1..873da01 100644 (file)
@@ -1256,9 +1256,10 @@ sub req_download_file {
                                  "This file can only be downloaded as part of an order"));
 
   # check the user has access to this file (RT#531)
+  my $article;
   if ($file->{articleId} != -1) {
     require Articles;
-    my $article = Articles->getByPkey($file->{articleId})
+    $article = Articles->getByPkey($file->{articleId})
       or return $self->req_show_logon($req,
                                  $msgs->('downloadarticle',
                                          "Could not load article for file"));
@@ -1277,6 +1278,15 @@ sub req_download_file {
       }
     }
   }
+
+  # this this file is on an external storage, and qualifies for
+  # external storage send the user to get it from there
+  if ($file->{src} && $file->{storage} ne 'local'
+      && !$file->{forSale} && !$file->{requireUser}
+      && (!$article || !$article->is_access_controlled)) {
+    refresh_to($file->{src});
+    return;
+  }
   
   my $filebase = $cfg->entryVar('paths', 'downloads');
   open FILE, "< $filebase/$file->{filename}"
diff --git a/site/cgi-bin/modules/BSE/Util/ContentType.pm b/site/cgi-bin/modules/BSE/Util/ContentType.pm
new file mode 100644 (file)
index 0000000..54e4c1b
--- /dev/null
@@ -0,0 +1,110 @@
+package BSE::Util::ContentType;
+use strict;
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(content_type);
+
+my %types =
+  (
+   qw(
+   bash text/plain
+   css  text/css
+   csv  text/plain
+   diff text/plain
+   htm  text/html
+   html text/html
+   ics  text/calendar
+   patch text/plain
+   pl   text/plain
+   pm   text/plain
+   pod  text/plain
+   py   text/plain
+   sgm  text/sgml
+   sgml text/sgml
+   sh   text/plain
+   tcsh text/plain
+   text text/plain
+   tsv  text/tab-separated-values
+   txt  text/plain
+   vcf  text/x-vcard
+   vcs  text/x-vcalendar
+   xml  text/xml
+   zsh  text/plain
+   bmp  image/bmp 
+   gif  image/gif
+   jp2  image/jpeg2000
+   jpeg image/jpeg
+   jpg  image/jpeg   
+   pct  image/pict 
+   pict image/pict
+   png  image/png
+   tif  image/tiff
+   tiff image/tiff
+   dcr  application/x-director
+   dir  application/x-director
+   doc  application/msword
+   dxr  application/x-director
+   eps  application/postscript
+   fla  application/x-shockwave-flash
+   flv  application/x-shockwave-flash
+   gz   application/gzip
+   hqx  application/mac-binhex40
+   js   application/x-javascript
+   lzh  application/x-lzh
+   pdf  application/pdf
+   pps  application/ms-powerpoint
+   ppt  application/ms-powerpoint
+   ps   application/postscript
+   rtf  application/rtf
+   sit  application/x-stuffit
+   swf  application/x-shockwave-flash
+   tar  application/x-tar
+   tgz  application/gzip
+   xls  application/ms-excel
+   Z    application/x-compress
+   zip  application/zip
+   asf  video/x-ms-asf
+   avi  video/avi
+   flc  video/flc
+   moov video/quicktime
+   mov  video/quicktime
+   mp4  video/mp4
+   mpeg video/mpeg
+   mpg  video/mpeg
+   wmv  video/x-ms-wmv
+   3gp  video/3gpp
+   aa   audio/audible
+   aif  audio/aiff
+   aiff audio/aiff
+   m4a  audio/m4a
+   mid  audio/midi
+   mp2  audio/x-mpeg
+   mp3  audio/x-mpeg
+   ra   audio/x-realaudio
+   ram  audio/x-pn-realaudio
+   rm   audio/vnd.rm-realmedia
+   swa  audio/mp3
+   wav  audio/wav
+   wma  audio/x-ms-wma
+   )
+  );
+
+sub content_type {
+  my ($cfg, $filename) = @_;
+
+  if ($filename =~ /\.(\w+)$/) {
+    my $ext = lc $1;
+    my $type = $types{$ext};
+    unless ($type) {
+      $type = $cfg->entry('extensions', $ext)
+       || $cfg->entry('extensions', ".$ext")
+         || "application/octet-stream";
+    }
+    
+    return $type;
+  }
+  else {
+    return "application/octet-stream";
+  }
+}
+
index d836b7a..23a32de 100644 (file)
@@ -355,6 +355,8 @@ sub get_parms {
                           \"[^"]*\"
                           |
                           \[[^\]\[]+?\]
+                           |
+                           \[(?:[^\]\[]*\[[^\]\[]*\])+[^\]\[]*\]
                          )
                         )*
                         )
index dd425c1..d99fa26 100644 (file)
@@ -176,35 +176,6 @@ sub _body_embed {
   return $text;
 }
 
-sub _make_img {
-  my ($args, $imagePos, $images) = @_;
-
-  my ($index, $align, $url) = split /\|/, $args, 3;
-  my $text = '';
-  if ($index >=1 && $index <= @$images) {
-# I considered this
-#      if (!$align) {
-#        $align = $$imagePos =~ /r/ ? 'right' : 'left';
-#        $$imagePos =~ tr/rl/lr/; # I wonder
-#      }
-    my $im = $images->[$index-1];
-    $text = qq!<img src="/images/$im->{image}" width="$im->{width}"!
-      . qq! height="$im->{height}" alt="! . escape_html($im->{alt}).'"'
-       . qq! border="0"!;
-    $text .= qq! align="$align"! if $align && $align ne 'center';
-    $text .= qq! />!;
-    $text = qq!<div align="center">$text</div>!
-      if $align && $align eq 'center';
-    if (!$url && $im->{url}) {
-      $url = $im->{url};
-    }
-    if ($url) {
-      $text = qq!<a href="! . escape_html($url) . qq!">$text</a>!;
-    }
-  }
-  return $text;
-}
-
 sub formatter_class {
   require BSE::Formatter::Article;
   return 'BSE::Formatter::Article'
@@ -865,14 +836,20 @@ sub get_gfile {
 sub image_url {
   my ($self, $im) = @_;
 
-  "/images/$im->{image}";
+  $im->{src} || "/images/$im->{image}";
 }
 
 sub _format_image {
   my ($self, $im, $align, $rest) = @_;
 
   if ($align && exists $im->{$align}) {
-    return escape_html($im->{$align});
+    if ($align eq 'src') {
+      my $src = $self->image_url($im);
+      return escape_html($im);
+    }
+    else {
+      return escape_html($im->{$align});
+    }
   }
   else {
     my $image_url = $self->image_url($im);
index e766d38..33f02db 100644 (file)
@@ -92,7 +92,9 @@ sub tag_title {
   }
 
   if ($im) {
-    return qq!<img src="/images/$im->{image}" width="$im->{width}"!
+    my $src = $im->{src} || "/images/$im->{image}";
+    $src = escape_html($src);
+    return qq!<img src="$src" width="$im->{width}"!
       . qq! height="$im->{height}" alt="$title" />!;
   }
   else {
index 8654848..e855042 100644 (file)
@@ -6,7 +6,8 @@ use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row/;
 
 sub columns {
-  return qw/id articleId image alt width height url displayOrder name/;
+  return qw/id articleId image alt width height url displayOrder name
+            storage src/;
 }
 
 1;
index 15e0376..19b0b3a 100644 (file)
@@ -9,4 +9,8 @@ sub rowClass {
   return 'Image';
 }
 
+sub image_storages {
+  return map [ $_->{image}, $_->{storage}, $_ ], Images->all;
+}
+
 1;
index 7c51c61..58e64b3 100644 (file)
@@ -33,6 +33,7 @@ my @targets =
    'formmail.html',
    'userupdate.html',
    'siteusers.html',
+   'storages.html',
   );
 
 my @exts = qw(.pod .pm .pl);
diff --git a/site/docs/storages.pod b/site/docs/storages.pod
new file mode 100644 (file)
index 0000000..36d9dce
--- /dev/null
@@ -0,0 +1,297 @@
+=head1 NAME
+
+storages.pod - external image and file stores
+
+=head1 SYNOPSIS
+
+  [storages]
+  images=istore1,istore2
+  files=fstore1,fstore2
+
+  [storage istore1]
+  class=BSE::Storage::AmazonS3
+  baseurl=http://.../images/
+  keyid=...
+  accesskey=...
+  bucket=...
+  prefix=images/
+  description=Images on Amazon S3
+
+  [storage istore2]
+  class=BSE::Storage::FTP
+  baseurl=http://.../images/
+  host=ftphost
+  user=ftpuser
+  password=ftppassword
+  cwd=/public_html/images
+  chmod=644
+  description=Images on Somehost
+
+=head1 DESCRIPTION
+
+BSE allows you to have images and file served from a remote server.
+This can be useful:
+
+=over
+
+=item *
+
+to reduce bandwidth usage on your dynamic server
+
+=item *
+
+to reduce CPU load - though this shouldn't be significant from
+file/image transfers in any case
+
+=back
+
+=head1 FILE STORAGE
+
+Unlike images, files attached to images can be limited to either
+require that a user be logged in, that the file be available only on
+purchase or access limited by the user's access rights in the article
+or it's parents.
+
+Hence, if a file is marked for sale, user required, or the article it
+belongs to is access controlled, the files cannot be stored remotely.
+
+Also the marking of files for download, the display name and
+specifying the content type is only supported by the Amazon S3
+storage.
+
+=head1 CONFIGURATION
+
+Each type of file has a list of stores where their associated files
+can be stored, which is set in the [storages] section of the config
+file as a comma delimited list of tokens.
+
+A "local" storage for the given file type is added to the end of that
+list.  This storage has no configuration.
+
+Each of these tokens then refers to another configuration section
+C<[storage >I<token>C<]> with the definition for that store.
+
+Each storage section B<must> have a C<class> token which defines the
+storage class.
+
+Other common tokens include:
+
+=over
+
+=item *
+
+description - the description of the storage as displayed in drop down
+lists.
+
+=item *
+
+baseurl - the base url the image filename is appended to to obtain the
+final file source url.
+
+=item *
+
+cond - a perl expression, if the users chooses (Auto) from the
+storages drop down then the first storage when cond evals to a true
+value will be used.  If none are true the local storage is used.  This
+expression is ignored if the user selects a particular storage.
+
+=back
+
+=head1 STORAGE CLASSES
+
+=head2 BSE::Storage::AmazonS3
+
+This stores the files on Amazon's Simple Storage Service.
+
+This storage supports storing content types and dispositions, so
+supports BSE's distinction between retrieving files for download or
+for inline display.
+
+=over
+
+=item *
+
+keyid - "Your Access Key ID" from the AWS Access Identifiers page.
+Required.
+
+=item *
+
+accesskey - " Your Secret Access Key" from the AWS Access Identifiers
+page.  Required.
+
+=item *
+
+bucket - the name of the S3 bucket to store the files in.  Required.
+
+=item *
+
+prefix - the prefix applied to filenames stored in this bucket.  This
+combined with the bucket must be unique amongst the storages you
+create.  Required.
+
+=back
+
+The bse_s3.pl tool can be used for basic setup.
+
+To create the bucket associated with a storage:
+
+  perl bse_s3.pl istore1 create
+
+To delete the bucket associated with a storage:
+
+  perl bse_s3.pl istore1 create
+
+The bucket must be empty before doing this.
+
+To list all buckets for the account associated with a storage:
+
+  perl bse_s3.pl istore1 listbuckets
+
+=head2 BSE::Storage::FTP
+
+This storage transfers files to an FTP server.
+
+Without complex apache setup this storage is only useful for images,
+since it doesn't support BSE's distinction between inline and
+attachment for files.
+
+=over
+
+=item *
+
+host - the ftp host to transfer the files to.  Required.
+
+=item *
+
+user - the FTP user.  Required.
+
+=item *
+
+password - the FTP password.  Required.
+
+=item *
+
+cwd - the storage will change to this directory before
+uploading/removing files.  Required.
+
+=item *
+
+chmod - if set then any files uploaded will be chmod to the given
+mask.  Optional but recommended that this be set to 644.
+
+=back
+
+=head1 MAINTENANCE
+
+The bse_storage.pl can be use for simple maintenance tasks.
+
+=head2 Synchronization
+
+If you've manually removed or added files to the storage or updated
+the storage field in the C<image> or C<article_files> tables you can
+resynchronize the storage state to the database.
+
+  perl bse_storage.pl sync
+
+To see what differences were found run with the -v option:
+
+  perl bse_storage.pl -v sync
+
+This will also update the file src for each file found to be out of
+sync.
+
+For example, if you want to force all images to be stored on the
+storage C<s3_images> you would do the following in SQL:
+
+  update image set storage='s3_images';
+
+then run:
+
+  perl bse_storage.pl -v sync
+
+and you might see:
+
+  Type files
+    Storage S3 Files (s3_files)
+  Type images
+    Storage S3 Images (s3_images)
+      11 missing - transferring:
+      1180071938_kscdisplay.png
+      1180071915_209_yonge.jpg
+      1180328212_t105gray-perturb.gif
+      1180743047_test.jpg
+      1180745768_t50out.gif
+      1188193066_foo.png
+      1189397083_dnangel_01_1280.jpg
+      1189411047_dnangel_18_1024.jpg
+      1195003780_anzscin2.jpg
+      1195002521_1194062541_anzscin2.png
+      1202278171_result.png
+    Storage FTP Images (ftp_images)
+
+or to bulk remove files from the storage:
+
+  update image set storage='local';
+
+  Type files
+    Storage S3 Files (s3_files)
+  Type images
+    Storage S3 Images (s3_images)
+      12 extra files found, removing:
+        1180071915_209_yonge.jpg
+        1180071938_kscdisplay.png
+        1180328212_t105gray-perturb.gif
+        1180743047_test.jpg
+        1180745768_t50out.gif
+        1188193066_foo.png
+        1189397083_dnangel_01_1280.jpg
+        1189411047_dnangel_18_1024.jpg
+        1195002521_1194062541_anzscin2.png
+        1195003780_anzscin2.jpg
+        1202278171_result.png
+        1202437879_t101.jpg
+    Storage FTP Images (ftp_images)
+
+=head2 Storage Contents
+
+You can see what files are stored in which storages with the list command:
+
+  perl bse_storage.pl list
+
+=head2 URL Updates
+
+If you reconfigure the base URL for a storage you can do:
+
+  perl bse_storage.pl fixsrc
+
+to update the stored URL for every file.
+
+This should also be done when updating to a version of BSE with
+storages to fix the src for images.
+
+=head1 CNAME and S3
+
+To avoid sending your users to
+http://I<bucket>.s3.amazonaws.com/... for your data you can create a
+CNAME named for your bucket that points at I<bucket>.s3.amazonaws.com.
+
+eg. given a base site name of http://bsetest.develop-help.com we
+create a bucket called "images.bsetest.develop-help.com" and create a
+CNAME like so:
+
+; in the develop-help.com zone file
+images.bsetest  IN      CNAME   images.bsetest.develop-help.com.s3.amazonaws.com.
+
+We can then set the baseurl using that name:
+
+  baseurl=http://images.bsetest.develop-help.com/images/
+  prefix=images/
+
+For more information see "Virtual Hosting of Buckets" under "Using the
+REST API" in the Amazone Simple Storage Service Developer Guide.
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
index 3f35e53..3c8d8b5 100644 (file)
             </td>
             <td nowrap="nowrap" bgcolor="#FFFFFF"><:help image name:> <:error_img name:></td>
           </tr>
+          <tr> 
+            <th bgcolor="#FFFFFF" align="left">Storage:</th>
+            <td bgcolor="#FFFFFF"> 
+<select name="storage">
+<option value="">(Auto)</option>
+<:iterator begin image_stores:>
+<option value="<:image_store name:>"><:image_store description:></option>
+<:iterator end image_stores:>
+</select>
+            </td>
+            <td nowrap="nowrap" bgcolor="#FFFFFF"><:help image storage:> <:error_img storage:></td>
+          </tr>
           <tr> 
             <td bgcolor="#FFFFFF" colspan="3" align="right"> 
               <input type="submit" name="addimg" value="Add Image" />
           </tr>
 <:iterator begin images:>
        <tr>
-          <td rowspan="4" align="center" valign="center" bgcolor="#FFFFFF"><a href="#" onclick="window.open('/images/<:image image:>', 'fullimage', 'width=<:arithmetic [image width]+20:>,height=<:arithmetic [image height] + 30:>,location=no,status=no,menubar=no,scrollbars=yes'); return false;"><:thumbimage editor:></a></th>
+          <td rowspan="5" align="center" valign="center" bgcolor="#FFFFFF"><a href="#" onclick="window.open('<:image src:>', 'fullimage', 'width=<:arithmetic [image width]+20:>,height=<:arithmetic [image height] + 30:>,location=no,status=no,menubar=no,scrollbars=yes'); return false;"><:thumbimage editor:></a></th>
            <th>Alt text:</th>
             <td valign="top" bgcolor="#FFFFFF"> 
               <:ifUserCan edit_images_save:article:><input type="text" name="alt<:image id:>" value="<: oldi [concatenate alt [image id] ] 0 image alt :>" size="32" /><:or:><: image alt :><:eif:>
             </td>
-            <td valign="top" nowrap="nowrap" rowspan="4" bgcolor="#FFFFFF"> 
+            <td valign="top" nowrap="nowrap" rowspan="5" bgcolor="#FFFFFF"> 
               <:ifUserCan edit_images_delete:article:><b><a href="<:script:>?id=<:article id:>&removeimg_<: image id :>=1&_t=img" onClick="return window.confirm('Are you sure you want to delete this Image')">Delete</a></b><:or:><:eif:>
 <:ifUserCan edit_images_save:article:><a href="<:script:>?a_edit_image=1&amp;id=<:article id:>&image_id=<: image id :>">Edit</a><:or:><:eif:></td>
-            <td nowrap="nowrap" bgcolor="#FFFFFF" rowspan="4"><:imgmove:></td>
+            <td nowrap="nowrap" bgcolor="#FFFFFF" rowspan="5"><:imgmove:></td>
          </tr>
          <tr>        
             <th>URL:</th>
-            <td valign="top" width="50%"  bgcolor="#FFFFFF"colspan="1"> 
+            <td valign="top" width="50%"  bgcolor="#FFFFFF" colspan="1"> 
               <:ifUserCan edit_images_save:article:><input type="text" name="url<:image id:>" value="<: oldi [concatenate url [image id] ] 0 image url :>" size="32" /><:or:><: image url :><:eif:>
             </td>
           </tr>
           <tr>
            <th>Identifier:</th>
-            <td valign="top" nowrap="nowrap"  bgcolor="#FFFFFF"colspan="1"> 
+            <td valign="top" nowrap="nowrap"  bgcolor="#FFFFFF" colspan="1"> 
               <:ifUserCan edit_images_save:article:><input type="text" name="name<:image id:>" value="<: oldi [concatenate name [image id] ] 0 image name :>" size="32" /> <:error_img [concatenate "name" [image id] ]:><:or:><: image name :><:eif:>
             </td>
         </tr>
           <tr>
            <th>Image file:</th>
-            <td valign="top" nowrap="nowrap"  bgcolor="#FFFFFF"colspan="1"> 
+            <td valign="top" nowrap="nowrap"  bgcolor="#FFFFFF" colspan="1"> 
               <:ifUserCan edit_images_save:article:><input type="file" name="image<:image id:>" size="32" /> <:error_img [concatenate "image" [image id] ]:><:or:><: image displayName :><:eif:>
             </td>
         </tr>
+          <tr>
+           <th>Stored:</th>
+            <td valign="top" nowrap="nowrap"  bgcolor="#FFFFFF" colspan="1"> 
+              <:ifUserCan edit_images_save:article:><select name="storage<:image id:>">
+<option value="">(Auto)</option>
+<:iterator begin image_stores:>
+<option value="<:image_store name:>" <:ifEq [oldi [concatenate storage [image id] ] 0 image storage] [image_store name]:>selected="selected"<:or:><:eif:>><:image_store description:></option>
+<:iterator end image_stores:>
+</select><:error_img [concatenate "storage" [image id] ]:><:or:><: image storage :><:eif:>
+            </td>
+        </tr>
 <:iterator end images:>          
 <:or Thumbs:>
           <tr bgcolor="#FFFFFF"> 
           </tr>
           <: iterator begin images :> 
           <tr bgcolor="#FFFFFF"> 
-            <td align="center" colspan="5"> <img src="/images/<: image image :>" alt="<: image alt :>" width="<: 
+            <td align="center" colspan="5"> <img src="<: image src :>" alt="<: image alt :>" width="<: 
               image width :>" height="<: image height :>" /></td>
           </tr>
           <tr bgcolor="#FFFFFF"> 
index 9435061..e7fbe96 100644 (file)
@@ -33,7 +33,7 @@
           <td nowrap><a href="/cgi-bin/admin/add.pl?id=<:product id:>">Edit</a> 
             <:if Product listed:> <a href="/cgi-bin/admin/add.pl?hide=1&id=<:product id:>&r=<:cfg site url:><:script:>">Hide</a> 
             <:or Product:> <a href="/cgi-bin/admin/add.pl?unhide=1&id=<:product id:>&r=<:cfg site url:><:script:>">Show</a> 
-            <:eif Product:> <:move:> </td>
+            <:eif Product:> <:move:> x<:product customStr1:>y</td>
           <td><:hiddenNote:></td>
         </tr>
         <:iterator end products:> 
index d5ed53a..8ef40e9 100644 (file)
             </td>
             <td nowrap="nowrap"><:help file hide_from_list:> <:error_img hide_from_list:></td>
           </tr>
+          <tr> 
+            <th align="left">Storage:</th>
+            <td> 
+<select name="storage">
+<option value="">(Auto)</option>
+<:iterator begin file_stores:>
+<option value="<:file_store name:>" <:ifEq [efile storage] [file_store name]:>selected="selected"<:or:><:eif:>><:file_store description:></option>
+<:iterator end file_stores:>
+</select>
+            </td>
+            <td nowrap="nowrap"><:help file hide_from_list:> <:error_img hide_from_list:></td>
+          </tr>
           <tr> 
             <td colspan="3" align="right"> 
               <input type="submit" name="a_save_file" value="Save File" />
index af21a1c..4a9c62e 100644 (file)
             </td>
             <td nowrap="nowrap" bgcolor="#FFFFFF"><:help file hide_from_list:> <:error_img hide_from_list:></td>
           </tr>
+          <tr> 
+            <th bgcolor="#FFFFFF" align="left">Storage:</th>
+            <td bgcolor="#FFFFFF"> 
+<select name="storage">
+<option value="">(Auto)</option>
+<:iterator begin file_stores:>
+<option value="<:file_store name:>"><:file_store description:></option>
+<:iterator end file_stores:>
+</select>
+
+            </td>
+            <td nowrap="nowrap" bgcolor="#FFFFFF"><:help file hide_from_list:> <:error_img hide_from_list:></td>
+          </tr>
           <tr> 
             <td bgcolor="#FFFFFF" colspan="3" align="right"> 
               <input type="submit" name="fileadd" value="Add File" />
             </td>
           </tr>
           <tr>
-            <td valign="top" colspan="2" nowrap="nowrap" bgcolor="#FFFFFF"> 
+            <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF"> 
                Identifier: <:ifUserCan edit_files_save:article:><input name="name_<:file id:>" type="text" value="<: oldi [concatenate name_ [file id]] 0 file name :>" size="20" /><:error_img [concatenate name_ [file id]]:>
                <:or:><: file name :><:eif:>
             </td>
+            <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF"> 
+               Storage: <:ifUserCan edit_files_save:article:><select name="storage_<:file id:>"><option value="">(Auto)</option>
+<:iterator begin file_stores:>
+<option value="<:file_store name:>" <:ifEq [oldi [concatenate storage_ [file id] ] 0 file storage] [file_store name]:>selected="selected"<:or:><:eif:>><:file_store description:></option>
+<:iterator end file_stores:></select><:error_img [concatenate storage_ [file id]]:>
+               <:or:><: file storage :><:eif:>
+            </td>
           </tr>
           <tr bgcolor="#FFFFFF"> 
             <td colspan="3"> 
index dd33379..560a0e6 100644 (file)
@@ -6,7 +6,7 @@
 <p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> | 
 <a href="<:article admin:>">See article</a> | 
 <a href="/cgi-bin/admin/add.pl?id=<:article id:>">Edit Article</a> |
-<a href="/cgi-bin/admin/add.pl?id=<:article id:>">Images</a> |
+<a href="/cgi-bin/admin/add.pl?id=<:article id:>&amp;_t=img">Images</a> |
 </p>
 
 <form action="/cgi-bin/admin/add.pl" method="post" enctype="multipart/form-data">
     <td><input type="text" name="name" value="<:old name eimage name:>" /></td>
     <td nowrap="nowrap"><:help image name:> <:error_img name:></td>
   </tr>
+  <tr> 
+    <th align="left">Storage:</th>
+            <td> 
+<select name="storage">
+<option value="">(Auto)</option>
+<:iterator begin image_stores:>
+<option value="<:image_store name:>" <:ifEq [old storage eimage storage] [image_store name]:>selected="selected"<:or:><:eif:>><:image_store description:></option>
+<:iterator end image_stores:>
+</select>
+            </td>
+            <td nowrap="nowrap"><:help image name:> <:error_img name:></td>
+          </tr>
   <tr> 
     <td colspan="3" align="right">
       <input type="submit" name="a_save_image" value="Save Image" />
diff --git a/site/util/bse_s3.pl b/site/util/bse_s3.pl
new file mode 100644 (file)
index 0000000..7921df3
--- /dev/null
@@ -0,0 +1,19 @@
+#!perl -w
+use strict;
+use lib '../cgi-bin/modules';
+use BSE::Cfg;
+use BSE::Storage::AmazonS3;
+
+chdir "$FindBin::Bin/../cgi-bin"
+  or warn "Could not change to cgi-bin directory: $!\n";
+
+my $cfg = BSE::Cfg->new;
+
+my $store_name = shift;
+my $action = shift
+  or die "Usage: $0 storage action\n";
+
+$cfg->entry("storage $store_name", "class", '') eq 'BSE::Storage::AmazonS3'
+  or die "$0: $store_name is not an S3 storage\n";
+my $store = BSE::Storage::AmazonS3->new(cfg => $cfg, name => $store_name);
+$store->cmd($action, @ARGV);
diff --git a/site/util/bse_storage.pl b/site/util/bse_storage.pl
new file mode 100644 (file)
index 0000000..1f2c577
--- /dev/null
@@ -0,0 +1,65 @@
+#!perl -w
+use strict;
+use lib '../cgi-bin/modules';
+use BSE::Cfg;
+use BSE::StorageMgr::Images;
+use BSE::StorageMgr::Files;
+use Getopt::Long;
+
+my $verbose;
+
+GetOptions("v", \$verbose);
+
+chdir "$FindBin::Bin/../cgi-bin"
+  or warn "Could not change to cgi-bin directory: $!\n";
+
+my $cfg = BSE::Cfg->new;
+
+my $images = BSE::StorageMgr::Images->new(cfg => $cfg);
+my $files = BSE::StorageMgr::Files->new(cfg => $cfg);
+my %stores =
+  (
+   images => $images,
+   files => $files,
+  );
+
+my $action = shift;
+
+if ($action eq 'list') {
+  for my $type (sort keys %stores) {
+    my @stores = $stores{$type}->all_stores;
+    print "Type $type\n";
+    for my $store (grep $_->name ne 'local', @stores) {
+      print " Storage ", $store->description, " (", $store->name, ")\n";
+      print "  $_\n" for $store->list;
+    }
+  }
+}
+elsif ($action eq 'sync') {
+  my %opts;
+
+  if ($verbose) {
+    $opts{print} = sub { print "  ", @_, "\n"; };
+  }
+  for my $type (sort keys %stores) {
+    print "Type $type\n" if $verbose;
+    my $mgr = $stores{$type};
+    $mgr->sync(%opts);
+  }
+}
+elsif ($action eq 'fixsrc') {
+  for my $type (sort keys %stores) {
+    print "Type $type\n" if $verbose;
+    $stores{$type}->fixsrc;
+  }
+}
+else {
+  print <<EOS;
+Usage: $0 [-v] command
+  -v - display progress information
+Commands:
+  list - list the files stored on each non-local storage
+  sync - synchronize the files stored to the storages selected in 
+         their records
+EOS
+}
index 03d1ce7..00b27bb 100644 (file)
@@ -95,6 +95,8 @@ Column requireUser;int(11);NO;0;
 Column notes;text;NO;;
 Column name;varchar(80);NO;;
 Column hide_from_list;int(11);NO;0;
+Column storage;varchar(20);NO;local;
+Column src;varchar(255);NO;;
 Index PRIMARY;1;[id]
 Table bse_article_groups
 Column article_id;int(11);NO;;
@@ -204,6 +206,8 @@ Column height;smallint(5) unsigned;YES;NULL;
 Column url;varchar(255);YES;NULL;
 Column displayOrder;int(11);NO;0;
 Column name;varchar(255);NO;;
+Column storage;varchar(20);NO;local;
+Column src;varchar(255);NO;;
 Index PRIMARY;1;[id]
 Table order_item
 Column id;int(11);NO;NULL;auto_increment