Wandlungsfähig (Linux-Magazin, Oktober 2001)

Aus juristischen Gründen sollte niemand mehr GIF-Bilder auf seiner Website verwenden. Ein Skript durchwandert den Dokumentenbaum, wandelt GIFs in freie PNG-Dateien um und zieht die <IMG> und <A>-Tags im HTML aller sie referenzierenden Webseiten nach.

Wie in [3] nachzulesen, spielte sich vor einiger Zeit wegen eines Patents auf den Komprimierungsalgorithmus in GIF-Bildern ein bösartiges Gerangel zwischen der Firma Unisys und erschrockenen Webseitenbetreibern ab, denen plötzlich Briefe von Rechtsanwälten mit Geldforderungen ins Haus flatterten. Die Open-Source-Gemeinde reagierte prompt und schuf einen GIF-Erstatz: Das PNG-(Portable Network Graphics)-Format, das GIF überlegen ist -- Grund genug, alle alten GIFs zu verbrennen ([4]).

Enthält eine Website aber tausende von HTML-Seiten, die die GIF-Bilder referenzieren, kann das schnell in Arbeit ausarten. Deswegen wühlt sich das heute vorgestellte Perlskript durch alle Seiten, analysiert das HTML und findet Referenzen auf lokale GIF-Dateien. Findet es zum Beispiel irgendwo den HTML-Code

    <IMG SRC="/images/buidl.gif">

weiß es, wo die zugehörige Datei buildl.gif liegt, wirft das Programm convert aus der ImageMagick-Sammlung auf sie an und kreiert buildl.png. Anschließend korrigiert es auch noch den Link in der HTML-Seite, die dann mit

    <IMG SRC="/images/buidl.png">

auf das neue Bild zeigt. Wie das geht? Führt man sich zu Gemüte, dass unter Umständen im Originaltext (wie zum Beispiel in diesem Artikel) der String "/images/buidl.gif" außerhalb des HTML-Markups vorkommt, den das Skript dann bitte nicht ersetzen soll, wird schnell klar, dass diese Aufgabe nicht mit einfachen regulären Ausdrücken zu erschlagen ist. Einfaches Parsen tut's auch nicht, denn die HTML-verarbeitenden Browser achten (im Gegensatz etwa zu XML-Parsern) nicht streng auf die Syntaxregeln und murren selbst manchmal bei haarsträubenden Fehlern nicht. Zum Glück gibt es das Modul HTML::Parser von Gisle Aas und Michael Chase, mit dem man HTML einfach und schlampig wie ein Browser durchforsten und, hier kommt's, nebenbei manipulieren kann.

Das in Listing burngifs.pl gezeigte Skript verlangt in den Zeilen 6 bis 8 nach perl in mindestens der Version 5.6.0. Weiter besteht es mit use strict und use warnings auf sauberem Code und nörgelt bei zwielichtigen Vorgängen.

An Modulen braucht es mindestens die 3.0er Version von HTML::Parser, URI::URL zum Herumspielen mit URLs, File::Find zum Durchstöbern von Dateibäumen, und einige Funktionen aus File::Basename und File::Spec zum handlichen Manipulieren von Dateipfaden.

Die Konfigurationssektion ab Zeile 18 stellt das Skript auf den aktuellen Einsatzort ein. Da burngifs.pl sowohl absolute als auch relative Image-Links unterstützt, muss es wissen, dass die Linkangaben

    http://perlmeister.com/i.gif
    http://www.perlmeister.com/i.gif
    /i.gif
    i.gif

unter Umständen auf dasselbe Bild verweisen. Hierzu braucht es in @SITES die Top-URLs der Website und in $BASE_DIR das zugehörige Basisverzeichnis auf der Festplatte.

$CONVERT gibt den Pfad zum Konvertierungsprogramm convert aus der Sammlung ImageMagick an, die praktisch jeder Linux-Distribution beiliegt, falls nicht, gibt es sie unter [2]. Ein aus der Shell aufgerufenes which convert zeigt, ob und wo convert installiert ist.

