File Coverage

blib/lib/MIME/Body.pm
Criterion Covered Total %
statement 109 115 94.7
branch 26 34 76.4
condition 7 15 46.6
subroutine 29 32 90.6
pod 11 11 100.0
total 182 207 87.9


line stmt bran cond sub pod time code
1             package MIME::Body;
2              
3             =head1 NAME
4              
5             MIME::Body - the body of a MIME message
6              
7              
8             =head1 SYNOPSIS
9              
10             Before reading further, you should see L to make sure that
11             you understand where this module fits into the grand scheme of things.
12             Go on, do it now. I'll wait.
13              
14             Ready? Ok...
15              
16              
17             =head2 Obtaining bodies
18              
19             ### Get the bodyhandle of a MIME::Entity object:
20             $body = $entity->bodyhandle;
21              
22             ### Create a body which stores data in a disk file:
23             $body = new MIME::Body::File "/path/to/file";
24              
25             ### Create a body which stores data in an in-core array:
26             $body = new MIME::Body::InCore \@strings;
27              
28              
29             =head2 Opening, closing, and using IO handles
30              
31             ### Write data to the body:
32             $IO = $body->open("w") || die "open body: $!";
33             $IO->print($message);
34             $IO->close || die "close I/O handle: $!";
35              
36             ### Read data from the body (in this case, line by line):
37             $IO = $body->open("r") || die "open body: $!";
38             while (defined($_ = $IO->getline)) {
39             ### do stuff
40             }
41             $IO->close || die "close I/O handle: $!";
42              
43              
44             =head2 Other I/O
45              
46             ### Dump the ENCODED body data to a filehandle:
47             $body->print(\*STDOUT);
48              
49             ### Slurp all the UNENCODED data in, and put it in a scalar:
50             $string = $body->as_string;
51              
52             ### Slurp all the UNENCODED data in, and put it in an array of lines:
53             @lines = $body->as_lines;
54              
55              
56             =head2 Working directly with paths to underlying files
57              
58             ### Where's the data?
59             if (defined($body->path)) { ### data is on disk:
60             print "data is stored externally, in ", $body->path;
61             }
62             else { ### data is in core:
63             print "data is already in core, and is...\n", $body->as_string;
64             }
65              
66             ### Get rid of anything on disk:
67             $body->purge;
68              
69              
70             =head1 DESCRIPTION
71              
72             MIME messages can be very long (e.g., tar files, MPEGs, etc.) or very
73             short (short textual notes, as in ordinary mail). Long messages
74             are best stored in files, while short ones are perhaps best stored
75             in core.
76              
77             This class is an attempt to define a common interface for objects
78             which contain message data, regardless of how the data is
79             physically stored. The lifespan of a "body" object
80             usually looks like this:
81              
82             =over 4
83              
84             =item 1.
85              
86             B
87             It's at this point that the actual MIME::Body subclass is chosen,
88             and new() is invoked. (For example: if the body data is going to
89             a file, then it is at this point that the class MIME::Body::File,
90             and the filename, is chosen).
91              
92             =item 2.
93              
94             B (usually by the MIME parser) like this:
95             The body is opened for writing, via C. This will trash any
96             previous contents, and return an "I/O handle" opened for writing.
97             Data is written to this I/O handle, via print().
98             Then the I/O handle is closed, via close().
99              
100             =item 3.
101              
102             B (usually by the user application) like this:
103             The body is opened for reading by a user application, via C.
104             This will return an "I/O handle" opened for reading.
105             Data is read from the I/O handle, via read(), getline(), or getlines().
106             Then the I/O handle is closed, via close().
107              
108             =item 4.
109              
110             B
111              
112             =back
113              
114             You can write your own subclasses, as long as they follow the
115             interface described below. Implementers of subclasses should assume
116             that steps 2 and 3 may be repeated any number of times, and in
117             different orders (e.g., 1-2-2-3-2-3-3-3-3-3-2-4).
118              
119             In any case, once a MIME::Body has been created, you ask to open it
120             for reading or writing, which gets you an "i/o handle": you then use
121             the same mechanisms for reading from or writing to that handle, no matter
122             what class it is.
123              
124             Beware: unless you know for certain what kind of body you have, you
125             should I assume that the body has an underlying filehandle.
126              
127              
128             =head1 PUBLIC INTERFACE
129              
130             =over 4
131              
132             =cut
133              
134              
135             ### Pragmas:
136 22     22   168754 use strict;
  22         28  
  22         681  
