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 {
  25         # FIXME: Check config
  26         $CF{'Title'} = 'An Unnamed Gallery',
  27         $CF{'HeadExtras'} = "",
  28         $CF{'TopExtras'} = "",
  29         $CF{'BotExtras'} = "",
  30         $CF{'ParentURL'} = '../',
  31         $CF{'BackURL'} = "",
  32         $CF{'FwdURL'} = "",
  33         $CF{'ImageSubpages'} = 1,
  34         $CF{'AllowArchives'} = 1,
  35         $CF{'PhotoUrlPrefix'} = "",
  36         $CF{'ThumbUrlPrefix'} = "",
  37         $CF{'MetaDataDir'} = '.',
  38         $CF{'PhotoDir'} = '.',
  39         # FIXME: Who sets GalDir?
  40
  41         $CF{'ScanDefaultTransform'} = 's';
  42         $CF{'OrigDir'} = '.';
  43         $CF{'PhotoDir'} = 'photo';
  44         $CF{'CacheDir'} = 'cache',
  45         $CF{'PhotoMaxWidth'} = 1024,
  46         $CF{'PhotoMaxHeight'} = 1024,
  47         $CF{'ThumbFormats'} = {},
  48 }
  49
  50 sub LoadConfig() {
  51         my $cfg = "./gallery.cf";
  52         unless (defined do $cfg) {
  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 }
  62
  63 sub SetOptions(@) {
  64         while (my $o = shift @_) {
  65                 my $v = shift @_;
  66                 $CF{$o} = $v;
  67                 if ($o eq "Theme") {
  68                         require $CF{"GalDir"} . "/$v/theme.pm";
  69                         UCW::Gallery::Theme::Init($CF{"GalURL"} . "/$v");
  70                 }
  71         }
  72 }
  73
  74 sub RequireThumbnails($$) {
  75         my ($w, $h) = @_;
  76         my $fmt = "${w}x${h}";
  77         $CF{'ThumbFormats'}->{$fmt} = 1;
  78 }
  79
  80 sub WriteList($$) {
  81         my ($file, $images) = @_;
  82         open LIST, '>', "$file.new" or die "Cannot create $file.new: $!\n";
  83         print LIST "# Image\tID\tRotate\tXform\tTitle\n";
  84         for my $i (@$images) {
  85                 print LIST join("\t",
  86                         $i->{file},
  87                         $i->{id},
  88                         $i->{orientation},
  89                         $i->{xfrm},
  90                         ($i->{title} eq '' ? '-' : $i->{title}),
  91                 ), "\n";
  92         }
  93         close LIST;
  94         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
  95 }
  96
  97 sub ReadList($) {
  98         my ($file) = @_;
  99         my @images = ();
 100         open LIST, '<', $file or return;
 101         while (<LIST>) {
 102                 chomp;
 103                 /^$/ and next;
 104                 /^#/ and next;
 105                 my $i = {};
 106                 ($i->{file}, $i->{id}, $i->{orientation}, $i->{xfrm}, $i->{title}) = split /\t/;
 107                 if ($i->{title} eq '-') { $i->{title} = ""; }
 108                 push @images, $i;
 109         }
 110         close LIST;
 111         return \@images;
 112 }
 113
 114 sub WriteMeta($$) {
 115         my ($file, $meta) = @_;
 116         open META, '>', "$file.new" or die "Cannot create $file.new: $!\n";
 117         Storable::nstore_fd($meta, \*META);
 118         close META;
 119         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
 120 }
 121
 122 sub ReadMeta($) {
 123         my ($file) = @_;
 124         open META, '<', $file or die "Cannot read $file: $!\n";
 125         my $meta = Storable::fd_retrieve(\*META) or die "Cannot parse $file\n";
 126         close META;
 127         return $meta;
 128 }
 129
 130 1;