File Coverage

blib/lib/Apache/RedirectDBI.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

#$Id: RedirectDBI.pm,v 0.02 2001/10/05 18:59:00 [e-mail] Exp $
package Apache::RedirectDBI;
$VERSION='0.02';
use strict;
use Apache::Constants qw(:common OK DECLINED REDIRECT SERVER_ERROR);
my ($debug)=0;
my %Config = ('RedirectDBI_data_source'=>'',
	      'RedirectDBI_username'=>'',
	      'RedirectDBI_password'=>'',
	      'RedirectDBI_default'=>'',
	      'RedirectDBI_table2uri'=>'',
	      'RedirectDBI_location'=>'',
	      'RedirectDBI_url'=>'',
	      'RedirectDBI_field'=>'',
	      'RedirectDBI_external'=>'',
	     );

sub handler {
    my $r = shift;		     # Incoming request
    my($key, $val);		     # Configuration key/value

    my $config = {};		     # Configuration hash
    my @tables;			     # Map table names to URIs
#
# Pull out the current URI
#
    my $uri=$r->uri;
# If the requested URI did not end in a trailing '/' and the URI is
# a directory then print a location redirect to the right URL. The
# user will then repeat the request with the right location, and we
# do this again.
#
# If you don't do this, the user will see the URL change when they
# get redirected to wherever based on the table they use. This exposes
# the underlying directory names, which is a bad thing.
#
    if(($uri !~ /\/$/) && (-d $r->document_root . $uri)) {
	$uri.='/';
	$r->header_out(Location=>$uri);
	return REDIRECT;
    }
# Pull out the configuration information
    while(($key, $val) = each %Config) {
	$val = $r->dir_config($key) || $val;
	$key =~ s/^RedirectDBI_//;	# Pull RedirectDBI_ off the start
	$config->{$key} = $val;
    }
#
# Connect to the database
#
    my $dbh;
    unless ($dbh = DBI->connect($config->{data_source}, $config->{username}, $config->{password})) {
	$r->log_reason(__PACKAGE__." db connect error with $config->{data_source} $uri");
	return SERVER_ERROR;
    }
#
# Get the table/uri map apart
    @tables = split /\s/, $config->{table2uri};
#
# Iterate over every other entry in @tables. Each entry will be the
# name of a table to check. For each table, count the number of users
# in the table who match the currently connected user. If there's
# at least one (there shouldn't be more than one, but you never know)
# then change the location of the current request, and fall out of the
# loop.
#
    my $query;
    my $mode=1;
    $mode+=1 unless $config->{field};
    for(my $i=0; $i<=$#tables; $i+=$mode) {
	my $table = $tables[$i];	# Current table name
# SQL for search
	$config->{field}||='name';
	my $sql = "select ";
	if($config->{url}) {
	    $sql.="$config->{url} ";
	} else {
	    $sql.="$config->{field} ";
	}
	$sql.="from ".$table." where $config->{field}=" . $dbh->quote($r->connection->user);
    print STDERR __PACKAGE__." sql=$sql\n" if $debug;
#
# Run search, get results
#
	unless($query=$dbh->prepare($sql)) {
            $r->log_reason(__PACKAGE__." ERROR: prepare: $DBI::errstr $uri");
            $dbh->disconnect;
            return SERVER_ERROR;
        }
        unless($query->execute) {
            $r->log_reason(__PACKAGE__." ERROR: execute: $DBI::errstr $uri");
            $dbh->disconnect;
            return SERVER_ERROR;
        }
	my $matched_user = $query->fetchrow_array();
	if($matched_user) {		# User matched?
	    if($config->{url}) {
		$uri=$matched_user;
	    } else {
		my $touri = $tables[$i + 1];i # Get the location to send them to
		$uri =~ s/^$config->{'location'}/$touri/; # and store this change
	    }
	    print STDERR __PACKAGE__." uri=$uri\n" if $debug;
	    last;
	}
    }
#
# If the URI wasn't changed then send the user to the default location
#
    if ($uri eq $r->uri) {
	$uri =~ s/^$config->{'location'}/$config->{'default'}/;
	print STDERR __PACKAGE__." default_uri=$uri\n" if $debug;
    }
#
# Redirect Apache to the right location, and continue.
#
    my $retval;
    if($config->{external}) {
	print STDERR __PACKAGE__." external_REDIRECT\n" if $debug;
	$r->header_out(Location=>$uri);
	$retval=REDIRECT;
    } else {
	print STDERR __PACKAGE__." internal_redirect\n" if $debug;
	$r->internal_redirect_handler($uri);
	$retval=OK;
    }
    $query->finish;
    $dbh->disconnect;
    $retval;
}
1;

__END__