| 
49
 | 
     1 use strict;
 | 
| 
 | 
     2 package DOM::Gallery;
 | 
| 
 | 
     3 use Common;
 | 
| 
 | 
     4 our @ISA = qw(Object);
 | 
| 
 | 
     5 
 | 
| 
 | 
     6 BEGIN {
 | 
| 
 | 
     7     DeclareProperty(Id => ACCESS_READ);
 | 
| 
 | 
     8     DeclareProperty(Name => ACCESS_READ);
 | 
| 
 | 
     9     DeclareProperty(Description => ACCESS_READ);
 | 
| 
 | 
    10     DeclareProperty(Images => ACCESS_READ);
 | 
| 
 | 
    11     DeclareProperty(CurrentImage => ACCESS_READ);
 | 
| 
 | 
    12     DeclareProperty(NextImage => ACCESS_READ);
 | 
| 
 | 
    13     DeclareProperty(PrevImage => ACCESS_READ);
 | 
| 
 | 
    14 }
 | 
| 
 | 
    15 
 | 
| 
 | 
    16 sub CTOR {
 | 
| 
 | 
    17     my ($this,%args) = @_;
 | 
| 
 | 
    18     
 | 
| 
 | 
    19     $this->{$Id} = $args{'Id'};
 | 
| 
 | 
    20     $this->{$Name} = $args{'Name'};
 | 
| 
 | 
    21     $this->{$Description} = $args{'Description'};
 | 
| 
 | 
    22 }
 | 
| 
 | 
    23 
 | 
| 
 | 
    24 sub GroupList {
 | 
| 
 | 
    25     my ($this,$GroupCount, $option) = @_;
 | 
| 
 | 
    26     
 | 
| 
 | 
    27     my @images = map { $this->{$Images}->{$_} } sort keys %{$this->{$Images}};
 | 
| 
 | 
    28     
 | 
| 
 | 
    29     my @listGroups;
 | 
| 
 | 
    30     my $group;
 | 
| 
 | 
    31     for (my $i = 0; $i < $GroupCount; $i++ ) {
 | 
| 
 | 
    32         #last unless scalar(@images) or $option =~ /align/i; 
 | 
| 
 | 
    33         push (@$group, shift(@images));
 | 
| 
 | 
    34         if ($i == $GroupCount - 1) {
 | 
| 
 | 
    35             push @listGroups, $group;
 | 
| 
 | 
    36             undef $group;
 | 
| 
 | 
    37             $i = -1;
 | 
| 
 | 
    38             last if not scalar(@images);
 | 
| 
 | 
    39         }
 | 
| 
 | 
    40     }
 | 
| 
 | 
    41     
 | 
| 
 | 
    42     return \@listGroups;
 | 
| 
 | 
    43 }
 | 
| 
 | 
    44 
 | 
| 
 | 
    45 sub SelectImage {
 | 
| 
 | 
    46     my ($this,$imageId) = @_;
 | 
| 
 | 
    47     
 | 
| 
 | 
    48     my @images = sort keys %{$this->{$Images}};
 | 
| 
 | 
    49     
 | 
| 
 | 
    50     for (my $i=0; $i <= @images; $i++) {
 | 
| 
 | 
    51         if ($images[$i] eq $imageId) {
 | 
| 
 | 
    52             $this->{$CurrentImage} = $this->{$Images}->{$images[$i]};
 | 
| 
 | 
    53             $this->{$PrevImage} = $i-1 >= 0 ? $this->{$Images}->{$images[$i-1]} : undef;
 | 
| 
 | 
    54             $this->{$NextImage} = $i+1 < @images ? $this->{$Images}->{$images[$i+1]} : undef;
 | 
| 
 | 
    55             return 1;
 | 
| 
 | 
    56         }
 | 
| 
 | 
    57     }
 | 
| 
 | 
    58     die new Exception("An image '$imageId' not found in the gallery '$this->{$Id}'");
 | 
| 
 | 
    59 }
 | 
| 
 | 
    60 
 | 
| 
 | 
    61 sub AddImage {
 | 
| 
 | 
    62     my ($this,$image) = @_;
 | 
| 
 | 
    63     
 | 
| 
 | 
    64     $this->{$Images}->{$image->Id()} = $image;
 | 
| 
 | 
    65 }
 | 
| 
 | 
    66 
 | 
| 
 | 
    67 package DOM::Gallery::Image;
 | 
