1package MIME::Entity; 2 3 4=head1 NAME 5 6MIME::Entity - class for parsed-and-decoded MIME message 7 8 9=head1 SYNOPSIS 10 11Before reading further, you should see L<MIME::Tools> to make sure that 12you understand where this module fits into the grand scheme of things. 13Go on, do it now. I'll wait. 14 15Ready? Ok... 16 17 ### Create an entity: 18 $top = MIME::Entity->build(From => 'me@myhost.com', 19 To => 'you@yourhost.com', 20 Subject => "Hello, nurse!", 21 Data => \@my_message); 22 23 ### Attach stuff to it: 24 $top->attach(Path => $gif_path, 25 Type => "image/gif", 26 Encoding => "base64"); 27 28 ### Sign it: 29 $top->sign; 30 31 ### Output it: 32 $top->print(\*STDOUT); 33 34 35=head1 DESCRIPTION 36 37A subclass of B<Mail::Internet>. 38 39This package provides a class for representing MIME message entities, 40as specified in RFCs 2045, 2046, 2047, 2048 and 2049. 41 42 43=head1 EXAMPLES 44 45=head2 Construction examples 46 47Create a document for an ordinary 7-bit ASCII text file (lots of 48stuff is defaulted for us): 49 50 $ent = MIME::Entity->build(Path=>"english-msg.txt"); 51 52Create a document for a text file with 8-bit (Latin-1) characters: 53 54 $ent = MIME::Entity->build(Path =>"french-msg.txt", 55 Encoding =>"quoted-printable", 56 From =>'jean.luc@inria.fr', 57 Subject =>"C'est bon!"); 58 59Create a document for a GIF file (the description is completely optional; 60note that we have to specify content-type and encoding since they're 61not the default values): 62 63 $ent = MIME::Entity->build(Description => "A pretty picture", 64 Path => "./docs/mime-sm.gif", 65 Type => "image/gif", 66 Encoding => "base64"); 67 68Create a document that you already have the text for, using "Data": 69 70 $ent = MIME::Entity->build(Type => "text/plain", 71 Encoding => "quoted-printable", 72 Data => ["First line.\n", 73 "Second line.\n", 74 "Last line.\n"]); 75 76Create a multipart message, with the entire structure given 77explicitly: 78 79 ### Create the top-level, and set up the mail headers: 80 $top = MIME::Entity->build(Type => "multipart/mixed", 81 From => 'me@myhost.com', 82 To => 'you@yourhost.com', 83 Subject => "Hello, nurse!"); 84 85 ### Attachment #1: a simple text document: 86 $top->attach(Path=>"./testin/short.txt"); 87 88 ### Attachment #2: a GIF file: 89 $top->attach(Path => "./docs/mime-sm.gif", 90 Type => "image/gif", 91 Encoding => "base64"); 92 93 ### Attachment #3: text we'll create with text we have on-hand: 94 $top->attach(Data => $contents); 95 96Suppose you don't know ahead of time that you'll have attachments? 97No problem: you can "attach" to singleparts as well: 98 99 $top = MIME::Entity->build(From => 'me@myhost.com', 100 To => 'you@yourhost.com', 101 Subject => "Hello, nurse!", 102 Data => \@my_message); 103 if ($GIF_path) { 104 $top->attach(Path => $GIF_path, 105 Type => 'image/gif'); 106 } 107 108Copy an entity (headers, parts... everything but external body data): 109 110 my $deepcopy = $top->dup; 111 112 113 114=head2 Access examples 115 116 ### Get the head, a MIME::Head: 117 $head = $ent->head; 118 119 ### Get the body, as a MIME::Body; 120 $bodyh = $ent->bodyhandle; 121 122 ### Get the intended MIME type (as declared in the header): 123 $type = $ent->mime_type; 124 125 ### Get the effective MIME type (in case decoding failed): 126 $eff_type = $ent->effective_type; 127 128 ### Get preamble, parts, and epilogue: 129 $preamble = $ent->preamble; ### ref to array of lines 130 $num_parts = $ent->parts; 131 $first_part = $ent->parts(0); ### an entity 132 $epilogue = $ent->epilogue; ### ref to array of lines 133 134 135=head2 Manipulation examples 136 137Muck about with the body data: 138 139 ### Read the (unencoded) body data: 140 if ($io = $ent->open("r")) { 141 while (defined($_ = $io->getline)) { print $_ } 142 $io->close; 143 } 144 145 ### Write the (unencoded) body data: 146 if ($io = $ent->open("w")) { 147 foreach (@lines) { $io->print($_) } 148 $io->close; 149 } 150 151 ### Delete the files for any external (on-disk) data: 152 $ent->purge; 153 154Muck about with the signature: 155 156 ### Sign it (automatically removes any existing signature): 157 $top->sign(File=>"$ENV{HOME}/.signature"); 158 159 ### Remove any signature within 15 lines of the end: 160 $top->remove_sig(15); 161 162Muck about with the headers: 163 164 ### Compute content-lengths for singleparts based on bodies: 165 ### (Do this right before you print!) 166 $entity->sync_headers(Length=>'COMPUTE'); 167 168Muck about with the structure: 169 170 ### If a 0- or 1-part multipart, collapse to a singlepart: 171 $top->make_singlepart; 172 173 ### If a singlepart, inflate to a multipart with 1 part: 174 $top->make_multipart; 175 176Delete parts: 177 178 ### Delete some parts of a multipart message: 179 my @keep = grep { keep_part($_) } $msg->parts; 180 $msg->parts(\@keep); 181 182 183=head2 Output examples 184 185Print to filehandles: 186 187 ### Print the entire message: 188 $top->print(\*STDOUT); 189 190 ### Print just the header: 191 $top->print_header(\*STDOUT); 192 193 ### Print just the (encoded) body... includes parts as well! 194 $top->print_body(\*STDOUT); 195 196Stringify... note that C<stringify_xx> can also be written C<xx_as_string>; 197the methods are synonymous, and neither form will be deprecated. 198 199If you set the variable $MIME::Entity::BOUNDARY_DELIMITER to a string, 200that string will be used as the line-end delimiter on output. If it is not set, 201the line ending will be a newline character (\n) 202 203NOTE that $MIME::Entity::BOUNDARY_DELIMITER only applies to structural 204parts of the MIME data generated by this package and to the Base64 205encoded output; if a part internally uses a different line-end 206delimiter and is output as-is, the line-ending is not changed to match 207$MIME::Entity::BOUNDARY_DELIMITER. 208 209 ### Stringify the entire message: 210 print $top->stringify; ### or $top->as_string 211 212 ### Stringify just the header: 213 print $top->stringify_header; ### or $top->header_as_string 214 215 ### Stringify just the (encoded) body... includes parts as well! 216 print $top->stringify_body; ### or $top->body_as_string 217 218Debug: 219 220 ### Output debugging info: 221 $entity->dump_skeleton(\*STDERR); 222 223 224 225=head1 PUBLIC INTERFACE 226 227=cut 228 229#------------------------------ 230 231### Pragmas: 232use vars qw(@ISA $VERSION); 233use strict; 234 235### System modules: 236use Carp; 237 238### Other modules: 239use Mail::Internet 1.28 (); 240use Mail::Field 1.05 (); 241 242### Kit modules: 243use MIME::Tools qw(:config :msgs :utils); 244use MIME::Head; 245use MIME::Body; 246use MIME::Decoder; 247 248@ISA = qw(Mail::Internet); 249 250 251#------------------------------ 252# 253# Globals... 254# 255#------------------------------ 256 257### The package version, both in 1.23 style *and* usable by MakeMaker: 258$VERSION = "5.509"; 259 260### Boundary counter: 261my $BCount = 0; 262 263### Standard "Content-" MIME fields, for scrub(): 264my $StandardFields = 'Description|Disposition|Id|Type|Transfer-Encoding'; 265 266### Known Mail/MIME fields... these, plus some general forms like 267### "x-*", are recognized by build(): 268my %KnownField = map {$_=>1} 269qw( 270 bcc cc comments date encrypted 271 from keywords message-id mime-version organization 272 received references reply-to return-path sender 273 subject to 274 ); 275 276### Fallback preamble and epilogue: 277my $DefPreamble = [ "This is a multi-part message in MIME format..." ]; 278my $DefEpilogue = [ ]; 279 280 281#============================== 282# 283# Utilities, private 284# 285 286#------------------------------ 287# 288# known_field FIELDNAME 289# 290# Is this a recognized Mail/MIME field? 291# 292sub known_field { 293 my $field = lc(shift); 294 $KnownField{$field} or ($field =~ m{^(content|resent|x)-.}); 295} 296 297#------------------------------ 298# 299# make_boundary 300# 301# Return a unique boundary string. 302# This is used both internally and by MIME::ParserBase, but it is NOT in 303# the public interface! Do not use it! 304# 305# We generate one containing a "=_", as RFC2045 suggests: 306# A good strategy is to choose a boundary that includes a character 307# sequence such as "=_" which can never appear in a quoted-printable 308# body. See the definition of multipart messages in RFC 2046. 309# 310sub make_boundary { 311 return "----------=_".scalar(time)."-$$-".$BCount++; 312} 313 314 315 316 317 318 319#============================== 320 321=head2 Construction 322 323=over 4 324 325=cut 326 327 328#------------------------------ 329 330=item new [SOURCE] 331 332I<Class method.> 333Create a new, empty MIME entity. 334Basically, this uses the Mail::Internet constructor... 335 336If SOURCE is an ARRAYREF, it is assumed to be an array of lines 337that will be used to create both the header and an in-core body. 338 339Else, if SOURCE is defined, it is assumed to be a filehandle 340from which the header and in-core body is to be read. 341 342B<Note:> in either case, the body will not be I<parsed:> merely read! 343 344=cut 345 346sub new { 347 my $class = shift; 348 my $self = $class->Mail::Internet::new(@_); ### inherited 349 $self->{ME_Parts} = []; ### no parts extracted 350 $self; 351} 352 353 354###------------------------------ 355 356=item add_part ENTITY, [OFFSET] 357 358I<Instance method.> 359Assuming we are a multipart message, add a body part (a MIME::Entity) 360to the array of body parts. Returns the part that was just added. 361 362If OFFSET is positive, the new part is added at that offset from the 363beginning of the array of parts. If it is negative, it counts from 364the end of the array. (An INDEX of -1 will place the new part at the 365very end of the array, -2 will place it as the penultimate item in the 366array, etc.) If OFFSET is not given, the new part is added to the end 367of the array. 368I<Thanks to Jason L Tibbitts III for providing support for OFFSET.> 369 370B<Warning:> in general, you only want to attach parts to entities 371with a content-type of C<multipart/*>). 372 373=cut 374 375sub add_part { 376 my ($self, $part, $index) = @_; 377 defined($index) or $index = -1; 378 379 ### Make $index count from the end if negative: 380 $index = $#{$self->{ME_Parts}} + 2 + $index if ($index < 0); 381 splice(@{$self->{ME_Parts}}, $index, 0, $part); 382 $part; 383} 384 385#------------------------------ 386 387=item attach PARAMHASH 388 389I<Instance method.> 390The real quick-and-easy way to create multipart messages. 391The PARAMHASH is used to C<build> a new entity; this method is 392basically equivalent to: 393 394 $entity->add_part(ref($entity)->build(PARAMHASH, Top=>0)); 395 396B<Note:> normally, you attach to multipart entities; however, if you 397attach something to a singlepart (like attaching a GIF to a text 398message), the singlepart will be coerced into a multipart automatically. 399 400=cut 401 402sub attach { 403 my $self = shift; 404 $self->make_multipart; 405 $self->add_part(ref($self)->build(@_, Top=>0)); 406} 407 408#------------------------------ 409 410=item build PARAMHASH 411 412I<Class/instance method.> 413A quick-and-easy catch-all way to create an entity. Use it like this 414to build a "normal" single-part entity: 415 416 $ent = MIME::Entity->build(Type => "image/gif", 417 Encoding => "base64", 418 Path => "/path/to/xyz12345.gif", 419 Filename => "saveme.gif", 420 Disposition => "attachment"); 421 422And like this to build a "multipart" entity: 423 424 $ent = MIME::Entity->build(Type => "multipart/mixed", 425 Boundary => "---1234567"); 426 427A minimal MIME header will be created. If you want to add or modify 428any header fields afterwards, you can of course do so via the underlying 429head object... but hey, there's now a prettier syntax! 430 431 $ent = MIME::Entity->build(Type =>"multipart/mixed", 432 From => $myaddr, 433 Subject => "Hi!", 434 'X-Certified' => ['SINED', 435 'SEELED', 436 'DELIVERED']); 437 438Normally, an C<X-Mailer> header field is output which contains this 439toolkit's name and version (plus this module's RCS version). 440This will allow any bad MIME we generate to be traced back to us. 441You can of course overwrite that header with your own: 442 443 $ent = MIME::Entity->build(Type => "multipart/mixed", 444 'X-Mailer' => "myprog 1.1"); 445 446Or remove it entirely: 447 448 $ent = MIME::Entity->build(Type => "multipart/mixed", 449 'X-Mailer' => undef); 450 451OK, enough hype. The parameters are: 452 453=over 4 454 455=item (FIELDNAME) 456 457Any field you want placed in the message header, taken from the 458standard list of header fields (you don't need to worry about case): 459 460 Bcc Encrypted Received Sender 461 Cc From References Subject 462 Comments Keywords Reply-To To 463 Content-* Message-ID Resent-* X-* 464 Date MIME-Version Return-Path 465 Organization 466 467To give experienced users some veto power, these fields will be set 468I<after> the ones I set... so be careful: I<don't set any MIME fields> 469(like C<Content-type>) unless you know what you're doing! 470 471To specify a fieldname that's I<not> in the above list, even one that's 472identical to an option below, just give it with a trailing C<":">, 473like C<"My-field:">. When in doubt, that I<always> signals a mail 474field (and it sort of looks like one too). 475 476=item Boundary 477 478I<Multipart entities only. Optional.> 479The boundary string. As per RFC-2046, it must consist only 480of the characters C<[0-9a-zA-Z'()+_,-./:=?]> and space (you'll be 481warned, and your boundary will be ignored, if this is not the case). 482If you omit this, a random string will be chosen... which is probably 483safer. 484 485=item Charset 486 487I<Optional.> 488The character set. 489 490=item Data 491 492I<Single-part entities only. Optional.> 493An alternative to Path (q.v.): the actual data, either as a scalar 494or an array reference (whose elements are joined together to make 495the actual scalar). The body is opened on the data using 496MIME::Body::InCore. 497 498=item Description 499 500I<Optional.> 501The text of the content-description. 502If you don't specify it, the field is not put in the header. 503 504=item Disposition 505 506I<Optional.> 507The basic content-disposition (C<"attachment"> or C<"inline">). 508If you don't specify it, it defaults to "inline" for backwards 509compatibility. I<Thanks to Kurt Freytag for suggesting this feature.> 510 511=item Encoding 512 513I<Optional.> 514The content-transfer-encoding. 515If you don't specify it, a reasonable default is put in. 516You can also give the special value '-SUGGEST', to have it chosen for 517you in a heavy-duty fashion which scans the data itself. 518 519=item Filename 520 521I<Single-part entities only. Optional.> 522The recommended filename. Overrides any name extracted from C<Path>. 523The information is stored both the deprecated (content-type) and 524preferred (content-disposition) locations. If you explicitly want to 525I<avoid> a recommended filename (even when Path is used), supply this 526as empty or undef. 527 528=item Id 529 530I<Optional.> 531Set the content-id. 532 533=item Path 534 535I<Single-part entities only. Optional.> 536The path to the file to attach. The body is opened on that file 537using MIME::Body::File. 538 539=item Top 540 541I<Optional.> 542Is this a top-level entity? If so, it must sport a MIME-Version. 543The default is true. (NB: look at how C<attach()> uses it.) 544 545=item Type 546 547I<Optional.> 548The basic content-type (C<"text/plain">, etc.). 549If you don't specify it, it defaults to C<"text/plain"> 550as per RFC 2045. I<Do yourself a favor: put it in.> 551 552=back 553 554=cut 555 556sub build { 557 my ($self, @paramlist) = @_; 558 my %params = @paramlist; 559 my ($field, $filename, $boundary); 560 561 ### Create a new entity, if needed: 562 ref($self) or $self = $self->new; 563 564 565 ### GET INFO... 566 567 ### Get sundry field: 568 my $type = $params{Type} || 'text/plain'; 569 my $charset = $params{Charset}; 570 my $is_multipart = ($type =~ m{^multipart/}i); 571 my $encoding = $params{Encoding} || ''; 572 my $desc = $params{Description}; 573 my $top = exists($params{Top}) ? $params{Top} : 1; 574 my $disposition = $params{Disposition} || 'inline'; 575 my $id = $params{Id}; 576 577 ### Get recommended filename, allowing explicit no-value value: 578 my ($path_fname) = (($params{Path}||'') =~ m{([^/]+)\Z}); 579 $filename = (exists($params{Filename}) ? $params{Filename} : $path_fname); 580 $filename = undef if (defined($filename) and $filename eq ''); 581 582 ### Type-check sanity: 583 if ($type =~ m{^(multipart/|message/(rfc822|partial|external-body|delivery-status|disposition-notification|feedback-report)$)}i) { 584 ($encoding =~ /^(|7bit|8bit|binary|-suggest)$/i) 585 or croak "can't have encoding $encoding for message type $type!"; 586 } 587 588 ### Multipart or not? Do sanity check and fixup: 589 if ($is_multipart) { ### multipart... 590 591 ### Get any supplied boundary, and check it: 592 if (defined($boundary = $params{Boundary})) { ### they gave us one... 593 if ($boundary eq '') { 594 whine "empty string not a legal boundary: I'm ignoring it"; 595 $boundary = undef; 596 } 597 elsif ($boundary =~ m{[^0-9a-zA-Z_\'\(\)\+\,\.\/\:\=\?\- ]}) { 598 whine "boundary ignored: illegal characters ($boundary)"; 599 $boundary = undef; 600 } 601 } 602 603 ### If we have to roll our own boundary, do so: 604 defined($boundary) or $boundary = make_boundary(); 605 } 606 else { ### single part... 607 ### Create body: 608 if ($params{Path}) { 609 $self->bodyhandle(new MIME::Body::File $params{Path}); 610 } 611 elsif (defined($params{Data})) { 612 $self->bodyhandle(new MIME::Body::InCore $params{Data}); 613 } 614 else { 615 die "can't build entity: no body, and not multipart\n"; 616 } 617 618 ### Check whether we need to binmode(): [Steve Kilbane] 619 $self->bodyhandle->binmode(1) unless textual_type($type); 620 } 621 622 623 ### MAKE HEAD... 624 625 ### Create head: 626 my $head = new MIME::Head; 627 $self->head($head); 628 $head->modify(1); 629 630 ### Add content-type field: 631 $field = new Mail::Field 'Content_type'; ### not a typo :-( 632 $field->type($type); 633 $field->charset($charset) if $charset; 634 $field->name($filename) if defined($filename); 635 $field->boundary($boundary) if defined($boundary); 636 $head->replace('Content-type', $field->stringify); 637 638 ### Now that both body and content-type are available, we can suggest 639 ### content-transfer-encoding (if desired); 640 if (!$encoding) { 641 $encoding = $self->suggest_encoding_lite; 642 } 643 elsif (lc($encoding) eq '-suggest') { 644 $encoding = $self->suggest_encoding; 645 } 646 647 ### Add content-disposition field (if not multipart): 648 unless ($is_multipart) { 649 $field = new Mail::Field 'Content_disposition'; ### not a typo :-( 650 $field->type($disposition); 651 $field->filename($filename) if defined($filename); 652 $head->replace('Content-disposition', $field->stringify); 653 } 654 655 ### Add other MIME fields: 656 $head->replace('Content-transfer-encoding', $encoding) if $encoding; 657 $head->replace('Content-description', $desc) if $desc; 658 659 # Content-Id value should be surrounded by < >, but versions before 5.428 660 # did not do this. So, we check, and add if the caller has not done so 661 # already. 662 if( defined $id ) { 663 if( $id !~ /^<.*>$/ ) { 664 $id = "<$id>"; 665 } 666 $head->replace('Content-id', $id); 667 } 668 $head->replace('MIME-Version', '1.0') if $top; 669 670 ### Add the X-Mailer field, if top level (use default value if not given): 671 $top and $head->replace('X-Mailer', 672 "MIME-tools ".(MIME::Tools->version). 673 " (Entity " .($VERSION).")"); 674 675 ### Add remaining user-specified fields, if any: 676 while (@paramlist) { 677 my ($tag, $value) = (shift @paramlist, shift @paramlist); 678 679 ### Get fieldname, if that's what it is: 680 if ($tag =~ /^-(.*)/s) { $tag = lc($1) } ### old style, b.c. 681 elsif ($tag =~ /(.*):$/s ) { $tag = lc($1) } ### new style 682 elsif (known_field(lc($tag))) { 1 } ### known field 683 else { next; } ### not a field 684 685 ### Clear head, get list of values, and add them: 686 $head->delete($tag); 687 foreach $value (ref($value) ? @$value : ($value)) { 688 (defined($value) && ($value ne '')) or next; 689 $head->add($tag, $value); 690 } 691 } 692 693 ### Done! 694 $self; 695} 696 697#------------------------------ 698 699=item dup 700 701I<Instance method.> 702Duplicate the entity. Does a deep, recursive copy, I<but beware:> 703external data in bodyhandles is I<not> copied to new files! 704Changing the data in one entity's data file, or purging that entity, 705I<will> affect its duplicate. Entities with in-core data probably need 706not worry. 707 708=cut 709 710sub dup { 711 my $self = shift; 712 local($_); 713 714 ### Self (this will also dup the header): 715 my $dup = bless $self->SUPER::dup(), ref($self); 716 717 ### Any simple inst vars: 718 foreach (keys %$self) {$dup->{$_} = $self->{$_} unless ref($self->{$_})}; 719 720 ### Bodyhandle: 721 $dup->bodyhandle($self->bodyhandle ? $self->bodyhandle->dup : undef); 722 723 ### Preamble and epilogue: 724 foreach (qw(ME_Preamble ME_Epilogue)) { 725 $dup->{$_} = [@{$self->{$_}}] if $self->{$_}; 726 } 727 728 ### Parts: 729 $dup->{ME_Parts} = []; 730 foreach (@{$self->{ME_Parts}}) { push @{$dup->{ME_Parts}}, $_->dup } 731 732 ### Done! 733 $dup; 734} 735 736=back 737 738=cut 739 740 741 742 743 744#============================== 745 746=head2 Access 747 748=over 4 749 750=cut 751 752 753#------------------------------ 754 755=item body [VALUE] 756 757I<Instance method.> 758Get the I<encoded> (transport-ready) body, as an array of lines. 759Returns an array reference. Each array entry is a newline-terminated 760line. 761 762This is a read-only data structure: changing its contents will have 763no effect. Its contents are identical to what is printed by 764L<print_body()|/print_body>. 765 766Provided for compatibility with Mail::Internet, so that methods 767like C<smtpsend()> will work. Note however that if VALUE is given, 768a fatal exception is thrown, since you cannot use this method to 769I<set> the lines of the encoded message. 770 771If you want the raw (unencoded) body data, use the L<bodyhandle()|/bodyhandle> 772method to get and use a MIME::Body. The content-type of the entity 773will tell you whether that body is best read as text (via getline()) 774or raw data (via read()). 775 776=cut 777 778sub body { 779 my ($self, $value) = @_; 780 my $boundary_delimiter = $MIME::Entity::BOUNDARY_DELIMITER || "\n"; 781 if (@_ > 1) { ### setting body line(s)... 782 croak "you cannot use body() to set the encoded contents\n"; 783 } else { 784 my $output = ''; 785 my $fh = IO::File->new(\$output, '>:') or croak("Cannot open in-memory file: $!"); 786 $self->print_body($fh); 787 close($fh); 788 my @ary = split(/\n/, $output); 789 # Each line needs the terminating newline 790 @ary = map { "$_$boundary_delimiter" } @ary; 791 792 return \@ary; 793 } 794} 795 796#------------------------------ 797 798=item bodyhandle [VALUE] 799 800I<Instance method.> 801Get or set an abstract object representing the body of the message. 802The body holds the decoded message data. 803 804B<Note that not all entities have bodies!> 805An entity will have either a body or parts: not both. 806This method will I<only> return an object if this entity can 807have a body; otherwise, it will return undefined. 808Whether-or-not a given entity can have a body is determined by 809(1) its content type, and (2) whether-or-not the parser was told to 810extract nested messages: 811 812 Type: | Extract nested? | bodyhandle() | parts() 813 ----------------------------------------------------------------------- 814 multipart/* | - | undef | 0 or more MIME::Entity 815 message/* | true | undef | 0 or 1 MIME::Entity 816 message/* | false | MIME::Body | empty list 817 (other) | - | MIME::Body | empty list 818 819If C<VALUE> I<is not> given, the current bodyhandle is returned, 820or undef if the entity cannot have a body. 821 822If C<VALUE> I<is> given, the bodyhandle is set to the new value, 823and the previous value is returned. 824 825See L</parts> for more info. 826 827=cut 828 829sub bodyhandle { 830 my ($self, $newvalue) = @_; 831 my $value = $self->{ME_Bodyhandle}; 832 $self->{ME_Bodyhandle} = $newvalue if (@_ > 1); 833 $value; 834} 835 836#------------------------------ 837 838=item effective_type [MIMETYPE] 839 840I<Instance method.> 841Set/get the I<effective> MIME type of this entity. This is I<usually> 842identical to the actual (or defaulted) MIME type, but in some cases 843it differs. For example, from RFC-2045: 844 845 Any entity with an unrecognized Content-Transfer-Encoding must be 846 treated as if it has a Content-Type of "application/octet-stream", 847 regardless of what the Content-Type header field actually says. 848 849Why? because if we can't decode the message, then we have to take 850the bytes as-is, in their (unrecognized) encoded form. So the 851message ceases to be a "text/foobar" and becomes a bunch of undecipherable 852bytes -- in other words, an "application/octet-stream". 853 854Such an entity, if parsed, would have its effective_type() set to 855C<"application/octet_stream">, although the mime_type() and the contents 856of the header would remain the same. 857 858If there is no effective type, the method just returns what 859mime_type() would. 860 861B<Warning:> the effective type is "sticky"; once set, that effective_type() 862will always be returned even if the conditions that necessitated setting 863the effective type become no longer true. 864 865=cut 866 867sub effective_type { 868 my $self = shift; 869 $self->{ME_EffType} = shift if @_; 870 return ($self->{ME_EffType} ? lc($self->{ME_EffType}) : $self->mime_type); 871} 872 873 874#------------------------------ 875 876=item epilogue [LINES] 877 878I<Instance method.> 879Get/set the text of the epilogue, as an array of newline-terminated LINES. 880Returns a reference to the array of lines, or undef if no epilogue exists. 881 882If there is a epilogue, it is output when printing this entity; otherwise, 883a default epilogue is used. Setting the epilogue to undef (not []!) causes 884it to fallback to the default. 885 886=cut 887 888sub epilogue { 889 my ($self, $lines) = @_; 890 $self->{ME_Epilogue} = $lines if @_ > 1; 891 $self->{ME_Epilogue}; 892} 893 894#------------------------------ 895 896=item head [VALUE] 897 898I<Instance method.> 899Get/set the head. 900 901If there is no VALUE given, returns the current head. If none 902exists, an empty instance of MIME::Head is created, set, and returned. 903 904B<Note:> This is a patch over a problem in Mail::Internet, which doesn't 905provide a method for setting the head to some given object. 906 907=cut 908 909sub head { 910 my ($self, $value) = @_; 911 (@_ > 1) and $self->{'mail_inet_head'} = $value; 912 $self->{'mail_inet_head'} ||= new MIME::Head; ### KLUDGE! 913} 914 915#------------------------------ 916 917=item is_multipart 918 919I<Instance method.> 920Does this entity's effective MIME type indicate that it's a multipart entity? 921Returns undef (false) if the answer couldn't be determined, 0 (false) 922if it was determined to be false, and true otherwise. 923Note that this says nothing about whether or not parts were extracted. 924 925NOTE: we switched to effective_type so that multiparts with 926bad or missing boundaries could be coerced to an effective type 927of C<application/x-unparseable-multipart>. 928 929 930=cut 931 932sub is_multipart { 933 my $self = shift; 934 $self->head or return undef; ### no head, so no MIME type! 935 my ($type, $subtype) = split('/', $self->effective_type); 936 (($type eq 'multipart') ? 1 : 0); 937} 938 939#------------------------------ 940 941=item mime_type 942 943I<Instance method.> 944A purely-for-convenience method. This simply relays the request to the 945associated MIME::Head object. 946If there is no head, returns undef in a scalar context and 947the empty array in a list context. 948 949B<Before you use this,> consider using effective_type() instead, 950especially if you obtained the entity from a MIME::Parser. 951 952=cut 953 954sub mime_type { 955 my $self = shift; 956 $self->head or return (wantarray ? () : undef); 957 $self->head->mime_type; 958} 959 960#------------------------------ 961 962=item open READWRITE 963 964I<Instance method.> 965A purely-for-convenience method. This simply relays the request to the 966associated MIME::Body object (see MIME::Body::open()). 967READWRITE is either 'r' (open for read) or 'w' (open for write). 968 969If there is no body, returns false. 970 971=cut 972 973sub open { 974 my $self = shift; 975 $self->bodyhandle and $self->bodyhandle->open(@_); 976} 977 978#------------------------------ 979 980=item parts 981 982=item parts INDEX 983 984=item parts ARRAYREF 985 986I<Instance method.> 987Return the MIME::Entity objects which are the sub parts of this 988entity (if any). 989 990I<If no argument is given,> returns the array of all sub parts, 991returning the empty array if there are none (e.g., if this is a single 992part message, or a degenerate multipart). In a scalar context, this 993returns you the number of parts. 994 995I<If an integer INDEX is given,> return the INDEXed part, 996or undef if it doesn't exist. 997 998I<If an ARRAYREF to an array of parts is given,> then this method I<sets> 999the parts to a copy of that array, and returns the parts. This can 1000be used to delete parts, as follows: 1001 1002 ### Delete some parts of a multipart message: 1003 $msg->parts([ grep { keep_part($_) } $msg->parts ]); 1004 1005 1006B<Note:> for multipart messages, the preamble and epilogue are I<not> 1007considered parts. If you need them, use the C<preamble()> and C<epilogue()> 1008methods. 1009 1010B<Note:> there are ways of parsing with a MIME::Parser which cause 1011certain message parts (such as those of type C<message/rfc822>) 1012to be "reparsed" into pseudo-multipart entities. You should read the 1013documentation for those options carefully: it I<is> possible for 1014a diddled entity to not be multipart, but still have parts attached to it! 1015 1016See L</bodyhandle> for a discussion of parts vs. bodies. 1017 1018=cut 1019 1020sub parts { 1021 my $self = shift; 1022 ref($_[0]) and return @{$self->{ME_Parts} = [@{$_[0]}]}; ### set the parts 1023 (@_ ? $self->{ME_Parts}[$_[0]] : @{$self->{ME_Parts}}); 1024} 1025 1026#------------------------------ 1027 1028=item parts_DFS 1029 1030I<Instance method.> 1031Return the list of all MIME::Entity objects included in the entity, 1032starting with the entity itself, in depth-first-search order. 1033If the entity has no parts, it alone will be returned. 1034 1035I<Thanks to Xavier Armengou for suggesting this method.> 1036 1037=cut 1038 1039sub parts_DFS { 1040 my $self = shift; 1041 return ($self, map { $_->parts_DFS } $self->parts); 1042} 1043 1044#------------------------------ 1045 1046=item preamble [LINES] 1047 1048I<Instance method.> 1049Get/set the text of the preamble, as an array of newline-terminated LINES. 1050Returns a reference to the array of lines, or undef if no preamble exists 1051(e.g., if this is a single-part entity). 1052 1053If there is a preamble, it is output when printing this entity; otherwise, 1054a default preamble is used. Setting the preamble to undef (not []!) causes 1055it to fallback to the default. 1056 1057=cut 1058 1059sub preamble { 1060 my ($self, $lines) = @_; 1061 $self->{ME_Preamble} = $lines if @_ > 1; 1062 $self->{ME_Preamble}; 1063} 1064 1065 1066 1067 1068 1069=back 1070 1071=cut 1072 1073 1074 1075 1076#============================== 1077 1078=head2 Manipulation 1079 1080=over 4 1081 1082=cut 1083 1084#------------------------------ 1085 1086=item make_multipart [SUBTYPE], OPTSHASH... 1087 1088I<Instance method.> 1089Force the entity to be a multipart, if it isn't already. 1090We do this by replacing the original [singlepart] entity with a new 1091multipart that has the same non-MIME headers ("From", "Subject", etc.), 1092but all-new MIME headers ("Content-type", etc.). We then create 1093a copy of the original singlepart, I<strip out> the non-MIME headers 1094from that, and make it a part of the new multipart. So this: 1095 1096 From: me 1097 To: you 1098 Content-type: text/plain 1099 Content-length: 12 1100 1101 Hello there! 1102 1103Becomes something like this: 1104 1105 From: me 1106 To: you 1107 Content-type: multipart/mixed; boundary="----abc----" 1108 1109 ------abc---- 1110 Content-type: text/plain 1111 Content-length: 12 1112 1113 Hello there! 1114 ------abc------ 1115 1116The actual type of the new top-level multipart will be "multipart/SUBTYPE" 1117(default SUBTYPE is "mixed"). 1118 1119Returns 'DONE' if we really did inflate a singlepart to a multipart. 1120Returns 'ALREADY' (and does nothing) if entity is I<already> multipart 1121and Force was not chosen. 1122 1123If OPTSHASH contains Force=>1, then we I<always> bump the top-level's 1124content and content-headers down to a subpart of this entity, even if 1125this entity is already a multipart. This is apparently of use to 1126people who are tweaking messages after parsing them. 1127 1128=cut 1129 1130sub make_multipart { 1131 my ($self, $subtype, %opts) = @_; 1132 my $tag; 1133 $subtype ||= 'mixed'; 1134 my $force = $opts{Force}; 1135 1136 ### Trap for simple case: already a multipart? 1137 return 'ALREADY' if ($self->is_multipart and !$force); 1138 1139 ### Rip out our guts, and spew them into our future part: 1140 my $part = bless {%$self}, ref($self); ### part is a shallow copy 1141 %$self = (); ### lobotomize ourselves! 1142 $self->head($part->head->dup); ### dup the header 1143 1144 ### Remove content headers from top-level, and set it up as a multipart: 1145 foreach $tag (grep {/^content-/i} $self->head->tags) { 1146 $self->head->delete($tag); 1147 } 1148 $self->head->mime_attr('Content-type' => "multipart/$subtype"); 1149 $self->head->mime_attr('Content-type.boundary' => make_boundary()); 1150 1151 ### Remove NON-content headers from the part: 1152 foreach $tag (grep {!/^content-/i} $part->head->tags) { 1153 $part->head->delete($tag); 1154 } 1155 1156 ### Add the [sole] part: 1157 $self->{ME_Parts} = []; 1158 $self->add_part($part); 1159 'DONE'; 1160} 1161 1162#------------------------------ 1163 1164=item make_singlepart 1165 1166I<Instance method.> 1167If the entity is a multipart message with one part, this tries hard to 1168rewrite it as a singlepart, by replacing the content (and content headers) 1169of the top level with those of the part. Also crunches 0-part multiparts 1170into singleparts. 1171 1172Returns 'DONE' if we really did collapse a multipart to a singlepart. 1173Returns 'ALREADY' (and does nothing) if entity is already a singlepart. 1174Returns '0' (and does nothing) if it can't be made into a singlepart. 1175 1176=cut 1177 1178sub make_singlepart { 1179 my $self = shift; 1180 1181 ### Trap for simple cases: 1182 return 'ALREADY' if !$self->is_multipart; ### already a singlepart? 1183 return '0' if ($self->parts > 1); ### can this even be done? 1184 1185 # Get rid of all our existing content info 1186 my $tag; 1187 foreach $tag (grep {/^content-/i} $self->head->tags) { 1188 $self->head->delete($tag); 1189 } 1190 1191 if ($self->parts == 1) { ### one part 1192 my $part = $self->parts(0); 1193 1194 ### Populate ourselves with any content info from the part: 1195 foreach $tag (grep {/^content-/i} $part->head->tags) { 1196 foreach ($part->head->get($tag)) { $self->head->add($tag, $_) } 1197 } 1198 1199 ### Save reconstructed header, replace our guts, and restore header: 1200 my $new_head = $self->head; 1201 %$self = %$part; ### shallow copy is ok! 1202 $self->head($new_head); 1203 1204 ### One more thing: the part *may* have been a multi with 0 or 1 parts! 1205 return $self->make_singlepart(@_) if $self->is_multipart; 1206 } 1207 else { ### no parts! 1208 $self->head->mime_attr('Content-type'=>'text/plain'); ### simple 1209 } 1210 'DONE'; 1211} 1212 1213#------------------------------ 1214 1215=item purge 1216 1217I<Instance method.> 1218Recursively purge (e.g., unlink) all external (e.g., on-disk) body parts 1219in this message. See MIME::Body::purge() for details. 1220 1221B<Note:> this does I<not> delete the directories that those body parts 1222are contained in; only the actual message data files are deleted. 1223This is because some parsers may be customized to create intermediate 1224directories while others are not, and it's impossible for this class 1225to know what directories are safe to remove. Only your application 1226program truly knows that. 1227 1228B<If you really want to "clean everything up",> one good way is to 1229use C<MIME::Parser::file_under()>, and then do this before parsing 1230your next message: 1231 1232 $parser->filer->purge(); 1233 1234I wouldn't attempt to read those body files after you do this, for 1235obvious reasons. As of MIME-tools 4.x, each body's path I<is> undefined 1236after this operation. I warned you I might do this; truly I did. 1237 1238I<Thanks to Jason L. Tibbitts III for suggesting this method.> 1239 1240=cut 1241 1242sub purge { 1243 my $self = shift; 1244 $self->bodyhandle and $self->bodyhandle->purge; ### purge me 1245 foreach ($self->parts) { $_->purge } ### recurse 1246 1; 1247} 1248 1249#------------------------------ 1250# 1251# _do_remove_sig 1252# 1253# Private. Remove a signature within NLINES lines from the end of BODY. 1254# The signature must be flagged by a line containing only "-- ". 1255 1256sub _do_remove_sig { 1257 my ($body, $nlines) = @_; 1258 $nlines ||= 10; 1259 my $i = 0; 1260 1261 my $line = int(@$body) || return; 1262 while ($i++ < $nlines and $line--) { 1263 if ($body->[$line] =~ /\A--[ \040][\r\n]+\Z/) { 1264 $#{$body} = $line-1; 1265 return; 1266 } 1267 } 1268} 1269 1270#------------------------------ 1271 1272=item remove_sig [NLINES] 1273 1274I<Instance method, override.> 1275Attempts to remove a user's signature from the body of a message. 1276 1277It does this by looking for a line matching C</^-- $/> within the last 1278C<NLINES> of the message. If found then that line and all lines after 1279it will be removed. If C<NLINES> is not given, a default value of 10 1280will be used. This would be of most use in auto-reply scripts. 1281 1282For MIME entity, this method is reasonably cautious: it will only 1283attempt to un-sign a message with a content-type of C<text/*>. 1284 1285If you send remove_sig() to a multipart entity, it will relay it to 1286the first part (the others usually being the "attachments"). 1287 1288B<Warning:> currently slurps the whole message-part into core as an 1289array of lines, so you probably don't want to use this on extremely 1290long messages. 1291 1292Returns truth on success, false on error. 1293 1294=cut 1295 1296sub remove_sig { 1297 my $self = shift; 1298 my $nlines = shift; 1299 1300 # If multipart, we only attempt to remove the sig from the first 1301 # part. This is usually a good assumption for multipart/mixed, but 1302 # may not always be correct. It is also possibly incorrect on 1303 # multipart/alternative (both may have sigs). 1304 if( $self->is_multipart ) { 1305 my $first_part = $self->parts(0); 1306 if( $first_part ) { 1307 return $first_part->remove_sig(@_); 1308 } 1309 return undef; 1310 } 1311 1312 ### Refuse non-textual unless forced: 1313 textual_type($self->head->mime_type) 1314 or return error "I won't un-sign a non-text message unless I'm forced"; 1315 1316 ### Get body data, as an array of newline-terminated lines: 1317 $self->bodyhandle or return undef; 1318 my @body = $self->bodyhandle->as_lines; 1319 1320 ### Nuke sig: 1321 _do_remove_sig(\@body, $nlines); 1322 1323 ### Output data back into body: 1324 my $io = $self->bodyhandle->open("w"); 1325 foreach (@body) { $io->print($_) }; ### body data 1326 $io->close; 1327 1328 ### Done! 1329 1; 1330} 1331 1332#------------------------------ 1333 1334=item sign PARAMHASH 1335 1336I<Instance method, override.> 1337Append a signature to the message. The params are: 1338 1339=over 4 1340 1341=item Attach 1342 1343Instead of appending the text, add it to the message as an attachment. 1344The disposition will be C<inline>, and the description will indicate 1345that it is a signature. The default behavior is to append the signature 1346to the text of the message (or the text of its first part if multipart). 1347I<MIME-specific; new in this subclass.> 1348 1349=item File 1350 1351Use the contents of this file as the signature. 1352Fatal error if it can't be read. 1353I<As per superclass method.> 1354 1355=item Force 1356 1357Sign it even if the content-type isn't C<text/*>. Useful for 1358non-standard types like C<x-foobar>, but be careful! 1359I<MIME-specific; new in this subclass.> 1360 1361=item Remove 1362 1363Normally, we attempt to strip out any existing signature. 1364If true, this gives us the NLINES parameter of the remove_sig call. 1365If zero but defined, tells us I<not> to remove any existing signature. 1366If undefined, removal is done with the default of 10 lines. 1367I<New in this subclass.> 1368 1369=item Signature 1370 1371Use this text as the signature. You can supply it as either 1372a scalar, or as a ref to an array of newline-terminated scalars. 1373I<As per superclass method.> 1374 1375=back 1376 1377For MIME messages, this method is reasonably cautious: it will only 1378attempt to sign a message with a content-type of C<text/*>, unless 1379C<Force> is specified. 1380 1381If you send this message to a multipart entity, it will relay it to 1382the first part (the others usually being the "attachments"). 1383 1384B<Warning:> currently slurps the whole message-part into core as an 1385array of lines, so you probably don't want to use this on extremely 1386long messages. 1387 1388Returns true on success, false otherwise. 1389 1390=cut 1391 1392sub sign { 1393 my $self = shift; 1394 my %params = @_; 1395 my $io; 1396 1397 my $boundary_delimiter = $MIME::Entity::BOUNDARY_DELIMITER || "\n"; 1398 ### If multipart and not attaching, try to sign our first part: 1399 if ($self->is_multipart and !$params{Attach}) { 1400 return $self->parts(0)->sign(@_); 1401 } 1402 1403 ### Get signature: 1404 my $sig; 1405 if (defined($sig = $params{Signature})) { ### scalar or array 1406 $sig = (ref($sig) ? join('', @$sig) : $sig); 1407 } 1408 elsif ($params{File}) { ### file contents 1409 my $fh = IO::File->new( $params{File} ) or croak "can't open $params{File}: $!"; 1410 $sig = join('', $fh->getlines); 1411 $fh->close or croak "can't close $params{File}: $!"; 1412 } 1413 else { 1414 croak "no signature given!"; 1415 } 1416 1417 ### Add signature to message as appropriate: 1418 if ($params{Attach}) { ### Attach .sig as new part... 1419 return $self->attach(Type => 'text/plain', 1420 Description => 'Signature', 1421 Disposition => 'inline', 1422 Encoding => '-SUGGEST', 1423 Data => $sig); 1424 } 1425 else { ### Add text of .sig to body data... 1426 1427 ### Refuse non-textual unless forced: 1428 ($self->head->mime_type =~ m{text/}i or $params{Force}) or 1429 return error "I won't sign a non-text message unless I'm forced"; 1430 1431 ### Get body data, as an array of newline-terminated lines: 1432 $self->bodyhandle or return undef; 1433 my @body = $self->bodyhandle->as_lines; 1434 1435 ### Nuke any existing sig? 1436 if (!defined($params{Remove}) || ($params{Remove} > 0)) { 1437 _do_remove_sig(\@body, $params{Remove}); 1438 } 1439 1440 ### Output data back into body, followed by signature: 1441 my $line; 1442 $io = $self->open("w") or croak("open: $!"); 1443 foreach $line (@body) { $io->print($line) }; ### body data 1444 (($body[-1]||'') =~ /\n\Z/) or $io->print($boundary_delimiter); ### ensure final \n 1445 $io->print("-- $boundary_delimiter$sig"); ### separator + sig 1446 $io->close or croak("close: $!"); 1447 return 1; ### done! 1448 } 1449} 1450 1451#------------------------------ 1452 1453=item suggest_encoding 1454 1455I<Instance method.> 1456Based on the effective content type, return a good suggested encoding. 1457 1458C<text> and C<message> types have their bodies scanned line-by-line 1459for 8-bit characters and long lines; lack of either means that the 1460message is 7bit-ok. Other types are chosen independent of their body: 1461 1462 Major type: 7bit ok? Suggested encoding: 1463 ----------------------------------------------------------- 1464 text yes 7bit 1465 text no quoted-printable 1466 message yes 7bit 1467 message no binary 1468 multipart * binary (in case some parts are bad) 1469 image, etc... * base64 1470 1471=cut 1472 1473### TO DO: resolve encodings of nested entities (possibly in sync_headers). 1474 1475sub suggest_encoding { 1476 my $self = shift; 1477 1478 my ($type) = split '/', $self->effective_type; 1479 if (($type eq 'text') || ($type eq 'message')) { ### scan message body 1480 $self->bodyhandle || return ($self->parts ? 'binary' : '7bit'); 1481 my ($IO, $unclean); 1482 if ($IO = $self->bodyhandle->open("r")) { 1483 ### Scan message for 7bit-cleanliness 1484 local $_; 1485 while (defined($_ = $IO->getline)) { 1486 last if ($unclean = ((length($_) > 999) or /[\200-\377]/)); 1487 } 1488 1489 ### Return '7bit' if clean; try and encode if not... 1490 ### Note that encodings are not permitted for messages! 1491 return ($unclean 1492 ? (($type eq 'message') ? 'binary' : 'quoted-printable') 1493 : '7bit'); 1494 } 1495 } 1496 else { 1497 return ($type eq 'multipart') ? 'binary' : 'base64'; 1498 } 1499} 1500 1501sub suggest_encoding_lite { 1502 my $self = shift; 1503 my ($type) = split '/', $self->effective_type; 1504 return (($type =~ /^(text|message|multipart)$/) ? 'binary' : 'base64'); 1505} 1506 1507#------------------------------ 1508 1509=item sync_headers OPTIONS 1510 1511I<Instance method.> 1512This method does a variety of activities which ensure that 1513the MIME headers of an entity "tree" are in-synch with the body parts 1514they describe. It can be as expensive an operation as printing 1515if it involves pre-encoding the body parts; however, the aim is to 1516produce fairly clean MIME. B<You will usually only need to invoke 1517this if processing and re-sending MIME from an outside source.> 1518 1519The OPTIONS is a hash, which describes what is to be done. 1520 1521=over 4 1522 1523 1524=item Length 1525 1526One of the "official unofficial" MIME fields is "Content-Length". 1527Normally, one doesn't care a whit about this field; however, if 1528you are preparing output destined for HTTP, you may. The value of 1529this option dictates what will be done: 1530 1531B<COMPUTE> means to set a C<Content-Length> field for every non-multipart 1532part in the entity, and to blank that field out for every multipart 1533part in the entity. 1534 1535B<ERASE> means that C<Content-Length> fields will all 1536be blanked out. This is fast, painless, and safe. 1537 1538B<Any false value> (the default) means to take no action. 1539 1540 1541=item Nonstandard 1542 1543Any header field beginning with "Content-" is, according to the RFC, 1544a MIME field. However, some are non-standard, and may cause problems 1545with certain MIME readers which interpret them in different ways. 1546 1547B<ERASE> means that all such fields will be blanked out. This is 1548done I<before> the B<Length> option (q.v.) is examined and acted upon. 1549 1550B<Any false value> (the default) means to take no action. 1551 1552 1553=back 1554 1555Returns a true value if everything went okay, a false value otherwise. 1556 1557=cut 1558 1559sub sync_headers { 1560 my $self = shift; 1561 my $opts = ((int(@_) % 2 == 0) ? {@_} : shift); 1562 my $ENCBODY; ### keep it around until done! 1563 1564 ### Get options: 1565 my $o_nonstandard = ($opts->{Nonstandard} || 0); 1566 my $o_length = ($opts->{Length} || 0); 1567 1568 ### Get head: 1569 my $head = $self->head; 1570 1571 ### What to do with "nonstandard" MIME fields? 1572 if ($o_nonstandard eq 'ERASE') { ### Erase them... 1573 my $tag; 1574 foreach $tag ($head->tags()) { 1575 if (($tag =~ /\AContent-/i) && 1576 ($tag !~ /\AContent-$StandardFields\Z/io)) { 1577 $head->delete($tag); 1578 } 1579 } 1580 } 1581 1582 ### What to do with the "Content-Length" MIME field? 1583 if ($o_length eq 'COMPUTE') { ### Compute the content length... 1584 my $content_length = ''; 1585 1586 ### We don't have content-lengths in multiparts... 1587 if ($self->is_multipart) { ### multipart... 1588 $head->delete('Content-length'); 1589 } 1590 else { ### singlepart... 1591 1592 ### Get the encoded body, if we don't have it already: 1593 unless ($ENCBODY) { 1594 $ENCBODY = tmpopen() || die "can't open tmpfile"; 1595 $self->print_body($ENCBODY); ### write encoded to tmpfile 1596 } 1597 1598 ### Analyse it: 1599 $ENCBODY->seek(0,2); ### fast-forward 1600 $content_length = $ENCBODY->tell; ### get encoded length 1601 $ENCBODY->seek(0,0); ### rewind 1602 1603 ### Remember: 1604 $self->head->replace('Content-length', $content_length); 1605 } 1606 } 1607 elsif ($o_length eq 'ERASE') { ### Erase the content-length... 1608 $head->delete('Content-length'); 1609 } 1610 1611 ### Done with everything for us! 1612 undef($ENCBODY); 1613 1614 ### Recurse: 1615 my $part; 1616 foreach $part ($self->parts) { $part->sync_headers($opts) or return undef } 1617 1; 1618} 1619 1620#------------------------------ 1621 1622=item tidy_body 1623 1624I<Instance method, override.> 1625Currently unimplemented for MIME messages. Does nothing, returns false. 1626 1627=cut 1628 1629sub tidy_body { 1630 usage "MIME::Entity::tidy_body currently does nothing"; 1631 0; 1632} 1633 1634=back 1635 1636=cut 1637 1638 1639 1640 1641 1642#============================== 1643 1644=head2 Output 1645 1646=over 4 1647 1648=cut 1649 1650#------------------------------ 1651 1652=item dump_skeleton [FILEHANDLE] 1653 1654I<Instance method.> 1655Dump the skeleton of the entity to the given FILEHANDLE, or 1656to the currently-selected one if none given. 1657 1658Each entity is output with an appropriate indentation level, 1659the following selection of attributes: 1660 1661 Content-type: multipart/mixed 1662 Effective-type: multipart/mixed 1663 Body-file: NONE 1664 Subject: Hey there! 1665 Num-parts: 2 1666 1667This is really just useful for debugging purposes; I make no guarantees 1668about the consistency of the output format over time. 1669 1670=cut 1671 1672sub dump_skeleton { 1673 my ($self, $fh, $indent) = @_; 1674 $fh or $fh = select; 1675 defined($indent) or $indent = 0; 1676 my $ind = ' ' x $indent; 1677 my $part; 1678 no strict 'refs'; 1679 1680 1681 ### The content type: 1682 print $fh $ind,"Content-type: ", ($self->mime_type||'UNKNOWN'),"\n"; 1683 print $fh $ind,"Effective-type: ", ($self->effective_type||'UNKNOWN'),"\n"; 1684 1685 ### The name of the file containing the body (if any!): 1686 my $path = ($self->bodyhandle ? $self->bodyhandle->path : undef); 1687 print $fh $ind, "Body-file: ", ($path || 'NONE'), "\n"; 1688 1689 ### The recommended file name (thanks to Allen Campbell): 1690 my $filename = $self->head->recommended_filename; 1691 print $fh $ind, "Recommended-filename: ", $filename, "\n" if ($filename); 1692 1693 ### The subject (note: already a newline if 2.x!) 1694 my $subj = $self->head->get('subject',0); 1695 defined($subj) or $subj = ''; 1696 chomp($subj); 1697 print $fh $ind, "Subject: $subj\n" if $subj; 1698 1699 ### The parts: 1700 my @parts = $self->parts; 1701 print $fh $ind, "Num-parts: ", int(@parts), "\n" if @parts; 1702 print $fh $ind, "--\n"; 1703 foreach $part (@parts) { 1704 $part->dump_skeleton($fh, $indent+1); 1705 } 1706} 1707 1708#------------------------------ 1709 1710=item print [OUTSTREAM] 1711 1712I<Instance method, override.> 1713Print the entity to the given OUTSTREAM, or to the currently-selected 1714filehandle if none given. OUTSTREAM can be a filehandle, or any object 1715that responds to a print() message. 1716 1717The entity is output as a valid MIME stream! This means that the 1718header is always output first, and the body data (if any) will be 1719encoded if the header says that it should be. 1720For example, your output may look like this: 1721 1722 Subject: Greetings 1723 Content-transfer-encoding: base64 1724 1725 SGkgdGhlcmUhCkJ5ZSB0aGVyZSEK 1726 1727I<If this entity has MIME type "multipart/*",> 1728the preamble, parts, and epilogue are all output with appropriate 1729boundaries separating each. 1730Any bodyhandle is ignored: 1731 1732 Content-type: multipart/mixed; boundary="*----*" 1733 Content-transfer-encoding: 7bit 1734 1735 [Preamble] 1736 --*----* 1737 [Entity: Part 0] 1738 --*----* 1739 [Entity: Part 1] 1740 --*----*-- 1741 [Epilogue] 1742 1743I<If this entity has a single-part MIME type with no attached parts,> 1744then we're looking at a normal singlepart entity: the body is output 1745according to the encoding specified by the header. 1746If no body exists, a warning is output and the body is treated as empty: 1747 1748 Content-type: image/gif 1749 Content-transfer-encoding: base64 1750 1751 [Encoded body] 1752 1753I<If this entity has a single-part MIME type but it also has parts,> 1754then we're probably looking at a "re-parsed" singlepart, usually one 1755of type C<message/*> (you can get entities like this if you set the 1756C<parse_nested_messages(NEST)> option on the parser to true). 1757In this case, the parts are output with single blank lines separating each, 1758and any bodyhandle is ignored: 1759 1760 Content-type: message/rfc822 1761 Content-transfer-encoding: 7bit 1762 1763 [Entity: Part 0] 1764 1765 [Entity: Part 1] 1766 1767In all cases, when outputting a "part" of the entity, this method 1768is invoked recursively. 1769 1770B<Note:> the output is very likely I<not> going to be identical 1771to any input you parsed to get this entity. If you're building 1772some sort of email handler, it's up to you to save this information. 1773 1774=cut 1775 1776use Symbol; 1777sub print { 1778 my ($self, $out) = @_; 1779 my $boundary_delimiter = $MIME::Entity::BOUNDARY_DELIMITER || "\n"; 1780 $out = select if @_ < 2; 1781 $out = Symbol::qualify($out,scalar(caller)) unless ref($out); 1782 1783 $self->print_header($out); ### the header 1784 $out->print($boundary_delimiter); 1785 $self->print_body($out); ### the "stuff after the header" 1786} 1787 1788#------------------------------ 1789 1790=item print_body [OUTSTREAM] 1791 1792I<Instance method, override.> 1793Print the body of the entity to the given OUTSTREAM, or to the 1794currently-selected filehandle if none given. OUTSTREAM can be a 1795filehandle, or any object that responds to a print() message. 1796 1797The body is output for inclusion in a valid MIME stream; this means 1798that the body data will be encoded if the header says that it should be. 1799 1800B<Note:> by "body", we mean "the stuff following the header". 1801A printed multipart body includes the printed representations of its subparts. 1802 1803B<Note:> The body is I<stored> in an un-encoded form; however, the idea is that 1804the transfer encoding is used to determine how it should be I<output.> 1805This means that the C<print()> method is always guaranteed to get you 1806a sendmail-ready stream whose body is consistent with its head. 1807If you want the I<raw body data> to be output, you can either read it from 1808the bodyhandle yourself, or use: 1809 1810 $ent->bodyhandle->print($outstream); 1811 1812which uses read() calls to extract the information, and thus will 1813work with both text and binary bodies. 1814 1815B<Warning:> Please supply an OUTSTREAM. This override method differs 1816from Mail::Internet's behavior, which outputs to the STDOUT if no 1817filehandle is given: this may lead to confusion. 1818 1819=cut 1820 1821sub print_body { 1822 my ($self, $out) = @_; 1823 $out ||= select; 1824 my ($type) = split '/', lc($self->mime_type); ### handle by MIME type 1825 my $boundary_delimiter = $MIME::Entity::BOUNDARY_DELIMITER || "\n"; 1826 1827 ### Multipart... 1828 if ($type eq 'multipart') { 1829 my $boundary = $self->head->multipart_boundary; 1830 1831 ### Preamble: 1832 my $plines = $self->preamble; 1833 if (defined $plines) { 1834 # Defined, so output the preamble if it exists (avoiding additional 1835 # newline as per ticket 60931) 1836 $out->print( join('', @$plines) . $boundary_delimiter) if (@$plines > 0); 1837 } else { 1838 # Undefined, so use default preamble 1839 $out->print( join('', @$DefPreamble) . $boundary_delimiter . $boundary_delimiter ); 1840 } 1841 1842 ### Parts: 1843 my $part; 1844 foreach $part ($self->parts) { 1845 $out->print("--$boundary$boundary_delimiter"); 1846 $part->print($out); 1847 $out->print($boundary_delimiter); ### needed for next delim/close 1848 } 1849 $out->print("--$boundary--$boundary_delimiter"); 1850 1851 ### Epilogue: 1852 my $epilogue = join('', @{ $self->epilogue || $DefEpilogue }); 1853 if ($epilogue ne '') { 1854 $out->print($epilogue); 1855 $out->print($boundary_delimiter) if ($epilogue !~ /\n\Z/); ### be nice 1856 } 1857 } 1858 1859 ### Singlepart type with parts... 1860 ### This makes $ent->print handle message/rfc822 bodies 1861 ### when parse_nested_messages('NEST') is on [idea by Marc Rouleau]. 1862 elsif ($self->parts) { 1863 my $need_sep = 0; 1864 my $part; 1865 foreach $part ($self->parts) { 1866 $out->print("$boundary_delimiter$boundary_delimiter") if $need_sep++; 1867 $part->print($out); 1868 } 1869 } 1870 1871 ### Singlepart type, or no parts: output body... 1872 else { 1873 $self->bodyhandle ? $self->print_bodyhandle($out) 1874 : whine "missing body; treated as empty"; 1875 } 1876 1; 1877} 1878 1879#------------------------------ 1880# 1881# print_bodyhandle 1882# 1883# Instance method, unpublicized. Print just the bodyhandle, *encoded*. 1884# 1885# WARNING: $self->print_bodyhandle() != $self->bodyhandle->print()! 1886# The former encodes, and the latter does not! 1887# 1888sub print_bodyhandle { 1889 my ($self, $out) = @_; 1890 $out ||= select; 1891 1892 my $IO = $self->open("r") || die "open body: $!"; 1893 if ( $self->bodyhandle->is_encoded ) { 1894 ### Transparent mode: data is already encoded, so no 1895 ### need to encode it again 1896 my $buf; 1897 $out->print($buf) while ($IO->read($buf, 8192)); 1898 } else { 1899 ### Get the encoding, defaulting to "binary" if unsupported: 1900 my $encoding = ($self->head->mime_encoding || 'binary'); 1901 my $decoder = best MIME::Decoder $encoding; 1902 $decoder->head($self->head); ### associate with head, if any 1903 $decoder->encode($IO, $out, textual_type($self->head->mime_type) ? 1 : 0) || return error "encoding failed"; 1904 } 1905 1906 $IO->close; 1907 1; 1908} 1909 1910#------------------------------ 1911 1912=item print_header [OUTSTREAM] 1913 1914I<Instance method, inherited.> 1915Output the header to the given OUTSTREAM. You really should supply 1916the OUTSTREAM. 1917 1918=cut 1919 1920### Inherited. 1921 1922#------------------------------ 1923 1924=item stringify 1925 1926I<Instance method.> 1927Return the entity as a string, exactly as C<print> would print it. 1928The body will be encoded as necessary, and will contain any subparts. 1929You can also use C<as_string()>. 1930 1931=cut 1932 1933sub stringify { 1934 my ($self) = @_; 1935 my $output = ''; 1936 my $fh = IO::File->new( \$output, '>:' ) or croak("Cannot open in-memory file: $!"); 1937 $self->print($fh); 1938 $fh->close; 1939 return $output; 1940} 1941 1942sub as_string { shift->stringify }; ### silent BC 1943 1944#------------------------------ 1945 1946=item stringify_body 1947 1948I<Instance method.> 1949Return the I<encoded> message body as a string, exactly as C<print_body> 1950would print it. You can also use C<body_as_string()>. 1951 1952If you want the I<unencoded> body, and you are dealing with a 1953singlepart message (like a "text/plain"), use C<bodyhandle()> instead: 1954 1955 if ($ent->bodyhandle) { 1956 $unencoded_data = $ent->bodyhandle->as_string; 1957 } 1958 else { 1959 ### this message has no body data (but it might have parts!) 1960 } 1961 1962=cut 1963 1964sub stringify_body { 1965 my ($self) = @_; 1966 my $output = ''; 1967 my $fh = IO::File->new( \$output, '>:' ) or croak("Cannot open in-memory file: $!"); 1968 $self->print_body($fh); 1969 $fh->close; 1970 return $output; 1971} 1972 1973sub body_as_string { shift->stringify_body } 1974 1975#------------------------------ 1976 1977=item stringify_header 1978 1979I<Instance method.> 1980Return the header as a string, exactly as C<print_header> would print it. 1981You can also use C<header_as_string()>. 1982 1983=cut 1984 1985sub stringify_header { 1986 shift->head->stringify; 1987} 1988sub header_as_string { shift->stringify_header } 1989 1990 19911; 1992__END__ 1993 1994#------------------------------ 1995 1996=back 1997 1998=head1 NOTES 1999 2000=head2 Under the hood 2001 2002A B<MIME::Entity> is composed of the following elements: 2003 2004=over 4 2005 2006=item * 2007 2008A I<head>, which is a reference to a MIME::Head object 2009containing the header information. 2010 2011=item * 2012 2013A I<bodyhandle>, which is a reference to a MIME::Body object 2014containing the decoded body data. This is only defined if 2015the message is a "singlepart" type: 2016 2017 application/* 2018 audio/* 2019 image/* 2020 text/* 2021 video/* 2022 2023=item * 2024 2025An array of I<parts>, where each part is a MIME::Entity object. 2026The number of parts will only be nonzero if the content-type 2027is I<not> one of the "singlepart" types: 2028 2029 message/* (should have exactly one part) 2030 multipart/* (should have one or more parts) 2031 2032 2033=back 2034 2035 2036 2037=head2 The "two-body problem" 2038 2039MIME::Entity and Mail::Internet see message bodies differently, 2040and this can cause confusion and some inconvenience. Sadly, I can't 2041change the behavior of MIME::Entity without breaking lots of code already 2042out there. But let's open up the floor for a few questions... 2043 2044=over 4 2045 2046=item What is the difference between a "message" and an "entity"? 2047 2048A B<message> is the actual data being sent or received; usually 2049this means a stream of newline-terminated lines. 2050An B<entity> is the representation of a message as an object. 2051 2052This means that you get a "message" when you print an "entity" 2053I<to> a filehandle, and you get an "entity" when you parse a message 2054I<from> a filehandle. 2055 2056 2057=item What is a message body? 2058 2059B<Mail::Internet:> 2060The portion of the printed message after the header. 2061 2062B<MIME::Entity:> 2063The portion of the printed message after the header. 2064 2065 2066=item How is a message body stored in an entity? 2067 2068B<Mail::Internet:> 2069As an array of lines. 2070 2071B<MIME::Entity:> 2072It depends on the content-type of the message. 2073For "container" types (C<multipart/*>, C<message/*>), we store the 2074contained entities as an array of "parts", accessed via the C<parts()> 2075method, where each part is a complete MIME::Entity. 2076For "singlepart" types (C<text/*>, C<image/*>, etc.), the unencoded 2077body data is referenced via a MIME::Body object, accessed via 2078the C<bodyhandle()> method: 2079 2080 bodyhandle() parts() 2081 Content-type: returns: returns: 2082 ------------------------------------------------------------ 2083 application/* MIME::Body empty 2084 audio/* MIME::Body empty 2085 image/* MIME::Body empty 2086 message/* undef MIME::Entity list (usually 1) 2087 multipart/* undef MIME::Entity list (usually >0) 2088 text/* MIME::Body empty 2089 video/* MIME::Body empty 2090 x-*/* MIME::Body empty 2091 2092As a special case, C<message/*> is currently ambiguous: depending 2093on the parser, a C<message/*> might be treated as a singlepart, 2094with a MIME::Body and no parts. Use bodyhandle() as the final 2095arbiter. 2096 2097 2098=item What does the body() method return? 2099 2100B<Mail::Internet:> 2101As an array of lines, ready for sending. 2102 2103B<MIME::Entity:> 2104As an array of lines, ready for sending. 2105 2106=item What's the best way to get at the body data? 2107 2108B<Mail::Internet:> 2109Use the body() method. 2110 2111B<MIME::Entity:> 2112Depends on what you want... the I<encoded> data (as it is 2113transported), or the I<unencoded> data? Keep reading... 2114 2115 2116=item How do I get the "encoded" body data? 2117 2118B<Mail::Internet:> 2119Use the body() method. 2120 2121B<MIME::Entity:> 2122Use the body() method. You can also use: 2123 2124 $entity->print_body() 2125 $entity->stringify_body() ### a.k.a. $entity->body_as_string() 2126 2127 2128=item How do I get the "unencoded" body data? 2129 2130B<Mail::Internet:> 2131Use the body() method. 2132 2133B<MIME::Entity:> 2134Use the I<bodyhandle()> method! 2135If bodyhandle() method returns true, then that value is a 2136L<MIME::Body|MIME::Body> which can be used to access the data via 2137its open() method. If bodyhandle() method returns an undefined value, 2138then the entity is probably a "container" that has no real body data of 2139its own (e.g., a "multipart" message): in this case, you should access 2140the components via the parts() method. Like this: 2141 2142 if ($bh = $entity->bodyhandle) { 2143 $io = $bh->open; 2144 ...access unencoded data via $io->getline or $io->read... 2145 $io->close; 2146 } 2147 else { 2148 foreach my $part (@parts) { 2149 ...do something with the part... 2150 } 2151 } 2152 2153You can also use: 2154 2155 if ($bh = $entity->bodyhandle) { 2156 $unencoded_data = $bh->as_string; 2157 } 2158 else { 2159 ...do stuff with the parts... 2160 } 2161 2162 2163=item What does the body() method return? 2164 2165B<Mail::Internet:> 2166The transport-encoded message body, as an array of lines. 2167 2168B<MIME::Entity:> 2169The transport-encoded message body, as an array of lines. 2170 2171 2172=item What does print_body() print? 2173 2174B<Mail::Internet:> 2175Exactly what body() would return to you. 2176 2177B<MIME::Entity:> 2178Exactly what body() would return to you. 2179 2180 2181=item Say I have an entity which might be either singlepart or multipart. 2182 How do I print out just "the stuff after the header"? 2183 2184B<Mail::Internet:> 2185Use print_body(). 2186 2187B<MIME::Entity:> 2188Use print_body(). 2189 2190 2191=item Why is MIME::Entity so different from Mail::Internet? 2192 2193Because MIME streams are expected to have non-textual data... 2194possibly, quite a lot of it, such as a tar file. 2195 2196Because MIME messages can consist of multiple parts, which are most-easily 2197manipulated as MIME::Entity objects themselves. 2198 2199Because in the simpler world of Mail::Internet, the data of a message 2200and its printed representation are I<identical>... and in the MIME 2201world, they're not. 2202 2203Because parsing multipart bodies on-the-fly, or formatting multipart 2204bodies for output, is a non-trivial task. 2205 2206 2207=item This is confusing. Can the two classes be made more compatible? 2208 2209Not easily; their implementations are necessarily quite different. 2210Mail::Internet is a simple, efficient way of dealing with a "black box" 2211mail message... one whose internal data you don't care much about. 2212MIME::Entity, in contrast, cares I<very much> about the message contents: 2213that's its job! 2214 2215=back 2216 2217 2218 2219=head2 Design issues 2220 2221=over 4 2222 2223=item Some things just can't be ignored 2224 2225In multipart messages, the I<"preamble"> is the portion that precedes 2226the first encapsulation boundary, and the I<"epilogue"> is the portion 2227that follows the last encapsulation boundary. 2228 2229According to RFC 2046: 2230 2231 There appears to be room for additional information prior 2232 to the first encapsulation boundary and following the final 2233 boundary. These areas should generally be left blank, and 2234 implementations must ignore anything that appears before the 2235 first boundary or after the last one. 2236 2237 NOTE: These "preamble" and "epilogue" areas are generally 2238 not used because of the lack of proper typing of these parts 2239 and the lack of clear semantics for handling these areas at 2240 gateways, particularly X.400 gateways. However, rather than 2241 leaving the preamble area blank, many MIME implementations 2242 have found this to be a convenient place to insert an 2243 explanatory note for recipients who read the message with 2244 pre-MIME software, since such notes will be ignored by 2245 MIME-compliant software. 2246 2247In the world of standards-and-practices, that's the standard. 2248Now for the practice: 2249 2250I<Some "MIME" mailers may incorrectly put a "part" in the preamble>. 2251Since we have to parse over the stuff I<anyway>, in the future I 2252I<may> allow the parser option of creating special MIME::Entity objects 2253for the preamble and epilogue, with bogus MIME::Head objects. 2254 2255For now, though, we're MIME-compliant, so I probably won't change 2256how we work. 2257 2258=back 2259 2260=head1 SEE ALSO 2261 2262L<MIME::Tools>, L<MIME::Head>, L<MIME::Body>, L<MIME::Decoder>, L<Mail::Internet> 2263 2264=head1 AUTHOR 2265 2266Eryq (F<eryq@zeegee.com>), ZeeGee Software Inc (F<http://www.zeegee.com>). 2267Dianne Skoll (dfs@roaringpenguin.com) http://www.roaringpenguin.com 2268 2269All rights reserved. This program is free software; you can redistribute 2270it and/or modify it under the same terms as Perl itself. 2271 2272=cut 2273