File Coverage

blib/lib/Mail/Builder/Attachment.pm
Criterion Covered Total %
statement 48 52 92.3
branch 12 18 66.6
condition 5 8 62.5
subroutine 9 9 100.0
pod 1 1 100.0
total 75 88 85.2


line stmt bran cond sub pod time code
1             # ============================================================================
2             package Mail::Builder::Attachment;
3             # ============================================================================
4              
5 8     8   57 use namespace::autoclean;
  8         23  
  8         79  
6 8     8   894 use Moose;
  8         23  
  8         132  
7             with qw(Mail::Builder::Role::File);
8 8     8   40517 use Mail::Builder::TypeConstraints;
  8         23  
  8         179  
9              
10 8     8   4137 use MIME::Types;
  8         27252  
  8         331  
11 8     8   66 use Carp;
  8         19  
  8         350  
12 8     8   54 use Encode;
  8         19  
  8         4723  
13              
14             our $VERSION = $Mail::Builder::VERSION;
15              
16             has 'name' => (
17             is => 'rw',
18             isa => 'Str',
19             lazy_build => 1,
20             trigger => sub { shift->clear_cache },
21             );
22              
23             has 'mimetype' => (
24             is => 'rw',
25             isa => 'Mail::Builder::Type::Mimetype',
26             lazy_build => 1,
27             trigger => sub { shift->clear_cache },
28             );
29              
30              
31             around BUILDARGS => sub {
32             my $orig = shift;
33             my $class = shift;
34              
35             if ( scalar @_ == 1 && ref $_[0] eq 'HASH' ) {
36             return $class->$orig($_[0]);
37             }
38             else {
39             my $params = {
40             file => $_[0],
41             };
42             if (defined $_[1]) {
43             $params->{name} = $_[1];
44             }
45             if (defined $_[2]) {
46             $params->{mimetype} = $_[2];
47             }
48             return $class->$orig($params);
49             }
50             };
51              
52             sub _build_mimetype {
53 6     6   13 my ($self) = @_;
54              
55 6         25 my $filename = $self->filename;
56 6         11 my $filetype;
57              
58 6 100 66     38 if (defined $filename
59             && lc($filename->basename) =~ /\.([0-9a-z]{1,4})$/) {
60 4         101 my $mimetype = MIME::Types->new->mimeTypeOf($1);
61 4 50       80971 $filetype = $mimetype->type
62             if defined $mimetype;
63             }
64              
65 6 100       46 unless (defined $filetype) {
66 2         9 my $filecontent = $self->filecontent;
67 2         9 $filetype = $self->_check_magic_string($filecontent);
68             }
69              
70 6   100     24 $filetype ||= 'application/octet-stream';
71              
72 6         202 return $filetype;
73             }
74              
75             sub _build_name {
76 1     1   3 my ($self) = @_;
77              
78 1         6 my $filename = $self->filename;
79 1         3 my $name;
80              
81 1 50       6 if (defined $filename) {
82 0         0 $name = $filename->basename;
83             }
84              
85 1 50 33     6 unless (defined $name
86             && $name !~ m/^\s*$/) {
87 1         17 croak('Could not determine the attachment name automatically');
88             }
89              
90 0         0 return $name;
91             }
92              
93             sub serialize {
94 3     3 1 191 my ($self) = @_;
95              
96 3 50       96 return $self->cache
97             if ($self->has_cache);
98              
99 3         74 my $file = $self->file;
100 3         8 my $accessor;
101             my $value;
102              
103 3 50       19 if (blessed $file) {
104 3 100       26 if ($file->isa('IO::File')) {
    50          
105 2         4 $accessor = 'Data';
106 2         9 $value = $self->filecontent;
107             } elsif ($file->isa('Path::Class::File')) {
108 1         3 $accessor = 'Path';
109 1         6 $value = $file->stringify;
110             }
111             } else {
112 0         0 $accessor = 'Data';
113 0         0 $value = $$file;
114             }
115              
116 3         152 my $entity = MIME::Entity->build(
117             Disposition => 'attachment',
118             Type => $self->mimetype,
119             Top => 0,
120             Filename => Mail::Builder::Utils::encode_mime($self->name),
121             Encoding => 'base64',
122             $accessor => $value,
123             );
124              
125 2         2469 $self->cache($entity);
126              
127 2         10 return $entity;
128             }
129              
130             __PACKAGE__->meta->make_immutable;
131              
132             1;
133              
134             =encoding utf8
135              
136             =head1 NAME
137              
138             Mail::Builder::Attachment - Class for handling e-mail attachments
139              
140             =head1 SYNOPSIS
141              
142             use Mail::Builder::Attachment;
143            
144             my $attachment1 = Mail::Builder::Attachment->new({
145             file => 'path/to/attachment.pdf',
146             name => 'LoveLetter.txt.vbs',
147             });
148            
149             my $attachment2 = Mail::Builder::Attachment->new($fh);
150            
151             my $attachment_entity = $attachment1->serialize;
152              
153             =head1 DESCRIPTION
154              
155             This class handles e-mail attachments for Mail::Builder.
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::Attachment->new({
166             file => Path | Path::Class::File | IO::File | FH | ScalarRef,
167             [ name => Attachment filename, ]
168             [ mimetype => MIME type, ]
169             })
170             OR
171             Mail::Builder::Image->new(
172             Path | Path::Class::File | IO::File | FH | ScalarRef
173             [, Attachment filename [, MIME type ]]
174             )
175              
176             See L<Accessors> for more details.
177              
178             =head2 Public Methods
179              
180             =head3 serialize
181              
182             Returns the attachment as a L<MIME::Entity> object.
183              
184             =head3 filename
185              
186             If possible, returns the filename of the attachment file as a
187             L<Path::Class::File> object.
188              
189             =head3 filecontent
190              
191             Returns the content of the attachment file.
192              
193             =head3 filehandle
194              
195             If possible, returns a filehandle for the attachment file as a
196             L<IO::File> object.
197              
198             =head2 Accessors
199              
200             =head3 name
201              
202             Name of the attachment as used in the e-mail message. If no name is provided
203             the current filename will be used.
204              
205             =head3 mimetype
206              
207             Mime type of the attachment.
208              
209             If not provided the mime type is determined by analyzing the filename
210             extension.
211              
212             =head3 file
213              
214             Attachment file. Can be a
215              
216             =over
217              
218             =item * Path (or a Path::Class::File object)
219              
220             =item * Filehandle (or an IO::File object)
221              
222             =item * ScalarRef containing the attachment data
223              
224             =back
225              
226             =head1 AUTHOR
227              
228             MaroÅ¡ Kollár
229             CPAN ID: MAROS
230             maros [at] k-1.com
231             http://www.k-1.com
232              
233             =cut