my first mod_perl works but ...

["Peter J. Schoenster" <we...@rede.com>]

Hello,

Nearly all my work has been on virtual servers and recently our 
hosting company (iserver) began to support mod_perl on their 
freebsd servers ... so other than one time in the past I have 
not had the opportunity to write code for mod_perl (except on 
our intranet where it has been for personal use).  As this code 
will be going out for public use I feel more responsiblity. I'm 
still in a situation of 'not knowing what I don't know'.  I 
would really, really appreciate criticisms (with suggestion for 
improvement) for the following code.  I would have used some of 
the modules that seem to do what this does but I did not 
like/understand them and, as  you can imagine, the client wants 
this to work asap.  Thanks.

#!/usr/local/bin/perl5 -w

$|++;

use strict;
use Apache::Request();
use Apache::Cookie();
use DBISUPPORT;
use SERMON_HTML;

use vars qw($r $debug);

$r = Apache->request; 
my $q= Apache::Request->new($r, POST_MAX => 25);
my $html = SERMON_HTML->new();
$debug = 0;


print_headers(1) if $debug;

my $level = '';
my $u = $q->param('u') || '';
my $p = $q->param('p') || '';

$level = verify_user() if (!$u && !$p);

if($level) {
	print_headers();
	print $html->graceful_snippets($level);
	print qq|Level	$level<hr>|;
}else {
	my $user_level = &db_lookup($u,$p);
	if(!$user_level) {
		print_headers();
		print $html->graceful_snippets('generic_header');
		print $html->graceful_snippets('login');
		print $html->graceful_snippets('footer');
	}else {
		print_headers(1,$user_level);
		print $html->graceful_snippets($user_level);
		print qq|Level	$user_level<hr>|;
	}
}

######################################################
##					 BEGIN SUBS						##
sub print_headers {
	my $send_cookie = shift || 0;
	my $nivel = shift || 0;
	$r->content_type("text/html"); 
	if($send_cookie && $nivel > 0) {
		$r->headers_out->add("Set-Cookie" =>qq|nivel=$nivel|); 
	}
	$r->send_http_header();
}
##
sub verify_user {
	my %headers_in = $r->headers_in;
	my $cookie = $headers_in{'Cookie'};
	my(@bites) = split /;/,$cookie;
	my $n = '';
	my $v = '';
	for(@bites) {
		($n,$v) = split /=/;
		$n =~ s/^\s+//;
		if($n eq 'nivel') {
			return $v;
		}
	}
	return undef;
}
##
sub db_lookup {
	my($username,$password) = @_;
	my $dbi= DBISUPPORT->new('this_cgi'=>'/cgi-
bin/login.pl','database'=>'xxxx','username'=>'xxxx','password'=>'
xxxx');	
	my $table = 'members';
	my $sql = qq|SELECT username,level,password FROM $table WHERE 
username = '$username' AND password = '$password'|;
	my $dbu = '';
	my $dbg = '';
	my $dbp = '';
	($dbu,$dbg,$dbp)= $dbi->{'db'}->selectrow_array( qq{ $sql });
	$dbi->{'db'}->disconnect();
	if($dbu && $dbg && $dbp) {
		return $dbg;
	}else {
		return undef;
	}
	
}
##

---------------------------
"Reality is that which, when you stop believing in it, doesn't go
away".
                -- Philip K. Dick