| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# mamgal - a program for creating static image galleries |
|
2
|
|
|
|
|
|
|
# Copyright 2008-2011 Marcin Owsiany |
|
3
|
|
|
|
|
|
|
# See the README file for license information |
|
4
|
|
|
|
|
|
|
package App::MaMGal::TestHelper; |
|
5
|
10
|
|
|
10
|
|
557533
|
use Test::MockObject; |
|
|
10
|
|
|
|
|
34138
|
|
|
|
10
|
|
|
|
|
66
|
|
|
6
|
10
|
|
|
10
|
|
301
|
use Test::More; |
|
|
10
|
|
|
|
|
18
|
|
|
|
10
|
|
|
|
|
113
|
|
|
7
|
10
|
|
|
10
|
|
3237
|
use base 'Exporter'; |
|
|
10
|
|
|
|
|
33
|
|
|
|
10
|
|
|
|
|
811
|
|
|
8
|
10
|
|
|
10
|
|
57
|
use Carp; |
|
|
10
|
|
|
|
|
33
|
|
|
|
10
|
|
|
|
|
17774
|
|
|
9
|
|
|
|
|
|
|
@EXPORT = qw(get_mock_entry get_mock_iif get_mock_datetime_parser get_mock_formatter get_mock_localeenv get_mock_cc prepare_test_data get_mock_mplayer_wrapper get_mock_logger logged_only_ok logged_exception_only_ok get_mock_exception get_mock_fh printed_only_ok); |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub get_mock_entry |
|
12
|
|
|
|
|
|
|
{ |
|
13
|
0
|
|
0
|
0
|
0
|
0
|
my $class = (shift || 'App::MaMGal::Entry'); |
|
14
|
0
|
|
|
|
|
0
|
my %args = @_; |
|
15
|
|
|
|
|
|
|
my $mock_entry = Test::MockObject->new |
|
16
|
|
|
|
|
|
|
->mock('set_root') |
|
17
|
|
|
|
|
|
|
->mock('make') |
|
18
|
|
|
|
|
|
|
->mock('add_tools') |
|
19
|
0
|
0
|
|
0
|
|
0
|
->mock('name', sub { $args{'name'} || 'filename.jpg' }) |
|
20
|
0
|
0
|
|
0
|
|
0
|
->mock('description', sub { $args{'description'} || 'a description' }) |
|
21
|
0
|
|
|
0
|
|
0
|
->mock('creation_time', sub { 1234 }) |
|
22
|
0
|
|
|
0
|
|
0
|
->mock('page_path', sub { 'a/page/path' }) |
|
23
|
0
|
|
|
0
|
|
0
|
->mock('thumbnail_path', sub { 'a/thumbnail/path' }); |
|
|
0
|
|
|
|
|
0
|
|
|
24
|
0
|
|
|
|
|
0
|
$mock_entry->set_isa($class); |
|
25
|
0
|
|
|
|
|
0
|
return $mock_entry; |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub get_mock_fh { |
|
29
|
5
|
|
|
5
|
0
|
4439
|
my $fh = Test::MockObject->new->mock('printf'); |
|
30
|
5
|
|
|
|
|
160
|
return $fh; |
|
31
|
|
|
|
|
|
|
} |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub get_mock_iif { |
|
34
|
0
|
|
|
0
|
0
|
0
|
my $f = Test::MockObject->new->mock('read', sub { Test::MockObject->new }); |
|
|
0
|
|
|
0
|
|
0
|
|
|
35
|
0
|
|
|
|
|
0
|
$f->set_isa('App::MaMGal::ImageInfoFactory'); |
|
36
|
0
|
|
|
|
|
0
|
$f |
|
37
|
|
|
|
|
|
|
} |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub get_mock_logger { |
|
40
|
110
|
|
|
110
|
0
|
49051
|
my $l = Test::MockObject->new |
|
41
|
|
|
|
|
|
|
->mock('log_message') |
|
42
|
|
|
|
|
|
|
->mock('log_exception'); |
|
43
|
110
|
|
|
|
|
4975
|
$l->set_isa('App::MaMGal::Logger'); |
|
44
|
110
|
|
|
|
|
1530
|
$l |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub get_mock_datetime_parser { |
|
48
|
42
|
|
|
42
|
0
|
83957
|
my $p = Test::MockObject->new->mock('parse'); |
|
49
|
42
|
|
|
|
|
1494
|
$p->set_isa('Image::EXIF::DateTime::Parser'); |
|
50
|
42
|
|
|
|
|
748
|
$p |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub get_mock_formatter { |
|
54
|
0
|
|
|
0
|
0
|
0
|
my @methods = @_; |
|
55
|
0
|
|
|
|
|
0
|
my $mf = Test::MockObject->new(); |
|
56
|
0
|
|
|
|
|
0
|
$mf->set_isa('App::MaMGal::Formatter'); |
|
57
|
0
|
|
|
0
|
|
0
|
$mf->mock($_, sub { "whatever" }) for @methods; |
|
|
0
|
|
|
|
|
0
|
|
|
58
|
0
|
|
|
|
|
0
|
return $mf; |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub get_mock_localeenv { |
|
62
|
0
|
|
|
0
|
0
|
0
|
my $ml = Test::MockObject->new(); |
|
63
|
0
|
|
|
|
|
0
|
$ml->set_isa('App::MaMGal::LocaleEnv'); |
|
64
|
0
|
|
|
0
|
|
0
|
$ml->mock('get_charset', sub { "ISO-8859-123" }); |
|
|
0
|
|
|
|
|
0
|
|
|
65
|
0
|
|
|
|
|
0
|
$ml->mock('set_locale'); |
|
66
|
0
|
|
|
0
|
|
0
|
$ml->mock('format_time', sub { "12:12:12" }); |
|
|
0
|
|
|
|
|
0
|
|
|
67
|
0
|
|
|
0
|
|
0
|
$ml->mock('format_date', sub { "18 dec 2004" }); |
|
|
0
|
|
|
|
|
0
|
|
|
68
|
0
|
|
|
|
|
0
|
return $ml; |
|
69
|
|
|
|
|
|
|
} |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub get_mock_mplayer_wrapper { |
|
72
|
0
|
|
|
0
|
0
|
0
|
my $mmw = Test::MockObject->new; |
|
73
|
0
|
|
|
|
|
0
|
$mmw->set_isa('App::MaMGal::MplayerWrapper'); |
|
74
|
0
|
|
|
|
|
0
|
my $mock_image = Test::MockObject->new; |
|
75
|
0
|
|
|
|
|
0
|
$mock_image->set_isa('Image::Magick'); |
|
76
|
0
|
|
|
0
|
|
0
|
$mock_image->mock('Get', sub { '100', '100' }); |
|
|
0
|
|
|
|
|
0
|
|
|
77
|
0
|
|
|
0
|
|
0
|
$mock_image->mock('Scale', sub { undef }); |
|
|
0
|
|
|
|
|
0
|
|
|
78
|
0
|
|
|
0
|
|
0
|
$mock_image->mock('Write', sub { system('touch', $_[1] ) }); |
|
|
0
|
|
|
|
|
0
|
|
|
79
|
0
|
|
|
0
|
|
0
|
$mmw->mock('snapshot', sub { $mock_image }); |
|
|
0
|
|
|
|
|
0
|
|
|
80
|
0
|
|
|
|
|
0
|
return $mmw; |
|
81
|
|
|
|
|
|
|
} |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub get_mock_cc($) { |
|
84
|
0
|
|
|
0
|
0
|
0
|
my $ret = shift; |
|
85
|
0
|
|
|
|
|
0
|
my $mcc = Test::MockObject->new; |
|
86
|
0
|
|
|
|
|
0
|
$mcc->set_isa('App::MaMGal::CommandChecker'); |
|
87
|
0
|
|
|
0
|
|
0
|
$mcc->mock('is_available', sub { $ret }); |
|
|
0
|
|
|
|
|
0
|
|
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub prepare_test_data { |
|
91
|
|
|
|
|
|
|
# We have to create empty directories, because git does not track them |
|
92
|
5
|
|
|
5
|
0
|
3786
|
for my $dir (qw(empty one_dir one_dir/subdir more/subdir/lost+found)) { |
|
93
|
20
|
100
|
50
|
|
|
631
|
mkdir("td.in/$dir") or die "td.in/$dir: $!" unless -d "td.in/$dir"; |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
# We have to create and populate directories with spaces in their |
|
96
|
|
|
|
|
|
|
# names, because perl's makemaker does not like them |
|
97
|
5
|
100
|
|
|
|
125
|
mkdir "td.in/more/zzz another subdir" unless -d "td.in/more/zzz another subdir"; |
|
98
|
5
|
50
|
|
|
|
85
|
my $orig_size = -s "td.in/p.png" or die "Unable to stat td.in/p.png"; |
|
99
|
5
|
|
|
|
|
79
|
my $dest_size = -s 'td.in/more/zzz another subdir/p.png'; |
|
100
|
5
|
100
|
66
|
|
|
47
|
unless ($dest_size and $orig_size == $dest_size) { |
|
101
|
1
|
|
|
|
|
7640
|
system('cp', '-a', 'td.in/p.png', 'td.in/more/zzz another subdir/p.png'); |
|
102
|
|
|
|
|
|
|
} |
|
103
|
|
|
|
|
|
|
# We also need to create our test symlinks, because MakeMaker does not like them |
|
104
|
5
|
|
|
|
|
83
|
for my $pair ([qw(td.in/symlink_broken broken)], [qw(td.in/symlink_pic_noext one_pic/a1.png)], [qw(td.in/symlink_to_empty empty)], [qw(td.in/symlink_to_empty_file empty_file)], [qw(td.in/symlink_pic.png one_pic/a1.png)]) { |
|
105
|
25
|
|
|
|
|
51
|
my ($link, $dest) = @$pair; |
|
106
|
25
|
100
|
50
|
|
|
540
|
symlink($dest, $link) or die "Failed to symlink [$dest] to [$link]" unless -l $link; |
|
107
|
|
|
|
|
|
|
} |
|
108
|
|
|
|
|
|
|
# Finally, purge and copy a clean version of the test data into "td" |
|
109
|
5
|
50
|
|
|
|
134276
|
system('rm -rf td ; cp -a td.in td') == 0 or die "Test data preparation failed: $?"; |
|
110
|
|
|
|
|
|
|
} |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub logged_only_ok($$;$) |
|
113
|
|
|
|
|
|
|
{ |
|
114
|
2
|
|
|
2
|
0
|
15
|
my $mock = shift; |
|
115
|
2
|
|
|
|
|
4
|
my $re = shift; |
|
116
|
2
|
|
|
|
|
5
|
my $prefix = shift; |
|
117
|
2
|
|
|
|
|
5
|
my $level = $Test::Builder::Level; |
|
118
|
2
|
|
|
|
|
4
|
local $Test::Builder::Level = $level + 1; |
|
119
|
2
|
|
|
|
|
12
|
my ($name, $args) = $mock->next_call; |
|
120
|
2
|
|
|
|
|
41
|
is($name, 'log_message', 'expected method was called'); |
|
121
|
2
|
|
|
|
|
1476
|
like($args->[1], $re, 'message as expected'); |
|
122
|
2
|
|
|
|
|
996
|
is($args->[2], $prefix, 'prefix as expected'); |
|
123
|
2
|
|
|
|
|
899
|
($name, $args) = $mock->next_call; |
|
124
|
2
|
|
|
|
|
32
|
is($name, undef, 'no other logging method was called'); |
|
125
|
2
|
50
|
|
|
|
753
|
return unless defined $name; |
|
126
|
0
|
|
|
|
|
0
|
is($args->[1], undef, 'no args were passed either'); |
|
127
|
0
|
|
|
|
|
0
|
is($args->[2], undef, 'no args were passed either'); |
|
128
|
0
|
|
|
|
|
0
|
is($args->[3], undef, 'no args were passed either'); |
|
129
|
|
|
|
|
|
|
} |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub printed_only_ok($$;$) |
|
132
|
|
|
|
|
|
|
{ |
|
133
|
12
|
|
|
12
|
0
|
3748
|
my $mock = shift; |
|
134
|
12
|
|
|
|
|
16
|
my $re = shift; |
|
135
|
12
|
|
|
|
|
16
|
my $level = $Test::Builder::Level; |
|
136
|
12
|
|
|
|
|
16
|
local $Test::Builder::Level = $level + 1; |
|
137
|
12
|
|
|
|
|
11
|
my ($name, $args); |
|
138
|
12
|
100
|
66
|
|
|
61
|
if (ref $re and ref $re eq 'ARRAY') { |
|
139
|
1
|
|
|
|
|
2
|
foreach my $line_re (@$re) { |
|
140
|
10
|
|
|
|
|
3151
|
($name, $args) = $mock->next_call; |
|
141
|
10
|
|
|
|
|
194
|
is($name, 'printf', "expected method was called (checking $line_re)"); |
|
142
|
10
|
|
|
|
|
3540
|
is($args->[1], "%s%s\n", "format string as expected (for $line_re)"); |
|
143
|
10
|
50
|
|
|
|
3361
|
like((($args->[2] ? $args->[2] : '') . ($args->[3] ? $args->[3] : '')), $line_re, 'message as expected'); |
|
|
|
50
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
} |
|
145
|
|
|
|
|
|
|
} else { |
|
146
|
11
|
|
|
|
|
33
|
($name, $args) = $mock->next_call; |
|
147
|
11
|
|
|
|
|
177
|
is($name, 'printf', 'expected method was called'); |
|
148
|
11
|
|
|
|
|
3843
|
is($args->[1], "%s%s\n", 'format string as expected'); |
|
149
|
11
|
100
|
|
|
|
3616
|
like((($args->[2] ? $args->[2] : '') . ($args->[3] ? $args->[3] : '')), $re, 'message as expected'); |
|
|
|
50
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
} |
|
151
|
12
|
|
|
|
|
3995
|
($name, $args) = $mock->next_call; |
|
152
|
12
|
|
|
|
|
158
|
is($name, undef, 'no other logging method was called'); |
|
153
|
12
|
50
|
|
|
|
2812
|
return unless defined $name; |
|
154
|
0
|
|
|
|
|
0
|
is($args->[1], undef, 'no args were passed either'); |
|
155
|
0
|
|
|
|
|
0
|
is($args->[2], undef, 'no args were passed either'); |
|
156
|
0
|
|
|
|
|
0
|
is($args->[3], undef, 'no args were passed either'); |
|
157
|
|
|
|
|
|
|
} |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub logged_exception_only_ok($$;$) |
|
160
|
|
|
|
|
|
|
{ |
|
161
|
0
|
|
|
0
|
0
|
0
|
my $mock = shift; |
|
162
|
0
|
|
|
|
|
0
|
my $ex = shift; |
|
163
|
0
|
|
|
|
|
0
|
my $prefix = shift; |
|
164
|
0
|
|
|
|
|
0
|
my $level = $Test::Builder::Level; |
|
165
|
0
|
|
|
|
|
0
|
local $Test::Builder::Level = $level + 1; |
|
166
|
0
|
|
|
|
|
0
|
my ($name, $args) = $mock->next_call; |
|
167
|
0
|
|
|
|
|
0
|
is($name, 'log_exception'); |
|
168
|
0
|
|
|
|
|
0
|
is($args->[1], $ex); |
|
169
|
0
|
|
|
|
|
0
|
is($args->[2], $prefix); |
|
170
|
0
|
|
|
|
|
0
|
($name, $args) = $mock->next_call; |
|
171
|
0
|
|
|
|
|
0
|
is($name, undef, 'no other logging method was called'); |
|
172
|
0
|
0
|
|
|
|
0
|
return unless defined $name; |
|
173
|
0
|
|
|
|
|
0
|
is($args->[1], undef, 'no args were passed either'); |
|
174
|
0
|
|
|
|
|
0
|
is($args->[2], undef, 'no args were passed either'); |
|
175
|
0
|
|
|
|
|
0
|
is($args->[3], undef, 'no args were passed either'); |
|
176
|
|
|
|
|
|
|
} |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub get_mock_exception($) |
|
179
|
|
|
|
|
|
|
{ |
|
180
|
5
|
|
|
5
|
0
|
1981
|
my $class = shift; |
|
181
|
5
|
|
|
|
|
13
|
my $e = Test::MockObject->new; |
|
182
|
5
|
|
|
|
|
33
|
$e->set_isa($class); |
|
183
|
5
|
|
|
8
|
|
83
|
$e->mock('message', sub { 'foo bar' }); |
|
|
8
|
|
|
|
|
362
|
|
|
184
|
5
|
|
|
2
|
|
112
|
$e->mock('interpolated_message', sub { 'foo bar baz' }); |
|
|
2
|
|
|
|
|
93
|
|
|
185
|
5
|
|
|
|
|
95
|
return $e; |
|
186
|
|
|
|
|
|
|
} |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
1; |