gal/UCW/Gallery.pm

   1 # Simple Photo Gallery
   2 # (c) 2003--2012 Martin Mares <mj@ucw.cz>
   3
   4 package UCW::Gallery;
   5
   6 use strict;
   7 use warnings;
   8
   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
  34                 # Titles and navigation
  35                 Title => 'An Unnamed Gallery',
  36                 SubTitle => "",
  37                 ParentURL => '../',
  38                 BackURL => "",
  39                 FwdURL => "",
  40         };
  41         return bless $self, $class;
  42 }
  43
  44 sub load_config($) {
  45         my $cfg = "./gallery.cf";
  46         my $self = do $cfg;
  47         unless (defined $self) {
  48                 if ($@) {
  49                         die "Error parsing $cfg: $@";
  50                 } elsif ($!) {
  51                         die "Cannot load $cfg: $!\n";
  52                 } else {
  53                         die "Cannot load $cfg, check that it returns true\n";
  54                 }
  55         }
  56         return $self;
  57 }
  58
  59 ### Object methods ###
  60
  61 sub get($$) {
  62         my ($self, $key) = @_;
  63         if (exists $self->{cfg}->{$key}) {
  64                 my $val = $self->{cfg}->{$key};
  65                 defined $val or warn "Gallery: Config item $key is not set\n";
  66                 return $val;
  67         } else {
  68                 warn "Gallery: Config item $key does not exist\n";
  69                 return;
  70         }
  71 }
  72
  73 sub def($@) {
  74         my $self = shift;
  75         while (my $key = shift @_) {
  76                 my $val = shift @_;
  77                 $self->{cfg}->{$key} //= $val;
  78         }
  79 }
  80
  81 sub set($@) {
  82         my $self = shift;
  83         while (my $key = shift @_) {
  84                 $self->{cfg}->{$key} = shift @_;
  85         }
  86 }
  87
  88 sub get_config_keys($) {
  89         my ($self) = @_;
  90         return keys %{$self->{cfg}};
  91 }
  92
  93 sub write_list($$$) {
  94         my ($self, $file, $images) = @_;
  95         open my $fh, '>:utf8', "$file.new" or die "Cannot create $file.new: $!\n";
  96         for my $i (@$images) {
  97                 print $fh join("\t",
  98                         $i->{file},
  99                         $i->{id},
 100                         $i->{orientation},
 101                         $i->{xfrm},
 102                         ($i->{title} eq '' ? '-' : $i->{title}),
 103                 ), "\n";
 104         }
 105         close $fh;
 106         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 107 }
 108
 109 sub read_list($$) {
 110         my ($self, $file) = @_;
 111         my @images = ();
 112         open my $fh, '<:utf8', $file or return;
 113         while (<$fh>) {
 114                 chomp;
 115                 /^$/ and next;
 116                 /^#/ and next;
 117                 my $i = {};
 118                 ($i->{file}, $i->{id}, $i->{orientation}, $i->{xfrm}, $i->{title}) = split /\t/;
 119                 if ($i->{title} eq '-') { $i->{title} = ""; }
 120                 push @images, $i;
 121         }
 122         close $fh;
 123         return \@images;
 124 }
 125
 126 sub write_meta($$) {
 127         my ($self, $file, $meta) = @_;
 128         open my $fh, '>', "$file.new" or die "Cannot create $file.new: $!\n";
 129         Storable::nstore_fd($meta, $fh);
 130         close $fh;
 131         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 132 }
 133
 134 sub read_meta($) {
 135         my ($self, $file) = @_;
 136         open my $fh, '<', $file or die "Cannot read $file: $!\n";
 137         my $meta = Storable::fd_retrieve($fh) or die "Cannot parse $file\n";
 138         close $fh;
 139         return $meta;
 140 }
 141
 142 sub photo_meta_name($) {
 143         my ($self) = @_;
 144         return File::Spec->catfile($self->get('PhotoDir'), 'gallery.meta');
 145 }
 146
 147 sub cache_meta_name($) {
 148         my ($self) = @_;
 149         return File::Spec->catfile($self->get('CacheDir'), 'cache.meta');
 150 }
 151
 152 sub thumb_fmt_to_size($$) {
 153         my ($self, $fmt) = @_;
 154         my ($tw, $th) = ($fmt =~ m{^(\d+)x(\d+)$}) or die "Cannot parse thumbnail format $fmt\n";
 155         return ($tw, $th);
 156 }
 157
 158 1;