137 22     22   92 use vars qw($VERSION);
  22         29  
  22         764  
138              
139             ### System modules:
140 22     22   84 use Carp;
  22         27  
  22         1204  
141 22     22   2071 use IO::File;
  22         21685  
  22         12364  
142              
143             ### The package version, both in 1.23 style *and* usable by MakeMaker:
144             $VERSION = "5.509";
145              
146              
147             #------------------------------
148              
149             =item new ARGS...
150              
151             I
152             Create a new body. Any ARGS are sent to init().
153              
154             =cut
155              
156             sub new {
157 162     162 1 6645 my $self = bless {}, shift;
158 162         387 $self->init(@_);
159 162         494 $self;
160             }
161              
162             #------------------------------
163              
164             =item init ARGS...
165              
166             I
167             This is called automatically by C, with the arguments given
168             to C. The arguments are optional, and entirely up to the
169             subclass. The default method does nothing,
170              
171             =cut
172              
173 0     0 1 0 sub init { 1 }
174              
175             #------------------------------
176              
177             =item as_lines
178              
179             I
180             Return the contents of the body as an array of lines (each terminated
181             by a newline, with the possible exception of the final one).
182             Returns empty on failure (NB: indistinguishable from an empty body!).
183              
184             Note: the default method gets the data via
185             repeated getline() calls; your subclass might wish to override this.
186              
187             =cut
188              
189             sub as_lines {
190 7     7 1 5119 my $self = shift;
191 7         7 my @lines;
192 7   50     14 my $io = $self->open("r") || return ();
193 7         75 local $_;
194 7         202 push @lines, $_ while (defined($_ = $io->getline()));
195 7         1526 $io->close;
196 7         81 @lines;
197             }
198              
199             #------------------------------
200              
201             =item as_string
202              
203             I
204             Return the body data as a string (slurping it into core if necessary).
205             Best not to do this unless you're I that the body is reasonably small!
206             Returns empty string for an empty body, and undef on failure.
207              
208             Note: the default method uses print(), which gets the data via
209             repeated read() calls; your subclass might wish to override this.
210              
211             =cut
212              
213             sub as_string {
214 10     10 1 196 my $self = shift;
215 10         13 my $str = '';
216 10 50       48 my $fh = IO::File->new(\$str, '>:') or croak("Cannot open in-memory file: $!");
217 10         425 $self->print($fh);
218 10         12 close($fh);
219 10         26 return $str;
220             }
221             *data = \&as_string; ### silently invoke preferred usage
222              
223              
224             #------------------------------
225              
226             =item binmode [ONOFF]
227              
228             I
229             With argument, flags whether or not open() should return an I/O handle
230             which has binmode() activated. With no argument, just returns the
231             current value.
232              
233             =cut
234              
235             sub binmode {
236 186     186 1 247 my ($self, $onoff) = @_;
237 186 100       396 $self->{MB_Binmode} = $onoff if (@_ > 1);
238 186         533 $self->{MB_Binmode};
239             }
240              
241             #------------------------------
242              
243             =item is_encoded [ONOFF]
244              
245             I
246             If set to yes, no decoding is applied on output. This flag is set
247             by MIME::Parser, if the parser runs in decode_bodies(0) mode, so the
248             content is handled unmodified.
249              
250             =cut
251              
252             sub is_encoded {
253 80     80 1 76 my ($self, $yesno) = @_;
254 80 100       129 $self->{MB_IsEncoded} = $yesno if (@_ > 1);
255 80         189 $self->{MB_IsEncoded};
256             }
257              
258             #------------------------------
259              
260             =item dup
261              
262             I
263             Duplicate the bodyhandle.
264              
265             I external data in bodyhandles is I copied to new files!
266             Changing the data in one body's data file, or purging that body,
267             I affect its duplicate. Bodies with in-core data probably need
268             not worry.
269              
270             =cut
271              
272             sub dup {
273 4     4 1 5 my $self = shift;
274 4         17 bless { %$self }, ref($self); ### shallow copy ok for ::File and ::Scalar
275             }
276              
277             #------------------------------
278              
279             =item open READWRITE
280              
281             I
282             This should do whatever is necessary to open the body for either
283             writing (if READWRITE is "w") or reading (if mode is "r").
284              
285             This method is expected to return an "I/O handle" object on success,
286             and undef on error. An I/O handle can be any object that supports a
287             small set of standard methods for reading/writing data.
288             See the IO::Handle class for an example.
289              
290             =cut
291              
292             sub open {
293 0     0 1 0 undef;
294             }
295              
296             #------------------------------
297              
298             =item path [PATH]
299              
300             I
301             If you're storing the body data externally (e.g., in a disk file), you'll
302             want to give applications the ability to get at that data, for cleanup.
303             This method should return the path to the data, or undef if there is none.
304              
305             Where appropriate, the path I be a simple string, like a filename.
306             With argument, sets the PATH, which should be undef if there is none.
307              
308             =cut
309              
310             sub path {
311 336     336 1 515 my $self = shift;
312 336 100       622 $self->{MB_Path} = shift if @_;
313 336         1090 $self->{MB_Path};
314             }
315              
316             #------------------------------
317              
318             =item print FILEHANDLE
319              
320             I
321             Output the body data to the given filehandle, or to the currently-selected
322             one if none is given.
323              
324             =cut
325              
326             sub print {
327 19     19 1 20 my ($self, $fh) = @_;
328 19         17 my $nread;
329              
330             ### Get output filehandle, and ensure that it's a printable object:
331 19   33     39 $fh ||= select;
332              
333             ### Write it:
334 19         19 my $buf = '';
335 19   50     30 my $io = $self->open("r") || return undef;
336 19         395 $fh->print($buf) while ($nread = $io->read($buf, 8192));
337 19         348 $io->close;
338 19         116 return defined($nread); ### how'd we do?
339             }
340              
341             #------------------------------
342              
343             =item purge
344              
345             I
346             Remove any data which resides external to the program (e.g., in disk files).
347             Immediately after a purge(), the path() should return undef to indicate
348             that the external data is no longer available.
349              
350             =cut
351              
352             sub purge {
353 0     0 1 0 1;
354             }
355              
356              
357              
358             =back
359              
360             =head1 SUBCLASSES
361              
362             The following built-in classes are provided:
363              
364             Body Stores body When open()ed,
365             class: data in: returns:
366             --------------------------------------------------------
367             MIME::Body::File disk file IO::Handle
368             MIME::Body::Scalar scalar IO::Handle
369             MIME::Body::InCore scalar array IO::Handle
370              
371             =cut
372              
373            
374             #------------------------------------------------------------
375             package MIME::Body::File;
376             #------------------------------------------------------------
377              
378             =head2 MIME::Body::File
379              
380             A body class that stores the data in a disk file. Invoke the
381             constructor as:
382              
383             $body = new MIME::Body::File "/path/to/file";
384              
385             In this case, the C method would return the given path,
386             so you I say:
387              
388             if (defined($body->path)) {
389             open BODY, $body->path or die "open: $!";
390             while () {
391             ### do stuff
392             }
393             close BODY;
394             }
395              
396             But you're best off not doing this.
397              
398             =cut
399              
400              
401             ### Pragmas:
402 22     22   113 use vars qw(@ISA);
  22         25  
  22         780  
