initial import of Catalyst-Authentication-Store-DBI 0.00_01 from CPAN

git-cpan-module:   Catalyst-Authentication-Store-DBI
git-cpan-version:  0.00_01
git-cpan-authorid: JANUS
git-cpan-file:     authors/id/J/JA/JANUS/Catalyst-Authentication-Store-DBI-0.00_01.tar.gz

Changes

@@ -0,0 +1,2 @@
+0.00_01 Tue Nov 18 22:15:54 CET 2008
+    - initial development release

MANIFEST

@@ -0,0 +1,15 @@
+Changes
+lib/Catalyst/Authentication/Store/DBI.pm
+lib/Catalyst/Authentication/Store/DBI/User.pm
+Makefile.PL
+MANIFEST
+README
+t/00_load.t
+t/10_auth.t
+t/20_session.t
+t/90_pod.t
+t/95_pod-coverage.t
+t/lib/SetupDB.pm
+t/lib/TestApp.pm
+t/lib/TestApp/Model/DBI.pm
+META.yml                                 Module meta-data (added by MakeMaker)

META.yml

@@ -0,0 +1,15 @@
+--- #YAML:1.0
+name:                Catalyst-Authentication-Store-DBI
+version:             0.00_01
+abstract:            Storage class for Catalyst Authentication using DBI
+license:             perl
+author:              
+    - Simon Bertrang <simon.bertrang@puzzworks.com>
+generated_by:        ExtUtils::MakeMaker version 6.42
+distribution_type:   module
+requires:     
+    Catalyst::Model::DBI:          0
+    Catalyst::Plugin::Authentication: 0
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Makefile.PL

@@ -0,0 +1,15 @@
+use 5.005;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+	'NAME'		=> 'Catalyst::Authentication::Store::DBI',
+	'LICENSE'	=> 'perl',
+	'VERSION_FROM'	=> 'lib/Catalyst/Authentication/Store/DBI.pm',
+	'PREREQ_PM'	=> {
+		'Catalyst::Plugin::Authentication'	=> 0,
+		'Catalyst::Model::DBI'			=> 0,
+	},
+	'ABSTRACT_FROM'	=> 'lib/Catalyst/Authentication/Store/DBI.pm',
+	'AUTHOR'	=> 'Simon Bertrang <simon.bertrang@puzzworks.com>',
+);
+

README

@@ -0,0 +1,89 @@
+NAME
+    Catalyst::Authentication::Store::DBI - Storage class for Catalyst
+    Authentication using DBI
+
+SYNOPSIS
+      use Catalyst qw(Authentication);
+
+      __PACKAGE__->config->{'authentication'} = {
+        'default_realm' => 'default',
+        'realms' => {
+          'default' => {
+            'credential' => {
+              'class'               => 'Password',
+              'password_field'      => 'password',
+              'password_type'       => 'hashed',
+              'password_hash_type'  => 'SHA-1',
+            },
+            'store' => {
+              'class'              => 'DBI',
+              'user_table'         => 'login',
+              'user_key'           => 'id',
+              'user_name'          => 'name',
+              'role_table'         => 'authority',
+              'role_key'           => 'id',
+              'role_name'          => 'name',
+              'user_role_table'    => 'competence',
+              'user_role_user_key' => 'login',
+              'user_role_role_key' => 'authority',
+            },
+          },
+        },
+      };
+
+      sub login :Global
+      {
+        my ($self, $c) = @_;
+        my $req = $c->request();
+
+        # catch login failures
+        unless ($c->authenticate({
+          'name'     => $req->param('name'),
+          'password' => $req->param('password'),
+          })) {
+          ...
+        }
+
+        ...
+      }
+
+      sub something :Path
+      {
+        my ($self, $c) = @_;
+
+        # handle missing role case
+        unless ($c->check_user_roles('editor')) {
+          ...
+        }
+
+        ...
+      }
+
+DESCRIPTION
+    This module implements the Catalyst::Authentication API using
+    Catalyst::Model::DBI.
+
+    It uses DBI to let your application authenticate users against a
+    database and it provides support for
+    Catalyst::Plugin::Authorization::Roles.
+
+METHODS
+  new
+  find_user
+  for_session
+  from_session
+  user_supports
+SEE ALSO
+    Catalyst::Plugin::Authentication
+    Catalyst::Model::DBI
+    Catalyst::Plugin::Authorization::Roles
+
+AUTHOR
+    Simon Bertrang, <simon.bertrang@puzzworks.com>
+
+COPYRIGHT AND LICENSE
+    Copyright (C) 2008 by PuzzWorks, OHG.
+
+    This library is free software; you can redistribute it and/or modify it
+    under the same terms as Perl itself.
+

lib/Catalyst/Authentication/Store/DBI.pm

