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; |