CatalystX-SimpleLogin-0.20/ 0000755 0001750 0001750 00000000000 13120307403 015716 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/Changes 0000644 0001750 0001750 00000010177 13120307334 017222 0 ustar ahartmai ahartmai 0.20 Wed, 14 June 2017 21:30:00 +0200
* Fix spelling error (RT#116452, thanks Nick Morrott)
* Don't use Moose::Autobox (fixes RT#113157)
0.19 Mon, 22 February 2016 18:16:00 +0100
* Remove test dependency on Session::Store::File
* Fix "remember" checkbox (Yaroslav Polyakov)
* Made remember me behaviour extensible and configurable.
* Rotate session id after login/logout
* Catch exceptions thrown by the authenticate method
0.18 Sat, 21 July 2012 14:39:00 +0100
* Stop depending on the now unused Catalyst::Controller::ActionRole
RT#78500
0.17 Sun, 15 July 2012 18:23:00 +0100
* Better fix for Catalyst versions >= 5.90013 RT#78340, one module
and some documentation was missed.
0.16 Fri, 13 July 2012 15:41:00 +0100
* Ensure that temp directories created in tests get removed.
* Fix for Catalyst versions >= 5.90013 RT#78340
0.15 Tue, 6 Sept 2011 09:59:00 +0100
* Various documentation fixes and improvements
* Add tab index to forms
* Fix login redirect to just use the URI, rather than trying to compose
an action, as in some cases we may not have an action.
(E.g. when you have a sub default : Private { action)
0.14 Tue, 12 Oct 2010 17:54:00 +0100
* Large improvements in the documentation to pass all POD coverage tests
and document examples well thanks to Shlomi Fish.
0.13 Thu, 07 Oct 2010 09:35:00 +0100
* Fix the docs to make it clearer how to remove traits and use your own
login form.
0.12
* Fix test failures with various DBIC versions by relying on the DBIC
dependency magic (RT#58307).
0.11
* Add a chunk of documentation (Drew Taylour)
0.10 Wed, 02 Jul 2010 17:03:41 +0000
* Add a clear_session_on_logout config setting which will blow away the
contents of the session on logout.
0.09 Sat, 20 Feb 2010 18:05:05 +0000
* Add actions for people using Chained controllers to chain off.
/login/required and /login/not_required
* Point new users to the manual at the top of the POD so they know it's there.
* Add SQL::Translator as a test dependency.
0.08 Wed, 27 Jan 2010 22:02:11 +0000
* Fix Login controller so that it works with the RequiresLogin action
role without the WithRedirect trait composed.
* Added redirect_after_login_uri configuration key to Controller::Login which
can be used to set the path to redirect the user after login (if the
WithRedirect trait is not used)
* Added redirect_after_logout_uri configuration key to Controller::Login which
can be used to set the path to redirect the user after logout.
* Fix manual typo (Curtis 'Ovid' Poe)
0.07 Sun, 13 Dec 2009 20:00:23 +0000
* Fix so that you can pass parameters to the login form from config to change
the keys used in the $c->authenticate call, so that you can use an arbitrary
DBIC schema result class.
* Add tests with a DBIC using app.
* Significant refactoring in the test suite to reduce code and template duplication
between the test applications.
0.06 Fri, 11 Dec 2009 00:01:23 +0000
* Fix Catalyst::ActionRole::NeedsLogin to correctly detach from
action chains + tests.
* Add an experimental controller for OpenID support.
0.05 Wed, 09 Dec 2009 22:50:23 +0000
* WARNING: BREAKING CHANGE - The WithRedirect and RenderAsTTTemplate
traits are now composed as default to reduce the amount of config
needed in the tutorial, and as these are mostly what people want.
If you don't want these traits, then you'll have to remove them with
config.
* Various documentation cleanups.
* Remove dependency on Test::MockModule
* Make OpenID support optional so that people don't get stuck installing
Crypt::DH without the support modules which stop it taking forever.
0.04 Sun, 06 Dec 2009 13:25:23 +0000
* Fix too low a dependency on HTML::Formhandler
* Clean up a couple of things in the controller code to use $self
rather than $c->controller('Login').
0.03 Sat, 14 Nov 2009 16:28:23 +0000
* Fix dependency on Authentication::Credential::OpenID
* Doc fixes
0.02 Sat, 07 Nov 2009 21:20:00 +0000
* Much more documentation
* Traits are automatically merged
* Added OpenID support
0.01 Wed, 30 Sep 2009 02:17:00 +0200
* Initial release.
CatalystX-SimpleLogin-0.20/t/ 0000755 0001750 0001750 00000000000 13120307403 016161 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/ 0000755 0001750 0001750 00000000000 13120307403 016727 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppClearSession/ 0000755 0001750 0001750 00000000000 13120307403 022622 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppClearSession/Controller/ 0000755 0001750 0001750 00000000000 13120307403 024745 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppClearSession/Controller/Root.pm 0000644 0001750 0001750 00000001560 12651666547 026261 0 ustar ahartmai ahartmai
package TestAppClearSession::Controller::Root;
use Moose;
use namespace::autoclean;
BEGIN { extends 'TestAppBase::Controller::Root' }
after index => sub {
my ($self, $c) = @_;
$c->res->body("BLARRRMOO");
};
sub setsess :Local
{
my ($self, $ctx) = @_;
$ctx->session->{session_var1_set} = 'someval1';
$ctx->res->body('Set the session');
}
sub needsloginsetsess :Local :Does('NeedsLogin')
{
my ($self, $ctx) = @_;
$ctx->session->{session_var2_set} = 'someval2';
$ctx->res->body('Logged in and set the session');
}
sub viewsess :Local
{
my ($self, $ctx) = @_;
my $session_string = '';
foreach ( keys %{ $ctx->session } )
{
next if $_ =~ /^\_\_/;
$session_string .= $_ . '=' . $ctx->session->{$_} . ';'
}
$ctx->res->body('In the session:' . $session_string . ':');
}
__PACKAGE__->meta->make_immutable;
CatalystX-SimpleLogin-0.20/t/lib/TestAppClearSession/root/ 0000755 0001750 0001750 00000000000 13120307403 023605 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppClearSession/root/login/ 0000755 0001750 0001750 00000000000 13120307403 024715 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppClearSession/root/login/login.tt 0000644 0001750 0001750 00000000030 12651666547 026420 0 ustar ahartmai ahartmai [% render_login_form %]
CatalystX-SimpleLogin-0.20/t/lib/script/ 0000755 0001750 0001750 00000000000 13120307403 020233 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/script/testapp_server.pl 0000644 0001750 0001750 00000000310 12651666547 023661 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use FindBin qw/$Bin/;
use lib "$Bin/../../../lib", "$Bin/../";
use TestAppBase::Script::Server;
TestAppBase::Script::Server->new_with_options->run;
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppRedirect/ 0000755 0001750 0001750 00000000000 13120307403 021771 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppRedirect/Controller/ 0000755 0001750 0001750 00000000000 13120307403 024114 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppRedirect/Controller/Root.pm 0000644 0001750 0001750 00000002564 12651666547 025435 0 ustar ahartmai ahartmai package TestAppRedirect::Controller::Root;
use Moose;
use namespace::autoclean;
BEGIN { extends 'TestAppBase::Controller::Root' }
after index => sub {
my ($self, $c) = @_;
$c->res->body("MOO");
};
sub _needslogin {
my ($self, $ctx) = @_;
$ctx->res->body('NeedsLogin works!');
$ctx->res->header('X-Action-Run'
=> ($ctx->res->header('X-Action-Run')||'')
. $ctx->action
);
}
sub needslogin :Local :Does('NeedsLogin') {shift->_needslogin(shift)}
sub base : Chained('/') PathPart('') CaptureArgs(0) :Does('NeedsLogin') {shift->_needslogin(shift)}
sub needslogin_chained : Chained('base') Args(0) {shift->_needslogin(shift)}
sub base2 : Chained('/') PathPart('') CaptureArgs(0) { $_[1]->res->header('X-Start-Chain-Run', 1) }
sub needslogin_chained_subpart : Chained('base2') Args(0) :Does('NeedsLogin') {shift->_needslogin(shift)}
sub needslogincustommsg :Local :Does('NeedsLogin') :LoginRedirectMessage('Please Login to view this Test Action') {
my ($self, $c) = @_;
$c->res->body('NeedsLogin works!');
}
sub needsloginandhasacl :Local :Does('NeedsLogin') :Does('ACL') :RequiresRole('abc') :ACLDetachTo('denied') {
my ($self, $c) = @_;
$c->res->body('NeedsLogin with ACL works!');
}
sub denied :Private {
my ($self, $c) = @_;
$c->res->status('403');
$c->res->body('Denied!');
}
__PACKAGE__->meta->make_immutable;
CatalystX-SimpleLogin-0.20/t/lib/TestAppRedirect/root/ 0000755 0001750 0001750 00000000000 13120307403 022754 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppRedirect/root/login/ 0000755 0001750 0001750 00000000000 13120307403 024064 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppRedirect/root/login/login.tt 0000644 0001750 0001750 00000000030 12651666547 025567 0 ustar ahartmai ahartmai [% render_login_form %]
CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/ 0000755 0001750 0001750 00000000000 13120307403 021102 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/View/ 0000755 0001750 0001750 00000000000 13120307403 022014 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/View/HTML.pm 0000644 0001750 0001750 00000000277 12651666547 023155 0 ustar ahartmai ahartmai package TestAppBase::View::HTML;
use Moose;
use namespace::autoclean;
extends 'Catalyst::View::TT';
__PACKAGE__->config(
WRAPPER => 'wrapper.tt',
TEMPLATE_EXTENSION => '.tt',
);
1; CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/root/ 0000755 0001750 0001750 00000000000 13120307403 022065 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/root/wrapper.tt 0000644 0001750 0001750 00000000122 12651666547 024142 0 ustar ahartmai ahartmai
[% error_msg || c.flash.error_msg %]
[% content %]
CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/root/index.tt 0000644 0001750 0001750 00000000054 12651666547 023575 0 ustar ahartmai ahartmai It works. [% IF c.user %]Logged in[% END %]
CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/Script/ 0000755 0001750 0001750 00000000000 13120307403 022346 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/Script/Server.pm 0000644 0001750 0001750 00000001435 12651666547 024206 0 ustar ahartmai ahartmai package TestAppBase::Script::Server;
use Moose;
use MooseX::Types::Moose qw/Str/;
use Moose::Util::TypeConstraints;
use namespace::autoclean;
extends 'Catalyst::Script::Server';
my $appname = do {
my $re = q{^TestApp(|DBIC|OpenID|Redirect|RenderTT)$};
subtype Str,
where { /$re/ },
message { "Application name must match /$re/" };
};
# FIXME
# Gross, but overriding NoGetopt with Getopt doesn't work
# right, and nor does +application_name with cmd_aliases
# (as Moose uses a white list of options you can change
# with has +).
__PACKAGE__->meta->remove_attribute('application_name');
has application_name => (
isa => $appname,
traits => [qw/Getopt/],
cmd_aliases => ['app', 'name'],
is => 'ro',
required => 1,
);
__PACKAGE__->meta->make_immutable;
CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/Controller/ 0000755 0001750 0001750 00000000000 13120307403 023225 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppBase/Controller/Root.pm 0000644 0001750 0001750 00000000643 12651666547 024542 0 ustar ahartmai ahartmai package TestAppBase::Controller::Root;
use Moose;
use namespace::autoclean;
BEGIN { extends 'Catalyst::Controller' }
__PACKAGE__->config(
namespace => '',
);
sub auto : Action {
my ($self, $c) = @_;
$c->stash->{additional_template_paths} =
[$c->config->{home} . '/../TestAppBase/root'];
1;
}
sub index : Path { }
sub end : ActionClass('RenderView') {}
__PACKAGE__->meta->make_immutable;
CatalystX-SimpleLogin-0.20/t/lib/TestAppFormArgs.pm 0000644 0001750 0001750 00000000776 12651666547 022351 0 ustar ahartmai ahartmai package TestAppFormArgs;
use Moose;
use namespace::autoclean;
extends 'TestAppBase';
__PACKAGE__->config(
'Controller::Login' => {
# Doing our own templates, without the redirect stuff.
traits => ['-WithRedirect', '-RenderAsTTTemplate'],
login_form_args => {
field_list => [
extra_field => { type => 'Text', label => 'Testing Form Args' },
'+submit' => { value => 'Login' },
],
},
},
);
__PACKAGE__->setup;
1;
CatalystX-SimpleLogin-0.20/t/lib/TestApp/ 0000755 0001750 0001750 00000000000 13120307403 020307 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestApp/root/ 0000755 0001750 0001750 00000000000 13120307403 021272 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestApp/root/chainedexample/ 0000755 0001750 0001750 00000000000 13120307403 024241 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestApp/root/chainedexample/item.tt 0000644 0001750 0001750 00000000433 12651666547 025601 0 ustar ahartmai ahartmai [% c.user.id %] you inputted [% arg1 | html %].
[%# N.B. Trusting your safety to XSS attacks from arbitrary
user input to a lone | html in TT is probably
a stupendously bad idea. I'd recommend being
significantly more paranoid if doing anything 'real' -%]
CatalystX-SimpleLogin-0.20/t/lib/TestApp/root/chainedexample/public.tt 0000644 0001750 0001750 00000000024 12651666547 026115 0 ustar ahartmai ahartmai This page is public. CatalystX-SimpleLogin-0.20/t/lib/TestApp/root/chainedexample/index.tt 0000644 0001750 0001750 00000000031 12651666547 025744 0 ustar ahartmai ahartmai Welcome [% c.user.id %].
CatalystX-SimpleLogin-0.20/t/lib/TestApp/root/login/ 0000755 0001750 0001750 00000000000 13120307403 022402 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestApp/root/login/login.tt 0000644 0001750 0001750 00000000030 12651666547 024105 0 ustar ahartmai ahartmai [% render_login_form %]
CatalystX-SimpleLogin-0.20/t/lib/TestApp/Controller/ 0000755 0001750 0001750 00000000000 13120307403 022432 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestApp/Controller/NeedsAuth.pm 0000644 0001750 0001750 00000000437 12651666547 024705 0 ustar ahartmai ahartmai package TestApp::Controller::NeedsAuth;
use Moose;
use namespace::autoclean;
BEGIN { extends 'Catalyst::Controller' }
sub foo : Chained('/') PathPart('needsauth') Args(0) Does('NeedsLogin') {
my ($self, $c) = @_;
$c->res->body("SEKRIT");
}
__PACKAGE__->meta->make_immutable;
CatalystX-SimpleLogin-0.20/t/lib/TestApp/Controller/ChainedExample.pm 0000644 0001750 0001750 00000001244 12651666547 025671 0 ustar ahartmai ahartmai package TestApp::Controller::ChainedExample;
use Moose;
use namespace::autoclean;
BEGIN { extends 'Catalyst::Controller' }
sub base : Chained('/login/required') PathPart('chainedexample') CaptureArgs(0) {} # Chain everything in the controller off of here.
sub index : Chained('base') PathPart('') Args(0) { # /chainedexample
}
sub item : Chained('base') PathPart('') Args(1) { #/chainedexample/$arg1
my ($self, $c, $arg1) = @_;
$c->stash->{arg1} = $arg1;
}
sub no_auth_base : Chained('/login/not_required') PathPart('chainedexample') CaptureArgs(0) {}
sub public : Chained('no_auth_base') Args(0) {} # /chainedexample/public
__PACKAGE__->meta->make_immutable;
CatalystX-SimpleLogin-0.20/t/lib/TestApp.pm 0000644 0001750 0001750 00000000440 12651666547 020674 0 ustar ahartmai ahartmai package TestApp;
use Moose;
use namespace::autoclean;
extends 'TestAppBase';
__PACKAGE__->config(
'Controller::Login' => {
# Doing our own templates, without the redirect stuff.
traits => ['-WithRedirect', '-RenderAsTTTemplate'],
},
);
__PACKAGE__->setup;
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/ 0000755 0001750 0001750 00000000000 13120307403 020731 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/Model/ 0000755 0001750 0001750 00000000000 13120307403 021771 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/Model/DB.pm 0000644 0001750 0001750 00000000254 12651666547 022646 0 ustar ahartmai ahartmai package TestAppDBIC::Model::DB;
use strict;
use warnings;
use base 'Catalyst::Model::DBIC::Schema';
__PACKAGE__->config(
schema_class => 'TestAppDBIC::Schema',
);
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/Schema.pm 0000644 0001750 0001750 00000000174 12651666547 022522 0 ustar ahartmai ahartmai package TestAppDBIC::Schema;
use strict;
use warnings;
use base 'DBIx::Class::Schema';
__PACKAGE__->load_namespaces;
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/Schema/ 0000755 0001750 0001750 00000000000 13120307403 022131 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/Schema/Result/ 0000755 0001750 0001750 00000000000 13120307403 023407 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/Schema/Result/User.pm 0000644 0001750 0001750 00000000702 12651666547 024713 0 ustar ahartmai ahartmai package TestAppDBIC::Schema::Result::User;
use strict;
use warnings;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/ Core /);
__PACKAGE__->table ('user');
__PACKAGE__->add_columns (
id => { data_type => 'int', is_auto_increment => 1 },
user_name => { data_type => 'varchar', }, # Note this is not the standard 'username' field used by simplelogin
password => { data_type => 'varchar', },
);
__PACKAGE__->set_primary_key ('id');
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/Controller/ 0000755 0001750 0001750 00000000000 13120307403 023054 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/Controller/Root.pm 0000644 0001750 0001750 00000000243 12651666547 024365 0 ustar ahartmai ahartmai package TestAppDBIC::Controller::Root;
use Moose;
use namespace::autoclean;
BEGIN { extends 'TestAppBase::Controller::Root' }
__PACKAGE__->meta->make_immutable;
CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/View/ 0000755 0001750 0001750 00000000000 13120307403 021643 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC/View/HTML.pm 0000644 0001750 0001750 00000000156 12651666547 023000 0 ustar ahartmai ahartmai package TestAppDBIC::View::HTML;
use Moose;
use namespace::autoclean;
extends 'TestAppBase::View::HTML';
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppRenderTT.pm 0000644 0001750 0001750 00000000352 12651666547 022306 0 ustar ahartmai ahartmai package TestAppRenderTT;;
use Moose;
use namespace::autoclean;
extends 'TestAppBase';
__PACKAGE__->config(
'Controller::Login' => {
# No config needed, you get renderastt by default :)
},
);
__PACKAGE__->setup;
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppBase.pm 0000644 0001750 0001750 00000003403 12651666547 021471 0 ustar ahartmai ahartmai package TestAppBase;
use Moose;
use CatalystX::InjectComponent;
use File::Temp qw/ tempdir /;
use namespace::autoclean;
use Catalyst qw/
+CatalystX::SimpleLogin
Authentication
Session
Session::Store::Dummy
Session::State::Cookie
/;
extends 'Catalyst';
# HULK SMASH.
# Catalyst->import calls setup_home, which results in config for
# the root directory being set if not already set. Ergo we end
# up with the templates for this class, rather than the subclass,
# which is fail..
# FIXME - Do the appropriate handwave here to tell TT about the extra
# base app include path, rather than throwing the root dir
# away..
__PACKAGE__->config(home => undef, root => undef);
# Normal default config.
__PACKAGE__->config(
'Plugin::Authentication' => {
default => {
credential => {
class => 'Password',
password_field => 'password',
password_type => 'clear'
},
store => {
class => 'Minimal',
users => {
bob => {
password => "s00p3r",
},
william => {
password => "s3cr3t",
},
},
},
},
},
'Plugin::Session' => {
storage => tempdir( CLEANUP => 1 ),
},
);
after 'setup_components' => sub {
my ($app) = @_;
CatalystX::InjectComponent->inject(
into => $app,
component => 'TestAppBase::Controller::Root',
as => 'Root',
) unless $app->controller('Root');
CatalystX::InjectComponent->inject(
into => $app,
component => 'TestAppBase::View::HTML',
as => 'HTML',
) unless $app->view('HTML');
};
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppOpenID/ 0000755 0001750 0001750 00000000000 13120307403 021346 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppOpenID/.exists 0000644 0001750 0001750 00000000063 12651666547 022716 0 ustar ahartmai ahartmai # Must be here for Catalyst home detection to work
CatalystX-SimpleLogin-0.20/t/lib/TestAppDBIC.pm 0000644 0001750 0001750 00000001512 12651666547 021317 0 ustar ahartmai ahartmai package TestAppDBIC;
use Moose;
use namespace::autoclean;
extends 'TestAppBase';
__PACKAGE__->setup_home;
__PACKAGE__->config(
'Controller::Login' => {
login_form_args => {
authenticate_username_field_name => 'user_name',
},
},
'Model::DB' => {
connect_info => {
dsn => 'dbi:SQLite:' . __PACKAGE__->path_to('testdbic.db'),
user => '',
password => '',
},
},
'Plugin::Authentication' => {
default => {
credential => {
class => 'Password',
password_field => 'password',
password_type => 'clear'
},
store => {
class => 'DBIx::Class',
user_model => 'DB::User',
},
},
},
);
__PACKAGE__->setup;
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppRenderTT/ 0000755 0001750 0001750 00000000000 13120307403 021717 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppRenderTT/.exists 0000644 0001750 0001750 00000000063 12651666547 023267 0 ustar ahartmai ahartmai # Must be here for Catalyst home detection to work
CatalystX-SimpleLogin-0.20/t/lib/TestAppFormArgs/ 0000755 0001750 0001750 00000000000 13120307403 021750 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppFormArgs/root/ 0000755 0001750 0001750 00000000000 13120307403 022733 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppFormArgs/root/login/ 0000755 0001750 0001750 00000000000 13120307403 024043 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppFormArgs/root/login/login.tt 0000644 0001750 0001750 00000000030 12651666547 025546 0 ustar ahartmai ahartmai [% render_login_form %]
CatalystX-SimpleLogin-0.20/t/lib/TestAppFormArgs/Controller/ 0000755 0001750 0001750 00000000000 13120307403 024073 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/TestAppFormArgs/Controller/NeedsAuth.pm 0000644 0001750 0001750 00000000447 12651666547 026347 0 ustar ahartmai ahartmai package TestAppFormArgs::Controller::NeedsAuth;
use Moose;
use namespace::autoclean;
BEGIN { extends 'Catalyst::Controller' }
sub foo : Chained('/') PathPart('needsauth') Args(0) Does('NeedsLogin') {
my ($self, $c) = @_;
$c->res->body("SEKRIT");
}
__PACKAGE__->meta->make_immutable;
CatalystX-SimpleLogin-0.20/t/lib/TestAppClearSession.pm 0000644 0001750 0001750 00000000422 12651666547 023207 0 ustar ahartmai ahartmai package TestAppClearSession;
use Moose;
use namespace::autoclean;
extends 'TestAppBase';
__PACKAGE__->config(
'Controller::Login' => {
clear_session_on_logout => 1
},
'Plugin::Session' => {
flash_to_stash => 1
}
);
__PACKAGE__->setup;
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppRedirect.pm 0000644 0001750 0001750 00000000413 12651666547 022356 0 ustar ahartmai ahartmai package TestAppRedirect;
use Moose;
use namespace::autoclean;
extends 'TestAppBase';
__PACKAGE__->config(
'Controller::Login' => {
traits => 'WithRedirect',
},
'Plugin::Session' => {
flash_to_stash => 1
}
);
__PACKAGE__->setup;
1;
CatalystX-SimpleLogin-0.20/t/lib/TestAppOpenID.pm 0000644 0001750 0001750 00000000735 12651666547 021742 0 ustar ahartmai ahartmai package TestAppOpenID;
use Moose;
use namespace::autoclean;
extends 'TestAppBase';
__PACKAGE__->config(
'Plugin::Authentication' => {
default => {
credential => {
class => 'MockOpenID',
},
store => {
class => 'Null',
}
},
},
'Controller::Login' => {
login_form_class_roles => [ 'CatalystX::SimpleLogin::Form::LoginOpenID']
},
);
__PACKAGE__->setup;
1;
CatalystX-SimpleLogin-0.20/t/lib/Catalyst/ 0000755 0001750 0001750 00000000000 13120307403 020513 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/Catalyst/Authentication/ 0000755 0001750 0001750 00000000000 13120307403 023472 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/Catalyst/Authentication/Credential/ 0000755 0001750 0001750 00000000000 13120307403 025544 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/lib/Catalyst/Authentication/Credential/MockOpenID.pm 0000644 0001750 0001750 00000001701 12651666547 030062 0 ustar ahartmai ahartmai package Catalyst::Authentication::Credential::MockOpenID;
use strict;
use warnings;
use base qw/Catalyst::Authentication::Credential::OpenID/;
sub authenticate {
my ( $self, $c, $realm, $authinfo ) = @_;
my $claimed_uri = $authinfo->{ 'openid_identifier' };
if ( $claimed_uri ) {
if( $claimed_uri eq 'aaa' ){
return;
}
if( $claimed_uri eq 'http://mock.open.id.server' ){
$c->res->redirect( 'http://localhost/login?openid-check=1' );
$c->detach();
}
}
elsif ( $c->req->params->{'openid-check'} ){
my $user = {
url => 'http://mock.open.id.server' ,
display => 'mocked_user' ,
rss => '',
atom => '',
foaf => '',
declared_rss => '',
declared_atom => '',
declared_foaf => '',
foafmaker => '',
};
return $realm->find_user($user, $c);
}
}
1;
CatalystX-SimpleLogin-0.20/t/01-live-test.t 0000644 0001750 0001750 00000006561 12651666547 020541 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More 'no_plan';
use HTTP::Request::Common;
# setup library path
use FindBin qw($Bin);
use lib "$Bin/lib";
use Catalyst::Test 'TestApp';
my ($res, $c);
ok(request('/')->is_success, 'Get /');
ok(request('/login')->is_success, 'Get /login');
is(request('/logout')->code, 302, 'Get 302 from /logout');
is(request('/needsauth')->code, 302, 'Get 302 from /needsauth');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 'aaaa']);
is($res->code, 200, 'get errors in login form');
like($c->res->body, qr/Wrong username or password/, 'login error');
like($c->res->body, qr/submit/, 'submit button on form');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 's00p3r']);
is($res->code, 302, 'get 302 redirect');
my $cookie = $res->header('Set-Cookie');
ok($cookie, 'Have a cookie');
is($res->header('Location'), 'http://localhost/', 'Redirect to /');
ok($c->user, 'Have a user in $c');
($res, $c) = ctx_request(GET 'http://localhost/', Cookie => $cookie);
like($c->res->body, qr/Logged in/, 'Am logged in');
ok( $c->session_is_valid, 'Session is valid');
ok( ($c->session_expires && $c->session_expires-time()-7200) <= 0, 'Session length low when no "remember"');
($res, $c) = ctx_request(GET 'http://localhost/logout', Cookie => $cookie);
ok(!$c->user_exists, 'No user in $c after logout');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 's00p3r', remember => 1], Cookie => $cookie);
my ($session_id) = $cookie=~/testapp_session=(.*?);/;
$cookie = $res->header('Set-Cookie');
my ($new_session_id) = $cookie=~/testapp_session=(.*?);/;
isnt $session_id, $new_session_id, 'Session id should have changed.';
($res, $c) = ctx_request(GET 'http://localhost/', Cookie => $cookie);
ok( (($c->session_expires-time()-7200) > 0) &&
(($c->session_expires-time()-1000000000) < 0) , 'Long session set when "remember"');
$cookie = $res->header('Set-Cookie');
ok($cookie, 'Have a cookie');
ok($c->user_exists, 'have the user back after re-login with "remember"');
($res, $c) = ctx_request(GET 'http://localhost/logout', Cookie => $cookie);
$cookie = $res->header('Set-Cookie');
my ($new_new_session_id) = $cookie=~/testapp_session=(.*?);/;
isnt $new_new_session_id, $new_session_id, 'Check session id changed when we logged out';
$cookie = $res->header('Set-Cookie');
ok(!$c->user_exists, 'No user in $c after logout from long session');
$cookie = $res->header('Set-Cookie');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 's00p3r'], Cookie => $cookie);
$cookie = $res->header('Set-Cookie');
($res, $c) = ctx_request(GET 'http://localhost/', Cookie => $cookie);
ok( ($c->session_expires && $c->session_expires-time()-7200) <= 0, 'Session length is low again when no "remember"');
$res = request(GET 'http://localhost/needsauth', Cookie => $cookie);
is($res->code, 200, '/needsauth 200OK now');
($res, $c) = ctx_request(GET 'http://localhost/logout', Cookie => $cookie);
is($res->code, 302, '/logout with cookie redirects');
is($res->header('Location'), 'http://localhost/', 'Redirect to / after logout');
ok($res->header('Set-Cookie'), 'Cookie is reset by /logout');
($res, $c) = ctx_request(GET 'http://localhost/', Cookie => $cookie);
ok($res->is_success, '/ success');
unlike($c->res->body, qr/Logged in/, 'Am logged out');
CatalystX-SimpleLogin-0.20/t/chained_parts.t 0000644 0001750 0001750 00000002172 12651666547 021205 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use HTTP::Request::Common;
# setup library path
use FindBin qw($Bin);
use lib "$Bin/lib";
use Catalyst::Test 'TestApp';
my ($res, $c);
ok(request('/')->is_success, 'Get /');
ok(request('/login')->is_success, 'Get /login');
is(request('/chainedexample')->code, 302, 'Get 302 from /chainedexample');
is(request('/chainedexample/foo')->code, 302, 'Get 302 from /chainedexample/foo');
($res, $c) = ctx_request(GET 'http://localhost/chainedexample/public');
like($c->res->body, qr/page is public/, 'Public page is public.');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 's00p3r']);
is($res->code, 302, 'get 302 redirect');
my $cookie = $res->header('Set-Cookie');
ok($cookie, 'Have a cookie');
ok($c->user, 'Have a user in $c');
($res, $c) = ctx_request(GET 'http://localhost/chainedexample', Cookie => $cookie);
like($c->res->body, qr/Welcome bob/, 'Am logged in');
($res, $c) = ctx_request(GET 'http://localhost/chainedexample/foo', Cookie => $cookie);
like($c->res->body, qr/bob you inputted foo/, 'Works for sub path');
done_testing;
CatalystX-SimpleLogin-0.20/t/08-dbic-mappedfields.t 0000644 0001750 0001750 00000003372 12651666547 022165 0 ustar ahartmai ahartmai use strict;
use warnings;
use Test::More;
use Test::Exception;
use Class::Load;
use HTTP::Request::Common;
use FindBin qw/$Bin/;
use lib "$Bin/lib";
BEGIN {
my @needed = qw/
Catalyst::Model::DBIC::Schema
Catalyst::Authentication::Store::DBIx::Class
DBIx::Class::Optional::Dependencies
/;
plan skip_all => "One of the required classes for this test $@ (" . join(',', @needed) . ") not found."
unless eval {
Class::Load::load_class($_) for @needed; 1;
};
plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for('admin')
unless DBIx::Class::Optional::Dependencies->req_ok_for('admin');
}
use Catalyst::Test qw/TestAppDBIC/;
my $db_file = "$Bin/lib/TestAppDBIC/testdbic.db";
unlink $db_file if -e $db_file;
use_ok('TestAppDBIC::Schema');
my $schema;
lives_ok { $schema = TestAppDBIC::Schema->connect("DBI:SQLite:$db_file") }
'Connect';
ok $schema;
lives_ok { $schema->deploy } 'deploy schema';
$schema->resultset('User')->create({
user_name => 'bob',
password => 'bbbb',
});
ok(request('/')->is_success, 'Get /');
ok(request('/login')->is_success, 'Get /login');
is(request('/logout')->code, 302, 'Get 302 from /logout');
{
my ($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 'aaaa']);
is($res->code, 200, 'get 200 ok as login page redisplayed when bullshit');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 'bbbb']);
is($res->code, 302, 'get 302 redirect');
my $cookie = $res->header('Set-Cookie');
ok($cookie, 'Have a cookie');
is($res->header('Location'), 'http://localhost/', 'Redirect to /');
ok($c->user, 'Have a user in $c');
}
done_testing;
CatalystX-SimpleLogin-0.20/t/05-login-redirect-custom-message.t 0000644 0001750 0001750 00000001157 12651666547 024466 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More 'no_plan';
use HTTP::Request::Common;
use Data::Dumper;
# setup library path
use FindBin qw($Bin);
use lib "$Bin/lib";
use Catalyst::Test 'TestAppRedirect';
my ($res, $c);
($res, $c) = ctx_request(GET 'http://localhost/needslogincustommsg');
is($res->header('Location'), 'http://localhost/login', 'Redirect to /login');
my $cookie = $res->header('Set-Cookie');
ok($cookie, 'Have a cookie');
($res, $c) = ctx_request(GET 'http://localhost/login', Cookie => $cookie);
like($c->res->body, qr/Please Login to view this Test Action/, 'check for custom login msg'); CatalystX-SimpleLogin-0.20/t/author/ 0000755 0001750 0001750 00000000000 13120307403 017463 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/t/author/eol.t 0000644 0001750 0001750 00000000312 12651666547 020454 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use Test::More;
eval {require Test::EOL; };
if ($@) {
plan skip_all => 'Need Test::EOL installed for line ending tests';
exit 0;
}
Test::EOL->import;
all_perl_files_ok();
CatalystX-SimpleLogin-0.20/t/author/pod-coverage.t 0000644 0001750 0001750 00000000252 12651666547 022253 0 ustar ahartmai ahartmai #!perl
use Test::More;
eval "use Test::Pod::Coverage 1.08";
plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@;
all_pod_coverage_ok();
CatalystX-SimpleLogin-0.20/t/author/pod.t 0000644 0001750 0001750 00000000214 12651666547 020460 0 ustar ahartmai ahartmai #!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();
CatalystX-SimpleLogin-0.20/t/author/notabs.t 0000644 0001750 0001750 00000000232 12651666547 021164 0 ustar ahartmai ahartmai
use Test::More;
eval { require Test::NoTabs; };
if ($@) { plan skip_all => 'Test::NoTabs not installed'; exit 0; }
Test::NoTabs::all_perl_files_ok();
CatalystX-SimpleLogin-0.20/t/02-redirect-test.t 0000755 0001750 0001750 00000003022 12651666547 021374 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use HTTP::Request::Common;
use FindBin qw($Bin);
use lib "$Bin/lib";
use Catalyst::Test 'TestAppRedirect';
foreach my $path (qw|needslogin needslogin_chained needslogin_chained_subpart|) {
my ($res, $c) = ctx_request(GET "/$path");
is($res->code, 302, 'get 302 redirect for /' . $path);
is($res->header('Location'), 'http://localhost/login', 'Redirect to /login');
ok(!$res->header('X-Action-Run'), 'Action shouldnt run! ' . ($res->header('X-Action-Run')||''));
}
{
my ($res, $c) = ctx_request(GET "/needslogin_chained_subpart");
ok($res->header('X-Start-Chain-Run'), 'Start of chain actions run when needslogin at end of chain');
}
{
my ($res, $c) = ctx_request('/needslogin');
# FIXME
# ok($c->session->{redirect_to_after_login}, '$c->session->{redirect_to_after_login} set');
my $cookie = $res->header('Set-Cookie');
ok($cookie, 'Have a cookie');
($res, $c) = ctx_request(POST '/login', [username => 'bob', password => 's00p3r'], Cookie => $cookie);
$cookie = $res->header('Set-Cookie');
ok(!exists($c->session->{redirect_to_after_login}), '$c->session->{redirect_to_after_login} cleared');
ok($c->user, 'Have a user in $c');
is($res->code, 302, 'get 302 redirect to needslogin');
is($res->header('Location'), 'http://localhost/needslogin', 'Redirect to /needslogin');
($res, $c) = ctx_request(GET '/needslogin', Cookie => $cookie);
is($res->code, 200, 'get 200 ok for page which needs login');
}
done_testing;
CatalystX-SimpleLogin-0.20/t/10-form-args.t 0000644 0001750 0001750 00000001077 12651666547 020517 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More 'no_plan';
use HTTP::Request::Common;
# setup library path
use FindBin qw($Bin);
use lib "$Bin/lib";
use Catalyst::Test 'TestAppFormArgs';
my ($res, $c);
ok(request('/')->is_success, 'Get /');
ok(request('/login')->is_success, 'Get /login');
($res, $c) = ctx_request(GET 'http://localhost/login' );
like( $c->res->body, qr/Testing Form Args/, 'extra form field added' );
like( $c->res->body, qr/\/, 'submit button modified' );
CatalystX-SimpleLogin-0.20/t/07-openid-live.t 0000644 0001750 0001750 00000002224 12651666547 021036 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use HTTP::Request::Common;
# setup library path
use FindBin qw($Bin);
use lib "$Bin/lib";
BEGIN {
unless (
eval { require Crypt::DH } &&
eval { require Catalyst::Authentication::Credential::OpenID; }
) {
plan skip_all => 'OpenID dependencies not installed';
}
}
use Catalyst::Test 'TestAppOpenID';
my ($res, $c);
ok(request('/login')->is_success, 'Get /login');
($res, $c) = ctx_request(POST 'http://localhost/login', [ openid_identifier => 'aaa' ]);
is($res->code, 200, 'get login form');
ok( $res->content =~ /class="error_message">Invalid OpenID 'http://mock.open.id.server' ]);
is($res->code, 302, 'get redirect to openid server');
is($res->header( 'location' ), 'http://localhost/login?openid-check=1', 'Redir location');
($res, $c) = ctx_request(POST 'http://localhost/login?openid-check=1', );
my $user = $c->user;
is( $user->{url}, 'http://mock.open.id.server', 'user url' );
is( $user->{display}, 'mocked_user', 'user display' );
done_testing;
CatalystX-SimpleLogin-0.20/t/09-clearsession.t 0000644 0001750 0001750 00000005367 12651666547 021332 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use LWP::UserAgent;
use HTTP::Request::Common;
use FindBin qw($Bin);
use lib "$Bin/lib";
use Catalyst::Test 'TestAppClearSession';
####################################################################
# This test will is here to see if 'clear_session_on_logout' works.#
####################################################################
# __PACKAGE__->config('Controller::Login' => { clear_session_on_logout => 1 });
####################################################################
# Can we request the index of the correct test app?..
my ($res, $c) = ctx_request(GET "/");
like($c->res->body, qr/BLARRRMOO/, '');
# Can we request that something be set in the session?..
($res, $c) = ctx_request(GET "/setsess");
is($res->code, 200, 'Set session requested (not logged in)');
# Did we get a cookie?..
my $cookie = $res->header('Set-Cookie');
ok($cookie, 'Got cookie - 001');
# Is there something in the session?..
($res, $c) = ctx_request(GET '/viewsess', Cookie => $cookie);
like($c->res->body, qr/session_var1_set=someval1/, '');
# Can we request that something else be set in the session .... even thou we have not yet logged in?
#... should not be able to as this action 'NeedsLogin'...
($res, $c) = ctx_request(GET "/needsloginsetsess", Cookie => $cookie );
is($res->code, 302, 'Set session requested (logged in) ... we are not yet logged in');
# Can we login?...
($res, $c) = ctx_request(POST 'login', [ username => 'william', password => 's3cr3t' ], Cookie => $cookie );
is($res->code, 302, 'Logged in so therefore got 302 redirect');
$cookie = $res->header('Set-Cookie');
# Is there still something in the session?..
($res, $c) = ctx_request(GET '/viewsess', Cookie => $cookie);
like($c->res->body, qr/session_var1_set=someval1/, '');
# Can we request that something else be set in the session now we are logged in?..
($res, $c) = ctx_request(GET "/needsloginsetsess", Cookie => $cookie );
is($res->code, 200, 'Set session requested (logged in)');
# Is there something new in the session?..
($res, $c) = ctx_request(GET '/viewsess', Cookie => $cookie);
like($c->res->body, qr/session_var2_set=someval2/, '');
# Can we logout?..
($res, $c) = ctx_request(GET 'logout', Cookie => $cookie );
is($res->code, 302, 'Logged out so therefore got 302 redirect');
# Ensure we are logged out, by requesting something at 'NeedsLogin'..
($res, $c) = ctx_request(GET "/needsloginsetsess", Cookie => $cookie );
is($res->code, 302, 'Set session requested (logged in)');
# Now lets have look at the session.. it should be clear..
# Is there something new in the session?..
($res, $c) = ctx_request(GET '/viewsess', Cookie => $cookie);
like($c->res->body, qr/In the session::/, 'Should be seeing a cleared session');
done_testing;
CatalystX-SimpleLogin-0.20/t/03-login-form.t 0000644 0001750 0001750 00000002001 12651666547 020661 0 ustar ahartmai ahartmai #!/usr/bin env perl
use strict;
use warnings;
use Test::More;
my $form_class = 'CatalystX::SimpleLogin::Form::Login';
use_ok( $form_class );
my $form = $form_class->new;
ok( $form, 'form created OK' );
my $rendered = $form->render;
ok( $rendered, 'form renders' );
# mock up ctx/authenticate
{
package Catalyst;
use Moose;
sub authenticate { 1 }
}
my $ctx = Catalyst->new;
my $values = { username => 'Bob', password => 'bobpw' };
my $result = $form->run( ctx => $ctx, params => $values );
ok( $result, 'result created' );
ok( $result->validated, 'result validated' );
$values->{remember} = 0;
is_deeply( $result->value, $values, 'values correct' );
$form = $form_class->new( field_list => [ '+username' => { accessor => 'user_name' },
'+password' => { accessor => 'pw' } ] );
$result = $form->run( ctx => $ctx, params => $values );
my $custom_values = { user_name => 'Bob', pw => 'bobpw', remember => 0 };
is_deeply( $result->value, $custom_values, 'accessors used for fields' );
done_testing;
CatalystX-SimpleLogin-0.20/t/00-load.t 0000644 0001750 0001750 00000000270 12651666547 017532 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 2;
use_ok 'CatalystX::SimpleLogin' or BAIL_OUT;
use_ok 'CatalystX::SimpleLogin::Controller::Login' or BAIL_OUT;
CatalystX-SimpleLogin-0.20/t/04-test-role-apply-order.t 0000644 0001750 0001750 00000000622 12651666547 022772 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More 'no_plan';
use HTTP::Request::Common;
# setup library path
use FindBin qw($Bin);
use lib "$Bin/lib";
use Catalyst::Test 'TestAppRedirect';
my ($res, $c);
($res, $c) = ctx_request(GET 'http://localhost/needsloginandhasacl');
TODO: {
local $TODO = 'Known broken';
is($res->code, 302, 'ACL Role got applied before NeedsLogin role');
}
CatalystX-SimpleLogin-0.20/t/06-rendertt.t 0000644 0001750 0001750 00000003623 12651666547 020455 0 ustar ahartmai ahartmai #!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use HTTP::Request::Common;
use FindBin qw($Bin);
use lib "$Bin/lib";
use Catalyst::Test 'TestAppRenderTT';
my ($res, $c);
ok(request('/')->is_success, 'Get /');
ok(request('/login')->is_success, 'Get /login');
is(request('/logout')->code, 302, 'Get 302 from /logout');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 'aaaa']);
is($res->code, 200, 'get errors in login form');
like($c->res->body, qr/Wrong username or password/, 'login error');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 's00p3r']);
my $cookie = $res->header('Set-Cookie');
($res, $c) = ctx_request(GET 'http://localhost/', Cookie => $cookie);
ok( ($c->session_expires-time()-7200) <= 0, 'Session length low when no "remember"');
($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 's00p3r', remember => 1]);
$cookie = $res->header('Set-Cookie');
is($res->code, 302, 'get 302 redirect');
is($res->header('Location'), 'http://localhost/', 'Redirect to /');
($res, $c) = ctx_request(GET 'http://localhost/', Cookie => $cookie);
ok( ($c->session_expires-time()-7200) >= 0, 'Long session set when "remember"');
$cookie = $res->header('Set-Cookie');
ok($cookie, 'Have a cookie');
ok($c->user, 'Have a user in $c');
($res, $c) = ctx_request(GET 'http://localhost/', Cookie => $cookie);
like($c->res->body, qr/Logged in/, 'Am logged in');
($res, $c) = ctx_request(GET 'http://localhost/logout', Cookie => $cookie);
is($res->code, 302, '/logout with cookie redirects');
is($res->header('Location'), 'http://localhost/', 'Redirect to / after logout');
ok($res->header('Set-Cookie'), 'Cookie is reset by /logout');
($res, $c) = ctx_request(GET 'http://localhost/', Cookie => $cookie);
ok($res->is_success, '/ success');
unlike($c->res->body, qr/Logged in/, 'Am logged out');
done_testing;
CatalystX-SimpleLogin-0.20/lib/ 0000755 0001750 0001750 00000000000 13120307403 016464 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/CatalystX/ 0000755 0001750 0001750 00000000000 13120307403 020400 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/ 0000755 0001750 0001750 00000000000 13120307403 022622 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/TraitFor/ 0000755 0001750 0001750 00000000000 13120307403 024354 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/TraitFor/Controller/ 0000755 0001750 0001750 00000000000 13120307403 026477 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/ 0000755 0001750 0001750 00000000000 13120307403 027547 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/RenderAsTTTemplate.pm0000644 0001750 0001750 00000001763 12651666547 033614 0 ustar ahartmai ahartmai package CatalystX::SimpleLogin::TraitFor::Controller::Login::RenderAsTTTemplate;
use MooseX::MethodAttributes::Role;
use namespace::autoclean;
requires qw/
login
login_form_stash_key
/;
after 'login' => sub {
my ( $self, $ctx ) = @_;
my $rendered_form = $ctx->stash->{$self->login_form_stash_key}->render;
$ctx->stash( template => \$rendered_form );
};
1;
=head1 NAME
CatalystX::SimpleLogin::TraitFor::Controller::Login::RenderAsTTTemplate - render a login form with no template file
=head1 DESCRIPTION
Simple controller role to allow rendering a login form with no
template file. Sets the stash 'template' key to a string reference
containing the rendered form.
=head1 METHODS
=head2 after 'login'
$ctx->stash( template => \$self->render_login_form($ctx, $result) );
=head1 SEE ALSO
=over
=item L
=back
=head1 AUTHORS
See L for authors.
=head1 LICENSE
See L for license.
=cut
CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/WithRedirect.pm 0000644 0001750 0001750 00000004351 13120305560 032507 0 ustar ahartmai ahartmai package CatalystX::SimpleLogin::TraitFor::Controller::Login::WithRedirect;
use MooseX::MethodAttributes::Role;
use namespace::autoclean;
requires qw/
redirect_after_login_uri
/;
around 'redirect_after_login_uri' => sub {
my ($orig, $self, $c, @args) = @_;
if (!$c->can('session')) {
$c->log->warn('No $c->session, cannot do ' . __PACKAGE__);
return $self->$orig($c, @args);
}
return $c->session->{redirect_to_after_login}
? delete $c->session->{redirect_to_after_login}
: $self->$orig($c, @args);
};
before login_redirect => sub {
my ($self, $c, $message) = @_;
$c->flash->{error_msg} = $message; # FIXME - Flash horrible
$c->session->{redirect_to_after_login}
= $c->req->uri->as_string;
};
1;
__END__
=head1 NAME
CatalystX::SimpleLogin::TraitFor::Controller::Login::WithRedirect - redirect
users who login back to the page they originally requested.
=head1 SYNOPSIS
package MyApp::Controller::NeedsAuth;
use Moose;
use namespace::autoclean;
# One needs to inherit from Catalyst::Controller in order
# to get the Does('NeedsLogin') functionality.
BEGIN { extends 'Catalyst::Controller'; }
sub inbox : Path Does('NeedsLogin') {
# Redirects to /login if not logged in
my ($self, $c) = @_;
$c->stash->{template} = "inbox.tt2";
return;
}
# Turn on in config
MyApp->config('Contoller::Login' => { traits => 'WithRedirect' });
=head1 DESCRIPTION
Provides the C
action with a wrapper to redirect to a page which needs authentication, from which the
user was previously redirected. Goes hand in hand with L
=head1 WRAPPED METHODS
=head2 redirect_after_login_uri
Make it use and extract C<< $c->session->{redirect_to_after_login} >>
if it exists.
=head1 METHODS
=head2 $controller->login_redirect($c, $message)
This sets the error message to $message and sets
C<< $c->session->{redirect_to_after_login} >> to the current URL.
=head1 SEE ALSO
=over
=item L
=item L
=back
=head1 AUTHORS
See L for authors.
=head1 LICENSE
See L for license.
=cut
CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/Logout.pm 0000644 0001750 0001750 00000004163 12651666547 031413 0 ustar ahartmai ahartmai package CatalystX::SimpleLogin::TraitFor::Controller::Login::Logout;
use MooseX::MethodAttributes::Role;
use MooseX::Types::Moose qw/Str Bool/;
use namespace::autoclean;
sub logout : Chained('/') PathPart('logout') Args(0) {
my ($self, $c) = @_;
$c->logout;
$c->change_session_id;
$self->do_clear_session_on_logout($c) if $self->clear_session_on_logout;
$c->res->redirect($self->redirect_after_logout_uri($c));
}
has clear_session_on_logout => (
isa => Bool,
is => 'ro',
default => 0,
);
sub do_clear_session_on_logout {
my ($self, $c) = @_;
$c->delete_session;
}
sub redirect_after_logout_uri {
my ($self, $c) = @_;
$c->uri_for($self->_redirect_after_logout_uri);
}
has _redirect_after_logout_uri => (
isa => Str,
default => '/',
init_arg => 'redirect_after_logout_uri',
is => 'ro',
);
1;
=head1 NAME
CatalystX::SimpleLogin::TraitFor::Controller::Login::Logout - log users out
=head1 DESCRIPTION
Simple controller role for logging users out. Provides a
C action (at /logout by default) which redirects
the user to the homepage by default.
=head1 ACTIONS
=head2 logout : Chained('/') PathPart('logout') Args(0)
Calls C<< $c->logout >>, then redirects to the logout uri
retuned by C<< $self->redirect_after_logout_uri >>.
=head1 METHODS
=head2 redirect_after_logout_uri
Returns the uri to redirect to after logout.
Defaults to C<< $c->uri_for('/'); >> you can override this
by setting the C<> key in config
to a path to be passed to C<< $c->uri_for >>.
Alternatively, you can write your own redirect_after_logout_uri
in your Login controller if you are extending CatalystX::SimpleLogin
and it will override the method from this role.
=head2 do_clear_session_on_logout
Deletes the session after a logout.
To enable this use the following in your config:
__PACKAGE__->config('Controller::Login' => { clear_session_on_logout => 1 });
=head1 SEE ALSO
=over
=item L
=back
=head1 AUTHORS
See L for authors.
=head1 LICENSE
See L for license.
=cut
CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/OpenID.pm 0000644 0001750 0001750 00000003536 12651666547 031263 0 ustar ahartmai ahartmai package CatalystX::SimpleLogin::TraitFor::Controller::Login::OpenID;
use MooseX::MethodAttributes ();
use MooseX::Types::Common::String qw/ NonEmptySimpleStr /;
use Moose::Role -traits => 'MethodAttributes';
use namespace::autoclean;
has 'openid_realm' => (
is => 'ro',
isa => NonEmptySimpleStr,
required => 1,
default => 'openid',
);
around 'login_GET' => sub {
my $orig = shift;
my $self = shift;
my ( $c) = @_;
if($c->req->param("openid.mode"))
{
if($c->authenticate({},$self->openid_realm)) {
$c->flash(success_msg => "You signed in with OpenID!");
$c->res->redirect($self->redirect_after_login_uri($c));
}
else
{
$c->flash(error_msg => "Failed to sign in with OpenID!");
}
}
else
{
return $self->$orig(@_);
}
};
=head1 NAME
CatalystX::SimpleLogin::TraitFor::Controller::Login::OpenID - allows a User to login via OpenID
=head1 SYNOPSIS
package MyApp::Controller::NeedsAuth;
sub something : Path Does('NeedsLogin') {
# Redirects to /login if not logged in
}
# Turn on in config
MyApp->config('Contoller::Login' => { traits => 'Login::OpenID' });
=head1 DESCRIPTION
Provides the C action with a wrapper to redirect to a page which needs
authentication, from which the user was previously redirected. Goes hand in
hand with L .
=head1 WRAPPED METHODS
=head2 login_GET
Wrap around an openid authentication if the C<'openid.mode'> request parameter
is set. Otherwise, use the default login_GET() method.
=head1 SEE ALSO
=over
=item L
=item L
=back
=head1 AUTHORS
See L for authors.
=head1 LICENSE
See L for license.
=cut
1;
CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/Form/ 0000755 0001750 0001750 00000000000 13120307403 023525 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/Form/Login.pm 0000644 0001750 0001750 00000010570 12651705736 025161 0 ustar ahartmai ahartmai package CatalystX::SimpleLogin::Form::Login;
use HTML::FormHandler::Moose;
use Try::Tiny;
use namespace::autoclean;
extends 'HTML::FormHandler';
use MooseX::Types::Moose qw/ HashRef /;
use MooseX::Types::Common::String qw/ NonEmptySimpleStr /;
has '+name' => ( default => 'login_form' );
has authenticate_args => (
is => 'ro',
isa => HashRef,
predicate => 'has_authenticate_args',
);
has authenticate_realm => (
is => 'ro',
isa => NonEmptySimpleStr,
predicate => 'has_authenticate_realm',
);
has 'login_error_message' => (
is => 'ro',
isa => NonEmptySimpleStr,
required => 1,
default => 'Wrong username or password',
);
foreach my $type (qw/ username password /) {
has sprintf("authenticate_%s_field_name", $type) => (
is => 'ro',
isa => NonEmptySimpleStr,
default => $type
);
# FIXME - be able to change field names in rendered form also!
}
has_field 'username' => ( type => 'Text', tabindex => 1 );
has_field 'password' => ( type => 'Password', tabindex => 2 );
has_field 'remember' => ( type => 'Checkbox', tabindex => 3 );
has_field 'submit' => ( type => 'Submit', value => 'Login', tabindex => 4 );
sub validate {
my $self = shift;
# as HTML::Formhandler doesn't handle exceptions thrown by user provided
# validate methods and fails to clear the 'posted' attribute we need to
# catch them
unless (
try {
$self->ctx->authenticate(
{
(map {
my $param_name = sprintf("authenticate_%s_field_name", $_);
($self->can($param_name) ? $self->$param_name() : $_) => $self->values->{$_};
}
grep { ! /remember/ }
keys %{ $self->values }),
($self->has_authenticate_args ? %{ $self->authenticate_args } : ()),
},
($self->has_authenticate_realm ? $self->authenticate_realm : ()),
);
}
catch {
$self->ctx->log->error("$_");
return 0;
}
) {
$self->add_auth_errors;
# the return value of this method is ignored by HTML::FormHandler
# 0.40064, only errors added to the form itself or its fields control
# the forms' 'validated' attribute
return 0;
}
return 1;
}
sub add_auth_errors {
my $self = shift;
$self->field( 'password' )->add_error( $self->login_error_message );
}
__PACKAGE__->meta->make_immutable;
=head1 NAME
CatalystX::SimpleLogin::Form::Login - validation for the login form
=head1 DESCRIPTION
A L form for the login form.
=head1 FIELDS
=over
=item username
=item password
=item remember
=item submit
=back
=head1 METHODS
=over
=item validate
=item add_auth_errors
=back
=head1 SEE ALSO
=over
=item L
=back
=head1 CUSTOMIZATION
By default, the params passed to authenticate() are 'username' and
'password'. If you need to use different names, then you'll need to
set the correct value(s) via login_form_args in the configuration.
The keys are 'authenticate_username_field_name' and/or
'authenticate_password_field_name'.
__PACKAGE__->config(
'Controller::Login' => {
login_form_args => {
authenticate_username_field_name => 'name',
authenticate_password_field_name => 'password2',
},
},
);
You can also change the way that the form is displayed by setting
attributes. In MyApp.pm:
__PACKAGE__->config(
'Controller::Login' => {
login_form_args => {
login_error_message => 'Login failed',
field_list => [
'+submit' => { value => 'Login' },
]
}
},
);
Additional fields can be added:
field_list => [
'foo' => ( type => 'MyField' ),
'bar' => { type => 'Text' },
]
Additional arguments to the authenticate call can be added:
If your user table has a column C and you want only those with Cto be able to log .in
__PACKAGE__->config(
'Controller::Login' => {
login_form_args => {
authenticate_args => { status => 1 },
},
},
};
=head1 AUTHORS
See L for authors.
=head1 LICENSE
See L for license.
=cut
CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/Form/LoginOpenID.pm 0000644 0001750 0001750 00000002656 12651666547 026234 0 ustar ahartmai ahartmai package CatalystX::SimpleLogin::Form::LoginOpenID;
use HTML::FormHandler::Moose::Role;
use MooseX::Types::Common::String qw/ NonEmptySimpleStr /;
BEGIN {
unless (
eval { require Crypt::DH } &&
eval { require Catalyst::Authentication::Credential::OpenID; }
) {
warn("Cannot load " . __PACKAGE__ . " - Catalyst OpenID authentication credential not installed\n");
exit 1;
}
}
has_field 'openid_identifier' => ( type => 'Text' );
has_field 'openid-check' => ( widget => 'no_render' );
has 'openid_error_message' => (
is => 'ro',
isa => NonEmptySimpleStr,
required => 1,
default => 'Invalid OpenID',
);
after 'add_auth_errors' => sub {
my $self = shift;
$self->field( 'openid_identifier' )->add_error( $self->openid_error_message )
if $self->field( 'openid-check' )->value or defined $self->field( 'openid_identifier' )->value;
};
1;
=head1 NAME
CatalystX::SimpleLogin::Form::LoginOpenID - OpenID validation role for the login form
=head1 DESCRIPTION
A L role form for the login form.
=head1 FIELDS
=over
=item openid_identifier
=item openid-check
=item openid_error_message
=back
=head1 METHODS
=over
=item add_auth_errors
=back
=head1 SEE ALSO
=over
=item L
=back
=head1 AUTHORS
See L for authors.
=head1 LICENSE
See L for license.
=cut
CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/Controller/ 0000755 0001750 0001750 00000000000 13120307403 024745 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/Controller/Login.pm 0000644 0001750 0001750 00000016705 13120305560 026366 0 ustar ahartmai ahartmai package CatalystX::SimpleLogin::Controller::Login;
use Moose;
use MooseX::Types::Moose qw/ HashRef ArrayRef ClassName Object Str Int/;
use MooseX::Types::Common::String qw/ NonEmptySimpleStr /;
use CatalystX::SimpleLogin::Form::Login;
use namespace::autoclean;
BEGIN { extends 'Catalyst::Controller'; }
with qw(
CatalystX::Component::Traits
Catalyst::Component::ContextClosure
);
has '+_trait_merge' => (default => 1);
__PACKAGE__->config(
traits => [qw/
WithRedirect
RenderAsTTTemplate
Logout
/],
remember_me_expiry => 999999999,
);
sub BUILD {
my $self = shift;
$self->login_form; # Build login form at construction time
}
has login_form_class => (
isa => ClassName,
is => 'rw',
default => 'CatalystX::SimpleLogin::Form::Login',
);
has login_form_class_roles => (
isa => ArrayRef[NonEmptySimpleStr],
is => 'ro',
default => sub { [] },
);
has login_form => (
isa => Object,
is => 'ro',
lazy_build => 1,
);
has login_form_args => (
isa => HashRef,
is => 'ro',
default => sub { {} },
);
has remember_me_expiry => (
isa => Int,
is => 'ro',
);
has login_form_stash_key => (
is => 'ro',
isa => Str,
default => 'login_form',
);
has render_login_form_stash_key => (
is => 'ro',
isa => Str,
default => 'render_login_form',
);
with 'MooseX::RelatedClassRoles' => { name => 'login_form' };
sub _build_login_form {
my $self = shift;
$self->apply_login_form_class_roles(@{$self->login_form_class_roles})
if scalar @{$self->login_form_class_roles}; # FIXME - Should MX::RelatedClassRoles
# do this automagically?
return $self->login_form_class->new($self->login_form_args);
}
sub render_login_form {
my ($self, $ctx, $form) = @_;
return $form->render;
}
sub not_required
:Chained('/')
:PathPart('')
:CaptureArgs(0)
{}
sub required
:Chained('/')
:PathPart('')
:CaptureArgs(0)
:Does('NeedsLogin')
{}
sub login
:Chained('not_required')
:PathPart('login')
:Args(0)
{
my ($self, $ctx) = @_;
my $form = $self->login_form;
my $p = $ctx->req->parameters;
if( $form->process(ctx => $ctx, params => $p) ) {
$ctx->change_session_id;
$self->remember_me($ctx, $form->field( 'remember' )->value);
$self->do_post_login_redirect($ctx);
}
$ctx->stash(
$self->login_form_stash_key => $form,
$self->render_login_form_stash_key => $self->make_context_closure(sub {
my ($ctx) = @_;
$self->render_login_form($ctx, $form);
}, $ctx),
);
}
sub remember_me
{
my ($self, $ctx, $remember) = @_;
my $expire = $remember ?
$self->remember_me_expiry : $ctx->initial_session_expires - time();
# set expiry time in storage
$ctx->change_session_expires($expire);
# refresh changed expiry time from storage
$ctx->reset_session_expires;
# update cookie TTL
$ctx->set_session_id($ctx->sessionid);
}
sub do_post_login_redirect {
my ($self, $ctx) = @_;
$ctx->res->redirect($self->redirect_after_login_uri($ctx));
}
sub login_redirect {
my ($self, $ctx) = @_;
$ctx->response->redirect($ctx->uri_for($self->action_for("login")));
$ctx->detach;
}
sub redirect_after_login_uri {
my ($self, $ctx) = @_;
$ctx->uri_for($self->_redirect_after_login_uri);
}
has _redirect_after_login_uri => (
is => Str,
is => 'ro',
init_arg => 'redirect_after_login_uri',
default => '/',
);
1;
=head1 NAME
CatalystX::SimpleLogin::Controller::Login - Configurable login controller
=head1 SYNOPSIS
# For simple useage exmple, see CatalystX::SimpleLogin, this is a
# full config example
__PACKAGE__->config(
'Controller::Login' => {
traits => [
'WithRedirect', # Optional, enables redirect-back feature
'-RenderAsTTTemplate', # Optional, allows you to use your own template
],
actions => {
login => { # Also optional
PathPart => ['theloginpage'], # Change login action to /theloginpage
},
},
},
);
See L for configuring the form.
=head1 DESCRIPTION
Controller base class which exists to have login roles composed onto it
for the login and logout actions.
=head1 ATTRIBUTES
=head2 login_form_class
A class attribute containing the class of the form to be initialised. One
can override it in a derived class with the class of a new form, possibly
subclassing L. For example:
package MyApp::Controller::Login;
use Moose;
extends('CatalystX::SimpleLogin::Controller::Login');
has '+login_form_class' => (
default => "MyApp::Form::Login",
);
1;
=head2 login_form_class_roles
An attribute containing an array reference of roles to be consumed by
the form. One can override it in a similar way to C:
package MyApp::Controller::Login;
use Moose;
extends('CatalystX::SimpleLogin::Controller::Login');
has '+login_form_class_roles' => (
default => sub { [qw(MyApp::FormRole::Foo MyApp::FormRole::Bar)] },
);
1;
=head1 METHODS
=head2 BUILD
Cause form instance to be built at application startup.
=head2 do_post_login_redirect
This method does a post-login redirect. B for BOBTFISH - should it even
be public? If it does need to be public, then document it because the Pod
coverage test failed.
=head2 login
Login action.
=head2 login_redirect
Redirect to the login action.
=head2 login_GET
Displays the login form
=head2 login_POST
Processes a submitted login form, and if correct, logs the user in
and redirects
=head2 not_required
A stub action that is anchored at the root of the site ("/") and does not
require registration (hence the name).
=head2 redirect_after_login_uri
If you are using WithRedirect (i.e. by default), then this method is overridden
to redirect the user back to the page they initially hit which required
authentication.
Note that even if the original URI was a post, then the redirect back will only
be a GET.
If you choose B to compose the WithRedirect trait, then you can set the
uri users are redirected to with the C config key,
or by overriding the redirect_after_login_uri method in your own login
controller if you need custom logic.
=head2 render_login_form
Renders the login form. By default it just calls the form's render method. If
you want to do something different, like rendering the form with a template
through your view, this is the place to hook into.
=head2 required
A stub action that is anchored at the root of the site ("/") and does
require registration (hence the name).
=head2 remember_me
An action that is called to deal with whether the remember me flag has
been set or not. If it has been it extends the session expiry time.
This is only called if there was a successful login so if you want a
hook into that part of the process this is a good place to hook into.
It is also obviously a good place to hook into if you want to change
the behaviour of the remember me flag.
=head1 SEE ALSO
=over
=item L
=item L
=back
=head1 AUTHORS
See L for authors.
=head1 LICENSE
See L for license.
=cut
CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin/Manual.pod 0000644 0001750 0001750 00000016351 12651666547 024602 0 ustar ahartmai ahartmai =head1 NAME
CatalystX::SimpleLogin::Manual - How to use and customise CatalystX::SimpleLogin.
=head2 Tutorial
We're using a sample application here, to make the instructions a little
easier. This assumes that you have Catalyst, Catalyst::Devel,
Template Toolkit, and the Catalyst authentication and session plugins
installed.
catalyst.pl MyApp
cd MyApp
script/myapp_create.pl view HTML TT
Edit lib/MyApp.pm and add CatalystX::SimpleLogin, Authenticate, and the
Session plugins to the use Catalyst plugin list:
use Catalyst qw/-Debug
ConfigLoader
+CatalystX::SimpleLogin
Authentication
Session
Session::Store::File
Session::State::Cookie
Static::Simple/;
Add the following config for authentication, including two sample users:
__PACKAGE__->config(
'Plugin::Authentication' => {
default => {
credential => {
class => 'Password',
password_field => 'password',
password_type => 'clear'
},
store => {
class => 'Minimal',
users => {
bob => {
password => "bobpw",
},
william => {
password => "billpw",
},
},
},
},
},
);
Execute C< script/myapp_server.pl > and, as part of the debug output, you should see:
[debug] Loaded Chained actions:
.-------------------------------------+--------------------------------------.
| Path Spec | Private |
+-------------------------------------+--------------------------------------+
| /login | /login/login |
| /logout | /login/logout |
'-------------------------------------+--------------------------------------'
Go to C< localhost:3000 > and you should see the Catalyst welcome screen. Go to
C< localhost:3000/login > and you should get a login screen containing username and
password text fields, a 'Remember' checkbox, and a 'Login' button. Enter 'bob' and
'bobpw'. You should be logged in and taken to the welcome screen. If you execute
C< localhost:3000/logout > you will be logged out, and should see this in the
debug output (the welcome screen will stay the same).
Now go to C< lib/MyApp/Controller/Root.pm > and remove the lines saying:
use strict;
use warnings;
use parent 'Catalyst::Controller';
and add the following lines:
use Moose;
use namespace::autoclean;
BEGIN { extends 'Catalyst::Controller' }
Now add a new action to C< lib/MyApp/Controller/Root.pm > and include
C< Does('NeedsLogin') > to use the Catalyst ActionRole that is part of SimpleLogin:
sub hello_user : Local Does('NeedsLogin') {
my ( $self, $c ) = @_;
$c->res->body('
Hello, user!
');
}
Restart the server and you can see the new action. Go to C<< htp://localhost:3000/hello_user >>
and you'll get the 'Hello, user!' page. Now execute C<< http://localhost:3000/logout >> and try
C<< http://localhost:3000/hello_user >> again. You will be presented with a login screen.
=head3 Authorization
CatalystX::SimpleLogin also provides /login/required and /login/not_required for easy
chaining off of for actions which should only be available to authenticated users.
package MyApp::Controller::Secure;
sub setup : Chained('/login/required') PathPart('') CaptureArgs(1) {
my ( $self, $c, $id ) = @_;
# setup actions for authenticated-user-only access
$c->stash->{id} = $id;
}
sub something_secure : Chained('setup') PathPart Args(0) {
my ( $self, $c ) = @_;
# only authenticated users will have access to this action
}
sub open_to_all : Chained('/login/not_required') PathPart Args(0) {
my ( $self, $c ) = @_;
# this is available to everyone
}
For more fine-grained control, you can use ACL checks to refine access
control policies. This functionality is provided via L.
Please consult the ACL documentation for steps to setup your application.
The ACL checks work by allowing you to add additional attributes on your
actions which control the particular role(s) required or allowed.
package MyApp;
__PACKAGE__->config(
'Controller::Login' => {
actions => {
required => {
Does => ['ACL'],
AllowedRole => ['admin', 'poweruser'], # ANY of these
# RequiresRole => ['extranet'], # ALL of these
ACLDetachTo => 'login',
},
},
},
);
package MyApp::Controller::Foo;
BEGIN { extends 'Catalyst::Controller' }
sub do_something : Chained('/login/required')
: Does('ACL') RequiresRole('createinvoice') ACLDetachTo('/login') {}
You can also add a message, which will be put into the flash key 'error_msg'. Add
the following to the hello_user action:
: LoginRedirectMessage('Please Login to view this Action')
Now we'll create a Template Toolkit template that can be customized. Create a
C< root/login/login.tt > file with the following lines.
[% error_msg %]
[% render_login_form %]
Now edit C< lib/MyApp.pm > and add the config shown below
to remove the 'RenderAsTTTemplate' trait, and add
'flash_to_stash' for L
(to allow the error message to be passed to the next request):
__PACKAGE__->config(
'Plugin::Session' => {
flash_to_stash => 1
},
'Controller::Login' => {
traits => ['-RenderAsTTTemplate'],
},
# Other config..
);
Restart the server and try to view the hello_user page without being logged in.
You should be redireced to the login page with the error message displayed at
the top.
You can replace C< [% render_login_form %] > with your own html, and customize
it as you please.
[% error_msg %]
Or you can customize it using L HTML rendering features, and
the 'login_form_args' config key.
To alter the amount the remember me extends the session by alter the C
configuration setting.
__PACKAGE__->config(
'Controller::Login' => {
remember_me_expiry => 999999999, # the default is about 32 years.
},
# Other config..
);
=cut
CatalystX-SimpleLogin-0.20/lib/CatalystX/SimpleLogin.pm 0000644 0001750 0001750 00000012742 13120307261 023170 0 ustar ahartmai ahartmai package CatalystX::SimpleLogin;
use Moose::Role;
use CatalystX::InjectComponent;
use namespace::autoclean;
our $VERSION = '0.20';
after 'setup_components' => sub {
my $class = shift;
CatalystX::InjectComponent->inject(
into => $class,
component => 'CatalystX::SimpleLogin::Controller::Login',
as => 'Controller::Login'
);
};
=head1 NAME
CatalystX::SimpleLogin - Provide a simple Login controller which can be reused
=head1 SYNOPSIS
package MyApp;
use Moose;
use namespace::autoclean;
use Catalyst qw/
+CatalystX::SimpleLogin
Authentication
Session
Session::State::Cookie
Session::Store::File
/;
extends 'Catalyst';
__PACKAGE__->config(
'Plugin::Authentication' => { # Auth config here }
);
__PACKAGE__->config(
'Controller::Login' => { # SimpleLogin config here }
);
__PACKAGE__->setup;
=head1 ATTENTION!
If you're new here, you should start by reading
L, which provides a gentler introduction to
using this code. Come back here when you're done there.
=head1 DESCRIPTION
CatalystX::SimpleLogin is an application class L which will
inject a L
which is an instance of L into your
application. This provides a simple login and logout page with the addition
of only one line of code and one template to your application.
=head1 REQUIREMENTS
=over
=item A Catalyst application
=item Working authentication configuration
=item Working session configuration
=item A view
=back
=head1 CUSTOMISATION
CatalystX::SimpleLogin is a prototype for CatalystX::Elements. As such, one of the goals
is to make it easy for users to customise the provided component to the maximum degree
possible, and also, to have a linear relationship between effort invested and level of
customisation achieved.
Three traits are shipped with SimpleLogin: WithRedirect, Logout, and RenderAsTTTemplate.
These traits are set in the config:
__PACKAGE__->config(
'Controller::Login' => {
traits => [qw/ Logout WithRedirect RenderAsTTTemplate /],
login_form_args => { # see the login form },
);
=head1 COMPONENTS
=over
=item *
L - first point of call for customisation.
Override the action configs to reconfigure the paths of the login or logout actions.
Subclass to be able to apply method modifiers to run before / after the login or
logout actions or override methods.
=item *
L - provides the C action
and associated methods. You can compose this manually yourself if you want just that
action.
This trait is set by default, but if you set another trait in your config, you
will have to include it.
=item *
L - provides the C
action with a wrapper to redirect to a page which needs authentication, from which the
user was previously redirected. Goes hand in hand with L
=item *
L - sets
the stash variable 'template' to point to a string reference containing the
rendered template so that it's not necessary to have a login.tt template file.
=item *
L - the L form for the login form.
=item *
L - Used to cause a specific path to redirect to the login
page if a user is not authenticated.
=back
=head1 TODO
Here's a list of what I think needs working on, in no particular order.
Please feel free to add to or re-arrange this list :)
=over
=item Fix extension documentation
=item Document all this stuff.
=item Examples of use / customisation in documentation
=item Fixing one uninitialized value warning in LoginRedirect
=item Disable the use of NeedsLogin ActionRole when WithRedirect is not loaded
=back
=head1 SOURCE CODE
http://github.com/bobtfish/catalystx-simplelogin/tree/master
git://github.com/bobtfish/catalystx-simplelogin.git
Forks and patches are welcome. #formhandler or #catalyst (irc.perl.org)
are both good places to ask about using or developing this code.
=head1 SEE ALSO
=over
=item *
L
=item *
L and L
=item *
L - Actions composed from L.
=item *
L - Injects the controller class
=item *
L - Generates the login form
=item *
L - Responsible for the actual heavy lifting of authenticating the user
=item *
L
=item *
L - Allows you to decorate actions with roles (E.g L)
=item *
L - Allows L to be composed onto components from config
=back
=head1 AUTHORS
=over
=item Tomas Doran (t0m) C<< bobtfish@bobtfish.net >>
=item Zbigniew Lukasiak
=item Stephan Jauernick (stephan48) C<< stephan@stejau.de >>
=item Gerda Shank (gshank) C<< gshank@cpan.org >>
=item Florian Ragwitz C<< rafl@debian.org >>
=item Shlomi Fish
=item Oleg Kostyuk (cub-uanic) C<< cub@cpan.org >>
=back
=head1 LICENSE
Copyright 2009 Tomas Doran. Some rights reserved.
This software is free software, and is licensed under the same terms as perl itself.
=cut
1;
CatalystX-SimpleLogin-0.20/lib/Catalyst/ 0000755 0001750 0001750 00000000000 13120307403 020250 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/Catalyst/ActionRole/ 0000755 0001750 0001750 00000000000 13120307403 022307 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/lib/Catalyst/ActionRole/NeedsLogin.pm 0000644 0001750 0001750 00000004104 12651666547 024724 0 ustar ahartmai ahartmai package Catalyst::ActionRole::NeedsLogin;
use Moose::Role;
use namespace::autoclean;
around execute => sub {
my $orig = shift;
my $self = shift;
my ($controller, $c, @args) = @_;
if (!$c->user) {
my $message = ($self->attributes->{LoginRedirectMessage}[0])
? $self->attributes->{LoginRedirectMessage}[0]
:'You need to login to view this page!';
$c->controller('Login')->login_redirect($c, $message, @args);
$c->detach;
}
else {
return $self->$orig(@_);
}
};
1;
__END__
=head1 NAME
Catalyst::ActionRole::NeedsLogin - checks if a user is logged in and if not redirects him to login page
=head1 SYNOPSIS
package MyApp::Controller::NeedsAuth;
use Moose;
use namespace::autoclean;
# One needs to inherit from Catalyst::Controller in order
# to get the Does('NeedsLogin') functionality.
BEGIN { extends 'Catalyst::Controller'; }
sub inbox : Path Does('NeedsLogin') {
# Redirects to /login if not logged in
my ($self, $c) = @_;
$c->stash->{template} = "inbox.tt2";
return;
}
sub inbox : Path Does('NeedsLogin') :LoginRedirectMessage('Your custom Message') {
# Redirects to /login if not logged in-
}
# Turn on in config
MyApp->config('Contoller::Login' => { traits => ['WithRedirect'] });
=head1 DESCRIPTION
Provides a ActionRole for forcing the user to login.
=head1 WRAPPED METHODS
=head2 execute
If there is no logged-in user, call the login_redirect() method in the
C<'Login'> controller with the Catalyst context object, $c, and the
message specified by the C<:LoginRedirectMessage('Message here')> method
attribute (see the synopsis).
If there is a user logged-in (i.e: C<< $c->user >> is true), execute the body
of the action as it is.
=head1 SEE ALSO
=over
=item L
=item L
=item L
=back
=head1 AUTHORS
See L for authors.
=head1 LICENSE
See L for license.
=cut
CatalystX-SimpleLogin-0.20/inc/ 0000755 0001750 0001750 00000000000 13120307403 016467 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/inc/Module/ 0000755 0001750 0001750 00000000000 13120307403 017714 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/inc/Module/Install/ 0000755 0001750 0001750 00000000000 13120307403 021322 5 ustar ahartmai ahartmai CatalystX-SimpleLogin-0.20/inc/Module/Install/WriteAll.pm 0000644 0001750 0001750 00000002376 13120307400 023410 0 ustar ahartmai ahartmai #line 1
package Module::Install::WriteAll;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@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;
CatalystX-SimpleLogin-0.20/inc/Module/Install/Can.pm 0000644 0001750 0001750 00000006405 13120307400 022363 0 ustar ahartmai ahartmai #line 1
package Module::Install::Can;
use strict;
use Config ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@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 '';
require File::Spec;
my $abs = File::Spec->catfile($dir, $cmd);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
# Can our C compiler environment build XS files
sub can_xs {
my $self = shift;
# Ensure we have the CBuilder module
$self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
# Do we have the configure_requires checker?
local $@;
eval "require ExtUtils::CBuilder;";
if ( $@ ) {
# They don't obey configure_requires, so it is
# someone old and delicate. Try to avoid hurting
# them by falling back to an older simpler test.
return $self->can_cc();
}
# Do we have a working C compiler
my $builder = ExtUtils::CBuilder->new(
quiet => 1,
);
unless ( $builder->have_compiler ) {
# No working C compiler
return 0;
}
# Write a C file representative of what XS becomes
require File::Temp;
my ( $FH, $tmpfile ) = File::Temp::tempfile(
"compilexs-XXXXX",
SUFFIX => '.c',
);
binmode $FH;
print $FH <<'END_C';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
int main(int argc, char **argv) {
return 0;
}
int boot_sanexs() {
return 1;
}
END_C
close $FH;
# Can the C compiler access the same headers XS does
my @libs = ();
my $object = undef;
eval {
local $^W = 0;
$object = $builder->compile(
source => $tmpfile,
);
@libs = $builder->link(
objects => $object,
module_name => 'sanexs',
);
};
my $result = $@ ? 0 : 1;
# Clean up all the build files
foreach ( $tmpfile, $object, @libs ) {
next unless defined $_;
1 while unlink;
}
return $result;
}
# Can we locate a (the) C compiler
sub can_cc {
my $self = shift;
if ($^O eq 'VMS') {
require ExtUtils::CBuilder;
my $builder = ExtUtils::CBuilder->new(
quiet => 1,
);
return $builder->have_compiler;
}
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 245
CatalystX-SimpleLogin-0.20/inc/Module/Install/Makefile.pm 0000644 0001750 0001750 00000027437 13120307400 023407 0 ustar ahartmai ahartmai #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 = '1.18';
@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-separated 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 ) {
# This previous attempted to inherit the version of
# ExtUtils::MakeMaker in use by the module author, but this
# was found to be untenable as some authors build releases
# using future dev versions of EU:MM that nobody else has.
# Instead, #toolchain suggests we use 6.59 which is the most
# stable version on CPAN at time of writing and is, to quote
# ribasushi, "not terminally fucked, > and tested enough".
# TODO: We will now need to maintain this over time to push
# the version up as new versions are released.
$self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
} 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.36 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# 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
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 544
CatalystX-SimpleLogin-0.20/inc/Module/Install/AutoInstall.pm 0000644 0001750 0001750 00000004162 13120307400 024117 0 ustar ahartmai ahartmai #line 1
package Module::Install::AutoInstall;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@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 @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
while (my ($mod, $ver) = splice(@configure_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 installdeps_target {
my ($self, @args) = @_;
$self->include('Module::AutoInstall');
require Module::AutoInstall;
Module::AutoInstall::_installdeps_target(1);
$self->auto_install(@args);
}
sub auto_install_now {
my $self = shift;
$self->auto_install(@_);
Module::AutoInstall::do_install();
}
1;
CatalystX-SimpleLogin-0.20/inc/Module/Install/Base.pm 0000644 0001750 0001750 00000002147 13120307400 022533 0 ustar ahartmai ahartmai #line 1
package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.18';
}
# 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
CatalystX-SimpleLogin-0.20/inc/Module/Install/Metadata.pm 0000644 0001750 0001750 00000043302 13120307400 023377 0 ustar ahartmai ahartmai #line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@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;
my $value = @_ ? shift : 1;
if ( $self->{values}->{dynamic_config} ) {
# Once dynamic we never change to static, for safety
return 0;
}
$self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
# Convenience command
sub static_config {
shift->dynamic_config(0);
}
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 really 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 2\.0' => 'artistic_2', 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<(
https?\Q://rt.cpan.org/\E[^>]+|
https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
https?\Q://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+(v?[\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 hashes
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;
CatalystX-SimpleLogin-0.20/inc/Module/Install/AuthorTests.pm 0000644 0001750 0001750 00000002215 13120307400 024142 0 ustar ahartmai ahartmai #line 1
package Module::Install::AuthorTests;
use 5.005;
use strict;
use Module::Install::Base;
use Carp ();
#line 16
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.002';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
#line 42
sub author_tests {
my ($self, @dirs) = @_;
_add_author_tests($self, \@dirs, 0);
}
#line 56
sub recursive_author_tests {
my ($self, @dirs) = @_;
_add_author_tests($self, \@dirs, 1);
}
sub _wanted {
my $href = shift;
sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
}
sub _add_author_tests {
my ($self, $dirs, $recurse) = @_;
return unless $Module::Install::AUTHOR;
my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
# XXX: pick a default, later -- rjbs, 2008-02-24
my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
@dirs = grep { -d } @dirs;
if ($recurse) {
require File::Find;
my %test_dir;
File::Find::find(_wanted(\%test_dir), @dirs);
$self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
} else {
$self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
}
}
#line 107
1;
CatalystX-SimpleLogin-0.20/inc/Module/Install/AuthorRequires.pm 0000644 0001750 0001750 00000001131 13120307400 024633 0 ustar ahartmai ahartmai #line 1
use strict;
use warnings;
package Module::Install::AuthorRequires;
use base 'Module::Install::Base';
# cargo cult
BEGIN {
our $VERSION = '0.02';
our $ISCORE = 1;
}
sub author_requires {
my $self = shift;
return $self->{values}->{author_requires}
unless @_;
my @added;
while (@_) {
my $mod = shift or last;
my $version = shift || 0;
push @added, [$mod => $version];
}
push @{ $self->{values}->{author_requires} }, @added;
$self->admin->author_requires(@added);
return map { @$_ } @added;
}
1;
__END__
#line 92
CatalystX-SimpleLogin-0.20/inc/Module/Install/Fetch.pm 0000644 0001750 0001750 00000004627 13120307400 022717 0 ustar ahartmai ahartmai #line 1
package Module::Install::Fetch;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@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;
CatalystX-SimpleLogin-0.20/inc/Module/Install/Win32.pm 0000644 0001750 0001750 00000003403 13120307400 022557 0 ustar ahartmai ahartmai #line 1
package Module::Install::Win32;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@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;
CatalystX-SimpleLogin-0.20/inc/Module/Install/Include.pm 0000644 0001750 0001750 00000001015 13120307400 023235 0 ustar ahartmai ahartmai #line 1
package Module::Install::Include;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@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;
CatalystX-SimpleLogin-0.20/inc/Module/Install.pm 0000644 0001750 0001750 00000027145 13120307400 021666 0 ustar ahartmai ahartmai #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.006;
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 = '1.18';
# 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::getcwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::getcwd();
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'};
{
# to suppress the redefine warning
local $SIG{__WARN__} = sub {};
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::getcwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
$base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS';
$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( {no_chdir => 1, wanted => 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($File::Find::name);
my $in_pod = 0;
foreach ( split /\n/, $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;
}
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
binmode FH;
my $string = do { local $/; };
close FH or die "close($_[0]): $!";
return $string;
}
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;
}
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
# _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($_[1]) <=> _version($_[2]);
}
# 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 - 2012 Adam Kennedy.
CatalystX-SimpleLogin-0.20/inc/Module/AutoInstall.pm 0000644 0001750 0001750 00000062311 13120307400 022511 0 ustar ahartmai ahartmai #line 1
package Module::AutoInstall;
use strict;
use Cwd ();
use File::Spec ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.18';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
my (
$Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
$UpgradeDeps
);
my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
$PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
$PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
# 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 _installdeps_target {
$InstallDepsTarget = 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 =~ /^--upgradedeps=(.*)$/ ) {
$UpgradeDeps = 1;
__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::getcwd();
$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 || $InstallDepsTarget;
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 compatibility
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 = _version_of($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 $InstallDepsTarget
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;
my $make = $Config::Config{make};
if ($InstallDepsTarget) {
print
"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
}
else {
print
"*** Dependencies will be installed the next time you type '$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 @_;
if ($ENV{PERL5_CPANM_IS_RUNNING}) {
return _running_under('cpanminus');
}
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, @modules_to_upgrade );
while (my ($pkg, $ver) = splice(@_, 0, 2)) {
# grep out those already installed
if (_version_cmp(_version_of($pkg), $ver) >= 0) {
push @installed, $pkg;
if ($UpgradeDeps) {
push @modules_to_upgrade, $pkg, $ver;
}
}
else {
push @modules, $pkg, $ver;
}
}
if ($UpgradeDeps) {
push @modules, @modules_to_upgrade;
@installed = ();
@modules_to_upgrade = ();
}
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( _version_of($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";
}
push @config, 'prereqs', $value;
} elsif ( $key eq 'force' ) {
push @config, $key, $value;
} elsif ( $key eq 'notest' ) {
push @config, 'skiptest', $value;
} 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|notest)$/; # pseudo-option
$CPAN::Config->{$opt} = $opt eq 'urllist' ? [$arg] : $arg;
}
if ($args{notest} && (not CPAN::Shell->can('notest'))) {
die "Your version of CPAN is too old to support the 'notest' pragma";
}
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 = do {
if ($args{force}) {
CPAN::Shell->force( install => $pkg )
} elsif ($args{notest}) {
CPAN::Shell->notest( install => $pkg )
} else {
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::getcwd() );
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( _version_of($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; # method/function doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
# report version without loading a module
sub _version_of {
my $mod = pop; # method/function doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
foreach my $dir ( @INC ) {
next if ref $dir;
my $path = File::Spec->catfile($dir, $file);
next unless -e $path;
require ExtUtils::MM_Unix;
return ExtUtils::MM_Unix->parse_version($path);
}
return undef;
}
# 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)"
);
my $deps_list = join( ',', @Missing, @Existing );
$PostambleActionsUpgradeDeps =
"\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
my $config_notest =
join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
'notest', 1 )
if $Config;
$PostambleActionsNoTest = (
($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
$PostambleActionsUpgradeDepsNoTest =
"\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
$PostambleActionsListDeps =
'@$(PERL) -le "print for @ARGV" '
. join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
my @all = (@Missing, @Existing);
$PostambleActionsListAllDeps =
'@$(PERL) -le "print for @ARGV" '
. join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
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;
my $fragment;
$fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
config :: installdeps
\t\$(NOECHO) \$(NOOP)
AUTO_INSTALL
$fragment .= <<"END_MAKE";
checkdeps ::
\t\$(PERL) $0 --checkdeps
installdeps ::
\t$PostambleActions
installdeps_notest ::
\t$PostambleActionsNoTest
upgradedeps ::
\t$PostambleActionsUpgradeDeps
upgradedeps_notest ::
\t$PostambleActionsUpgradeDepsNoTest
listdeps ::
\t$PostambleActionsListDeps
listalldeps ::
\t$PostambleActionsListAllDeps
END_MAKE
return $fragment;
}
1;
__END__
#line 1197
CatalystX-SimpleLogin-0.20/.gitignore 0000644 0001750 0001750 00000000237 12651666547 017741 0 ustar ahartmai ahartmai MYMETA.*
MANIFEST.bak
*.swp
cover_db
META.yml
Makefile
blib
inc
pm_to_blib
MANIFEST
Makefile.old
README
CatalystX-SimpleLogin-*
t/lib/TestAppDBIC/testdbic.db
CatalystX-SimpleLogin-0.20/Makefile.PL 0000644 0001750 0001750 00000003425 13120305560 017676 0 ustar ahartmai ahartmai use strict;
use warnings;
use inc::Module::Install 0.91;
use Module::Install::AuthorTests;
use Module::Install::AuthorRequires;
name 'CatalystX-SimpleLogin';
all_from 'lib/CatalystX/SimpleLogin.pm';
requires 'Moose';
requires 'Catalyst::Runtime' => '5.80013';
requires 'MooseX::MethodAttributes' => '0.18';
requires 'Catalyst::Action::REST' => '0.74';
requires 'Catalyst::Plugin::Authentication';
requires 'Catalyst::View::TT';
requires 'CatalystX::InjectComponent';
requires 'CatalystX::Component::Traits' => '0.13';
requires 'MooseX::Types::Common';
requires 'MooseX::Types';
requires 'MooseX::RelatedClassRoles' => '0.004';
requires 'HTML::FormHandler' => '0.28001';
requires 'namespace::autoclean';
requires 'Catalyst::Plugin::Session' => '0.35'; # Required as we use the 'Plugin::Session' config key in ::Manual
requires 'Try::Tiny' => '0.24';
test_requires 'Test::More' => '0.94';
test_requires 'Class::Load' => '0.20';
test_requires 'Test::Exception';
test_requires 'File::Temp';
test_requires 'Catalyst::Action::RenderView';
test_requires 'Catalyst::Plugin::Session::State::Cookie';
test_requires 'HTTP::Request::Common';
test_requires 'Catalyst::ActionRole::ACL';
test_requires 'CatalystX::InjectComponent';
test_requires 'SQL::Translator';
author_requires 'Test::EOL' => '0.3';
author_requires 'Test::NoTabs';
author_requires 'Test::Pod' => '1.14';
author_requires 'Test::Pod::Coverage' => '1.08';
author_requires 'Catalyst::Model::DBIC::Schema';
author_requires 'Catalyst::Authentication::Store::DBIx::Class';
license 'perl';
resources repository => 'git://github.com/bobtfish/catalystx-simplelogin.git';
tests 't/*.t';
author_tests 't/author';
if ($Module::Install::AUTHOR) {
system("pod2text lib/CatalystX/SimpleLogin.pm > README") and die;
}
auto_install;
auto_provides;
WriteAll();
CatalystX-SimpleLogin-0.20/MANIFEST 0000644 0001750 0001750 00000004646 13120307403 017061 0 ustar ahartmai ahartmai .gitignore
Changes
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AuthorRequires.pm
inc/Module/Install/AuthorTests.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/ActionRole/NeedsLogin.pm
lib/CatalystX/SimpleLogin.pm
lib/CatalystX/SimpleLogin/Controller/Login.pm
lib/CatalystX/SimpleLogin/Form/Login.pm
lib/CatalystX/SimpleLogin/Form/LoginOpenID.pm
lib/CatalystX/SimpleLogin/Manual.pod
lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/Logout.pm
lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/OpenID.pm
lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/RenderAsTTTemplate.pm
lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/WithRedirect.pm
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
META.yml
README
t/00-load.t
t/01-live-test.t
t/02-redirect-test.t
t/03-login-form.t
t/04-test-role-apply-order.t
t/05-login-redirect-custom-message.t
t/06-rendertt.t
t/07-openid-live.t
t/08-dbic-mappedfields.t
t/09-clearsession.t
t/10-form-args.t
t/author/eol.t
t/author/notabs.t
t/author/pod-coverage.t
t/author/pod.t
t/chained_parts.t
t/lib/Catalyst/Authentication/Credential/MockOpenID.pm
t/lib/script/testapp_server.pl
t/lib/TestApp.pm
t/lib/TestApp/Controller/ChainedExample.pm
t/lib/TestApp/Controller/NeedsAuth.pm
t/lib/TestApp/root/chainedexample/index.tt
t/lib/TestApp/root/chainedexample/item.tt
t/lib/TestApp/root/chainedexample/public.tt
t/lib/TestApp/root/login/login.tt
t/lib/TestAppBase.pm
t/lib/TestAppBase/Controller/Root.pm
t/lib/TestAppBase/root/index.tt
t/lib/TestAppBase/root/wrapper.tt
t/lib/TestAppBase/Script/Server.pm
t/lib/TestAppBase/View/HTML.pm
t/lib/TestAppClearSession.pm
t/lib/TestAppClearSession/Controller/Root.pm
t/lib/TestAppClearSession/root/login/login.tt
t/lib/TestAppDBIC.pm
t/lib/TestAppDBIC/Controller/Root.pm
t/lib/TestAppDBIC/Model/DB.pm
t/lib/TestAppDBIC/Schema.pm
t/lib/TestAppDBIC/Schema/Result/User.pm
t/lib/TestAppDBIC/View/HTML.pm
t/lib/TestAppFormArgs.pm
t/lib/TestAppFormArgs/Controller/NeedsAuth.pm
t/lib/TestAppFormArgs/root/login/login.tt
t/lib/TestAppOpenID.pm
t/lib/TestAppOpenID/.exists
t/lib/TestAppRedirect.pm
t/lib/TestAppRedirect/Controller/Root.pm
t/lib/TestAppRedirect/root/login/login.tt
t/lib/TestAppRenderTT.pm
t/lib/TestAppRenderTT/.exists
CatalystX-SimpleLogin-0.20/MANIFEST.SKIP 0000644 0001750 0001750 00000000246 12651666547 017647 0 ustar ahartmai ahartmai ^MYMETA\.
^t/lib/TestAppDBIC/testdbic.db$
\..*.swp
^TODO
.git/
blib
pm_to_blib
MANIFEST.bak
MANIFEST.SKIP~
cover_db
Makefile$
Makefile.old$
^CatalystX-SimpleLogin-.*
CatalystX-SimpleLogin-0.20/META.yml 0000644 0001750 0001750 00000002417 13120307400 017170 0 ustar ahartmai ahartmai ---
abstract: 'Provide a simple Login controller which can be reused'
author:
- =over
build_requires:
Catalyst::Action::RenderView: 0
Catalyst::ActionRole::ACL: 0
Catalyst::Plugin::Session::State::Cookie: 0
CatalystX::InjectComponent: 0
Class::Load: '0.20'
ExtUtils::MakeMaker: 6.36
File::Temp: 0
HTTP::Request::Common: 0
SQL::Translator: 0
Test::Exception: 0
Test::More: '0.94'
configure_requires:
ExtUtils::MakeMaker: 6.36
distribution_type: module
dynamic_config: 1
generated_by: 'Module::Install version 1.18'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: CatalystX-SimpleLogin
no_index:
directory:
- inc
- t
requires:
Catalyst::Action::REST: '0.74'
Catalyst::Plugin::Authentication: 0
Catalyst::Plugin::Session: '0.35'
Catalyst::Runtime: '5.80013'
Catalyst::View::TT: 0
CatalystX::Component::Traits: '0.13'
CatalystX::InjectComponent: 0
HTML::FormHandler: '0.28001'
Moose: 0
MooseX::MethodAttributes: '0.18'
MooseX::RelatedClassRoles: '0.004'
MooseX::Types: 0
MooseX::Types::Common: 0
Try::Tiny: '0.24'
namespace::autoclean: 0
resources:
license: http://dev.perl.org/licenses/
repository: git://github.com/bobtfish/catalystx-simplelogin.git
version: '0.20'
CatalystX-SimpleLogin-0.20/README 0000644 0001750 0001750 00000012125 13120307400 016574 0 ustar ahartmai ahartmai NAME
CatalystX::SimpleLogin - Provide a simple Login controller which can be
reused
SYNOPSIS
package MyApp;
use Moose;
use namespace::autoclean;
use Catalyst qw/
+CatalystX::SimpleLogin
Authentication
Session
Session::State::Cookie
Session::Store::File
/;
extends 'Catalyst';
__PACKAGE__->config(
'Plugin::Authentication' => { # Auth config here }
);
__PACKAGE__->config(
'Controller::Login' => { # SimpleLogin config here }
);
__PACKAGE__->setup;
ATTENTION!
If you're new here, you should start by reading
CatalystX::SimpleLogin::Manual, which provides a gentler introduction to
using this code. Come back here when you're done there.
DESCRIPTION
CatalystX::SimpleLogin is an application class Moose::Role which will
inject a Catalyst::Controller which is an instance of
CatalystX::SimpleLogin::Controller::Login into your application. This
provides a simple login and logout page with the addition of only one
line of code and one template to your application.
REQUIREMENTS
A Catalyst application
Working authentication configuration
Working session configuration
A view
CUSTOMISATION
CatalystX::SimpleLogin is a prototype for CatalystX::Elements. As such,
one of the goals is to make it easy for users to customise the provided
component to the maximum degree possible, and also, to have a linear
relationship between effort invested and level of customisation
achieved.
Three traits are shipped with SimpleLogin: WithRedirect, Logout, and
RenderAsTTTemplate. These traits are set in the config:
__PACKAGE__->config(
'Controller::Login' => {
traits => [qw/ Logout WithRedirect RenderAsTTTemplate /],
login_form_args => { # see the login form },
);
COMPONENTS
* CatalystX::SimpleLogin::Controller::Login - first point of call for
customisation. Override the action configs to reconfigure the paths
of the login or logout actions. Subclass to be able to apply method
modifiers to run before / after the login or logout actions or
override methods.
* CatalystX::SimpleLogin::TraitFor::Controller::Login::Logout -
provides the "logout" action and associated methods. You can compose
this manually yourself if you want just that action.
This trait is set by default, but if you set another trait in your
config, you will have to include it.
* CatalystX::SimpleLogin::TraitFor::Controller::Login::WithRedirect -
provides the "login" action with a wrapper to redirect to a page
which needs authentication, from which the user was previously
redirected. Goes hand in hand with Catalyst::ActionRole::NeedsLogin
* CatalystX::SimpleLogin::TraitFor::Controller::Login::RenderAsTTTempl
ate - sets the stash variable 'template' to point to a string
reference containing the rendered template so that it's not
necessary to have a login.tt template file.
* CatalystX::SimpleLogin::Form::Login - the HTML::FormHandler form for
the login form.
* Catalyst::ActionRole::NeedsLogin - Used to cause a specific path to
redirect to the login page if a user is not authenticated.
TODO
Here's a list of what I think needs working on, in no particular order.
Please feel free to add to or re-arrange this list :)
Fix extension documentation
Document all this stuff.
Examples of use / customisation in documentation
Fixing one uninitialized value warning in LoginRedirect
Disable the use of NeedsLogin ActionRole when WithRedirect is not loaded
SOURCE CODE
http://github.com/bobtfish/catalystx-simplelogin/tree/master
git://github.com/bobtfish/catalystx-simplelogin.git
Forks and patches are welcome. #formhandler or #catalyst (irc.perl.org)
are both good places to ask about using or developing this code.
SEE ALSO
* Catalyst
* Moose and Moose::Role
* MooseX::MethodAttributes::Role - Actions composed from Moose::Role.
* CatalystX::InjectComponent - Injects the controller class
* HTML::FormHandler - Generates the login form
* Catalyst::Plugin::Authentication - Responsible for the actual heavy
lifting of authenticating the user
* Catalyst::Plugin::Session
* Catalyst::Controller - Allows you to decorate actions with roles
(E.g Catalyst::ActionRole::NeedsLogin)
* CatalystX::Component::Traits - Allows Moose::Role to be composed
onto components from config
AUTHORS
Tomas Doran (t0m) "bobtfish@bobtfish.net"
Zbigniew Lukasiak
Stephan Jauernick (stephan48) "stephan@stejau.de"
Gerda Shank (gshank) "gshank@cpan.org"
Florian Ragwitz "rafl@debian.org"
Shlomi Fish
Oleg Kostyuk (cub-uanic) "cub@cpan.org"
LICENSE
Copyright 2009 Tomas Doran. Some rights reserved.
This software is free software, and is licensed under the same terms as
perl itself.