use strict;
use warnings;
use MIME::Parser;

my $infile = 'test.eml';
my $top_entity;
my $pfad = '/tmp/perl/Mail';
my $prefix = "Message";

# Datei mit MIME-Nachricht einlesen und parsen
$top_entity = parse_mail($infile);

# Mail_Header der TOP-Entity (Nachricht) ausgeben
do_header($top_entity);

# MIME-Nachricht rekursiv durchlaufen
walk_through($top_entity);

exit;


sub parse_mail
  # Parser-Objekt initialisieren
  {
  my $file = shift;
  die "Oops: keine Datei angegeben\n" unless defined $file;

  # Neues Parser-Objekt
  # Daten auf Festplatte speichern
  my $parser = MIME::Parser->new(output_to_core => 'NONE',
                                 output_dir     => $pfad,
                                );
  # Alternativ:
  #  $parser = MIME::Parser->new();
  #  $parser->output_to_core('NONE');
  #  $parser->output_dir($pfad);
  $parser->output_prefix($prefix);

  open(INPUT,$file) or die "Oops: $!\n";
  my $top_entity = $parser->read(\*INPUT);
  close(INPUT) or die "Oops: $!\n";
  return $top_entity;
  }

sub do_header
  {
  my $entity = shift;
  # $entity->print_header(\*STDOUT);

  my $head = $entity->head();
  $head->decode;
  $head->unfold;

  # Mail-Nachrichten-Header-Felder ausgeben
  print "Subject:      ", $head->get('Subject')      , "\n";
  print "From:         ", $head->get('From')         , "\n";
  print "Sender:       ", $head->get('Sender')       , "\n";
  print "Return-Path:  ", $head->get('Return-Path')  , "\n";
  print "Date:         ", $head->get('Date')         , "\n";
  print "To:           ", $head->get('To')           , "\n";
  print "Organization: ", $head->get('Organization') , "\n";
  print "Status:       ", $head->get('Status')       , "\n";
  print "Message-ID:   ", $head->get('Message-ID')   , "\n";
  print "Precedence:   ", $head->get('Precedence')   , "\n";
  print "References:   ", $head->get('References')   , "\n";
  print "X-Original-To:", $head->get('X-Original-To'), "\n";
  print "X-Priority:   ", $head->get('X-Priority')   , "\n";
  print "X-Mailer:     ", $head->get('X-Mailer')     , "\n";
  print "Ref. Count:   ", $head->count('References') , "\n";
  if ($head->count('References') == 0)
    { print "Neue E-Mail\n"; }
  else
    { print "Antwort-Mail (Reply)\n"; }

  print "\nNumber of Hops: " , $head->count('Received') , "\n";
  my @hops = $head->get_all('Received');
  for my $x (0 .. $#hops)
    {  print "Mail-Host [" , $x + 1, "] $hops[$x] \n";  }
  print "\n\n";
  }

sub walk_through
  {
  # Parameter pruefen
  my $entity = shift if @_;
  return unless defined $entity;

  # Head extrahieren
  my $head = $entity->head();

  # mehrteilige Nachricht
  if ($head->mime_type() =~ m/multipart/i)
    { 
    my $num_alt_parts  = $entity->parts();
    my $current_entity;

    # alle Teile der Nachricht rekursiv abarbeiten
    for my $i (0 .. $num_alt_parts)
      {
      $current_entity = $entity->parts($i);
      walk_through($current_entity);
      }
    }
  # einteilige Nachricht  
  else
    {
    handle_head($head) if (defined $head);
    my $body = $entity->bodyhandle();
    handle_body($body) if (defined $body);
    }
  }

sub handle_head
  {
  my $current_head = shift;
  $current_head->decode;
  $current_head->unfold;

  print "Headerinformationen\n";
  print "~~~~~~~~~~~~~~~~~~~\n";
  print "MIME-Type:           ", $current_head->mime_type(), "\n";
  print "Encoding:            ", $current_head->mime_encoding(), "\n";
  print "Content-type:        ", $current_head->mime_attr('content-type'), "\n";
  print "Charset:             ", $current_head->mime_attr('content-type.charset'), "\n"
    if (defined $current_head->mime_attr('content-type.charset'));
  print "Content-Disposition: ", $current_head->mime_attr('content-disposition'), "\n"
    if (defined $current_head->mime_attr('content-disposition'));
  print "Filename:            ", $current_head->recommended_filename(), "\n"
    if (defined $current_head->recommended_filename());
  }

sub handle_body
  {
  my $current_body = shift;
  if (defined($current_body->path))
    {
    print "Daten werden auf Platte gespeichert: ", $current_body->path() , "\n";
    print '-' x 60 . "\n\n";

    # Hier kommt der Programmcode zur Weiterbearbeitung hin
    
    }
  else
    {
    print "Daten werden im Arbeisspeicher bearbeitet\n";
    print '-' x 60 . "\n\n";

    # Wie kommt man an die Daten?
    #
    # 1. Moeglichkeit: $Content = $current_body->as_string;
    # 2. Moeglichkeit: @Content = $current_body->as_lines();
    #
    # oder einfach ausgeben:
    # $current_body->print(\*STDOUT);
    
    # Hier kommt der Programmcode zur Weiterbearbeitung hin
    
    }
  }