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 BEGIN {
  10         # Standard Perl module stuff
  11         use Exporter();
  12         our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  13         $VERSION = 1.00;
  14         @ISA = qw(Exporter);
  15         @EXPORT = qw(&SetOptions);
  16         %EXPORT_TAGS = ();
  17         @EXPORT_OK = qw(%CF);
  18 }
  19
  20 our %CF;
  21 our $th;
  22
  23 BEGIN {
  24         $CF{'Title'} = 'An Unnamed Gallery',
  25         $CF{'HeadExtras'} = "",
  26         $CF{'TopExtras'} = "",
  27         $CF{'BotExtras'} = "",
  28         $CF{'ParentURL'} = '../',
  29         $CF{'BackURL'} = "",
  30         $CF{'FwdURL'} = "",
  31         $CF{'ImageSubpages'} = 1,
  32         $CF{'AllowArchives'} = 1,
  33         $CF{'PhotoUrlPrefix'} = "",
  34         $CF{'ThumbUrlPrefix'} = "",
  35         $CF{'MetaDataDir'} = '.',
  36         $CF{'PhotoDir'} = '.',
  37
  38         $CF{'ScanDefaultTransform'} = 'n';
  39         $CF{'OrigDir'} = '.';
  40         $CF{'PhotoDir'} = 'photo';
  41         $CF{'CacheDir'} = "cache",
  42 }
  43
  44 sub LoadConfig() {
  45         my $cfg = "./gallery.cf";
  46         unless (defined do $cfg) {
  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 }
  56
  57 sub SetOptions(@) {
  58         while (my $o = shift @_) {
  59                 my $v = shift @_;
  60                 $CF{$o} = $v;
  61                 if ($o eq "Theme") {
  62                         require $CF{"GalDir"} . "/$v/theme.pm";
  63                         Gallery::Theme::Init($CF{"GalURL"} . "/$v");
  64                 }
  65         }
  66 }
  67
  68 sub WriteList($$) {
  69         my ($file, $images) = @_;
  70         open LIST, '>', "$file.new" or die "Cannot create $file.new: $!\n";
  71         print LIST "# Image\tID\tRotate\tXform\tTitle\n";
  72         for my $i (@$images) {
  73                 print LIST join("\t",
  74                         $i->{file},
  75                         $i->{id},
  76                         $i->{orientation},
  77                         $i->{xfrm},
  78                         ($i->{title} eq '' ? '-' : $i->{title}),
  79                 ), "\n";
  80         }
  81         close LIST;
  82         rename "$file.new", $file or die "Cannot rename $file.new to $file: $!\n";
  83 }
  84
  85 sub ReadList($) {
  86         my ($file) = @_;
  87         my @images = ();
  88         open LIST, '<', $file or return;
  89         while (<LIST>) {
  90                 chomp;
  91                 /^$/ and next;
  92                 /^#/ and next;
  93                 my $i = {};
  94                 ($i->{file}, $i->{id}, $i->{orientation}, $i->{xfrm}, $i->{title}) = split /\t/;
  95                 if ($i->{title} eq '-') { $i->{title} = ""; }
  96                 push @images, $i;
  97         }
  98         close LIST;
  99         return \@images;
 100 }
 101
 102 1;