403 22     22   81 use strict;
  22         30  
  22         378  
404              
405             ### System modules:
406 22     22   71 use IO::File;
  22         26  
  22         2921  
407              
408             ### Kit modules:
409 22     22   1592 use MIME::Tools qw(whine);
  22         34  
  22         5257  
410              
411             @ISA = qw(MIME::Body);
412              
413              
414             #------------------------------
415             # init PATH
416             #------------------------------
417             sub init {
418 112     112   129 my ($self, $path) = @_;
419 112         239 $self->path($path); ### use it as-is
420 112         99 $self;
421             }
422              
423             #------------------------------
424             # open READWRITE
425             #------------------------------
426             sub open {
427 150     150   845 my ($self, $mode) = @_;
428              
429 150         230 my $path = $self->path;
430              
431 150 50 66     538 if( $mode ne 'r' && $mode ne 'w' ) {
432 0         0 die "bad mode: '$mode'";
433             }
434              
435 150   50     560 my $IO = IO::File->new($path, $mode) || die "MIME::Body::File->open $path: $!";
436              
437 150 100       13892 $IO->binmode() if $self->binmode;
438              
439 150         715 return $IO;
440             }
441              
442             #------------------------------
443             # purge
444             #------------------------------
445             # Unlink the path (and undefine it).
446             #
447             sub purge {
448 3     3   2 my $self = shift;
449 3 50       5 if (defined($self->path)) {
450 3 50       4 unlink $self->path or whine "couldn't unlink ".$self->path.": $!";
451 3         5 $self->path(undef);
452             }
453 3         6 1;
454             }
455              
456              
457            
458              
459             #------------------------------------------------------------
460             package MIME::Body::Scalar;
461             #------------------------------------------------------------
462              
463             =head2 MIME::Body::Scalar
464              
465             A body class that stores the data in-core, in a simple scalar.
466             Invoke the constructor as:
467              
468             $body = new MIME::Body::Scalar \$string;
469              
470             A single scalar argument sets the body to that value, exactly as though
471             you'd opened for the body for writing, written the value,
472             and closed the body again:
473              
474             $body = new MIME::Body::Scalar "Line 1\nLine 2\nLine 3";
475              
476             A single array reference sets the body to the result of joining all the
477             elements of that array together:
478              
479             $body = new MIME::Body::Scalar ["Line 1\n",
480             "Line 2\n",
481             "Line 3"];
482              
483             =cut
484              
485 22     22   95 use vars qw(@ISA);
  22         32  
  22         736  
