File Coverage

blib/lib/Email/Barcode/Decode.pm
Criterion Covered Total %
statement 22 24 91.6
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 30 32 93.7


line stmt bran cond sub pod time code
1             package Email::Barcode::Decode;
2              
3 1     1   45940 use warnings;
  1         1  
  1         24  
4 1     1   3 use strict;
  1         1  
  1         15  
5              
6 1     1   3 use Carp 'croak';
  1         4  
  1         33  
7 1     1   489 use Email::MIME;
  1         48728  
  1         25  
8 1     1   5 use File::Temp qw(tempdir);
  1         1  
  1         54  
9 1     1   417 use File::Find::Rule;
  1         5274  
  1         6  
10 1     1   37 use Path::Class qw(file);
  1         1  
  1         36  
11 1     1   185 use Image::Magick;
  0            
  0            
12             use Barcode::ZBar;
13             use Cwd 'getcwd';
14             use Capture::Tiny 'capture';
15             use File::Which qw(which);
16              
17             our $VERSION = '0.03';
18              
19             use base 'Class::Accessor::Fast';
20              
21             __PACKAGE__->mk_accessors(qw{
22             email
23             header_obj
24             attached_files
25             _tmpdir
26             });
27              
28             our @enhancers = (
29             sub {
30             my ($magick) = @_;
31             $magick->Normalize();
32             $magick->Contrast(sharpen => 1);
33             },
34             sub {
35             my ($magick) = @_;
36             $magick->Set(dither => 'False');
37             $magick->Quantize(colors => 2);
38             $magick->Quantize(colorspace => 'gray');
39             $magick->ContrastStretch(levels => 0);
40             },
41             );
42              
43             sub new {
44             my ($class, %opts) = @_;
45              
46             my $email = $opts{email};
47             croak 'need email string as argument'
48             unless $email;
49              
50             my $tmpdir = tempdir( CLEANUP => 1 );
51             $opts{_tmpdir} = $tmpdir;
52              
53             my @attached_files;
54             my $parsed = Email::MIME->new($email);
55             $opts{header_obj} = $parsed->header_obj;
56             $opts{attached_files} = \@attached_files;
57              
58             foreach my $part ($parsed->parts) {
59             my $filename = $part->filename;
60             next unless $filename;
61             my $body = $part->body;
62              
63             if ((
64             ($part->content_type =~ m{application/pdf})
65             || ($filename =~ m{\.pdf$})
66             )
67             && (scalar(which("gs")))
68             ) {
69             my $tmpdir2 = tempdir( CLEANUP => 1 );
70             my $attached_pdf = file($tmpdir2, 'attached.pdf');
71             $attached_pdf->spew($body);
72            
73             my $old_cwd = getcwd;
74             chdir($tmpdir2);
75            
76             my ($stdout, $stderr, $exit) = capture {
77             system(qw(
78             gs -dNOPAUSE -sDEVICE=jpeg -dFirstPage=1 -dLastPage=237
79             -sOutputFile=page%d.jpg -dJPEGQ=100 -r150x150 -q attached.pdf
80             -c quit
81             ));
82             };
83             my @files =
84             map { file($_) }
85             sort
86             File::Find::Rule
87             ->file()
88             ->name( 'page*.jpg' )
89             ->in( $tmpdir2 );
90             my $base_name = $filename;
91             $base_name =~ s/[.]/-/g;
92             foreach my $file (@files) {
93             my $image_file = file($tmpdir, $base_name.'-'.$file->basename);
94             $file->copy_to($image_file);
95             push(@attached_files, $image_file);
96             }
97            
98             chdir($old_cwd);
99             }
100             else {
101             my $attached_file = file($tmpdir, $filename);
102             $attached_file->spew($body);
103             push(@attached_files, $attached_file);
104             }
105             }
106              
107             my $self = $class->SUPER::new(\%opts);
108             return $self;
109             }
110              
111             sub get_symbols {
112             my ($self) = @_;
113              
114             my $scanner = Barcode::ZBar::ImageScanner->new();
115             $scanner->parse_config("enable");
116              
117             my @symbols;
118             foreach my $file (@{$self->attached_files}) {
119             my %unique_data;
120             foreach my $enhancer (@enhancers) {
121             my @new_symbols = _get_symbols_from_file($scanner, $file, $enhancer,);
122              
123             push(
124             @symbols, (
125             map { +{
126             filename => $file->basename,
127             type => $_->get_type,
128             data => $_->get_data,
129             }}
130             grep { not($unique_data{$_->get_data}++) } # only new/unique
131             @new_symbols,
132             ),
133             );
134             }
135             }
136              
137             return @symbols;
138             }
139              
140             sub _get_symbols_from_file {
141             my ($scanner, $file, $enhance_code) = @_;
142              
143             my $magick = Image::Magick->new();
144             my $error = $magick->Read($file);
145             die $error if $error;
146              
147             $enhance_code->($magick);
148              
149             my ($width,$height) = $magick->Get(qw(columns rows));
150             $magick->Resize(height=>1500,width=>int($width*(1500/$height)))
151             if $height > 1500;
152             #$magick->Write('/tmp/testing.jpg');
153             my $raw = $magick->ImageToBlob(magick => 'GRAY', depth => 8);
154              
155             my $image = Barcode::ZBar::Image->new();
156             $image->set_format('Y800');
157             $image->set_size($magick->Get(qw(columns rows)));
158             $image->set_data($raw);
159              
160             $scanner->scan_image($image);
161              
162             return $image->get_symbols;
163             }
164              
165             sub email_name {
166             my ($self) = @_;
167             my ($from) = Email::Address->parse($self->header_obj->header('From'));
168             return $from->name;
169             }
170              
171             sub email_from {
172             my ($self) = @_;
173             my ($from) = Email::Address->parse($self->header_obj->header('From'));
174             return $from->address;
175             }
176              
177              
178              
179             1;
180              
181              
182             __END__