← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:12 2021

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