CatalystX-SimpleLogin-0.21/0000755000175000017500000000000013770352561015737 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/0000755000175000017500000000000013770352561016505 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/CatalystX/0000755000175000017500000000000013770352561020421 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/CatalystX/SimpleLogin/0000755000175000017500000000000013770352561022643 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/CatalystX/SimpleLogin/TraitFor/0000755000175000017500000000000013770352561024375 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/CatalystX/SimpleLogin/TraitFor/Controller/0000755000175000017500000000000013770352561026520 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/0000755000175000017500000000000013770352561027570 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/Logout.pm0000644000175000017500000000416312651666547031414 0ustar ahartmaiahartmaipackage 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.21/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/OpenID.pm0000644000175000017500000000353612651666547031264 0ustar ahartmaiahartmaipackage 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.21/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/WithRedirect.pm0000644000175000017500000000435113120305560032510 0ustar ahartmaiahartmaipackage 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.21/lib/CatalystX/SimpleLogin/TraitFor/Controller/Login/RenderAsTTTemplate.pm0000644000175000017500000000176312651666547033615 0ustar ahartmaiahartmaipackage 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.21/lib/CatalystX/SimpleLogin/Manual.pod0000644000175000017500000001635112651666547024603 0ustar ahartmaiahartmai=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.21/lib/CatalystX/SimpleLogin/Form/0000755000175000017500000000000013770352561023546 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/CatalystX/SimpleLogin/Form/Login.pm0000644000175000017500000001057012651705736025162 0ustar ahartmaiahartmaipackage 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.21/lib/CatalystX/SimpleLogin/Form/LoginOpenID.pm0000644000175000017500000000265612651666547026235 0ustar ahartmaiahartmaipackage 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.21/lib/CatalystX/SimpleLogin/Controller/0000755000175000017500000000000013770352561024766 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/CatalystX/SimpleLogin/Controller/Login.pm0000644000175000017500000001670513120305560026367 0ustar ahartmaiahartmaipackage 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.21/lib/CatalystX/SimpleLogin.pm0000644000175000017500000001274213770352447023212 0ustar ahartmaiahartmaipackage CatalystX::SimpleLogin; use Moose::Role; use CatalystX::InjectComponent; use namespace::autoclean; our $VERSION = '0.21'; 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.21/lib/Catalyst/0000755000175000017500000000000013770352561020271 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/Catalyst/ActionRole/0000755000175000017500000000000013770352561022330 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/lib/Catalyst/ActionRole/NeedsLogin.pm0000644000175000017500000000410412651666547024725 0ustar ahartmaiahartmaipackage 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.21/t/0000755000175000017500000000000013770352561016202 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/0000755000175000017500000000000013770352561016750 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC.pm0000644000175000017500000000151212651666547021320 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppRedirect/0000755000175000017500000000000013770352561022012 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppRedirect/root/0000755000175000017500000000000013770352561022775 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppRedirect/root/login/0000755000175000017500000000000013770352561024105 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppRedirect/root/login/login.tt0000644000175000017500000000003012651666547025570 0ustar ahartmaiahartmai[% render_login_form %] CatalystX-SimpleLogin-0.21/t/lib/TestAppRedirect/Controller/0000755000175000017500000000000013770352561024135 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppRedirect/Controller/Root.pm0000644000175000017500000000256412651666547025436 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppDBIC/0000755000175000017500000000000013770352561020752 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/Schema.pm0000644000175000017500000000017412651666547022523 0ustar ahartmaiahartmaipackage TestAppDBIC::Schema; use strict; use warnings; use base 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces; 1; CatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/View/0000755000175000017500000000000013770352561021664 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/View/HTML.pm0000644000175000017500000000015612651666547023001 0ustar ahartmaiahartmaipackage TestAppDBIC::View::HTML; use Moose; use namespace::autoclean; extends 'TestAppBase::View::HTML'; 1; CatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/Controller/0000755000175000017500000000000013770352561023075 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/Controller/Root.pm0000644000175000017500000000024312651666547024366 0ustar ahartmaiahartmaipackage TestAppDBIC::Controller::Root; use Moose; use namespace::autoclean; BEGIN { extends 'TestAppBase::Controller::Root' } __PACKAGE__->meta->make_immutable; CatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/Model/0000755000175000017500000000000013770352561022012 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/Model/DB.pm0000644000175000017500000000025412651666547022647 0ustar ahartmaiahartmaipackage TestAppDBIC::Model::DB; use strict; use warnings; use base 'Catalyst::Model::DBIC::Schema'; __PACKAGE__->config( schema_class => 'TestAppDBIC::Schema', ); 1; CatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/Schema/0000755000175000017500000000000013770352561022152 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/Schema/Result/0000755000175000017500000000000013770352561023430 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppDBIC/Schema/Result/User.pm0000644000175000017500000000070212651666547024714 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestApp/0000755000175000017500000000000013770352561020330 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestApp/Controller/0000755000175000017500000000000013770352561022453 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestApp/Controller/ChainedExample.pm0000644000175000017500000000124412651666547025672 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestApp/Controller/NeedsAuth.pm0000644000175000017500000000043712651666547024706 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestApp/root/0000755000175000017500000000000013770352561021313 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestApp/root/chainedexample/0000755000175000017500000000000013770352561024262 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestApp/root/chainedexample/item.tt0000644000175000017500000000043312651666547025602 0ustar ahartmaiahartmai[% 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.21/t/lib/TestApp/root/chainedexample/index.tt0000644000175000017500000000003112651666547025745 0ustar ahartmaiahartmaiWelcome [% c.user.id %]. CatalystX-SimpleLogin-0.21/t/lib/TestApp/root/chainedexample/public.tt0000644000175000017500000000002412651666547026116 0ustar ahartmaiahartmaiThis page is public.CatalystX-SimpleLogin-0.21/t/lib/TestApp/root/login/0000755000175000017500000000000013770352561022423 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestApp/root/login/login.tt0000644000175000017500000000003012651666547024106 0ustar ahartmaiahartmai[% render_login_form %] CatalystX-SimpleLogin-0.21/t/lib/TestAppOpenID/0000755000175000017500000000000013770352561021367 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppOpenID/.exists0000644000175000017500000000006312651666547022717 0ustar ahartmaiahartmai# Must be here for Catalyst home detection to work CatalystX-SimpleLogin-0.21/t/lib/TestAppRenderTT.pm0000644000175000017500000000035212651666547022307 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestApp.pm0000644000175000017500000000044012651666547020675 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppBase/0000755000175000017500000000000013770352561021123 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppBase/root/0000755000175000017500000000000013770352561022106 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppBase/root/index.tt0000644000175000017500000000005412651666547023576 0ustar ahartmaiahartmaiIt works. [% IF c.user %]Logged in[% END %] CatalystX-SimpleLogin-0.21/t/lib/TestAppBase/root/wrapper.tt0000644000175000017500000000012212651666547024143 0ustar ahartmaiahartmai [% error_msg || c.flash.error_msg %] [% content %] CatalystX-SimpleLogin-0.21/t/lib/TestAppBase/View/0000755000175000017500000000000013770352561022035 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppBase/View/HTML.pm0000644000175000017500000000027712651666547023156 0ustar ahartmaiahartmaipackage TestAppBase::View::HTML; use Moose; use namespace::autoclean; extends 'Catalyst::View::TT'; __PACKAGE__->config( WRAPPER => 'wrapper.tt', TEMPLATE_EXTENSION => '.tt', ); 1;CatalystX-SimpleLogin-0.21/t/lib/TestAppBase/Controller/0000755000175000017500000000000013770352561023246 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppBase/Controller/Root.pm0000644000175000017500000000064312651666547024543 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppBase/Script/0000755000175000017500000000000013770352561022367 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppBase/Script/Server.pm0000644000175000017500000000143512651666547024207 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppFormArgs/0000755000175000017500000000000013770352561021771 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppFormArgs/root/0000755000175000017500000000000013770352561022754 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppFormArgs/root/login/0000755000175000017500000000000013770352561024064 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppFormArgs/root/login/login.tt0000644000175000017500000000003012651666547025547 0ustar ahartmaiahartmai[% render_login_form %] CatalystX-SimpleLogin-0.21/t/lib/TestAppFormArgs/Controller/0000755000175000017500000000000013770352561024114 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppFormArgs/Controller/NeedsAuth.pm0000644000175000017500000000044712651666547026350 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppFormArgs.pm0000644000175000017500000000077612651666547022352 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppClearSession.pm0000644000175000017500000000042212651666547023210 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppRenderTT/0000755000175000017500000000000013770352561021740 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppRenderTT/.exists0000644000175000017500000000006312651666547023270 0ustar ahartmaiahartmai# Must be here for Catalyst home detection to work CatalystX-SimpleLogin-0.21/t/lib/Catalyst/0000755000175000017500000000000013770352561020534 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/Catalyst/Authentication/0000755000175000017500000000000013770352561023513 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/Catalyst/Authentication/Credential/0000755000175000017500000000000013770352561025565 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/Catalyst/Authentication/Credential/MockOpenID.pm0000644000175000017500000000170112651666547030063 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppBase.pm0000644000175000017500000000340312651666547021472 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppRedirect.pm0000644000175000017500000000041312651666547022357 0ustar ahartmaiahartmaipackage 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.21/t/lib/script/0000755000175000017500000000000013770352561020254 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/script/testapp_server.pl0000644000175000017500000000031012651666547023662 0ustar ahartmaiahartmai#!/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.21/t/lib/TestAppOpenID.pm0000644000175000017500000000073512651666547021743 0ustar ahartmaiahartmaipackage 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.21/t/lib/TestAppClearSession/0000755000175000017500000000000013770352561022643 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppClearSession/root/0000755000175000017500000000000013770352561023626 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppClearSession/root/login/0000755000175000017500000000000013770352561024736 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppClearSession/root/login/login.tt0000644000175000017500000000003012651666547026421 0ustar ahartmaiahartmai[% render_login_form %] CatalystX-SimpleLogin-0.21/t/lib/TestAppClearSession/Controller/0000755000175000017500000000000013770352561024766 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/lib/TestAppClearSession/Controller/Root.pm0000644000175000017500000000156012651666547026262 0ustar ahartmaiahartmai 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.21/t/07-openid-live.t0000644000175000017500000000222412651666547021037 0ustar ahartmaiahartmai#!/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.21/t/author/0000755000175000017500000000000013770352561017504 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/t/author/pod.t0000644000175000017500000000021412651666547020461 0ustar ahartmaiahartmai#!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.21/t/author/pod-coverage.t0000644000175000017500000000025212651666547022254 0ustar ahartmaiahartmai#!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.21/t/author/eol.t0000644000175000017500000000031212651666547020455 0ustar ahartmaiahartmai#!/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.21/t/author/notabs.t0000644000175000017500000000023212651666547021165 0ustar ahartmaiahartmai 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.21/t/01-live-test.t0000644000175000017500000000656112651666547020542 0ustar ahartmaiahartmai#!/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.21/t/chained_parts.t0000644000175000017500000000217212651666547021206 0ustar ahartmaiahartmai#!/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.21/t/02-redirect-test.t0000755000175000017500000000302212651666547021375 0ustar ahartmaiahartmai#!/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.21/t/05-login-redirect-custom-message.t0000644000175000017500000000115712651666547024467 0ustar ahartmaiahartmai#!/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.21/t/06-rendertt.t0000644000175000017500000000362312651666547020456 0ustar ahartmaiahartmai#!/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.21/t/10-form-args.t0000644000175000017500000000107712651666547020520 0ustar ahartmaiahartmai#!/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.21/t/09-clearsession.t0000644000175000017500000000536712651666547021333 0ustar ahartmaiahartmai#!/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.21/t/00-load.t0000644000175000017500000000027012651666547017533 0ustar ahartmaiahartmai#!/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.21/t/03-login-form.t0000644000175000017500000000200112651666547020662 0ustar ahartmaiahartmai#!/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.21/t/04-test-role-apply-order.t0000644000175000017500000000062212651666547022773 0ustar ahartmaiahartmai#!/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.21/t/08-dbic-mappedfields.t0000644000175000017500000000337212651666547022166 0ustar ahartmaiahartmaiuse 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.21/inc/0000755000175000017500000000000013770352561016510 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/inc/Module/0000755000175000017500000000000013770352561017735 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/inc/Module/Install/0000755000175000017500000000000013770352561021343 5ustar ahartmaiahartmaiCatalystX-SimpleLogin-0.21/inc/Module/Install/Win32.pm0000644000175000017500000000340313770352556022607 0ustar ahartmaiahartmai#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.19'; @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.21/inc/Module/Install/Fetch.pm0000644000175000017500000000462713770352556022747 0ustar ahartmaiahartmai#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.19'; @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.21/inc/Module/Install/WriteAll.pm0000644000175000017500000000237613770352556023440 0ustar ahartmaiahartmai#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.19'; @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.21/inc/Module/Install/Can.pm0000644000175000017500000000640513770352555022412 0ustar ahartmaiahartmai#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.19'; @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.21/inc/Module/Install/AuthorTests.pm0000644000175000017500000000221513770352555024171 0ustar ahartmaiahartmai#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.21/inc/Module/Install/Metadata.pm0000644000175000017500000004330213770352555023426 0ustar ahartmaiahartmai#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.19'; @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.21/inc/Module/Install/Base.pm0000644000175000017500000000214713770352555022562 0ustar ahartmaiahartmai#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.19'; } # 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.21/inc/Module/Install/Include.pm0000644000175000017500000000101513770352556023265 0ustar ahartmaiahartmai#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.19'; @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.21/inc/Module/Install/AuthorRequires.pm0000644000175000017500000000113113770352555024662 0ustar ahartmaiahartmai#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.21/inc/Module/Install/Makefile.pm0000644000175000017500000002743713770352555023436 0ustar ahartmaiahartmai#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.19'; @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.21/inc/Module/Install/AutoInstall.pm0000644000175000017500000000416213770352556024147 0ustar ahartmaiahartmai#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.19'; @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.21/inc/Module/AutoInstall.pm0000644000175000017500000006231113770352556022541 0ustar ahartmaiahartmai#line 1 package Module::AutoInstall; use strict; use Cwd (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.19'; } # 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.21/inc/Module/Install.pm0000644000175000017500000002714513770352555021715 0ustar ahartmaiahartmai#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.19'; # 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.21/META.yml0000644000175000017500000000252413770352556017217 0ustar ahartmaiahartmai--- 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.19' 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: bugtracker: https://github.com/bobtfish/catalystx-simplelogin/issues license: http://dev.perl.org/licenses/ repository: https://github.com/bobtfish/catalystx-simplelogin version: '0.21' CatalystX-SimpleLogin-0.21/.gitignore0000644000175000017500000000023712651666547017742 0ustar ahartmaiahartmaiMYMETA.* 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.21/README0000644000175000017500000001212513770352556016624 0ustar ahartmaiahartmaiNAME 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. CatalystX-SimpleLogin-0.21/Makefile.PL0000644000175000017500000000354713770352151017715 0ustar ahartmaiahartmaiuse 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 bugtracker => 'https://github.com/bobtfish/catalystx-simplelogin/issues'; resources repository => 'https://github.com/bobtfish/catalystx-simplelogin'; 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.21/Changes0000644000175000017500000001031613770352430017226 0ustar ahartmaiahartmai0.21 Tue, 22 December 2020 12:15:00 +0100 * Change bugtracker to github.com 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.21/MANIFEST.SKIP0000644000175000017500000000024612651666547017650 0ustar ahartmaiahartmai^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.21/MANIFEST0000644000175000017500000000464613770352561017102 0ustar ahartmaiahartmai.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