The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# $Id: SQL.pm,v 1.1.1.1 2004/06/28 19:24:28 veselosky Exp $
package CGI::Builder::Auth::UserAdmin::SQL;
use DBI;
use Carp ();
use strict;
use vars qw(@ISA $VERSION);
@ISA = qw(CGI::Builder::Auth::UserAdmin);
$VERSION = (qw$Revision: 1.1.1.1 $)[1];

my %Default = (HOST => "",                  #server hostname
	       DB => "",                    #database name
	       USER => "", 	            #database login name	    
	       AUTH => "",                  #database login password
	       DRIVER => "mSQL",            #driver for DBI
	       USERTABLE => "",             #table with field names below
	       NAMEFIELD => "user",         #field for the name
	       PASSWORDFIELD => "password", #field for the password
	       );

sub new {
    my($class) = shift;
    my $self = bless { %Default, @_ } => $class;
    $self->_check(qw(DRIVER DB USERTABLE)); 
    if(!defined $self->{'DBH'}) { $self->db($self->{DB}) }
    else { $self->{'_DBH'} = $self->{'DBH'}; };
    return $self;
}

sub DESTROY {
    my($self) = @_;
    #Don't disconnect if you didn't make it.
    $self->{'_DBH'}->disconnect if(!defined $self->{'DBH'});
}

sub db {
    my($self,$db) = @_;
    my $old = $self->{DB};
    return $old unless $db;
    $self->{DB} = $db; 

    if(defined $self->{'_DBH'}) {
	$self->{'_DBH'}->disconnect;
    }

    # LS 12/1/97 -- Be sure to use Msql-modules-1.1814 (at least).
    # Do NOT  use the older DBD-mSQL-0.65.
    # The connect() method changed.
    my $source = sprintf("dbi:%s:%s",@{$self}{qw(DRIVER DB)});
    $source .= ":$self->{HOST}" if $self->{HOST};
    $source .= ":$self->{PORT}" if $self->{HOST} and $self->{PORT};
    $self->{'_DBH'} = DBI->connect($source,@{$self}{qw(USER AUTH)} ) 
	|| Carp::croak($DBI::errstr);
    return $old;
}

package CGI::Builder::Auth::UserAdmin::SQL::_generic;
use vars qw(@ISA);
@ISA = qw(CGI::Builder::Auth::UserAdmin::SQL);

sub add {
    my($self, $username, $passwd, $other) = @_;
    return(0, "add_user: no user name!") unless $username;
    return(0, "add_user: no password!") unless $passwd;
    return(0, "user '$username' already exists!") 
	if $self->exists($username);

    my(%f) = ($self->{NAMEFIELD}=>$username,
	      $self->{PASSWORDFIELD}=>$self->encrypt($passwd));
    if ($other) {
	Carp::croak('Specify other fields as a hash ref for SQL databases')
	    unless ref($other) eq 'HASH';
	  foreach (keys %{$other}) {
	      $f{$_} = $other->{$_};
	  }
    }
    my $statement = 
	sprintf("INSERT into %s (%s)\n VALUES (%s)\n",
		$self->{USERTABLE},
		join(',',keys %f),
		join(',', map {$self->{'_DBH'}->quote($f{$_})} keys %f));
#This _is_string this is silly.  It should be handled in the DBI::quote function.
#Further, if you really want to do that, the fast way is to use Scalar::Util::Numeric
		#join(',', map {$self->_is_string($_,$f{$_}) ? $self->{'_DBH'}->quote($f{$_}) : $f{$_} } keys %f));

    print STDERR $statement if $self->debug;
    $self->{'_DBH'}->do($statement) || Carp::croak($DBI::errstr);
    1;
}

sub exists {
    my($self, $username) = @_;
    my $statement = 
	sprintf("SELECT %s from %s WHERE %s=%s\n",
		@{$self}{qw(PASSWORDFIELD USERTABLE NAMEFIELD)}, $self->{'_DBH'}->quote($username));
    print STDERR $statement if $self->debug;
    my $sth = $self->{'_DBH'}->prepare($statement);
    Carp::carp("Cannot prepare sth ($DBI::err): $DBI::errstr")
	unless $sth;
    $sth->execute || Carp::croak($DBI::errstr);
    my(@row) = $sth->fetchrow;
    $sth->finish;
    return $row[0];
}

sub delete {
    my($self, $username) = @_;
    my $statement = 
	sprintf("DELETE from %s where %s=%s\n",
		@{$self}{qw(USERTABLE NAMEFIELD)}, $self->{'_DBH'}->quote($username));
    print STDERR $statement if $self->debug;
    $self->{'_DBH'}->do($statement) || Carp::croak($DBI::errstr);
}

