lib/UCW/Gallery/Web.pm

   1 # Simple Photo Gallery: Web Interface
   2 # (c) 2003--2012 Martin Mares <mj@ucw.cz>
   3
   4 package UCW::Gallery::Web;
   5
   6 use common::sense;
   7
   8 use UCW::Gallery;
   9 use UCW::CGI;
  10 use File::Spec;
  11
  12 my $show_img;
  13 my $want_archive;
  14
  15 my %args = (
  16         'i'     => { 'var' => \$show_img, 'check' => '\d+' },
  17         'a'     => { 'var' => \$want_archive },
  18 );
  19
  20 sub error($) {
  21         print "<p style='color:red'>Bad luck, the script is broken. Sorry.\n<p>$_[0]\n";
  22         print "</body></html>\n";
  23 }
  24
  25 sub get($$) {
  26         my ($self, $key) = @_;
  27         return $self->{gal}->get($key);
  28 }
  29
  30 sub extras($$) {
  31         my ($self, $key) = @_;
  32         my $val = $self->get($key);
  33         if (ref $val eq 'CODE') {
  34                 return &$val($self);
  35         } else {
  36                 return $val;
  37         }
  38 }
  39
  40 # For use by extras hooks
  41 sub gallery($) {
  42         my ($self) = @_;
  43         return $self->{gal};
  44 }
  45
  46 # For use by extras hooks: return true if we are showing an image page, false for index page
  47 sub showing_image($) {
  48         my ($self) = @_;
  49         return $show_img ne "";
  50 }
  51
  52 sub html_top($) {
  53         my ($self) = @_;
  54         my $title = UCW::CGI::html_escape($self->get('Title'));
  55         my $hextras = $self->extras('WebHeadExtras');
  56         my $theme_hextras = $self->theme_head_extras;
  57         print <<EOF ;
  58 Content-Type: text/html
  59
  60 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
  61 <html><head>
  62 $hextras$theme_hextras<title>$title</title>
  63 </head><body>
  64 EOF
  65
  66         $UCW::CGI::ErrorHandler::error_hook = \&error;
  67
  68         # WebTopExtras are evaluated separately, since they can override the error hook
  69         print $self->extras('WebTopExtras');
  70 }
  71
  72 sub html_bot($) {
  73         my ($self) = @_;
  74         print $self->extras('WebBotExtras'), "</body></html>\n";
  75 }
  76
  77 sub show_img($) {
  78         my ($self) = @_;
  79
  80         if ($show_img < 1 || $show_img > $self->{num_photos}) {
  81                 UCW::CGI::http_error('404 No such photo');
  82                 return;
  83         }
  84
  85         my $meta = $self->{meta};
  86         my $id = $meta->{sequence}->[$show_img-1];
  87         my $m = $meta->{photo}->{$id} or die;
  88         $self->html_top;
  89
  90         $self->show_links(($show_img > 1 ? ("?i=".($show_img-1)) : ""),
  91                           ".",
  92                           ($show_img < $self->{num_photos} ? ("?i=".($show_img+1)) : ""));
  93
  94         my $t = UCW::CGI::html_escape($m->{title});
  95         my $w = $m->{w};
  96         my $h = $m->{h};
  97         print "<h1>$t</h1>\n" if $t ne "";
  98         my $img = $self->get('PhotoUrlPrefix') . $self->{gal}->photo_file_name($m, $id);
  99         print "<p class=large><img src='$img' width=$w height=$h alt='$t'>\n";
 100
 101         $self->html_bot;
 102 }
 103
 104 sub show_pre_thumbs($) {
 105         my ($self) = @_;
 106 }
 107
 108 sub show_post_thumbs($) {
 109         my ($self) = @_;
 110 }
 111
 112 sub show_list($) {
 113         my ($self) = @_;
 114         $self->html_top;
 115
 116         $self->show_links($self->get('BackURL'), $self->get('ParentURL'), $self->get('FwdURL'));
 117         print "<h1>", $self->get('Title'), "</h1>\n";
 118         my $subtitle = $self->get('SubTitle');
 119         print "<h2>$subtitle</h2>\n" if $subtitle ne "";
 120         $self->show_pre_thumbs;
 121
 122         my $meta = $self->{meta};
 123         for my $idx (1..$self->{num_photos}) {
 124                 my $id = $meta->{sequence}->[$idx-1];
 125                 my $m = $meta->{photo}->{$id};
 126                 my $click_url;
 127                 if ($self->get('WebImageSubpages')) {
 128                         $click_url = "?i=$idx";
 129                 } else {
 130                         $click_url = $self->get('PhotoUrlPrefix') . $self->{gal}->photo_file_name($m, $id);
 131                 }
 132                 $self->show_thumb($meta, $id, $click_url);
 133         }
 134
 135         $self->show_post_thumbs;
 136         $self->html_bot();
 137 }
 138
 139 sub dispatch($) {
 140         my ($self) = @_;
 141         binmode STDOUT, ':utf8';
 142         UCW::CGI::parse_args(\%args);
 143         $self->{meta} = $self->{gal}->read_meta(File::Spec->catfile($self->get('CacheDir'), 'cache.meta'));
 144         $self->{num_photos} = scalar @{$self->{meta}->{sequence}};
 145
 146         if ($want_archive) {
 147                 require UCW::Gallery::Archive;
 148                 UCW::Gallery::Archive::send_archive($self->{gal}, $self->{meta});
 149         } elsif ($show_img ne "") {
 150                 $self->show_img;
 151         } else {
 152                 $self->show_list;
 153         }
 154 }
 155
 156 sub attach($$) {
 157         my ($class, $gal) = @_;
 158         my $self = { gal => $gal };
 159         $gal->def(
 160                 WebFE => $self,
 161
 162                 # Extras are either strings or functions called with the current gallery object as parameter
 163                 WebHeadExtras => "",
 164                 WebTopExtras => "",
 165                 WebBotExtras => "",
 166
 167                 # Used by the theming logic
 168                 WebThemeCSS => undef,
 169
 170                 # 1 if thumbnail link to sub-pages with images, 0 if they link directly to image files
 171                 WebImageSubpages => 1,
 172
 173                 # If enabled, calling the CGI with a=zip produces a ZIP archive with all photos.
 174                 WebAllowArchives => 1,
 175         );
 176         bless $self, $class;
 177         return $self;
 178 }
 179
 180 42;