############################################################################
#
#   Copyright 1999-2000 Phone.com, Inc.  All rights reserved.
#
#   Subject to the terms and conditions of the SDK License Agreement, 
#   Phone.com, Inc. hereby grants you the right to use the UP.SDK 
#   software and its related documentation.
#
#   The Phone.com name and logo and the family of terms carrying the "UP."
#   prefix are trademarks of Phone.com, Inc. All other brands and product 
#   names may be trademarks of the respective companies with which they 
#   are associated.
#
############################################################################

######################################################################
#
# Mime.pm
#
# CLASS:
# MsgEntity
#
# INDEX: (lists the categories this function is indexed under in the docs)
# MIME messages:API for
# 
# DESCRIPTION:
# The MsgEntity class provides an API to build and manage MIME message
# entities.  A message entity consists of a header and a body, as
# specified in RFCs 822 and 1521:
#
#	http://www.internic.net/rfc/rfc822.txt
#	http://www.internic.net/rfc/rfc1521.txt
#
# SUPERCLASSES:
# None
#
# ATTRIBUTES:
# header	The header is an associative array where the keys are \
#			the header field names and the values are the header \
#			field bodies.
# body		The body of the message
#
# CAVEATS:
# This class is designed to build HTTP responses, and as such does not
# support MIME content encoding which is unnecessary for HTTP.  Also,
# this class will output a Content-length header field which is
# specific to HTTP.
#
# If you are using a non-Unix platform, you should call "binmode" on a
# file descriptor before writing out the string version of this class.
#
######################################################################

# Require Perl 5.001
require 5.001;

package MsgEntity;

# for non-unix platforms so they properly calculate msg size.
binmode(STDOUT);

######################################################################
#
# METHOD:
# new
#
# INDEX: (lists the categories this function is indexed under in the docs)
# MIME messages:creating instances of
# 
# DESCRIPTION:
# Creates a new instance of a MsgEntity.  Calling this method is a 
# prerequisite for calling any other method of this class.
#
# SYNOPSIS:
# require MsgEntity;
# ...
# $msgEntity = MsgEntity->new();
#
# SYNOPSIS:
# require MsgEntity;
# ...
# $msgEntity = MsgEntity->new($header, $body);
#
# ARGUMENTS:
# $header		(hash reference) The initial header of the message
# $body			(string) The initial body of the message
#
# RETURN:
# $self			Returns a reference to the MsgEntity object on \
#				success
# undef			Returns undef if called with bogus arguments
#
# EXAMPLE:
# $msgEntity = MsgEntity->new({ "Content-type" => "text/x-hdml" },
#				$hdmlDeck);
#
######################################################################
sub new
{
	my($class) = shift;
	my($header) = shift;
	my($body) = shift;

	# Sanity check args
	return undef if (ref($header) != "HASH");

	# Instantiate
	my($self) = {};
	bless($self, $class);

	# Initialize
	$self->{'header'} = $header;
	$self->{'body'} = $body;

	return $self;
}


######################################################################
#
# METHOD:
# addHeader
#
# INDEX: (lists the categories this function is indexed under in the docs)
# MIME messages:adding headers to
# 
# DESCRIPTION:
# Adds a header field to the message entity.  If the header field
# already exists, it is overwritten.
#
# SYNOPSIS:
# require MsgEntity;
# ...
# MsgEntity->addHeader($name, $value);
#
# ARGUMENTS:
# $name			(string) The name of the header field
# $value			(string) The value of the header field
#
# EXAMPLE:
# $msg->addHeader("Content-location", "http://www.foo.com/bar.cgi");
#
######################################################################
sub addHeader
{
	my($self) = shift;
	my($name) = shift;
	my($value) = shift;

	$self->{'header'}->{$name} = $value;
}


######################################################################
#
# METHOD:
# setBody
#
# INDEX: (lists the categories this function is indexed under in the docs)
# MIME messages:setting the bodies of
# 
# DESCRIPTION:
# Sets the body of a message entity.
#
# SYNOPSIS:
# require MsgEntity;
# ...
# $msg->SetBody($newBody);
#
# ARGUMENTS:
# $newBody		(string) The new body of the message entity
#
# EXAMPLE:
# $msg->SetBody($newBody);
#
######################################################################
sub setBody {
	my($self) = shift;
	my($newBody) = shift;

	$self->{'body'} = $newBody;
}


