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   3585 use namespace::autoclean;
  8         9  
  8         42  
6 8     8   3727 use Moose::Role;
  8         24730  
  8         28  
7              
8 8     8   33629 use Path::Class qw();
  8         2127  
  8         147  
9 8     8   39 use IO::File qw();
  8         11  
  8         3595  
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   31 my (@chars) = @_;
35 24         29 return join ('',map { chr($_) } @chars);
  112         160  
36             }
37              
38             sub _check_magic_string {
39 3     3   6 my ($self,$string) = @_;
40            
41 3         13 foreach my $type (keys %MAGIC_STRINGS) {
42             return $type
43 7 100       26 if substr($string,0,(length $MAGIC_STRINGS{$type})) eq $MAGIC_STRINGS{$type};
44             }
45 2         9 return;
46             }
47              
48             sub filename {
49 25     25 0 967 my ($self) = @_;
50            
51 25         811 my $file = $self->file;
52            
53             # Return filename if we know it
54 25 100 100     216 if (blessed $file
55             && $file->isa('Path::Class::File')) {
56 17         76 return $file;
57             }
58            
59             # We don't know the filename
60 8         28 return;
61             }
62              
63             sub filehandle {
64 9     9 0 14 my ($self) = @_;
65            
66 9         256 my $file = $self->file;
67            
68 9         12 my $file_handle;
69            
70             # Open Path::Class::File
71 9 100 66     129 if (blessed $file
    50 33        
72             && $file->isa('Path::Class::File')) {
73 2         8 $file_handle = $file->openr();
74             # Return filehandle
75             } elsif (blessed $file
76             && $file->isa('IO::File')) {
77 7         12 $file_handle = $file;
78             # We don't have a filehandle
79             } else {
80 0         0 return;
81             }
82            
83 9         355 $file_handle->binmode();
84 9         70 return $file_handle;
85             }
86              
87             sub filecontent {
88 11     11 0 1672 my ($self) = @_;
89            
90 11         387 my $file = $self->file;
91            
92 11 100       38 return $$file
93             if ref $file eq 'SCALAR';
94            
95 9         25 my $filehandle = $self->filehandle;
96            
97 9         13 my $filecontent = do { local $/; <$filehandle> };
  9         32  
  9         227  
98            
99 9 100 66     81 if (blessed $file
100             && $file->isa('Path::Class::File')) {
101 2         13 $filehandle->close;
102             } else {
103 7         46 $filehandle->seek(0,0);
104             }
105            
106 9         107 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;