CGI und Perl
Description: Einführung in die CGI-Programmierung mit Perl im Internet. Vorkenntnisse der Programmierung sind notwendig.
Keywords: Multimedia WWW Internet Webdesign CGI Perl Programmierung

| ### Grundlagen CGI-Programmierung mit Perl von Prof. Jürgen Plate

## 4 CGI-Beispiele

Die folgenden Perl-Skripte sollen exemplarisch die Anwendung von Perl für CGI zeigen. Wichtig ist es auch, am Anfang dem CGI-Skript mitzuteilen, daß alle erzeugten Daten sofort zum Client gesendet und nicht gepuffert werden sollen. Bei längeren Berechnungen oder aufwendige Suche sieht der Empfänger dann schon mal die ersten Teilergebnisse. Dies geschieht mit

    $|=1;

Kontrollieren Sie auch den Pfad auf die Perl-Installation (`#!/usr/bin/perl`) der ersten Zeile der Programme. Passen Sie diesen gegebenenfalls an.

#### Decodierung der übergebenen Daten

Die Environment-Variablen REQUEST_METHOD, QUERY_STRING und CONTENT_LENGTH werden benötigt, um die Formulardaten zu übernehmen.

- Handelt es sich um die Methode POST, erfolgt das Einlesen der Daten von der Standardeingabe mit dem Perl-Aufruf read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}+1).
- Bei der Methode GET wird die Eingabe aus der Umgebungsvariablen QUERY_STRING gelesen.

Der Datenstring ist noch verschlüsselt. Perl liefert jedoch gute Routinen, ihn einfach zu decodieren. Der folgende Code aus einem CGI-Programm faßt das Vorgehen zusammen:

    if ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; }
    else { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}+1); }

    @nvpairs = split(/&/,$buffer);
    foreach $pair (@nvpairs)
      {
      ($name, $value) = split(/=/, $pair);
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $in{$name} = $value;
      }

Durch die Speicherung der Werte in einem assoziativen Array kann der Programmierer den Zugriff auf die einzelnen Werte flexibel handhaben. Beim Zugriff auf ein Feld mit dem Namen "Text" wird im Code mit `$in{'Text'}` darauf zugegriffen.

### 4.1 Grundroutinen

Das erste Perl-Skript erweitert das obige Grundschema. Es dekodiert die von GCI empfangenen Variablen und Werte, generiert eine HTML Seite mit diesen Informationen und schickt sie an den Absender zurück. Diesmal sind die einzelnen Teile als Unterprogramme strukturiert und es werden auch mehrfache Formular-Varlablen mit gleichem Namen berücksichtigt. Außerdem wird aus Sicherheitsgründen auch noch jede HTML-Kommentarzeile ausgeblendet, da diese einen Aufruf für Server-Side-Includes (SSI) enthalten könnte.

- `&InsertHeader;` erzeugt einen korrekten HTML-Header.
- `&InsertTrailer;` erzeugt den Schluß der HTML Seite.
- `&Parse;` ist die wichtigste Funktion. Sie zerlegt die CGI-Parameter wie im vorhergehenden Abschnitt.

    #!/usr/bin/perl
    # Perl-Programm zum Bearbeiten von HTML-Formularen
    # Verarbeitet GET und POST

    # Hash for Form Data
    my %entries = ();
    my $key;

    &InsertHeader("CGI generated text");
    %entries = &Parse;
    foreach $key (keys %entries)
      {
      print "entry\{\"$key\"\} = $entries{$key}<BR>\n";
      }
    &InsertTrailer;

    # Unterprogramme
    sub Parse
      {
      my (@pairs, $pair, $value, $name, $in, %entry);
      if ($ENV{'REQUEST_METHOD'} eq "GET")
        { $in = $ENV{'QUERY_STRING'}; }
      elsif ($ENV{'REQUEST_METHOD'} eq "POST")
        { read(STDIN, $in, $ENV{'CONTENT_LENGTH'}+1); }

      @pairs = split(/&/, $in);
      foreach $pair (@pairs)
        {
        # do the special character conversion (%xx)
        $pair =~ tr/+/ /;
        $pair =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C",hex($1))/ge;
        # prevent from SSI
        $pair =~ s/<!--(.|\n)*-->//g;
        ($name, $value) = split(/=/, $pair);
        if (defined($entry{$name}))
          { $entry{$name} .= ":" . $value; }
        else
          { $entry{$name} = $value; }
        }
        return %entry;
      }

    sub InsertHeader
      {
      my ($htmltitle) = @_;
      print "Content-type: text/html\n\n";
      print "<HTML>\n<HEAD>\n";
      print "<TITLE> $htmltitle </TITLE>\n</HEAD>\n";
      print "<BODY>\n";
      }

    sub InsertTrailer
      {
      print "</BODY>\n</HTML>\n";
      }

Zum Testen kann man das CGI-Script vom Browser aus in der URL-Zeile mit

    http://host.domain/cgi-bin/test.cgi?name1=wert1&name2=wert2 ...

aufrufen.

Ein weiteres Beispiel, das auch zum Testen verwendet werden kann ist das folgende Script, das alle Umgebungsvariablen ausgibt:

    #!/usr/bin/perl
    print "Content-type: text/html\n\n";
    print "<h1>ENVIRONMENT</h1>\n";
    foreach (keys %ENV)
      {
      print "<B>$_</B> = $ENV{$_}<br>\n";
      }

### 4.2 Automatischer E-Mail-Versand

Das folgende Script schickt eine Email mit festem Text an den angegebenen Adressaten. Der Surfer kann so z. B. Infos oder Preislisten per E-Mail anfordern. Das Formular dazu lautet:

    <form method="get" action="/cgi-bin/mailme.cgi">
    Absender-EMail-Adresse:
    <input type="text" name="mailadresse" size=30>
    <p>
    <input type="reset" value="Reset">
    <input type="submit" value="Send">
    </form>

An die angegeben Mailadresse werden dann die Infos geschickt, die als sogenanntes "Hier-Dokument" in das Programm eingebettet. Alternativ könnte man die Information auch aus einer Datei lesen.

Das Script selbst filtert aus der angegebenen Mailadresse alle "bösen" Zeichen heraus, damit kein Unheil angerichtet werden kann. Bei UNIX lassen sich mehrere Kommandos durch Strichpunkt getrennt oder als Pipe hintereinanderhängen. Das Perl-Skript nimmt eine Mailadresse entgegen und erzeugt daraus eine Kommandozeile:

    /bin/mail user@domain

Wenn der Benutzer beim Ausfüllen des Formulars statt einer Mailadresse beispielsweise die Zeichenkette "`user@domain; cd / ; rm -rf *`" eingibt, resultiert das in der Kommandofolge:

    /bin/mail user@domain; cd / ; rm -rf *

Auch wenn der Webserver und damit das Script mit relativ geringen Benutzerrechten läuft, kann doch einiges gelöscht werden.

    #!/usr/bin/perl
    my %entry = ();

    &InsertHeader("CGI generated text");
    %entry = &Parse;      # sub Parse siehe oben

    # Hackversuche verhindern
    # ';' und '|' durch Leerzeichen ersetzen
    $entry{'mailadresse'} =~ s/\;/ /ge;
    $entry{'mailadresse'} =~ s/\|/ /ge;
    # Nur die Zeichenkette bis zum ersten Leerzeichen nehmen
    ($entry{'mailadresse'}, @dummy) = split(/ /, $entry{'mailadresse'});
    # Nur einen Klammeraffen zulassen
    ($nx, $na, @dummy ) = split(/@/, $entry{'mailadresse'});
    $entry{'mailadresse'} = $nx . "@" . $na;

    # Mail versenden
    open(MAIL, "| /bin/mail $entry{'mailadresse'}");
    print MAIL<<END_OF_PRINT;

       Hier kommt die Mail-Nachricht

    END_OF_PRINT
    close(MAIL);

    print "Mail abgeschickt!<br>"
    &InsertTrailer;

