Mehr XML (Linux-Magazin, März 2000)

Wie versprochen: Heute gibt's die Testsuite, die in XML spezifizierte Testfälle durchackert und Live-Ergebnisse mit Erwartungswerten vergleicht.

Das heutige Perl-Skript hat es in sich: Es lässt sich nicht nur zum Ablaufen einer Testsuite gebrauchen, sondern ganz allgemein, um eine Reihe von Webdokumenten abzuklappern und eventuell gefilterte Ergebnisse auszudrucken. Das Konto unserer Online-Bank abfragen, die zunächst immer nach Kontonummer und Passwort fragt? Zugriff auf Echtzeit-Börsenkurse, denen immer eine Login-Seite vorangeht? Alles kein Problem mit dem heute vorgestellten Modul.

Eine Testsuite besteht aus einer Reihe von Testfällen, die jeweils ein oder mehrere Webdokumente vom Netz holen oder auch gerne mal lokale Skripts aufrufen. Das Ergebnis wird wahlweise mit einem regulären Ausdruck oder einer Referenzdatei verglichen -- oder einfach gefiltert ausgegeben.

Testfälle in XML

Listing TESTCASES.xml zeigt die XML-Beschreibung unserer Test-Suite. Der erste Testfall, der ab Zeile 4 definiert ist, trägt den Namen Test, findet im Verzeichnis TEST1 statt und wird einen Web-Request für einen URL aussenden, der, ganz wie letzten Monat in [1] beschrieben, in XML in der Datei test.xml im Verzeichnis TEST1 steht. Wie besprochen ist der XML-fähige Web-Agent ein echter Tausendsassa, ob http oder https, GET oder POST, mit Parametern oder ohne, mit Passwort, Cookies, Extra-Headern -- alles geht. Im Beispiel steht in test.xml der einfache Request

    <request url="http://localhost/index.html">
    </request>

der schlichtweg die Startseite meines lokalen Webservers holt. Der Testfall besteht nun darin, dass das Ergebnis des Requests mit dem Inhalt einer Referenzdatei test.ref verglichen wird, die das Testprogramm, falls sie noch nicht existiert, ohne Murren selbst anlegt. Bevor's nun an die Details der Beschreibungssprache oder gar die Implementierung des Perl-Moduls geht, zunächst die Ausgabe des Testprogramms aus Listing run.pl für den ersten Testfall:

    Test .................. CREATED test.ref ok

Beim nächsten Lauf von run.pl existiert test.ref bereits im Testfallverzeichnis TEST1 und enthält das Ergebnis des letzten Testlaufs. Wenn der Webserver jetzt immer noch den gleichen Inhalt liefert, lautet die Ausgabe

    Test .................. ok

und der Test ist bestanden. Nun zum detaillierten Aufbau der Beschreibungssprache.

Ein testcase als XML-Element führt die Attribute name und dir, die einen beliebigen Namen für den Test festlegen und das Verzeichnis, in welches das Testprogramm wechselt, um den Test auszuführen. Innerhalb eines Testfalls stehen ein oder mehrere request-Elemente, die jeweils entweder ein mit XML beschriebenes Web-Dokument holen oder lokal ein Skript ausführen und dessen Ausgabe weiterverarbeiten. Der Wert des xml-Attributs eines request-Elements gibt die XML-Datei an, die die Parameter für den Request beschreibt -- ganz wie letzten Monat vorgestellt. Soll der Request alternativ ein lokales Skript ausführen, steht dessen Name als Wert im function-Attribut (wie im Testfall 3 in Zeile 21 in TESTCASES.xml angegeben).

