
use strict;
use warnings;

package HTML::FromMail::Message;
use vars '$VERSION';
$VERSION = '0.01';
use base 'HTML::FromMail::Page';

use HTML::FromMail::Head;
use HTML::FromMail::Field;
use HTML::FromMail::Default::Previewers;
use HTML::FromMail::Default::HTMLifiers;

use Carp;
use File::Basename 'basename';


sub init($)
{   my ($self, $args) = @_;
    $args->{topic} ||= 'message';

    $self->SUPER::init($args) or return;

    $self->{HFM_dispose}  = $args->{disposition};
    my $settings = $self->settings;

    # Collect previewers
    my @prevs = @HTML::FromMail::Default::Previewers::previewers;
    if(my $prevs = $settings->{previewers})
    {   unshift @prevs, @$prevs;
    }
    $self->{HFM_previewers} = \@prevs;
 
    # Collect htmlifiers
    my @html = @HTML::FromMail::Default::HTMLifiers::htmlifiers;
    if(my $html = $settings->{htmlifiers})
    {   unshift @html, @$html;
    }
    $self->{HFM_htmlifiers} = \@html;

    # We will use header and field formatters
    $self->{HFM_field} = HTML::FromMail::Field->new(settings => $settings);
    $self->{HFM_head}  = HTML::FromMail::Head ->new(settings => $settings);

    $self;
}


my $attach_id = 0;

sub createAttachment($$$)
{   my ($self, $message, $part, $args) = @_;
    my $outdir   = $args->{outdir} or confess;
    my $decoded  = $part->decoded;

    my $filename = $part->label('filename');
    unless(defined $filename)
    {   $filename = $decoded->dispositionFilename($outdir);
        $part->label(filename => $filename);
    }

    $decoded->write(filename => $filename)
       or return ();

    ( url      => basename($filename)
    , size     => (-s $filename)
    , type     => $decoded->type->body

    , filename => $filename    # absolute
    , decoded  => $decoded
    );
}


sub fields() { shift->{HFM_field} }


sub header() { shift->{HFM_head} }


sub htmlField($$)
{   my ($self, $message, $args) = @_;

    my $name  = $args->{name};
    unless(defined $name)
    {   $self->log(ERROR => "No field name specified in $args->{input}.");
        $name = "NONE";
    }

    my $current = $self->lookup('part_object', $args);

    my $head;
    for($args->{from} || 'PART')
    {   my $source = ( $_ eq 'PART'   ? $current
                     : $_ eq 'PARENT' ? $current->container
                     : undef
                     ) || $message;
        $head      = $source->head;
    }

    my @fields  = $self->fields->fromHead($head, $name, $args);

    return [ map { +{ field_object => $_ } } @fields ]
        unless $args->{formatter}->onFinalToken($args);

    my $f       = $self->fields;
    join "<br />\n", map { $f->htmlBody($_, $args) } @fields;
}


sub htmlSubject($$)
{   my ($self, $message, $args) = @_;
    my %args = (%$args, name => 'subject', from => 'NESSAGE');
    $self->htmlField($message, \%args);
}


sub htmlName($$)
{   my ($self, $message, $args) = @_;

    my $field = $self->lookup('field_object', $args)
       or die "ERROR use of 'name' outside field container\n";

    $self->fields->htmlName($field, $args);
}


sub htmlBody($$)
{   my ($self, $message, $args) = @_;

    my $field = $self->lookup('field_object', $args)
       or die "ERROR use of 'body' outside field container\n";

    $self->fields->htmlBody($field, $args);
}


sub htmlAddresses($$)
{   my ($self, $message, $args) = @_;

    my $field = $self->lookup('field_object', $args)
       or die "ERROR use of 'body' outside field container\n";

    $self->fields->htmlAddresses($field, $args);
}


sub htmlHead($$)
{   my ($self, $message, $args) = @_;

    my $current = $self->lookup('part_object', $args) || $message;
    my $head    = $current->head or return;
    my @fields  = $self->header->fields($head, $args);

    return [ map { +{ field_object => $_ } } @fields ]
        unless $args->{formatter}->onFinalToken($args);

    local $" = '';
    "<pre>@{ [ map { $_->string } @fields ] }</pre>\n";
}


sub htmlMessage($$)
{  my ($self, $message, $args) = @_;
   { message_text => $args->{formatter}->containerText($args) };
}


sub htmlMultipart($$)
{  my ($self, $message, $args) = @_;
   my $current = $self->lookup('part_object', $args) || $message;
   return '' unless $current->isMultipart;

   my $body = $current->body;    # un-decoded info is more useful
   +{  type => $body->mimeType->type
    ,  size => $body->size
    };
}