######################################################################
#
# METHOD:
# asString
#
# INDEX: (lists the categories this function is indexed under in the docs)
# MIME messages:converting to strings
# 
# DESCRIPTION:
# Converts the message entity to a string for printing.
#
# SYNOPSIS:
# require MsgEntity;
# ...
# $content = $msg->asString();
#
# RETURN:
# $content		The entire message as a single scalar string
#
# EXAMPLE:
# $content = $msg->asString();
#
# CAVEAT:
# On non-Unix systems, you should call "binmode" on a file descriptor
# before writing this string out to it.
#
######################################################################
sub asString
{
	my($self) = shift;

	# Calculate the content length, and update the headers
	my($contentLenName, $contentLenVal);
	my(@grep) = grep(/Content-length/i, keys %{$self->{'header'}});
	$contentLenName = $grep[0];

	if (! defined($contentLenName)) {
		$contentLenName = "Content-length";
	}
	$self->{'header'}->{$contentLenName} = length $self->{'body'};

	# Catenate the header fields
	my($key, $value, $ret);
	while (($key, $value) = each %{$self->{'header'}}) {
		$ret .= $key;
		$ret .= ": ";
		$ret .= $value;
		$ret .= "\n";
	}

	# Add the separator
	$ret .= "\n";

	# Add the body
    $ret .= $self->{'body'};

	return $ret;
}


######################################################################
#
# CLASS:
# MultipartMsg
#
# INDEX: (lists the categories this function is indexed under in the docs)
# multipart messages
# 
# DESCRIPTION:
# The MultipartMsg class provides an API to build and manage MIME
# multipart messages.  A multipart message consists of a header and a
# body just like a message entity, but the body is divided into a
# preamble, one or more subparts, and an epilogue.
#
# SUPERCLASSES:
# MsgEntity
#
# ATTRIBUTES:
# header		(From MsgEntity)
# preamble		The preamble portion of the body
# subParts		An array of subparts
# epilogue		The epilogue portion of the body
#
# CAVEATS:
# You should not specify an epilogue in an HTTP response, the HTTP
# specification explicitly says not to.
#
# If you are using a non-Unix platform, you should call "binmode" on a
# file descriptor before writing out the string version of this class.
#
######################################################################

package MultipartMsg;

# Specify inheritance
@ISA = ("MsgEntity");
@MultipartMsg::SUPER::ISA = @ISA;


######################################################################
#
# METHOD:
# new
#
# INDEX: (lists the categories this function is indexed under in the docs)
# multipart messages:creating instances of
# 
# DESCRIPTION:
# Creates a new multipart message.  Calling this method is a
# prerequisite for calling any other method of this class.
##
# ARGUMENTS:
# header		(hash reference) The initial header of the message
# preamble		(string) The initial preamble
# subParts		(array reference) The initial subParts
# epilogue		(string) The initial epilogy (optional)
#
# RETURN:
# $self			Returns a reference to the MultipartMsg object on \
#				success
# undef			Returns undef if called with bogus arguments
#
# EXAMPLE:
# $msg = MultipartMsg->new({ "Content-type" => "multipart/mixed" },
# "", [], "");
#
######################################################################
sub new
{
	my($class) = shift;
	my($header) = shift;
	my($preamble) = shift;
	my($subparts) = shift;
	my($epilogue) = shift;

	# Instantiate
	my($self) = new MsgEntity($header);

	if (defined($self)) {
		bless($self, $class);

		# Initialize
		$self->{'preamble'} = $preamble;
		$self->{'subparts'} = $subparts;
		$self->{'epilogue'} = $epilogue;
	}

	return $self;
}	


######################################################################
#
# METHOD:
# setBody
#
# DESCRIPTION:
# Catch a bogus attempt to set the body of a multipart message.  You
# can't do that.  You can only set the preamble and epilogue, or ad
# subparts.
#
######################################################################
sub setBody
{
	die "can't directly set the body of a multipart message";
}


######################################################################
#
# METHOD:
# setPreamble
#
# INDEX: (lists the categories this function is indexed under in the docs)
# multipaart messages:setting preambles of
# 
# DESCRIPTION:
# Sets the preamble of the body of a multipart message.
#
# SYNOPSIS:
# require MsgEntity;
# ...
# $msg->setPreamble($preamble);
#
# ARGUMENTS:
# $preamble		(string) The new preamble of the message.
#
# EXAMPLE:
# $msg->setPreamble("This is the new preamble");
#
######################################################################
sub setPreamble
{
	my($self) = shift;
	my($preamble) = shift;

	$self->{'preamble'} = $preamble;
}