sub update {
    my($self, $username, $passwd,$other) = @_;
    return 0 unless $self->exists($username);

    my(%f);
    if ($other) {
	Carp::croak('Specify other fields as a hash ref for SQL databases')
	    unless ref($other) eq 'HASH';
	  foreach (keys %{$other}) {
	      $f{$_} = $other->{$_};
	  }
    }

    $f{$self->{PASSWORDFIELD}}=$self->encrypt($passwd) if $passwd;

    my $statement = 
	sprintf("UPDATE %s SET %s\n WHERE %s = '%s'\n",
		$self->{USERTABLE},
		join(',', map {$_ . "=" . $self->{_DBH}->quote($f{$_}) } keys %f),
		#join(',', map {$_ . "=" . ($self->_is_string($_,$f{$_}) ? "'$f{$_}'" : $f{$_}) } keys %f),
		$self->{NAMEFIELD}, $username);
    print STDERR $statement if $self->debug;
    $self->{'_DBH'}->do($statement) || Carp::croak($DBI::errstr);
}

sub list {
    my($self) = @_;
    my $statement = 
	sprintf("SELECT %s from %s\n",
		@{$self}{qw(NAMEFIELD USERTABLE)});
    print STDERR $statement if $self->debug;
    my $sth = $self->{'_DBH'}->prepare($statement);
    Carp::carp("Cannot prepare sth ($DBI::err): $DBI::errstr")
	unless $sth;
    $sth->execute || Carp::croak($DBI::errstr);
    my($user,@list);
    while($user = $sth->fetchrow) {
	push(@list, $user);
    }
    $sth->finish;
    return @list;
}

sub fetch {
    my($self,$username,@fields) = @_;
    return(0, "fetch: no user name!") unless $username;
    return(0, "fetch: user '$username' doesn't exist") 
	unless $self->exists($username);
    my (@f);
    foreach (@fields) {
	push(@f,ref($_) ? @$_ : $_);
    }
    push (@f,'*') unless @f;
    my $statement = 
	sprintf("SELECT %s FROM %s WHERE %s = %s",
		join(',',@f),
		@{$self}{qw/USERTABLE NAMEFIELD/},
		$self->{'_DBH'}->quote($username));
    print STDERR $statement if $self->debug;
    my $sth = $self->{'_DBH'}->prepare($statement);
    Carp::carp("Cannot prepare sth ($DBI::err): $DBI::errstr")
	unless $sth;
    $sth->execute || Carp::croak($DBI::errstr);
    my $result = $sth->fetchrow_hashref;
    $sth->finish;
    return $result;
}

#sub _is_string {
#    my ($self,$field_name,$field_value) = @_;
#    if ($self->{DRIVER} =~ /^msql$/i) {
#	unless ($self->{'_TYPES'}) {
#	    require Msql;
#	    my $st = $self->{'_DBH'}->prepare("LISTFIELDS $self->{USERTABLE}") 
#		|| Carp::croak($DBI::errstr);
#	    $st->execute || Carp::croak($DBI::errstr);
#	    my $types = $st->{msql_type};
#	    foreach (@{$st->{NAME}}) {
#		$self->{'_TYPES'}->{$_} = Msql::CHAR_TYPE() eq (shift @{$types});
#	    }
#	    $st->finish();
#	}
#	return $self->{'_TYPES'}->{$field_name};
#    } else {
#	return $field_value !~ /^[0-9.E-]+$/i;
#    }
#}

sub encrypt {
    my($self) = shift; 
    my($passwd) = "";
    my($scheme) = $self->{ENCRYPT} || "crypt";
    # not quite sure where we're at risk here...
    # I am.  SQL injection is possible the previous way if crypt is ever broken.  -Rusty Phillips
    # $_[0] =~ /^[^<>;|]+$/ or Carp::croak("Bad password name"); $_[0] = $&;
    if (($self->{DRIVER} =~ /^mysql$/i) && ($scheme =~ /^MySQL(:?-Password)?$/i)) {
        my $statement = "SELECT password(?)\n";
        print STDERR $statement if $self->debug;
        my $sth = $self->{'_DBH'}->prepare($statement);
        Carp::carp("Cannot prepare sth ($DBI::err): $DBI::errstr")
	    unless $sth;
        $sth->execute($_[0]) || Carp::croak($DBI::errstr);
        my(@row) = $sth->fetchrow;
        $sth->finish;
        $passwd = $row[0];
    } else {
	$passwd = $self->SUPER::encrypt(@_);
    }
    return $passwd;
}

1;

__END__

CREATE table auth_users (
    user char(40),
    password char(20)
)