sub htmlNested($$)
{  my ($self, $message, $args) = @_;
   my $current = $self->lookup('part_object', $args) || $message;
   return '' unless $current->isNested;

   my $partnr  = $self->lookup('part_number', $args);
   $partnr    .= '.' if length $partnr;

   [ +{ part_number => $partnr . '1' 
      , part_object => $current->body->nested
      }
   ];
}


sub htmlifier($)
{   my ($self, $type) = @_;
    my $pairs = $self->{HFM_htmlifiers};
    for(my $i=0; $i < @$pairs; $i+=2)
    {   return $pairs->[$i+1] if $type eq $pairs->[0];
    }
    undef;
}


sub previewer($)
{   my ($self, $type) = @_;
    my $pairs = $self->{HFM_previewers};
    for(my $i=0; $i < @$pairs; $i+=2)
    {    return $pairs->[$i+1] if $type eq $pairs->[$i]
                               || $type->mediaType eq $pairs->[$i];
    }
    undef;
}


sub disposition($$$)
{   my ($self, $message, $part, $args) = @_;
    return '' if $part->isMultipart || $part->isNested;

    my $cd   = $part->head->get('Content-Disposition');

    my $sugg = defined $cd ? lc($cd->body) : '';
    $sugg    = 'attach' if $sugg =~ m/^\s*attach/;

    my $body = $part->body;
    my $type = $body->mimeType;

    if($sugg eq 'inline')
    {   $sugg = $self->htmlifier($type) ? 'inline'
              : $self->previewer($type) ? 'preview'
              :                           'attach';
    }
    elsif($sugg eq 'attach')
    {   $sugg = 'preview' if $self->previewer($type);
    }
    elsif($self->htmlifier($type)) { $sugg = 'inline' }
    elsif($self->previewer($type)) { $sugg = 'preview' }
    else                           { $sugg = 'attach'  }

    # User may have a different opinion.
    my $disp = $self->settings->{disposition} or return $sugg;
    $disp->($message, $part, $sugg, $args)
}


sub htmlInline($$)
{  my ($self, $message, $args) = @_;

   my $current = $self->lookup('part_object', $args) || $message;
   my $dispose = $self->disposition($message, $current, $args);
   return '' unless $dispose eq 'inline';

   my @attach  = $self->createAttachment($message, $current, $args);
   return "Could not create attachment" unless @attach;

   my $inliner = $self->htmlifier($current->body->mimeType);
   my $inline  = $inliner->($self, $message, $current, $args);

   +{ %$inline, @attach };
}


sub htmlAttach($$)
{  my ($self, $message, $args) = @_;

   my $current = $self->lookup('part_object', $args) || $message;
   my $dispose = $self->disposition($message, $current, $args);
   return '' unless $dispose eq 'attach';

   my %attach  = $self->createAttachment($message, $current, $args);
   return "Could not create attachment" unless keys %attach;

   \%attach;
}


sub htmlPreview($$)
{  my ($self, $message, $args) = @_;

   my $current = $self->lookup('part_object', $args) || $message;
   my $dispose = $self->disposition($message, $current, $args);
   return '' unless $dispose eq 'preview';

   my %attach  = $self->createAttachment($message, $current, $args);
   return "Could not create attachment" unless keys %attach;

   my $previewer = $self->previewer($current->body->mimeType);
   $previewer->($self, $message, $current, \%attach, $args);
}


sub htmlForeachPart($$)
{  my ($self, $message, $args) = @_;

   my $part     = $self->lookup('part_object', $args) || $message;
 
   die "ERROR: foreachPart not used within part" unless $part;
   die "ERROR: foreachPart outside multipart"    unless $part->isMultipart;

   my $parentnr = $self->lookup('part_number',$args) || '';
   $parentnr   .= '.' if length $parentnr;

   my @parts   = $part->parts;
   my @part_data;

   for(my $partnr = 0; $partnr < @parts; $partnr++)
   {   push @part_data,
          { part_number => $parentnr . ($partnr+1)
          , part_object => $parts[$partnr]
          };
   }

   \@part_data;
}


sub htmlRawText($$)
{  my ($self, $message, $args) = @_;
   my $part     = $self->lookup('part_object', $args) || $message;
   $self->plain2html($part->decoded->string);
}


sub htmlPart($$)
{  my ($self, $message, $args) = @_;
   my $format  = $args->{formatter};
   my $msg     = $format->lookup('message_text', $args);

   warn("Part outside a 'message' block"), return ''
      unless defined $msg;

   $format->processText($msg, $args);
}


1;