| 
 | 
    68 use Common;
 | 
| 
 | 
    69 our @ISA = qw(Object);
 | 
| 
 | 
    70 BEGIN {
 | 
| 
 | 
    71     DeclareProperty(Id => ACCESS_READ);
 | 
| 
 | 
    72     DeclareProperty(Name => ACCESS_READ);
 | 
| 
 | 
    73     DeclareProperty(Gallery => ACCESS_READ);
 | 
| 
 | 
    74     DeclareProperty(URL => ACCESS_READ);
 | 
| 
 | 
    75     DeclareProperty(ThumbURL => ACCESS_READ);
 | 
| 
 | 
    76 }
 | 
| 
 | 
    77 
 | 
| 
 | 
    78 sub CTOR {
 | 
| 
 | 
    79     my ($this,%args) = @_;
 | 
| 
 | 
    80     
 | 
| 
 | 
    81     $this->{$Id} = $args{'Id'} or die new Exception ('An Id should be specified for an image');
 | 
| 
 | 
    82     $this->{$Name} = $args{'Name'};
 | 
| 
 | 
    83     $this->{$Gallery} = $args{'Gallery'} or die new Exception('An Gallery should be specified for an image');
 | 
| 
 | 
    84     $this->{$URL} = $args{'URL'};
 | 
| 
 | 
    85     $this->{$ThumbURL} = $args{'ThumbURL'};
 | 
| 
 | 
    86 }
 | 
| 
 | 
    87 
 | 
| 
 | 
    88 package DOM::Providers::Gallery;
 | 
| 
 | 
    89 use Common;
 | 
| 
 | 
    90 our @ISA = qw(Object);
 | 
| 
 | 
    91 
 | 
| 
 | 
    92 our $RepoPath;
 | 
| 
 | 
    93 our $ImagesURL;
 | 
| 
 | 
    94 our $Encoding;
 | 
| 
 | 
    95 
 | 
| 
 | 
    96 BEGIN {
 | 
| 
 | 
    97     DeclareProperty(GalleryCache => ACCESS_NONE);
 | 
| 
 | 
    98     DeclareProperty(Repository => ACCESS_NONE);
 | 
| 
 | 
    99 }
 | 
| 
 | 
   100 
 | 
| 
 | 
   101 sub CTOR {
 | 
| 
 | 
   102     my ($this,%args) = @_;
 | 
| 
 | 
   103     
 | 
| 
 | 
   104     $this->{$Repository} = $args {'Repository'} or die new Exception('A path to an galleries repository should be specified');
 | 
| 
 | 
   105 }
 | 
| 
 | 
   106 
 | 
| 
 | 
   107 sub GetProviderInfo() {
 | 
| 
 | 
   108     return {
 | 
| 
 | 
   109         Name => 'Gallery',
 | 
| 
 | 
   110         Host => 'DOM::Site',
 | 
| 
 | 
   111         Methods => {
 | 
| 
 | 
   112             LoadGallery => \&SiteLoadGallery #($this,$site,$galleryId)
 | 
| 
 | 
   113         }
 | 
| 
 | 
   114     };
 | 
| 
 | 
   115 }
 | 
| 
 | 
   116 
 | 
| 
 | 
   117 sub SiteLoadGallery {
 | 
| 
 | 
   118     my ($this,$site,$galleryId) = @_;
 | 
| 
 | 
   119     
 | 
| 
 | 
   120     my $gallery = $this->LoadGallery($galleryId);
 | 
| 
 | 
   121     
 | 
| 
 | 
   122     $site->RegisterObject('Gallery',$gallery);
 | 
| 
 | 
   123     
 | 
| 
 | 
   124     return $gallery;
 | 
| 
 | 
   125 }
 | 
| 
 | 
   126 
 | 
