#!/usr/bin/perl
no locale;
use Config;
# vim: set sw=4 ts=4 si et:
use File::Basename qw(basename dirname);
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
        if ($Config{'osname'} eq 'VMS' or
            $Config{'osname'} eq 'OS2');  # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
chmod(0755, $file);
print "Extracting $file (with variable substitutions)\n";

my $VERSION="unknown";
if (-r "../TagReader.pm"){ # get version
    open(F,"../TagReader.pm")||die;
    while(<F>){
        if (/\$VERSION *= *(.+)/){
            $VERSION=$1;
            $VERSION=~s/[^\.\d]//g;
        }
    }
    close F;
}

print OUT "$Config{'startperl'} -w
my \$VERSION = \"$VERSION\";
";


while(<DATA>){
        print OUT;
}

__END__ 
# vim: set sw=4 ts=4 si et:
# Copyright: GPL, Author: Guido Socher
#
no locale;
use strict;
use vars qw($opt_v $opt_c $opt_a $opt_h);
use Getopt::Std;
use HTML::TagReader;
#
sub help();
sub expandonefile($$);
sub dirname($);
sub linktype($);
#
getopts("hcav")||die "ERROR: No such option. -h for help.\n";
help() if ($opt_h);
help() unless ($ARGV[1]);
my $expr;
($expr=shift)||help();
my $changecount=0;
my $mode;
for my $f (@ARGV){
    if ( -r "$f" ){
        $mode=(stat(_))[2];
        rename($f,"$f.bak")||die "ERROR: can not rename $f to $f.bak, check directory permissions.\n";
        $changecount=expandonefile("$f.bak",$f);
        print STDERR "$f:1: $changecount links changed\n\n";
        if ($changecount){
            chmod($mode,$f)||die "ERROR: chmod %o $f failed\n";
        }else{
            # undo
            unlink("$f")||die "ERROR: unlink $f failed\n";
            rename("$f.bak",$f)||die "ERROR: can not undo rename $f.bak to $f, check directory permissions.\n";
        }
    }else{
        warn "ERROR: can not read $f\n";
    }
}
# 
# expand exactly one file 
#
sub expandonefile($$){
    my $infile=shift;
    my $outfile=shift; 
    my $count=0;
    my @tag;
    my $linktype; # one of: name href src background
    my ($tagnospace,$ckpath,$path,$dir,$ltype,$origpath,$line,$found,$v);

    my $p=new HTML::TagReader "$infile";
    open(OUT,">$outfile")||die "ERROR: can not write $outfile\n";
    while(@tag = $p->getbytoken($opt_v)){
        # read out the tags:
        if($tag[1] eq ""){
            print OUT $tag[0];
            next;
        } 
        $line=$tag[2];
        if($tag[1] eq "!--"){
            # ignore comments unless opt_c is set:
            if (!$opt_c){
                print OUT $tag[0];
                next;
            }
        }else{ 
            if (!$opt_a){
                # we search for " href", " src", " background": 
                unless($tag[0]=~/\ssrc\s*=|\shref\s*=|\sbackground\s*=/i){
                    print OUT $tag[0];
                    next;
                }
            } 
        }
        $tagnospace=$tag[0];
        # decode URL encoding:
        $tagnospace=~tr/+/ /;
        $tagnospace=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $tagnospace=~s/\s+/ /g; # kill newline and double space
        $_=$tagnospace;
        eval $expr;
        if ($@){
            warn $@;
            $_=$tagnospace; # restore any messed up data in case of syntax error
        }
        if ($tagnospace ne $_){
            print OUT $_;
            $count++;
            print "$infile:$line: $tagnospace -\> $_\n";
        }else{
            # no change
            print OUT $tag[0];
        }
    }
    close OUT;
    return($count);
}
#----------------------------------
sub help(){
print "tr_mvlnk -- modify tags in html files with perl
commands.

USAGE: tr_mvlnk [-hacv] perlexpr html-files

tr_mvlnk provides the tags in html code in \$_ to perlexpr
and modifies the tags according to the perlexpr.
The original files are backed-up to filename.bak

Spaces, tabs and newline are removed from the tag and replaced
by just one space. This is to make it easier for the perlexpr.

OPTIONS: 
     -a include all tags. Normally only tags that contain links
     (e.g <a href=... and not <p> </p>) are passed to the perlexpr.
     That is all tags with href=, src= or background=. With this
     option set you can modify any tag.

     -h this help

     -c includes comments. Normally comment tags are not passed
     to perlexpr. With this option set you can modify also comments.

     -v verbous messages about html errors.

EXAMPLES: 
     Change links to tldp.org/linuxfocus to linuxfocus.org:
     tr_mvlnk 's|tldp.org/linuxfocus|linuxfocus.org|' index.html

tr_mvlnk is part of the HTML::TagReader package.

version $VERSION
         \n";
exit(0);
}
__END__ 

=head1 NAME

tr_mvlnk -- modify tags in html files with perl commands.

=head1 SYNOPSIS

USAGE: tr_mvlnk [-hacv] perlexpr html-files

=head1 DESCRIPTION

tr_mvlnk provides the tags in html code in \$_ to perlexpr
and modifies the tags according to the perlexpr.
The original files are backed-up to filename.bak

Spaces, tabs and newline are removed from the tag and replaced
by just one space. This is to make it easier for the perlexpr.

=head1 OPTIONS

B<-a> include all tags. Normally only tags that contain links
(e.g E<lt>a href=... and not E<lt>pE<gt> E<lt>/pE<gt>) are passed to the perlexpr.
That is all tags with href=, src= or background=. With this
option set you can modify any tag.

B<-h> this help

B<-c> includes comments. Normally comment tags are not passed
to perlexpr. With this option set you can modify also comments.

B<-v> verbous messages about html errors.

=head1 EXAMPLE

Change links to tldp.org/linuxfocus to linuxfocus.org:
tr_mvlnk 's|tldp.org/linuxfocus|linuxfocus.org|' index.html

=head1 AUTHOR

xlnk is part of the HTML::TagReader package and was written by
Guido Socher [guido(at)linuxfocus.org]

=cut