[Plweb-commits] CVS: Web/Web DBTable.pm,NONE,1.1 Config.pm,1.1.1.1,1.2 Session.pm,1.2,1.3 SimpleDB.pm,1.1.1.1,NONE

[Josh <con...@us...>]

Update of /cvsroot/plweb/Web/Web
In directory usw-pr-cvs1:/tmp/cvs-serv8727/Web

Modified Files:
	Config.pm Session.pm 
Added Files:
	DBTable.pm 
Removed Files:
	SimpleDB.pm 
Log Message:
Converted things over to use a real RDBMS.  Got rid of the stupid GDB files
in /tmp.  Added a configuration file plweb.conf.  Changed everything so the
universe looks totally different.  Had a mental awakening.  Things like that.


--- NEW FILE: DBTable.pm ---
package Web::DBTable;

use DBI;

$db = DBI->connect("dbi:" . Config->get("db_provider"),
		   Config->get('db_user'), Config->get('db_passwd'));

sub get {
    my $pkg = shift;
    my $tbl = shift;
    return bless { 'name' => $tbl }, $pkg;
}

sub first {
    my ($tbl, $fields, $where) = @_;
    my $qry = $db->prepare("select " . join(',', @$fields) . " from $tbl->{name} where $where");
    my $rcd;

    $qry->execute;

    return $qry->fetchrow_hashref;
}

sub select {
    my ($tbl, $fields, $where, $index_by) = @_;
    my $qry = $db->prepare("select " . join(',', @$fields) . " from $tbl->{name} where $where");
    my $ret = $index_by ? {} : [];
    my $rcd;

    $qry->execute;

    while ($rcd = $qry->fetchrow_hashref) {
	if ($index_by) {
	    $ret->{$rcd->{$index_by}} = $rcd;
	} else {
	    push @$ret, $rcd;
	}
    }

    return $index_by ? $ret : @$ret;
}

sub insert {
    my $table = shift;
    my %fields = @_;
    my @keys = keys %fields; # It's done this way to be ABSOLUTELY safe
    my @vals = ();
    
    my $sql = "insert into $table->{name} (" . join(',', @keys) . ") values(";
    foreach my $k (@keys) {
	my $v = $fields{$k};
	$v =~ s/\'/\\\'/g;
	push @vals, "'" . $v . "'";
    }
    $sql .= join(',', @vals) . ")";
    $db->do($sql);
}

sub update {
    my $table = shift;
    my $where = shift;
    my %fields = @_;
    my @vals = ();

    my $sql = "update $table->{name} set ";
    foreach my $key (keys %fields) {
	my $v = $fields{$key};
	$v =~ s/\'/\\\'/g;
	push @vals, "$key='$v'";
    }
    $sql .= join ',', @vals;
    $sql .= " where $where" if $where;
    $db->do($sql);
}

sub delete {
    my $table = shift;
    my $where = shift;
    my $w;
    $w = "where $where" if $where;
    $db->do("delete from $table->{name} $w");
}

1;

Index: Config.pm
===================================================================
RCS file: /cvsroot/plweb/Web/Web/Config.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -r1.1.1.1 -r1.2
*** Config.pm	2001/05/02 15:28:57	1.1.1.1
--- Config.pm	2001/10/27 09:08:33	1.2
***************
*** 1,26 ****
  package Config;
  
! my $cfgdb = Web::SimpleDB->new('/tmp/plweb-cfg.gdb');
  
! sub set {
! 	shift;
! 	return $cfgdb->set(@_);
  }
  
  sub get {
! 	shift;
! 	return $cfgdb->get(@_);
  }
  
  sub keys {
! 	shift;
! 	return $cfgdb->keys(@_);
  }
  
- sub delete {
- 	shift;
- 	return $cfgdb->delete(@_);
- }
- 
  1;
  
--- 1,26 ----
  package Config;
  
! my $cfgdb = {};
! my $line;
  
! open (WEBCFG, "< /etc/plweb.conf");
! while (! eof(WEBCFG)) {
!     chomp ($line = <WEBCFG>);
!     next if $line =~ /\#/;
!     $line =~ /(\w+)\s+(.*)/;
!     $cfgdb->{$1} = $2;
  }
+ close (WEBCFG);
  
  sub get {
!     shift;
!     return $cfgdb->{$_[0]};
  }
  
  sub keys {
!     shift;
!     return keys %$cfgdb;
  }
  
  1;
  
***************
*** 34,59 ****
  
  	use Web;
- 	
- 	# Store a single value under key 'foo'
- 	Config->set('foo', 'bar');
- 	$x = Config->get('foo');
  	
