gal/UCW/Gallery.pm

   1 # Simple Photo Gallery
   2 # (c) 2003--2014 Martin Mares <mj@ucw.cz>
   3
   4 package UCW::Gallery;
   5
   6 use strict;
   7 use warnings;
   8
   9 use File::Spec;
  10 use Storable;
  11
  12 ### Class methods ###
  13
  14 sub new($) {
  15         my ($class) = @_;
  16         my $self = { };
  17         $self->{cfg} = {
  18                 # Directories
  19                 OrigDir => '.',                 # Original images
  20                 PhotoDir => 'photo',            # Scaled-down photos for web
  21                 CacheDir => 'cache',            # Cache with meta-data and thumbnails
  22
  23                 # URL prefixes
  24                 PhotoUrlPrefix => 'photo/',
  25                 ThumbUrlPrefix => 'thumb/',
  26                 ThemeUrlPrefix => 'gal/',
  27
  28                 # Processing machinery settings
  29                 ScanDefaultTransform => 's',
  30                 PhotoMaxWidth => 1024,
  31                 PhotoMaxHeight => 1024,
  32                 ThumbFormats => [ "114x94" ],   # Built-in themes use the first size,
  33                                                 # but more can be generated
  34                 CacheExif => 0,                 # Cache selected EXIF meta-data
  35
  36                 # Titles and navigation
  37                 Title => 'An Unnamed Gallery',
  38                 SubTitle => "",
  39                 ParentURL => '../',
  40                 BackURL => "",
  41                 FwdURL => "",
  42
  43                 # Hacks
  44                 GeoHack => 0,
  45         };
  46         return bless $self, $class;
  47 }
  48
  49 sub load_config($) {
  50         my $cfg = "./gallery.cf";
  51         my $self = do $cfg;
  52         unless (defined $self) {
  53                 if ($@) {
  54                         die "Error parsing $cfg: $@";
  55                 } elsif ($!) {
  56                         die "Cannot load $cfg: $!\n";
  57                 } else {
  58                         die "Cannot load $cfg, check that it returns true\n";
  59                 }
  60         }
  61         return $self;
  62 }
  63
  64 ### Object methods ###
  65
  66 sub get($$) {
  67         my ($self, $key) = @_;
  68         if (exists $self->{cfg}->{$key}) {
  69                 my $val = $self->{cfg}->{$key};
  70                 defined $val or warn "Gallery: Config item $key is not set\n";
  71                 return $val;
  72         } else {
  73                 warn "Gallery: Config item $key does not exist\n";
  74                 return;
  75         }
  76 }
  77
  78 sub try_get($$) {
  79         my ($self, $key) = @_;
  80         return $self->{cfg}->{$key};
  81 }
  82
  83 sub def($@) {
  84         my $self = shift;
  85         while (my $key = shift @_) {
  86                 my $val = shift @_;
  87                 $self->{cfg}->{$key} //= $val;
  88         }
  89 }
  90
  91 sub set($@) {
  92         my $self = shift;
  93         while (my $key = shift @_) {
  94                 $self->{cfg}->{$key} = shift @_;
  95         }
  96 }
  97
  98 sub get_config_keys($) {
  99         my ($self) = @_;
 100         return keys %{$self->{cfg}};
 101 }
 102
 103 sub write_list($$$) {
 104         my ($self, $file, $images) = @_;
 105         open my $fh, '>:utf8', "$file.new" or die "Cannot create $file.new: $!\n";
 106         for my $i (@$images) {
 107                 print $fh join("\t",
 108                         $i->{file},
 109                         $i->{id},
 110                         $i->{orientation},
 111                         $i->{xfrm},
 112                         ($i->{title} eq '' ? '-' : $i->{title}),
 113                 ), "\n";
 114         }
 115         close $fh;
 116         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 117 }
 118
 119 sub read_list($$) {
 120         my ($self, $file) = @_;
 121         my @images = ();
 122         open my $fh, '<:utf8', $file or return;
 123         while (<$fh>) {
 124                 chomp;
 125                 /^$/ and next;
 126                 /^#/ and next;
 127                 my $i = {};
 128                 ($i->{file}, $i->{id}, $i->{orientation}, $i->{xfrm}, $i->{title}) = split /\t/;
 129                 if ($i->{title} eq '-') { $i->{title} = ""; }
 130                 push @images, $i;
 131         }
 132         close $fh;
 133         return \@images;
 134 }
 135
 136 sub write_meta($$) {
 137         my ($self, $file, $meta) = @_;
 138         open my $fh, '>', "$file.new" or die "Cannot create $file.new: $!\n";
 139         Storable::nstore_fd($meta, $fh);
 140         close $fh;
 141         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 142 }
 143
 144 sub read_meta($) {
 145         my ($self, $file) = @_;
 146         open my $fh, '<', $file or die "Cannot read $file: $!\n";
 147         my $meta = Storable::fd_retrieve($fh) or die "Cannot parse $file\n";
 148         close $fh;
 149         return $meta;
 150 }
 151
 152 sub photo_meta_name($) {
 153         my ($self) = @_;
 154         return File::Spec->catfile($self->get('PhotoDir'), 'gallery.meta');
 155 }
 156
 157 sub cache_meta_name($) {
 158         my ($self) = @_;
 159         return File::Spec->catfile($self->get('CacheDir'), 'cache.meta');
 160 }
 161
 162 sub thumb_fmt_to_size($$) {
 163         my ($self, $fmt) = @_;
 164         my ($tw, $th) = ($fmt =~ m{^(\d+)x(\d+)$}) or die "Cannot parse thumbnail format $fmt\n";
 165         return ($tw, $th);
 166 }
 167
 168 sub photo_file_name($$$) {
 169         my ($self, $photo_meta, $id) = @_;
 170         return $id . '.' . ($photo_meta->{fmt} // 'jpg');
 171 }
 172
 173 sub photo_name($$$) {
 174         my ($self, $photo_meta, $id) = @_;
 175         return File::Spec->catfile($self->get('PhotoDir'), $self->photo_file_name($photo_meta, $id));
 176 }
 177
 178
 179 1;