File Coverage

blib/lib/Courriel/Header/Disposition.pm
Criterion Covered Total %
statement 24 24 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 32 32 100.0


line stmt bran cond sub pod time code
1             package Courriel::Header::Disposition;
2              
3 8     8   671 use strict;
  8         16  
  8         355  
4 8     8   44 use warnings;
  8         14  
  8         300  
5 8     8   45 use namespace::autoclean;
  8         14  
  8         77  
6              
7             our $VERSION = '0.43';
8              
9 8     8   865 use Courriel::Types qw( Bool Maybe NonEmptyStr );
  8         16  
  8         73  
10 8     8   70412 use DateTime;
  8         2980963  
  8         454  
11 8     8   5514 use DateTime::Format::Mail;
  8         49732  
  8         354  
12              
13 8     8   71 use Moose;
  8         15  
  8         88  
14 8     8   51952 use MooseX::StrictConstructor;
  8         16  
  8         106  
15              
16             extends 'Courriel::Header';
17              
18             with 'Courriel::Role::HeaderWithAttributes' =>
19             { main_value_key => 'disposition' };
20              
21             has '+value' => (
22             required => 0,
23             lazy => 1,
24             builder => 'as_header_value',
25             );
26              
27             has disposition => (
28             is => 'ro',
29             isa => NonEmptyStr,
30             required => 1,
31             );
32              
33             has is_inline => (
34             is => 'ro',
35             isa => Bool,
36             init_arg => undef,
37             lazy => 1,
38             default => sub { $_[0]->disposition() ne 'attachment' },
39             );
40              
41             has is_attachment => (
42             is => 'ro',
43             isa => Bool,
44             init_arg => undef,
45             lazy => 1,
46             default => sub { !$_[0]->is_inline() },
47             );
48              
49             has filename => (
50             is => 'ro',
51             isa => Maybe [NonEmptyStr],
52             init_arg => undef,
53             lazy => 1,
54             default => sub {
55             exists $_[0]->_attributes()->{filename}
56             ? $_[0]->_attributes()->{filename}->value()
57             : undef;
58             },
59             );
60              
61             {
62             my $parser = DateTime::Format::Mail->new( loose => 1 );
63             for my $attr (qw( creation_datetime modification_datetime read_datetime ))
64             {
65             ( my $name_in_header = $attr ) =~ s/_/-/g;
66             $name_in_header =~ s/datetime/date/;
67              
68             my $default = sub {
69             my $attr = $_[0]->_attributes()->{$name_in_header};
70             return unless $attr;
71              
72             my $dt = $parser->parse_datetime( $attr->value() );
73             $dt->set_time_zone('UTC') if $dt;
74              
75             return $dt;
76             };
77              
78             has $attr => (
79             is => 'ro',
80             isa => Maybe ['DateTime'],
81             init_arg => undef,
82             lazy => 1,
83             default => $default,
84             );
85             }
86             }
87              
88             around BUILDARGS => sub {
89             my $orig = shift;
90             my $class = shift;
91              
92             my $p = $class->$orig(@_);
93              
94             $p->{name} = 'Content-Disposition' unless exists $p->{name};
95              
96             return $p;
97             };
98              
99             __PACKAGE__->meta()->make_immutable();
100              
101             1;
102              
103             # ABSTRACT: The content disposition for an email part
104              
105             __END__
106              
107             =pod
108              
109             =encoding UTF-8
110              
111             =head1 NAME
112              
113             Courriel::Header::Disposition - The content disposition for an email part
114              
115             =head1 VERSION
116              
117             version 0.43
118              
119             =head1 SYNOPSIS
120              
121             my $disp = $part->content_disposition();
122             print $disp->is_inline();
123             print $disp->is_attachment();
124             print $disp->filename();
125              
126             my %attr = $disp->attributes();
127             while ( my ( $k, $v ) = each %attr ) {
128             print "$k => $v\n";
129             }
130              
131             =head1 DESCRIPTION
132              
133             This class represents the contents of a "Content-Disposition" header attached
134             to an email part. Such headers indicate whether or not a part should be
135             considered an attachment or should be displayed to the user directly. This
136             header may also include information about the attachment's filename, creation
137             date, etc.
138              
139             Here are some typical headers:
140              
141             Content-Disposition: inline
142              
143             Content-Disposition: multipart/alternative; boundary=abcdefghijk
144              
145             Content-Disposition: attachment; filename="Filename.jpg"
146              
147             Content-Disposition: attachment; filename="foo-bar.jpg";
148             creation-date="Tue, 31 May 2011 09:41:13 -0700"
149              
150             =head1 API
151              
152             This class supports the following methods:
153              
154             =head2 Courriel::Header::Disposition->new_from_value( ... )
155              
156             This takes two parameters, C<name> and C<value>. The C<name> is optional, and
157             defaults to "Content-Disposition".
158              
159             The C<value> is parsed and split up into the disposition and attributes.
160              
161             =head2 Courriel::Header::Disposition->new( ... )
162              
163             This method creates a new object. It accepts the following parameters:
164              
165             =over 4
166              
167             =item * name
168              
169             This defaults to 'Content-Type'.
170              
171             =item * value
172              
173             This is the full header value.
174              
175             =item * disposition
176              
177             This should usually either be "inline" or "attachment".
178              
179             In theory, the RFCs allow other values.
180              
181             =item * attributes
182              
183             A hash reference of attributes from the header, such as a filename, creation
184             date, size, etc. The keys are attribute names and the values can either be
185             strings or L<Courriel::HeaderAttribute> objects. Values which are strings will
186             be inflated into objects by the constructor.
187              
188             This is optional, and can be an empty hash reference or omitted entirely.
189              
190             =back
191              
192             =head2 $ct->name()
193              
194             The header name, usually "Content-Disposition".
195              
196             =head2 $ct->value()
197              
198             The raw header value.
199              
200             =head2 $disp->disposition()
201              
202             Returns the disposition value passed to the constructor.
203              
204             =head2 $disp->is_inline()
205              
206             Returns true if the disposition is not equal to "attachment".
207              
208             =head2 $disp->is_attachment()
209              
210             Returns true if the disposition is equal to "attachment".
211              
212             =head2 $disp->filename()
213              
214             Returns the filename found in the attributes, or C<undef>.
215              
216             =head2 $disp->creation_datetime(), $disp->last_modified_datetime(), $disp->read_datetime()
217              
218             These methods look for a corresponding attribute ("creation-date", etc.) and
219             return a L<DateTime> object representing that attribute's value, if it exists.
220              
221             =head2 $disp->attributes()
222              
223             Returns a hash (not a reference) of the attributes passed to the constructor.
224              
225             Attributes are L<Courriel::HeaderAttribute> objects.
226              
227             The keys of the hash are all lower case, though the original casing is
228             preserved in the C<name()> returned by the L<Courriel::HeaderAttribute>
229             object.
230              
231             =head2 $disp->attribute($key)
232              
233             Given a key, returns the named L<Courriel::HeaderAttribute> object. Obviously,
234             this value can be C<undef> if the attribute doesn't exist. Name lookup is
235             case-insensitive.
236              
237             =head2 $disp->attribute_value($key)
238              
239             Given a key, returns the named attribute's value as a string. Obviously, this
240             value can be C<undef> if the attribute doesn't exist. Name lookup is
241             case-insensitive.
242              
243             The attribute is a L<Courriel::HeaderAttribute> object.
244              
245             =head2 $disp->as_header_value()
246              
247             Returns the object as a string suitable for a header value (but not folded).
248              
249             =head1 EXTENDS
250              
251             This class extends L<Courriel::Header>.
252              
253             =head1 ROLES
254              
255             This class does the C<Courriel::Role::HeaderWithAttributes> role.
256              
257             =head1 SUPPORT
258              
259             Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=Courriel>
260             (or L<bug-courriel@rt.cpan.org|mailto:bug-courriel@rt.cpan.org>).
261              
262             I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
263              
264             =head1 AUTHOR
265              
266             Dave Rolsky <autarch@urth.org>
267              
268             =head1 COPYRIGHT AND LICENSE
269              
270             This software is Copyright (c) 2016 by Dave Rolsky.
271              
272             This is free software, licensed under:
273              
274             The Artistic License 2.0 (GPL Compatible)
275              
276             =cut