Wie gesagt kann ein testcase nicht nur ein, sondern gerne auch mehrere request-Elemente enthalten. Die Requests werden in diesem Fall nacheinander ausgeführt und Cookies durchgeschleift. Das Ergebnis bestimmt der letzte Request in der Reihe. Damit wir notfalls zwischen den Einzel-Requests einschreiten können um während des Testlaufs noch schnell Daten zu ändern, kann ein request auch noch einen sogenannten fixup-Handler enthalten. Dieses vom Testprogramm aufgerufene Skript erhält das Ergebnis des letzten Requests in die Standardeingabe gepustet. Zum Beispiel kann so ein fixup-Skript aus dem Ergebnis eines Einzelrequests eine dynamisch erzeugte ID herausfiltern und in die XML-Beschreibung des nächsten Requests einarbeiten, indem es einfach eine Stringersetzung in der entsprechenden XML-Datei durchführt -- doch dies nur in Ausnahmefällen. Tabelle 1 fasst die Elemente einer Testsuitenbeschreibung mit ihren zulässigen Attributen zusammen.

Tag Attribut Beschreibung
testcase name Name des Tests
dir Verzeichnis, in dem der Test lagert
log file Name der Log-Datei
request xml Name einer XML-Datei mit dem Request
function Name eines Skripts, das den Test ausführt
fixup Am Ende des Requests mit dem Request-Ergebnis optional aufgerufenes Skript
expect reffile Referenzdatei für das Ergebnis des Requests
regex Regulärer Ausdruck zum Abgleich des Ergebnisses
print filter Filter-Skript, das ein Ergebnis ausgibt
Tabelle 1: Elemente der Testsuitenbeschreibung

Wie gezeigt darf eine Testsuite außer den Testfällen auch noch ein log-Tag mit einem file-Attribut enthalten, dessen Wert den Namen der Logdatei angibt, in dem das Testprogramm detailliertere Informationen ablegt, falls mal ein Testfall schiefgeht. So steht dort für den Fall, dass ein Ergebnis nicht mit dem angegebenen regulären Ausdruck übereinstimmte oder nicht dem Inhalt der Referenzdatei entsprach, was genau erwartet und erhalten wurde.

Das den request-Tags folgende expect-Tag definiert, ob das Request-Ergebnis mit einem regulären Ausdruck oder einer Referenzdatei zu vergleichen ist und setzt dementsprechend das regex- oder das reffile-Attribut.

Die regulären Ausdrücke als Werte des regex-Attributs verstehen sich als vollständige Perl5-Regexen, einschließlich der Querstriche (Slashes) und eventueller Modifizierer:

    "/abc/"         # "abc"
    "m#abc#"        # "abc" alternative Schreibweise
    "/^abc/mi"      # "abc" gross/klein, Zeilenanfang
    "/&lt;H1&gt;/i" # "<H1>", "<h1>"

Tauchen in den Attributwerten irgendwelche Sonderzeichen wie &, <, >, " oder \ auf, müssen sie wie in HTML mit &amp;, &lt;, &gt;, &quot; und &#092; maskiert werden. Und natürlich erlaubt XML zwischen den Tags auch Kommentare, die das Testprogramm geflissentlich ignoriert (<!-- ... -->).

Soll nichts mit früheren Testläufen verglichen, sondern einfach nur ein Ergebnis gefiltert ausgegeben werden, ist statt dem expect- ein print-Tag im Testfall anzugeben, dann erscheint das Ergebnis auf der Standardausgabe des Testsuitenprogramms, nachdem es durch das im filter-Attribut angegebene Filterskript gelaufen ist.

Die DTD, die angibt, wie ein gültige Testsuite-Dokumente auszusehen hat, zeigt Listing testsuite.dtd -- nicht dass der Parser Wert darauf legte, nur der Klarheit halber sei sie dargestellt: Zeile 1 zeigt, dass einem optionalen log-Tag eine Reihe von testcase-Definitionen folgt.

Nun zu den restlichen Testfällen in TESTCASES.xml: Der zweite Testfall ab Zeile 11 mit dem Namen Login + Welcome gibt zwei mittels XML spezifizierte Web-Requests hintereinander an: Zunächst meldet das Testprogramm sich mit login.xml bei einem Webservice an, dann holt es mit getit.xml Daten ab (Request-Dateien login.xml und getit.xml nicht abgedruckt). Enthält das Ergebnis von login.xml beispielsweise eine dynamisch erzeugte Session-ID des Webservice, die der Request in getit.xml dringend benötigt, lässt man, wie in TESTCASES.xml in Zeile 14 angegeben, einen fixup-Handler einspringen, der die ID extrahiert und sie als zusätzlichen Parameter in getit.xml einfügt, bevor das Testprogramm mit getit.xml im Testfall fortschreitet (fixup.pl nicht abgedruckt). Der Testfall erwartet mit dem regulären Ausdruck /test page/i den String "Test Page" -- in beliebiger Groß- und Kleinschreibung -- irgendwo auf der Ergebnisseite.

