File Coverage

blib/lib/Mail/Builder/Image.pm
Criterion Covered Total %
statement 39 48 81.2
branch 9 18 50.0
condition 3 6 50.0
subroutine 7 7 100.0
pod 1 1 100.0
total 59 80 73.7


line stmt bran cond sub pod time code
1             # ============================================================================
2             package Mail::Builder::Image;
3             # ============================================================================
4              
5 8     8   52 use namespace::autoclean;
  8         49  
  8         75  
6 8     8   798 use Moose;
  8         21  
  8         64  
7             with qw(Mail::Builder::Role::File);
8 8     8   39827 use Mail::Builder::TypeConstraints;
  8         19  
  8         169  
9              
10 8     8   43 use Carp;
  8         17  
  8         5743  
11              
12             our $VERSION = $Mail::Builder::VERSION;
13              
14             has 'id' => (
15             is => 'rw',
16             isa => 'Str',
17             lazy_build => 1,
18             trigger => sub { shift->clear_cache },
19             );
20              
21             has 'mimetype' => (
22             is => 'rw',
23             isa => 'Mail::Builder::Type::ImageMimetype',
24             lazy_build => 1,
25             trigger => sub { shift->clear_cache },
26             );
27              
28             around BUILDARGS => sub {
29             my $orig = shift;
30             my $class = shift;
31              
32             if ( scalar @_ == 1 && ref $_[0] eq 'HASH' ) {
33             return $class->$orig($_[0]);
34             }
35             else {
36             my $params = {
37             file => $_[0],
38             };
39             if (defined $_[1]) {
40             $params->{id} = $_[1];
41             }
42             if (defined $_[2]) {
43             $params->{mimetype} = $_[2];
44             }
45             return $class->$orig($params);
46             }
47             };
48              
49             sub _build_mimetype {
50 3     3   7 my ($self) = @_;
51              
52 3         8 my $filename = $self->filename;
53 3         6 my $filetype;
54              
55 3 100 66     17 if (defined $filename
56             && $filename->basename =~ m/\.(PNG|JPE?G|GIF)$/i) {
57 2         20 $filetype = 'image/'.lc($1);
58 2 50       7 $filetype = 'image/jpeg'
59             if $filetype eq 'image/jpg';
60             } else {
61 1         8 my $filecontent = $self->filecontent;
62 1         5 $filetype = $self->_check_magic_string($filecontent);
63             }
64              
65 3 50       8 unless (defined $filetype) {
66 0         0 croak('Could not determine the file type automatically and/or invalid file type (only image/png, image/jpeg an image/gif allowed)');
67             }
68              
69 3         73 return $filetype;
70             }
71              
72             sub _build_id {
73 1     1   3 my ($self) = @_;
74              
75 1         5 my $filename = $self->filename;
76 1         2 my $id;
77              
78 1 50       4 if (defined $filename) {
79 0         0 $id = $filename->basename;
80 0         0 $id =~ s/[.-]/_/g;
81 0         0 $id =~ s/(.+)\.(JPE?G|GIF|PNG)$/$1/i;
82             }
83              
84 1 50 33     4 unless (defined $id
85             && $id !~ m/^\s*$/) {
86 1         16 croak('Could not determine the image id automatically');
87             }
88              
89 0         0 return $id;
90             }
91              
92             sub serialize {
93 2     2 1 183 my ($self) = @_;
94              
95 2 50       66 return $self->cache
96             if ($self->has_cache);
97              
98 2         47 my $file = $self->file;
99 2         6 my $accessor;
100             my $value;
101              
102 2 50       10 if (blessed $file) {
103 2 50       10 if ($file->isa('IO::File')) {
    0          
104 2         5 $accessor = 'Data';
105 2         9 $value = $self->filecontent;
106             } elsif ($file->isa('Path::Class::File')) {
107 0         0 $accessor = 'Path';
108 0         0 $value = $file->stringify;
109             }
110             } else {
111 0         0 $accessor = 'Data';
112 0         0 $value = $file;
113             }
114              
115 2         68 my $entity = MIME::Entity->build(
116             Disposition => 'inline',
117             Type => $self->mimetype,
118             Top => 0,
119             Id => '<'.$self->id.'>',
120             Encoding => 'base64',
121             $accessor => $value,
122             );
123              
124 1         1375 $self->cache($entity);
125              
126 1         4 return $entity;
127             }
128              
129             __PACKAGE__->meta->make_immutable;
130              
131             1;
132              
133             =encoding utf8
134              
135             =head1 NAME
136              
137             Mail::Builder::Image - Class for handling inline images
138              
139             =head1 SYNOPSIS
140              
141             use Mail::Builder::Image;
142            
143             my $image1 = Mail::Builder::Image->new({
144             file => 'path/to/image.png',
145             id => 'location',
146             });
147            
148             my $image2 = Mail::Builder::Image->new($fh);
149            
150             my $image1_entity = $image1->serialize;
151              
152             =head1 DESCRIPTION
153              
154             This class handles inline images that should be displayed in html e-mail
155             messages.
156              
157             =head1 METHODS
158              
159             =head2 Constructor
160              
161             =head3 new
162              
163             The constructor can be called in multiple ways
164              
165             Mail::Builder::Image->new({
166             file => Path | Path::Class::File | IO::File | FH | ScalarRef,
167             [ id => Image id, ]
168             [ mimetype => MIME type, ]
169             })
170             OR
171             Mail::Builder::Image->new(
172             Path | Path::Class::File | IO::File | FH | ScalarRef
173             [, Image id [, MIME type ]]
174             )
175              
176             See L<Accessors> for more details.
177              
178             =head2 Public Methods
179              
180             =head3 serialize
181              
182             Returns the image file as a L<MIME::Entity> object.
183              
184             =head3 filename
185              
186             If possible, returns the filename of the image file as a L<Path::Class::File>
187             object.
188              
189             =head3 filecontent
190              
191             Returns the content of the image file.
192              
193             =head3 filehandle
194              
195             If possible, returns a filehandle for the image file as a L<IO::File> object.
196              
197             =head2 Accessors
198              
199             =head3 id
200              
201             ID of the file. If no id is provided the lowercase filename without the
202             extension will be used as the ID.
203              
204             The ID is needed to reference the image in the e-mail body:
205              
206             <img src="cid:invitation_location"/>
207              
208             =head3 mimetype
209              
210             Mime type of the image. Valid types are
211              
212             =over
213              
214             =item * image/gif
215              
216             =item * image/jpeg
217              
218             =item * image/png
219              
220             =back
221              
222             If not provided the mime type is determined by analyzing the filename
223             extension and file content.
224              
225             =head3 file
226              
227             Image. Can be a
228              
229             =over
230              
231             =item * Path (or a Path::Class::File object)
232              
233             =item * Filehandle (or an IO::File object)
234              
235             =item * ScalarRef containing the image data
236              
237             =back
238              
239             =head1 AUTHOR
240              
241             MaroÅ¡ Kollár
242             CPAN ID: MAROS
243             maros [at] k-1.com
244             http://www.k-1.com
245              
246             =cut
247