line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# ============================================================================ |
2
|
|
|
|
|
|
|
package Mail::Builder::Role::File; |
3
|
|
|
|
|
|
|
# ============================================================================ |
4
|
|
|
|
|
|
|
|
5
|
8
|
|
|
8
|
|
4934
|
use namespace::autoclean; |
|
8
|
|
|
|
|
18
|
|
|
8
|
|
|
|
|
55
|
|
6
|
8
|
|
|
8
|
|
3872
|
use Moose::Role; |
|
8
|
|
|
|
|
40852
|
|
|
8
|
|
|
|
|
38
|
|
7
|
|
|
|
|
|
|
|
8
|
8
|
|
|
8
|
|
48637
|
use Path::Class qw(); |
|
8
|
|
|
|
|
2887
|
|
|
8
|
|
|
|
|
151
|
|
9
|
8
|
|
|
8
|
|
57
|
use IO::File qw(); |
|
8
|
|
|
|
|
22
|
|
|
8
|
|
|
|
|
4097
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = $Mail::Builder::VERSION; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
has 'file' => ( |
14
|
|
|
|
|
|
|
is => 'rw', |
15
|
|
|
|
|
|
|
isa => 'Mail::Builder::Type::Content | Mail::Builder::Type::File | Mail::Builder::Type::Fh', |
16
|
|
|
|
|
|
|
required => 1, |
17
|
|
|
|
|
|
|
coerce => 1, |
18
|
|
|
|
|
|
|
trigger => sub { shift->clear_cache }, |
19
|
|
|
|
|
|
|
); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
has 'cache' => ( |
22
|
|
|
|
|
|
|
is => 'rw', |
23
|
|
|
|
|
|
|
predicate => 'has_cache', |
24
|
|
|
|
|
|
|
clearer => 'clear_cache', |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our %MAGIC_STRINGS = ( |
28
|
|
|
|
|
|
|
'image/gif' => _build_magic_string(0x47,0x49,0x46,0x38,0x39,0x61), |
29
|
|
|
|
|
|
|
'image/jpeg'=> _build_magic_string(0xFF,0xD8), |
30
|
|
|
|
|
|
|
'image/png' => _build_magic_string(0x89,0x50,0x4E,0x47,0x0D,0x0A), |
31
|
|
|
|
|
|
|
); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub _build_magic_string { |
34
|
24
|
|
|
24
|
|
59
|
my (@chars) = @_; |
35
|
24
|
|
|
|
|
48
|
return join ('',map { chr($_) } @chars); |
|
112
|
|
|
|
|
294
|
|
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub _check_magic_string { |
39
|
3
|
|
|
3
|
|
8
|
my ($self,$string) = @_; |
40
|
|
|
|
|
|
|
|
41
|
3
|
|
|
|
|
19
|
foreach my $type (keys %MAGIC_STRINGS) { |
42
|
|
|
|
|
|
|
return $type |
43
|
9
|
100
|
|
|
|
36
|
if substr($string,0,(length $MAGIC_STRINGS{$type})) eq $MAGIC_STRINGS{$type}; |
44
|
|
|
|
|
|
|
} |
45
|
2
|
|
|
|
|
6
|
return; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub filename { |
49
|
25
|
|
|
25
|
0
|
1668
|
my ($self) = @_; |
50
|
|
|
|
|
|
|
|
51
|
25
|
|
|
|
|
716
|
my $file = $self->file; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Return filename if we know it |
54
|
25
|
100
|
100
|
|
|
237
|
if (blessed $file |
55
|
|
|
|
|
|
|
&& $file->isa('Path::Class::File')) { |
56
|
17
|
|
|
|
|
96
|
return $file; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# We don't know the filename |
60
|
8
|
|
|
|
|
31
|
return; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub filehandle { |
64
|
9
|
|
|
9
|
0
|
23
|
my ($self) = @_; |
65
|
|
|
|
|
|
|
|
66
|
9
|
|
|
|
|
202
|
my $file = $self->file; |
67
|
|
|
|
|
|
|
|
68
|
9
|
|
|
|
|
17
|
my $file_handle; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# Open Path::Class::File |
71
|
9
|
100
|
66
|
|
|
153
|
if (blessed $file |
|
|
50
|
33
|
|
|
|
|
72
|
|
|
|
|
|
|
&& $file->isa('Path::Class::File')) { |
73
|
2
|
|
|
|
|
10
|
$file_handle = $file->openr(); |
74
|
|
|
|
|
|
|
# Return filehandle |
75
|
|
|
|
|
|
|
} elsif (blessed $file |
76
|
|
|
|
|
|
|
&& $file->isa('IO::File')) { |
77
|
7
|
|
|
|
|
20
|
$file_handle = $file; |
78
|
|
|
|
|
|
|
# We don't have a filehandle |
79
|
|
|
|
|
|
|
} else { |
80
|
0
|
|
|
|
|
0
|
return; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
9
|
|
|
|
|
325
|
$file_handle->binmode(); |
84
|
9
|
|
|
|
|
99
|
return $file_handle; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub filecontent { |
88
|
11
|
|
|
11
|
0
|
1898
|
my ($self) = @_; |
89
|
|
|
|
|
|
|
|
90
|
11
|
|
|
|
|
291
|
my $file = $self->file; |
91
|
|
|
|
|
|
|
|
92
|
11
|
100
|
|
|
|
42
|
return $$file |
93
|
|
|
|
|
|
|
if ref $file eq 'SCALAR'; |
94
|
|
|
|
|
|
|
|
95
|
9
|
|
|
|
|
33
|
my $filehandle = $self->filehandle; |
96
|
|
|
|
|
|
|
|
97
|
9
|
|
|
|
|
21
|
my $filecontent = do { local $/; <$filehandle> }; |
|
9
|
|
|
|
|
37
|
|
|
9
|
|
|
|
|
209
|
|
98
|
|
|
|
|
|
|
|
99
|
9
|
100
|
66
|
|
|
81
|
if (blessed $file |
100
|
|
|
|
|
|
|
&& $file->isa('Path::Class::File')) { |
101
|
2
|
|
|
|
|
47
|
$filehandle->close; |
102
|
|
|
|
|
|
|
} else { |
103
|
7
|
|
|
|
|
47
|
$filehandle->seek(0,0); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
9
|
|
|
|
|
121
|
return $filecontent; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub compare { |
111
|
0
|
|
|
0
|
0
|
|
my ($self,$compare) = @_; |
112
|
|
|
|
|
|
|
|
113
|
0
|
0
|
|
|
|
|
return 0 |
114
|
|
|
|
|
|
|
unless ($compare); |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
my $filename_self = $self->filename; |
117
|
0
|
|
|
|
|
|
my $filename_compare = $compare->filename; |
118
|
|
|
|
|
|
|
|
119
|
0
|
0
|
0
|
|
|
|
if (defined $filename_self |
120
|
|
|
|
|
|
|
&& defined $filename_compare) { |
121
|
0
|
0
|
|
|
|
|
return ($filename_self eq $filename_compare ? 1:0); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
my $filecontent_self = $self->filecontent; |
125
|
0
|
|
|
|
|
|
my $filecontent_compare = $compare->filecontent; |
126
|
|
|
|
|
|
|
|
127
|
0
|
0
|
|
|
|
|
return ($filecontent_self eq $filecontent_compare ? 1:0); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
1; |