673 lines
22 KiB
Perl
673 lines
22 KiB
Perl
# ====================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Mail::Message
|
|
# Author: Scott Beck
|
|
# CVS Info : 087,068,085,094,083
|
|
# $Id: Message.pm,v 1.14 2004/01/13 01:35:17 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ====================================================================
|
|
#
|
|
|
|
package GT::Mail::Message;
|
|
|
|
use strict;
|
|
use vars qw/$ATTRIBS $CRLF/;
|
|
use bases 'GT::Base' => '';
|
|
|
|
$ATTRIBS = {
|
|
root_part => undef,
|
|
debug => 0
|
|
};
|
|
|
|
$CRLF = "\012";
|
|
|
|
|
|
sub init {
|
|
# --------------------------------------------------------------------------
|
|
# Init called from GT::Base
|
|
my $self = shift;
|
|
|
|
$self->set( @_ );
|
|
|
|
if ( !defined( $self->{root_part} ) ) {
|
|
$self->{root_part} = new GT::Mail::Parts;
|
|
}
|
|
$self->{parts} = _get_parts( $self->{root_part} );
|
|
}
|
|
|
|
|
|
sub delete_part {
|
|
# --------------------------------------------------------------------------
|
|
# Deletes the given part from the email
|
|
#
|
|
my ( $self, $part ) = @_;
|
|
|
|
die "Can't delete top level part" if $part == $self->{root_part};
|
|
$self->_link;
|
|
|
|
|
|
# We must remove it from the flat list of parts
|
|
$self->_delete_part( $part );
|
|
|
|
# Now we must relink our list
|
|
$self->_link;
|
|
|
|
return $part;
|
|
}
|
|
|
|
sub move_part_before {
|
|
# --------------------------------------------------------------------------
|
|
# Move a part before another part. The first argument is the part to move
|
|
# before, the second is the part to move. No moving the top level part.
|
|
#
|
|
my ( $self, $before_part, $part ) = @_;
|
|
die "Can't move part before the top part" if $before_part == $self->{root_part};
|
|
die "Can't move top part" if $part == $self->{root_part};
|
|
if ( !$self->_part_in_message( $before_part ) or !$self->_part_in_message( $part ) ) {
|
|
die "All parts specified must be in the MIME message";
|
|
}
|
|
|
|
# First remove the part
|
|
$self->_delete_part( $part );
|
|
|
|
# Now we add
|
|
$self->add_part_before( $before_part, $part );
|
|
}
|
|
|
|
sub move_part_after {
|
|
# --------------------------------------------------------------------------
|
|
# Move a part after another part. The first argument is the part to move
|
|
# after, the second is the part to move. No moving the top level part.
|
|
#
|
|
my ( $self, $after_part, $part ) = @_;
|
|
die "Can't move part after the top part" if $after_part == $self->{root_part};
|
|
die "Can't move top part" if $part == $self->{root_part};
|
|
if ( !$self->_part_in_message( $after_part ) or !$self->_part_in_message( $part ) ) {
|
|
die "All parts specified must be in the MIME message";
|
|
}
|
|
|
|
# First remove the part
|
|
$self->_delete_part( $part );
|
|
|
|
# Now we add
|
|
$self->add_part_after( $after_part, $part );
|
|
}
|
|
|
|
sub move_part_end {
|
|
# --------------------------------------------------------------------------
|
|
# Move a part to the end of a multipart part. The first part is the
|
|
# multipart part to move it to the end of. The second argument is the part
|
|
# to move. No moving the top level part.
|
|
#
|
|
my ( $self, $parent_part, $part ) = @_;
|
|
die "Can't move top part" if $part == $self->{root_part};
|
|
if ( !$self->_part_in_message( $parent_part ) or !$self->_part_in_message( $part ) ) {
|
|
die "All parts specified must be in the MIME message";
|
|
}
|
|
|
|
# First remove the part to be moved
|
|
$self->_delete_part( $part );
|
|
|
|
# Then we add it back in
|
|
$self->add_part_end( $parent_part, $part );
|
|
}
|
|
|
|
sub move_part_beginning {
|
|
# --------------------------------------------------------------------------
|
|
# Move a part to the beginning of a multipart part. The first part is the
|
|
# multipart part to move it to the beginning of. The second argument is the
|
|
# part to move. No moving the top level part.
|
|
#
|
|
my ( $self, $parent_part, $part ) = @_;
|
|
die "Can't move top part" if $part == $self->{root_part};
|
|
if ( !$self->_part_in_message( $parent_part ) or !$self->_part_in_message( $part ) ) {
|
|
die "All parts specified must be in the MIME message";
|
|
}
|
|
|
|
# First remove the part to be moved
|
|
$self->_delete_part( $part );
|
|
|
|
# Then we add it back in
|
|
$self->add_part_beginning( $parent_part, $part );
|
|
}
|
|
|
|
sub replace_part {
|
|
# --------------------------------------------------------------------------
|
|
# Replace a part with another part
|
|
#
|
|
my ( $self, $old_part, $new_part ) = @_;
|
|
$self->_link;
|
|
splice( @{$self->{parts}}, $old_part->{id}, 1, $new_part );
|
|
$self->_link;
|
|
}
|
|
|
|
sub add_part_before {
|
|
# --------------------------------------------------------------------------
|
|
# Adds a part before the given part. The first argument is the part object
|
|
# to add the part before. the second argument is the part to add.
|
|
#
|
|
my ( $self, $before_part, $part ) = @_;
|
|
$self->_link;
|
|
die "Can't add part before the top level part" if $before_part == $self->{root_part};
|
|
my $parent_id = $before_part->{parent_id};
|
|
|
|
if ( !defined $parent_id or !$self->{parts}[$parent_id]->is_multipart ) {
|
|
die "The part's parent must exist and must be a multipart";
|
|
}
|
|
splice( @{$self->{parts}}, $before_part->{id}, 0, $part );
|
|
my $parent_part = $self->{parts}[$parent_id];
|
|
$parent_part->add_parts_before( $before_part->{id}, $part );
|
|
$self->_link;
|
|
}
|
|
|
|
sub add_part_after {
|
|
# --------------------------------------------------------------------------
|
|
# Adds a part after the given part. The first argument is the part object
|
|
# to add the part after. the second argument is the part to add.
|
|
#
|
|
my ( $self, $after_part, $part ) = @_;
|
|
$self->_link;
|
|
die "Can't add part after the top level part" if $after_part == $self->{root_part};
|
|
my $parent_id = $after_part->{parent_id};
|
|
|
|
if ( !defined $parent_id or !$self->{parts}[$parent_id]->is_multipart ) {
|
|
die "The part's parent must exist and must be a multipart";
|
|
}
|
|
splice( @{$self->{parts}}, $after_part->{id} + 1, 0, $part );
|
|
my $parent_part = $self->{parts}[$parent_id];
|
|
$parent_part->add_parts_after( $after_part->{id}, $part );
|
|
$self->_link;
|
|
}
|
|
|
|
sub add_part_beginning {
|
|
# --------------------------------------------------------------------------
|
|
# Adds a part at the beginning of the given multipart part. The first
|
|
# argument is the part object to add the part before. the second argument is
|
|
# the part to add.
|
|
#
|
|
my ( $self, $parent_part, $part ) = @_;
|
|
$self->_link;
|
|
my $parent_id = $parent_part->{id};
|
|
|
|
if ( !$self->{parts}[$parent_id]->is_multipart ) {
|
|
die "The parent part must be a multipart";
|
|
}
|
|
splice( @{$self->{parts}}, $parent_id + 1, 0, $part );
|
|
$parent_part->add_part_before( $part->{parts}[0]{id}, $part );
|
|
$self->_link;
|
|
}
|
|
|
|
sub add_part_end {
|
|
# --------------------------------------------------------------------------
|
|
# Adds a part at the end of the given multipart part. The first argument is
|
|
# the part object to add the part at the end of. the second argument is the
|
|
# part to add. The first argument must be a multipart part or a fatal error
|
|
# occurs.
|
|
#
|
|
my ( $self, $parent_part, $part ) = @_;
|
|
$self->_link;
|
|
my $parent_id = $parent_part->{id};
|
|
|
|
if ( !$self->{parts}[$parent_id]->is_multipart ) {
|
|
die "The parent part must be a multipart";
|
|
}
|
|
splice( @{$self->{parts}}, $parent_id + @parts, 0, $part );
|
|
$parent_part->parts( $part );
|
|
$self->_link;
|
|
}
|
|
|
|
sub move_part_to_position {
|
|
# --------------------------------------------------------------------------
|
|
# Move a part to a position within another multipart part. The first
|
|
# argument is the part to move within, the second argument is the part to
|
|
# move and the final argument is the position within those parts to move it
|
|
# in.
|
|
#
|
|
my ( $self, $parent_part, $part, $pos ) = @_;
|
|
die "Can't move top part" if $part == $self->{root_part};
|
|
if ( !$self->_part_in_message( $parent_part ) or !$self->_part_in_message( $part ) ) {
|
|
die "All parts specified must be in the MIME message";
|
|
}
|
|
$self->_link;
|
|
my $parent_id = $parent_part->{id};
|
|
|
|
if ( !$self->{parts}[$parent_id]->is_multipart ) {
|
|
die "The parent part must be a multipart";
|
|
}
|
|
splice( @{$self->{parts}}, $parent_id + $pos, $part );
|
|
$self->_link;
|
|
}
|
|
|
|
sub get_part_by_id {
|
|
# --------------------------------------------------------------------------
|
|
# Method to retrieve a part object by it's id
|
|
#
|
|
my ( $self, $id ) = @_;
|
|
|
|
return $self->{parts}[$id];
|
|
}
|
|
|
|
sub new_part {
|
|
# --------------------------------------------------------------------------
|
|
# Method to easily create a part object. All the header fields can be passed
|
|
# in as a hash. If the key "body_data" the value will be set as the parts
|
|
# body rather than a header field.
|
|
#
|
|
my ( $self, @opts ) = @_;
|
|
my $part = new GT::Mail::Parts;
|
|
while ( my ( $key, $val ) = ( shift( @opts ), shift( @opts ) ) ) {
|
|
if ( $key eq 'body_data' ) {
|
|
$part->body_data( $val );
|
|
}
|
|
elsif ( $key eq 'body_handle' ) {
|
|
$part->body_handle( $val );
|
|
}
|
|
elsif ( $key eq 'body_path' ) {
|
|
$part->body_path( $val );
|
|
}
|
|
else {
|
|
$part->set( $key => $val );
|
|
}
|
|
}
|
|
return $part;
|
|
}
|
|
|
|
sub all_parts {
|
|
# --------------------------------------------------------------------------
|
|
# my @parts = $obj->all_parts;
|
|
# ----------------------------
|
|
# Returns a list of all the part object for the current parsed email.
|
|
# If the email is not multipart this will be just the header part.
|
|
#
|
|
return @{shift()->{parts}}
|
|
}
|
|
|
|
sub size {
|
|
# --------------------------------------------------------------------------
|
|
# Returns the total size of an email. Call this method after the email has
|
|
# been parsed.
|
|
#
|
|
my $self = shift;
|
|
(@{$self->{parts}} > 0) or return;
|
|
my $size = 0;
|
|
foreach (@{$self->{parts}}) {
|
|
$size += $_->size;
|
|
}
|
|
return $size;
|
|
}
|
|
|
|
sub as_string {
|
|
# --------------------------------------------------------------------------
|
|
# Returns the entire email as a sting.
|
|
#
|
|
my ( $self ) = @_;
|
|
$GT::Mail::Encoder::CRLF = $CRLF;
|
|
|
|
my $out;
|
|
$$out = ' ' x 50*1024;
|
|
$self->debug ("\n\t--------------> Creating email") if $self->{_debug};
|
|
|
|
# Need the head to contiue
|
|
$self->{root_part} or die "No root part!";
|
|
$self->{root_part}->set( 'MIME-Version' => '1.0' ) unless $self->{root_part}->get( 'MIME-Version' );
|
|
|
|
my $bound = $self->{root_part}->multipart_boundary;
|
|
|
|
# If the message has parts
|
|
|
|
if ( @{$self->{root_part}->{parts}} > 0 ) {
|
|
$self->debug( "Creating multipart email." ) if $self->{_debug};
|
|
$self->_build_multipart_head( $out );
|
|
}
|
|
|
|
# Else we are single part and have either a body IO handle or the body is in memory
|
|
else {
|
|
$self->debug( "Creating singlepart email." ) if $self->{_debug};
|
|
$self->_build_singlepart_head( $out );
|
|
}
|
|
|
|
# If we have parts go through all of them and add them.
|
|
if ( @{$self->{root_part}->{parts}} > 0 ) {
|
|
my $num_parts = $#{$self->{root_part}->{parts}};
|
|
for my $num ( 0 .. $num_parts ) {
|
|
next unless $self->{root_part}->{parts}->[$num];
|
|
$self->debug( "Creating part ($num)." ) if $self->{_debug};
|
|
$self->_build_parts( $out, $self->{root_part}->{parts}->[$num] );
|
|
if ( $num_parts == $num ) {
|
|
$self->debug( "Boundary\n\t--$bound--" ) if $self->{_debug};
|
|
$$out .= $CRLF . '--' . $bound . '--' . $CRLF;
|
|
}
|
|
else {
|
|
$self->debug( "Boundary\n\t--$bound" ) if $self->{_debug};
|
|
$$out .= $CRLF . '--' . $bound . $CRLF;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Add the epilogue if we are multipart
|
|
if ( @{$self->{root_part}->{parts}} > 0 ) {
|
|
my $epilogue = join( '', @{$self->{root_part}->epilogue || []} ) || '';
|
|
$epilogue =~ s/\015?\012//g;
|
|
$self->debug( "Setting epilogue to ($epilogue)" ) if $self->{_debug};
|
|
$$out .= $epilogue . $CRLF . $CRLF if $epilogue;
|
|
}
|
|
$self->debug( "\n\t<-------------- Email created." ) if $self->{_debug};
|
|
return $$out;
|
|
}
|
|
|
|
sub _build_multipart_head {
|
|
# --------------------------------------------------------------------------
|
|
# Private method to build a multipart header.
|
|
#
|
|
my ( $self, $out ) = @_;
|
|
my $bound = $self->{root_part}->multipart_boundary;
|
|
my $encoding = $self->{root_part}->suggest_encoding;
|
|
$self->debug( "Setting encoding to ($encoding)." ) if ( $self->{debug} );
|
|
$self->{root_part}->set( 'Content-Transfer-Encoding' => $encoding );
|
|
$bound or $bound = "---------=_" . scalar (time) . "-$$-" . int(rand(time)/2);
|
|
|
|
# Set the content boundary unless it has already been set
|
|
my $c = $self->{root_part}->get( 'Content-Type' );
|
|
if ( $c !~ /\Q$bound/i ) {
|
|
if ( $c and lc( $c ) !~ /boundary=/ ) {
|
|
$c =~ /multipart/ or $c = 'multipart/mixed';
|
|
$self->debug( qq|Setting content type to ($c; boundary="$bound")| ) if $self->{debug};
|
|
$self->{root_part}->set( 'Content-Type' => $c . qq|; boundary="$bound"| );
|
|
}
|
|
else {
|
|
$self->debug( "Setting multipart boundary to ($bound)." ) if $self->{_debug};
|
|
$self->{root_part}->set( 'Content-Type' => qq!multipart/mixed; boundary="$bound"! )
|
|
}
|
|
}
|
|
|
|
my $preamble = join( '', @{$self->{root_part}->preamble || []} ) || "This is a multi-part message in MIME format.";
|
|
$preamble =~ s/\015?\012//g;
|
|
$self->debug( "Setting preamble to ($preamble)." ) if ( $self->{_debug} );
|
|
( my $head = $self->{root_part}->header_as_string ) =~ s/\015?\012/$CRLF/g;
|
|
$self->debug( "Boundary\n\t--$bound" ) if $self->{_debug};
|
|
$$out .= $head . $CRLF . $preamble . $CRLF . $CRLF . '--' . $bound . $CRLF;
|
|
return 1;
|
|
}
|
|
|
|
sub _build_singlepart_head {
|
|
# --------------------------------------------------------------------------
|
|
# Private method to build a single part header.
|
|
#
|
|
my ( $self, $out ) = @_;
|
|
my $encoding = $self->{root_part}->suggest_encoding;
|
|
$self->debug( "Setting encoding to ($encoding)." ) if $self->{_debug};
|
|
$self->{root_part}->set( 'Content-Transfer-Encoding' => $encoding );
|
|
( my $head = $self->{root_part}->header_as_string ) =~ s/\015?\012/$CRLF/g;
|
|
$$out .= $head . $CRLF;
|
|
$self->debug( "Encoding body with ($encoding)." ) if $self->{_debug};
|
|
GT::Mail::Encoder->gt_encode (
|
|
debug => $self->{_debug},
|
|
encoding => $encoding,
|
|
in => $self->{root_part}->body_as_string,
|
|
out => $out
|
|
) or return;
|
|
|
|
# Must seek to the beginning for additional calles
|
|
return 1;
|
|
}
|
|
|
|
sub _build_parts {
|
|
# --------------------------------------------------------------------------
|
|
# Private method that builds the parts for the email.
|
|
#
|
|
my ($self, $out, $part) = @_;
|
|
|
|
# Need the head to contiue
|
|
$self->{root_part} or die "No root part!";
|
|
|
|
my ( $body, $encoding, $bound );
|
|
$bound = $part->multipart_boundary;
|
|
|
|
|
|
# Find the encoding for the part and set it.
|
|
$encoding = $part->suggest_encoding;
|
|
$self->debug( "Setting encoding to ($encoding)." ) if $self->{_debug};
|
|
$part->set( 'Content-Transfer-Encoding' => $encoding );
|
|
|
|
# If the message has parts and has a multipart boundary
|
|
if ( @{$part->{parts}} > 0 and $bound ) {
|
|
$self->debug( "Part is multpart." ) if $self->{_debug};
|
|
|
|
# Set the multipart boundary
|
|
$self->debug( "Setting boundary to ($bound)." ) if $self->{_debug};
|
|
|
|
# Set the content boundary unless it has already been set
|
|
my $c = $part->get( 'Content-Type' );
|
|
if ( $c ) {
|
|
$self->debug( qq|Setting content type to ($c; boundary="$bound")| ) if $self->{_debug};
|
|
$part->set( 'Content-Type' => $c . qq|; boundary="$bound"| );
|
|
}
|
|
else {
|
|
$self->debug( "Setting multipart boundary to ($bound)." ) if $self->{_debug};
|
|
$part->set( 'Content-Type' => qq!multipart/mixed; boundary="$bound"! );
|
|
}
|
|
|
|
my $preamble = join( '' => @{ $part->preamble || [] } ) || "This is a multi-part message in MIME format.";
|
|
$preamble =~ s/\015?\012//g;
|
|
$self->debug( "Setting preamble to ($preamble)." ) if $self->{_debug};
|
|
( my $head = $part->header_as_string ) =~ s/\015?\012/$CRLF/g;
|
|
$self->debug( "Boundary\n\t--$bound" ) if $self->{_debug};
|
|
$$out .= $head . $CRLF . $preamble . $CRLF . '--' . $bound . $CRLF;
|
|
}
|
|
else {
|
|
$self->debug( "Part is single part." ) if $self->{_debug};
|
|
( my $head = $part->header_as_string ) =~ s/\015?\012/$CRLF/g;
|
|
$$out .= $head . $CRLF;
|
|
|
|
# Set the body only if we have one. We would not have one on the head an multipart
|
|
$self->debug( "Encoding body with ($encoding)." ) if $self->{_debug};
|
|
GT::Mail::Encoder->gt_encode(
|
|
encoding => $encoding,
|
|
debug => $self->{_debug},
|
|
in => $part->body_as_string,
|
|
out => $out
|
|
) or return;
|
|
|
|
}
|
|
|
|
# Add the rest of the parts
|
|
if ( @{$part->{parts}} > 0 ) {
|
|
$self->debug( "Part has parts." ) if $self->{_debug};
|
|
my $num_parts = $#{$part->{parts}};
|
|
for my $num ( 0 .. $num_parts ) {
|
|
next unless $part->{parts}->[$num];
|
|
$self->debug( "Creating part ($num)." ) if $self->{_debug};
|
|
$self->_build_parts( $out, $part->{parts}->[$num] ) or return;
|
|
if ( $bound ) {
|
|
if ( $num_parts == $num ) {
|
|
$self->debug( "Boundary\n\t--$bound--" ) if $self->{_debug};
|
|
$$out .= $CRLF . '--' . $bound . '--' . $CRLF;
|
|
}
|
|
else {
|
|
$self->debug( "Boundary\n\t--$bound" ) if $self->{_debug};
|
|
$$out .= $CRLF . '--' . $bound . $CRLF;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Maybe done!
|
|
return 1;
|
|
}
|
|
|
|
sub _delete_part {
|
|
# --------------------------------------------------------------------------
|
|
# Internal method to delete a part
|
|
my ( $self, $part ) = @_;
|
|
|
|
# We must remove it from it's parent
|
|
my $parent = $self->{parts}[$part->{parent_id}];
|
|
for ( 0 .. $#{$parent->{parts}} ) {
|
|
if ( $parent->{parts}[$_]{id} == $part->{id} ) {
|
|
splice( @{$parent->{parts}}, $_, 1 );
|
|
last;
|
|
}
|
|
}
|
|
|
|
# We must remove it from the flat list of parts
|
|
return splice( @{$self->{parts}}, $part->{id}, 1 );
|
|
}
|
|
|
|
sub _part_in_message {
|
|
# --------------------------------------------------------------------------
|
|
# Internal method to find out weather a part is in the current message
|
|
my ( $self, $part ) = @_;
|
|
for ( @{$self->{parts}} ) {
|
|
return 1 if $_ == $part;
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub _link {
|
|
# --------------------------------------------------------------------------
|
|
# Creats part ids and links the children to the parrents. Called
|
|
# When parts arer modified
|
|
#
|
|
my ( $self ) = @_;
|
|
|
|
# Creates ids to keep track of parts with.
|
|
for ( 0 .. $#{$self->{parts}} ) {
|
|
$self->{parts}[$_]{id} = $_;
|
|
}
|
|
_link_ids( $self->{root_part} );
|
|
}
|
|
|
|
sub _links_ids {
|
|
# --------------------------------------------------------------------------
|
|
# Internal function to link all children to their parents with the parent id.
|
|
# RECURSIVE
|
|
#
|
|
my ( $part, $parent_id ) = @_;
|
|
for ( @{$part->{parts}} ) {
|
|
_link_ids( $_, $part->{id} );
|
|
}
|
|
$part->{parent_id} = $parent_id;
|
|
}
|
|
|
|
sub _get_parts {
|
|
# --------------------------------------------------------------------------
|
|
# Recursive function to get a flat list of all the parts in a part structure
|
|
#
|
|
my ( $part, $parts ) = @_;
|
|
$parts ||= [];
|
|
|
|
for ( @{$part->{parts}} ) {
|
|
push @$parts, @{_get_parts( $_, $parts )};
|
|
}
|
|
return $parts;
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::Mail::Message - Encapsolates an email message.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use GT::Mail::Message;
|
|
|
|
# Get a GT::Mail::Message object from the parser
|
|
use GT::Mail::Parse;
|
|
|
|
my $parser = new GT::Mail::Parse( in_file => "myemail.eml" );
|
|
my $message = $parser->parse;
|
|
|
|
# Get the top level part
|
|
my $root_part = $message->root_part;
|
|
|
|
# Replace the first part with a new part
|
|
$message->replace_part( $root_part, $message->new_part(
|
|
to => 'scott@gossamer-threads.com',
|
|
from => 'alex@gossamer-threads.com',
|
|
'content-type' => 'text/plain',
|
|
body_data => 'Hi Scott, how are you?!'
|
|
);
|
|
|
|
# Add a part at the end
|
|
my $end_part = $message->new_part(
|
|
'content-type' => 'image/gif',
|
|
body_path => 'myimage.jpg'
|
|
);
|
|
$message->add_part_end( $root_part, $end_part );
|
|
|
|
# Move the first part in the top part to after the end part
|
|
$message->move_part_after( $root_part->parts->[0], $end_part );
|
|
|
|
# Print the mime message
|
|
print $message->to_string;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
GT::Mail::Message encapsolates a mime message which consists of
|
|
L<GT::Mail::Parts> object. This module provides methods to change,
|
|
move, remove, and access these parts.
|
|
|
|
=head2 Creating a new GT::Mail::Message object
|
|
|
|
Usually you will get a GT::Mail::Message object by call the parse method
|
|
in L<GT::Mail::Parse>.
|
|
|
|
my $message = $parser->parse;
|
|
|
|
You may also call new on this class specifying the top level part and or
|
|
a debug level.
|
|
|
|
my $message = new GT::Mail::Message(
|
|
root_part => $part,
|
|
debug => 1
|
|
);
|
|
|
|
=head2 Creating a new Part
|
|
|
|
You can create a part by calling new on L<GT::Mail::Parts> directly
|
|
|
|
my $part = new GT::Mail::Parts;
|
|
$part->set( 'content-type' => 'image/gif' );
|
|
$part->body_path( 'myimage.gif' );
|
|
|
|
or you can call a method in this module to get a new part
|
|
|
|
my $part = $message->new_part(
|
|
'content-type' => 'image/gif',
|
|
body_path => 'myimage.gif'
|
|
);
|
|
|
|
This method is a wraper on a combination of new() and some other
|
|
supporting methods in L<GT::Mail::Parts> such as body_path(). Anything
|
|
that is not B<body_path>, B<body_data>, or B<body_handle> is treated
|
|
as header values.
|
|
|
|
=head2 Manipulating Parts
|
|
|
|
A MIME message is just a format for storing a tree structure. We provide
|
|
tree-like methods to manipulate parts. All the method for manipulating
|
|
parts take the part object(s) as arguments. We do this so you do not need
|
|
to know how the tree is tracked internally.
|
|
|
|
=head2 Accessing Parts
|
|
|
|
|
|
More to come!
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: Message.pm,v 1.14 2004/01/13 01:35:17 jagerman Exp $
|
|
|
|
|
|
|