Gallery2: Archiving and generalized HTML extras

diff --git a/gal2/Makefile b/gal2/Makefile
index 02713b8942ee29feb0f4b4cd5a221862b81fd9f5..c57a4f3ca4f3bc9fbd35c2dfdfee2161405363c2 100644 (file)
--- a/gal2/Makefile
+++ b/gal2/Makefile
@@ -1,6 +1,8 @@
 $(eval $(dir-setup))
 
-$(call lib-copy, UCW/Gallery.pm UCW/Gallery/Web.pm UCW/Gallery/Web/NrtBlue.pm UCW/Gallery/Web/Plain.pm UCW/Gallery/Web/HighSlide.pm)
+$(call lib-copy, UCW/Gallery.pm)
+$(call lib-copy, $(addprefix UCW/Gallery/, Web.pm Archive.pm))
+$(call lib-copy, $(addprefix UCW/Gallery/Web/, Plain.pm NrtBlue.pm HighSlide.pm))
 
 $(call copy, $(addprefix nrt-blue/,back.png bot.png left.png next.png prev.png right.png top.png style.css))
 $(call copy, $(addprefix plain/,back.png next.png prev.png style.css))

diff --git a/gal2/UCW/Gallery/Archive.pm b/gal2/UCW/Gallery/Archive.pm
new file mode 100644 (file)
index 0000000..0cf8553
--- /dev/null
+++ b/gal2/UCW/Gallery/Archive.pm
@@ -0,0 +1,32 @@
+# Simple Photo Gallery: Archiving
+# (c) 2003--2012 Martin Mares <mj@ucw.cz>
+
+package UCW::Gallery::Archive;
+
+use strict;
+use warnings;
+
+use Archive::Zip;
+use File::Spec;
+use UCW::CGI;
+
+sub send_archive($$) {
+       my ($gal, $meta) = @_;
+
+       if (!$gal->get('WebAllowArchives')) {
+               UCW::CGI::http_error('403 Archiving forbidden by server configuration');
+               return;
+       }
+
+       my $zip = Archive::Zip->new;
+       my $cnt = 0;
+       for my $id (@{$meta->{sequence}}) {
+               $zip->addFile(File::Spec->catfile($gal->get('PhotoDir'), "$id.jpg"), sprintf("%03d.jpg", $cnt)) or die;
+               $cnt++;
+       }
+
+       print "Content-type: application/zip\n\n";
+       $zip->writeToFileHandle(\*STDOUT, 0);
+}
+
+42;

diff --git a/gal2/UCW/Gallery/Web.pm b/gal2/UCW/Gallery/Web.pm
index 1af530ea6734ea165f8ec270dc7f0b9228d25215..dbf913a63de4858f97fbdb8ef1359cb08cbf4d47 100644 (file)
--- a/gal2/UCW/Gallery/Web.pm
+++ b/gal2/UCW/Gallery/Web.pm
@@ -11,9 +11,11 @@ use UCW::CGI;
 use File::Spec;
 
 my $show_img;
+my $want_archive;
 
 my %args = (
        'i'     => { 'var' => \$show_img, 'check' => '\d+' },
+       'a'     => { 'var' => \$want_archive },
 );
 
 sub error($) {
@@ -26,11 +28,21 @@ sub get($$) {
        return $self->{gal}->get($key);
 }
 
+sub extras($$) {
+       my ($self, $key) = @_;
+       my $val = $self->get($key);
+       if (ref $val eq 'CODE') {
+               return &$val($self->{gal});
+       } else {
+               return $val;
+       }
+}
+
 sub html_top($) {
        my ($self) = @_;
        my $title = UCW::CGI::html_escape($self->get('Title'));
-       my $hextras = $self->get('WebHeadExtras');
-       my $textras = $self->get('WebTopExtras');
+       my $hextras = $self->extras('WebHeadExtras');
+       my $textras = $self->extras('WebTopExtras');
        my $theme_hextras = $self->theme_head_extras;
        print <<EOF ;
 Content-Type: text/html
@@ -46,7 +58,7 @@ EOF
 
 sub html_bot($) {
        my ($self) = @_;
-       print $self->get('WebBotExtras'), "</body></html>\n";
+       print $self->extras('WebBotExtras'), "</body></html>\n";
 }
 
 sub show_img($) {
@@ -117,7 +129,10 @@ sub dispatch($) {
        $self->{meta} = $self->{gal}->read_meta(File::Spec->catfile($self->get('CacheDir'), 'cache.meta'));
        $self->{num_photos} = scalar @{$self->{meta}->{sequence}};
 
-       if ($show_img ne "") {
+       if ($want_archive) {
+               require UCW::Gallery::Archive;
+               UCW::Gallery::Archive::send_archive($self->{gal}, $self->{meta});
+       } elsif ($show_img ne "") {
                $self->show_img;
        } else {
                $self->show_list;
@@ -129,11 +144,20 @@ sub attach($$) {
        my $self = { gal => $gal };
        $gal->def(
                WebFE => $self,
+
+               # Extras are either strings or functions called with the current gallery object as parameter
                WebHeadExtras => "",
                WebTopExtras => "",
                WebBotExtras => "",
+
+               # Used by the theming logic
                WebThemeCSS => undef,
+
+               # 1 if thumbnail link to sub-pages with images, 0 if they link directly to image files
                WebImageSubpages => 1,
+
+               # If enabled, calling the CGI with a=zip produces a ZIP archive with all photos.
+               WebAllowArchives => 1,
        );
        bless $self, $class;
        return $self;