### 4.3 CGI Mailer Skript

Eines der häufigsten Anwendungsfelder für CGI-Skripts ist das Weiterleiten von Formulardaten an eine E-Mail-Adresse, z. B. eine Bestell- oder "Meckerseite". Diesmal wird kein Mail-Clientprogram wie mail oder mailx verwendet, sondern der "mail transport agent" sendmail selbst. Im Gegensatz zu einem Mail-Client muß hier auch der Header selbst programmiert werden. Dem Benutzer wird folgendes Formular angeboten (Quelltext im Fenster):

Das zugehörige Perl-Skript sehen Sie unten. Zur Verwendung sind die folgenden Einstellung nötig:

1. Kontrollieren Sie den Pfad auf das sendmail-Programm (Variable `$mailer`). Passen Sie diesen gegebenenfalls an.
2. Geben Sie in der Variablen `$webmaster` die Adresse an, an die alle Briefe geschickt werden sollen. Der Klammeraffe muß - da von Perl als Arrayreferenz verwendet - durch einen "\" geschützt werden.
3. Geben Sie in der Variablen `$url` an, wohin der Benutzer nach dem Versand des Brief zurück geleitet werden soll. Soll dies die Seite sein, auf der sich das Mail-Formular befand, kann man auch den folgenden Befehl verdenden:

       $url = $ENV{'HTTP_REFERER'};

    #!/usr/bin/perl
    # Diese Variablen muessen Sie anpassen
    $mailer = "/usr/lib/sendmail -t -n";    # Name und Pfad des Mailers
    $webmaster = "webmaster\@host.domain";  # Mailadresse des Webmasters
    $url  = "/index.html";                  # Return-Pfad
    # ab hier kann alles bleiben

    my %FORM = ();

    # Formulardaten parsen
    %FORM = &Parse;

    &InsertHeader("Mailer-Antwort");

    # Senden E-Mail
    if ($FORM{'brief'} ne '')
      {
      open(FILE, "| $mailer");
      # Mail-Header schreiben (Leerzeile nach dem Header)
      print FILE "From: $FORM{'email'}\n";
      print FILE "To: $webmaster\n";
      print FILE "X-Remote-Host: $ENV('REMOTE_ADDR')\n\n";
      # Mail-Body schreiben
      print FILE "$FORM{'brief'}\n" ;
      close (FILE);
      print "Ihr Brief wurde gesendet!\n";
      }
    else
      {
      print "Fehler: leere Mitteilung <b>nicht</b> abgesendet!\n";
      }

    print "<a href=\"$url\">Zurück</a>\n";

    &InsertTrailer;

Umgekehrt kann es auch vorkommen, daß in einem Formular eine Datei angefordert wird, die dann per Mail geschickt werden soll. Bei Textdateien ist das nicht weiter kompliziert. Bei Binärdateien wird es schon schwieriger, denn die müssen als Attachment verschickt werden. Das Programm muß also:

1. Eine mehrteilige MIME-Nachricht generieren,
2. die gewünschte Datei mit BASE-64 umcodieren (damit sie nur aus ASCII-Zeichen besteht),
3. die codierte Datei in die E-Mail einbinden.

All dies leistet das folgende Programm, wobei die Liste der MIME-Typen den größten Teil des Programms einnimmt. Das Programm versucht nach der Windows-Methode, den MIME-Typen der zu sendenden Datei festzustellen. Es entscheidet nämlich nicht nach Dateinhalt, sondern nach der Endung des Dateinamens.

