r1311 - in packages/libuser-simple-perl/trunk: . debian lib/User
lib/User/Simple t
Gunnar Wolf
gwolf at costa.debian.org
Sat Aug 27 00:58:26 UTC 2005
Author: gwolf
Date: 2005-08-27 00:58:24 +0000 (Sat, 27 Aug 2005)
New Revision: 1311
Modified:
packages/libuser-simple-perl/trunk/Changes
packages/libuser-simple-perl/trunk/MANIFEST
packages/libuser-simple-perl/trunk/META.yml
packages/libuser-simple-perl/trunk/Makefile.PL
packages/libuser-simple-perl/trunk/README
packages/libuser-simple-perl/trunk/debian/changelog
packages/libuser-simple-perl/trunk/debian/control
packages/libuser-simple-perl/trunk/lib/User/Simple.pm
packages/libuser-simple-perl/trunk/lib/User/Simple/Admin.pm
packages/libuser-simple-perl/trunk/t/User-Simple.t
Log:
New upstream version
Modified: packages/libuser-simple-perl/trunk/Changes
===================================================================
--- packages/libuser-simple-perl/trunk/Changes 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/Changes 2005-08-27 00:58:24 UTC (rev 1311)
@@ -1,5 +1,9 @@
Revision history for Perl extension User::Simple.
+1.0 Sun Aug 21 23:06:08 2005
+ - Now correctly works with any kind of DBD backend
+ - Added a complete test suite, which surprisingly worked!
+
0.9 Sat Jul 30 10:45:15 2005
- Added Date::Calc and Digest::MD5 as prerequisite modules
- Added a more granular 'level' for the users instead of the
Modified: packages/libuser-simple-perl/trunk/MANIFEST
===================================================================
--- packages/libuser-simple-perl/trunk/MANIFEST 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/MANIFEST 2005-08-27 00:58:24 UTC (rev 1311)
@@ -1,8 +1,8 @@
Changes
+lib/User/Simple.pm
+lib/User/Simple/Admin.pm
Makefile.PL
MANIFEST
+META.yml
README
t/User-Simple.t
-lib/User/Simple.pm
-lib/User/Simple/Admin.pm
-META.yml Module meta-data (added by MakeMaker)
Modified: packages/libuser-simple-perl/trunk/META.yml
===================================================================
--- packages/libuser-simple-perl/trunk/META.yml 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/META.yml 2005-08-27 00:58:24 UTC (rev 1311)
@@ -1,11 +1,12 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: User-Simple
-version: 0.9
+version: 1.0
version_from: lib/User/Simple.pm
installdirs: site
requires:
Date::Calc: 0
+ DBI: 0
Digest::MD5: 0
distribution_type: module
Modified: packages/libuser-simple-perl/trunk/Makefile.PL
===================================================================
--- packages/libuser-simple-perl/trunk/Makefile.PL 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/Makefile.PL 2005-08-27 00:58:24 UTC (rev 1311)
@@ -6,7 +6,9 @@
NAME => 'User::Simple',
VERSION_FROM => 'lib/User/Simple.pm', # finds $VERSION
PREREQ_PM => {Date::Calc => 0,
- Digest::MD5 => 0}, # e.g., Module::Name => 1.1
+ Digest::MD5 => 0,
+ DBI => 0,
+ }, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/User/Simple.pm', # retrieve abstract from module
AUTHOR => 'Gunnar Wolf <gwolf@>') : ()),
Modified: packages/libuser-simple-perl/trunk/README
===================================================================
--- packages/libuser-simple-perl/trunk/README 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/README 2005-08-27 00:58:24 UTC (rev 1311)
@@ -2,8 +2,8 @@
User::Simple provides a very simple framework for validating users,
managing their sessions and storing a minimal set of information (this
-is, a meaningful user login/password pair and the user's name) via a
-database. The sessions can be used as identifiers for i.e. cookies on
+is, a meaningful user login/password pair, the user's name and level) via
+a database. The sessions can be used as identifiers for i.e. cookies on
a Web system. The passwords are stored as MD5 hashes (this means, the
password is not stored in clear text).
@@ -11,7 +11,8 @@
functionalities to manage the users.
User::Simple was originally developed with a PostgreSQL database in
-mind, but should work with any DBD.
+mind, but should work with any DBD, even those not implemented with a
+real RDBMS (i.e. XBase, CSV, etc).
INSTALLATION
@@ -29,7 +30,11 @@
Date::Calc
Digest::MD5
+ DBI
+DBI is not called directly from within the module, but it is required
+in order to do anything with it.
+
COPYRIGHT AND LICENCE
Copyright (C) 2005 by Gunnar Wolf
Modified: packages/libuser-simple-perl/trunk/debian/changelog
===================================================================
--- packages/libuser-simple-perl/trunk/debian/changelog 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/debian/changelog 2005-08-27 00:58:24 UTC (rev 1311)
@@ -1,3 +1,10 @@
+libuser-simple-perl (1.0-1) unstable; urgency=low
+
+ * New upstream release
+ * Added dependency on libdbi, build-dependency on libdbd-xbase
+
+ -- Gunnar Wolf <gwolf at debian.org> Fri, 26 Aug 2005 19:38:36 -0500
+
libuser-simple-perl (0.9-1) unstable; urgency=low
* Bumped up standards-version to 3.6.2
Modified: packages/libuser-simple-perl/trunk/debian/control
===================================================================
--- packages/libuser-simple-perl/trunk/debian/control 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/debian/control 2005-08-27 00:58:24 UTC (rev 1311)
@@ -2,13 +2,13 @@
Section: perl
Priority: optional
Build-Depends: debhelper (>= 4.0.2)
-Build-Depends-Indep: perl (>= 5.8.0-7), libdate-calc-perl
+Build-Depends-Indep: perl (>= 5.8.0-7), libdate-calc-perl, libdbi-perl, libdbd-xbase-perl
Maintainer: Gunnar Wolf <gwolf at debian.org>
Standards-Version: 3.6.2
Package: libuser-simple-perl
Architecture: all
-Depends: ${perl:Depends}, ${misc:Depends}, libdate-calc-perl
+Depends: ${perl:Depends}, ${misc:Depends}, libdate-calc-perl, libdbi-perl
Description: Simple user sessions management
User::Simple provides a very simple framework for validating users,
managing their sessions and storing a minimal set of information (this
@@ -18,6 +18,6 @@
password is not stored in clear text).
.
User::Simple was originally developed with a PostgreSQL database in
- mind, but should work with any real DBMS. Sadly, this rules out DBD::CSV,
- DBD::XBase, DBD::Excel and many others - The user table requires the driver
- to implement primary keys and NOT NULL/UNIQUE constraints.
+ mind, but should work with any DBI handle, be it from a real database
+ (i.e. PostgreSQL, Firebird, MySQL) or from a file-based one
+ (DBD::CSV, DBD::XBase, DBD::DBM, etc.)
Modified: packages/libuser-simple-perl/trunk/lib/User/Simple/Admin.pm
===================================================================
--- packages/libuser-simple-perl/trunk/lib/User/Simple/Admin.pm 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/lib/User/Simple/Admin.pm 2005-08-27 00:58:24 UTC (rev 1311)
@@ -10,10 +10,10 @@
=head1 SYNOPSIS
- $ua = User::Simple::Admin->new($db, $user_table, [$adm_level]);
+ $ua = User::Simple::Admin->new($db, $user_table);
- $ua = User::Simple::Admin->create_db_structure($db, $user_table,
- [$adm_level]);
+ $ua = User::Simple::Admin->create_rdbms_db_structure($db, $user_table);
+ $ua = User::Simple::Admin->create_plain_db_structure($db, $user_table);
$ok = User::Simple::Admin->has_db_structure($db, $user_table);
%users = $ua->dump_users;
@@ -22,13 +22,10 @@
$login = $ua->login($id);
$name = $ua->name($id);
$level = $ua->level($id);
- $is_admin = $ua->is_admin($id);
$ok = $usr->set_login($id, $login);
$ok = $usr->set_name($id, $name);
$ok = $usr->set_level($id, $level);
- $ok = $usr->set_admin($id);
- $ok = $usr->unset_admin($id);
$ok = $usr->set_passwd($id, $passwd);
$ok = $usr->clear_session($id);
@@ -44,40 +41,41 @@
User::Simple::Admin works as a regular administrator would: The module should
be instantiated only once for all of your users' administration, if possible,
-not instantiated once for each user (in contraposition to L<User::Simple>, as
-it works from each of the users' perspective in independent instantiations).
+and not instantiated once for each user (in contraposition to L<User::Simple>,
+as it works from each of the users' perspective in independent instantiations).
Note also that User::Simple::Admin does b<not> perform the administrative user
checks - It is meant to be integrated to your system, and it is your system
which should carry out all of the needed authentication checks.
-There are some oddly named methods and attributes you will find both in
-L<User::Simple> and this modules - C<is_admin>, C<set_admin>, C<unset_admin>,
-C<adm_level>. Please consider them all as B<deprecated>. They are provided only
-for backward compatibility, and will be dropped in a future version.
-
=head2 CONSTRUCTOR
Administrative actions for User::Simple modules are handled through this
Admin object. To instantiate it:
- $ua = User::Simple::Admin->new($db, $user_table, [$adm_level]);
+ $ua = User::Simple::Admin->new($db, $user_table);
$db is an open connection to the database where the user data is stored.
$user_table is the name of the table that holds the users' data.
-The optional $adm_level argument indicates from which level on are users
-recognized as administrative - This can be any arbitrary nonnegative integer.
-If this parameter is not specified, it will default to 1, having basically a
-correspondence to Perl's handling of truth values.
-
If we do not yet have the needed DB structure to store the user information,
we can use this class method as a constructor as well:
- $ua = User::Simple::Admin->create_db_structure($db, $user_table,
- [$adm_level])
+ $ua = User::Simple::Admin->create_rdbms_db_structure($db, $user_table);
+ $ua = User::Simple::Admin->create_plain_db_structure($db, $user_table);
+
+The first one should be used if your DBI handle ($db) points to a real RDBMS,
+such as PostgreSQL or MySQL. In case you are using a file-based DBD (such as
+DBD::XBase, DBD::DBM, DBD::CVS or any other which does not use a real RDBMS
+for storage), use C<User::Simple::Admin-E<gt>create_plain_db_structure>
+instead. What is the difference? In the first case, we will create a table
+that has internal consistency checks - Some fields are declared NOT NULL, some
+fields are declared UNIQUE, and the user ID is used as a PRIMARY KEY. This
+cannot, of course, be achieved using file-based structures, so the integrity
+can only be maintained from within our scripts.
+
=head2 QUERYING FOR DATABASE READINESS
In order to check if the database is ready to be used by this module with the
@@ -92,18 +90,15 @@
Will return a hash with the data regarding the registered users, in the
following form:
- ( $id1 => { level => $level1, is_admin => $is_admin1,
- name => $name1, login => $login1},
- $id2 => { level => $level2, is_admin => $is_admin2,
- name => $name2, login => $login2},
+ ( $id1 => { level => $level1, name => $name1, login => $login1},
+ $id2 => { level => $level2, name => $name2, login => $login2},
(...) )
=head2 CREATING, QUERYING AND MODIFYING USERS
$id = $ua->new_user($login, $name, $passwd, $level);
-Creates a new user with the specified data. $is_admin is a boolean value - Use
-1 for true, 0 for false. Returns the new user's ID.
+Creates a new user with the specified data. Returns the new user's ID.
$ok = $ua->remove_user($id);
@@ -113,7 +108,6 @@
$login = $ua->login($id);
$name = $ua->name($id);
$level = $ua->level($id);
- $is_admin = $ua->is_admin($id);
Get the value of each of the mentioned attributes. Note that in order to get
the ID you can supply the login, every other method answers only to the ID. In
@@ -128,21 +122,6 @@
Modifies the requested attribute of the specified user, setting it to the new
value.
- $ok = $usr->set_admin($id);
- $ok = $usr->unset_admin($id);
-
-Sets or removes the administrative status of this user. Please note that this
-is done relative to the value specified as C<$adm_level> upon the
-User::Simple::Admin object's instantiation - By calling C<set_admin>, the
-user's level will be set to the minimum administrative value (this means, to
-the current C<$adm_level>). By calling unsed_admin, it will be set to zero.
-
-Note that the C<set_admin> and C<unset_admin> methods are provided for
-backwards compatibility and should be considered as B<deprecated> - In order
-to set a user's level, you should call C<set_level> instead. Support for these
-two methods (and to the is_admin idea in general) will be dropped in the
-future.
-
=head2 SESSIONS
$ok = $usr->clear_session($id);
@@ -193,7 +172,13 @@
return undef;
}
- $adm_level = 1 unless defined $adm_level;
+ if (defined $adm_level) {
+ carp 'adm_level is considered deprecated and will be removed in'.
+ ' future releases.';
+ } else {
+ $adm_level = 1;
+ }
+
if ($adm_level !~ /^\d+$/) {
carp "adm_level must be a non-negative integer";
return undef;
@@ -220,7 +205,7 @@
######################################################################
# Creating the needed structure
-sub create_db_structure {
+sub create_rdbms_db_structure {
my ($class, $db, $table, $sth);
$class = shift;
$db = shift;
@@ -229,14 +214,13 @@
# Remember some DBD backends don't implement 'serial' - Use 'integer' and
# some logic on our side instead
unless ($sth = $db->prepare("CREATE TABLE $table (
- id integer PRIMARY KEY,
- login varchar NOT NULL UNIQUE,
- name varchar NOT NULL,
- passwd varchar,
--- is_admin bool NOT NULL DEFAULT 'f',
- level integer NOT NULL DEFAULT 0,
- session varchar UNIQUE,
- session_exp varchar)") and $sth->execute) {
+ id serial PRIMARY KEY,
+ login varchar(100) NOT NULL UNIQUE,
+ name varchar(100) NOT NULL,
+ passwd char(32),
+ level integer NOT NULL,
+ session char(32) UNIQUE,
+ session_exp varchar(20))") and $sth->execute) {
carp "Could not create database structure using table $table";
return undef;
}
@@ -244,6 +228,29 @@
return $class->new($db, $table);
}
+sub create_plain_db_structure {
+ my ($class, $db, $table, $sth);
+ $class = shift;
+ $db = shift;
+ $table = shift;
+
+ # Remember some DBD backends don't implement 'serial' - Use 'integer' and
+ # some logic on our side instead
+ unless ($sth = $db->prepare("CREATE TABLE $table (
+ id integer,
+ login varchar(100),
+ name varchar(100),
+ passwd char(32),
+ level integer,
+ session char(32),
+ session_exp varchar(20))") and $sth->execute) {
+ carp "Could not create database structure using table $table";
+ return undef;
+ }
+
+ return $class->new($db, $table);
+}
+
sub has_db_structure {
my ($class, $db, $table, $sth);
$class = shift;
@@ -256,7 +263,7 @@
# But usually, this check will be enough just to determine if we have the
# structure ready.
return 1 if ($sth=$db->prepare("SELECT id, login, name, passwd, level,
- session, session_exp FROM $table LIMIT 1") and $sth->execute);
+ session, session_exp FROM $table") and $sth->execute);
return 0;
}
@@ -322,7 +329,7 @@
my ($self, $id);
$self = shift;
$id = shift;
- $self->_debug(2,"is_admin is deprecated! Please use level instead");
+ carp "is_admin is deprecated! Please use level instead";
return ($self->{adm_level} <= $self->level($id)) ? 1 : 0;
}
@@ -330,10 +337,16 @@
# Modifying information
sub set_login {
- my ($self, $id, $new);
+ my ($self, $id, $new, $sth, $ret);
$self = shift;
$id = shift;
$new = shift;
+
+ if (my $used = $self->id($new)) {
+ carp "The requested login is already used (ID $used).";
+ return undef;
+ }
+
return $self->_set_field($id, 'login', $new);
}
@@ -357,7 +370,7 @@
my ($self, $id);
$self = shift;
$id = shift;
- $self->_debug(2,"set_admin is deprecated! Please use level instead");
+ carp "set_admin is deprecated! Please use level instead";
return $self->set_level($id, $self->{adm_level});
}
@@ -365,7 +378,7 @@
my ($self, $id);
$self = shift;
$id = shift;
- $self->_debug(2,"unset_admin is deprecated! Please use level instead");
+ carp "unset_admin is deprecated! Please use level instead";
return $self->set_level($id, 0);
}
@@ -392,18 +405,32 @@
# User creation and removal
sub new_user {
- my ($self, $login, $name, $passwd, $level, $id, $orig_re);
+ my ($self, $login, $name, $passwd, $level, $id, $db, $orig_state,
+ $has_transact);
$self = shift;
$login = shift;
$name = shift;
$passwd = shift;
$level = shift || 0; # Don't whine on undef
- $orig_re = $self->{db}->{RaiseError};
+ # We will use the database handler over and over - Get a shortcut.
+ $db = $self->{db};
+
+ # If available, we will do all this work inside a transaction. Sadly, not
+ # every DBD provides such a facility - By trying to begin_work and
+ # then commit on an empty transaction, we can check if this DBD does
+ # provide it.
+ eval {
+ $db->begin_work;
+ $db->commit;
+ };
+ $has_transact = $@ ? 0 : 1;
+
+ $orig_state = $db->{RaiseError};
eval {
- my ($sth, $id);
- $self->{db}->begin_work;
- $self->{db}->{RaiseError} = 1;
+ my ($sth);
+ $db->begin_work if $has_transact;
+ $db->{RaiseError} = 1;
# Not all DBD backends implement the 'serial' datatype - We use a
# simple integer, and we just move the 'serial' logic to this point,
@@ -413,29 +440,35 @@
# 'primary key'. Any DBD implementing unicity will correctly fail.
# And... Well, nobody expects too high trust from a DBD backend which
# does not implement unicity, right? :)
- $sth = $self->{db}->prepare("SELECT id FROM $self->{tbl} ORDER BY
- id desc LIMIT 1");
+ $sth = $db->prepare("SELECT id FROM $self->{tbl} ORDER BY
+ id desc");
$sth->execute;
($id) = $sth->fetchrow_array;
$id++;
- $sth = $self->{db}->prepare("INSERT INTO $self->{tbl} (id, login, name,
+ $sth = $db->prepare("INSERT INTO $self->{tbl} (id, login, name,
level) VALUES (?, ?, ?, ?)");
$sth->execute($id, $login, $name, $level);
+ # But just to be sure, lets retreive the ID from the login.
$id = $self->id($login);
$self->set_passwd($id, $passwd);
- $self->{db}->commit;
- $self->{db}->{RaiseError} = $orig_re;
+ $db->commit if $has_transact;
+ $db->{RaiseError} = $orig_state;
};
if ($@) {
- $self->{db}->rollback;
- $self->{db}->{RaiseError} = $orig_re;
+ if ($has_transact) {
+ $db->rollback;
+ } else {
+ carp 'User creation was not successful. This DBD does not support'.
+ ' transactions - You might have a half-created user!';
+ }
+ $db->{RaiseError} = $orig_state;
carp "Could not create specified user";
return undef;
}
- return 1;
+ return $id;
}
sub remove_user {
@@ -499,23 +532,3 @@
}
1;
-
-# $Log: Admin.pm,v $
-# Revision 1.7 2005/06/15 17:17:10 gwolf
-# Some documentation fixes
-# User::Simple: Finishing touches to breathe independent life to it, so it will
-# become a project of its own ;-)
-#
-# Revision 1.6 2005/05/10 05:06:24 gwolf
-# Replace Crypt::PasswdMD5 for Digest::MD5 for consistency
-#
-# Revision 1.5 2005/05/02 19:11:55 gwolf
-# Fixed a simple warning
-#
-# Revision 1.4 2005/04/06 23:00:09 gwolf
-# Documented
-#
-# Revision 1.3 2005/04/05 00:33:39 gwolf
-# - Admin: Fixed create_db_structure to reflect documented behavior
-# - Documentation details added
-#
Modified: packages/libuser-simple-perl/trunk/lib/User/Simple.pm
===================================================================
--- packages/libuser-simple-perl/trunk/lib/User/Simple.pm 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/lib/User/Simple.pm 2005-08-27 00:58:24 UTC (rev 1311)
@@ -13,8 +13,7 @@
$usr = User::Simple->new(db => $db,
[tbl => $user_table],
[durat => $duration],
- [debug => $debug],
- [adm_level => $level]);
+ [debug => $debug]);
$ok = $usr->ck_session($session);
$ok = $usr->ck_login($login, $passwd, [$no_sess]);
@@ -26,7 +25,6 @@
$id = $usr->id;
$session = $usr->session;
$level = $usr->level;
- $ok = $usr->is_admin;
=head1 DESCRIPTION
@@ -56,7 +54,7 @@
active DBI (database connection) object as its only argument:
$usr = User::Simple->new(db => $db, [tbl => $table], [durat => $duration],
- [debug => $debug], [adm_level => $level]);
+ [debug => $debug]);
Of course, the database must have the right structure in it - please check
L<User::Simple::Admin> for more information.
@@ -75,18 +73,6 @@
debug is set to 5, information such as cleartext passwords will be logged as
well!
-C<adm_level> gives us an extra way to tell if a user has administrative
-privileges - The users with a level under the number specified here will be
-seen as unprivileged, and those whose level is equal or higher than it will
-be treated as administrative users. The user level assigned to a user does not
-mean anything for User::Simple, but might be used inside your application. If
-C<adm_level> is not specified, it will default to 1 (meaning that regular
-users' level is only 0, and any positive integer is an administrative user, as
-traditional in Perl's truth management). Please note (explanation follows
-below) that using C<adm_level> and the C<is_admin> method is deprecated in
-favor of directly querying C<$usr-E<gt>level>, and will be dropped in the
-future.
-
=head2 SESSION CREATION/DELETION
Once the object is created, we can ask it to verify that a given user is
@@ -121,50 +107,36 @@
$ok = $usr->set_passwd($new_pass);
-=head2 USER LEVEL / ADMINISTRATIVE ACCESS
+=head2 USER LEVEL
-To check for the user level (or simply to check if the user has administrative
-access) (again, see L<User::Simple::Admin> for further details):
+To check for the user level (again, see L<User::Simple::Admin> for further
+details):
$level = $usr->level;
- $ok = $usr->is_admin;
-Please note that User::Simple will only tell your application whether a user
-has administrative access (that is, C<$usr-E<gt>is_admin> is true, or
-C<$usr-E<gt>level> is equal or larger than C<adm_level>. The C<is_admin> method
-is for integration to your system, and does not mean that the user can access
-the functionality of User::Simple::Admin.
-
-Yes, this last note takes away part of the nice simplicity of User::Simple, and
-that is not a good thing. This is still a very young module, but has already
-some systems depending on its way of working. Consider C<is_admin> as
-B<deprecated>, support for it will be dropped in the future.
-
=head1 DEPENDS ON
L<Date::Calc>
L<Digest::MD5>
+L<DBI> (and a suitable L<DBD> backend)
+
=head1 SEE ALSO
L<User::Simple::Admin> for administrative routines
=head1 TO DO
-This module still requires a decent test suite. In order for it to become
-automatic, we need to be able to operate without a real RDBMS, i.e., with
-DBD::CSV.
+I would like to separate a bit the table structure, allowing for flexibility
+- This means, if you added some extra fields to the table, provide an easy way
+to access them. Currently, you have to reach in from outside User::Simple,
+skipping the abstraction, to get them.
-The C<is_admin>, C<adm_level> and related infrastructure feels like a kludge,
-and cries to be removed. As for now, a simple warning about it being deprecated
-will do.
+Although no longer documented (don't use them, please!), we still have the
+adm_level/is_admin functionality. For cleanness, it should be removed by the
+next release.
-I would also like to separate a bit the table structure, allowing for
-flexibility - This means, if you added some extra fields to the table,
-provide an easy way to access them. Currently, you have to reach in from
-outside User::Simple, skipping the abstraction, to get them.
-
Besides that, it works as expected (that is, as I expect ;-) )
=head1 AUTHOR
@@ -184,7 +156,7 @@
use Digest::MD5 qw(md5_hex);
use UNIVERSAL qw(isa);
-our $VERSION = '0.9';
+our $VERSION = '1.0';
######################################################################
# Constructor
@@ -201,6 +173,10 @@
return undef;
}
+ if (defined($init{adm_level})) {
+ carp "adm_level is deprecated and will be dropped in future releases";
+ }
+
# Default values
$init{tbl} = 'user_simple' unless defined $init{tbl};
$init{durat} = 30 unless defined $init{durat};
@@ -219,7 +195,7 @@
return undef;
}
unless ($sth=$init{db}->prepare("SELECT id, login, name, level
- FROM $init{tbl} LIMIT 1") and $sth->execute) {
+ FROM $init{tbl}") and $sth->execute) {
carp "Table $init{tbl} does not exist or has wrong structure";
return undef;
}
@@ -258,6 +234,8 @@
$self->_debug(5, "Checking session $sess");
+ $self->_clean_user_data;
+
unless ($sth = $self->{db}->prepare("SELECT id, session_exp
FROM $self->{tbl} WHERE session = ?") and $sth->execute($sess)
and ($id, $exp) = $sth->fetchrow_array) {
@@ -288,6 +266,8 @@
$self->_debug(5, "Verifying login: $login/$pass");
+ $self->_clean_user_data;
+
# Is this login/password valid?
unless ($sth = $self->{db}->prepare("SELECT id, passwd FROM $self->{tbl}
WHERE login = ?") and $sth->execute($login) and
@@ -337,9 +317,7 @@
session_exp = NULL WHERE id = ?");
$sth->execute($self->{id});
- for my $key qw(id level login name session session_exp) {
- delete $self->{$key};
- }
+ $self->_clean_user_data;
return 1;
}
@@ -461,24 +439,11 @@
}
}
-1;
+sub _clean_user_data {
+ my $self = shift;
+ for my $key qw(id level login name session session_exp) {
+ delete $self->{$key};
+ }
+}
-# $Log: Simple.pm,v $
-# Revision 1.7 2005/06/15 17:17:10 gwolf
-# Some documentation fixes
-# User::Simple: Finishing touches to breathe independent life to it, so it will
-# become a project of its own ;-)
-#
-# Revision 1.6 2005/06/07 01:23:14 gwolf
-# Fixed: Used hardwired reference for table name
-#
-# Revision 1.5 2005/05/10 05:06:24 gwolf
-# Replace Crypt::PasswdMD5 for Digest::MD5 for consistency
-#
-# Revision 1.4 2005/04/14 00:03:41 gwolf
-# Continuing with the translation, it _seems_ everything is working as it should
-#
-# Revision 1.3 2005/04/05 00:33:39 gwolf
-# - Admin: Fixed create_db_structure to reflect documented behavior
-# - Documentation details added
-#
+1;
Modified: packages/libuser-simple-perl/trunk/t/User-Simple.t
===================================================================
--- packages/libuser-simple-perl/trunk/t/User-Simple.t 2005-08-27 00:28:34 UTC (rev 1310)
+++ packages/libuser-simple-perl/trunk/t/User-Simple.t 2005-08-27 00:58:24 UTC (rev 1311)
@@ -1,11 +1,17 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl User-Simple.t'
+use strict;
+use DBI;
+use File::Temp qw(tempdir);
+use lib qw(/home/gwolf/User-Simple/lib);
+my ($db, $dbdir);
+
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
-use Test::More tests => 2;
+use Test::More tests => 31;
BEGIN { use_ok('User::Simple'); use_ok('User::Simple::Admin') };
#########################
@@ -13,3 +19,93 @@
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
+$dbdir = tempdir (CLEANUP => 1); # CLEANUP removes directory upon exiting
+eval { $db = DBI->connect("DBI:XBase:$dbdir") };
+
+SKIP: {
+ my ($ua, $adm_id, $usr_id, $usr, $session);
+ skip 'Not executing the complete tests: Database handler not created ' .
+ '(I need DBD::XBase for this)', 14 unless $db;
+
+ ###
+ ### First, the User::Simple::Admin tests...
+ ###
+
+ # Create now the database and our table
+ ok($ua = User::Simple::Admin->create_plain_db_structure($db,'user_simple'),
+ 'Created a new table and an instance of a User::Simple::Admin object');
+
+ # Create some user accounts
+ ok(($ua->new_user('admin','Administrative user','Iamroot',5) and
+ $ua->new_user('adm2','Another administrative user','stillagod',2) and
+ $ua->new_user('user1','Regular user 1','a_password',0) and
+ $ua->new_user('user2','Regular user 2','a_password',0) and
+ $ua->new_user('user3','Regular user 3','a_password',0) and
+ $ua->new_user('user4','Regular user 4','a_password',0) and
+ $ua->new_user('user5','Regular user 5','a_password',0)),
+ 'Created some users to test on');
+
+ # Now do some queries on them...
+ $adm_id = $ua->id('admin');
+ $usr_id = $ua->id('user2');
+
+ # Get the information they were created with
+ is($ua->login($adm_id), 'admin', 'First user reports the right login');
+ is($ua->name($adm_id), 'Administrative user',
+ 'First user reports the right name');
+ is($ua->level($adm_id), 5, 'First user reports the right level');
+
+ is($ua->login($usr_id), 'user2', 'Second user reports the right login');
+ is($ua->name($usr_id), 'Regular user 2',
+ 'Second user reports the right name');
+ is($ua->level($usr_id), 0, 'Second user reports the right level');
+
+ # Change their details
+ ok($ua->set_login($usr_id, 'luser1'),
+ 'Successfully changed the user login');
+ is($ua->id('luser1'), $usr_id, 'Changed user login reported correctly');
+
+ ok(($ua->set_name($usr_id, 'Irregular luser 1') and
+ $ua->set_level($usr_id, 1)),
+ "Successfully changed other of this user's details");
+
+ diag('Next test will issue a warning - Disregard.');
+ ok(!($ua->set_login($adm_id, 'adm2')),
+ 'System successfully prevents me from having duplicate logins');
+
+ # Remove a user, should be gone.
+ ok($ua->remove_user($usr_id), 'Removed a user');
+ ok(!($ua->id('luser1')), 'Could not query for the removed user - Good.');
+
+ ###
+ ### Now, the User::Simple tests
+ ###
+ ok($usr = User::Simple->new(db=>$db, tbl=>'user_simple'),
+ 'Created a new instance of a User::Simple object');
+
+ # Log in with user/password, retrieve the user's data
+ ok($usr->ck_login('user5','a_password'),
+ 'Successfully logged in with one of the users');
+ is($usr->login, 'user5', 'Reported login matches');
+ is($usr->name, 'Regular user 5', 'Reported name matches');
+ is($usr->level, 0, 'Reported level matches');
+
+ # Get the user's session
+ ok($session = $usr->session, "Retreived the user's session");
+
+ # Try to log in with an invalid session, check that all of the data is
+ # cleared.
+ is($usr->ck_session('blah'), undef,
+ 'Checked for a wrong session, successfully got refused');
+ is($usr->id, undef, "Nobody's ID successfully reports nothing");
+ is($usr->login, undef, "Nobody's login successfully reports nothing");
+ is($usr->name, undef, "Nobody's name successfully reports nothing");
+ is($usr->level, undef, "Nobody's level successfully reports nothing");
+
+ # Now log in using the session we just retreived - We should get the
+ # full data again.
+ ok($usr->ck_session($session), 'Successfully checked for a real session');
+ is($usr->login, 'user5', 'Reported login matches');
+ is($usr->name, 'Regular user 5', 'Reported name matches');
+ is($usr->level, 0, 'Reported level matches');
+}
More information about the Pkg-perl-cvs-commits
mailing list