Der reguläre Ausdruck in $PAGEMATCH legt fest, dass das Skript nur .html und .htm-Dateien anfasst -- wer zum Beispiel noch .asp und .php braucht, schreibt statt dessen einfach qr#\.html?$|\.asp$|\.php$#.

Zeile 25 definiert mit our drei globale Variablen, über die die verschiedenen Funktionen im Skript miteinander kommunizieren: Nach $OUTDATA schreibt der Parser seine manipulierten Daten, $REPS ist die Anzahl von Ersetzungen pro Datei für informative Zwecke und im Hash %BURNED schmoren die Pfade aller bislang konvertierten GIFs. Zeile 28 macht aus dem Array von URLs in @SITES einen Array von URI::URL-Objekten, damit wir sie später leichter manipulieren können.

Schöner Parsen mit HTML::Parser

Zeile 31 definiert den HTML::Parser, der mit Version 3.0 ein neues API erhielt: Man gibt einfach an, welche benutzerdefinierten Funktionen der Parser bei welchen Ereignissen anspringen soll, und welche Argumente jene erwarten. Der Eintrag unter start_h gibt an, dass der Parser im Falle eines sich öffnenden Tags (z.B. <IMG SRC="i.gif" WIDTH=65>) der weiter unten definierten Funktion burn_gif folgendes übergibt:

Für alle anderen Ereignisse (z.B. Kommentare, Text oder schließende Tags) springt der Default-Handler default_h ein, den Zeile 32 so definiert, dass er den ursprünglich gefundenen Text zur unmodifizierten Ausgabe an die weiter unten definierte Funktion print_out() weiterleitet.

Die aus dem Modul File::Find exportierte Funktion find() startet in Zeile 38 den Ersetzungsreigen und ruft hierzu für jeden Eintrag, den sie rekursiv unter dem Dokumentenpfad des Webservers $BASE_DIR findet, die Funktion warp_file() mit der HTML::Parser-Objektreferenz als Argument auf. Am Ende stehen in %BURNED alle ersetzten GIF-Dateien, die Zeile 43 dann für immer von der Platte löscht.

Da warp_file() auch für Verzeichnisse und Binärdateien aufgerufen wird, muss sie in Zeile 52 prüfen, ob denn überhaupt eine ersetzungswürdige Datei vorliegt -- falls nicht, kehrt sie sofort mit return zurück und lässt die Datei unangetastet. -T lässt nur Textdateien durch und der in der Konfigurationssektion definierte reguläre Ausdruck $PAGEMATCH schränkt die Auswahl weiter ein.

Die Zeilen 58 bis 61 lesen den HTML-Code aus der Datei in den Skalar $data ein. Zeile 65 gibt sie dem Parser mit der data()-Methode zu fressen und signalisiert mit der anschließend abgesetzten eof()-Methode, dass die aktuelle Datei zuende ist, andernfalls interpretierte der persistente Parser alle Dateien als kontinuierlichen Datenstrom und käme eventuell ins Schleudern. Die manipulierten Daten schreibt er in den vorher auf den Leerstring initialisierten globalen Skalar $OUTDATA. Liegen anschließend tatsächlich Veränderungen gegenüber der Originalversion vor, überschreiben die Zeilen 70 bis 73 die Originaldatei mit dem korrigierten HTML.

Die ab Zeile 79 definierte Funktion print_out hängt Ausgabedaten einfach an den globalen String $OUTDATA an. Wir wollen ganz sicher gehen, dass alles, einschließlich der Bildformatkonvertierungen glatt geht, bevor die Originaldatei letztendlich überschrieben wird.

Burn GIF, burn!

burn_gif() ab Zeile 87 wird vom Parser für jedes sich öffnende Tag aufgerufen. Da wir uns nur für das src-Attribut von <img> und das href-Attribut von <a> interessieren, muss der else-Zweig ab Zeile 100 den Orginaltext herausschreiben und burn_gif beenden, da der Parser für andere Tags keine Veränderungen am HTML-Code vornehmen darf.