| 
 | 
   127 sub LoadGallery {
 | 
| 
 | 
   128     my ($this,$galleryId) = @_;
 | 
| 
 | 
   129     
 | 
| 
 | 
   130     die new Exception("Invalid Gallery Id: $galleryId") if $galleryId =~ /\\|\//;
 | 
| 
 | 
   131     
 | 
| 
 | 
   132     my $galleryIdPath = $galleryId;
 | 
| 
 | 
   133     $galleryIdPath =~ s/\./\//g;
 | 
| 
 | 
   134     
 | 
| 
 | 
   135     my $GalleryPath = $this->{$Repository} . $galleryIdPath .'/';
 | 
| 
 | 
   136     
 | 
| 
 | 
   137     die new Exception("A gallery '$galleryId' isn't found",$GalleryPath) if not -d $GalleryPath;
 | 
| 
 | 
   138     
 | 
| 
 | 
   139     open my $hDesc, "<:encoding($Encoding)", $GalleryPath.'index.htm' or die new Exception("Invalid gallery: $galleryId","Failed to open ${GalleryPath}index.htm: $!");
 | 
| 
 | 
   140     
 | 
| 
 | 
   141     my $GalleryName;   
 | 
| 
 | 
   142     while (<$hDesc>) {
 | 
| 
 | 
   143         if (/<title>(.+?)<\/title>/i) {
 | 
| 
 | 
   144             $GalleryName = $1;
 | 
| 
 | 
   145             last;
 | 
| 
 | 
   146         }
 | 
| 
 | 
   147     }    
 | 
| 
 | 
   148     undef $hDesc;
 | 
| 
 | 
   149     
 | 
| 
 | 
   150     my $ImagesPath = $GalleryPath.'images/';
 | 
| 
 | 
   151     my $ThumbsPath = $GalleryPath.'thumbnails/';
 | 
| 
 | 
   152     
 | 
| 
 | 
   153     opendir my $hImages, $ImagesPath or die new Exception("Invalid gallery: $galleryId","Can't open images repository: $!");
 | 
| 
 | 
   154     
 | 
| 
 | 
   155     my @imageIds = grep { -f $ImagesPath.$_ } readdir $hImages;
 | 
| 
 | 
   156     
 | 
| 
 | 
   157     my %imageNames;
 | 
| 
 | 
   158     
 | 
| 
 | 
   159     if (-f $GalleryPath.'description.txt') {
 | 
| 
 | 
   160         local $/="\n";
 | 
| 
 | 
   161         if (open my $hfile,"<:encoding($Encoding)",$GalleryPath.'description.txt') {
 | 
| 
 | 
   162             while (<$hfile>) {
 | 
| 
 | 
   163                 chomp;
 | 
| 
 | 
   164                 my ($id,$name) = split /\s*=\s*/;
 | 
| 
 | 
   165                 $imageNames{$id} = $name;
 | 
| 
 | 
   166             }
 | 
| 
 | 
   167         }
 | 
| 
 | 
   168     }
 | 
| 
 | 
   169     
 | 
| 
 | 
   170     undef $hImages;
 | 
| 
 | 
   171     
 | 
| 
 | 
   172     if ($Common::Debug) {
 | 
| 
 | 
   173         foreach (@imageIds) {
 | 
| 
 | 
   174             warn "A tumb isn't found for an image: $_" if not -f $ThumbsPath.$_;
 | 
| 
 | 
   175         }
 | 
| 
 | 
   176     }
 | 
| 
 | 
   177     
 | 
| 
 | 
   178     my $gallery = new DOM::Gallery(Id => $galleryId, Name => $GalleryName);
 | 
| 
 | 
   179     
 | 
| 
 | 
   180     foreach my $imageId (@imageIds) {
 | 
| 
 | 
   181         $gallery->AddImage(new DOM::Gallery::Image(
 | 
| 
 | 
   182                 Id => $imageId,
 | 
| 
 | 
   183                 URL => $ImagesURL.$galleryIdPath.'/images/'.$imageId,
 | 
| 
 | 
   184                 ThumbURL => $ImagesURL.$galleryIdPath.'/thumbnails/'.$imageId,
 | 
| 
 | 
   185                 Gallery => $gallery,
 | 
| 
 | 
   186                 Name => $imageNames{$imageId}
 | 
| 
 | 
   187             )
 | 
| 
 | 
   188         );
 | 
| 
 | 
   189     }
 | 
| 
 | 
   190     
 | 
| 
 | 
   191     return $gallery;
 | 
| 
 | 
   192 }
 | 
| 
 | 
   193 
 | 
| 
 | 
   194 sub construct {
 | 
| 
 | 
   195     my $self = shift;
 | 
| 
 | 
   196     
 | 
| 
 | 
   197     return new DOM::Providers::Gallery( Repository => $RepoPath);
 | 
| 
 | 
   198 }
 | 
| 
 | 
   199 
 | 
| 
 | 
   200 1;
 |