Der dritte Testfall in TESTCASES.xml spezifiziert ab Zeile 19 statt einem Web-Request schlicht ein Testscript doit.pl im Verzeichnis TEST1 und erwartet von ihm eine Ausgabe, auf die der reguläre Ausdruck /hallo/ passt.

Der vierte Testfall ab Zeile 15 nutzt das print-Tag mit dem filter-Attribut, um das Ergebnis eines Webrequests nicht mit vorgegebenen Daten abzugleichen sondern über eine Filter-Funktion auszugeben. Listing filter.pl zeigt die Implementierung der Funktion, die im Verzeichnis TEST1 residiert, ihre Eingabe liest und schlichtweg die Anzahl der erhaltenen Zeilen ausgibt.

Wie funktioniert's?

Wie funktioniert das Ganze nun? Listing run.pl zeigt die Implementierung des Testprogramms, die ganze 8 Zeilen lang ist, da das ganze Gehirnschmalz im Modul XmlTestSuite residiert (Listing XmlTestSuite.pm). Das Skript run.pl erzeugt lediglich ein neues XmlTestSuite-Objekt, ruft dessen parse-Methode mit dem Namen der Testsuitenbeschreibungsdatei TESTCASES.xml auf und rattert anschließend mit der run-Methode alle definierten Testfälle durch, wobei es folgende Ausgabe erzeugt:

    Test .................. ok
    Login + Welcome ....... ok
    Testfunktion .......... ok
    Testfilter ............ 
        51 lines in index.html - ok
    4 tests OK

Listing XmlTestSuite.pm zeigt die Implementierung des Moduls XmlTestSuite. Die Zeilen 8 bis 12 ziehen später benutzte Perl-Module hinzu: Das letzten Monat hier besprochene XmlUserAgent, des weiteren HTTP::Cookies, der Cookie-Topf für HTTP-Requests, weiter XML::Parser, das unser XML analysiert und schließlich IO::File für objektorientierte Filehandles. use strict setzt nützliche Restriktionen in Perl durch und hilft, Leichtsinnsfehler zu vermeiden.

Zeile 15 setzt die Konstante COLUMN_WIDTH, die später die Breite der Ausgabespalten festlegt, auf den Wert 40.

Der Konstruktor ab Zeile 20 setzt als Instanzvariablen lediglich die Anzahl der erfolgreichen (ok) und fehlgeschlagenen (notok) Tests auf den Wert 0 .

Die parsefile-Methode ab Zeile 29 nimmt den Namen der XML-Datei für die Testsuite entgegen, legt ein neues XML::Parser-Objekt an, setzt die Parser-Callbacks und ruft schließlich die parse-Methode mit der XML-Datei als Parameter auf. parse_handle_start ab Zeile 162 ruft der XML::Parser bei jedem öffnenden Tag auf und gibt -- durch die anonymen Subroutinen in den Zeilen 32 und 34 -- nicht nur eine Referenz auf das Parser-Objekt ($p), den Tagnamen ($el) und den Attribut-Hash (%atts) mit, sondern auch eine Referenz auf das XmlTestSuite-Objekt ($self). parse_handle_start sammelt für jedes Tag, wegen dem es aufgerufen wird, Daten eines Testfalls aus der XML-Beschreibung und legt sie unter der Instanzvariablen case des XmlTestSuite-Objektes ab: Unter $self->{case}->{requests} steht, wenn der Parser durch alle request-Elemente durch ist, eine Liste von XML-Requests mit Sub-Listen, die jeweils den Namen der XML-Datei und entweder den Fixup-Handler oder einen Leerstring enthalten. Der End-Handler parse_handle_end hängt am Testfallende alle case-Daten an die Liste von Testfällen an, die unter $self->{cases} hängt.