Die Zeilen 104 bis 106 prüfen, ob eines unserer gesuchten Attribute vorliegt, sieht nach, ob dessen Stringwert auf .gif oder .GIF endet und findet mit der weiter unten definierten Funktion url2file heraus, ob es sich um einen Link auf eine tatsächlich existierende Datei auf dem lokalen Webserver handelt. Falls ja, macht warp_name() aus dem GIF-Namen den PNG-Namen, falls nein, gibt's nichts zu verändern und Zeile 114 gibt den Originaltext aus bevor Zeile 115 burn_gif() abbricht.

Da Zeile 110 bereits den Hash-Eintrag für den Image-Link in $attr->{$key} verändert hat, geben die Zeilen 119 bis 123 den modifizierten Tag einfach dadurch aus, dass sie mit mit map durch alle Attributname und -einträge laufen, sie jeweils in Textstrings im Format KEY="VALUE" umwandeln und diese dann mit join durch Leerzeichen getrennt hintereinander ausdrucken.

Existiert zu einer gefundenen GIF-Datei noch keine PNG-Datei oder ist die PNG-Datei älteren Datums als das Original-GIF, wirft Zeile 135 den Formatierer convert aus dem ImageMagick-Paket an, der aus GIF-Dateien ohne Firlefanz PNG-Bilder macht. Zeile 137 merkt sich im Hash %BURNED, dass die alte GIF-Datei später gelöscht werden kann.

Von relativ nach absolut und retour

Die vorher erwähnte Funktion url2file() ab Zeile 142 versucht, einem Link eine lokale Datei zuzuordnen. Drei Möglichkeiten gibt's:

Zeile 146 macht aus dem URL-String ein URI::URL-Objekt, über dessen Methoden wir anschließend einfach auf die verschiedenen Teile des URLs zugreifen können. $uri->scheme() liefert den Protokollteil des URLs zurück (also etwa http) und undef, falls nur ein lokaler Pfad vorliegt. Bei vollständigen URLs untersucht die for-Schleife ab Zeile 150, ob der URL mit einem der in @SITES in der Konfigurationssektion angegebenen Alias-URLs übereinstimmt. Die Methode netloc() der Klasse URI::URL liefert hierzu die ersten drei Teile der URL, die das Protokoll, den Host und den Port festlegen. Liegt der Link irgendwo unterhalb des aktuell untersuchten Alias-Namens $s, transformiert die rel()-Methode mit $s als Argument in Zeile 152 den aktuellen Link in eine relative Pfadangabe zur Basis $s. Aus http://perlmeister.com/img/i.gif wird so /img/i.gif.

Für den Fall, dass der Link bereits als Pfadangabe vorliegt, kommt der else-Zweig ab Zeile 157 zum Einsatz. Absolute Pfadangaben können wir belassen, relative hingegen müssen wir in ``absolute'' Angaben relativ zur Dokumentenwurzel des Webservers umrechnen. file_name_is_absolute() aus File::Spec::Functions sieht nur nach, ob ein / vorne dran steht, und falls dem nicht so ist, rechnet Zeile 159 zunächst mit rel2abs (auch aus File::Spec::Functions) den zugehörigen absoluten Pfad aus. rel2abs bezieht hierzu den Linknamen auf das aktuelle Verzeichnis (in das File::Find während der rekursiven Suche praktischerweise wechselt) und ermittelt daraus den Pfad, ausgehend vom / des Unix-Systems. Um diese absolute Angabe dann wieder auf die Dokumentenwurzel des Webservers zu relativieren, wandelt abs2rel (auch aus File::Spec::Functions) $rel wieder zur Basis $BASE_DIR um. Uff!

catfile und canonpath aus dem gleichen Modul machen daraus in Zeile 164 wieder eine absolute Pfadangabe auf der aktuellen Festplatte, in dem sie $BASE_DIR und $rel zusammenhängen und den entstehenden Pfad minimalisieren.

