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 BEGIN {
  12         # Standard Perl module stuff
  13         use Exporter();
  14         our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  15         $VERSION = 1.00;
  16         @ISA = qw(Exporter);
  17         @EXPORT = qw(&SetOptions);
  18         %EXPORT_TAGS = ();
  19         @EXPORT_OK = qw(%CF);
  20 }
  21
  22 our %CF;
  23
  24 BEGIN { %CF = (
  25         # Directories
  26         OrigDir => '.',                 # Original images
  27         PhotoDir => 'photo',            # Scaled-down photos for web
  28         CacheDir => 'cache',            # Cache with meta-data and thumbnails
  29         ThemeDir => 'gal',              # Themes
  30
  31         # URL prefixes
  32         PhotoUrlPrefix => 'photo/',
  33         ThumbUrlPrefix => 'thumb/',
  34         ThemeUrlPrefix => 'gal/',
  35
  36         # Processing machinery settings
  37         ScanDefaultTransform => 's',
  38         PhotoMaxWidth => 1024,
  39         PhotoMaxHeight => 1024,
  40         ThumbFormats => {},             # Set up by themes
  41
  42         # HTML output settings
  43         Title => 'An Unnamed Gallery',
  44         HeadExtras => "",
  45         TopExtras => "",
  46         BotExtras => "",
  47         ParentURL => '../',
  48         BackURL => "",
  49         FwdURL => "",
  50         ImageSubpages => 1,
  51 ); }
  52
  53 sub LoadConfig() {
  54         my $cfg = "./gallery.cf";
  55         unless (defined do $cfg) {
  56                 if ($@) {
  57                         die "Error parsing $cfg: $@";
  58                 } elsif ($!) {
  59                         die "Cannot load $cfg: $!\n";
  60                 } else {
  61                         die "Cannot load $cfg, check that it returns true\n";
  62                 }
  63         }
  64 }
  65
  66 sub SetOptions(@) {
  67         while (my $o = shift @_) {
  68                 my $v = shift @_;
  69                 $CF{$o} = $v;
  70                 if ($o eq "Theme") {
  71                         require $CF{'ThemeDir'} . "/$v/theme.pm";
  72                         UCW::Gallery::Theme::Init($CF{'ThemeUrlPrefix'} . $v);
  73                 }
  74         }
  75 }
  76
  77 sub RequireThumbnails($$) {
  78         my ($w, $h) = @_;
  79         my $fmt = "${w}x${h}";
  80         $CF{'ThumbFormats'}->{$fmt} = 1;
  81 }
  82
  83 sub WriteList($$) {
  84         my ($file, $images) = @_;
  85         open LIST, '>', "$file.new" or die "Cannot create $file.new: $!\n";
  86         for my $i (@$images) {
  87                 print LIST join("\t",
  88                         $i->{file},
  89                         $i->{id},
  90                         $i->{orientation},
  91                         $i->{xfrm},
  92                         ($i->{title} eq '' ? '-' : $i->{title}),
  93                 ), "\n";
  94         }
  95         close LIST;
  96         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
  97 }
  98
  99 sub ReadList($) {
 100         my ($file) = @_;
 101         my @images = ();
 102         open LIST, '<', $file or return;
 103         while (<LIST>) {
 104                 chomp;
 105                 /^$/ and next;
 106                 /^#/ and next;
 107                 my $i = {};
 108                 ($i->{file}, $i->{id}, $i->{orientation}, $i->{xfrm}, $i->{title}) = split /\t/;
 109                 if ($i->{title} eq '-') { $i->{title} = ""; }
 110                 push @images, $i;
 111         }
 112         close LIST;
 113         return \@images;
 114 }
 115
 116 sub WriteMeta($$) {
 117         my ($file, $meta) = @_;
 118         open META, '>', "$file.new" or die "Cannot create $file.new: $!\n";
 119         Storable::nstore_fd($meta, \*META);
 120         close META;
 121         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 122 }
 123
 124 sub ReadMeta($) {
 125         my ($file) = @_;
 126         open META, '<', $file or die "Cannot read $file: $!\n";
 127         my $meta = Storable::fd_retrieve(\*META) or die "Cannot parse $file\n";
 128         close META;
 129         return $meta;
 130 }
 131
 132 1;