#!/usr/bin/perl
##################################################
# burngifs.pl -- Mike Schilli, 2001 
#                (m@perlmeister.com)
##################################################
use 5.6.0;
use warnings;
use strict;

use HTML::Parser 3.0;
use URI::URL;
use File::Spec::Functions qw(catfile canonpath
           rel2abs abs2rel file_name_is_absolute);
use File::Find;
use File::Basename;

    # Namen, unter denen die Website bekannt ist
my @SITES     = qw( http://www.linux-magazin.de );
my $BASE_DIR  = "/home/tfreitag/aktuell/snapshot.10.2001/tmp/html";
my $CONVERT   = "/usr/bin/convert";
my $PAGEMATCH = qr#\.html?$#;

    # Globale Variablen
our ($OUTDATA, $REPS, %BURNED);

    # Alias-Namen als URL::URI-Objekte speichern
@SITES = map { URI::URL->new($_) } @SITES;

    # Parser aufsetzen
my $parser = HTML::Parser->new(
    default_h => [ \&print_out, 'text' ],
    start_h   => [ \&burn_gif, 
                   'tagname,attrseq,attr,text']);

    # Rekursiv suchen, manipulieren und GIFs 
    # konvertieren
find(sub {warp_file($parser)}, $BASE_DIR);

    # Ersetzte GIF-Dateien löschen
for my $gif (keys %BURNED) {
    print "Deleting $gif\n";
    unlink $gif or warn "Cannot unlink $gif ($!)";
}

##################################################
sub warp_file {          # Eine Datei konvertieren
##################################################
    my $parser = shift;
    my $file   = $_;

    return unless -T $file and 
           $file =~ $PAGEMATCH;

    $REPS = 0;

        # Daten aus Datei holen
    open FILE, "<$file" or 
        die "Cannot open $file ($!)";
    my $data   = join '', <FILE>;
    close FILE;

    $OUTDATA = "";

    $parser->parse($data) || die $!;
    $parser->eof;

    if($data ne $OUTDATA) {
            # Zurückschreiben
        open FILE, ">$file" or 
            die "Cannot open $file ($!)";
        print FILE $OUTDATA;
        close FILE;
        print "    $REPS replacements\n" if $REPS;
    }
}

##################################################
sub print_out {
##################################################
    my ($text) = shift;

    $OUTDATA .= $text;
}

##################################################
sub burn_gif {
##################################################
    my($tagname, $attrseq, $attr, $text) = @_;
    my($path, $key);

    if($tagname eq "img") {
            # <IMG SRC=...> Tag gefunden
        $key = "src";
    } elsif($tagname eq "a") {
            # <A HREF=...> Tag gefunden
        $key = "href";
    } else {
            # Anderes Tag => unverändert ausgeben
        print_out $text;
        return;
    }

    if(exists $attr->{$key} and 
       $attr->{$key} =~ /\.gif$|\.GIF$/ and 
       defined ($path = url2file($attr->{$key}))
      ) {
            # Tag referenziert eine existierende
            # GIF-Datei auf Website.
        $attr->{$key} = warp_name($attr->{$key});
    } else {
            # Keine lokale GIF-Datei existiert
            # => Unverändert ausgeben
        print_out $text;
        return;
    }

        # Tag mit veränderten Attributen ausgeben
    $OUTDATA .= "<" . uc($tagname) . " " .
          join(" ", map { uc($_) . '="' . 
                          $attr->{$_} . '"' 
                        } @$attrseq ) .
          ">";

    print "$File::Find::name\n" if $REPS++ < 1;

    my $new = warp_name($path);

        # GIF->PNG-Konvertierer aufrufen, falls
        # PNG-Datei noch nicht existiert oder
        # älter als GIF-Datei ist.
    if(! -f $new or -M $new > -M $path) {
        print "    Converting ", basename($path), 
              " -> ", basename($new), "\n";
        system($CONVERT, $path, $new) and
            die "Converting failed";
        $BURNED{$path} = 1;
    }
}

##################################################
sub url2file {
##################################################
    my($link) = @_;

    my $uri = URI::URL->new($link);
    my $rel = "";

    if($uri->scheme) {
        for my $s (@SITES) {
            if($uri->netloc() eq $s->netloc()) {
                $rel = $uri->rel($s);
                last;
            }
        }
    } else {
        $rel = $link;
        if(!file_name_is_absolute($rel)) {
            $rel = rel2abs($rel);
            $rel = abs2rel($rel, $BASE_DIR);
        }
    }

    my $p = canonpath(catfile($BASE_DIR, $rel));

    print "    $File::Find::name: No local GIF ",
          "for '$link'\n" unless -f $p;

    return -f _ ? $p : undef;
}

##################################################
sub warp_name {
##################################################
    my $link = shift;

    (my $new = $link) =~ s/\.gif$|\.GIF$/.png/;

    return $new;
}