Die run-Methode ab Zeile 46 entpuffert zunächst die Standardausgabe, so dass Ausgaben, auch wenn sie kein Newline-Zeichen enthalten, sofort dargestellt werden. Ab Zeile 50 wird die Logdatei geöffnet, falls eine solche in der Testfalldatei spezifiziert wurde. Zeile 51 legt ein entsprechendes IO::File-Filehandle in der Instanzvariablen log ab, so dass die log-Methode später einfach dorthin schreiben kann.

Zeile 57 iteriert über die Testfälle, ab Zeile 60 wird ins entsprechende Test-Verzeichnis gewechselt. Zeile 65 ruft die ab Zeile 89 definierte Hilfsfunktion print_headline auf, die den Namen des Testfalles mit einer Reihe von Pünktchen im Format

    Test ..................

ausgibt, so dass, abhängig von der Länge des Testfallnamens, die ausgegebenen Zeilen immer gleich lang sind. Ja, ich gebe es gerne zu: Ich bin ein Pedant!

Die handle_case-Methode ab Zeile 104 handelt einen einzelnen Testfall ab. Abhängig davon, ob es sich um einen XML-gesteuerten Web-Request oder einen simplen Aufruf eines Testskripts handelt, rufen entweder Zeile 109 die fetch-Methode oder Zeile 120 das entsprechende Skript auf.

Falls ein regulärer Ausdruck wartet, lässt ihn Zeile 127 über ein eval-Konstrukt auf die Ergebnisdaten in $data los. Falls der Ausdruck passt, liefert handle_case den Wert 1. Im Fehlerfall kommt 0 zurück und die log-Methode schreibt die Begründung in die Logdatei.

Ist andererseits eine Referenzdatei angegeben, wird sie, falls sie existiert, mittels der ab Zeile 274 definierten Funktion suckfile eingelesen. Existiert sie noch nicht, liefert suckfile den Wert undef und Zeile 145 legt mittels der ab Zeile 286 definierten Funktion dumptofile, die einen Dateinamen und einen Skalar mit Daten erwartet, eine neue Referenzdatei an. Stimmt das Requestergebnis mit dem Inhalt der Referenzdatei überein, lief der Test erfolgreich, falls nicht, wird der Fehler wie oben beim fehlgeschlagenen Regex behandelt und in der Logdatei notiert.

Ab Zeile 151 schließlich wird, falls definiert, die Filterfunktion aufgerufen, die als Eingabe die Ergebnisdaten des Testfalls erhält. Was sie damit macht, bleibt ihr selbst überlassen, gängigerweise wird sie bestimmte Daten ausfiltern und mit print ausgeben, sie könnte aber genausogut in eine andere Datei schreiben oder eine Datenbank ansprechen.

Die log-Methode ab Zeile 212 schreibt eine ihr übergebene Nachricht mit vorangestelltem Datum in die Logdatei, die, falls spezifiziert, über ein in $self->{log} abgelegtes modernes File-Handle vom Typ IO::File angesprochen wird.

Die fetch-Methode ab Zeile 228 implementiert in Kürze das, was wir letzten Monat als Standalone-Skript implementiert hatten: Sie arbeitet eine Reihe von XML-Dateien ab, die HTTP-Requestdaten enthalten, holt die erforderlichen Dokumente vom Netz und jongliert die Cookies entsprechend. Außerdem implementiert sie den letztens besprochenen Post-Redirect-Browser-Bug sowie einen kleinen Hack, um einen eventuell auftretenden Client-Pull mit META-Refresh-Tag zu simulieren. fetch ruft ab Zeile 261 nach jedem erfolgreichen Request eventuell definierte Fixup-Handler auf, denen sie das Ergebnis des gerade gelaufenen Requests in die Standardeingabe legt.

Installation

