File Coverage

blib/lib/Metabrik/Email/Message.pm
Criterion Covered Total %
statement 9 77 11.6
branch 0 28 0.0
condition 0 12 0.0
subroutine 3 7 42.8
pod 1 4 25.0
total 13 128 10.1


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # email::message Brik
5             #
6             package Metabrik::Email::Message;
7 1     1   1024 use strict;
  1         2  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         961  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             input => [ qw(file) ],
21             output => [ qw(file) ],
22             subject => [ qw(subject|OPTIONAL) ],
23             from => [ qw(from|OPTIONAL) ],
24             to => [ qw(to|OPTIONAL) ],
25             },
26             attributes_default => {
27             from => 'from@example.com',
28             to => 'to@example.com',
29             subject => 'Example.com subject',
30             },
31             commands => {
32             create => [ qw(content) ],
33             parse => [ qw(string) ],
34             save_attachments => [ qw(string) ],
35             },
36             require_modules => {
37             'Metabrik::System::File' => [ ],
38             'Metabrik::File::Base64' => [ ],
39             'Email::Simple' => [ ],
40             'Email::MIME' => [ ],
41             },
42             };
43             }
44              
45             sub create {
46 0     0 0   my $self = shift;
47 0           my ($content) = @_;
48              
49 0 0         $self->brik_help_run_undef_arg('create', $content) or return;
50              
51 0           my $from = $self->from;
52 0           my $to = $self->to;
53 0           my $subject = $self->subject;
54              
55 0           my $email = Email::Simple->create(
56             header => [
57             From => $from,
58             To => $to,
59             Subject => $subject,
60             ],
61             body => $content,
62             );
63              
64 0           return $email;
65             }
66              
67             sub parse {
68 0     0 0   my $self = shift;
69 0           my ($message) = @_;
70              
71 0 0         $self->brik_help_run_undef_arg('parse', $message) or return;
72              
73 0           my $parsed = Email::MIME->new($message);
74 0 0         if (! defined($parsed)) {
75 0           return $self->log->error("parse: MIME failed for message");
76             }
77              
78 0           my $simple = Email::Simple->new($message);
79              
80 0           my @headers = $simple->headers;
81 0           my %header = ();
82 0           for my $this (@headers) {
83 0           my @values = $simple->header($this);
84 0 0         if (@values == 1) {
85 0           $header{$this} = $values[0];
86             }
87             else {
88 0           $header{$this} = \@values;
89             }
90             }
91              
92 0           my @list = ();
93 0           push @list, \%header;
94              
95 0           my @parts = $parsed->parts;
96 0           for (@parts) {
97 0           my $this = { %$_ }; # unbless it.
98              
99 0           my $filename = $_->filename;
100 0           my $file_content = $_->body_raw;
101 0 0 0       if (defined($filename) && defined($file_content)) {
102 0           $this->{filename} = $filename;
103 0           $file_content =~ s{[\r\n]*$}{};
104 0           $this->{file_content} = $file_content;
105             }
106              
107 0 0 0       if (exists($this->{header}) && exists($this->{header}{headers})) {
108 0           my $headers = $this->{header}{headers};
109 0           my $new_headers = {};
110 0           my $name;
111             my $value;
112 0           for (@$headers) {
113 0 0         if (ref($_) eq '') { # This is a name
    0          
114 0           $name = $_;
115             }
116             elsif (ref($_) eq 'ARRAY') { # This is a value
117 0           $value = $_->[0]; # 0: has the header value, 1 has the header + value
118             }
119 0 0 0       if (defined($name) && defined($value)) {
120 0           $new_headers->{$name} = $value;
121 0           $name = undef;
122 0           $value = undef;
123             }
124             }
125 0           $this->{header} = $new_headers;
126             }
127 0           push @list, $this;
128             }
129              
130 0           return \@list;
131             }
132              
133             sub save_attachments {
134 0     0 0   my $self = shift;
135 0           my ($string) = @_;
136              
137 0 0         $self->brik_help_run_undef_arg('parse', $string) or return;
138              
139 0           my $datadir = $self->datadir;
140 0 0         my $message = $self->parse($string) or return;
141 0           my $headers = $message->[0];
142              
143 0 0         my $sf = Metabrik::System::File->new_from_brik_init($self) or return;
144 0 0         my $fb = Metabrik::File::Base64->new_from_brik_init($self) or return;
145              
146 0           my @files = ();
147 0           for my $part (@$message) {
148 0 0 0       if (exists($part->{filename}) && length($part->{filename})) {
149 0           my $from = $headers->{From};
150 0           my $to = $headers->{To};
151 0           my $subject = $headers->{Subject};
152 0           my $filename = $sf->basefile($part->{filename});
153 0           $filename =~ s{\s+}{_}g; # I hate spaces in filenames.
154             my $output = $fb->decode_from_string(
155 0           $part->{file_content}, $datadir."/$filename"
156             );
157 0           push @files, {
158             headers => $headers,
159             file => $output,
160             };
161             }
162             }
163              
164 0           return \@files;
165             }
166              
167             1;
168              
169             __END__