lib/UCW/Gallery.pm

   1 # Simple Photo Gallery
   2 # (c) 2003--2015 Martin Mares <mj@ucw.cz>
   3
   4 package UCW::Gallery;
   5
   6 use common::sense;
   7
   8 use File::Spec;
   9 use Storable;
  10
  11 ### Class methods ###
  12
  13 sub new($) {
  14         my ($class) = @_;
  15         my $self = { };
  16         $self->{cfg} = {
  17                 # Directories
  18                 OrigDir => '.',                 # Original images
  19                 PhotoDir => 'photo',            # Scaled-down photos for web
  20                 CacheDir => 'cache',            # Cache with meta-data and thumbnails
  21
  22                 # URL prefixes
  23                 PhotoUrlPrefix => 'photo/',
  24                 ThumbUrlPrefix => 'thumb/',
  25                 ThemeUrlPrefix => 'gal/',
  26
  27                 # Processing machinery settings
  28                 ScanDefaultTransform => 's',
  29                 PhotoMaxWidth => 1024,
  30                 PhotoMaxHeight => 1024,
  31                 ThumbFormats => [ "114x94" ],   # Built-in themes use the first size,
  32                                                 # but more can be generated
  33                 CacheExif => 0,                 # Cache selected EXIF meta-data
  34                 CacheHashes => 1,               # Let gal-scan cache file hashes
  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 our %list_attrs = (
 104         'file' => 0,            # 0 = not permitted as extended attribute
 105         'id' => 0,
 106         'orientation' => 1,     # 1 = aliases for normal attributes
 107         'title' => 1,
 108         'xf' => 2,              # 2 = ... and propagated to gal-gen
 109         'lat' => 3,             # 3 = normal extended attributes, propagated to gal-gen
 110         'lon' => 3,
 111         'alt' => 3,
 112         't' => 3,
 113 );
 114
 115 sub write_list($$$) {
 116         my ($self, $file, $images) = @_;
 117         open my $fh, '>:utf8', "$file.new" or die "Cannot create $file.new: $!\n";
 118         for my $i (@$images) {
 119                 print $fh join("\t",
 120                         $i->{file},
 121                         $i->{id},
 122                         $i->{orientation},
 123                         $i->{xf},
 124                         ($i->{title} eq '' ? '-' : $i->{title}),
 125                 ), "\n";
 126                 for my $k (keys %$i) {
 127                         print $fh "\t$k=", $i->{$k}, "\n" if $list_attrs{$k} >= 3;
 128                 }
 129         }
 130         close $fh;
 131         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 132 }
 133
 134 sub read_list_fh($$) {
 135         my ($self, $fh) = @_;
 136         my @images = ();
 137         while (<$fh>) {
 138                 chomp;
 139                 /^$/ and next;
 140                 /^#/ and next;
 141                 if (/^\t/) {
 142                         @images or die "Misplaced continuation line before first image\n";
 143                         if (my ($k, $v) = /^\t+(.*?)=(.*)/) {
 144                                 # Continutation of previous line
 145                                 my $i = $images[-1];
 146                                 if ($list_attrs{$k}) {
 147                                         $i->{$k} = $v;
 148                                 } else {
 149                                         print STDERR "Ignoring unknown attribute $k for ", $i->{file}, "\n";
 150                                 }
 151                         } else {
 152                                 die "Invalid continuation line. Expecting 'key=value'.\n";
 153                         }
 154                 } else {
 155                         my $i = {};
 156                         ($i->{file}, $i->{id}, $i->{orientation}, $i->{xf}, $i->{title}) = split /\t/;
 157                         if (!defined $i->{title} || $i->{title} eq '-') { $i->{title} = ""; }
 158                         push @images, $i;
 159                 }
 160         }
 161         return \@images;
 162 }
 163
 164 sub read_list($$) {
 165         my ($self, $file) = @_;
 166         open my $fh, '<:utf8', $file or return;
 167         my $list = $self->read_list_fh($fh);
 168         close $fh;
 169         return $list;
 170 }
 171
 172 sub write_meta($$) {
 173         my ($self, $file, $meta) = @_;
 174         open my $fh, '>', "$file.new" or die "Cannot create $file.new: $!\n";
 175         Storable::nstore_fd($meta, $fh);
 176         close $fh;
 177         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 178 }
 179
 180 sub read_meta($) {
 181         my ($self, $file) = @_;
 182         open my $fh, '<', $file or die "Cannot read $file: $!\n";
 183         my $meta = Storable::fd_retrieve($fh) or die "Cannot parse $file\n";
 184         close $fh;
 185         return $meta;
 186 }
 187
 188 sub photo_meta_name($) {
 189         my ($self) = @_;
 190         return File::Spec->catfile($self->get('PhotoDir'), 'gallery.meta');
 191 }
 192
 193 sub cache_meta_name($) {
 194         my ($self) = @_;
 195         return File::Spec->catfile($self->get('CacheDir'), 'cache.meta');
 196 }
 197
 198 sub thumb_fmt_to_size($$) {
 199         my ($self, $fmt) = @_;
 200         my ($tw, $th) = ($fmt =~ m{^(\d+)x(\d+)$}) or die "Cannot parse thumbnail format $fmt\n";
 201         return ($tw, $th);
 202 }
 203
 204 sub photo_file_name($$$) {
 205         my ($self, $photo_meta, $id) = @_;
 206         return $id . '.' . ($photo_meta->{fmt} // 'jpg');
 207 }
 208
 209 sub photo_name($$$) {
 210         my ($self, $photo_meta, $id) = @_;
 211         return File::Spec->catfile($self->get('PhotoDir'), $self->photo_file_name($photo_meta, $id));
 212 }
 213
 214
 215 1;