@@ -0,0 +1,222 @@
+package Catalyst::Authentication::Store::DBI;
+use strict;
+use warnings;
+use Catalyst::Authentication::Store::DBI::User;
+
+our $VERSION = '0.00_01';
+
+=head1 NAME
+
+Catalyst::Authentication::Store::DBI - Storage class for Catalyst Authentication using DBI
+
+=head1 SYNOPSIS
+
+  use Catalyst qw(Authentication);
+
+  __PACKAGE__->config->{'authentication'} = {
+    'default_realm' => 'default',
+    'realms' => {
+      'default' => {
+        'credential' => {
+          'class'               => 'Password',
+          'password_field'      => 'password',
+          'password_type'       => 'hashed',
+          'password_hash_type'  => 'SHA-1',
+        },
+        'store' => {
+          'class'              => 'DBI',
+          'user_table'         => 'login',
+          'user_key'           => 'id',
+          'user_name'          => 'name',
+          'role_table'         => 'authority',
+          'role_key'           => 'id',
+          'role_name'          => 'name',
+          'user_role_table'    => 'competence',
+          'user_role_user_key' => 'login',
+          'user_role_role_key' => 'authority',
+        },
+      },
+    },
+  };
+
+  sub login :Global
+  {
+    my ($self, $c) = @_;
+    my $req = $c->request();
+
+    # catch login failures
+    unless ($c->authenticate({
+      'name'     => $req->param('name'),
+      'password' => $req->param('password'),
+      })) {
+      ...
+    }
+
+    ...
+  }
+
+  sub something :Path
+  {
+    my ($self, $c) = @_;
+
+    # handle missing role case
+    unless ($c->check_user_roles('editor')) {
+      ...
+    }
+
+    ...
+  }
+
+=head1 DESCRIPTION
+
+This module implements the L<Catalyst::Authentication> API using L<Catalyst::Model::DBI>.
+
+It uses DBI to let your application authenticate users against a database and it provides support for L<Catalyst::Plugin::Authorization::Roles>.
+
+=head1 METHODS
+
+=head2 new
+
+=cut
+
+# instantiates the store object
+sub new
+{
+	my ($class, $config, $app, $realm) = @_;
+
+	unless (defined($config) && ref($config) eq 'HASH') {
+		Catalyst::Exception->throw(__PACKAGE__ .
+		    ' needs a hashref for configuration');
+	}
+
+	my $self = {%$config};
+
+	bless($self, $class);
+
+	return $self;
+}
+
+=head2 find_user
+
+=cut
+
+# locates a user using data contained in the hashref
+sub find_user
+{
+	my ($self, $authinfo, $c) = @_;
+	my $sql;
+	my $sth;
+	my %user;
+
+	unless ($self->{'dbh'}) {
+		$self->{'dbh'} = $c->model('DBI')->dbh();
+	}
+
+	my $dbh = $self->{'dbh'};
+
+	my @col = map { $_ } sort(keys(%$authinfo));
+
+	$sql = 'SELECT * FROM ' . $self->{'user_table'} . ' WHERE ' . join(' AND ', map { $_ . ' = ?' } @col);
+
+	$sth = $dbh->prepare($sql) or die($dbh->errstr());
+	$sth->execute(@$authinfo{@col}) or die($dbh->errstr());
+	$sth->bind_columns(\( @user{ @{ $sth->{'NAME_lc'} } } )) or die($dbh->errstr());
+	unless ($sth->fetch()) {
+		$sth->finish();
+		return undef;
+	}
+	$sth->finish();
+
+	unless (exists($user{$self->{'user_key'}}) && length($user{$self->{'user_key'}})) {
+		return undef;
+	}
+
+	return Catalyst::Authentication::Store::DBI::User->new($self, \%user);
+}
+
+=head2 for_session
+
+=cut
+
+sub for_session
+{
+	my ($self, $c, $user) = @_;
+
+	return $user->id();
+}
+
+=head2 from_session
+
+=cut
+
+sub from_session
+{
+	my ($self, $c, $frozen) = @_;
+	my $sql;
+	my $sth;
+	my %user;
+
+	unless ($self->{'dbh'}) {
+		$self->{'dbh'} = $c->model('DBI')->dbh();
+	}
+
+	my $dbh = $self->{'dbh'};
+
+	$sql = 'SELECT * FROM ' . $self->{'user_table'} . ' WHERE ' . $self->{'user_key'} . ' = ?';
+
+	$sth = $dbh->prepare($sql) or die($dbh->errstr());
+	$sth->execute($frozen) or die($dbh->errstr());
+	$sth->bind_columns(\( @user{ @{ $sth->{'NAME_lc'} } } )) or die($dbh->errstr());
+	unless ($sth->fetch()) {
+		$sth->finish();
+		return undef;
+	}
+	$sth->finish();
+
+	unless (exists($user{$self->{'user_key'}}) && length($user{$self->{'user_key'}})) {
+		return undef;
+	}
+
+	return Catalyst::Authentication::Store::DBI::User->new($self, \%user);
+
+}
+
+=head2 user_supports
+
+=cut
+
+sub user_supports
+{
+	my $self = shift;
+
+	return;
+}
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Catalyst::Plugin::Authentication>
+
+=item L<Catalyst::Model::DBI>
+
+=item L<Catalyst::Plugin::Authorization::Roles>
+
+=back
+
+=head1 AUTHOR
+
+Simon Bertrang, E<lt>simon.bertrang@puzzworks.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 PuzzWorks OHG, L<http://puzzworks.com/>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;