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         print LIST "# Image\tID\tRotate\tXform\tTitle\n";
  87         for my $i (@$images) {
  88                 print LIST join("\t",
  89                         $i->{file},
  90                         $i->{id},
  91                         $i->{orientation},
  92                         $i->{xfrm},
  93                         ($i->{title} eq '' ? '-' : $i->{title}),
  94                 ), "\n";
  95         }
  96         close LIST;
  97         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
  98 }
  99
 100 sub ReadList($) {
 101         my ($file) = @_;
 102         my @images = ();
 103         open LIST, '<', $file or return;
 104         while (<LIST>) {
 105                 chomp;
 106                 /^$/ and next;
 107                 /^#/ and next;
 108                 my $i = {};
 109                 ($i->{file}, $i->{id}, $i->{orientation}, $i->{xfrm}, $i->{title}) = split /\t/;
 110                 if ($i->{title} eq '-') { $i->{title} = ""; }
 111                 push @images, $i;
 112         }
 113         close LIST;
 114         return \@images;
 115 }
 116
 117 sub WriteMeta($$) {
 118         my ($file, $meta) = @_;
 119         open META, '>', "$file.new" or die "Cannot create $file.new: $!\n";
 120         Storable::nstore_fd($meta, \*META);
 121         close META;
 122         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 123 }
 124
 125 sub ReadMeta($) {
 126         my ($file) = @_;
 127         open META, '<', $file or die "Cannot read $file: $!\n";
 128         my $meta = Storable::fd_retrieve(\*META) or die "Cannot parse $file\n";
 129         close META;
 130         return $meta;
 131 }
 132
 133 1;