Falls es zu einem GIF-Bild-Link keine zugehörige lokale Datei gibt, meldet dies Zeile 166 dem Benutzer und Zeile 169 lässt url2file den Wert undef zurückgeben. Andernfalls kommt der absolute Pfad in $p als String zurück. Die Funktion warp_name ab Zeile 173 führt nur eine einfache Textersetzung durch, und liefert den zu einem GIF-Namen zugehörigen PNG-Namen zurück.

Installation

Vor dem Laufenlassen des Skripts müssen noch die Konfigurationsvariablen in den Zeilen 18 bis 22 an die lokalen Verhältnisse angepasst werden: Die URLs, unter denen die Website erreichbar ist in @SITES, in $BASE_DIR die Dokumentenwurzel des Webservers, und in $CONVERT der Pfad zum convert-Programm. Die verwendeten Perl-Module liegen jeder neuen Perl-Distribution bei, falls nicht, kann man sie entweder vom CPAN abholen oder, noch besser, die neueste Perl-Version auf www.perl.com abholen. Dann schnell aus Sicherheitsgründen ein Backup gemacht -- und los geht's, putzt die obsoleten GIFs weg!

Listing 1: burngifs.pl

    001 #!/usr/bin/perl
    002 ##################################################
    003 # burngifs.pl -- Mike Schilli, 2001 
    004 #                (m@perlmeister.com)
    005 ##################################################
    006 use 5.6.0;
    007 use warnings;
    008 use strict;
    009 
    010 use HTML::Parser 3.0;
    011 use URI::URL;
    012 use File::Spec::Functions qw(catfile canonpath
    013            rel2abs abs2rel file_name_is_absolute);
    014 use File::Find;
    015 use File::Basename;
    016 
    017     # Namen, unter denen die Website bekannt ist
    018 my @SITES     = qw( http://perlmeister.com
    019                     http://www.perlmeister.com );
    020 my $BASE_DIR  = "/web/HTML";
    021 my $CONVERT   = "/usr/local/bin/convert";
    022 my $PAGEMATCH = qr#\.html?$#;
    023 
    024     # Globale Variablen
    025 our ($OUTDATA, $REPS, %BURNED);
    026 
    027     # Alias-Namen als URL::URI-Objekte speichern
    028 @SITES = map { URI::URL->new($_) } @SITES;
    029 
    030     # Parser aufsetzen
    031 my $parser = HTML::Parser->new(
    032     default_h => [ \&print_out, 'text' ],
    033     start_h   => [ \&burn_gif, 
    034                    'tagname,attrseq,attr,text']);
    035 
    036     # Rekursiv suchen, manipulieren und GIFs 
    037     # konvertieren
    038 find(sub {warp_file($parser)}, $BASE_DIR);
    039 
    040     # Ersetzte GIF-Dateien löschen
    041 for my $gif (keys %BURNED) {
    042     print "Deleting $gif\n";
    043     unlink $gif or warn "Cannot unlink $gif ($!)";
    044 }
    045 
    046 ##################################################
    047 sub warp_file {          # Eine Datei konvertieren
    048 ##################################################
    049     my $parser = shift;
    050     my $file   = $_;
    051 
    052     return unless -T $file and 
    053            $file =~ $PAGEMATCH;
    054 
    055     $REPS = 0;
    056 
    057         # Daten aus Datei holen
    058     open FILE, "<$file" or 
    059         die "Cannot open $file ($!)";
    060     my $data   = join '', <FILE>;
    061     close FILE;
    062 
    063     $OUTDATA = "";
    064 
    065     $parser->parse($data) || die $!;
    066     $parser->eof;
    067 
    068     if($data ne $OUTDATA) {
    069             # Zurückschreiben
    070         open FILE, ">$file" or 
    071             die "Cannot open $file ($!)";
    072         print FILE $OUTDATA;
    073         close FILE;
    074         print "    $REPS replacements\n" if $REPS;
    075     }
    076 }
    077 
    078 ##################################################
    079 sub print_out {
    080 ##################################################
    081     my ($text) = shift;
    082 
    083     $OUTDATA .= $text;
    084 }
    085 
    086 ##################################################
    087 sub burn_gif {
    088 ##################################################
    089     my($tagname, $attrseq, $attr, $text) = @_;
    090     my($path, $key);
    091 
    092     if($tagname eq "img") {
    093             # <IMG SRC=...> Tag gefunden
    094         $key = "src";
    095     } elsif($tagname eq "a") {
    096             # <A HREF=...> Tag gefunden
    097         $key = "href";
    098     } else {
    099             # Anderes Tag => unverändert ausgeben
    100         print_out $text;
    101         return;
    102     }
    103 
    104     if(exists $attr->{$key} and 
    105        $attr->{$key} =~ /\.gif$|\.GIF$/ and 
    106        defined ($path = url2file($attr->{$key}))
    107       ) {
    108             # Tag referenziert eine existierende
    109             # GIF-Datei auf Website.
    110         $attr->{$key} = warp_name($attr->{$key});
    111     } else {
    112             # Keine lokale GIF-Datei existiert
    113             # => Unverändert ausgeben
    114         print_out $text;
    115         return;
    116     }
    117 
    118         # Tag mit veränderten Attributen ausgeben
    119     $OUTDATA .= "<" . uc($tagname) . " " .
    120           join(" ", map { uc($_) . '="' . 
    121                           $attr->{$_} . '"' 
    122                         } @$attrseq ) .
    123           ">";
    124 
    125     print "$File::Find::name\n" if $REPS++ < 1;
    126 
    127     my $new = warp_name($path);
    128 
    129         # GIF->PNG-Konvertierer aufrufen, falls
    130         # PNG-Datei noch nicht existiert oder
    131         # älter als GIF-Datei ist.
    132     if(! -f $new or -M $new > -M $path) {
    133         print "    Converting ", basename($path), 
    134               " -> ", basename($new), "\n";
    135         system($CONVERT, $path, $new) and
    136             die "Converting failed";
    137         $BURNED{$path} = 1;
    138     }
    139 }
    140 
    141 ##################################################
    142 sub url2file {
    143 ##################################################
    144     my($link) = @_;
    145 
    146     my $uri = URI::URL->new($link);
    147     my $rel = "";
    148 
    149     if($uri->scheme) {
    150         for my $s (@SITES) {
    151             if($uri->netloc() eq $s->netloc()) {
    152                 $rel = $uri->rel($s);
    153                 last;
    154             }
    155         }
    156     } else {
    157         $rel = $link;
    158         if(!file_name_is_absolute($rel)) {
    159             $rel = rel2abs($rel);
    160             $rel = abs2rel($rel, $BASE_DIR);
    161         }
    162     }
    163 
    164     my $p = canonpath(catfile($BASE_DIR, $rel));
    165 
    166     print "    $File::Find::name: No local GIF ",
    167           "for '$link'\n" unless -f $p;
    168 
    169     return -f _ ? $p : undef;
    170 }
    171 
    172 ##################################################
    173 sub warp_name {
    174 ##################################################
    175     my $link = shift;
    176 
    177     (my $new = $link) =~ s/\.gif$|\.GIF$/.png/;
    178 
    179     return $new;
    180 }

Infos

[1]
Listings zu diesem Artikel: ftp://www.linux-magazin.de/pub/listings/magazin/2001/12/Perl

[2]
Die ImageMagick-Bibliothek: ftp://ftp.imagemagick.org/pub/ImageMagick

[3]
Lincoln Stein, ``Fugitive From Justice'', WebTechniques 12/99, http://www.webtechniques.com/archives/1999/12/webm

[4]
Die Initiative ``Burn all GIFs'', http://www.burnallgifs.org

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.