Catalyst-Authentication-Store-DBIx-Class-0.1201/0000755000175000017500000000000011404300037021543 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/.gitignore0000644000175000017500000000024111402677735023554 0ustar rkitoverrkitover.* !.gitignore Makefile* !Makefile.PL META.yml blib build inc pm_to_blib MANIFEST* !MANIFEST.SKIP Debian* README Catalyst-Authentication-Store-DBIx-Class-* *.bs Catalyst-Authentication-Store-DBIx-Class-0.1201/t/0000755000175000017500000000000011404300037022006 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/t/04-authsessions.t0000644000175000017500000000512011402677735025166 0ustar rkitoverrkitover#!perl use strict; use warnings; use DBI; use File::Path; use FindBin; use Test::More; use lib "$FindBin::Bin/lib"; BEGIN { eval { require Test::WWW::Mechanize::Catalyst } or plan skip_all => "Test::WWW::Mechanize::Catalyst is required for this test"; eval { require DBD::SQLite } or plan skip_all => "DBD::SQLite is required for this test"; eval { require DBIx::Class } or plan skip_all => "DBIx::Class is required for this test"; eval { require Catalyst::Plugin::Session; die unless $Catalyst::Plugin::Session::VERSION >= 0.02 } or plan skip_all => "Catalyst::Plugin::Session >= 0.02 is required for this test"; eval { require Catalyst::Plugin::Session::State::Cookie; } or plan skip_all => "Catalyst::Plugin::Session::State::Cookie is required for this test"; plan tests => 8; $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/auth.db" unless exists($ENV{TESTAPP_DB_FILE}); $ENV{TESTAPP_CONFIG} = { name => 'TestApp', authentication => { default_realm => "users", realms => { users => { credential => { 'class' => "Password", 'password_field' => 'password', 'password_type' => 'clear' }, store => { 'class' => 'DBIx::Class', 'user_model' => 'TestApp::User', 'use_userdata_from_session' => 0, }, }, }, }, }; $ENV{TESTAPP_PLUGINS} = [ qw/Authentication Session Session::Store::Dummy Session::State::Cookie / ]; } use SetupDB; use Test::WWW::Mechanize::Catalyst 'TestApp'; my $m = Test::WWW::Mechanize::Catalyst->new; # log a user in { $m->get_ok( 'http://localhost/user_login?username=joeuser&password=hackme', undef, 'request ok' ); $m->content_is( 'joeuser logged in', 'user logged in ok' ); } # verify the user is still logged in { $m->get_ok( 'http://localhost/get_session_user', undef, 'request ok' ); $m->content_is( 'joeuser', 'user still logged in' ); } # log the user out { $m->get_ok( 'http://localhost/user_logout', undef, 'request ok' ); $m->content_is( 'logged out', 'user logged out ok' ); } # verify there is no session { $m->get_ok( 'http://localhost/get_session_user', undef, 'request ok' ); $m->content_is( '', "user's session deleted" ); } # clean up unlink $ENV{TESTAPP_DB_FILE}; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/05-auth-roles-relationship.t0000644000175000017500000000454011402677735027226 0ustar rkitoverrkitover#!perl use strict; use warnings; use DBI; use File::Path; use FindBin; use Test::More; use lib "$FindBin::Bin/lib"; BEGIN { eval { require DBD::SQLite } or plan skip_all => "DBD::SQLite is required for this test"; eval { require DBIx::Class } or plan skip_all => "DBIx::Class is required for this test"; eval { require Catalyst::Plugin::Authorization::Roles } or plan skip_all => "Catalyst::Plugin::Authorization::Roles is required for this test"; plan tests => 8; $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/auth.db" unless exists($ENV{TESTAPP_DB_FILE}); $ENV{TESTAPP_CONFIG} = { name => 'TestApp', authentication => { default_realm => "users", realms => { users => { credential => { 'class' => "Password", 'password_field' => 'password', 'password_type' => 'clear' }, store => { 'class' => 'DBIx::Class', 'user_model' => 'TestApp::User', 'role_relation' => 'roles', 'role_field' => 'role' }, }, }, }, }; $ENV{TESTAPP_PLUGINS} = [ qw/Authentication Authorization::Roles / ]; } use SetupDB; use Catalyst::Test 'TestApp'; # test user's admin access { ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin'), 'request ok' ); is( $res->content, 'ok', 'user is an admin' ); } # test unauthorized user's admin access { ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin'), 'request ok' ); is( $res->content, 'failed', 'user is not an admin' ); } # test multiple auth roles { ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin_user'), 'request ok' ); is( $res->content, 'ok', 'user is an admin and a user' ); } # test multiple unauth roles { ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin_user'), 'request ok' ); is( $res->content, 'failed', 'user is not an admin and a user' ); } # clean up unlink $ENV{TESTAPP_DB_FILE}; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/01-pod.t0000644000175000017500000000021411402677735023214 0ustar rkitoverrkitover#!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(); Catalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/0000755000175000017500000000000011404300037022554 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/0000755000175000017500000000000011404300037024134 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Controller/0000755000175000017500000000000011404300037026257 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Controller/Root.pm0000644000175000017500000001140511402677735027565 0ustar rkitoverrkitoverpackage TestApp::Controller::Root; use Moose; BEGIN { extends 'Catalyst::Controller' } __PACKAGE__->config(namespace => ''); sub user_login : Global { my ( $self, $c ) = @_; ## this allows anyone to login regardless of status. eval { $c->authenticate({ username => $c->request->params->{'username'}, password => $c->request->params->{'password'} }); 1; } or do { return $c->res->body($@); }; if ( $c->user_exists ) { if ( $c->req->params->{detach} ) { $c->detach( $c->req->params->{detach} ); } $c->res->body( $c->user->get('username') . ' logged in' ); } else { $c->res->body( 'not logged in' ); } } sub notdisabled_login : Global { my ( $self, $c ) = @_; $c->authenticate({ username => $c->request->params->{'username'}, password => $c->request->params->{'password'}, status => [ 'active', 'registered' ] }); if ( $c->user_exists ) { if ( $c->req->params->{detach} ) { $c->detach( $c->req->params->{detach} ); } $c->res->body( $c->user->get('username') . ' logged in' ); } else { $c->res->body( 'not logged in' ); } } sub searchargs_login : Global { my ( $self, $c ) = @_; my $username = $c->request->params->{'username'} || ''; my $email = $c->request->params->{'email'} || ''; $c->authenticate({ password => $c->request->params->{'password'}, dbix_class => { searchargs => [ { "-or" => [ username => $username, email => $email ]}, { prefetch => qw/ map_user_role /} ] } }); if ( $c->user_exists ) { if ( $c->req->params->{detach} ) { $c->detach( $c->req->params->{detach} ); } $c->res->body( $c->user->get('username') . ' logged in' ); } else { $c->res->body( 'not logged in' ); } } sub resultset_login : Global { my ( $self, $c ) = @_; my $username = $c->request->params->{'username'} || ''; my $email = $c->request->params->{'email'} || ''; my $rs = $c->model('TestApp::User')->search({ "-or" => [ username => $username, email => $email ]}); $c->authenticate({ password => $c->request->params->{'password'}, dbix_class => { resultset => $rs } }); if ( $c->user_exists ) { if ( $c->req->params->{detach} ) { $c->detach( $c->req->params->{detach} ); } $c->res->body( $c->user->get('username') . ' logged in' ); } else { $c->res->body( 'not logged in' ); } } sub bad_login : Global { my ( $self, $c ) = @_; ## this allows anyone to login regardless of status. eval { $c->authenticate({ william => $c->request->params->{'username'}, the_bum => $c->request->params->{'password'} }); 1; } or do { return $c->res->body($@); }; if ( $c->user_exists ) { if ( $c->req->params->{detach} ) { $c->detach( $c->req->params->{detach} ); } $c->res->body( $c->user->get('username') . ' logged in' ); } else { $c->res->body( 'not logged in' ); } } ## need to add a resultset login test and a search args login test sub user_logout : Global { my ( $self, $c ) = @_; $c->logout; if ( ! $c->user ) { $c->res->body( 'logged out' ); } else { $c->res->body( 'not logged ok' ); } } sub get_session_user : Global { my ( $self, $c ) = @_; if ( $c->user_exists ) { $c->res->body($c->user->get('username')); # . " " . Dumper($c->user->get_columns()) ); } } sub is_admin : Global { my ( $self, $c ) = @_; eval { if ( $c->assert_user_roles( qw/admin/ ) ) { $c->res->body( 'ok' ); } }; if ($@) { $c->res->body( 'failed' ); } } sub is_admin_user : Global { my ( $self, $c ) = @_; eval { if ( $c->assert_user_roles( qw/admin user/ ) ) { $c->res->body( 'ok' ); } }; if ($@) { $c->res->body( 'failed' ); } } sub set_usersession : Global { my ( $self, $c, $value ) = @_; $c->user_session->{foo} = $value; $c->res->body( 'ok' ); } sub get_usersession : Global { my ( $self, $c ) = @_; $c->res->body( $c->user_session->{foo} || '' ); } __PACKAGE__->meta->make_immutable; 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Schema/0000755000175000017500000000000011404300037025334 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Schema/User.pm0000644000175000017500000000076711403134541026626 0ustar rkitoverrkitoverpackage TestApp::Schema::User; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components(qw/ Core /); __PACKAGE__->table( 'user' ); __PACKAGE__->add_columns( qw/id username email status role_text session_data/ ); __PACKAGE__->add_column(password => { accessor => 'password_accessor' }); __PACKAGE__->set_primary_key( 'id' ); __PACKAGE__->has_many( 'map_user_role' => 'TestApp::Schema::UserRole' => 'user' ); __PACKAGE__->many_to_many( roles => 'map_user_role', 'role'); 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Schema/UserRole.pm0000644000175000017500000000053611402677735027462 0ustar rkitoverrkitoverpackage TestApp::Schema::UserRole; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components(qw/ Core /); __PACKAGE__->table( 'user_role' ); __PACKAGE__->add_columns( qw/id user roleid/ ); __PACKAGE__->set_primary_key( qw/id/ ); __PACKAGE__->belongs_to('role', 'TestApp::Schema::Role', { 'foreign.id' => 'self.roleid'}); 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Schema/Role.pm0000644000175000017500000000050411402677735026616 0ustar rkitoverrkitoverpackage TestApp::Schema::Role; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components(qw/ Core /); __PACKAGE__->table( 'role' ); __PACKAGE__->add_columns( qw/id role/ ); __PACKAGE__->set_primary_key( 'id' ); #__PACKAGE__->has_many( map_user_role => 'TestApp::Schema::UserRole' => 'roleid' ); 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Model/0000755000175000017500000000000011404300037025174 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Model/TestApp.pm0000644000175000017500000000063211402677735027137 0ustar rkitoverrkitoverpackage TestApp::Model::TestApp; use base qw/Catalyst::Model::DBIC::Schema/; use strict; our $db_file = $ENV{TESTAPP_DB_FILE}; __PACKAGE__->config( schema_class => 'TestApp::Schema', connect_info => [ "dbi:SQLite:$db_file", '', '', { AutoCommit => 1 }, ], ); # Load all of the classes #__PACKAGE__->load_classes(qw/Role User UserRole/); 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp/Schema.pm0000644000175000017500000000027511402677735025722 0ustar rkitoverrkitoverpackage TestApp::Schema; # Created by DBIx::Class::Schema::Loader v0.03007 @ 2006-10-18 12:38:33 use strict; use warnings; use base 'DBIx::Class::Schema'; __PACKAGE__->load_classes; 1;Catalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/TestApp.pm0000644000175000017500000000023111402677735024512 0ustar rkitoverrkitoverpackage TestApp; use strict; use Catalyst; use Data::Dumper; TestApp->config( $ENV{TESTAPP_CONFIG} ); TestApp->setup( @{$ENV{TESTAPP_PLUGINS}} ); 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/lib/SetupDB.pm0000644000175000017500000000233711402677735024451 0ustar rkitoverrkitover# create the database my $db_file = $ENV{TESTAPP_DB_FILE}; unlink $db_file if -e $db_file; my $dbh = DBI->connect( "dbi:SQLite:$db_file" ) or die $DBI::errstr; my $sql = q{ CREATE TABLE user ( id INTEGER PRIMARY KEY, username TEXT, email TEXT, password TEXT, status TEXT, role_text TEXT, session_data TEXT ); CREATE TABLE role ( id INTEGER PRIMARY KEY, role TEXT ); CREATE TABLE user_role ( id INTEGER PRIMARY KEY, user INTEGER, roleid INTEGER ); INSERT INTO user VALUES (1, 'joeuser', 'joeuser@nowhere.com', 'hackme', 'active', 'admin', NULL); INSERT INTO user VALUES (2, 'spammer', 'bob@spamhaus.com', 'broken', 'disabled', NULL, NULL); INSERT INTO user VALUES (3, 'jayk', 'j@cpants.org', 'letmein', 'active', NULL, NULL); INSERT INTO user VALUES (4, 'nuffin', 'nada@mucho.net', 'much', 'registered', 'user admin', NULL); INSERT INTO role VALUES (1, 'admin'); INSERT INTO role VALUES (2, 'user'); INSERT INTO user_role VALUES (1, 3, 1); INSERT INTO user_role VALUES (2, 3, 2); INSERT INTO user_role VALUES (3, 4, 2) }; $dbh->do( $_ ) for split /;/, $sql; $dbh->disconnect;Catalyst-Authentication-Store-DBIx-Class-0.1201/t/06-auth-roles-column.t0000644000175000017500000000446711402677735026033 0ustar rkitoverrkitover#!perl use strict; use warnings; use DBI; use File::Path; use FindBin; use Test::More; use lib "$FindBin::Bin/lib"; BEGIN { eval { require DBD::SQLite } or plan skip_all => "DBD::SQLite is required for this test"; eval { require DBIx::Class } or plan skip_all => "DBIx::Class is required for this test"; eval { require Catalyst::Plugin::Authorization::Roles } or plan skip_all => "Catalyst::Plugin::Authorization::Roles is required for this test"; plan tests => 8; $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/auth.db" unless exists($ENV{TESTAPP_DB_FILE}); $ENV{TESTAPP_CONFIG} = { name => 'TestApp', authentication => { default_realm => "users", realms => { users => { credential => { 'class' => "Password", 'password_field' => 'password', 'password_type' => 'clear' }, store => { 'class' => 'DBIx::Class', 'user_model' => 'TestApp::User', 'role_column' => 'role_text' }, }, }, }, }; $ENV{TESTAPP_PLUGINS} = [ qw/Authentication Authorization::Roles / ]; } use SetupDB; use Catalyst::Test 'TestApp'; # test user's admin access { ok( my $res = request('http://localhost/user_login?username=joeuser&password=hackme&detach=is_admin'), 'request ok' ); is( $res->content, 'ok', 'user is an admin' ); } # test unauthorized user's admin access { ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin'), 'request ok' ); is( $res->content, 'failed', 'user is not an admin' ); } # test multiple auth roles { ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin_user'), 'request ok' ); is( $res->content, 'ok', 'user is an admin and a user' ); } # test multiple unauth roles { ok( my $res = request('http://localhost/user_login?username=joeuser&password=hackme&detach=is_admin_user'), 'request ok' ); is( $res->content, 'failed', 'user is not an admin and a user' ); } # clean up unlink $ENV{TESTAPP_DB_FILE}; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/08-simpledb-auth-roles-relationship.t0000644000175000017500000000363611402677735031033 0ustar rkitoverrkitover#!perl use strict; use warnings; use DBI; use File::Path; use FindBin; use Test::More; use lib "$FindBin::Bin/lib"; BEGIN { eval { require DBD::SQLite } or plan skip_all => "DBD::SQLite is required for this test"; eval { require DBIx::Class } or plan skip_all => "DBIx::Class is required for this test"; eval { require Catalyst::Plugin::Authorization::Roles } or plan skip_all => "Catalyst::Plugin::Authorization::Roles is required for this test"; plan tests => 8; $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/auth.db" unless exists($ENV{TESTAPP_DB_FILE}); $ENV{TESTAPP_CONFIG} = { name => 'TestApp', 'Plugin::Authentication' => { default => { class => 'SimpleDB', user_model => 'TestApp::User', password_type => 'clear' } } }; $ENV{TESTAPP_PLUGINS} = [ qw/Authentication Authorization::Roles / ]; } use SetupDB; use Catalyst::Test 'TestApp'; # test user's admin access { ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin'), 'request ok' ); is( $res->content, 'ok', 'user is an admin' ); } # test unauthorized user's admin access { ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin'), 'request ok' ); is( $res->content, 'failed', 'user is not an admin' ); } # test multiple auth roles { ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin_user'), 'request ok' ); is( $res->content, 'ok', 'user is an admin and a user' ); } # test multiple unauth roles { ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin_user'), 'request ok' ); is( $res->content, 'failed', 'user is not an admin and a user' ); } # clean up unlink $ENV{TESTAPP_DB_FILE}; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/02-pod-coverage.t0000644000175000017500000000033711402677735025014 0ustar rkitoverrkitover#!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({ coverage_class => 'Pod::Coverage::CountParents' }); Catalyst-Authentication-Store-DBIx-Class-0.1201/t/09-simpledb-auth-roles-column.t0000644000175000017500000000366411402677735027631 0ustar rkitoverrkitover#!perl use strict; use warnings; use DBI; use File::Path; use FindBin; use Test::More; use lib "$FindBin::Bin/lib"; BEGIN { eval { require DBD::SQLite } or plan skip_all => "DBD::SQLite is required for this test"; eval { require DBIx::Class } or plan skip_all => "DBIx::Class is required for this test"; eval { require Catalyst::Plugin::Authorization::Roles } or plan skip_all => "Catalyst::Plugin::Authorization::Roles is required for this test"; plan tests => 8; $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/auth.db" unless exists($ENV{TESTAPP_DB_FILE}); $ENV{TESTAPP_CONFIG} = { name => 'TestApp', 'Plugin::Authentication' => { default => { class => 'SimpleDB', user_model => 'TestApp::User', role_column => 'role_text', password_type => 'clear' } } }; $ENV{TESTAPP_PLUGINS} = [ qw/Authentication Authorization::Roles / ]; } use SetupDB; use Catalyst::Test 'TestApp'; # test user's admin access { ok( my $res = request('http://localhost/user_login?username=joeuser&password=hackme&detach=is_admin'), 'request ok' ); is( $res->content, 'ok', 'user is an admin' ); } # test unauthorized user's admin access { ok( my $res = request('http://localhost/user_login?username=jayk&password=letmein&detach=is_admin'), 'request ok' ); is( $res->content, 'failed', 'user is not an admin' ); } # test multiple auth roles { ok( my $res = request('http://localhost/user_login?username=nuffin&password=much&detach=is_admin_user'), 'request ok' ); is( $res->content, 'ok', 'user is an admin and a user' ); } # test multiple unauth roles { ok( my $res = request('http://localhost/user_login?username=joeuser&password=hackme&detach=is_admin_user'), 'request ok' ); is( $res->content, 'failed', 'user is not an admin and a user' ); } # clean up unlink $ENV{TESTAPP_DB_FILE}; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/07-authsessions-cached.t0000644000175000017500000000512011402677735026376 0ustar rkitoverrkitover#!perl use strict; use warnings; use DBI; use File::Path; use FindBin; use Test::More; use lib "$FindBin::Bin/lib"; BEGIN { eval { require Test::WWW::Mechanize::Catalyst } or plan skip_all => "Test::WWW::Mechanize::Catalyst is required for this test"; eval { require DBD::SQLite } or plan skip_all => "DBD::SQLite is required for this test"; eval { require DBIx::Class } or plan skip_all => "DBIx::Class is required for this test"; eval { require Catalyst::Plugin::Session; die unless $Catalyst::Plugin::Session::VERSION >= 0.02 } or plan skip_all => "Catalyst::Plugin::Session >= 0.02 is required for this test"; eval { require Catalyst::Plugin::Session::State::Cookie; } or plan skip_all => "Catalyst::Plugin::Session::State::Cookie is required for this test"; plan tests => 8; $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/auth.db" unless exists($ENV{TESTAPP_DB_FILE}); $ENV{TESTAPP_CONFIG} = { name => 'TestApp', authentication => { default_realm => "users", realms => { users => { credential => { 'class' => "Password", 'password_field' => 'password', 'password_type' => 'clear' }, store => { 'class' => 'DBIx::Class', 'user_model' => 'TestApp::User', 'use_userdata_from_session' => 1, }, }, }, }, }; $ENV{TESTAPP_PLUGINS} = [ qw/Authentication Session Session::Store::Dummy Session::State::Cookie / ]; } use SetupDB; use Test::WWW::Mechanize::Catalyst 'TestApp'; my $m = Test::WWW::Mechanize::Catalyst->new; # log a user in { $m->get_ok( 'http://localhost/user_login?username=joeuser&password=hackme', undef, 'request ok' ); $m->content_is( 'joeuser logged in', 'user logged in ok' ); } # verify the user is still logged in { $m->get_ok( 'http://localhost/get_session_user', undef, 'request ok' ); $m->content_is( 'joeuser', 'user still logged in' ); } # log the user out { $m->get_ok( 'http://localhost/user_logout', undef, 'request ok' ); $m->content_is( 'logged out', 'user logged out ok' ); } # verify there is no session { $m->get_ok( 'http://localhost/get_session_user', undef, 'request ok' ); $m->content_is( '', "user's session deleted" ); } # clean up unlink $ENV{TESTAPP_DB_FILE}; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/03-authtest.t0000644000175000017500000000633711402677735024311 0ustar rkitoverrkitover#!perl use strict; use warnings; use DBI; use File::Path; use FindBin; use Test::More; use lib "$FindBin::Bin/lib"; BEGIN { eval { require DBD::SQLite } or plan skip_all => "DBD::SQLite is required for this test"; eval { require DBIx::Class } or plan skip_all => "DBIx::Class is required for this test"; plan tests => 17; $ENV{TESTAPP_DB_FILE} = "$FindBin::Bin/auth.db" unless exists($ENV{TESTAPP_DB_FILE}); $ENV{TESTAPP_CONFIG} = { name => 'TestApp', authentication => { default_realm => "users", realms => { users => { credential => { 'class' => "Password", 'password_field' => 'password', 'password_type' => 'clear' }, store => { 'class' => 'DBIx::Class', 'user_model' => 'TestApp::User', }, }, }, }, }; $ENV{TESTAPP_PLUGINS} = [ qw/Authentication/ ]; } use SetupDB; use Catalyst::Test 'TestApp'; # log a user in { ok( my $res = request('http://localhost/user_login?username=joeuser&password=hackme'), 'request ok' ); is( $res->content, 'joeuser logged in', 'user logged in ok' ); } # invalid user { ok( my $res = request('http://localhost/user_login?username=foo&password=bar'), 'request ok' ); is( $res->content, 'not logged in', 'user not logged in ok' ); } # disabled user - no disable check { ok( my $res = request('http://localhost/user_login?username=spammer&password=broken'), 'request ok' ); is( $res->content, 'spammer logged in', 'status check - disabled user logged in ok' ); } # disabled user - should fail login { ok( my $res = request('http://localhost/notdisabled_login?username=spammer&password=broken'), 'request ok' ); is( $res->content, 'not logged in', 'status check - disabled user not logged in ok' ); } # log the user out { ok( my $res = request('http://localhost/user_logout'), 'request ok' ); is( $res->content, 'logged out', 'user logged out ok' ); } # searchargs test { ok( my $res = request('http://localhost/searchargs_login?email=nada%40mucho.net&password=much'), 'request ok' ); is( $res->content, 'nuffin logged in', 'searchargs based login ok' ); } # resultset test # searchargs test { ok( my $res = request('http://localhost/resultset_login?email=j%40cpants.org&password=letmein'), 'request ok' ); is( $res->content, 'jayk logged in', 'resultset based login ok' ); } # invalid user { ok( my $res = request('http://localhost/bad_login?username=foo&password=bar'), 'request ok' ); like( $res->content, qr/only has these columns/, 'incorrect parameters to authenticate throws a useful exception' ); } { $ENV{TESTAPP_CONFIG}->{authentication}->{realms}->{users}->{store}->{user_model} = 'Nonexistent::Class'; my $res = request('http://localhost/user_login?username=joeuser&password=hackme'); like( $res->content, qr/\$\Qc->model('Nonexistent::Class') did not return a resultset. Did you set user_model correctly?/, 'test for wrong user_class' ); } # clean up unlink $ENV{TESTAPP_DB_FILE}; Catalyst-Authentication-Store-DBIx-Class-0.1201/t/00-load.t0000644000175000017500000000036011402677735023352 0ustar rkitoverrkitover#!perl use Test::More tests => 1; BEGIN { use_ok( 'Catalyst::Authentication::Store::DBIx::Class' ); } diag( "Testing Catalyst::Authentication::Store::DBIx::Class $Catalyst::Authentication::Store::DBIx::Class::VERSION, Perl $], $^X" ); Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/0000755000175000017500000000000011404300037022314 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/0000755000175000017500000000000011404300037023541 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/0000755000175000017500000000000011404300037025147 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/Metadata.pm0000644000175000017500000004302011404300032027217 0ustar rkitoverrkitover#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.99'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}->{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the reall old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( \Qhttp://rt.cpan.org/\E[^>]+| \Qhttp://github.com/\E[\w_]+/[\w_]+/issues| \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/Base.pm0000644000175000017500000000214711404300032026356 0ustar rkitoverrkitover#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '0.99'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/Fetch.pm0000644000175000017500000000462711404300035026545 0ustar rkitoverrkitover#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.99'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/Makefile.pm0000644000175000017500000002703211404300032027221 0ustar rkitoverrkitover#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.99'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/; $self->build_requires( 'ExtUtils::MakeMaker' => $v ); $self->configure_requires( 'ExtUtils::MakeMaker' => $v ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT $DB::single = 1; if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 541 Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/Can.pm0000644000175000017500000000333311404300035026206 0ustar rkitoverrkitover#line 1 package Module::Install::Can; use strict; use Config (); use File::Spec (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.99'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 156 Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/Include.pm0000644000175000017500000000101511404300032027060 0ustar rkitoverrkitover#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.99'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/WriteAll.pm0000644000175000017500000000237611404300035027236 0ustar rkitoverrkitover#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.99'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/AutoInstall.pm0000644000175000017500000000306411404300032027742 0ustar rkitoverrkitover#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.99'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; my @features_require = Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); my %seen; my @requires = map @$_, map @$_, grep ref, $self->requires; while (my ($mod, $ver) = splice(@requires, 0, 2)) { $seen{$mod}{$ver}++; } my @deduped; while (my ($mod, $ver) = splice(@features_require, 0, 2)) { push @deduped, $mod => $ver unless $seen{$mod}{$ver}++; } $self->requires(@deduped); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install/Win32.pm0000644000175000017500000000340311404300035026405 0ustar rkitoverrkitover#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.99'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/Install.pm0000644000175000017500000003002611404300031025500 0ustar rkitoverrkitover#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.99'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; require FindBin; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[0]) <=> _version($_[1]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2010 Adam Kennedy. Catalyst-Authentication-Store-DBIx-Class-0.1201/inc/Module/AutoInstall.pm0000644000175000017500000005423111404300033026337 0ustar rkitoverrkitover#line 1 package Module::AutoInstall; use strict; use Cwd (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.03'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps ); my ( $PostambleActions, $PostambleUsed ); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _load($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { require Config; print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; return (@Existing, @Missing); } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( _version_cmp( _load($pkg), $ver ) >= 0 ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _load($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^force$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) : CPAN::Shell->install($pkg); $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # class/instance doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to # CPAN::HandleConfig->load. CPAN reports that the redirection # is deprecated in a warning printed at the user. # CPAN-1.81 expects CPAN::HandleConfig->load, does not have # $CPAN::HandleConfig::VERSION but cannot handle # CPAN::Config->load # Which "versions expect CPAN::Config->load? if ( $CPAN::HandleConfig::VERSION || CPAN::HandleConfig->can('load') ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; return <<"END_MAKE"; config :: installdeps \t\$(NOECHO) \$(NOOP) checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions END_MAKE } 1; __END__ #line 1071 Catalyst-Authentication-Store-DBIx-Class-0.1201/META.yml0000644000175000017500000000234611404300036023020 0ustar rkitoverrkitover--- abstract: 'A storage class for Catalyst Authentication using DBIx::Class' author: - 'Jason Kuri (jayk@cpan.org)' build_requires: ExtUtils::MakeMaker: 6.42 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.42 distribution_type: module generated_by: 'Module::Install version 0.99' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Catalyst-Authentication-Store-DBIx-Class no_index: directory: - inc - t provides: Catalyst::Authentication::Realm::SimpleDB: file: lib/Catalyst/Authentication/Realm/SimpleDB.pm Catalyst::Authentication::Store::DBIx::Class: file: lib/Catalyst/Authentication/Store/DBIx/Class.pm version: 0.1201 Catalyst::Authentication::Store::DBIx::Class::User: file: lib/Catalyst/Authentication/Store/DBIx/Class/User.pm requires: Catalyst::Model::DBIC::Schema: 0.18 Catalyst::Plugin::Authentication: 0.10008 Catalyst::Runtime: 5.8 DBIx::Class: 0.08 List::MoreUtils: 0 Moose: 0 Test::More: 0 Try::Tiny: 0 namespace::autoclean: 0 perl: 5.8.1 resources: license: http://dev.perl.org/licenses/ repository: http://dev.catalystframework.org/repos/Catalyst/Catalyst-Authentication-Store-DBIx-Class version: 0.1201 Catalyst-Authentication-Store-DBIx-Class-0.1201/README0000644000175000017500000004200311404300032022415 0ustar rkitoverrkitoverNAME Catalyst::Authentication::Store::DBIx::Class - A storage class for Catalyst Authentication using DBIx::Class VERSION This documentation refers to version 0.1201. SYNOPSIS use Catalyst qw/ Authentication Authorization::Roles/; __PACKAGE__->config->{authentication} = { default_realm => 'members', realms => { members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'DBIx::Class', user_model => 'MyApp::User', role_relation => 'roles', role_field => 'rolename', } } } }; # Log a user in: sub login : Global { my ( $self, $c ) = @_; $c->authenticate({ screen_name => $c->req->params->username, password => $c->req->params->password, status => [ 'registered', 'loggedin', 'active'] })) } # verify a role if ( $c->check_user_roles( 'editor' ) ) { # do editor stuff } DESCRIPTION The Catalyst::Authentication::Store::DBIx::Class class provides access to authentication information stored in a database via DBIx::Class. CONFIGURATION The DBIx::Class authentication store is activated by setting the store config's class element to DBIx::Class as shown above. See the Catalyst::Plugin::Authentication documentation for more details on configuring the store. You can also use Catalyst::Authentication::Realm::SimpleDB for a simplified setup. The DBIx::Class storage module has several configuration options __PACKAGE__->config->{authentication} = { default_realm => 'members', realms => { members => { credential => { # ... }, store => { class => 'DBIx::Class', user_model => 'MyApp::User', role_relation => 'roles', role_field => 'rolename', ignore_fields_in_find => [ 'remote_name' ], use_userdata_from_session => 1, } } } }; class Class is part of the core Catalyst::Plugin::Authentication module; it contains the class name of the store to be used. user_model Contains the model name (as passed to $c->model()) of the DBIx::Class schema to use as the source for user information. This config item is REQUIRED. (Note that this option used to be called "user_class". "user_class" is still functional, but should be used only for compatibility with previous configs. The setting called "user_class" on other authentication stores is present, but named "store_user_class" in this store) role_column If your role information is stored in the same table as the rest of your user information, this item tells the module which field contains your role information. The DBIx::Class authentication store expects the data in this field to be a series of role names separated by some combination of spaces, commas, or pipe characters. role_relation If your role information is stored in a separate table, this is the name of the relation that will lead to the roles the user is in. If this is specified, then a role_field is also required. Also when using this method it is expected that your role table will return one row for each role the user is in. role_field This is the name of the field in the role table that contains the string identifying the role. ignore_fields_in_find This item is an array containing fields that may be passed to the $c->authenticate() routine (and therefore find_user in the storage class), but which should be ignored when creating the DBIx::Class search to retrieve a user. This makes it possible to avoid problems when a credential requires an authinfo element whose name overlaps with a column name in your users table. If this doesn't make sense to you, you probably don't need it. use_userdata_from_session Under normal circumstances, on each request the user's data is re-retrieved from the database using the primary key for the user table. When this flag is set in the configuration, it causes the DBIx::Class store to avoid this database hit on session restore. Instead, the user object's column data is retrieved from the session and used as-is. NOTE: Since the user object's column data is only stored in the session during the initial authentication of the user, turning this on can potentially lead to a situation where the data in $c->user is different from what is stored the database. You can force a reload of the data from the database at any time by calling $c->user->get_object(1); Note that this will update $c->user for the remainder of this request. It will NOT update the session. If you need to update the session you should call $c->update_user_in_session() as well. store_user_class This allows you to override the authentication user class that the DBIx::Class store module uses to perform its work. Most of the work done in this module is actually done by the user class, Catalyst::Authentication::Store::DBIx::Class::User, so overriding this doesn't make much sense unless you are using your own class to extend the functionality of the existing class. Chances are you do not want to set this. id_field In most cases, this config variable does not need to be set, as Catalyst::Authentication::Store::DBIx::Class will determine the primary key of the user table on its own. If you need to override the default, or your user table has multiple primary keys, then id_field should contain the column name that should be used to restore the user. A given value in this column should correspond to a single user in the database. Note that this is used ONLY when restoring a user from the session and has no bearing whatsoever in the initial authentication process. Note also that if use_userdata_from_session is enabled, this config parameter is not used at all. USAGE The Catalyst::Authentication::Store::DBIx::Class storage module is not called directly from application code. You interface with it through the $c->authenticate() call. There are three methods you can use to retrieve information from the DBIx::Class storage module. They are Simple retrieval, and the advanced retrieval methods Searchargs and Resultset. Simple Retrieval The first, and most common, method is simple retrieval. As its name implies simple retrieval allows you to simply to provide the column => value pairs that should be used to locate the user in question. An example of this usage is below: if ($c->authenticate({ screen_name => $c->req->params->{'username'}, password => $c->req->params->{'password'}, status => [ 'registered', 'active', 'loggedin'] })) { # ... authenticated user code here } The above example would attempt to retrieve a user whose username column (here, screen_name) matched the username provided, and whose status column matched one of the values provided. These name => value pairs are used more or less directly in the DBIx::Class search() routine, so in most cases, you can use DBIx::Class syntax to retrieve the user according to whatever rules you have. NOTE: Because the password in most cases is encrypted - it is not used directly but its encryption and comparison with the value provided is usually handled by the Password Credential. Part of the Password Credential's behavior is to remove the password argument from the authinfo that is passed to the storage module. See Catalyst::Authentication::Credential::Password. One thing you need to know about this retrieval method is that the name portion of the pair is checked against the user class's column list. Pairs are only used if a matching column is found. Other pairs will be ignored. This means that you can only provide simple name-value pairs, and that some more advanced DBIx::Class constructs, such as '-or', '-and', etc. are in most cases not possible using this method. For queries that require this level of functionality, see the 'searchargs' method below. Advanced Retrieval The Searchargs and Resultset retrieval methods are used when more advanced features of the underlying DBIx::Class schema are required. These methods provide a direct interface with the DBIx::Class schema and therefore require a better understanding of the DBIx::Class module. The dbix_class key Since the format of these arguments are often complex, they are not keys in the base authinfo hash. Instead, both of these arguments are placed within a hash attached to the store-specific 'dbix_class' key in the base $authinfo hash. When the DBIx::Class authentication store sees the 'dbix_class' key in the passed authinfo hash, all the other information in the authinfo hash is ignored and only the values within the 'dbix_class' hash are used as though they were passed directly within the authinfo hash. In other words, if 'dbix_class' is present, it replaces the authinfo hash for processing purposes. The 'dbix_class' hash can be used to directly pass arguments to the DBIx::Class authentication store. Reasons to do this are to avoid credential modification of the authinfo hash, or to avoid overlap between credential and store key names. It's a good idea to avoid using it in this way unless you are sure you have an overlap/modification issue. However, the two advanced retrieval methods, searchargs and resultset, require its use, as they are only processed as part of the 'dbix_class' hash. Searchargs The searchargs method of retrieval allows you to specify an arrayref containing the two arguments to the search() method from DBIx::Class::ResultSet. If provided, all other args are ignored, and the search args provided are used directly to locate the user. An example will probably make more sense: if ($c->authenticate( { password => $password, 'dbix_class' => { searchargs => [ { -or => [ username => $username, email => $email, clientid => $clientid ] }, { prefetch => qw/ preferences / } ] } } ) ) { # do successful authentication actions here. } The above would allow authentication based on any of the three items - username, email, or clientid - and would prefetch the data related to that user from the preferences table. The searchargs array is passed directly to the search() method associated with the user_model. Resultset The resultset method of retrieval allows you to directly specify a resultset to be used for user retrieval. This allows you to create a resultset within your login action and use it for retrieving the user. A simple example: my $rs = $c->model('MyApp::User')->search({ email => $c->request->params->{'email'} }); ... # further $rs adjustments if ($c->authenticate({ password => $password, 'dbix_class' => { resultset => $rs } })) { # do successful authentication actions here. } Be aware that the resultset method will not verify that you are passing a resultset that is attached to the same user_model as specified in the config. NOTE: All of these methods of user retrieval, including the resultset method, consider the first row returned to be the matching user. In most cases there will be only one matching row, but it is easy to produce multiple rows, especially when using the advanced retrieval methods. Remember, what you get when you use this module is what you would get when calling search(...)->first; NOTE ALSO: The user info used to save the user to the session and to retrieve it is the same regardless of what method of retrieval was used. In short, the value in the id field (see 'id_field' config item) is used to retrieve the user from the database upon restoring from the session. When the DBIx::Class storage module does this, it does so by doing a simple search using the id field. In other words, it will not use the same arguments you used to request the user initially. This is especially important to those using the advanced methods of user retrieval. If you need more complicated logic when reviving the user from the session, you will most likely want to subclass the Catalyst::Authentication::Store::DBIx::Class::User class and provide your own for_session and from_session routines. METHODS There are no publicly exported routines in the DBIx::Class authentication store (or indeed in most authentication stores). However, below is a description of the routines required by Catalyst::Plugin::Authentication for all authentication stores. Please see the documentation for Catalyst::Plugin::Authentication::Internals for more information. new ( $config, $app ) Constructs a new store object. find_user ( $authinfo, $c ) Finds a user using the information provided in the $authinfo hashref and returns the user, or undef on failure. This is usually called from the Credential. This translates directly to a call to Catalyst::Authentication::Store::DBIx::Class::User's load() method. for_session ( $c, $user ) Prepares a user to be stored in the session. Currently returns the value of the user's id field (as indicated by the 'id_field' config element) from_session ( $c, $frozenuser) Revives a user from the session based on the info provided in $frozenuser. Currently treats $frozenuser as an id and retrieves a user with a matching id. user_supports Provides information about what the user object supports. auto_update_user( $authinfo, $c, $res ) This method is called if the realm's auto_update_user setting is true. It will delegate to the user object's "auto_update" method. auto_create_user( $authinfo, $c ) This method is called if the realm's auto_create_user setting is true. It will delegate to the user class's (resultset) "auto_create" method. NOTES As of the current release, session storage consists of simply storing the user's id in the session, and then using that same id to re-retrieve the user's information from the database upon restoration from the session. More dynamic storage of user information in the session is intended for a future release. BUGS AND LIMITATIONS None known currently; please email the author if you find any. SEE ALSO Catalyst::Plugin::Authentication, Catalyst::Plugin::Authentication::Internals, and Catalyst::Plugin::Authorization::Roles AUTHOR Jason Kuri (jayk@cpan.org) LICENSE Copyright (c) 2007 the aforementioned authors. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Catalyst-Authentication-Store-DBIx-Class-0.1201/lib/0000755000175000017500000000000011404300037022311 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/0000755000175000017500000000000011404300037024075 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/0000755000175000017500000000000011404300037027054 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/Realm/0000755000175000017500000000000011404300037030114 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/Realm/SimpleDB.pm0000644000175000017500000001773011402677735032145 0ustar rkitoverrkitoverpackage Catalyst::Authentication::Realm::SimpleDB; use strict; use warnings; use Catalyst::Exception; use base qw/Catalyst::Authentication::Realm/; sub new { my ($class, $realmname, $config, $app) = @_; my $newconfig = { credential => { class => 'Password', password_type => 'clear' }, store => { class => 'DBIx::Class', role_relation => 'roles', role_field => 'role', use_userdata_from_session => '1' } }; if (!defined($config->{'user_model'})) { Catalyst::Exception->throw("Unable to initialize authentication, no user_model specified in SimpleDB config."); } ## load any overrides for the credential foreach my $key (qw/ password_type password_field password_hash_type/) { if (exists($config->{$key})) { $newconfig->{credential}{$key} = $config->{$key}; } } ## load any overrides for the store foreach my $key (qw/ user_model role_relation role_field role_column use_userdata_from_session/) { if (exists($config->{$key})) { $newconfig->{store}{$key} = $config->{$key}; } } if (exists($newconfig->{'store'}{'role_column'})) { delete $newconfig->{'store'}{'role_relation'}; delete $newconfig->{'store'}{'role_field'}; } return $class->SUPER::new($realmname, $newconfig, $app); } 1; __END__ =head1 NAME Catalyst::Authentication::Realm::SimpleDB - A simplified Catalyst authentication configurator. =head1 SYNOPSIS use Catalyst qw/ Authentication /; __PACKAGE__->config->{'Plugin::Authentication'} = { default => { class => 'SimpleDB', user_model => 'MyApp::Schema::Users', } } # later on ... $c->authenticate({ username => 'myusername', password => 'mypassword' }); my $age = $c->user->get('age'); $c->logout; =head1 DESCRIPTION The Catalyst::Authentication::Realm::SimpleDB provides a simple way to configure Catalyst Authentication when using the most common configuration of a password protected user retrieved from an SQL database. =head1 CONFIGURATION The SimpleDB Realm class configures the Catalyst authentication system based on the following: =over =item * Your user data is stored in a table that is accessible via $c->model($cfg->{user_model}); =item * Your passwords are stored in the 'password' field in your users table and are not encrypted. =item * Your roles for users are stored in a separate table and are directly accessible via a DBIx::Class relationship called 'roles' and the text of the role is stored in a field called 'role' within the role table. =item * Your user information is stored in the session once the user is authenticated. =back For the above usage, only one configuration option is necessary, 'user_model'. B should contain the B. See the L section for info on how to set up your database for use with this module. If your system differs from the above, some minor configuration may be necessary. The options available are detailed below. These options match the configuration options used by the underlying credential and store modules. More information on these options can be found in L and L. =over =item user_model Contains the class name (as passed to $c->model() ) of the DBIx::Class schema to use as the source for user information. This config item is B. =item password_field If your password field is not 'password' set this option to the name of your password field. Note that if you change this to, say 'users_password' you will need to use that in the authenticate call: $c->authenticate({ username => 'bob', users_password => 'foo' }); =item password_type If the password is not stored in plaintext you will need to define what format the password is in. The common options are B and B. Crypted uses the standard unix crypt to encrypt the password. Hashed uses the L modules to perform password hashing. =item password_hash_type If you use a hashed password type - this defines the type of hashing. See L for more details on this setting. =item role_column If your users roles are stored directly in your user table, set this to the column name that contains your roles. For example, if your user table contains a field called 'permissions', the value of role_column would be 'permissions'. B: If multiple values are stored in the role column, they should be space or pipe delimited. =item role_relation and role_field These define an alternate role relationship name and the column that holds the role's name in plain text. See L for more details on these settings. =item use_userdata_from_session This is a simple 1 / 0 setting which determines how a user's data is saved / restored from the session. If it is set to 1, the user's complete information (at the time of authentication) is cached between requests. If it is set to 0, the users information is loaded from the database on each request. =back =head1 PREPARATION This module makes several assumptions about the structure of your database. Below is an example of a table structure which will function with this module in it's default configuration. You can use this table structure as-is or add additional fields as necessary. B that this is the default SimpleDB configuration only. Your table structure can differ significantly from this when using the L directly. -- -- note that you can add any additional columns you require to the users table. -- CREATE TABLE users ( id INTEGER PRIMARY KEY, username TEXT, password TEXT, ); CREATE TABLE roles ( id INTEGER PRIMARY KEY, role TEXT ); CREATE TABLE user_roles ( user_id INTEGER, role_id INTEGER, PRIMARY KEY (user_id, role_id) ); Also, after you have loaded this table structure into your DBIx::Class schema, please be sure that you have a many_to_many DBIx::Class relationship defined for the users to roles relation. Your schema files should contain something along these lines: C: __PACKAGE__->has_many(map_user_role => 'MyApp::Schema::UserRoles', 'user_id'); __PACKAGE__->many_to_many(roles => 'map_user_role', 'role'); C: __PACKAGE__->belongs_to(role => 'MyApp::Schema::Roles', 'role_id'); =head1 MIGRATION If and when your application becomes complex enough that you need more features than SimpleDB gives you access to, you can migrate to a standard Catalyst Authentication configuration fairly easily. SimpleDB simply creates a standard Auth config based on the inputs you give it. The config SimpleDB creates by default looks like this: MyApp->config('Plugin::Authentication') = { default => { credential => { class => 'Password', password_type => 'clear' }, store => { class => 'DBIx::Class', role_relation => 'roles', role_field => 'role', use_userdata_from_session => '1', user_model => $user_model_from_simpledb_config } } }; =head1 SEE ALSO This module relies on a number of other modules to do it's job. For more information you can refer to the following: =over =item * L =item * L =item * L =item * L =item * L =back =cut Catalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/Store/0000755000175000017500000000000011404300037030150 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/Store/DBIx/0000755000175000017500000000000011404300037030736 5ustar rkitoverrkitoverCatalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/Store/DBIx/Class/0000755000175000017500000000000011404300037032003 5ustar rkitoverrkitover././@LongLink0000000000000000000000000000014500000000000011565 Lustar rootrootCatalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/Store/DBIx/Class/User.pmCatalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm0000644000175000017500000002514011404277437033302 0ustar rkitoverrkitoverpackage Catalyst::Authentication::Store::DBIx::Class::User; use Moose; use namespace::autoclean; extends 'Catalyst::Authentication::User'; use List::MoreUtils 'all'; use Try::Tiny; has 'config' => (is => 'rw'); has 'resultset' => (is => 'rw'); has '_user' => (is => 'rw'); has '_roles' => (is => 'rw'); sub new { my ( $class, $config, $c) = @_; $config->{user_model} = $config->{user_class} unless defined $config->{user_model}; my $self = { resultset => $c->model($config->{'user_model'}), config => $config, _roles => undef, _user => undef }; bless $self, $class; Catalyst::Exception->throw( "\$c->model('${ \$self->config->{user_model} }') did not return a resultset." . " Did you set user_model correctly?" ) unless $self->{resultset}; $self->config->{'id_field'} = [$self->{'resultset'}->result_source->primary_columns] unless exists $self->config->{'id_field'}; $self->config->{'id_field'} = [$self->config->{'id_field'}] unless ref $self->config->{'id_field'} eq 'ARRAY'; Catalyst::Exception->throw( "id_field set to " . join(q{,} => @{ $self->config->{'id_field'} }) . " but user table has no column by that name!" ) unless all { $self->{'resultset'}->result_source->has_column($_) } @{ $self->config->{'id_field'} }; ## 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. $self->config->{lazyload} = 0; # if (!$self->config->{lazyload}) { # return $self->load_user($authinfo, $c); # } 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 { my ($self, $authinfo, $c) = @_; my $dbix_class_config = 0; if (exists($authinfo->{'dbix_class'})) { $authinfo = $authinfo->{'dbix_class'}; $dbix_class_config = 1; } ## User can provide an arrayref containing the arguments to search on the user class. ## or even provide a prepared resultset, allowing maximum flexibility for user retreival. ## these options are only available when using the dbix_class authinfo hash. if ($dbix_class_config && exists($authinfo->{'resultset'})) { $self->_user($authinfo->{'resultset'}->first); } elsif ($dbix_class_config && exists($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'}}; 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}; } } if (keys %{$searchargs}) { $self->_user($self->resultset->search($searchargs)->first); } else { Catalyst::Exception->throw( "Failed to load user data. You passed [" . join(',', keys %{$authinfo}) . "]" . " to authenticate() but your user source (" . $self->config->{'user_model'} . ")" . " only has these columns: [" . join( ",", $self->resultset->result_source->columns ) . "]" . " Check your authenticate() call." ); } } if ($self->get_object) { return $self; } else { return undef; } } sub supported_features { my $self = shift; return { session => 1, roles => 1, }; } sub roles { my ( $self ) = shift; ## this used to load @wantedroles - but that doesn't seem to be used by the roles plugin, so I dropped it. ## shortcut if we have already retrieved them if (ref $self->_roles eq 'ARRAY') { return(@{$self->_roles}); } my @roles = (); if (exists($self->config->{'role_column'})) { my $role_data = $self->get($self->config->{'role_column'}); if ($role_data) { @roles = split /[\s,\|]+/, $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 = map { $_->get_column($self->config->{role_field}) } $self->_user->$relation->search(undef, { columns => [ $self->config->{role_field} ] })->all; $self->_roles(\@roles); } else { Catalyst::Exception->throw("role table does not have a column called " . $self->config->{'role_field'}); } } else { Catalyst::Exception->throw("user->roles accessed, but no role configuration found"); } return @{$self->_roles}; } sub for_session { my $self = shift; #return $self->get($self->config->{'id_field'}); #my $frozenuser = $self->_user->result_source->schema->freeze( $self->_user ); #return $frozenuser; my %userdata = $self->_user->get_columns(); return \%userdata; } sub from_session { my ($self, $frozenuser, $c) = @_; #my $obj = $self->resultset->result_source->schema->thaw( $frozenuser ); #$self->_user($obj); #if (!exists($self->config->{'use_userdata_from_session'}) || $self->config->{'use_userdata_from_session'} == 0) { # $self->_user->discard_changes(); # } # # return $self; # ## if use_userdata_from_session is defined in the config, we fill in the user data from the session. if (exists($self->config->{'use_userdata_from_session'}) && $self->config->{'use_userdata_from_session'} != 0) { my $obj = $self->resultset->new_result({ %$frozenuser }); $obj->in_storage(1); $self->_user($obj); return $self; } if (ref $frozenuser eq 'HASH') { return $self->load({ map { ($_ => $frozenuser->{$_}) } @{ $self->config->{id_field} } }); } return $self->load( { $self->config->{'id_field'} => $frozenuser }, $c); } sub get { my ($self, $field) = @_; if (my $code = $self->_user->can($field)) { return $self->_user->$code; } elsif (my $accessor = try { $self->_user->result_source->column_info($field)->{accessor} }) { return $self->_user->$accessor; } else { # XXX this should probably throw return undef; } } sub get_object { my ($self, $force) = @_; if ($force) { $self->_user->discard_changes; } return $self->_user; } sub obj { my ($self, $force) = @_; return $self->get_object($force); } sub auto_create { my $self = shift; $self->_user( $self->resultset->auto_create( @_ ) ); return $self; } sub auto_update { my $self = shift; $self->_user->auto_update( @_ ); } sub AUTOLOAD { my $self = shift; (my $method) = (our $AUTOLOAD =~ /([^:]+)$/); return if $method eq "DESTROY"; if (my $code = $self->_user->can($method)) { return $self->_user->$code(@_); } elsif (my $accessor = try { $self->_user->result_source->column_info($method)->{accessor} }) { return $self->_user->$accessor(@_); } else { # XXX this should also throw return undef; } } __PACKAGE__->meta->make_immutable(inline_constructor => 0); 1; __END__ =head1 NAME Catalyst::Authentication::Store::DBIx::Class::User - The backing user class for the Catalyst::Authentication::Store::DBIx::Class storage module. =head1 VERSION This documentation refers to version 0.1201. =head1 SYNOPSIS Internal - not used directly, please see L for details on how to use this module. If you need more information than is present there, read the source. =head1 DESCRIPTION The Catalyst::Authentication::Store::DBIx::Class::User class implements user storage connected to an underlying DBIx::Class schema object. =head1 SUBROUTINES / METHODS =head2 new Constructor. =head2 load ( $authinfo, $c ) Retrieves a user from storage using the information provided in $authinfo. =head2 supported_features Indicates the features supported by this class. These are currently Roles and Session. =head2 roles Returns an array of roles associated with this user, if roles are configured for this user class. =head2 for_session Returns a serialized user for storage in the session. =head2 from_session Revives a serialized user from storage in the session. =head2 get ( $fieldname ) Returns the value of $fieldname for the user in question. Roughly translates to a call to the DBIx::Class::Row's get_column( $fieldname ) routine. =head2 get_object Retrieves the DBIx::Class object that corresponds to this user =head2 obj (method) Synonym for get_object =head2 auto_create This is called when the auto_create_user option is turned on in Catalyst::Plugin::Authentication and a user matching the authinfo provided is not found. By default, this will call the C method of the resultset associated with this object. It is up to you to implement that method. =head2 auto_update This is called when the auto_update_user option is turned on in Catalyst::Plugin::Authentication. Note that by default the DBIx::Class store uses every field in the authinfo hash to match the user. This means any information you provide with the intent to update must be ignored during the user search process. Otherwise the information will most likely cause the user record to not be found. To ignore fields in the search process, you have to add the fields you wish to update to the 'ignore_fields_in_find' authinfo element. Alternately, you can use one of the advanced row retrieval methods (searchargs or resultset). By default, auto_update will call the C method of the DBIx::Class::Row object associated with the user. It is up to you to implement that method (probably in your schema file) =head1 BUGS AND LIMITATIONS None known currently, please email the author if you find any. =head1 AUTHOR Jason Kuri (jayk@cpan.org) =head1 LICENSE Copyright (c) 2007 the aforementioned authors. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Authentication-Store-DBIx-Class-0.1201/lib/Catalyst/Authentication/Store/DBIx/Class.pm0000644000175000017500000004365011404277437032372 0ustar rkitoverrkitoverpackage Catalyst::Authentication::Store::DBIx::Class; use strict; use warnings; use base qw/Class::Accessor::Fast/; our $VERSION= "0.1201"; BEGIN { __PACKAGE__->mk_accessors(qw/config/); } sub new { my ( $class, $config, $app ) = @_; ## figure out if we are overriding the default store user class $config->{'store_user_class'} = (exists($config->{'store_user_class'})) ? $config->{'store_user_class'} : "Catalyst::Authentication::Store::DBIx::Class::User"; ## make sure the store class is loaded. Catalyst::Utils::ensure_class_loaded( $config->{'store_user_class'} ); ## fields can be specified to be ignored during user location. This allows ## the store to ignore certain fields in the authinfo hash. $config->{'ignore_fields_in_find'} ||= [ ]; my $self = { config => $config }; bless $self, $class; } ## --jk note to self: ## let's use DBIC's get_columns method to return a hash and save / restore that ## from the session. Then we can respond to get() calls, etc. in most cases without ## resorting to a DB call. If user_object is called, THEN we can hit the DB and ## return a real object. sub from_session { my ( $self, $c, $frozenuser ) = @_; # return $frozenuser if ref $frozenuser; my $user = $self->config->{'store_user_class'}->new($self->{'config'}, $c); return $user->from_session($frozenuser, $c); } sub for_session { my ($self, $c, $user) = @_; return $user->for_session($c); } sub find_user { my ( $self, $authinfo, $c ) = @_; my $user = $self->config->{'store_user_class'}->new($self->{'config'}, $c); return $user->load($authinfo, $c); } sub user_supports { my $self = shift; # this can work as a class method on the user class $self->config->{'store_user_class'}->supports( @_ ); } sub auto_create_user { my( $self, $authinfo, $c ) = @_; my $res = $self->config->{'store_user_class'}->new($self->{'config'}, $c); return $res->auto_create( $authinfo, $c ); } sub auto_update_user { my( $self, $authinfo, $c, $res ) = @_; $res->auto_update( $authinfo, $c ); return $res; } __PACKAGE__; __END__ =head1 NAME Catalyst::Authentication::Store::DBIx::Class - A storage class for Catalyst Authentication using DBIx::Class =head1 VERSION This documentation refers to version 0.1201. =head1 SYNOPSIS use Catalyst qw/ Authentication Authorization::Roles/; __PACKAGE__->config->{authentication} = { default_realm => 'members', realms => { members => { credential => { class => 'Password', password_field => 'password', password_type => 'clear' }, store => { class => 'DBIx::Class', user_model => 'MyApp::User', role_relation => 'roles', role_field => 'rolename', } } } }; # Log a user in: sub login : Global { my ( $self, $c ) = @_; $c->authenticate({ screen_name => $c->req->params->username, password => $c->req->params->password, status => [ 'registered', 'loggedin', 'active'] })) } # verify a role if ( $c->check_user_roles( 'editor' ) ) { # do editor stuff } =head1 DESCRIPTION The Catalyst::Authentication::Store::DBIx::Class class provides access to authentication information stored in a database via DBIx::Class. =head1 CONFIGURATION The DBIx::Class authentication store is activated by setting the store config's B element to DBIx::Class as shown above. See the L documentation for more details on configuring the store. You can also use L for a simplified setup. The DBIx::Class storage module has several configuration options __PACKAGE__->config->{authentication} = { default_realm => 'members', realms => { members => { credential => { # ... }, store => { class => 'DBIx::Class', user_model => 'MyApp::User', role_relation => 'roles', role_field => 'rolename', ignore_fields_in_find => [ 'remote_name' ], use_userdata_from_session => 1, } } } }; =over 4 =item class Class is part of the core Catalyst::Plugin::Authentication module; it contains the class name of the store to be used. =item user_model Contains the model name (as passed to $c->model()) of the DBIx::Class schema to use as the source for user information. This config item is B. (Note that this option used to be called C<< user_class >>. C<< user_class >> is still functional, but should be used only for compatibility with previous configs. The setting called C<< user_class >> on other authentication stores is present, but named C<< store_user_class >> in this store) =item role_column If your role information is stored in the same table as the rest of your user information, this item tells the module which field contains your role information. The DBIx::Class authentication store expects the data in this field to be a series of role names separated by some combination of spaces, commas, or pipe characters. =item role_relation If your role information is stored in a separate table, this is the name of the relation that will lead to the roles the user is in. If this is specified, then a role_field is also required. Also when using this method it is expected that your role table will return one row for each role the user is in. =item role_field This is the name of the field in the role table that contains the string identifying the role. =item ignore_fields_in_find This item is an array containing fields that may be passed to the $c->authenticate() routine (and therefore find_user in the storage class), but which should be ignored when creating the DBIx::Class search to retrieve a user. This makes it possible to avoid problems when a credential requires an authinfo element whose name overlaps with a column name in your users table. If this doesn't make sense to you, you probably don't need it. =item use_userdata_from_session Under normal circumstances, on each request the user's data is re-retrieved from the database using the primary key for the user table. When this flag is set in the configuration, it causes the DBIx::Class store to avoid this database hit on session restore. Instead, the user object's column data is retrieved from the session and used as-is. B: Since the user object's column data is only stored in the session during the initial authentication of the user, turning this on can potentially lead to a situation where the data in $c->user is different from what is stored the database. You can force a reload of the data from the database at any time by calling $c->user->get_object(1); Note that this will update $c->user for the remainder of this request. It will NOT update the session. If you need to update the session you should call $c->update_user_in_session() as well. =item store_user_class This allows you to override the authentication user class that the DBIx::Class store module uses to perform its work. Most of the work done in this module is actually done by the user class, L, so overriding this doesn't make much sense unless you are using your own class to extend the functionality of the existing class. Chances are you do not want to set this. =item id_field In most cases, this config variable does not need to be set, as Catalyst::Authentication::Store::DBIx::Class will determine the primary key of the user table on its own. If you need to override the default, or your user table has multiple primary keys, then id_field should contain the column name that should be used to restore the user. A given value in this column should correspond to a single user in the database. Note that this is used B when restoring a user from the session and has no bearing whatsoever in the initial authentication process. Note also that if use_userdata_from_session is enabled, this config parameter is not used at all. =back =head1 USAGE The L storage module is not called directly from application code. You interface with it through the $c->authenticate() call. There are three methods you can use to retrieve information from the DBIx::Class storage module. They are Simple retrieval, and the advanced retrieval methods Searchargs and Resultset. =head2 Simple Retrieval The first, and most common, method is simple retrieval. As its name implies simple retrieval allows you to simply to provide the column => value pairs that should be used to locate the user in question. An example of this usage is below: if ($c->authenticate({ screen_name => $c->req->params->{'username'}, password => $c->req->params->{'password'}, status => [ 'registered', 'active', 'loggedin'] })) { # ... authenticated user code here } The above example would attempt to retrieve a user whose username column (here, screen_name) matched the username provided, and whose status column matched one of the values provided. These name => value pairs are used more or less directly in the DBIx::Class search() routine, so in most cases, you can use DBIx::Class syntax to retrieve the user according to whatever rules you have. NOTE: Because the password in most cases is encrypted - it is not used directly but its encryption and comparison with the value provided is usually handled by the Password Credential. Part of the Password Credential's behavior is to remove the password argument from the authinfo that is passed to the storage module. See L. One thing you need to know about this retrieval method is that the name portion of the pair is checked against the user class's column list. Pairs are only used if a matching column is found. Other pairs will be ignored. This means that you can only provide simple name-value pairs, and that some more advanced DBIx::Class constructs, such as '-or', '-and', etc. are in most cases not possible using this method. For queries that require this level of functionality, see the 'searchargs' method below. =head2 Advanced Retrieval The Searchargs and Resultset retrieval methods are used when more advanced features of the underlying L schema are required. These methods provide a direct interface with the DBIx::Class schema and therefore require a better understanding of the DBIx::Class module. =head3 The dbix_class key Since the format of these arguments are often complex, they are not keys in the base authinfo hash. Instead, both of these arguments are placed within a hash attached to the store-specific 'dbix_class' key in the base $authinfo hash. When the DBIx::Class authentication store sees the 'dbix_class' key in the passed authinfo hash, all the other information in the authinfo hash is ignored and only the values within the 'dbix_class' hash are used as though they were passed directly within the authinfo hash. In other words, if 'dbix_class' is present, it replaces the authinfo hash for processing purposes. The 'dbix_class' hash can be used to directly pass arguments to the DBIx::Class authentication store. Reasons to do this are to avoid credential modification of the authinfo hash, or to avoid overlap between credential and store key names. It's a good idea to avoid using it in this way unless you are sure you have an overlap/modification issue. However, the two advanced retrieval methods, B and B, require its use, as they are only processed as part of the 'dbix_class' hash. =over 4 =item Searchargs The B method of retrieval allows you to specify an arrayref containing the two arguments to the search() method from L. If provided, all other args are ignored, and the search args provided are used directly to locate the user. An example will probably make more sense: if ($c->authenticate( { password => $password, 'dbix_class' => { searchargs => [ { -or => [ username => $username, email => $email, clientid => $clientid ] }, { prefetch => qw/ preferences / } ] } } ) ) { # do successful authentication actions here. } The above would allow authentication based on any of the three items - username, email, or clientid - and would prefetch the data related to that user from the preferences table. The searchargs array is passed directly to the search() method associated with the user_model. =item Resultset The B method of retrieval allows you to directly specify a resultset to be used for user retrieval. This allows you to create a resultset within your login action and use it for retrieving the user. A simple example: my $rs = $c->model('MyApp::User')->search({ email => $c->request->params->{'email'} }); ... # further $rs adjustments if ($c->authenticate({ password => $password, 'dbix_class' => { resultset => $rs } })) { # do successful authentication actions here. } Be aware that the resultset method will not verify that you are passing a resultset that is attached to the same user_model as specified in the config. NOTE: All of these methods of user retrieval, including the resultset method, consider the first row returned to be the matching user. In most cases there will be only one matching row, but it is easy to produce multiple rows, especially when using the advanced retrieval methods. Remember, what you get when you use this module is what you would get when calling search(...)->first; NOTE ALSO: The user info used to save the user to the session and to retrieve it is the same regardless of what method of retrieval was used. In short, the value in the id field (see 'id_field' config item) is used to retrieve the user from the database upon restoring from the session. When the DBIx::Class storage module does this, it does so by doing a simple search using the id field. In other words, it will not use the same arguments you used to request the user initially. This is especially important to those using the advanced methods of user retrieval. If you need more complicated logic when reviving the user from the session, you will most likely want to subclass the L class and provide your own for_session and from_session routines. =back =head1 METHODS There are no publicly exported routines in the DBIx::Class authentication store (or indeed in most authentication stores). However, below is a description of the routines required by L for all authentication stores. Please see the documentation for L for more information. =head2 new ( $config, $app ) Constructs a new store object. =head2 find_user ( $authinfo, $c ) Finds a user using the information provided in the $authinfo hashref and returns the user, or undef on failure. This is usually called from the Credential. This translates directly to a call to L's load() method. =head2 for_session ( $c, $user ) Prepares a user to be stored in the session. Currently returns the value of the user's id field (as indicated by the 'id_field' config element) =head2 from_session ( $c, $frozenuser) Revives a user from the session based on the info provided in $frozenuser. Currently treats $frozenuser as an id and retrieves a user with a matching id. =head2 user_supports Provides information about what the user object supports. =head2 auto_update_user( $authinfo, $c, $res ) This method is called if the realm's auto_update_user setting is true. It will delegate to the user object's C method. =head2 auto_create_user( $authinfo, $c ) This method is called if the realm's auto_create_user setting is true. It will delegate to the user class's (resultset) C method. =head1 NOTES As of the current release, session storage consists of simply storing the user's id in the session, and then using that same id to re-retrieve the user's information from the database upon restoration from the session. More dynamic storage of user information in the session is intended for a future release. =head1 BUGS AND LIMITATIONS None known currently; please email the author if you find any. =head1 SEE ALSO L, L, and L =head1 AUTHOR Jason Kuri (jayk@cpan.org) =head1 LICENSE Copyright (c) 2007 the aforementioned authors. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Authentication-Store-DBIx-Class-0.1201/Changes0000644000175000017500000000425111404277630023054 0ustar rkitoverrkitoverRevision history for Catalyst-Plugin-Authentication-Store-DBIx-Class 0.1201 2010-06-11 Support columns with accessors that aren't the column name. 0.1200 2010-04-10 Release 0.1100 as a stable version without further modifications. 0.1100 2010-03-29 - development release Support compound primary keys for looking up users. 0.1083 2010-03-03 Tweaking exception message to better explain what people did wrong when they pass bad columns to authenticate. 0.1082 2008-10-27 Documentation tweak to clarify user_class, store_user_class etc. 0.108 2008-09-25 Adding SimpleDB realm to simplify basic auth configuration Changing user_class to user_model, per req. by mst to avoid confusing newbies. 0.107 2008-09-29 Fix the typo in exception during authenticate Doc fixes and clarifications Added missing dependency on Catalyst::Model::DBIC::Schema to Makefile.PL 0.105 2008-03-19 Throw an exception if no fields are provided during authenticate - better than retrieving a random user. - still possible to do an empty search by using searchargs 0.104 2008-02-15 Added ability to avoid DB hits when restoring from session 0.103 2008-02-07 Added missing DBIx::Class dependancy in Makefile.PL so that the damn test bots stop emailing me. 0.102 2008-01-23 Catalyst::Authentication::Store::DBIx::Class::User - Explicitly call auto_create() against resultset() - Explicitly call auto_update() against _user() - Document the above 0.101 2007-12-02 Implemented basic auto_update_user and auto_create_user support 0.10 2007-07-07 3pm CST Proper handling of missing id_field config (load from primary_key) Throw exception if id_field specified does not exist Full test suite added. (based loosely on old DBIC store) 0.03 XXX Switch to Module::Install 0.02 2006-12-16 2pm CST Rewritten to use proper accessors and clean up to match updated C::P::Authentication class naming 0.01 2006-11-10 First version, worked internally, completely undocumented Catalyst-Authentication-Store-DBIx-Class-0.1201/Makefile.PL0000644000175000017500000000342711404277555023545 0ustar rkitoverrkitoveruse inc::Module::Install 0.91; if( -e 'MANIFEST.SKIP' ) { system( 'pod2text lib/Catalyst/Authentication/Store/DBIx/Class.pm > README' ); } realclean_files 'README'; ## I'd love to use can_use - but I can't seem to test for success. :-/ eval { require Catalyst::Plugin::Authentication::Store::DBIx::Class or die 'footy'; }; if (!$@) { #} can_use("Catalyst::Plugin::Authentication::Store::DBIx::Class") ) { print STDERR < '5.8', 'Catalyst::Plugin::Authentication' => '0.10008', 'Catalyst::Model::DBIC::Schema' => '0.18', 'DBIx::Class' => '0.08', 'Moose' => 0, 'namespace::autoclean' => 0, 'List::MoreUtils' => 0, 'Try::Tiny' => 0, ); test_requires 'Test::More'; resources repository => 'http://dev.catalystframework.org/repos/Catalyst/Catalyst-Authentication-Store-DBIx-Class'; auto_install; auto_provides; WriteAll; Catalyst-Authentication-Store-DBIx-Class-0.1201/MANIFEST0000644000175000017500000000173311404300031022672 0ustar rkitoverrkitover.gitignore Changes inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Catalyst/Authentication/Realm/SimpleDB.pm lib/Catalyst/Authentication/Store/DBIx/Class.pm lib/Catalyst/Authentication/Store/DBIx/Class/User.pm Makefile.PL MANIFEST This list of files META.yml README t/00-load.t t/01-pod.t t/02-pod-coverage.t t/03-authtest.t t/04-authsessions.t t/05-auth-roles-relationship.t t/06-auth-roles-column.t t/07-authsessions-cached.t t/08-simpledb-auth-roles-relationship.t t/09-simpledb-auth-roles-column.t t/lib/SetupDB.pm t/lib/TestApp.pm t/lib/TestApp/Controller/Root.pm t/lib/TestApp/Model/TestApp.pm t/lib/TestApp/Schema.pm t/lib/TestApp/Schema/Role.pm t/lib/TestApp/Schema/User.pm t/lib/TestApp/Schema/UserRole.pm