486 22     22   77 use strict;
  22         31  
  22         365  
487              
488 22     22   69 use Carp;
  22         30  
  22         4614  
489              
490             @ISA = qw(MIME::Body);
491              
492              
493             #------------------------------
494             # init DATA
495             #------------------------------
496             sub init {
497 2     2   5 my ($self, $data) = @_;
498 2 50 33     12 $data = join('', @$data) if (ref($data) && (ref($data) eq 'ARRAY'));
499 2 50       15 $self->{MBS_Data} = (defined($data) ? $data : '');
500 2         4 $self;
501             }
502              
503             #------------------------------
504             # as_string
505             #------------------------------
506             sub as_string {
507 2     2   379 shift->{MBS_Data};
508             }
509              
510             #------------------------------
511             # open READWRITE
512             #------------------------------
513             sub open {
514 88     88   2100 my ($self, $mode) = @_;
515 88 100       219 $self->{MBS_Data} = '' if ($mode eq 'w'); ### writing
516              
517 88 100       203 if ($mode eq 'w') {
    50          
518 30         36 $mode = '>:';
519             } elsif ($mode eq 'r') {
520 58         64 $mode = '<:';
521             } else {
522 0         0 die "bad mode: $mode";
523             }
524              
525 88         445 return IO::File->new(\ $self->{MBS_Data}, $mode);
526             }
527              
528              
529              
530            
531              
532             #------------------------------------------------------------
533             package MIME::Body::InCore;
534             #------------------------------------------------------------
535              
536             =head2 MIME::Body::InCore
537              
538             A body class that stores the data in-core.
539             Invoke the constructor as:
540              
541             $body = new MIME::Body::InCore \$string;
542             $body = new MIME::Body::InCore $string;
543             $body = new MIME::Body::InCore \@stringarray
544              
545             A simple scalar argument sets the body to that value, exactly as though
546             you'd opened for the body for writing, written the value,
547             and closed the body again:
548              
549             $body = new MIME::Body::InCore "Line 1\nLine 2\nLine 3";
550              
551             A single array reference sets the body to the concatenation of all
552             scalars that it holds:
553              
554             $body = new MIME::Body::InCore ["Line 1\n",
555             "Line 2\n",
556             "Line 3"];
557              
558             =cut
559              
560 22     22   103 use vars qw(@ISA);
  22         27  
  22         708  
561 22     22   83 use strict;
  22         29  
  22         356  
562              
563 22     22   67 use Carp;
  22         30  
  22         3376  
564              
565             @ISA = qw(MIME::Body::Scalar);
566              
567              
568             #------------------------------
569             # init DATA
570             #------------------------------
571             sub init {
572 48     48   62 my ($self, $data) = @_;
573 48 100       142 if (!defined($data)) { ### nothing
    100          
    100          
    50          
574 28         82 $self->{MBS_Data} = '';
575             }
576             elsif (!ref($data)) { ### simple scalar
577 11         38 $self->{MBS_Data} = $data;
578             }
579             elsif (ref($data) eq 'SCALAR') {
580 1         2 $self->{MBS_Data} = $$data;
581             }
582             elsif (ref($data) eq 'ARRAY') {
583 8         29 $self->{MBS_Data} = join('', @$data);
584             }
585             else {
586 0         0 croak "I can't handle DATA which is a ".ref($data)."\n";
587             }
588 48         49 $self;
589             }
590              
591             1;
592             __END__