Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#!/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"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.