gistfile1.txt

#!/usr/bin/perl -w

use Getopt::Std;
getopts("m:h:");

$mapfile  = "/z/www/redir.txt";
$htaccess = "/z/www/.htaccess";
$hostname = `hostname`; chomp $hostname;

if ($opt_m) {
    $mapfile = $opt_m;
}
if ($opt_h) {
    $htaccess = $opt_h;
}

my %redirects;
open(MAP,$mapfile) || 
    die "Cannot read redir.txt: $!\n";
while (<MAP>) {
    if (/^([\w\.\-]+)\/(\S*)\s+(\S+)/) {
	# a sub-path redirect
	my ($host,$path,$to) = ($1,$2,$3);
	my $from = "$host/$path";
	if ($host =~ /[A-Z]/) {
		print "Warning: capitalized hostname $host on line $. won't match\n";
	}
	if ($host !~ /^[\w\-\.]+$/) {
		print "Warning: invalid hostname $host on line $.\n";
	}
	$pathed{$host} = 1;
	$host =~ s/\./\\./g;
	if ($path =~ /^$/) {
	    # top level redirect
	    $path = "(.*)\$";
	    if ($to =~ m,/$,) {
		$to .= "\$1";
	    } else {
		$to .= "/\$1";
	    }
	} else {
	    $path = "$path(.*)";
	    $to .= "\$1";
	}
	if ($host eq "dynamic\\.gamespy\\.com") {
	    $host = "dynamic.?\\.gamespy\\.com";
	}

	chomp;
	$redirects{"$from"} = "# $_\nRewriteCond\t\%{HTTP_HOST}\t^$host\$\t[NC]\nRewriteRule\t^$path\t$to [R=301,NE,L]\n";
    } elsif (/^EXACT=([\w\.\-]+)\/(\S*)\s+(\S+)/) {
	# an exact sub-path redirect
	my ($host,$path,$to) = ($1,$2,$3);
	my $from = "$host/$path";
	if ($host =~ /[A-Z]/) {
		print "Warning: capitalized hostname $host on line $. won't match\n";
	}
	if ($host !~ /^[\w\-\.]+$/) {
		print "Warning: invalid hostname $host on line $.\n";
	}
	$pathed{$host} = 1;
	$host =~ s/\./\\./g;
	if ($path =~ /^$/) {
	    # top level redirect
	    $path = "(.*)\$";
	}
	if ($host eq "dynamic\\.gamespy\\.com") {
	    $host = "dynamic.?\\.gamespy\\.com";
	}
	chomp;
	$redirects{"$from"} = "# $_\nRewriteCond\t\%{HTTP_HOST}\t^$host\$\t[NC]\nRewriteRule\t^$path\t$to [R=301,NE,L]\n";
    } elsif (/^(EXACT=)?([\w\.\-]+)\s+(\S+)/) {
	# a top level redirect
	my ($host,$to) = ($2,$3);
	if ($host =~ /[A-Z]/) {
		print "Warning: capitalized hostname $host on line $. won't match\n";
	}
	if ($host !~ /^[\w\-\.]+$/) {
		print "Warning: invalid hostname $host on line $.\n";
	}
	if ($pathed{$host}) {
	    print "$host has sub-path redirects which will get ignored\n";
	}
    } else {
	print "Invalid entry on line $.: $_";
    }
}
close MAP;

open(HTA,">$htaccess.new") ||
    die "Cannot write $htaccess.new: $!\n";
print HTA "# Generated by $0 on $hostname at ",scalar(localtime(time())),"\n";
print HTA "RewriteEngine on\n\n";
foreach $from (sort bypath keys %redirects) {
    print HTA "$redirects{$from}\n";
}
close HTA;

rename("$htaccess.new","$htaccess") ||
    die "Cannot move $htaccess.new into place: $!\n";

sub bypath {
    my ($adom,$apath,$bdom,$bpath);
    if ($a =~ m,^([\w\-\.]+)/(\S*)$,) {
	($adom,$apath) = ($1,$2);
    } else {
	$adom = $a;
    }
    if ($b =~ m,^([\w\-\.]+)/(\S*)$,) {
	($bdom,$bpath) = ($1,$2);
    } else {
	$bdom = $b;
    }
    if ($bdom ne $adom) {
	return ($a cmp $b);
    } elsif (length($apath) > length($bpath)) {
	return -1;
    } elsif (length($apath) < length($bpath)) {
	return 1;
    } else {
	return ($apath cmp $bpath);
    }
}

print "Parsing finished.\n"