! 	# Store multiple values under 'bar'
! 	Config->set('bar', 'foo', 'baz');
! 	@y = Config->get('bar');
  	
! 	# Delete everything
  	foreach $k (Config->keys) {
! 		Config->delete($k);
  	}
  	
  =head1 DESCRIPTION
  
! This works the same way as Web::SimpleDB.  Take a look at that for
! documentation.
  
  =head1 SEE ALSO
  
! Web::SimpleDB
  
  =head1 AUTHOR
--- 34,52 ----
  
  	use Web;
  	
! 	$y = Config->get('bar');
  	
! 	# Enumerate everything
  	foreach $k (Config->keys) {
! 		Config->get($k);
  	}
  	
  =head1 DESCRIPTION
  
! Stores site-specific configuration information.
  
  =head1 SEE ALSO
  
! Web::DBTable
  
  =head1 AUTHOR

Index: Session.pm
===================================================================
RCS file: /cvsroot/plweb/Web/Web/Session.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** Session.pm	2001/09/30 02:37:57	1.2
--- Session.pm	2001/10/27 09:08:33	1.3
***************
*** 1,122 ****
  package Session;
  
! my $sessdb = Web::SimpleDB->new('/tmp/plweb-sess.gdb');
! my $sessvardb = Web::SimpleDB->new('/tmp/plweb-sessvars.gdb');
! my $uservardb = Web::SimpleDB->new('/tmp/plweb-uservars.gdb');
  
  sub login {
! 	my $pkg = shift;
! 	my $user = shift;
! 	my $pwd = shift;
! 	my $proto;
! 	my $sessid = sprintf('%.8x', time) . sprintf('%.8x', rand() * 2**32);
! 	
! 	if ($proto = _usr_authenticate($user, $pwd)) {
! 	
! 		# Multiple logins aren't allowed
! 		foreach my $k ($sessdb->keys) {
! 			my @rcd = $sessdb->get($k);
! 			if ($rcd[0] eq $proto && $rcd[1] eq $user) {
! 				$sessid = $k;
! 			}
! 		}
! 	
! 		Browser->cookie('sessid', $sessid);
! 		$sessdb->set($sessid, $proto, $user);
! 		return bless { sessid=>$sessid, proto=>$proto, user=>$user }, $pkg;
  	}
! 	return undef;
  }
  
  sub get {
! 	my $pkg = shift;
! 	my $self;
! 	my $sid = Browser->cookie('sessid');
! 	
! 	return undef if ! $sid;
! 	
! 	my @rec = $sessdb->get($sid);
! 	if (! @rec) {
! 		Browser->cookie('sessid', '');
! 		return undef;
! 	}
! 	
! 	my $self = bless {
! 		sessid => $sid,
! 		proto => $rec[0],
! 		user => $rec[1]
! 	}, $pkg;
! 	return $self;
  }
  
  sub logout {
! 	my $self = shift;
! 	$sessdb->delete($self->{'sessid'});
! 	$sessvardb->delete($self->{'sessid'});
! 	Browser->cookie('sessid', '');
  }
  
  sub username {
! 	return $_[0]->{'user'};
  }
  
  sub proto {
! 	return $_[0]->{'proto'};
  }
  
  sub sess_var {
! 	my $self = shift;
! 	my $name = shift;
! 	my $val = shift;
! 	
! 	my %sessvars = $sessvardb->get($self->{'sessid'});
! 	if (defined $val) {
! 		$sessvars{$name} = $val;
! 		$sessvardb->set($self->{'sessid'}, %sessvars);
  	}
! 	return $sessvars{$name};
  }
  
  sub user_var {
! 	my $self = shift;
! 	my $name = shift;
! 	my $val = shift;
! 	
! 	my %uservars = $uservardb->get($self->{'proto'}.':'.$self->{'user'});
! 	if (defined $val) {
! 		$uservars{$name} = $val;
! 		$uservardb->set($self->{'proto'}.':'.$self->{'user'}, %uservars);
  	}
! 	return $uservars{$name};
  }
  
  sub _usr_authenticate {
! 	my $user = shift;
! 	my $pwd = shift;
! 	
! 	my $proto;
! 	
! 	my @authlist = Config->get(".auth.protolist");
! 	
! 	foreach $proto (@authlist) {
! 		eval "use $proto\;";
! 		die $@ if $@;
! 	}
! 	
! 	foreach $proto (@authlist) {
! 		return $proto if &{"$proto\::authenticate"}($user, $pwd);
! 	}
! 	return undef;
  }
  
  sub _usr_change_pwd {
! 	my $sess = shift;
! 	my $oldpw = shift;
! 	my $newpw = shift;
! 	
! 	eval "use $sess->{'proto'}\;";
! 	
! 	return &{$sess->{'proto'} . '::change_pwd'}($sess->{'user'},
! 												$oldpw, $newpw);
  }
  