XmlTestSuite.pm und das in der letzten Ausgabe vorgestellte XmlUserAgent.pm müssen in ein Verzeichnis wandern, in dem run.pl sie findet. Dann flugs Testfälle und Requests definiert und ab geht die Post! Bis zum nächsten Mal!

Listing TESTCASES.xml

    01 <testsuite>
    02     <log file="test.log" /> 
    03 
    04     <testcase name = "Test" 
    05               dir  = "TEST1">
    06         <request xml = "test.xml" />
    07         <expect reffile = "test.ref" />
    08     </testcase>
    09 
    10 
    11     <testcase name = "Login + Welcome" 
    12               dir  = "TEST1">
    13         <request xml = "login.xml" 
    14                  fixup = "fixup.pl" />
    15         <request xml = "getit.xml" />
    16         <expect regex = "/test page/i" />
    17     </testcase>
    18 
    19     <testcase name = "Testfunktion" 
    20               dir  = "TEST1">
    21         <request function = "doit.pl" />
    22         <expect regex = "/hallo/" />
    23     </testcase>
    24 
    25     <testcase name = "Testfilter" 
    26               dir  = "TEST1">
    27         <request xml = "test.xml" />
    28         <print filter = "filter.pl" />
    29     </testcase>
    30 
    31 </testsuite>

Listing run.pl

    1 #!/usr/bin/perl -w
    2 
    3 use strict;
    4 use XmlTestSuite;
    5 
    6 my $suite = XmlTestSuite->new;
    7 $suite->parsefile("TESTCASES.xml");
    8 $suite->run();

Listing testsuite.dtd

    01 <!ELEMENT testsuite (log?,testcase+)>
    02 
    03 <!ELEMENT testcase (request+,(expect|print))>
    04 <!ELEMENT log EMPTY>
    05 <!ELEMENT request EMPTY>
    06 <!ELEMENT expect EMPTY>
    07 <!ELEMENT print EMPTY>
    08 
    09 <!ATTLIST log
    10           file     CDATA #REQUIRED> 
    11 <!ATTLIST testcase
    12           name     CDATA #REQUIRED
    13           dir      CDATA #REQUIRED> 
    14 <!ATTLIST request
    15           function CDATA #IMPLIED
    16           xml      CDATA #IMPLIED
    17           fixup    CDATA #IMPLIED>
    18 <!ATTLIST expect
    19           regex    CDATA #IMPLIED
    20           reffile  CDATA #IMPLIED>
    21 <!ATTLIST print
    22           filter CDATA #REQUIRED>

Listing filter.pl

    1 #!/usr/bin/perl -w
    2 
    3 @data = <>;
    4 print "\n    ", scalar @data, 
    5       " lines in index.html - ";

