File Coverage

blib/lib/Mail/Builder/Role/File.pm
Criterion Covered Total %
statement 43 53 81.1
branch 11 20 55.0
condition 8 15 53.3
subroutine 9 10 90.0
pod 0 4 0.0
total 71 102 69.6


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;