gal2/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 strict;
   7 use warnings;
   8
   9 use UCW::Gallery;
  10 use UCW::CGI;
  11 use File::Spec;
  12
  13 my $show_img;
  14
  15 my %args = (
  16         'i'     => { 'var' => \$show_img, 'check' => '\d+' },
  17 );
  18
  19 sub error($) {
  20         print "<p style='color:red'>Bad luck, the script is broken. Sorry.\n<p>$_[0]\n";
  21         print "</body></html>\n";
  22 }
  23
  24 sub get($$) {
  25         my ($self, $key) = @_;
  26         return $self->{gal}->get($key);
  27 }
  28
  29 sub html_top($) {
  30         my ($self) = @_;
  31         my $title = UCW::CGI::html_escape($self->get('Title'));
  32         my $hextras = $self->get('WebHeadExtras');
  33         my $textras = $self->get('WebTopExtras');
  34         my $theme_hextras = $self->theme_head_extras;
  35         print <<EOF ;
  36 Content-Type: text/html
  37
  38 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
  39 <html><head>
  40 $hextras$theme_hextras<title>$title</title>
  41 </head><body>
  42 $textras
  43 EOF
  44         $UCW::CGI::ErrorHandler::error_hook = \&error;
  45 }
  46
  47 sub html_bot($) {
  48         my ($self) = @_;
  49         print $self->get('WebBotExtras'), "</body></html>\n";
  50 }
  51
  52 sub show_img($) {
  53         my ($self) = @_;
  54
  55         if ($show_img < 1 || $show_img > $self->{num_photos}) {
  56                 UCW::CGI::http_error('404 No such photo');
  57                 return;
  58         }
  59
  60         my $meta = $self->{meta};
  61         my $id = $meta->{sequence}->[$show_img-1];
  62         my $m = $meta->{photo}->{$id} or die;
  63         $self->html_top;
  64
  65         $self->show_links(($show_img > 1 ? ("?i=".($show_img-1)) : ""),
  66                           ".",
  67                           ($show_img < $self->{num_photos} ? ("?i=".($show_img+1)) : ""));
  68
  69         my $t = UCW::CGI::html_escape($m->{title});
  70         my $w = $m->{w};
  71         my $h = $m->{h};
  72         print "<h1>$t</h1>\n" if $t ne "";
  73         my $img = $self->get('PhotoUrlPrefix') . $id . '.jpg';
  74         print "<p class=large><img src='$img' width=$w height=$h alt='$t'>\n";
  75
  76         $self->html_bot;
  77 }
  78
  79 sub show_pre_thumbs($) {
  80         my ($self) = @_;
  81 }
  82
  83 sub show_post_thumbs($) {
  84         my ($self) = @_;
  85 }
  86
  87 sub show_list($) {
  88         my ($self) = @_;
  89         $self->html_top;
  90
  91         $self->show_links($self->get('BackURL'), $self->get('ParentURL'), $self->get('FwdURL'));
  92         print "<h1>", $self->get('Title'), "</h1>\n";
  93         my $subtitle = $self->get('SubTitle');
  94         print "<h2>$subtitle</h2>\n" if $subtitle ne "";
  95         $self->show_pre_thumbs;
  96
  97         my $meta = $self->{meta};
  98         for my $idx (1..$self->{num_photos}) {
  99                 my $id = $meta->{sequence}->[$idx-1];
 100                 my $click_url;
 101                 if ($self->get('WebImageSubpages')) {
 102                         $click_url = "?i=$idx";
 103                 } else {
 104                         $click_url = $self->get('PhotoUrlPrefix') . "$id.jpg";
 105                 }
 106                 $self->show_thumb($meta, $id, $click_url);
 107         }
 108
 109         $self->show_post_thumbs;
 110         $self->html_bot();
 111 }
 112
 113 sub dispatch($) {
 114         my ($self) = @_;
 115         binmode STDOUT, ':utf8';
 116         UCW::CGI::parse_args(\%args);
 117         $self->{meta} = $self->{gal}->read_meta(File::Spec->catfile($self->get('CacheDir'), 'cache.meta'));
 118         $self->{num_photos} = scalar @{$self->{meta}->{sequence}};
 119
 120         if ($show_img ne "") {
 121                 $self->show_img;
 122         } else {
 123                 $self->show_list;
 124         }
 125 }
 126
 127 sub attach($$) {
 128         my ($class, $gal) = @_;
 129         my $self = { gal => $gal };
 130         $gal->def(
 131                 WebFE => $self,
 132                 WebHeadExtras => "",
 133                 WebTopExtras => "",
 134                 WebBotExtras => "",
 135                 WebThemeCSS => undef,
 136                 WebImageSubpages => 1,
 137         );
 138         bless $self, $class;
 139         return $self;
 140 }
 141
 142 42;