File Coverage

blib/lib/App/MaMGal/Entry.pm
Criterion Covered Total %
statement 54 70 77.1
branch 15 22 68.1
condition 7 12 58.3
subroutine 20 27 74.0
pod 0 21 0.0
total 96 152 63.1


line stmt bran cond sub pod time code
1             # mamgal - a program for creating static image galleries
2             # Copyright 2007-2010 Marcin Owsiany
3             # See the README file for license information
4             # Any interesting entry (picture or subdirectory)
5             package App::MaMGal::Entry;
6 5     5   34070 use strict;
  5         8  
  5         146  
7 5     5   22 use warnings;
  5         8  
  5         131  
8 5     5   22 use base 'App::MaMGal::Base';
  5         8  
  5         1659  
9 5     5   24 use Carp;
  5         9  
  5         246  
10 5     5   22 use File::Basename;
  5         9  
  5         366  
11 5     5   22 use File::stat;
  5         8  
  5         39  
12              
13             sub init
14             {
15 90     90 0 117 my $self = shift;
16 90 100       392 my $dirname = shift or croak "Need dir"; # the directory which contains this entry, relative to WD or absolute
17 87 100       275 my $basename = shift or croak "Need basename"; # under $dirname
18 84 100 33     295 confess "A basename of \".\" used when other would be possible (last component of $dirname)" if $basename eq '.' and not ($dirname eq '.' or $dirname eq '/');
      66        
19 81 100       234 confess "Basename [$basename] contains a slash" if $basename =~ m{/};
20             # We might not be able to get stat information (e.g. no execute permission on containing directory), so do not croak
21 78         106 my $stat = shift;
22 78 100 66     476 confess "Third argument must be a File::stat, if provided" unless (not defined $stat) or (ref $stat and $stat->isa('File::stat'));
      66        
23 75 100       742 confess "At most 3 args expected, got fourth: [$_[0]]" if @_;
24              
25 72         159 $self->{dir_name} = $dirname;
26 72         102 $self->{base_name} = $basename;
27 72         107 $self->{stat} = $stat;
28 72         180 $self->{path_name} = $dirname.'/'.$basename;
29 72         195 $self->{tools} = {};
30             }
31              
32             sub add_tools
33             {
34 72     72 0 94 my $self = shift;
35 72         86 my $tools = shift;
36 72         237 foreach (keys %$tools) { $self->{tools}->{$_} = $tools->{$_} }
  144         344  
37             }
38              
39             sub tools
40             {
41 156     156 0 351 my $self = shift;
42 156         559 return $self->{tools};
43             }
44              
45             sub logger
46             {
47 6     6 0 2395 my $self = shift;
48 6         14 return $self->tools->{logger};
49             }
50              
51             # TODO: element should not have a need to know its index, container should be able to tell it simply given the object
52 0     0 0 0 sub element_index { $_[0]->{element_index} }
53 0     0 0 0 sub set_element_index { $_[0]->{element_index} = $_[1] }
54 6     6 0 2923 sub name { $_[0]->{base_name} }
55 6     6 0 2606 sub description { '' }
56 6     6 0 383 sub set_container { $_[0]->{container} = $_[1] }
57              
58             sub container
59             {
60 6     6 0 3005 my $self = shift;
61 6 50       35 unless (defined $self->{container}) {
62             # TODO this will lead to creation of a strange split tree if it
63             # is traversed again from container to this child
64 6         18 $self->set_container($self->tools->{entry_factory}->create_entry_for($self->{dir_name}));
65             }
66 6         44 return $self->{container};
67             }
68              
69             sub containers
70             {
71 0     0 0 0 my $self = shift;
72 0         0 return ($self->container->containers, $self->container);
73             }
74              
75             sub neighbours
76             {
77 0     0 0 0 my $self = shift;
78             # TODO this should in theory use container method rather than the hash
79             # element, but because this method needs element_index to be available
80             # (which is only set in the entity if it is instantiated by its
81             # container), then this will break in mysterious ways if the container
82             # method has to instantiate the container object
83 0 0       0 return (undef, undef) unless $self->{container};
84 0         0 return $self->{container}->neighbours_of_index($self->element_index);
85             }
86              
87             # Returns the best available approximation of creation time of this entry
88             sub creation_time
89             {
90 10     10 0 5073 my $self = shift;
91 10         14 my $stat = $self->{stat};
92             # We might not be able to get stat information (broken symlink, no permissions, ...)
93 10 100       43 return undef unless $stat;
94             # We need to use st_mtime, for lack of anything better
95 4         29 return $stat->mtime;
96             }
97              
98             sub content_modification_time
99             {
100 0     0 0 0 my $self = shift;
101 0         0 return $self->App::MaMGal::Entry::creation_time(@_);
102             }
103              
104             sub fresher_than_me
105             {
106 0     0 0 0 my $self = shift;
107 0         0 my $path = shift;
108 0         0 my %opts = @_;
109 0 0       0 my $stat = stat($path) or return 0;
110 0 0       0 return 1 if $stat->mtime >= $self->content_modification_time(%opts);
111 0         0 return 0;
112             }
113              
114             # Whether this entry should be shown in a directory contents montage
115       3 0   sub is_interesting { }
116              
117             # Some constants
118             our $slides_dir = '.mamgal-slides';
119 6     6 0 2852 sub slides_dir { $slides_dir }
120 6     6 0 3030 sub thumbnails_dir { '.mamgal-thumbnails' }
121 0     0 0 0 sub medium_dir { '.mamgal-medium' }
122              
123             #######################################################################################################################
124             # Abstract methods
125             # these two need to return the text of the link ...
126 2     2 0 2845 sub page_path { croak(sprintf("INTERNAL ERROR: Class [%s] does not define page_path.", ref(shift))) }
127 2     2 0 2842 sub thumbnail_path { croak(sprintf("INTERNAL ERROR: Class [%s] does not define thumbnail_path.", ref(shift))) }
128              
129             1;