######################################################################
#
# METHOD:
# setEpilogue
#
# INDEX: (lists the categories this function is indexed under in the docs)
# multipaart messages:setting epilogues of
# 
# DESCRIPTION:
# Sets the epilogue of the body of a multipart message
#
# SYNOPSIS:
# require MsgEntity;
# ...
# $msg->setEpilogue($epilogue);
#
# ARGUMENTS:
# $epilogue		(string) The new epilogue of the message
#
# EXAMPLE:
# $msg->setEpilogue("This is the new epilogue");
#
######################################################################
sub setEpilogue
{
	my($self) = shift;
	my($epilogue) = shift;

	$self->{'epilogue'} = $epilogue;
}


######################################################################
#
# METHOD:
# appendSubpart
#
# INDEX: (lists the categories this function is indexed under in the docs)
# multipaart messages:appending subparts of
# 
# DESCRIPTION:
# Add a subpart to the multipart message.  The subpart is appended
# after all the existing subparts.
#
# SYNOPSIS:
# require MsgEntity;
# ...
# $msg->appendSubpart($subMsg);
# $msg->appendSubpart($subpart1, $subpart2, $subpart3);
#
# ARGUMENTS:
# subPart,...	(MsgEntity) The subpart(s) to add
#
# EXAMPLE:
# $msg->appendSubpart($subMsg);
# $msg->appendSubpart($subpart1, $subpart2, $subpart3);
#
######################################################################
sub appendSubpart
{
	my($self) = shift;

	foreach $subpart (@_) {
		push @{$self->{'subparts'}}, $subpart;
	}
}


######################################################################
#
# METHOD:
# asString
#
# INDEX: (lists the categories this function is indexed under in the docs)
# multipaart messages:printing as strings
# 
# DESCRIPTION:
# Converts the multipart message to a string for printing.
#
# RETURN:
# $content		The entire message as a single scalar string
#
# EXAMPLE:
# $content = $msg->asString();
#
# CAVEAT:
# On non-Unix systems, you should call "binmode" on a file descriptor
# before writing this string out to it.
#
######################################################################
sub asString
{
	my($self) = shift;
	my($boundary, $contentTypeName, $contentTypeVal);

	#First replace each of the subpart MsgEntity objects with
	#the asString() versions of each. This will allow easy parsing
	#for a boundary string
	foreach $subpart (@{$self->{'subparts'}}) {
		$subpart = $subpart->asString();
	}

	# Calculate the boundary by tacking on random characters until
	# the boundary can no longer be found in any of the messages
	$boundary = "-";
	while (grep(/$boundary/, @{$self->{'subparts'}})) {
		$boundary .= (0 .. 9, 'a' .. 'z', 'A' .. 'Z')[int(rand 62)];
	}

	# Update the Content-type header to include the boundary

	# The grep ugliness makes sure we find the content-type header
	# regardless of how it is capitalized
	my(@grep) = grep(/Content-type/i, keys %{$self->{'header'}});
	$contentTypeName = $grep[0];
	if (defined($contentTypeName)) {
		$contentTypeVal = $self->{'header'}->{$contentTypeName};
	} else {
		$contentTypeName = "Content-type";
		$contentTypeVal = "multipart/mixed";
	}

	# Add the boundary parameter to the Content-type header
	#
	# Note, we remove whitespace in the boundary parameter because
	# NCSA HTTPd 1.4 truncates the Content-type header at the first
	# whitespace it sees.  Go figure.
	#
	$contentTypeVal =~ s/\;\s*boundary\=[^\;]*/\;boundary=\"$boundary\"/ ||
		$contentTypeVal =~ s/$/\;boundary=\"$boundary\"/;
	$self->{'header'}->{$contentTypeName} = $contentTypeVal;

	# Build up the body
	my ($body, $subpart);

	$body = $self->{'preamble'};
	foreach $subpart (@{$self->{'subparts'}}) {
		# XXX - should be CRLF not LF
		$body .= "\n--$boundary\n";
		$body .= $subpart;
	}
	# XXX - should be CRLF not LF
	$body .= "\n--$boundary--\n";
	$body .= $self->{'epilogue'};

	# HACK: Set the body attribute and the superclass's asString()
	# method to put it all together
	$self->{'body'} = $body;

	return $self->MultipartMsg::SUPER::asString();
}


1;