--- 1,134 ----
  package Session;
  
! my $sessions = Web::DBTable->get('sys_sessions');
! my $sessvars = Web::DBTable->get('sys_sessvars');
! my $uservars = Web::DBTable->get('sys_uservars');
  
  sub login {
!     my $pkg = shift;
!     my $user = shift;
!     my $pwd = shift;
!     my $proto;
!     my $sessid = sprintf('%.8x', time) . sprintf('%.8x', rand() * 2**32);
!     
!     if ($proto = _usr_authenticate($user, $pwd)) {
! 	
! 	# Multiple logins aren't allowed
! 	my $oldsess;
! 	if ($oldsess = $sessions->first(['*'], "user='$user'")) {
! 	    Browser->cookie('sessid', $oldsess->{'sessid'});
! 	} else {
! 	    $sessions->insert('sessid' => $sessid,
! 			      'proto' => $proto, 'user' => $user);
  	}
! 	return bless { sessid=>$sessid, proto=>$proto, user=>$user }, $pkg;
!     }
!     return undef;
  }
  
  sub get {
!     my $pkg = shift;
!     my $self;
!     my $sid = Browser->cookie('sessid');
!     
!     return undef if ! $sid;
!     
!     my $rec = $sessions->first(['*'], "sessid='$sid'");
!     if (! $rec) {
! 	Browser->cookie('sessid', '');
! 	return undef;
!     }
!     
!     my $self = bless {
! 	sessid => $rec->{'sessid'},
! 	proto => $rec->{'proto'},
! 	user => $rec->{'user'}
!     }, $pkg;
!     return $self;
  }
  
  sub logout {
!     my $self = shift;
!     $sessions->delete("sessid='$self->{'sessid'}'");
!     $sessvars->delete("sessid='$self->{'sessid'}'");
!     Browser->cookie('sessid', '');
  }
  
  sub username {
!     return $_[0]->{'user'};
  }
  
  sub proto {
!     return $_[0]->{'proto'};
  }
  
  sub sess_var {
!     my $self = shift;
!     my $name = shift;
!     my $val = shift;
!     my $where = "sessid='$self->{'sessid'}' and name='$name'";
!     
!     my $sv = $sessvars->first(['*'], $where);
!     if (defined $val) {
! 	if ($sv) {
! 	    $sessvars->update($where, 'value' => $val);
! 	} else {
! 	    $sessvars->insert('sessid' => $self->{'sessid'},
! 			      'name' => $name, 'value' => $val);
  	}
! 	$sv->{'value'} = $val;
!     }
! 
!     return $sv->{'value'};
  }
  
  sub user_var {
!     my $self = shift;
!     my $name = shift;
!     my $val = shift;
!     my $where = "user='$self->{'user'}' and name='$name'";
!     
!     my $sv = $uservars->first(['*'], $where);
!     if (defined $val) {
! 	if ($sv) {
! 	    $uservars->update($where, 'value' => $val);
! 	} else {
! 	    $uservars->insert('user' => $self->{'user'},
! 			      'name' => $name, 'value' => $val);
  	}
! 	$sv->{'value'} = $val;
!     }
! 
!     return $sv->{'value'};
  }
  
  sub _usr_authenticate {
!     my $user = shift;
!     my $pwd = shift;
!     
!     my $proto;
!     
!     my @authlist = split ',', Config->get("auth_mode");
!     
!     foreach $proto (@authlist) {
! 	eval "use $proto\;";
! 	die $@ if $@;
!     }
!     
!     foreach $proto (@authlist) {
! 	return $proto if &{"$proto\::authenticate"}($user, $pwd);
!     }
!     return undef;
  }
  
  sub _usr_change_pwd {
!     my $sess = shift;
!     my $oldpw = shift;
!     my $newpw = shift;
!     
!     eval "use $sess->{'proto'}\;";
!     
!     return &{$sess->{'proto'} . '::change_pwd'}($sess->{'user'},
! 						$oldpw, $newpw);
  }
  
***************
*** 200,202 ****
  Joshua J. Berry <con...@so...>
  
! =cut
\ No newline at end of file
--- 212,214 ----
  Joshua J. Berry <con...@so...>
  
! =cut

--- SimpleDB.pm DELETED ---