# # modules/User.pm # # Developed by Ondrej Jombik # Copyright (c) 2004 Platon SDG, http://platon.sk/ # Licensed under terms of GNU General Public License. # All rights reserved. # # Changelog: # 17/01/2004 - created # # $Platon$ package User; use strict; use Carp; use vars qw($VERSION @ISA @EXPORT $AUTOLOAD); @ISA = qw(Exporter); @EXPORT = qw( ); $VERSION = '0.1'; use dbh_query; use Digest::MD5 qw(md5_hex); sub new # {{{ { my $this = shift; my $class = ref($this) || $this; my $self = {}; bless $self, $class; $self->{'sid'} = shift; $self->{'uid'} = $self->getUserID(); return $self; } # }}} sub login # {{{ { my $self = shift; my $login = shift; my $password = shift; $password = md5_hex($password); my $query = sprintf( 'SELECT uid FROM users' . ' WHERE login = %s AND password = %s', dbh_quote($login), dbh_quote($password) ); my $new_uid = dbh_query( $query, 'SCALAR' ); return 0 if ( !defined $new_uid || !$new_uid > 0 ); $self->{'uid'} = $new_uid; $self->{'sid'} = md5_hex( $password . time() ); $query = sprintf( 'UPDATE users SET' . ' session_id = %s, login_count = login_count + 1,' . ' last_login = SYSDATE(), last_access = SYSDATE()' . ' WHERE login = %s AND password = %s', dbh_quote( $self->{'sid'} ), dbh_quote($login), dbh_quote($password) ); dbh_query( $query, 'UNDEF' ); return 1; } # }}} sub logout # {{{ { my $self = shift; my $query = 'UPDATE users SET' . ' session_id = NULL, last_logout = SYSDATE()' . ' WHERE uid = ' . dbh_quote( $self->{'uid'} ); dbh_query( $query, 'UNDEF' ); $self->{'uid'} = 0; $self->{'sid'} = undef; return 1; } # }}} sub getUserID # {{{ { my $self = shift; my $sid = shift; return $self->{'uid'} if ( defined $self->{'uid'} ); $sid = $self->{'sid'} if ( !defined $sid ); my $query = sprintf( 'SELECT uid FROM users WHERE session_id = %s', dbh_quote($sid) ); my $uid = dbh_query( $query, 'SCALAR' ); return defined $uid ? $uid : 0; # anonymous uid is 0 } # }}} sub updateLastAccess # {{{ { my $self = shift; return 1 if $self->isAnonymous(); # do not update for anonymous my $query = 'UPDATE users SET' . ' last_access = SYSDATE() WHERE uid = ' . dbh_quote( $self->{'uid'} ); dbh_query( $query, 'UNDEF' ); return 1; } # }}} sub isAnonymous # {{{ { my $self = shift; return $self->getUserID() == 0; } # }}} sub getAnnonymous # {{{ { my $anonymous_user = { uid => '0', login => 'anonymous', password => '', session_id => '', parent_uid => 'N/A', login_count => 'N/A', last_login => 'N/A', last_logout => 'N/A', last_access => 'N/A' }; return $anonymous_user; } # }}} sub getAnnonymousLogin # {{{ { return User::getAnnonymous()->{'login'}; } # }}} sub exist # {{{ { my $uid = shift; my $query = 'SELECT COUNT(*) FROM users WHERE uid = ' . dbh_quote($uid); return dbh_query( $query, 'SCALAR' ) == 1; } # }}} sub get # {{{ { my $self = shift; my $uid = $self =~ /^User=HASH/ ? $self->{'uid'} : $self; return User::getAnnonymous() if ( $uid == 0 ); my $query = 'SELECT u.*, u0.login AS parent_login,' . ' u1.login AS created_by_login, u2.login AS changed_by_login FROM users u' . ' LEFT JOIN users u0 ON u.parent_uid = u0.uid' . ' LEFT JOIN users u1 ON u.created_by = u1.uid' . ' LEFT JOIN users u2 ON u.changed_by = u2.uid' . ' WHERE u.uid = ' . dbh_quote($uid); my $user = ( dbh_query( $query, 'HASHREF' ) )[0]; $user->{'created_by_login'} ||= User::getAnnonymousLogin(); $user->{'changed_by_login'} ||= User::getAnnonymousLogin(); return $user; } # }}} sub set # {{{ { my $uid = shift; my $data = shift; my $cur_login = shift; my %real_data = (); my $key; my $val; foreach $key ( keys %$data ) { $val = $data->{$key}; next if ( $key !~ /^(login|password|firstname|middlename|lastname|parent_uid|notes)$/ ); if ( $key eq 'password' ) { # password change next if not( length $val > 0 ); $val = md5_hex($val) } # exit immidiatelly if someone is trying to insert anonymous account return 0 if ( $key eq 'login' && $val eq User::getAnnonymousLogin() ); $real_data{$key} = dbh_quote($val); } if ( scalar keys %real_data ) { $real_data{'changed_by'} = dbh_quote($cur_login); $real_data{'changed_date'} = 'SYSDATE()'; my $query; if ( User::exist($uid) ) { my $delim = ' '; $query = 'UPDATE users SET'; foreach $key ( keys %real_data ) { $val = $real_data{$key}; $query .= $delim; $query .= $key; $query .= '='; $query .= $val; $delim = ',' if $delim ne ','; } $query .= ' WHERE uid = ' . dbh_quote($uid) } else { $query = sprintf( 'INSERT INTO users' . '(login, password, firstname, middlename, lastname,' . ' parent_uid, notes, login_count,' . ' created_by, created_date, changed_by, changed_date)' . ' VALUES (%s, %s, %s, %s, %s, %s, %s, 0, %s, %s, %s, %s) ', $real_data{'login'}, $real_data{'password'}, $real_data{'firstname'}, $real_data{'middlename'}, $real_data{'lastname'}, $real_data{'parent_uid'}, $real_data{'notes'}, $real_data{'changed_by'}, $real_data{'changed_date'}, $real_data{'changed_by'}, $real_data{'changed_date'} ); } dbh_query( $query, 'UNDEF' ); } } # }}} sub delete # {{{ { my $uid = shift; my $query = 'DELETE FROM users WHERE uid = ' . dbh_quote($uid); dbh_query( $query, 'UNDEF' ); } # }}} sub getCount # {{{ { my $query = 'SELECT COUNT(*) FROM users'; return dbh_query( $query, 'SCALAR' ); } # }}} sub getAll # {{{ { return User::getFilteredList( undef, undef ); } # }}} sub getFilteredList # {{{ { my $where = User::_createWhere(shift); my $order = User::_createOrder(shift); my $query = 'SELECT u.*, u0.login AS parent_login' . ' FROM users u LEFT JOIN users u0 ON u.parent_uid = u0.uid'; $query .= " WHERE $where" if ( length $where ); $query .= " ORDER BY $order" if ( length $order ); my $ret = dbh_query( $query, 'HASHREF' ); unshift @$ret, User::getAnnonymous(); return $ret; } # }}} sub getLoginList # {{{ { my $query = 'SELECT uid, login FROM users'; my %ret = dbh_query( $query, 'HASH' ); $ret{0} = User::getAnnonymousLogin(); return wantarray ? %ret : \%ret; } # }}} sub _createWhere # {{{ { my $filter = shift; my @ret_ar = (); my $key; my $val; foreach $key ( keys %$filter ) { $val = $filter->{$key}; next if ( $key !~ /^(uid|login|firstname|middlename|lastname|parent_login|login_count)$/ ); next if ( !length $val ); if ( $key eq 'uid' ) { push @ret_ar, sprintf( 'u.%s = %d', $key, $val ) if ( $val =~ /\d+/ ); next; } if ( $key =~ /_price$/ ) { push @ret_ar, sprintf( 'u.%s = %f', $key, $val ) if ( $val =~ /[\d]*\.[\d]*/ ); next; } my $prefix; if ( $key =~ /parent_login$/ ) { $key =~ s/parent_//g; $prefix = 'u0.'; } else { $prefix = 'u.'; } push @ret_ar, sprintf( 'LOWER(%s%s) LIKE LOWER(%s)', $prefix, $key, dbh_quote( '%' . $val . '%' ) ); } return join ( ' AND ', @ret_ar ); } # }}} sub _createOrder # {{{ { my $key = shift; return '' if ( not defined $key ); return '' if ( $key !~ /^[-]?(uid|login|firstname|middlename|lastname|parent_login|login_count)$/ ); my $prefix; if ( $key =~ /parent_login$/ ) { $key =~ s/parent_//g; $prefix = 'u0.'; } else { $prefix = 'u.'; } return $prefix . substr( $key, 1 ) . ' DESC' if ( substr( $key, 0, 1 ) eq '-' ); return $prefix . $key; } # }}} 1; __END__ =head1 NAME User - <<>> =head1 SYNOPSIS use User; my $xxx = new User; =head1 DESCRIPTION The User module allows you ... <<>> =head2 EXPORT <>> =head1 SEE ALSO =head1 AUTHORS Ondrej Jombik, =cut # vim: ts=4 # vim600: fdm=marker fdl=0 fdc=3