[rt #1358] revamp imageclean.pl
authorTony Cook <tony@develop-help.com>
Wed, 1 Aug 2012 07:34:35 +0000 (17:34 +1000)
committerTony Cook <tony@develop-help.com>
Wed, 1 Aug 2012 07:34:35 +0000 (17:34 +1000)
- now uses a template for display

- provides a preview of the work to be done

- adds a command-line tool

- allows selection of files to remove (web UI)

- the web UI is now access controlled

13 files changed:
MANIFEST
site/cgi-bin/admin/imageclean.pl
site/cgi-bin/modules/Article.pm
site/cgi-bin/modules/BSE/ImageClean.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/Image.pm
site/cgi-bin/modules/BSE/UI/AdminImageClean.pm [new file with mode: 0644]
site/data/db/bse_msg_base.data
site/data/db/bse_msg_defaults.data
site/templates/admin/imageclean/final.tmpl [new file with mode: 0644]
site/templates/admin/imageclean/intro.tmpl [new file with mode: 0644]
site/templates/admin/imageclean/preview.tmpl [new file with mode: 0644]
site/util/bse_imageclean.pl [new file with mode: 0644]
t/t000load.t

index 8ffc3d2..704e74b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -100,6 +100,7 @@ site/cgi-bin/modules/BSE/Formatter.pm
 site/cgi-bin/modules/BSE/Formatter/Article.pm
 site/cgi-bin/modules/BSE/Formatter/Subscription.pm
 site/cgi-bin/modules/BSE/Generate/Seminar.pm
+site/cgi-bin/modules/BSE/ImageClean.pm
 site/cgi-bin/modules/BSE/ImageHandler/Base.pm
 site/cgi-bin/modules/BSE/ImageHandler/Flash.pm
 site/cgi-bin/modules/BSE/ImageHandler/Img.pm
@@ -236,6 +237,7 @@ site/cgi-bin/modules/BSE/ThumbLow.pm
 site/cgi-bin/modules/BSE/UI.pm
 site/cgi-bin/modules/BSE/UI/AdminAudit.pm
 site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
+site/cgi-bin/modules/BSE/UI/AdminImageClean.pm
 site/cgi-bin/modules/BSE/UI/AdminMessages.pm
 site/cgi-bin/modules/BSE/UI/AdminModules.pm
 site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm
@@ -560,6 +562,9 @@ site/templates/admin/generate.tmpl
 site/templates/admin/grouplist.tmpl
 site/templates/admin/helpicon.tmpl     Help icon template for admin templates
 site/templates/admin/image_edit.tmpl   Edit a single image
+site/templates/admin/imageclean/final.tmpl
+site/templates/admin/imageclean/intro.tmpl
+site/templates/admin/imageclean/preview.tmpl
 site/templates/admin/include/article_menu.tmpl
 site/templates/admin/include/auditentry.tmpl
 site/templates/admin/include/audithead.tmpl
@@ -806,6 +811,7 @@ site/templates/user/unsubone_base.tmpl
 site/templates/user/userpage_base.tmpl
 site/templates/xbase.tmpl
 site/util/bse_back.pl
+site/util/bse_imageclean.pl
 site/util/bse_makeindex.pl
 site/util/bse_mkgitversion.pl
 site/util/bse_msgcheck.pl      Scan for undefined message ids
index 7b0c4bf..a86e243 100755 (executable)
@@ -2,126 +2,6 @@
 use strict;
 use FindBin;
 use lib "$FindBin::Bin/../modules";
-use BSE::API qw(bse_init);
-use BSE::TB::Images;
-use Articles;
-use BSE::CfgInfo qw(cfg_image_dir);
-use File::Spec::Functions qw(catfile);
+use BSE::UI;
 
-bse_init("..");
-
-my %articleIds = ( -1 => 1 );
-my $images = BSE::TB::Images->new;
-my @images = $images->all;
-
-++$|;
-print <<EOS;
-Content-Type: text/plain
-
-Image Cleanup Tool
-------------------
-
-Removing image records that have no article
-EOS
-
-# first remove any image records that don't have a valid article id
-for my $image (@images) {
-  print ".";
-  # do we know about this article id?
-  unless (exists $articleIds{$image->{articleId}}) {
-    $articleIds{$image->{articleId}} = 
-      defined(Articles->getByPkey($image->{articleId}));
-  }
-  unless ($articleIds{$image->{articleId}}) {
-    $image->remove();
-    print "x";
-  }
-}
-
-print "\n\nRebuilding image list and indexing\n";
-# rebuild the images list
-$images = BSE::TB::Images->new;
-@images= $images->all;
-
-my %names = map { $_->{image}, $_->{id} } @images;
-
-print "\n\nScanning for thumbnails\n";
-
-my @articleids = Articles->allids;
-for my $id (@articleids) {
-  my $article = Articles->getByPkey($id)
-    or next;
-  if ($article->{thumbImage}) {
-    $names{$article->{thumbImage}} = "a$id";
-  }
-}
-
-print "\nRemoving unused images\n";
-
-my $image_dir = cfg_image_dir();
-opendir IMG, $image_dir
-  or do { print "Cannot open $image_dir: $!\n"; exit };
-while (defined(my $file = readdir IMG)) {
-  if ($file =~ /^\d{8}/) {
-    print ".";
-    unless ($names{$file} || !-f catfile($image_dir, $file)) {
-      print "x";
-
-      unlink catfile($image_dir, $file)
-       or print "\nCould not remove $image_dir$file: $!\n";
-    }
-  }
-}
-
-print "\nDone\n";
-
-__END__
-
-=head1 NAME
-
-imageclean.pl - clean up the images directory and image records
-
-=head1 SYNOPSIS
-
- (called as a CGI script, no values passed in)
-
-=head1 WARNING
-
-This will remove B<any> images in the configured managed images
-directory that have names starting with 8 or more digits if
-they don't exist in the C<image> table as a record with a current
-article number.
-
-If you need image names of this form, put them elsewhere, or
-reconfigure the managed images directory.
-
-=head1 DESCRIPTION
-
-Scans the C<image> table looking for images that don't have an
-article, and for image files that don't have image records.
-
-The first is required due to a bug in older versions that left the
-image records around when deleting an article.  It's also a recovery
-tool just in case the database loses referential integrity, since
-MySQL doesn't enforce it.
-
-The second is required for two reasons:
-
-=over
-
-=item
-
-older versions didn't remove the image files when images were removed
-
-=item
-
-you may have deleted articles with images under an older version,
-which would have left the image records (and the image files)
-
-=back
-
-=head1 AUTHOR
-
-Tony Cook <tony@develop-help.com>
-
-=cut
+BSE::UI->run("BSE::UI::AdminImageClean", silent_exit => 1 );
index 79b7e28..19f9056 100644 (file)
@@ -8,7 +8,7 @@ use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row BSE::TB::SiteCommon BSE::TB::TagOwner/;
 use Carp 'confess';
 
-our $VERSION = "1.014";
+our $VERSION = "1.015";
 
 =head1 NAME
 
@@ -45,6 +45,12 @@ sub columns {
     category/;
 }
 
+sub db_columns {
+  my ($self) = @_;
+
+  return map { $_ eq "summary" ? "summaryx" : $_ } $self->columns;
+}
+
 =item id
 
 =item parentid
diff --git a/site/cgi-bin/modules/BSE/ImageClean.pm b/site/cgi-bin/modules/BSE/ImageClean.pm
new file mode 100644 (file)
index 0000000..c9404a5
--- /dev/null
@@ -0,0 +1,196 @@
+package BSE::ImageClean;
+use strict;
+use BSE::TB::Images;
+use Articles;
+use BSE::TB::Files;
+use BSE::CfgInfo qw(cfg_image_dir);
+use File::Spec::Functions qw(catfile);
+
+our $VERSION = "1.000";
+
+sub scan {
+  my ($class, $callback) = @_;
+
+  my %articleIds = ( -1 => 1 );
+
+  my %orphan_files;
+  $callback->({type => "stage", stage => "images"});
+  BSE::TB::Images->iterateBy
+      (
+       sub {
+        my ($image) = @_;
+
+        unless (exists $articleIds{$image->{articleId}}) {
+          $articleIds{$image->{articleId}} = 
+            defined(Articles->getByPkey($image->{articleId}));
+        }
+        unless ($articleIds{$image->{articleId}}) {
+          $orphan_files{$image->image} = 1;
+          $callback->({type => "orphanimage", image => $image});
+        }
+       },
+      );
+
+  my %names;
+  $callback->({type => "endstage", stage => "images"});
+  $callback->({type => "stage", stage => "index"});
+  $callback->({type => "substage", stage => "index", substage => "images"});
+  BSE::TB::Images->iterateBy
+      (
+       sub {
+        my ($image) = @_;
+        $names{$image->image} = $image->id;
+       }
+      );
+  $callback->({type => "substage", stage => "index", substage => "thumbnails"});
+  Articles->iterateBy
+    (
+     sub {
+       my ($article) = @_;
+       $names{$article->thumbImage} = "a" . $article->id;
+     },
+     [ '<>', thumbImage => "" ]
+    );
+
+  my $image_dir = cfg_image_dir();
+  my $pub_file_path = BSE::TB::Files->public_path;
+  if ($image_dir eq $pub_file_path) {
+    $callback->({type => "substage", stage => "index", substage => "publicfiles"});
+    BSE::TB::Files->iterateBy
+       (
+        sub {
+          my ($file) = @_;
+          $names{$file->filename} = "f" . $file->id;
+        },
+        [ '<>', is_public => 0 ],
+       );
+  }
+
+  $callback->({type => "endstage", stage => "index"});
+  $callback->({type => "stage", stage => "files"});
+
+  if (opendir my $images, $image_dir) {
+    while (defined(my $file = readdir $images)) {
+      if ($file =~ /^\d{8}/) {
+       unless ($names{$file} || !-f catfile($image_dir, $file)) {
+         $callback->({
+                      type => "orphanfile",
+                      file => $file,
+                      fullfile => catfile($image_dir, $file),
+                     });
+       }
+      }
+    }
+    closedir $images;
+  }
+  else {
+    $callback->({type => "error", error => "Cannot open $image_dir: $!"});
+  }
+  $callback->({type => "endstage", stage => "files"});
+}
+
+1;
+
+=head1 NAME
+
+BSE::ImageClean - logic for finding orphan image files
+
+=head1 SYNOPSIS
+
+  use BSE::ImageClean;
+  BSE::ImageClean->scan
+    (
+     sub {
+       my ($type, @params) = @_;
+       ...
+     }
+    );
+
+=head1 DESCRIPTION
+
+BSE::ImageClean provides the logic for scanning for orphanned image
+files and image objects.
+
+Call the F</scan> class method with a callback and act on the returned
+values.
+
+=head1 CALLBACK
+
+The callback is called with a single parameter, a hashref containing
+at least a C<type> key, depending on the value of type, other keys
+will also be set:
+
+=over
+
+=item *
+
+C<stage> - the stage of processing, The C<stage> key can be any of:
+
+=over
+
+=item *
+
+C<images> - the images table is being scanned for orphan images
+
+=item *
+
+C<index> - the index of in-use image files in the images directory is
+being built.
+
+=item *
+
+C<files> - the image file directory is being scanned for unused
+images.  Only image files with 8 leading digits are included in the
+scan.
+
+=back
+
+=item *
+
+C<substage> - used during the C<index> stage, the C<substage> key
+indicates scanning of the C<images> table, C<thumbnail>s in the
+article table and public C<files> in the L<BSE::TB::Files> table.
+
+=item *
+
+C<endstage> - called at the end of a stage.  The C<stage> key contains
+the key of the stage that's ending.
+
+=item *
+
+C<orphanimage> - an image object was found without an associated
+article.  The C<image> key is the image object.  During final
+processing the remove() method can be called on the image.
+
+=item *
+
+C<orphanfile> - a file that doesn't belong to an unorphaned image, an
+aarticle thumbnail or as a public managed file was found.  The other
+keys that are set are:
+
+=over
+
+=item *
+
+C<file> - the base filename,
+
+=item *
+
+C<fullfile> - the full path to the file
+
+=back
+
+During final processing it's important that files belonging to orphans
+are only removed if the orphan image object is.
+
+=item *
+
+C<error> - an error occurred.  The C<error> key is the error message.
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
index 4ba0590..c286279 100644 (file)
@@ -7,13 +7,15 @@ use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row BSE::ThumbCommon/;
 use Carp qw(confess);
 
-our $VERSION = "1.004";
+our $VERSION = "1.005";
 
 sub columns {
   return qw/id articleId image alt width height url displayOrder name
             storage src ftype/;
 }
 
+sub table { "image" }
+
 sub formatted {
   my ($self, %opts) = @_;
 
diff --git a/site/cgi-bin/modules/BSE/UI/AdminImageClean.pm b/site/cgi-bin/modules/BSE/UI/AdminImageClean.pm
new file mode 100644 (file)
index 0000000..685aa5c
--- /dev/null
@@ -0,0 +1,148 @@
+package BSE::UI::AdminImageClean;
+use strict;
+use base qw(BSE::UI::AdminDispatch);
+use BSE::ImageClean;
+
+our $VERSION = "1.000";
+
+my %actions =
+  (
+   intro => "bse_imageclean",
+   preview => "bse_imageclean",
+   final => "bse_imageclean",
+  );
+
+sub actions { \%actions }
+
+sub rights { \%actions }
+
+sub default_action { "intro" }
+
+sub req_intro {
+  my ($self, $req) = @_;
+
+  my %acts = $req->admin_tags;
+  return $req->dyn_response("admin/imageclean/intro", \%acts);
+}
+
+sub _split_page {
+  my ($self, $req, $template) = @_;
+
+  my %acts = $req->admin_tags;
+  my $temp_result = $req->response($template, \%acts);
+  my ($prefix, $per_message, $suffix) =
+    split /<:\s*iterator\s+(?:begin|end)\s+messages\s*:>/, $temp_result->{content};
+
+  my $charset = $req->cfg->charset;
+  print "Content-Type: ", $temp_result->{type}, "\n";
+  print "\n";
+  print $prefix;
+
+  return ($per_message, $suffix);
+}
+
+sub req_preview {
+  my ($self, $req) = @_;
+
+  my ($per_message, $suffix) = $self->_split_page($req, "admin/imageclean/preview");
+
+  my %acts = $req->admin_tags;
+  ++$|;
+
+  BSE::ImageClean->scan
+      (
+       sub {
+        my ($state) = @_;
+        $req->set_variable(state => $state);
+        $acts{state} = [ \&tag_hash, $state ];
+        print BSE::Template->replace($per_message, $req->cfg, \%acts, $req->{vars});
+       }
+      );
+  print $suffix;
+  return;
+}
+
+sub req_final {
+  my ($self, $req) = @_;
+
+  my ($per_message, $suffix) = $self->_split_page($req, "admin/imageclean/final");
+
+  my %acts = $req->admin_tags;
+  ++$|;
+
+  my %files = map { $_ => 1 } $req->cgi->param("file");
+  my %images = map { $_ => 1 } $req->cgi->param("image");
+
+  BSE::ImageClean->scan
+      (
+       sub {
+        my ($state) = @_;
+        my $acted = 0;
+        if ($state->{type} eq "orphanimage") {
+          $acted = exists $images{$state->{image}->id};
+          $state->{image}->remove if $acted;
+        }
+        elsif ($state->{type} eq "orphanfile") {
+          $acted = exists $files{$state->{file}};
+          unlink $state->{fullfile} if $acted;
+        }
+        $req->set_variable(state => $state);
+        $req->set_variable(acted => $acted);
+        $acts{state} = [ \&tag_hash, $state ];
+        print BSE::Template->replace($per_message, $req->cfg, \%acts, $req->{vars});
+       }
+      );
+  print $suffix;
+  return;
+}
+
+__END__
+
+=head1 NAME
+
+imageclean.pl - clean up the images directory and image records
+
+=head1 SYNOPSIS
+
+ (called as a CGI script, no values passed in)
+
+=head1 WARNING
+
+This will remove B<any> images in the configured managed images
+directory that have names starting with 8 or more digits if
+they don't exist in the C<image> table as a record with a current
+article number.
+
+If you need image names of this form, put them elsewhere, or
+reconfigure the managed images directory.
+
+=head1 DESCRIPTION
+
+Scans the C<image> table looking for images that don't have an
+article, and for image files that don't have image records.
+
+The first is required due to a bug in older versions that left the
+image records around when deleting an article.  It's also a recovery
+tool just in case the database loses referential integrity, since
+MySQL doesn't enforce it.
+
+The second is required for two reasons:
+
+=over
+
+=item
+
+older versions didn't remove the image files when images were removed
+
+=item
+
+you may have deleted articles with images under an older version,
+which would have left the image records (and the image files)
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
index fe671b8..1961c62 100644 (file)
@@ -1,5 +1,5 @@
 --
-# VERSION=1.002
+# VERSION=1.003
 id: bse/
 description: BSE messages
 
@@ -272,6 +272,60 @@ description: Attempted to create or save a message to a language not in the conf
 id: bse/admin/message/badmultiline
 description: Multiple lines of text supplied when creating or saving a single line message
 
+id: bse/admin/imageclean/
+description: Messages/text for the imageclean tool(s)
+
+id: bse/admin/imageclean/stage/
+description: imageclean stage descriptions
+
+id: bse/admin/imageclean/stage/images
+description: Scanning images stage
+
+id: bse/admin/imageclean/stage/index
+description: Indexing file names from objects stage
+
+id: bse/admin/imageclean/stage/files
+description: Scanning files in the images directory for orphans
+
+id: bse/admin/imageclean/substage/
+description: Descriptions of substages
+
+id: bse/admin/imageclean/substage/index/
+description: Descriptions of substages of the index stage
+
+id: bse/admin/imageclean/substage/index/images
+description: Descriptions of the images substages of the index stage
+
+id: bse/admin/imageclean/substage/index/thumbnails
+description: Descriptions of the thumbnails substage of the index stage
+
+id: bse/admin/imageclean/substage/index/publicfiles
+description: Descriptions of publicfiles substage of the index stage
+
+id: bse/admin/imageclean/preview/
+description: Messages for images and files found during preview
+
+id: bse/admin/imageclean/preview/image
+description: Displayed for an orphan image object (%1 is the object id, %2 the filename)
+
+id: bse/admin/imageclean/preview/file
+description: Displayed for an orphan file (%1 is the filename)
+
+id: bse/admin/imageclean/process/
+description: Messages displayed during final processing
+
+id: bse/admin/imageclean/process/removefile
+description: Displayed when an orphan file is removed (%1 - filename)
+
+id: bse/admin/imageclean/process/removeimage
+description: Displayed when an orphan image is removed (%1 - image id, %2 - image filename)
+
+id: bse/admin/imageclean/process/skipfile
+description: Displayed when an orphan file is skipped (%1 - filename)
+
+id: bse/admin/imageclean/process/skipimage
+description: Displayed when an orphan image is skipped (%1 - image id, %2 - image filename)
+
 id: bse/shop/
 description: Shop messages
 
index beab50e..71d468e 100644 (file)
@@ -184,6 +184,42 @@ message: You don't have access to this function (%1:s)
 id: bse/admin/makeindex/complete
 message: Search index rebuild complete
 
+id: bse/admin/imageclean/stage/images
+message: Scanning image objects
+
+id: bse/admin/imageclean/stage/index
+message: Indexing file names from objects
+
+id: bse/admin/imageclean/stage/files
+message: Scanning files in the images directory for orphans
+
+id: bse/admin/imageclean/substage/index/images
+message: Image objects
+
+id: bse/admin/imageclean/substage/index/thumbnails
+message: Article thumbnails
+
+id: bse/admin/imageclean/substage/index/publicfiles
+message: Public managed files
+
+id: bse/admin/imageclean/preview/image
+message: Image: %1:d (%2:s)
+
+id: bse/admin/imageclean/preview/file
+message: File: %1:s
+
+id: bse/admin/imageclean/process/removefile
+message: Removed file '%1:s'
+
+id: bse/admin/imageclean/process/removeimage
+message: Removed image %1:d (%2:s)
+
+id: bse/admin/imageclean/process/skipfile
+message: Skipped file '%1:s'
+
+id: bse/admin/imageclean/process/skipimage
+message: Skipped image %1:d (%2:s)
+
 id: bse/shop/cart/empty
 message: Cart emptied
 
diff --git a/site/templates/admin/imageclean/final.tmpl b/site/templates/admin/imageclean/final.tmpl
new file mode 100644 (file)
index 0000000..9fddedb
--- /dev/null
@@ -0,0 +1,23 @@
+<:wrap admin/base.tmpl title => "Image Clean":>
+
+<h1>Image Clean - Processing</h1>
+
+<p>| <a href="<:= cfg.admin_url("menu") | html :>">Admin Menu</a>
+|</p>
+
+<div class="imageclean">
+<:iterator begin messages:>
+<:-.set msgbase = [ state, "msg:bse/admin/imageclean/" ][1] -:>
+<:- .if state.type eq "stage" -:>
+  <h1><:= request.htmlmsg("msg:bse/admin/imageclean/stage/" _ state.stage) -:></h1>
+<: .elsif state.type eq "substage" -:>
+  <h2><:= request.htmlmsg("msg:bse/admin/imageclean/substage/" _ state.stage _ "/" _ state.substage) -:></h2>
+<: .elsif state.type eq "orphanimage" :>
+  <div><:= request.htmlmsg(msgbase _ "process/" _ ( acted ? "remove" : "skip" ) _ "image", [ state.image.id, state.image.image ]) :></div>
+<: .elsif state.type eq "orphanfile" :>
+  <div><:= request.htmlmsg(msgbase _ "process/" _ ( acted ? "remove" : "skip" ) _ "file", [ state.file ]) :></div>
+<: .elsif state.type eq "error" :>
+<div class="message error"><:= state.error | html :></div>
+<: .end if -:>
+<:iterator end messages:>
+</div>
diff --git a/site/templates/admin/imageclean/intro.tmpl b/site/templates/admin/imageclean/intro.tmpl
new file mode 100644 (file)
index 0000000..b86d61e
--- /dev/null
@@ -0,0 +1,8 @@
+<:wrap admin/base.tmpl title => "Image Clean":>
+
+<h1>Image Clean</h1>
+
+<p>This process will remove any orphan image objects and files from
+the image directory.</p>
+
+<p><a href="<:= cfg.admin_url2("imageclean", "preview") | html :>">Start</a></p>
diff --git a/site/templates/admin/imageclean/preview.tmpl b/site/templates/admin/imageclean/preview.tmpl
new file mode 100644 (file)
index 0000000..e9c2ca8
--- /dev/null
@@ -0,0 +1,28 @@
+<:wrap admin/base.tmpl title => "Image Clean":>
+
+<h1>Image Clean - Preview</h1>
+
+<p>| <a href="<:= cfg.admin_url("menu") | html :>">Admin Menu</a>
+|</p>
+
+<form action="<:= cfg.admin_url2("imageclean") | html :>" method="post">
+<div class="imageclean">
+<:iterator begin messages:>
+<:-.set msgbase = [ state, "msg:bse/admin/imageclean/" ][1] -:>
+<:- .if state.type eq "stage" -:>
+  <h1><:= request.catmsg(msgbase _ "stage/" _ state.stage) -:></h1>
+<: .elsif state.type eq "substage" -:>
+  <h2><:= request.htmlmsg(msgbase _ "substage/" _ state.stage _ "/" _ state.substage) -:></h2>
+<: .elsif state.type eq "orphanimage" :>
+  <div><input type="checkbox" name="image" value="<:= state.image.id :>" checked="checked" />
+  <:= request.htmlmsg(msgbase _ "preview/image", [ state.image.id, state.image.image ]) :></div>
+<: .elsif state.type eq "orphanfile" :>
+  <div><input type="checkbox" name="file" value="<:= state.file :>" checked="checked" />
+  <:= request.htmlmsg(msgbase _ "preview/file", [ state.file ]) :></div>
+<: .elsif state.type eq "error" :>
+<div class="message error"><:= state.error | html :></div>
+<: .end if -:>
+<:iterator end messages:>
+<input type="submit" name="a_final" value="Clean up these files" />
+</div>
+</form>
diff --git a/site/util/bse_imageclean.pl b/site/util/bse_imageclean.pl
new file mode 100644 (file)
index 0000000..f47ed70
--- /dev/null
@@ -0,0 +1,124 @@
+#!perl -w
+use strict;
+use Getopt::Long;
+use FindBin;
+use Encode;
+
+Getopt::Long::Configure('bundling');
+my $verbose;
+my $actions;
+my $nothing;
+my $bse_dir = "../cgi-bin";
+my $help;
+GetOptions
+  (
+   "v", \$verbose,
+   "a|actions" => \$actions,
+   "b|bse" => \$bse_dir,
+   "n|nothing" => \$nothing,
+   "h" => \$help,
+  );
+
+if ($help) {
+  print <<EOS;
+Usage: perl $0 [options]
+Options:
+ -n - only display the actions to perform, but make no changes
+      (displays items as "skipped")
+ -a - display the actions as their done
+ -b cgidir - locate the BSE CGI directory (default ../cgi-bin)
+ -v - display progress as tables and directories are scanned
+ -h - display this help text
+
+Invocation without options will silently remove orphan image objects
+and files.
+EOS
+  exit 0;
+}
+
+unshift @INC, "$bse_dir/modules";
+
+require BSE::Console;
+
+my $req = BSE::Console->new(cgidir => $bse_dir);
+
+$nothing and ++$actions;
+
+require BSE::ImageClean;
+
+my $action = $nothing ? "skip" : "remove";
+
+my $msgbase = "msg:bse/admin/imageclean";
+
+BSE::ImageClean->scan
+  (
+   sub {
+     my $state = shift;
+     if ($verbose) {
+       if ($state->{type} eq "stage") {
+        print $req->catmsg("$msgbase/stage/$state->{stage}", [], $state->{stage}), "\n";
+       }
+       elsif ($state->{type} eq "substage") {
+        print "  ", $req->catmsg("$msgbase/substage/$state->{stage}/$state->{substage}", [], $state->{substage}), "\n";
+       }
+     }
+
+     if ($state->{type} eq "orphanimage") {
+       print "    ", $req->catmsg("$msgbase/process/${action}image", [ $state->{image}->id, $state->{image}->image ]), "\n"
+        if $verbose || $actions;
+       $state->{image}->remove unless $nothing;
+     }
+     elsif ($state->{type} eq "orphanfile") {
+       print "    ", $req->catmsg("$msgbase/process/${action}file", [ $state->{file} ]), "\n"
+        if $verbose || $actions;
+       unlink $state->{fullfile} unless $nothing;
+     }
+   }
+  );
+
+exit;
+
+=head1 NAME
+
+bse_imageclean.pl - clean up image objects and files
+
+=head1 SYNOPSIS
+
+  # clean up images silently
+  perl bse_imageclean.pl
+
+  # clean up images verbosely
+  perl bse_imageclean.pl -v
+
+  # clean up images indicating work done (no headings)
+  perl bse_imageclean.pl -a
+
+  # summarize what will be done cleaning up images
+  # implies -a
+  perl bse_imageclean.pl -n
+
+=head1 DESCRIPTION
+
+C<bse_imageclean.pl> is a command-line tool to clean up image objects
+and the image file directory.
+
+You can supply a C<-v> option to produce progress output.  This output
+assumes your terminal encoding matches the BSE configured character
+encoding.
+
+The C<-a> option only displays the work lines from the C<-v> output,
+this can be used in a C<cron> job to alert you if file have been left
+orphan (since cron only sends email if there's output.)
+
+You can supply a C<-n> option to display vebose output without doing
+the actual clean up, this implies C<-a>.
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=head1 SEE ALSO
+
+imageclean.pl, BSE::ImageClean, BSE::UI::AdminImageClean
+
+=cut
index 155f23d..0d61d96 100644 (file)
@@ -1,6 +1,6 @@
 #!perl -w
 use strict;
-use Test::More tests => 28;
+use Test::More tests => 30;
 use_ok("BSE::Cfg");
 use_ok("Squirrel::Template");
 use_ok("BSE::Template");
@@ -29,3 +29,5 @@ use_ok("BSE::UI::Page");
 use_ok("BSE::UserReg");
 use_ok("BSE::Index");
 use_ok("BSE::Index::BSE");
+use_ok("BSE::ImageClean");
+use_ok("BSE::UI::AdminImageClean");