Das folgende Programm ist kein CGI-Skript, sondern erwartet als Parameter den Dateinamen und die E-Mail-Adresse des Empfängers, läßt sich aber sehr schnell in ein CGI-Script einbinden.

    #!/usr/bin/perl
    #
    # Automatisches Versenden einer E-Mail
    # Programmaufruf:
    # send.pl <Datei> <Empfaenger>
    #
    use strict;

    # Folgende Variablen muessen vor Inbetriebnahme konfiguriert werden:
    # ---------------------------------------------------------------------
    # Pfad zum sendmail-Programm
    my $MailProgram = '/usr/lib/sendmail -t';

    # Absender der Automatik-Mail
    #my $Mailfrom = 'automat@host.domain';
    my $Mailfrom = 'plate@netzmafia.de';

    # Betreff der E-Mail
    my $Subject = 'Automatische E-Mail';

    # Klartext-Nachricht
    my $Message = "Dies ist eine automatisch generierte E-Mail\n";
    $Message .= "mit einem Attachment.";

    # ---------------------------------------------------------------------
    ############## AB HIER MUSS NICHTS MEHR GEAENDERT WERDEN ##############

    my $Mailto = '';                 # Empfaenger der E-Mail
    my $file = '';                   # zu sendende Datei
    my $ext = '';                    # Datei-Extension
    my $fext = '';                   # MIME-Typ dazu
    my $buf = '';                    # Dateipuffer
    my $boundary = '';               # Mime-Begrenzer

    die "Dateiangabe fehlt!" if ($ARGV[0] eq '');
    die "Empfaengerangabe fehlt!" if ($ARGV[1] eq '');

    $file = $ARGV[0];
    $Mailto = $ARGV[1];

    my @BoundaryChars = (0..9, 'A'..'F'); # Zeichen fuer Begrenzer

    my %mime =                       # Mime-Typen
    (
           #-------------------------------------<TEXT>-----
           'HTML',		"text/html",
           'HTM',		"text/html",
           'STM',		"text/html",
           'SHTML',		"text/html",

            .
            .           # Liste gekuerzt, das vollstaendige
            .           # Programm finden Sie in den >Beispielen.
            .

           'SVR',		"x-world/x-svr",
           'WRL',		"x-world/x-vrml",
           'VRML',		"x-world/x-vrml",
           'VRJ',		"x-world/x-vrt",
           'VRJT',		"x-world/x-vrt",
    );

    # Begrenzer basteln
    srand($$);
    for (my $i = 0; $i++ < 24;)
      {
      $boundary .= $BoundaryChars[rand(@BoundaryChars)];
      }
    $boundary = "Next_Part_" . $boundary;

    #--------------------------------------------------- Send attatchments etc...
    open MAIL, "| $MailProgram" || die "Cannot open $MailProgram";
    print MAIL "To: $Mailto\n";
    print MAIL "From: $Mailfrom\n";
    print MAIL "X-Mailer: Fax-to-Mail-Gateway\n";
    print MAIL "MIME-Version: 1.0\n";
    print MAIL "Subject: $Subject\n";
    print MAIL "Content-Type: multipart/mixed; boundary=\"$boundary\"\n";
    print MAIL "\n";
    print MAIL "This is a multi-part message in MIME format.\n";

    print MAIL "--$boundary\n";
    print MAIL "Content-Type: text/plain; charset=\"iso-8859-1\"\n";
    print MAIL "Content-Transfer-Encoding: 8bit\n\n";

    print MAIL "\n\n$Message\n";

    # Attachment anhaengen
    ($ext) = $file =~ m/\.([^\.]*)$/;
    $ext =~ tr/a-z/A-Z/;
    $fext = $mime{$ext};
    if ($fext && $fext =~ /^text/)
      {
      print MAIL "--$boundary\n";
      print MAIL "Content-Type: $fext; charset=\"iso-8859-1\"; name=\"$file\"\n";
      print MAIL "Content-Transfer-Encoding: 8bit\n";
      print MAIL "Content-Disposition: attachment; filename=\"$file\"\n\n";
      open INPUT, "$file";
      print MAIL while (<INPUT>);
      close INPUT;
      }
    else
      {
      print MAIL "--$boundary\n";
      print MAIL "Content-Type: $fext; name=\"$file\"\n";
      print MAIL "Content-Transfer-Encoding: base64\n";
      print MAIL "Content-Disposition: attachment; filename=\"$file\"\n\n";

      open INPUT, "$file" || die "Cannot open [$file].";
      binmode INPUT;
      while(read(INPUT, $buf, 60*57))
        {
        print MAIL &encode_base64($buf);
        }
      close INPUT;
      }
    # Attachment Ende

    print MAIL "\n--$boundary--\n";
    print MAIL "\n";
    close MAIL;

    sub encode_base64
      {
      my $res = '';
      my $eol = "\n";
      my $padding;
      while (($_[0] =~ /(.{1,45})/gs))
        {
    	$res .= substr(pack('u', $1), 1);
    	chop $res;
        }
      $res =~ tr|` -_|AA-Za-z0-9+/|;       # translate from uuencode to base64
      $padding = (3 - length($_[0]) % 3) % 3;  # fix padding at the end
      $res =~ s/.{$padding}$/'=' x $padding/e if $padding; # Fix the end padding
      $res =~ s/(.{1,76})/$1$eol/g if (length $eol); # lines of at least 76 characters
      return $res;
      }

Natürlich gibt es dafür auch Perl-Module, die einem das Leben erleichtern. Sowohl zum Erstellen von MIME-Mails mit PERL als auch zum Parsen von MIME mit PERL gibt es Module, die das Schreiben von Programmen erleichtern. Die MIME-Tools (http://www.zeegee.com/ ermöglichen das Parsen und Erstellen von MIME-Nachrichten.

MIME::Lite ist das Modul schlechthin zum Erstellen von MIME-Mails, also ein idealer Ersatz für das Beispiel oben. Mit den Methoden in MIME::Lite wird das Erstellen vom Mails mit Attachment zum Kinderspiel, die Mail läßt sich einschließlich Header komplett zusammenstellen und wird dann einfach an den MTA (sendmail) übergeben.

Beispiel 1: Ein Bild verschicken auf einfachste Art und Weise

    #!/usr/bin/perl -w

    use strict;
    use MIME::Lite;

    my $msg = MIME::Lite->new(
                            From     =>'jack@daniels.org',
                            To       =>'johnny@walker.org',
                            Subject  =>'Look at this',
                            Type     =>'image/gif',
                            Encoding =>'base64',
                            Path     =>'schweinebild.gif'
                            );
    $msg->send();

Beispiel 2: Datei per Mail versenden - etwas komfortabler. Mit Begleittext; der Dateiname wird per Kommandozeile übergeben:

    #!/usr/bin/perl

    use MIME::Lite;
    use strict;

    if (@ARGV !=1 ) {die "usage: mailit.pl file\n" }

    # Pfad vom Dateinamen abtrennen
    my $dateiname=$ARGV[0];
    $dateiname =~ s|^.*/||;

    # Text der Mail
    my $text=qq~

    Dieses ist eine automatisch erstellte Mail und deshalb
    nicht sehr persoenlich ;-)

    Im Anhang finden Sie die Datei $dateiname.

    Viele Gruesse

       Johnny
    ~;

    my $msg = MIME::Lite->new(
        From       => 'johnny@walker.org',
        To         => 'jim@beam.de',
        Subject    => "Datei: $dateiname",
        Type       => "TEXT",
        Data       => $text );

    $msg->attach(                        # include binary
        Type     => 'octet/stream',      # binary type
        Path     => $ARGV[0],            # source file
        Encoding => 'base64',            # encoding scheme
        Filename => $dateiname );          # name after arrival

    $msg->send();                                  # send with sendmail
    # $msg->send('smtp','mailhost',Timeout=>60);   # or via smtp

### Der MIME-Parser

MIME::Parser ist ein Modul, mit dem einen MIME-Mail empfängerseitig geparst werden kann. MIME::Parser liefert Objekte vom Typ MIME::Entity zurück. Falls es sich um eine mehrteilige Nachricht handelt, werden entsprechend mehrere Entity-Objekt zurückgeliefert. Jedes Entity-Objekt besteht seinerseits wieder aus MIME::Head-Objekten und gegebenenfalls MIME::Body-Objekten. Zur Verdeutlichung hier die Skizze aus der Dokumentation.

Falls es sich um eine Multipart/Alternative-Nachricht handelt, enthält das zurückgegebene Entity-Objekt weitere Entity-Objekte, die ihrerseits Head- und Body-Objekte enthalten; das Ganze kann also durchaus rekursiv sein. Eine kleine Auswahl aus der Vielzahl der Methoden:

#### MIME::Parser

read [INSTREAM] | Diese Methode liest einen MIME-Stream und parst bzw. splittet diesen in seine einzelnen Bestandteile auf. Sie liefert ein MIME-Entity-Objekt zurück.
    $infile = 'testmail';
    $parser = MIME::Parser->new();
    open(INPUTSTREAM,"<$infile") or die $!;
    $entity = $parser->read(\*INPUTSTREAM);
parse_data [SKALAR VARIABLE] | Falls sich eine einzelne vollständige Nachricht bereits in einer Variablen befindet, bietet sich parse_data() an. Sie liefert ein MIME-Entity-Objekt zurück.
    $entity = $parser->parse_data($message);
    	# oder
    $entity = $parser->parse_data(\@message);
dump_skeleton | Dies ist eine Debugging Methode. Sie druckt die Struktur der MIME-Nachricht aus.
output_to_core | Diese Methode legt fest, ob die Attachments im Speicher (core) oder auf der Festplatte gespeichert werden sollen.
    # Keine Dateien auf der Platte speichern
    # Alle Daten müssen in den Hauptspeicher passen
    $parser->output_to_core('ALL');

    # Alle Daten werden auf der Festplatte zwischengelagert
    $parser->output_to_core();

    # Alles was grösser als 20000 Byte ist, wird auf der Festplatte zwischengelagert
    $parser->output_to_core(20000);
Falls die Dateien auf der Platte gespeichert werden, werden Dateien mit identischen Dateinamen überschrieben.
output_dir | Legt das Verzeichnis fest, in dem die geparsten Dateien (Attachments) gespeichert werden sollen, falls die Dateien auf der Platte zwischengespeichert werden sollen.
purge | Löscht die geparsten (temporären) Dateien (Attachments) auf der Festplatte.

#### MIME::Entity

print_header() | Gibt den kompletten Header der Entity aus.
    $entity->print_header(\*STDOUT);
print_body | Gibt den kompletten Body einschliesslich aller Teile (weitere Entities) kodiert aus.
    $entity->print_body(\*STDOUT);
parts() | Liefert die Anzahl der Entities zurück.
    $num_parts  = $entity->parts;
    print "Anzahl MIME-Parts: $num_parts\n";
head() | Gibt das aktuelle MIME::Head-Objekt zurück.
    $head = $entity->head();
bodyhandle() | Gibt das aktuelle MIME::Body-Objekt zurück.
    $body = $entity->bodyhandle();
Multipart/Alternative-Nachrichten sind keine Body-Objekte, sondern eigenständige Entity-Objekte.

#### MIME::Head

decode() | Geht durch alle Header-Felder und decodiert diese.
unfold() [FIELD] | Entfernt alle Newlines im angegeben Header-Feld. Wenn kein Feld spezifiziert wird, werden alle Header-Felder behandelt.
mime_type() | Ermittelt den MIME-Type. Wenn kein MIME-Type ermittelt werden kann, wird 'text/plain' zurückgeben.
    print "MIME-Type: ", head->mime_type() , "\n";
mime_encoding() | Versucht die Kodiermethode zu ermitteln. Wenn keine Methode ermittelt werden kann, wird '7-bit' zurückgegeben.
    print "Encoding: ",  $head->mime_encoding() , "\n";
mime_attr() [FIELD] | Setzt bzw. holt die Werte des MIME-Header-Felds.
    # Set
    $head->mime_attr("content-type" => "text/html");

    # Get
    print "Content-type: ",  $head->mime_attr('content-type'), "\n";
recommended_filename() | Liefert den empfohlenen Dateinamen für das Attachment oder 'undef' zurück.
get FIELD, INDEX | Ermittelt den Inhalt des Feldes.
    print "Subject: ", $head->get('Subject'), "\n";
Falls ein Field mehrfach auftauchen kann, z.B "Received", können Sie über den Index darauf zugreifen. Falls kein INDEX angegeben wird, wird im skalaren Kontext das erste Auftauchen des Feldes gewählt.
    print "Erster Mail-Router:  ", $head->get('received', 0), "\n";
    print "Letzter Mail-Router: ", $head->get('received',-1), "\n";
Falls kein INDEX angegeben wird, werden in einem Listen-Kontext alle Vorkommen des Feldes gewählt.
    @all_received = $head->get('Received');
count FIELD | Zählt die Anzahl der Vorkommen von FIELD.
    $hops = $head->count('Received');
Sie können diese Methode zum Testen auf das Vorkommen eines Feldes verwenden:
    if ($head->count('Subject')) {
    	print "Subject: ", $head->get('Subject');
    }

#### MIME::Body

path() | Liefert den Pfad zu der externen Datei zurück, in der das aktuelle Attachment gespeichert ist.
    if (defined($body->path))
      {
    	print "Daten auf Platte: ", $body->path() , "\n";
    	}
    else
      {
    	print "Daten im Speicher\n";
      }
print(FILEHANDLE) | Gibt den Body auf das angegebene Dateihandle aus. Falls kein Handle spezifiziert wird, wird das zuletzt gewählte Dateihandle verwendet.
    $body->print(\*STDOUT);
as_string | Gibt die Daten des Body als String zurück. Der Body wird vollständig in den Speicher gelesen. Die Daten werden nicht kodiert, d.h. falls es sich um ein z.B. um ein Bild handelt, werden die binären Daten ausgegeben. Falls es sich um einen leeren Body handelt, wird ein leerer String zurückgegeben und 'undef' im Misserfolgsfall.
    $string = $body->as_string;
    	# oder
    open(FH,">Datei") or die $!;
    print FH $body->as_string();
    close(FH) or die $!;
Diese Methode verwendet intern die Methode print(). Ihre Subklasse kann dieses Verhalten überschreiben.
as_lines | Gibt die Daten des Body als einen Array von Zeilen zurück. Die Zeilen werden durch Newlines getrennt. Es ist möglich, daß das Newline-Zeichen für die letzte Zeile fehlt. Diese Methode gibt im Misserfolgsfall und bei einem leeren Body eine leere Liste zurück. Die Daten werden nicht kodiert, d.h. falls es sich um ein z.B. um ein Bild handelt, werden die binären Daten ausgegeben.
    @lines = $body->as_lines();

### Multipart/Mixed Beispielnachricht

Die komplexe Beispielnachricht enthält etwas Text, der sowohl als Plain-Text als auch als HTML-Nachricht zur Verfügung steht und zwei angehängte GIF-Bildchen.

    Received: <snipp>
    Message-Id: <41A60DC8.6080004@fhm.edu>
    Date: Thu, 25 Nov 2004 17:52:24 +0100
    From: "Juergen Plate" <plate@fhm.edu>
    MIME-Version: 1.0
    To: plate@ee.fhm.edu
    Subject: Testmail
    Content-Type: multipart/mixed;
     boundary="------------040307040001050305060304"
    X-Virus-Scanned: by amavisd-new at mailrelay.ee.fhm.edu

    This is a multi-part message in MIME format.
    --------------040307040001050305060304
    Content-Type: multipart/alternative; boundary="------------7040001050D4B8DB02AFFE78"

    --------------7040001050D4B8DB02AFFE78
    Content-Type: text/plain; charset=ISO-8859-1; format=flowed
    Content-Transfer-Encoding: 8bit

    Hallo Jürgen,

    hier eine kleine Testmail mit zwei angehängten Bildchen.
    Viel Spaß damit.

    Grüße, Jürgen

    --------------7040001050D4B8DB02AFFE78
    Content-Type: text/html; charset=ISO-8859-1; format=flowed
    Content-Transfer-Encoding: 8bit

    <HTML>
    <BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#FF0000" ALINK="#000088">
    <FONT COLOR="#FFFF00"<Hallo Jürgen,</FONT>
    <P>

    hier eine kleine Testmail mit zwei angehängten Bildchen.
    Viel Spaß damit.

    <P>
    <BR>
    <HR WIDTH="100%">
    Grüße, Jürgen
    </BODY>
    </HTML>

    --------------7040001050D4B8DB02AFFE78--

    --------------040307040001050305060304
    Content-Type: image/gif; name="nobtn.gif"
    Content-Transfer-Encoding: base64
    Content-Disposition: inline; filename="nobtn.gif"

    R0lGODdhRQAtAMIAAAAAALIiIr6+vv8AAP///3CAkAAAAAAAACwAAAAARQAtAAAD/ii63P4w
    ysmIsPjqzLfv4CeGmQKcaKqubOu+70LAdG3flgkQfO//wKBwSPwJAAAZsshsOoeCwnKxzFGu
    2GxUmlTMdlateLwocK1VsnpsRirB14F8vha3d1S4RB7o++V1WHdvPBFzfoh9gIESd2h6Dnx9
    SJQAfwGMEYNeaZEDkwBmolKXmQ+OeYUNkgGjrgWJpg2bF50Lkp+tZg6wAZ9dsltTOqq3iLkS
    iAUQy81Rz87Ls1yEYXyhin3Jk9KmqMTW3L3IELmhszpUzNNunJDmogLZmOXcD+1HgmepVvC7
    8r60PYDHQFqSLsDQFaTmrpg/BvMGinNw0ISOhOzwgDMW8SBUNwURV01UYNBiRYvPFuL74nAk
    xID0OHqkaDIfSl77Nip46CDkTpcl0wHr8lEYMJbhOhZdENLf0qEnbeIcdgSSgFytIkT85bFb
    UJSUymSsJrLPUqYBncr6VrXYTqzbzHUteDHsqbENw4CEawhUvLU52+oFCXOAJ79/0UWDxhhv
    Lasv/8xhhWRUMKOP3DawlChR5cSAV9o6haTzZ9ChNQqecKfSq8tlGD7WzOwV6stsR7N2BXvq
    Ud291+SGHFwNLZZbbCtfzry5c6punEufTv2V6ErYs2vfzr2790qPvosfT567jBHoSaRfr159
    8fcKEgAAOw==
    --------------040307040001050305060304
    Content-Type: image/gif; name="yesbtn.gif"
    Content-Transfer-Encoding: base64
    Content-Disposition: inline; filename="yesbtn.gif"

    R0lGODdhRQAtAMIAAAAAAAD/AL6+vi6LVwAAgP///3CAkAAAACwAAAAARQAtAAAD/ii63P4w
    yrmKsPjqzLfv4CeGnQCcaKqubOu+r2LBdG3fmgkUfO//wKBwSPzpZLqicskcCgyn3IlHqVqv
    CwMUgJxasOBwQxv9esXoMJmrOaff1bV094ULAoGBnSFv0/d4AwRae09bc1RwgYKEe30zf2+L
    jAaFcmaRaJMEg5WOh36JYpudhJWnT6moq2OHmKJgpFqNdo9JdViys2+eCpcKbg14gQ66tGwL
    yFe2wQx5A4LCz4KlqCYNyhG9hmXAmQubjZOUtMnmaqCQsArTlHftnLu+DFzKKMnI27+3xdDQ
    nePilXNgzxybbL7S8RPmj1HAanyw0UsBLGIWV97W3Wk4ruDhrG0PChKEwOwbO44cBQ5MRa9l
    xYPzLnZb6AylP5UgIWS7542kwmYnbeIkyYsPRprghEKcwAJdlFC4gjYcqq2oTC6vokql9rFQ
    nJ8mFxD4t5QCq7Oq0hqdCZQBp7JeJ5TUaFReXLNH27bKedfnU3Va+6bZp1ewmLmBDTvFmjGx
    YixzDX2cTLmy5cuYLbPlkrmz58+Y/+q4Qbo0DkymU6tegYTEiNeuY8Oe/fhxAgA7
    --------------040307040001050305060304--

Struktur mittels dump_skeleton():

    Content-type: multipart/mixed
    Effective-type: multipart/mixed
    Body-file: NONE
    Subject: Testmail
    Num-parts: 3
    --
        Content-type: multipart/alternative
        Effective-type: multipart/alternative
        Body-file: NONE
        Num-parts: 2
        --
            Content-type: text/plain
            Effective-type: text/plain
            Body-file: NONE
            --
            Content-type: text/html
            Effective-type: text/html
            Body-file: NONE
            --
        Content-type: image/gif
        Effective-type: image/gif
        Body-file: NONE
        --
        Content-type: image/gif
        Effective-type: image/gif
        Body-file: NONE
        --

Noch deutlicher wird das anhand einer Skizze:

Alle MIME-Entities enthalten ein MIME::Head-Objekt und gegebenenfalls ein MIME::Body-Objekt. Falls es sich um "multipart/..."-Nachrichten handelt, enthält die Entity nur ein Head-Objekt. Es gibt kein Body-Objekt, sondern weitere Entity-Objekte (parts), die selbst wieder Head- und gegebenenfalls Body-Objekte enthalten. Die erste Entity wird auch als Top-Entity bezeichnet.

### Beispiel: Zugriff auf die Teile einer Multipart/Mixed Nachricht

Das folgende Beispiel wandert, ggf. rekursiv, durch alle Teile einer MIME-Nachricht und gibt ausgewählte Header- und Body-Informationen aus.

    #!/bin/perl

    use strict;
    use MIME::Parser;

    my $infile = 'test.eml';
    my $top_entity;
    my $pfad = '/home/plate';
    my $prefix = "Message";

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

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

    # MIME-Nachricht rekursiv durchlaufen
    &walk($top_entity);

    exit;

    sub parse_MIME_Stream #(Eingabedatei)
      {
      my $file = shift;
      my $parser = '';

      die "NO FILE  $!" unless defined $file;

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

      open(INPUT,$file) or die $!;
      my $top_entity = $parser->read(\*INPUT);
      close(INPUT) or die $!;

      return $top_entity;
      }

    sub walk #(Entity)
      {
      my $entity = shift if @_;
      return unless defined $entity;

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

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

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

    sub handle_head #(Header)
      {
      my $current_head = shift;
      $current_head->decode;
      $current_head->unfold;

      # Headerinformationen ausgeben
      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";
      print "Content-Disposition: ", $current_head->mime_attr('content-disposition'), "\n";
      print "Filename:            ", $current_head->recommended_filename(), "\n";
    }

    sub handle_body
      {
      my $current_body = shift;
      if (defined($current_body->path))
        {   # data is on disk:
        print "Data is stored on Disk: ", $current_body->path() , "\n";
        print '-' x 60 . "\n\n";

        # Your code goes here
        }
      else
        {
        # How to get the data
        # $Content = $current_body->as_string;
        # @Content = $current_body->as_lines();
        # $current_body->print(\*OUTSTREAM);
        # Your code goes here
        }

      }

    sub handle_Mail_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 "Return-Path:     ", $head->get('Return-Path'), "\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-Priority:      ", $head->get('X-Priority'), "\n";
      print "X-Mailer:        ", $head->get('X-Mailer'), "\n";
      print "X-Virus-Scanned: ", $head->get('X-Virus-Scanned'), "\n";
      print "Ref. Count:      ", $head->count('References'), "\n";
      if ($head->count('References') == 0)
        { print "New thread\n"; }
      else
        { print "Reply\n"; }

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

### 4.4 Programmaufrufe per CGI

Wie Sie inzwischen wissen, kann jeder User Ihrer Webseiten an ein CGI-Script schicken, was er will. Er braucht sich ja nicht an Ihr Formular halten und kann zudem dort auch eingeben, was ihm gefällt. Daher ist es äußerst gefährlich, Benutzereingaben an "system()" oder "exec()" weiterzureichen. Besser ist ein Formular, das nur die Parameter der Programme in Empfang nimmt und die Programme dazu gezielt aufruft. Vorher werden die Übergabeparameter natürlich auf Herz und Nieren geprüft. Das folgende Beispiel erlaubt den Aufruf einiger Netzwerk-Tools auf dem Server. Dazu wird folgendes Formular angeboten:

Im Quelltext:

    <FORM ACTION="/cgi-bin/nettool.cgi" METHOD="POST">
    <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=5>
    <TR><TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="N-PING">
    </TD><TD VALIGN=TOP>
    Ping auf einen Host oder von hier zu Ihrem Rechner, falls Sie nichts eingeben.</TD>
    </TR><TR>
    <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="N-TRACE">
    </TD><TD VALIGN=TOP>
    Traceroute von hier zu einem Host oder von hier zu Ihrem Rechner,
    falls Sie nichts eingeben.</TD>
    </TR><TR>
    <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="P-LOOK"></TD>
    <TD VALIGN=TOP>
    Einzelhost-Nameserverabfrage mit dem Programm "host". Bitte Hostname oder IP-Nummer
    angeben.</TD>
    </TR><TR>
    <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="P-LOOKA">
    </TD><TD VALIGN=TOP>
    Nameserverabfrage einer kompletten Domain mit dem Programm "host".
    Vorsicht! Das kann unter Umständen sehr viel Output ergeben.
    Bitte Domainnamen angeben.</TD>
    </TR><TR>
    <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="P-FING">
    </TD><TD VALIGN=TOP>
    Finger-Abfrage. Bitte User (name@host.domain) oder Domain (@host.domain)
    angeben.</TD>
    </TR><TR>
    <TD VALIGN=TOP><INPUT TYPE="RADIO" NAME="program" VALUE="N-UP" CHECKED></TD>
    <TD VALIGN=TOP>
    Uptime und Load.</TD>
    </TR><TR>
    <TD VALIGN=TOP>Host/User: </TD>
    <TD VALIGN=TOP>
    <INPUT TYPE="TEXT" NAME="target" VALUE="" SIZE=40 MAXLENGTH=100></TD>
    </TR><TR>
    <TD VALIGN=TOP> </TD>
    <TD VALIGN=TOP><INPUT TYPE="SUBMIT" VALUE=" Anfrage absenden "></TD>
    </TR>
    </TABLE>
    </FORM>

Im Programm wird ein Hash verwendet, der jeweils den Programmnamen einem Kommando zuordnet. Damit wird kein Kommando vom Formular aus gesendet, ebenso sind alle Kommandoparameter festgelegt. Das Programm kann auch leicht durch weitere Einträge im Hash erweitert werden - wozu nicht einmal große Perl-Kenntnisse notwendig sind. Die Namen im Hash haben noch eine weitere Funktion. Jeder Name beginnt mit einem Kennbuchstaben und einen Bindestrich. Die Kennbuchstaben haben folgende Bedeutung:

- "P-": Parameter ist zwingend erforderlich
- "N-": Parameter ist optional
- "R-": Es darf kein Parameter angegeben werden

Wenn bei einigen Kommandos kein Rechner angegeben wird, nimmt das Programm den als REMOTE_ADDR im Environment des Browsers eingetragenen Host. Neben der minutiösen Prüfung der Parameter wird hier noch eine zweite Maßnahme nötig. Da manche Netzdienste bei Ausfall oder Nichterreichbarkeit eines Servers zu langen Timeouts führen, hat das Script seine eigene Timeout-Behandlung, die für einen Abbruch nach spätestens 60 Sekunden sorgt. Dazu wird mit `$SIG{'ALRM'} =\&alarm_handle;` ein eigenes Unterprogramm als Alarm-Unterprogramm eingesetzt und mit `alarm(60);` der Timeout gesetzt.

    #!/usr/bin/perl
    $|=1;
    use strict;

    # Definieren Sie hier Ihre Kommandoliste
    my %commands = (
      'N-PING',  '/bin/ping -c 5 -w 5',
      'N-TRACE', '/usr/sbin/traceroute ',
      'P-LOOK',  '/usr/bin/host -a ',
      'P-LOOKA', '/usr/bin/host -l -v -t any ',
      'P-FING',  '/usr/bin/finger ',
      'R-UP',    '/usr/bin/uptime'
                );

    # Ab hier sind keine Aenderungen noetig
    ##################################################################

    my $PROGRAMM = '';   # Programmname (1. Wert des Hashes %commands)
    my $ZIELHOST = '';   # Eingabeparameter
    my $temp = '';       # Hilfvariable
    my $i = 0;           # Zaehlvariable
    my $content = '';    # Variablen zur Aufbereitung der CGI-Parameter
    my $key = '';
    my %fields = ();

    # to prevent runaways, call it quits after 60 seconds.

    $SIG{'ALRM'} =\&alarm_handle;
    alarm(60);

    print "Content-type: text/html\n\n";
    print "<HTML><HEAD><TITLE>Network Tools</TITLE></HEAD>", "\n";
    print "<BODY>", "\n";
    print "<H2>Netzmafia Network Tools</H2>", "\n";

    # Sicherheitsmassnahmen:
    #  1. Eingabe auf zulaessige Zeichen beschraenken
    #  2. Laengenueberpruefung der Eingabe
    if ($ENV{'REQUEST_METHOD'} ne "POST")
      { $temp = $ENV{'QUERY_STRING'}; }
    else
      { read(STDIN,$temp,$ENV{'CONTENT_LENGTH'}); }

    foreach (split("&",$temp))
      {
      /(.*)=(.*)/;
      $key = $1;
      $content = $2;
      $content =~ s/\+/ /g;
      $content =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $fields{$key} = $content;
      }

    $PROGRAMM = $fields{'program'};

    if ($fields{'target'} =~ /^([-\@\w.]+)$/ || $fields{'target'} eq "")
      {
      $ZIELHOST = $fields{'target'};
      }
    else
      {
      $ZIELHOST = "";
      print "Unzul\&auml;ssige Zeichen im Parameter. Abbruch!";
      print "</BODY></HTML>", "\n";
      exit 0;
      }

    if (length($ZIELHOST) > 255)
      {
      $ZIELHOST = "";
      print "Parameter zu lang (mehr als 255 Zeichen). Abbruch!";
      print "</BODY></HTML>", "\n";
      exit 0;
      }

    if ($commands{$PROGRAMM} eq "")
      {
      print "<H2>Fehler</H2>", "\n";
      print "Kein Kommando angegeben!\n";
      print "</BODY></HTML>", "\n";
      exit 0;
      }

    if ($ZIELHOST eq "")
      {
      if ($PROGRAMM =~ /^P-/)
        {
        print "<H2>Fehler</H2>", "\n";
        print "Das Kommando ben\&ouml;tigt eine Angabe im Eingabefeld!\n";
        print "</BODY></HTML>", "\n";
        exit 0;
        }
      else
        {
        if ($ENV{'REQUEST_METHOD'} eq "POST")
          {
          $ZIELHOST = $ENV{'REMOTE_ADDR'};
          }
        }
      }

    if ($PROGRAMM =~ /^R-/)
      {
      $ZIELHOST = "";
      }

    $temp = $commands{$PROGRAMM};
    # eventuelle Pfadangabe weg (Zeilenanfang bis zum letzen '/')
    $temp =~ s/^..*\///;
    print "Bitte etwas Geduld, bis die gew\&uuml;nschten";
    print "Daten ermittelt sind.<P>", "\n";
    print "<B>Ergebnisse von Kommando: $temp</B>", "\n";
    if ($ZIELHOST ne "")
      {
      print "<B> $ZIELHOST</B>", "\n";
      }
    print "<PRE>", "\n";
    open (INP, "$commands{$PROGRAMM} $ZIELHOST |");
    while (<INP>)
      {
      chop $_;
      print "$_\n";
      }
    close (INP);
    print "</PRE></BODY></HTML>", "\n";
    exit 0;

    # Unterprogramm fuer Timeout
    #
    sub alarm_handle
      {
      alarm(0);
      print "<P><H2>Fehler</H2>", "\n";
      print "Zeit\&uuml;berschreitung beim Bearbeiten, Abbruch!", "\n";
      print "</BODY></HTML>", "\n";
      exit 0;
      }

### 4.5 Server-Push

Der Server sendet ein Dokument, das aus mehreren Teilen besteht. Das jeweils letzte Teildokument tritt in der Anzeige an die Stelle des gerade angezeigten. Auf diese Weise lassen sich beispielsweise Webcam-Bilder kontinuierlich aktualisieren. Das Schema beim Server-Push ist recht einfach. Das Dokument wird durch einen festgelegten Separator in Teildokumente zerlegt (ähnlich wie die Attachments bei einer E-Mail). Das stellt sich dann insgesamt folgendermaßen dar:

    Content-type: multipart/x-mixed-replace;boundary=ich-bin-ein-kleiner-separator

    --ich-bin-ein-kleiner-separator
    Content-type: image/gif

    [Hier Bild 1]
    --ich-bin-ein-kleiner-separator
    Content-type: image/gif

    [Hier Bild 2]
    --ich-bin-ein-kleiner-separator
    Content-type: image/gif

    [Hier Bild 3]
    --ich-bin-ein-kleiner-separator--

Wenn das Multipart-Dokument per CGI-Programm generiert wird, kann durch eine Wartezeit zwischen den einzelnen Teilen auch der Ablauf wie bei einer Dia-Show gesteuert werden. Dudelt dann noch parallel ein Soundfile (per <EMBED>-Tag ausgelöst), wird es richtig nervig. Das folgende Beispiel holt sich nacheinander Bilder aus einen vorgegebenen Verzeichnis (`$IMAGEDIR`) und zeigt sie nacheinander an. Das Array `@images` enthält für jedes Bild einen Hash, der Bildname und Delay-Zeit enthält. Durch Anpassen des Bildverzeichnisses und der Bilderliste kann das Programm beliebig konfiguriert werden. Es können neben GIF- und JPG-Bildern auch HTML-Dateien abgespielt werden.

    #!/usr/bin/perl

    use strict;

    $|= 1;

    # ****************************************************************
    # Configuration - These need to be modified for your needs
    # ****************************************************************

    # wo liegen die Bilder
    my $IMAGEDIR = ".../bilder/freak";

    # Endlosschleife = 1, nur ein Durchlauf = 0
    my $Continuous = 1;

    # Liste der Bilder und Dauer der Wartezeit
    my @images = (
                  {'name' => "freak1.gif",'sleeptime' => 1},
                  {'name' => "freak2.gif",'sleeptime' => 1},
                  {'name' => "freak3.gif",'sleeptime' => 1},
                  {'name' => "freak4.gif",'sleeptime' => 1},
                  {'name' => "freak5.gif",'sleeptime' => 1},
                  {'name' => "freak6.gif",'sleeptime' => 1},
                  {'name' => "freak7.gif",'sleeptime' => 1},
                  {'name' => "freak8.gif",'sleeptime' => 1},
                  );

    # ****************************************************************

    my $ANHEAD="Content-type: multipart/x-mixed-replace;boundary=135792468TraLaLa00\n";
    my $BOUNDARY="\n--135792468TraLaLa00\n";
    my $ENDBOUNDS="\n--135792468TraLaLa00--\n";
    my $GIFTYPE="Content-type: image/gif\n\n";
    my $JPGTYPE="Content-type: image/jpeg\n\n";
    my $HTMLTYPE="Content-type: text/html\n\n";

    # ****************************************************************
    # Main Routine
    # ****************************************************************

    &animate;
    exit(0);

    # ****************************************************************
    # Animate - Routine to display server push animation
    # ****************************************************************

    sub animate
      {
      my ($TYPE, $image, $count, $image_file, $data, $bc);
      print $ANHEAD;
      print $BOUNDARY;
      $count = 0;
      while(1)
        {
        $image_file = "$IMAGEDIR/$images[$count]->{'name'}";
        $TYPE = $GIFTYPE if ($image_file =~ /gif$/i);
        $TYPE = $JPGTYPE if ($image_file =~ /jpg$/i);
        $TYPE = $HTMLTYPE if ($image_file =~ /html$/i);
        print $TYPE;
        open (DAT,$image_file) || print "cannot open $image_file: $!\n";
        while (read(DAT,$data,8192,$bc))
          { print $data; }
        close DAT;
        print $BOUNDARY;
        sleep($images[$count]->{'sleeptime'});
        $count++;
        if ($count == $#images+1)
          {
          last if (! $Continuous);
          $count = 0;
          }
        }
      print $ENDBOUNDS;
      }

Server-Push wird nur noch selten eingesetzt, da die Dynamik von Webseiten heutzutage meist mit Javascript/Ajax oder Flash-Navigation realisiert wird.

### 4.6 Fortschritts-/Ladeanzeige

Wenn ein CGI-Script länger braucht, z. b. bei der Aufbereitung von Daten für eine PDF-Ausgabe, wird der Benutzer schnell ungeduldig. Meist wird die sehr dezente Ladeanzeige des Browsers gar nicht wahrgenommen. Eine "echte" Aktivitäts- bzw. Ladeanzeige ist relativ aufwendig und müsste zudem mittels Server-Push oder Ajax realisiert werden. In vielen Fällen reicht jedoch eine Pseude-Ladeanzeige, die sich recht leicht realisieren lässt. Dazu sind zwei Dinge notwendig:

1. Ein animiertes Gif-Bild, das eine Ladeanzeige darstellt. Es ist wichtig, dass das Bild animiert ist, um eine echte Aktivität vorzutäuschen. Hier vier Beispiele:

2. Der HTML-Datei, die das CGI-Script aufruft wird eine Ladeanzeige-Seite vorgeschaltet, die neben den üblichen "Verzierungen" (Headerteil, Fussteil usw.) nur das o. g. Bild enthält und die per refresh-Tag auf das eingentliche Script weiterleitet.

Solange das Script keine Antwortseite erzeugt und gesendet hat, wird die vorgelagerte Seite mit dem animierten GIF angezeigt und der Benutzer bei Laune gehalten. Diese Seite kann nach folgenden Muster erstellt werden:

    <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
    <html>
    <head>
     <meta http-equiv="content-type" content="text/html;charset=iso-8859-1">
     <!-- Hier kommt die wichtige Zeile -->
     <meta http-equiv="refresh" content="0; URL=http://www.netzmafia.de/cgi-bin/tolles-script.cgi">
     <!-- der Rest ist frei gestaltbar -->
     <title>Ladeanzeige-Seite</title>
    </head>
    <body text="#000000" bgcolor="#FFFFFF" link="#000000" vlink="#000000" alink="#000000">
      <div align="center">
      <p> </p>
      <p> </p>
      <h2>Generiere Wichtige Daten</h2>
      <p> </p>
      <p> </p>
      <!-- und hier das animierte GIF-Bild -->
      <img src="loading.gif">

      <p> </p>
      <p> </p>
      <p> </p>
      <p> </p>
      </div>
      </body>
    </html>

### 4.7 Verwendung einer Konfigurationsdatei

In vielen Scripten möchte man Werte, die an verschiedenen Stellen oder sogar in unterschiedlichen Scripten immer wieder benötigt werden, in eine externe Konfigurationsdatei auslagern. Dies kann auf verschiedene Weise geschehen, beispielsweise durch ein Perl-Modul, das die Konfiguration in Form von Variablendefinitionen enthält. Oder die Konfiguration wird aus einer Datei eingelesen. Das folgende Beispiel beschreibt, wie man aus einer solchen Datei die Werte liest, und in einem Hash ablegt. Die Konfigurationsdatei folgt dem Aufbau von Formularen und enthält in jeder Zeile ein Name-Wert-Paar in der Form `<Name>=<Wert>`.

Beispiel für eine Konfigurationsdatei:

    # Konfigurationsdatei fuer tollesscript2
    Hello = Hallo Du da

    Schriftfarbe = #DFDFDF
    Schrift = Arial,Verdana

    Schluss = Ende

Das folgende Unterprogramm liest die Datei ein und füllt einen Hash. Falls die Datei nicht existiert oder nicht gelesen werden kann, wird das Programm abgebrochen.

    sub ReadConfig # Parameter: Dateiname
      {
      my %wert;          # Daten-Hash
      my $file = shift;  # Dateiname
      my ($name,$val);
      open(CONF, '<', $file) or die "Kann die Datei $file nicht öffnen: $!";
      while (<CONF>)
        {
        chomp;              # Newline entfernen
        s/^\s+//;           # Leerzeichen am Anfang entfernen
        s/\s+$//;           # Leerzeichen am Ende entfernen
        next if (m/^#/);    # Kommentare ignorieren (Zeile beginnt mit #!)
        next if (m/^$/);    # Leerzeilen ignorieren
                            # aufspalten in Paare, Leerzeichen rechts und
                            # links vom "=" ignorieren
       ($name, $val) = split(/\s*=\s*/, $_, 2);
       $wert{$name}=$val;
       }
      close (CONF);
      return(%wert);
      }

Hinweis: Die Behandlung von Kommentarzeilen ist restriktiver als bei Perl; bei der Konfigurationsdatei muss das Kommentarzeichen "#" am Zeilenanfang stehen. Sonst könnte man den Farbwert, der auch mit "#" beginnt, nicht in der Konfiguration unterbringen.

Zum Testen kann man folgendes Hauptprogramm verwenden:

    #!/usr/bin/perl

    my %Conf = ReadConfig("conf.dat");
    foreach my $key (keys(%Conf))
      { print "$key = $Conf{$key}\n"; }

### 4.8 Templates

Bisher wurde munter HTML und Perl-Code gemischt (natürlich nicht wirklich, da die HTML-Texte ja per "print" ausgegeben wurden). Aber Änderungen im HTML bedeuteten Änderungen im Programm und mal ehrlich: Würden Sie einen Webdesigner an Ihren Perl-Code lassen? Deshalb ist es durchaus sinnvoll, zu überlegen, wie man den HTML-Text aus dem Programm verschwinden lassen und in externe Datein auslangern kann. Das Hindernis sind eigentlich nur die im HTML-Text eingesteuten Perl-Variablen bzw. deren Inhalte.

Die Antwort auf die Problemstellung sind sogenannte Templates. Im Folgenden wird gezeigt, wie man HTML-Templates in Scripten nutzt und die darin enthaltenen Platzhalter für Variablen mit jenen des Scripts ersetzt. Dieses Vorgehen bietet sich insbesondere dann an, wenn beispielsweise mehrere Personen an einem Projekt arbeiten (Webdesigner und Programmierer). Auch, wenn man mehrere unterschiedliche Layouts für ein Script verwenden möchte oder das Gestalten solcher Layouts von der Programmierung trennen will.

In der Layout-Datei stehen Platzhalter (Templates) für variable Werte, die dann vom Script eingesetzt werden. Die Templates werden in eindeutige Zeichenfolgen "geklammert", damit die Ersetzung fehlerfrei erfolgen kann. Welche Markierung gewählt wird, bleibt dem Programmierer überlassen. Einige Beispiele dazu:

- gleiche Zeichen davor und dahinter, z. B. `%%Variablenname%%`
- unterschiedliche Zeichen davor und dahinter, z. B. `[%Variablenname%]`
- HTML-Kommentar-Tags: `<!--Variablenname-->`

Die Template-Ersetzungen werden am Besten in einem Hash in der Form `Variablenname => Wert` gespeichert. Der Hash kann ggf. auch von einer Datei eingelesen werden. Das Unterprogramm `replace_tmpl` hat den Namen der HTML-Datei und den oben erwänten Hash als Parameter und ist damit genügend flexibel einsetzbar. Rückgabewert ist der bearbeitete Text. Der Variablenname wird in `%%...&&` "geklammert". Beachten Sie, dass eine Referenz des Template-Hash an das Unterprogramm übergeben wird:

    sub replace_tmpl
      {
      my ($datei, $template) = @_; # Dateiname und Template-Hash
      my $text;                    # Dateiinhalt
      local $/;                    # Zeilenende = undef
      open(DAT, '<',$datei) or die "....";
      $text = <DAT>;               # Dateiinhalt als String
      close(DAT);
      # Nun erfolgt die Ersetzung in einem Rutsch
      # nicht vorhandene Templates werden geloescht
      $text =~ s{%%(.*?)%%}
                {exists($template->{$1})
                        ? $template->{$1}: ''}egsx;
      return $text;
      }

Zum Testen wird folgendes Hauptprogramm verwendet:

    #!/usr/bin/perl
    use warnings;
    use strict;

    my %Tpl = ("eins" => "Jim",
               "zwei" => "Jack",
               "drei" => "Johnny");

    my $res = replace_tmpl("template.html",\%Tpl);
    print "$res\n";

Die HTML-Quelldatei zum Ausprobieren hat folgenden Inhalt:

    <HTML>
    <HEAD><TITLE>Template-Test</TITLE></HEAD>
    <BODY>
    <H2>%%eins%%, %%zwei%% und %%drei%%</H2>

    Es waren einmal drei stolze Ritter, %%eins%%,
    %%zwei%% und %%drei%%. %%eins%% war gut im
    Reiten, %%zwei%% war ein Meister des Schwertes
    und %%drei%% kannte einige Zaubersprüche.
    <p>
    und so weiter ...
    </BODY>
    </HTML>

Das Ergebnis des Programmlaufs zeigt die Ersetzung:

    <HTML>
    <HEAD><TITLE>Template-Test</TITLE></HEAD>
    <BODY>
    <H2>Jim, Jack und Johnny</H2>

    Es waren einmal drei stolze Ritter, Jim,
    Jack und Johnny. Jim war gut im
    Reiten, Jack war ein Meister des Schwertes
    und Johnny kannte einige Zaubersprüche.
    <p>
    und so weiter ...
    </BODY>
    </HTML>

Die Arbeit mit Templates beschränkt sich nicht auf Webseiten, auch die Anpassung eines Programms an eine bestimmte Sprache kann so erfolgen.

### 4.9 Die Optimierung von CGI-Programmen durch Libraries

Die oben vorgestellten CGI-Programme kann man eigentlich nicht weiter optimieren. Muß man allerdings mehrere Programme erstellen, bietet es sich an Libraries zu benutzen. Diese können in Form eines Moduls oder einer Perl-Datei auftrete, in der ständig benötigte Unterprogramme definiert wurden. So kann man z. B. die oben verwendeten Unterprogramme in eine Datei schreiben und durch die Perl-Anweisung require einfügen. Einzige Bedingung ist, daß das Programm-Modul einen Wert zurückliefert, was man mit der folgenden letzten Zeile erreichen kann:

    1;

oder auch `return(1);`.
So gelangt man nach und nach zu einer Library an allgemeinen Funktionen, welche die einzelnen CGI-Programme sehr einfach und transparent machen.

Die hier besprochenen Programme und viele weitere Beispiele finden sie in der Beispielsammlung.

### Wie geht's weiter?

Im Skript werden in Kapitel 7 weitere CGI-Anwendungen behandelt:

- Session-Tracking
- CGI-Upload
- CGI und geschützte Verzeichnisse

Im Skript zur Netzwerk-Programmierung finden Sie eine Anleitung zur Netzwerkprogrammierung in Perl:

- Erste Perl-Server und Clients
- Parallelität und Signale
- Netzwerk-Funktionen in Perl
- Einfache Server und Clients in Perl
- Fork-Server und -Clients in Perl
- Perl-Clients für Standard-Dienste

Zum vorhergehenden Abschnitt | Zum Inhaltsverzeichnis | Zum nächsten Abschnitt

###### Copyright © FH München, FB 04, Prof. Jürgen Plate

###### Letzte Aktualisierung: 25. Feb 2013