package MailBot::Entity;

=head1 NAME

MailBot::Entity - quota-enforcing extension to MIME::Entity

=head1 SYNOPSIS

 use MailBot::Entity;
 use MailBot::Envelope;

 MailBot::Entity::setEnvelope(new MailBot::Envelope());
 my $msg = new MailBot::Entity("If you can read this, you had enough quota");
 $msg -> send();  # dies if not enough quota

=head1 DESCRIPTION

MailBot::Entity extends extends L<MIME::Entity> to support quotas and
L<MailBot::Envelope> objects.

=head1 SEE ALSO

L<MIME::Entity>, L<MailBot::Envelope>, L<MailBot::UI>, L<MailBot::Quota>

=head1 COPYRIGHT

Copyright (c) 1997 SatelLife.  All rights reserved.

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

Rolf Nelson <rolf@usa.healthnet.org>

=cut

use MailBot::Sendable;
use MailBot::UI;
use MIME::Decoder;
use MailBot::UUEncode;

#install MailBot::UUEncode 'x-uuencode';
# broken MIMETools-2.04 'install' makes this workaround necessary:
$MIME::Decoder::DecoderFor{'x-uuencode'} = MailBot::UUEncode;

# jfj create 'profile' for healthnet users who probably have no MIME

@ISA = qw( MailBot::Sendable );

use Carp;
use strict;

my $gEnvelope;

# j implement "fake quota" copies

sub setEnvelope
{
    $gEnvelope = shift;
}

sub send
{
    my $self = shift;
    my $paResource = shift || [];

    my $config = MailBot::Config -> current;
    my $ui = MailBot::UI -> current;

    defined $gEnvelope or croak "no envelope";
    my $quotaMultiplier = $gEnvelope -> getQuotaMultiplier;
    my $from = $gEnvelope -> getFrom;
    defined $from and
	$self -> head -> replace('From',$from);

    my $resource;
    foreach $resource (@$paResource)
    {
	my $resourceMultiplier =
	    $config -> getIniVal("quota",$resource,1);
	$quotaMultiplier *= $resourceMultiplier;
    }

    # jf only chop, not die, if message too long

    my $length = $self -> get_length;
    $config ->
	log("send $length bytes to ", $gEnvelope -> getRecip -> asString());

    my $lastByte = $gEnvelope -> getLastByte;
    $length > $lastByte and
	die "UNAVAILABLE: message of length $length too long,\nmaximum length is $lastByte\n";

    my $quota = $ui -> getQuota;

    $quota -> bill(1 * $quotaMultiplier,"message");
    $quota -> bill($length * $quotaMultiplier,"byte");
    my $splitMultiplier = $config -> getSplitMultiplier;

    my $splitSize = $gEnvelope -> getSplitSize;
    if ($splitSize < 500 or $splitSize > 200000)
    {
	die "split size of $splitSize is illegal, must be between 500 and 200000 bytes\n";
    }

    my $maxChunk = $splitSize * $splitMultiplier;

    my $paSplit = $self -> split_into_array($splitSize,$maxChunk);

    my $msg;
    foreach $msg (@$paSplit)
    {
	$ui -> sendMessage($msg);
    }
}

# jfj smarter about when to use 7-bit and when to use q-p encoding

sub build
{
    my $type = shift;
    my %opt = @_;

    my $top = exists($opt{Top}) ? $opt{Top} : 1;
    my $contentEncoding = $opt{Encoding};
    
    my $self = $type -> SUPER::build(@_);
    my $header = $self -> head;

    my $contentType = $header -> mime_type;
    my $newEncoding;

    if (! defined $contentEncoding and
	$contentType !~ m|^multipart/| and
	$contentType !~ m|^message/|)
    {
	my $mime = $$gEnvelope{MIME};
	if (defined $contentType and $contentType !~ m!^text/!)
	{
	    if ($mime)
	    {
		$newEncoding = "base64";
	    }
	    else
	    {
		$newEncoding = "x-uuencode";
	    }
	}
	# default is 7bit
    }

    $header -> replace('Content-Transfer-Encoding',$newEncoding)
        if (defined $newEncoding);

    my $lastByte = $gEnvelope -> getLastByte;

    my $length = $self -> get_length;

    $length <= $lastByte or
	die "UNAVAILABLE: message longer than $lastByte bytes\n";

    return $self unless $top;

    my $recip = $gEnvelope -> getRecip;

    if (defined $recip)
    {
	$self -> head -> add('to',$recip -> to);
	$self -> head -> add('cc',$recip -> cc)
	    if $recip -> cc ne "";
    }

    $self -> head -> add('subject',$gEnvelope -> getSubject);

    if ($top)
    {
	my $ui = &MailBot::UI::current;
	my $paNote = $ui -> getNoteRef;

	$self -> head -> add('X-MailBot-Note',join(', ',@$paNote))
	    if @$paNote;
	@$paNote = ();
    }

    $self;
}

1;
