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   3649 use namespace::autoclean;
  8         15  
  8         40  
6 8     8   3408 use Moose::Role;
  8         25606  
  8         22  
7              
8 8     8   33077 use Path::Class qw();
  8         2441  
  8         131  
9 8     8   37 use IO::File qw();
  8         10  
  8         3762  
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   35 my (@chars) = @_;
35 24         27 return join ('',map { chr($_) } @chars);
  112         191  
36             }
37              
38             sub _check_magic_string {
39 3     3   5 my ($self,$string) = @_;
40              
41 3         13 foreach my $type (keys %MAGIC_STRINGS) {
42             return $type
43 8 100       25 if substr($string,0,(length $MAGIC_STRINGS{$type})) eq $MAGIC_STRINGS{$type};
44             }
45 2         5 return;
46             }
47              
48             sub filename {
49 25     25 0 2044 my ($self) = @_;
50              
51 25         734 my $file = $self->file;
52              
53             # Return filename if we know it
54 25 100 100     190 if (blessed $file
55             && $file->isa('Path::Class::File')) {
56 17         72 return $file;
57             }
58              
59             # We don't know the filename
60 8         26 return;
61             }
62              
63             sub filehandle {
64 9     9 0 13 my ($self) = @_;
65              
66 9         199 my $file = $self->file;
67              
68 9         13 my $file_handle;
69              
70             # Open Path::Class::File
71 9 100 66     124 if (blessed $file
    50 33        
72             && $file->isa('Path::Class::File')) {
73 2         5 $file_handle = $file->openr();
74             # Return filehandle
75             } elsif (blessed $file
76             && $file->isa('IO::File')) {
77 7         10 $file_handle = $file;
78             # We don't have a filehandle
79             } else {
80 0         0 return;
81             }
82              
83 9         228 $file_handle->binmode();
84 9         66 return $file_handle;
85             }
86              
87             sub filecontent {
88 11     11 0 1956 my ($self) = @_;
89              
90 11         308 my $file = $self->file;
91              
92 11 100       34 return $$file
93             if ref $file eq 'SCALAR';
94              
95 9         20 my $filehandle = $self->filehandle;
96              
97 9         11 my $filecontent = do { local $/; <$filehandle> };
  9         28  
  9         186  
98              
99 9 100 66     70 if (blessed $file
100             && $file->isa('Path::Class::File')) {
101 2         88 $filehandle->close;
102             } else {
103 7         47 $filehandle->seek(0,0);
104             }
105              
106 9         106 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;