Listing XmlTestSuite.pm

    001 #!/usr/bin/perl -w
    002 ##################################################
    003 # XmlTestSuite - mschilli@perlmeister.com, 2000
    004 ##################################################
    005 
    006 package XmlTestSuite;
    007 
    008 use XmlUserAgent;
    009 use HTTP::Cookies;
    010 use XML::Parser;
    011 use Cwd;
    012 use IO::File;
    013 use strict;
    014 
    015 use constant COLUMN_WIDTH => 40;
    016 
    017 ##################################################
    018 # Constructor
    019 ##################################################
    020 sub new {
    021     my ($class) = @_;
    022     my $self = { ok => 0, notok => 0 };
    023     bless $self, $class;
    024 }
    025 
    026 ##################################################
    027 # Parse the XML test suite file
    028 ##################################################
    029 sub parsefile {
    030     my ($self, $file) = @_;
    031 
    032     my $start_handler = sub { 
    033                    $self->parse_handle_start(@_) };
    034     my $end_handler = sub { 
    035                    $self->parse_handle_end(@_) };
    036 
    037     $self->{parser} = XML::Parser->new( 
    038             Handlers => { Start => $start_handler,
    039                           End   => $end_handler });
    040     return $self->{parser}->parsefile($file);
    041 }
    042 
    043 ##################################################
    044 # Run test cases
    045 ##################################################
    046 sub run {
    047     my $self = shift;
    048     local $| = 1;
    049 
    050     if(exists $self->{logfile}) {
    051         $self->{log} = 
    052                IO::File->new(">$self->{logfile}");
    053         die "Cannot open logfile $self->{logfile}" 
    054             unless defined $self->{log};
    055     }
    056 
    057     foreach my $case (@{$self->{cases}}) {
    058         my $cwd = Cwd::cwd();    # Get current dir
    059 
    060         if(exists $case->{dir}) {
    061             chdir $case->{dir} or 
    062                die "Cannot chdir to $case->{dir}";
    063         }
    064 
    065         print_headline($case->{name});
    066 
    067         if($self->handle_case($case)) {
    068             print "ok\n";
    069             $self->{ok}++;
    070             $self->log("$case->{name} ok");
    071         } else {
    072             print "not ok\n";
    073             $self->{notok}++;
    074             $self->log("$case->{name} not ok");
    075         }
    076 
    077         chdir($cwd) if $case->{dir};
    078     }
    079 
    080     $self->{log}->close if exists $self->{logfile};
    081 
    082     print "$self->{ok} tests OK ", $self->{notok} ? 
    083         ", $self->{notok} FAILED" : "", "\n";
    084 }
    085 
    086 ##################################################
    087 # Print test headline
    088 ##################################################
    089 sub print_headline {
    090     my $name = shift;
    091     my $dots = "";
    092 
    093     print "$name ";
    094     if(length($name) < COLUMN_WIDTH) {
    095         $dots = "." x 
    096              (COLUMN_WIDTH - 2 - length($name));
    097     }
    098     print "$dots ";
    099 }
    100 
    101 ##################################################
    102 # Handle one test case
    103 ##################################################
    104 sub handle_case {
    105     my ($self, $case) = @_;
    106     my $data;
    107 
    108     if(exists $case->{requests}) {
    109         my $resp = $self->fetch($case->{requests});
    110 
    111         if($resp->is_success) {
    112             $data = $resp->content();
    113         } else {
    114             print "Error: ", $resp->code, " - ", 
    115             $resp->message(), "\n";
    116         }
    117     }
    118 
    119     if(exists $case->{function}) {
    120         open PIPE, "$case->{function} |" or 
    121             die "Cannot open $case->{function}";
    122         $data = join '', <PIPE>;
    123         close PIPE;
    124     }
    125 
    126     if(exists $case->{regex}) {
    127         if(eval "\$data =~ $case->{regex}") {
    128             return 1;
    129         } else  {
    130             $self->log("$case->{name}: No match ",
    131              "for $case->{regex}, got:\n$data\n");
    132             return 0;
    133         }
    134     }
    135 
    136     if(exists $case->{reffile}) {
    137         my $refdata = suckfile($case->{reffile});
    138         if(defined $refdata) {
    139             return 1 if $refdata eq $data;
    140 
    141             $self->log("$case->{name}: mismatch" .
    142             " $case->{reffile}, got \n$data\n");
    143             return 0;
    144         } else {
    145             dumptofile($case->{reffile}, $data);
    146             print "CREATED $case->{reffile} ";
    147             return 1;
    148         }
    149     }
    150 
    151     if($case->{filter}) {
    152         open PIPE, "| $case->{filter}" or 
    153             die "Cannot open filter";
    154         print PIPE $data;
    155         close PIPE;
    156     }
    157 
    158     return 1;
    159 }
    160 
    161 ##################################################
    162 sub parse_handle_start {
    163 ##################################################
    164     my ($self, $p, $el, %atts) = @_;
    165 
    166     if($el eq "testcase") {
    167         $self->{case}  = { name => $atts{name},
    168                            dir  => $atts{dir} };
    169     }
    170 
    171     if($el eq "log") {
    172         $self->{logfile} = $atts{file};
    173     }
    174 
    175     if($el eq "request") {
    176         if(exists $atts{xml}) {
    177             push(@{$self->{case}->{requests}}, 
    178                 [$atts{xml}, $atts{fixup} || ""]);
    179         } elsif(exists $atts{function}) {
    180             $self->{case}->{function} = 
    181                                   $atts{function};
    182         }
    183     }
    184 
    185     if($el eq "function") {
    186         $self->{case}->{function} = $atts{"name"};
    187     }
    188 
    189     if($el eq "expect") {
    190         $self->{case}->{regex} = $atts{regex} if
    191             exists $atts{regex};
    192         $self->{case}->{reffile} = $atts{reffile} 
    193             if exists $atts{reffile};
    194     }
    195 
    196     if($el eq "print") {
    197         $self->{case}->{filter} = $atts{filter};
    198     }
    199 }
    200 
    201 ##################################################
    202 sub parse_handle_end {
    203 ##################################################
    204     my ($self, $p, $el, %atts) = @_;
    205 
    206     if($el eq "testcase") {
    207         push(@{$self->{cases}}, $self->{case});
    208     }
    209 }
    210 
    211 ##################################################
    212 sub log {
    213 ##################################################
    214     my ($self, $msg) = @_;
    215 
    216     return unless exists $self->{log};
    217 
    218     my ($sec,$min,$hour,$mday,$mon,$year) = 
    219                                   localtime(time);
    220     my $fh = $self->{log};
    221 
    222     printf $fh "%4d/%02d/%02d %02d:%02d:%02d> " .
    223            "%s\n", $year + 1900, $mon+1, $mday, 
    224            $hour, $min, $sec, $msg;
    225 }
    226 
    227 ##################################################
    228 sub fetch {
    229 ##################################################
    230     my ($self, $requests) = @_;
    231     my $resp;
    232 
    233     my $ua  = XmlUserAgent->new();
    234     my $jar = HTTP::Cookies->new();
    235 
    236     $ua->cookie_jar($jar);
    237 
    238     foreach my $req (@$requests) {
    239         my($xmlfile, $fixup) = @$req;
    240 
    241         my $data = suckfile($xmlfile) or 
    242                        die "Cannot open $xmlfile";
    243         $resp = $ua->request($data);
    244 
    245         {  if($resp->code == 302) {
    246                $req = HTTP::Request->new(GET => 
    247                    $resp->header('Location'));    
    248                $resp = $ua->request($req);
    249                redo;
    250            }
    251 
    252            if($resp->is_success && 
    253               $resp->content =~ 
    254                 /<META.*?Refresh.*?URL=(.*?)"/s) {
    255                $req = HTTP::Request->new(GET => $1);    
    256                $resp = $ua->req($req);
    257                redo;
    258            }
    259         }
    260 
    261         if($fixup and $resp->is_success) {
    262             open FIXUP, "| $fixup" or 
    263                          die "Cannot open $fixup";
    264             print FIXUP $resp->content;
    265             close FIXUP or 
    266                        die "Error running $fixup";
    267         }
    268     }
    269 
    270     return $resp;
    271 }
    272 
    273 ##################################################
    274 sub suckfile {
    275 ##################################################
    276     my $name = shift;
    277 
    278     open FILE, "<$name" or return undef;
    279     my $data = join '', <FILE>;
    280     close FILE;
    281 
    282     $data;
    283 }
    284 
    285 ##################################################
    286 sub dumptofile {
    287 ##################################################
    288     my ($name, $data) = @_;
    289 
    290     open FILE, ">$name" or die "Can't open $name";
    291     print FILE $data;
    292     close FILE;
    293 }
    294 
    295 1;

Referenzen

[1]
Michael Schilli, Spring auf den XML-Zug!, Linux-Magazin 02/00, http://www.linux-magazin.de/ausgabe/2000/02/Xml/xml.html

[2]
Robert Eckstein, XML Pocket Reference, O'Reilly, 1999.

Michael Schilli

arbeitet als Software-Engineer bei Yahoo! in Sunnyvale, Kalifornien. Er hat "Goto Perl 5" (deutsch) und "Perl Power" (englisch) für Addison-Wesley geschrieben und ist unter mschilli@perlmeister.com zu erreichen. Seine Homepage: http://perlmeister.com.