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