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__ |