#!/usr/bin/perl -w
# creator   : Tom Regner <regner@dievision.de>
# created   : Mon 13 Jan 2003 01:29:04 PM CET
# version   : $Id: apache_rw.pl,v 1.9 2003/06/12 11:10:38 tom Exp $
# copyright : (c) 2002, www.tomsdiner.org

use strict;

# 
# AFAIK no URLs whith ';'-seperated parameters are possible with this
# program
# 
# change this directive to point to the dir containing the config-file
use lib '/path/to/config/file';
use apache_rw_cfg qw($conf);

# necessary!!
$| = 1; # unbuffered IO

while (<>) {
    my $line = $_;
    if ($line =~ m{^(/[-/\w.]+?)\?([-=_&\w.]+?)(;[-\@:\w.]*)*$}) {
        my ($uri, $params, $remainder) = ($1, $2,$3);
        $remainder ||= '';
        my ($new_uri, $new_params);
        if ($conf->{$uri}->{'url'}) {
            $new_uri = $conf->{$uri}->{'url'};
            my $didIt = 1;
            my @parm_list = split(/&/, $params);
            $didIt = 0 if @parm_list == 0;
            my @new_parm_list = ();
            if ($didIt) {
                foreach (@parm_list) {
                    my ($name,$value) = split('=', $_);
                    if (defined($conf->{$uri}->{params}->{$name})) {
                        if ($value =~ m{$conf->{$uri}->{params}->{$name}->{regexp}}) {
                            push(@new_parm_list, $conf->{$uri}->{params}->{$name}->{name} . '=' . $value);
                        } else {
                            $didIt = 0;
                        }
                    } else {
                        $didIt = 0;
                    }
                }  
            }
            if ($didIt == 1) {
                $line =  $new_uri . '?';
                $remainder ||= '';
                $line .= join('&', @new_parm_list) . $remainder . "\n";
            } else {
                $line = '/' . "\n";
            }
        } else {
            $line = '/' . "\n";
        } 
    }
    print $line;
}