Initial import of new DBIx::Class store. Not compatible with old-school
Jay Kuri [Fri, 10 Nov 2006 21:55:27 +0000 (21:55 +0000)]
(pre 0.10) versions of C::P::Authenticate.  Don't try to use this with
0.09 because it won't work.

Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
lib/Catalyst/Plugin/Authentication/Store/DBIx/Class.pod [new file with mode: 0644]
lib/Catalyst/Plugin/Authentication/Store/DBIx/Class/Backend.pm [new file with mode: 0644]
lib/Catalyst/Plugin/Authentication/Store/DBIx/Class/User.pm [new file with mode: 0644]
t/00-load.t [new file with mode: 0644]
t/boilerplate.t [new file with mode: 0644]
t/pod-coverage.t [new file with mode: 0644]
t/pod.t [new file with mode: 0644]

diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..ff4803f
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for Catalyst-Plugin-Authentication-Store-DBIx-Class
+
+0.01    Date/time
+        First version, released on an unsuspecting world.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644 (file)
index 0000000..88bb2fa
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,10 @@
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+Makefile.PL
+README
+lib/Catalyst/Plugin/Authentication/Store/DBIx/Class.pm
+t/00-load.t
+t/boilerplate.t
+t/pod-coverage.t
+t/pod.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..57df17c
--- /dev/null
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'Catalyst::Plugin::Authentication::Store::DBIx::Class',
+    AUTHOR              => 'Jay Kuri <bsdmac@gmail.com>',
+    VERSION_FROM        => 'lib/Catalyst/Plugin/Authentication/Store/DBIx/Class.pm',
+    ABSTRACT_FROM       => 'lib/Catalyst/Plugin/Authentication/Store/DBIx/Class.pm',
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Test::More' => 0,
+    },
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+    clean               => { FILES => 'Catalyst-Plugin-Authentication-Store-DBIx-Class-*' },
+);
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..6eab563
--- /dev/null
+++ b/README
@@ -0,0 +1,49 @@
+Catalyst-Plugin-Authentication-Store-DBIx-Class
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the README
+file from a module distribution so that people browsing the archive
+can use it get an idea of the modules uses. It is usually a good idea
+to provide version information here so that people can decide whether
+fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc command.
+
+    perldoc Catalyst::Plugin::Authentication::Store::DBIx::Class
+
+You can also look for information at:
+
+    Search CPAN
+        http://search.cpan.org/dist/Catalyst-Plugin-Authentication-Store-DBIx-Class
+
+    CPAN Request Tracker:
+        http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Plugin-Authentication-Store-DBIx-Class
+
+    AnnoCPAN, annotated CPAN documentation:
+        http://annocpan.org/dist/Catalyst-Plugin-Authentication-Store-DBIx-Class
+
+    CPAN Ratings:
+        http://cpanratings.perl.org/d/Catalyst-Plugin-Authentication-Store-DBIx-Class
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2006 Jay Kuri
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
diff --git a/lib/Catalyst/Plugin/Authentication/Store/DBIx/Class.pod b/lib/Catalyst/Plugin/Authentication/Store/DBIx/Class.pod
new file mode 100644 (file)
index 0000000..bd9afb2
--- /dev/null
@@ -0,0 +1,101 @@
+package Catalyst::Plugin::Authentication::Store::DBIx::Class;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+Catalyst::Plugin::Authentication::Store::DBIx::Class - The great new Catalyst::Plugin::Authentication::Store::DBIx::Class!
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+Quick summary of what the module does.
+
+Perhaps a little code snippet.
+
+    use Catalyst::Plugin::Authentication::Store::DBIx::Class;
+
+    my $foo = Catalyst::Plugin::Authentication::Store::DBIx::Class->new();
+    ...
+
+=head1 EXPORT
+
+A list of functions that can be exported.  You can delete this section
+if you don't export anything, such as for a purely object-oriented module.
+
+=head1 FUNCTIONS
+
+=head2 function1
+
+=cut
+
+sub function1 {
+}
+
+=head2 function2
+
+=cut
+
+sub function2 {
+}
+
+=head1 AUTHOR
+
+Jay Kuri, C<< <bsdmac at gmail.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-catalyst-plugin-authentication-store-dbix-class at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Plugin-Authentication-Store-DBIx-Class>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc Catalyst::Plugin::Authentication::Store::DBIx::Class
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Catalyst-Plugin-Authentication-Store-DBIx-Class>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Catalyst-Plugin-Authentication-Store-DBIx-Class>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Plugin-Authentication-Store-DBIx-Class>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Catalyst-Plugin-Authentication-Store-DBIx-Class>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006 Jay Kuri, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of Catalyst::Plugin::Authentication::Store::DBIx::Class
diff --git a/lib/Catalyst/Plugin/Authentication/Store/DBIx/Class/Backend.pm b/lib/Catalyst/Plugin/Authentication/Store/DBIx/Class/Backend.pm
new file mode 100644 (file)
index 0000000..b5a38bb
--- /dev/null
@@ -0,0 +1,154 @@
+package Catalyst::Plugin::Authentication::Store::DBIx::Class::Backend;
+
+use strict;
+use warnings;
+use base qw/Class::Accessor::Fast/;
+
+sub new {
+    my ( $class, $config, $app ) = @_;
+
+    ## figure out if we are overriding the default store user class.
+    my $storeclass = $config->{'store_user_class'} || "Catalyst::Plugin::Authentication::Store::DBIx::Class::User";
+    
+    ## fields can be specified to be ignored during user location.  This allows
+    ## authinfo to contain the user info required to find the user, as well as the password
+    ## to try to match to, for example.  It can be added to by setting ignore_fields in the 
+    ## authinfo hashref also. 
+    $config->{'ignore_fields_in_find'} ||= [ 'password' ];
+    push @{$config->{'ignore_fields_in_find'}}, ('searchargs', 'ignore_fields');
+    
+    ## make sure the store class is loaded.
+    Catalyst::Utils::ensure_class_loaded( $storeclass );
+    
+    my $self = {};
+    $self->{config} = $config;
+    $self->{store_user_class} = $storeclass;
+    
+    #$self->{role_relation} ||= 'roles';
+    #$self->{role_field} ||= 'role';
+
+    bless $self, $class;
+}
+
+sub from_session {
+    my ( $self, $c, $frozenuser ) = @_;
+
+    return $frozenuser if ref $frozenuser;
+
+    # this could be a lot better.  But for now it just assumes $frozenuser is an id and uses find_user
+    # XXX: hits the database on every request?  Not good...
+    return $self->find_user( { id => $frozenuser }, $c);
+}
+
+sub for_session {
+    my ($self, $c, $user) = @_;
+    
+    return $user->for_session($c);
+}
+
+sub find_user {
+    my ( $self, $authinfo, $c ) = @_;
+    
+    return $self->{'store_user_class'}->new($authinfo, $self->{config}, $c);
+}
+
+
+sub user_supports {
+    # this can work as a class method
+    shift->{'store_user_class'}->supports( @_ );
+}
+
+__PACKAGE__;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Plugin::Authentication::Store::DBIx::Class::Backend - A class to ...
+
+=head1 VERSION
+
+This documentation refers to version 0.01.
+
+=head1 SYNOPSIS
+
+use Catalyst::Plugin::Authentication::Store::DBIx::Class::Backend;
+
+=head1 DESCRIPTION
+
+The Catalyst::Plugin::Authentication::Store::DBIx::Class::Backend class implements ...
+
+=head1 SUBROUTINES / METHODS
+
+=head2 new (constructor)
+
+Parameters:
+    class
+    config
+    app
+
+Insert description of constructor here...
+
+=head2 from_session (method)
+
+Parameters:
+    c
+    frozenuser
+
+Insert description of method here...
+
+=head2 for_session (method)
+
+Parameters:
+    c
+    user
+
+Insert description of method here...
+
+=head2 find_user (method)
+
+Parameters:
+    authinfo
+    c
+
+Insert description of method here...
+
+=head2 user_supports
+
+Parameters:
+    none
+
+Insert description of subroutine here...
+
+=head1 DEPENDENCIES
+
+Modules used, version dependencies, core yes/no
+
+strict
+
+warnings
+
+=head1 NOTES
+
+...
+
+=head1 BUGS AND LIMITATIONS
+
+None known currently, please email the author if you find any.
+
+=head1 SEE ALSO
+
+L<Catalyst::Plugin::Authentication::Store::DBIC>, L<Catalyst::Plugin::Authentication>,
+L<Catalyst::Plugin::Authorization::Roles>
+
+=head1 AUTHOR
+
+Jason Kuri (jk@domain.tld)
+
+=head1 LICENCE
+
+Copyright 2006 by Jason Kuri.
+
+This software is free.  It is licensed under the same terms as Perl itself.
+
+=cut
diff --git a/lib/Catalyst/Plugin/Authentication/Store/DBIx/Class/User.pm b/lib/Catalyst/Plugin/Authentication/Store/DBIx/Class/User.pm
new file mode 100644 (file)
index 0000000..01d72dc
--- /dev/null
@@ -0,0 +1,254 @@
+package Catalyst::Plugin::Authentication::Store::DBIx::Class::User;
+
+use strict;
+use warnings;
+use base qw/Catalyst::Plugin::Authentication::User/;
+
+sub new {
+    my ( $class, $authinfo, $config, $c, $lazyload) = @_;
+
+    my $self = {};
+    $self->{'resultset'} = $c->model($config->{'user_class'});
+    $self->{'config'} = $config;
+    $self->{'authinfo'} = {%{$authinfo}};
+    
+    bless $self, $class;
+    
+    ## if we have lazyloading turned on - we should not query the DB unless something gets read.
+    ## that's the idea anyway - still have to work out how to manage that - so for now we always force
+    ## lazyload to off.
+    $lazyload = 0;
+    
+    if (!$lazyload) {
+        $self->load_user($authinfo, $c);
+        if (!$self->{'user'}) {
+            return;
+        }
+    } else {
+        ## what do we do with a lazyload?
+        ## presumably this is coming out of session storage.  
+        ## use $authinfo to fill in the user in that case?
+    }
+    
+    return $self;
+}
+
+
+sub load_user {
+    my ($self, $authinfo, $c) = @_;
+    
+    ## User can provide an arrayref containing the arguments to search on the user class.
+    ## allowing maximum flexibility for authentication.
+    if ($authinfo->{'searchargs'}) {
+        $self->{user} = $self->{'resultset'}->search(@{$authinfo->{'searchargs'}})->first;
+    } else {
+        ## merge the ignore fields array into a hash - so we can do an easy check while building the query
+        my %ignorefields = map { $_ => 1} @{$self->{'config'}{'ignore_fields_in_find'}},
+                                    ( ref $authinfo->{'ignore_fields'} eq 'ARRAY' ? @{$authinfo->{'ignore_fields'}} : () );
+                                    
+        my $searchargs = {};
+        
+        # now we walk all the fields passed in, and build up a search hash.
+        foreach my $key (grep {!$ignorefields{$_}} keys %{$authinfo}) {
+
+            if ($self->{'resultset'}->result_source->has_column($key)) {
+                $searchargs->{$key} = $authinfo->{$key};
+            }
+        }  
+        $self->{user} = $self->{'resultset'}->search($searchargs)->first;
+    }
+   #$c->log->debug(dumper($self->{'user'}));
+
+}
+
+sub supported_features {
+    my $self = shift;
+    $self->{'config'}{'password_type'} = 'clear';
+
+    return {
+        password => {
+            $self->{'config'}{'password_type'} => 1,
+        },
+        session         => 1,
+        roles           => 1,
+    };
+}
+
+
+sub roles {
+    my ( $self, @wanted_roles ) = @_;
+
+    ## shortcut if we have already retrieved them
+    if (ref $self->{'roles'} eq 'ARRAY') {
+        return(@{$self->{'roles'}});
+    }
+    
+    my @roles = ();
+    if (exists($self->{'config'}{'role_column'})) {
+        @roles = split /[ ,\|]/, $self->get($self->{'config'}{'role_column'});
+        $self->{'roles'} = \@roles;
+    } elsif (exists($self->{'config'}{'role_relation'})) {
+        my $relation = $self->{'config'}{'role_relation'};
+        if ($self->{'user'}->$relation->result_source->has_column($self->{'config'}{'role_field'})) {
+            @roles = $self->{'user'}->$relation->search(undef, { columns => [ $self->{'config'}{'role_field'}]})->all();
+        } else {
+            Catalyst::Exception->throw("role table does not have a column called " . $self->{'config'}{'role_field'});
+        }
+        my $rolefield = $self->{'config'}{'role_field'};
+        @{$self->{'roles'}} =  map { $_->get_column($self->{'config'}{'role_field'}) } @roles;
+    } else {
+        Catalyst::Exception->throw("user->roles accessed, but no role configuration found");
+    }
+
+    return @{$self->{'roles'}};
+}
+
+sub for_session {
+    shift->id;
+}
+
+sub get {
+    my ($self, $field) = @_;
+    
+    if ($self->{'user'}->can($field)) {
+        return $self->{'user'}->$field;
+    } else {
+        return undef;
+    }
+}
+
+sub obj {
+    my $self = shift;
+    return $self->get_object;
+}
+
+sub get_object {
+    my $self = shift;
+    
+    return $self->{'user'};
+}
+
+sub AUTOLOAD {
+    my $self = shift;
+    (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
+    return if $method eq "DESTROY";
+
+    $self->{'user'}->$method(@_);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Catalyst::Plugin::Authentication::Store::DBIx::Class::User - A class to ...
+
+=head1 VERSION
+
+This documentation refers to version 0.01.
+
+=head1 SYNOPSIS
+
+use Catalyst::Plugin::Authentication::Store::DBIx::Class::User;
+
+=head1 DESCRIPTION
+
+The Catalyst::Plugin::Authentication::Store::DBIx::Class::User class implements ...
+
+=head1 SUBROUTINES / METHODS
+
+=head2 new (constructor)
+
+Parameters:
+    class
+    authinfo
+    config
+    c
+    lazyload
+
+Insert description of constructor here...
+
+=head2 load_user (method)
+
+Parameters:
+    authinfo
+    c
+
+Insert description of method here...
+
+=head2 supported_features (method)
+
+Parameters:
+    none
+
+Insert description of method here...
+
+=head2 roles
+
+Parameters:
+    none
+
+Insert description of subroutine here...
+
+=head2 for_session
+
+Parameters:
+    none
+
+Insert description of subroutine here...
+
+=head2 get (method)
+
+Parameters:
+    field
+
+Insert description of method here...
+
+=head2 obj (method)
+
+Parameters:
+    none
+
+Insert description of method here...
+
+=head2 get_object (method)
+
+Parameters:
+    none
+
+Insert description of method here...
+
+=head2 AUTOLOAD (method)
+
+Parameters:
+    none
+
+Insert description of method here...
+
+=head1 DEPENDENCIES
+
+Modules used, version dependencies, core yes/no
+
+strict
+
+warnings
+
+=head1 NOTES
+
+...
+
+=head1 BUGS AND LIMITATIONS
+
+None known currently, please email the author if you find any.
+
+=head1 AUTHOR
+
+Jason Kuri (jk@domain.tld)
+
+=head1 LICENCE
+
+Copyright 2006 by Jason Kuri.
+
+This software is free.  It is licensed under the same terms as Perl itself.
+
+=cut
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644 (file)
index 0000000..ea57153
--- /dev/null
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+       use_ok( 'Catalyst::Plugin::Authentication::Store::DBIx::Class' );
+}
+
+diag( "Testing Catalyst::Plugin::Authentication::Store::DBIx::Class $Catalyst::Plugin::Authentication::Store::DBIx::Class::VERSION, Perl $], $^X" );
diff --git a/t/boilerplate.t b/t/boilerplate.t
new file mode 100644 (file)
index 0000000..41dbb3a
--- /dev/null
@@ -0,0 +1,48 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+    my ($filename, %regex) = @_;
+    open my $fh, "<", $filename
+        or die "couldn't open $filename for reading: $!";
+
+    my %violated;
+
+    while (my $line = <$fh>) {
+        while (my ($desc, $regex) = each %regex) {
+            if ($line =~ $regex) {
+                push @{$violated{$desc}||=[]}, $.;
+            }
+        }
+    }
+
+    if (%violated) {
+        fail("$filename contains boilerplate text");
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+    } else {
+        pass("$filename contains no boilerplate text");
+    }
+}
+
+not_in_file_ok(README =>
+    "The README is used..."       => qr/The README is used/,
+    "'version information here'"  => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+    "placeholder date/time"       => qr(Date/time)
+);
+
+sub module_boilerplate_ok {
+    my ($module) = @_;
+    not_in_file_ok($module =>
+        'the great new $MODULENAME'   => qr/ - The great new /,
+        'boilerplate description'     => qr/Quick summary of what the module/,
+        'stub function definition'    => qr/function[12]/,
+    );
+}
+
+module_boilerplate_ok('lib/Catalyst/Plugin/Authentication/Store/DBIx/Class.pm');
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644 (file)
index 0000000..703f91d
--- /dev/null
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
diff --git a/t/pod.t b/t/pod.t
new file mode 100644 (file)
index 0000000..976d7cd
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();