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