1# Convert::TNEF.pm 2# 3# Copyright (c) 1999 Douglas Wilson <dougw@cpan.org>. All rights reserved. 4# This program is free software; you can redistribute it and/or 5# modify it under the same terms as Perl itself. 6 7package Convert::TNEF; 8 9use strict; 10use integer; 11use vars qw( 12 $VERSION 13 $TNEF_SIGNATURE 14 $TNEF_PURE 15 $LVL_MESSAGE 16 $LVL_ATTACHMENT 17 $errstr 18 $g_file_cnt 19 %dflts 20 %atp 21 %att 22 %att_name 23); 24 25use Carp; 26use IO::Wrap; 27use File::Spec; 28use MIME::Body; 29 30$VERSION = '0.18'; 31 32# Set some TNEF constants. Everything turned 33# out to be in little endian order, so I just added 34# 'reverse' everywhere that I needed to 35# instead of reversing the hex codes. 36$TNEF_SIGNATURE = reverse pack( 'H*', '223E9F78' ); 37$TNEF_PURE = reverse pack( 'H*', '00010000' ); 38 39$LVL_MESSAGE = pack( 'H*', '01' ); 40$LVL_ATTACHMENT = pack( 'H*', '02' ); 41 42%atp = ( 43 Triples => pack( 'H*', '0000' ), 44 String => pack( 'H*', '0001' ), 45 Text => pack( 'H*', '0002' ), 46 Date => pack( 'H*', '0003' ), 47 Short => pack( 'H*', '0004' ), 48 Long => pack( 'H*', '0005' ), 49 Byte => pack( 'H*', '0006' ), 50 Word => pack( 'H*', '0007' ), 51 Dword => pack( 'H*', '0008' ), 52 Max => pack( 'H*', '0009' ), 53); 54 55for ( keys %atp ) { 56 $atp{$_} = reverse $atp{$_}; 57} 58 59sub _ATT { 60 my ( $att, $id ) = @_; 61 return reverse($id) . $att; 62} 63 64# The side comments are 'MAPI' equivalents 65%att = ( 66 Null => _ATT( pack( 'H*', '0000' ), pack( 'H4', '0000' ) ), 67 # PR_ORIGINATOR_RETURN_ADDRESS 68 From => _ATT( $atp{Triples}, pack( 'H*', '8000' ) ), 69 # PR_SUBJECT 70 Subject => _ATT( $atp{String}, pack( 'H*', '8004' ) ), 71 # PR_CLIENT_SUBMIT_TIME 72 DateSent => _ATT( $atp{Date}, pack( 'H*', '8005' ) ), 73 # PR_MESSAGE_DELIVERY_TIME 74 DateRecd => _ATT( $atp{Date}, pack( 'H*', '8006' ) ), 75 # PR_MESSAGE_FLAGS 76 MessageStatus => _ATT( $atp{Byte}, pack( 'H*', '8007' ) ), 77 # PR_MESSAGE_CLASS 78 MessageClass => _ATT( $atp{Word}, pack( 'H*', '8008' ) ), 79 # PR_MESSAGE_ID 80 MessageID => _ATT( $atp{String}, pack( 'H*', '8009' ) ), 81 # PR_PARENT_ID 82 ParentID => _ATT( $atp{String}, pack( 'H*', '800A' ) ), 83 # PR_CONVERSATION_ID 84 ConversationID => _ATT( $atp{String}, pack( 'H*', '800B' ) ), 85 Body => _ATT( $atp{Text}, pack( 'H*', '800C' ) ), # PR_BODY 86 # PR_IMPORTANCE 87 Priority => _ATT( $atp{Short}, pack( 'H*', '800D' ) ), 88 # PR_ATTACH_DATA_xxx 89 AttachData => _ATT( $atp{Byte}, pack( 'H*', '800F' ) ), 90 # PR_ATTACH_FILENAME 91 AttachTitle => _ATT( $atp{String}, pack( 'H*', '8010' ) ), 92 # PR_ATTACH_RENDERING 93 AttachMetaFile => _ATT( $atp{Byte}, pack( 'H*', '8011' ) ), 94 # PR_CREATION_TIME 95 AttachCreateDate => _ATT( $atp{Date}, pack( 'H*', '8012' ) ), 96 # PR_LAST_MODIFICATION_TIME 97 AttachModifyDate => _ATT( $atp{Date}, pack( 'H*', '8013' ) ), 98 # PR_LAST_MODIFICATION_TIME 99 DateModified => _ATT( $atp{Date}, pack( 'H*', '8020' ) ), 100 #PR_ATTACH_TRANSPORT_NAME 101 AttachTransportFilename => _ATT( $atp{Byte}, pack( 'H*', '9001' ) ), 102 AttachRenddata => _ATT( $atp{Byte}, pack( 'H*', '9002' ) ), 103 MAPIProps => _ATT( $atp{Byte}, pack( 'H*', '9003' ) ), 104 # PR_MESSAGE_RECIPIENTS 105 RecipTable => _ATT( $atp{Byte}, pack( 'H*', '9004' ) ), 106 Attachment => _ATT( $atp{Byte}, pack( 'H*', '9005' ) ), 107 TnefVersion => _ATT( $atp{Dword}, pack( 'H*', '9006' ) ), 108 OemCodepage => _ATT( $atp{Byte}, pack( 'H*', '9007' ) ), 109 # PR_ORIG_MESSAGE_CLASS 110 OriginalMessageClass => _ATT( $atp{Word}, pack( 'H*', '0006' ) ), 111 112 # PR_RCVD_REPRESENTING_xxx or PR_SENT_REPRESENTING_xxx 113 Owner => _ATT( $atp{Byte}, pack( 'H*', '0000' ) ), 114 # PR_SENT_REPRESENTING_xxx 115 SentFor => _ATT( $atp{Byte}, pack( 'H*', '0001' ) ), 116 # PR_RCVD_REPRESENTING_xxx 117 Delegate => _ATT( $atp{Byte}, pack( 'H*', '0002' ) ), 118 # PR_DATE_START 119 DateStart => _ATT( $atp{Date}, pack( 'H*', '0006' ) ), 120 DateEnd => _ATT( $atp{Date}, pack( 'H*', '0007' ) ), # PR_DATE_END 121 # PR_OWNER_APPT_ID 122 AidOwner => _ATT( $atp{Long}, pack( 'H*', '0008' ) ), 123 # PR_RESPONSE_REQUESTED 124 RequestRes => _ATT( $atp{Short}, pack( 'H*', '0009' ) ), 125); 126 127# Create reverse lookup table 128%att_name = reverse %att; 129 130# Global counter for creating file names 131$g_file_cnt = 0; 132 133# Set some package global defaults for new objects 134# which can be overridden for any individual object. 135%dflts = ( 136 debug => 0, 137 debug_max_display => 1024, 138 debug_max_line_size => 64, 139 ignore_checksum => 0, 140 display_after_err => 32, 141 output_to_core => 4096, 142 output_dir => File::Spec->curdir, 143 output_prefix => "tnef", 144 buffer_size => 1024, 145); 146 147# Make a file name 148sub _mk_fname { 149 my $parms = shift; 150 File::Spec->catfile( $parms->{output_dir}, 151 $parms->{output_prefix} . "-" . $$ . "-" 152 . ++$g_file_cnt . ".doc" ); 153} 154 155sub _rtn_err { 156 my ( $errmsg, $fh, $parms ) = @_; 157 $errstr = $errmsg; 158 if ( $parms->{debug} ) { 159 my $read_size = $parms->{display_after_err} || 32; 160 my $data; 161 $fh->read( $data, $read_size ); 162 print "Error: $errstr\n"; 163 print "Data:\n"; 164 print $1, "\n" while $data =~ 165 /([^\r\n]{0,$parms->{debug_max_line_size}})\r?\n?/g; 166 print "HData:\n"; 167 my $hdata = unpack( "H*", $data ); 168 print $1, "\n" 169 while $hdata =~ /(.{0,$parms->{debug_max_line_size}})/g; 170 } 171 return undef; 172} 173 174sub _read_err { 175 my ( $bytes, $fh, $errmsg ) = @_; 176 $errstr = 177 ( defined $bytes ) ? "Premature EOF" : "Read Error:" . $errmsg; 178 return undef; 179} 180 181sub read_ent { 182 croak "Usage: Convert::TNEF->read_ent(entity, parameters) " 183 unless @_ == 2 or @_ == 3; 184 my $self = shift; 185 my ( $ent, $parms ) = @_; 186 my $io = $ent->open("r") or do { 187 $errstr = "Can't open entity: $!"; 188 return undef; 189 }; 190 my $tnef = $self->read( $io, $parms ); 191 $io->close or do { 192 $errstr = "Error closing handle: $!"; 193 return undef; 194 }; 195 return $tnef; 196} 197 198sub read_in { 199 croak "Usage: Convert::TNEF->read_in(filename, parameters) " 200 unless @_ == 2 or @_ == 3; 201 my $self = shift; 202 my ( $fname, $parms ) = @_; 203 open( INFILE, "<$fname" ) or do { 204 $errstr = "Can't open $fname: $!"; 205 return undef; 206 }; 207 binmode INFILE; 208 my $tnef = $self->read( \*INFILE, $parms ); 209 close INFILE or do { 210 $errstr = "Error closing $fname: $!"; 211 return undef; 212 }; 213 return $tnef; 214} 215 216sub read { 217 croak "Usage: Convert::TNEF->read(fh, parameters) " 218 unless @_ == 2 or @_ == 3; 219 my $self = shift; 220 my $class = ref($self) || $self; 221 $self = {}; 222 bless $self, $class; 223 my ( $fd, $parms ) = @_; 224 $fd = wraphandle($fd); 225 226 my %parms = %dflts; 227 @parms{ keys %$parms } = values %$parms if defined $parms; 228 $parms = \%parms; 229 my $debug = $parms{debug}; 230 my $ignore_checksum = $parms{ignore_checksum}; 231 232 # Start of TNEF stream 233 my $data; 234 my $num_bytes = $fd->read( $data, 4 ); 235 return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 4; 236 print "TNEF start: ", unpack( "H*", $data ), "\n" if $debug; 237 return _rtn_err( "Not TNEF-encapsulated", $fd, $parms ) 238 unless $data eq $TNEF_SIGNATURE; 239 240 # Key 241 $num_bytes = $fd->read( $data, 2 ); 242 return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 2; 243 print "TNEF key: ", unpack( "H*", $data ), "\n" if $debug; 244 245 # Start of First Object 246 $num_bytes = $fd->read( $data, 1 ); 247 return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 1; 248 249 my $msg_att = ""; 250 251 my $is_msg = ( $data eq $LVL_MESSAGE ); 252 my $is_att = ( $data eq $LVL_ATTACHMENT ); 253 print "TNEF object start: ", unpack( "H*", $data ), "\n" if $debug; 254 return _rtn_err( "Neither a message nor an attachment", $fd, 255 $parms ) 256 unless $is_msg or $is_att; 257 258 my $msg = Convert::TNEF::Data->new; 259 my @atts; 260 261 # Current message or attachment in loop 262 my $ent = $msg; 263 264 # Read message and attachments 265 LOOP: { 266 my $type = $is_msg ? 'message' : 'attachment'; 267 print "Reading $type attribute\n" if $debug; 268 $num_bytes = $fd->read( $data, 4 ); 269 return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 4; 270 my $att_id = $data; 271 my $att_name = $att_name{$att_id}; 272 273 print "TNEF $type attribute: ", unpack( "H*", $data ), "\n" 274 if $debug; 275 return _rtn_err( "Bad Attribute found in $type", $fd, $parms ) 276 unless $att_name{$att_id}; 277 if ( $att_id eq $att{TnefVersion} ) { 278 return _rtn_err( "Version attribute found in attachment", $fd, 279 $parms ) 280 if $is_att; 281 } elsif ( $att_id eq $att{MessageClass} ) { 282 return _rtn_err( "MessageClass attribute found in attachment", 283 $fd, $parms ) 284 if $is_att; 285 } elsif ( $att_id eq $att{AttachRenddata} ) { 286 return _rtn_err( "AttachRenddata attribute found in message", 287 $fd, $parms ) 288 if $is_msg; 289 push @atts, ( $ent = Convert::TNEF::Data->new ); 290 } else { 291 return _rtn_err( "AttachRenddata must be first attribute", $fd, 292 $parms ) 293 if $is_att 294 and !@atts 295 and $att_name ne "AttachRenddata"; 296 } 297 print "Got attribute:$att_name{$att_id}\n" if $debug; 298 299 $num_bytes = $fd->read( $data, 4 ); 300 return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 4; 301 302 print "HLength:", unpack( "H8", $data ), "\n" if $debug; 303 my $length = unpack( "V", $data ); 304 print "Length: $length\n" if $debug; 305 306 # Get the attribute data (returns an object since data may 307 # actually end up in a file) 308 my $calc_chksum; 309 $data = _build_data( $fd, $length, \$calc_chksum, $parms ) 310 or return undef; 311 _debug_print( $length, $att_id, $data, $parms ) if $debug; 312 $ent->datahandle( $att_name, $data, $length ); 313 314 $num_bytes = $fd->read( $data, 2 ); 315 return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 2; 316 my $file_chksum = $data; 317 if ($debug) { 318 print "Calc Chksum:", unpack( "H*", $calc_chksum ), "\n"; 319 print "File Chksum:", unpack( "H*", $file_chksum ), "\n"; 320 } 321 return _rtn_err( "Bad Checksum", $fd, $parms ) 322 unless $calc_chksum eq $file_chksum 323 or $ignore_checksum; 324 325 my $num_bytes = $fd->read( $data, 1 ); 326 327 # EOF (0 bytes) is ok 328 return _read_err( $num_bytes, $fd, $! ) unless defined $num_bytes; 329 last LOOP if $num_bytes < 1; 330 print "Next token:", unpack( "H2", $data ), "\n" if $debug; 331 $is_msg = ( $data eq $LVL_MESSAGE ); 332 return _rtn_err( "Found message data in attachment", $fd, $parms ) 333 if $is_msg and $is_att; 334 $is_att = ( $data eq $LVL_ATTACHMENT ); 335 redo LOOP if $is_msg or $is_att; 336 return _rtn_err( "Not a TNEF $type", $fd, $parms ); 337 } 338 339 print "EOF\n" if $debug; 340 341 $self->{TN_Message} = $msg; 342 $self->{TN_Attachments} = \@atts; 343 return $self; 344} 345 346sub _debug_print { 347 my ( $length, $att_id, $data, $parms ) = @_; 348 if ( $length < $parms->{debug_max_display} ) { 349 $data = $data->data; 350 if ( $att_id eq $att{TnefVersion} ) { 351 $data = unpack( "L", $data ); 352 print "Version: $data\n"; 353 } elsif ( substr( $att_id, 2 ) eq $atp{Date} and $length == 14 ) { 354 my ( $yr, $mo, $day, $hr, $min, $sec, $dow ) = 355 unpack( "vvvvvvv", $data ); 356 my $date = join ":", $yr, $mo, $day, $hr, $min, $sec, $dow; 357 print "Date: $date\n"; 358 print "HDate:", unpack( "H*", $data ), "\n"; 359 } elsif ( $att_id eq $att{AttachRenddata} and $length == 14 ) { 360 my ( $atyp, $ulPosition, $dxWidth, $dyHeight, $dwFlags ) = 361 unpack( "vVvvV", $data ); 362 $data = join ":", $atyp, $ulPosition, $dxWidth, $dyHeight, 363 $dwFlags; 364 print "AttachRendData: $data\n"; 365 } else { 366 print "Data:\n"; 367 print $1, "\n" while $data =~ 368 /([^\r\n]{0,$parms->{debug_max_line_size}})\r?\n?/g; 369 print "HData:\n"; 370 my $hdata = unpack( "H*", $data ); 371 print $1, "\n" 372 while $hdata =~ /(.{0,$parms->{debug_max_line_size}})/g; 373 } 374 } else { 375 my $io = $data->open("r") 376 or croak "Error opening attachment data handle: $!"; 377 my $buffer; 378 $io->read( $buffer, $parms->{debug_max_display} ); 379 $io->close or croak "Error closing attachment data handle: $!"; 380 print "Data:\n"; 381 print $1, "\n" while $buffer =~ 382 /([^\r\n]{0,$parms->{debug_max_line_size}})\r?\n?/sg; 383 print "HData:\n"; 384 my $hdata = unpack( "H*", $buffer ); 385 print $1, "\n" 386 while $hdata =~ /(.{0,$parms->{debug_max_line_size}})/g; 387 } 388} 389 390sub _build_data { 391 my ( $fd, $length, $chksumref, $parms ) = @_; 392 my $cutoff = $parms->{output_to_core}; 393 my $incore = do { 394 if ( $cutoff eq 'NONE' ) { 0 } #Everything to files 395 elsif ( $cutoff eq 'ALL' ) { 1 } #Everything in memory 396 elsif ( $cutoff < $length ) { 0 } #Large items in files 397 else { 1 } #Everything else in memory 398 }; 399 400 # Just borrow some other objects for the attachment attribute data 401 my $body = 402 ($incore) 403 ? new MIME::Body::Scalar 404 : new MIME::Body::File _mk_fname($parms); 405 $body->binmode(1); 406 my $io = $body->open("w"); 407 my $bufsiz = $parms->{buffer_size}; 408 $bufsiz = $length if $length < $bufsiz; 409 my $buffer; 410 my $chksum = 0; 411 412 while ( $length > 0 ) { 413 my $num_bytes = $fd->read( $buffer, $bufsiz ); 414 return _read_err( $num_bytes, $fd, $! ) 415 unless $num_bytes == $bufsiz; 416 $io->print($buffer); 417 $chksum += unpack( "%16C*", $buffer ); 418 $chksum %= 65536; 419 $length -= $bufsiz; 420 $bufsiz = $length if $length < $bufsiz; 421 } 422 $$chksumref = pack( "v", $chksum ); 423 $io->close; 424 return $body; 425} 426 427sub purge { 428 my $self = shift; 429 my $msg = $self->{TN_Message}; 430 my @atts = $self->attachments; 431 for ( keys %$msg ) { 432 $msg->{$_}->purge if exists $att{$_}; 433 } 434 for my $attch (@atts) { 435 for ( keys %$attch ) { 436 $attch->{$_}->purge if exists $att{$_}; 437 } 438 } 439} 440 441sub message { 442 my $self = shift; 443 $self->{TN_Message}; 444} 445 446sub attachments { 447 my $self = shift; 448 return @{ $self->{TN_Attachments} } if wantarray; 449 $self->{TN_Attachments}; 450} 451 452# This is for Messages or Attachments 453# since they are essentially the same thing except 454# for the leading attribute code 455package Convert::TNEF::Data; 456 457sub new { 458 my $proto = shift; 459 my $class = ref($proto) || $proto; 460 my $self = {}; 461 $self->{TN_Size} = {}; 462 bless $self, $class; 463} 464 465sub data { 466 my $self = shift; 467 my $attr = shift || 'AttachData'; 468 return $self->{$attr} && $self->{$attr}->as_string; 469} 470 471sub name { 472 my $self = shift; 473 my $attr = shift || 'AttachTitle'; 474 my $name = $self->{$attr} && $self->{$attr}->data; 475 $name =~ s/\x00+$// if $name; 476 return $name; 477} 478 479# Try to get the long filename out of the 480# 'Attachment' attribute. 481sub longname { 482 my $self = shift; 483 484 my $data = $self->data("Attachment"); 485 return unless $data; 486 my $pos = index( $data, pack( "H*", "1e00013001" ) ); 487 $pos = index( $data, pack( "H*", "1e00073701" ) ) if ($pos < 0); 488 return $self->name unless $pos >= 0; 489 my $len = unpack( "V", substr( $data, $pos + 8, 4 ) ); 490 my $longname = substr( $data, $pos + 12, $len ); 491 $longname =~ s/\x00+$// if $longname; 492 return $longname || $self->name; 493} 494 495sub datahandle { 496 my $self = shift; 497 my $attr = shift || 'AttachData'; 498 $self->{$attr} = shift if @_; 499 $self->size( $attr, shift ) if @_; 500 return $self->{$attr}; 501} 502 503sub size { 504 my $self = shift; 505 my $attr = shift || 'AttachData'; 506 $self->{TN_Size}->{$attr} = shift if @_; 507 return $self->{TN_Size}->{$attr}; 508} 509 510# Autoload methods go after =cut, and are processed by the autosplit program. 511 5121; 513__END__ 514 515 516=head1 NAME 517 518 Convert::TNEF - Perl module to read TNEF files 519 520=head1 SYNOPSIS 521 522 use Convert::TNEF; 523 524 $tnef = Convert::TNEF->read($iohandle, \%parms) 525 or die Convert::TNEF::errstr; 526 527 $tnef = Convert::TNEF->read_in($filename, \%parms) 528 or die Convert::TNEF::errstr; 529 530 $tnef = Convert::TNEF->read_ent($mime_entity, \%parms) 531 or die Convert::TNEF::errstr; 532 533 $tnef->purge; 534 535 $message = $tnef->message; 536 537 @attachments = $tnef->attachments; 538 539 $attribute_value = $attachments[$i]->data($att_attribute_name); 540 $attribute_value_size = $attachments[$i]->size($att_attribute_name); 541 $attachment_name = $attachments[$i]->name; 542 $long_attachment_name = $attachments[$i]->longname; 543 544 $datahandle = $attachments[$i]->datahandle($att_attribute_name); 545 546=head1 DESCRIPTION 547 548 TNEF stands for Transport Neutral Encapsulation Format, and if you've 549 ever been unfortunate enough to receive one of these files as an email 550 attachment, you may want to use this module. 551 552 read() takes as its first argument any file handle open 553 for reading. The optional second argument is a hash reference 554 which contains one or more of the following keys: 555 556=head2 557 558 output_dir - Path for storing TNEF attribute data kept in files 559 (default: current directory). 560 561 output_prefix - File prefix for TNEF attribute data kept in files 562 (default: 'tnef'). 563 564 output_to_core - TNEF attribute data will be saved in core memory unless 565 it is greater than this many bytes (default: 4096). May also be set to 566 'NONE' to keep all data in files, or 'ALL' to keep all data in core. 567 568 buffer_size - Buffer size for reading in the TNEF file (default: 1024). 569 570 debug - If true, outputs all sorts of info about what the read() function 571 is reading, including the raw ascii data along with the data converted 572 to hex (default: false). 573 574 display_after_err - If debug is true and an error is encountered, 575 reads and displays this many bytes of data following the error 576 (default: 32). 577 578 debug_max_display - If debug is true then read and display at most 579 this many bytes of data for each TNEF attribute (default: 1024). 580 581 debug_max_line_size - If debug is true then at most this many bytes of 582 data will be displayed on each line for each TNEF attribute 583 (default: 64). 584 585 ignore_checksum - If true, will ignore checksum errors while parsing 586 data (default: false). 587 588 read() returns an object containing the TNEF 'attributes' read from the 589 file and the data for those attributes. If all you want are the 590 attachments, then this is mostly garbage, but if you're interested then 591 you can see all the garbage by turning on debugging. If the garbage 592 proves useful to you, then let me know how I can maybe make it more 593 useful. 594 595 If an error is encountered, an undefined value is returned and the 596 package variable $errstr is set to some helpful message. 597 598 read_in() is a convienient front end for read() which takes a filename 599 instead of a handle. 600 601 read_ent() is another convient front end for read() which can take a 602 MIME::Entity object (or any object with like methods, specifically 603 open("r"), read($buff,$num_bytes), and close ). 604 605 purge() deletes any on-disk data that may be in the attachments of 606 the TNEF object. 607 608 message() returns the message portion of the tnef object, if any. 609 The thing it returns is like an attachment, but its not an attachment. 610 For instance, it more than likely does not have a name or any 611 attachment data. 612 613 attachments() returns a list of the attachments that the given TNEF 614 object contains. Returns a list ref if not called in array context. 615 616 data() takes a TNEF attribute name, and returns a string value for that 617 attribute for that attachment. Its your own problem if the string is too 618 big for memory. If no argument is given, then the 'AttachData' attribute 619 is assumed, which is probably the attachment data you're looking for. 620 621 name() is the same as data(), except the attribute 'AttachTitle' is 622 the default, which returns the 8 character + 3 character extension name 623 of the attachment. 624 625 longname() returns the long filename and extension of an attachment. This 626 is embedded within a MAPI property of the 'Attachment' attribute data, so 627 we attempt to extract the name out of that. 628 629 size() takes an TNEF attribute name, and returns the size in bytes for 630 the data for that attachment attribute. 631 632 datahandle() is a method for attachments which takes a TNEF attribute 633 name, and returns the data for that attribute as a handle which is 634 the same as a MIME::Body handle. See MIME::Body for all the applicable 635 methods. If no argument is given, then 'AttachData' is assumed. 636 637 638=head1 EXAMPLES 639 640 # Here's a rather long example where mail is retrieved 641 # from a POP3 server based on header information, then 642 # it is MIME parsed, and then the TNEF contents 643 # are extracted and converted. 644 645 use strict; 646 use Net::POP3; 647 use MIME::Parser; 648 use Convert::TNEF; 649 650 my $mail_dir = "mailout"; 651 my $mail_prefix = "mail"; 652 653 my $pop = new Net::POP3 ( "pop3server_name" ); 654 my $num_msgs = $pop->login("user_name","password"); 655 die "Can't login: $!" unless defined $num_msgs; 656 657 # Get mail by sender and subject 658 my $mail_out_idx = 0; 659 MESSAGE: for ( my $i=1; $i<= $num_msgs; $i++ ) { 660 my $header = join "", @{$pop->top($i)}; 661 662 for ($header) { 663 next MESSAGE unless 664 /^from:.*someone\@somewhere.net/im && 665 /^subject:\s*important stuff/im 666 } 667 668 my $fname = $mail_prefix."-".$$.++$mail_out_idx.".doc"; 669 open (MAILOUT, ">$mail_dir/$fname") 670 or die "Can't open $mail_dir/$fname: $!"; 671 # If the get() complains, you need the new libnet bundle 672 $pop->get($i, \*MAILOUT) or die "Can't read mail"; 673 close MAILOUT or die "Error closing $mail_dir/$fname"; 674 # If you want to delete the mail on the server 675 # $pop->delete($i); 676 } 677 678 close MAILOUT; 679 $pop->quit(); 680 681 # Parse the mail message into separate mime entities 682 my $parser=new MIME::Parser; 683 $parser->output_dir("mimemail"); 684 685 opendir(DIR, $mail_dir) or die "Can't open directory $mail_dir: $!"; 686 my @files = map { $mail_dir."/".$_ } sort 687 grep { -f "$mail_dir/$_" and /$mail_prefix-$$-/o } readdir DIR; 688 closedir DIR; 689 690 for my $file ( @files ) { 691 my $entity=$parser->parse_in($file) or die "Couldn't parse mail"; 692 print_tnef_parts($entity); 693 # If you want to delete the working files 694 # $entity->purge; 695 } 696 697 sub print_tnef_parts { 698 my $ent = shift; 699 700 if ( $ent->parts ) { 701 for my $sub_ent ( $ent->parts ) { 702 print_tnef_parts($sub_ent); 703 } 704 } elsif ( $ent->mime_type =~ /ms-tnef/i ) { 705 706 # Create a tnef object 707 my $tnef = Convert::TNEF->read_ent($ent,{output_dir=>"tnefmail"}) 708 or die $Convert::TNEF::errstr; 709 for ($tnef->attachments) { 710 print "Title:",$_->name,"\n"; 711 print "Data:\n",$_->data,"\n"; 712 } 713 714 # If you want to delete the working files 715 # $tnef->purge; 716 } 717 } 718 719=head1 SEE ALSO 720 721perl(1), IO::Wrap(3), MIME::Parser(3), MIME::Entity(3), MIME::Body(3) 722 723=head1 CAVEATS 724 725 The parsing may depend on the endianness (see perlport) and width of 726 integers on the system where the TNEF file was created. If this proves 727 to be the case (check the debug output), I'll see what I can do 728 about it. 729 730=head1 AUTHOR 731 732 Douglas Wilson, dougw@cpan.org 733 734=cut 735 736