[Catalyst-commits] r8483 - / Catalyst-Helper-AuthDBIC/tags Catalyst-Helper-AuthDBIC/tags/0.06 Catalyst-Helper-AuthDBIC/tags/0.06/lib Catalyst-Helper-AuthDBIC/tags/0.06/lib/Catalyst Catalyst-Helper-AuthDBIC/tags/0.06/lib/Catalyst/Helper Catalyst-Helper-AuthDBIC/tags/0.06/script Catalyst-Helper-AuthDBIC/tags/0.06/t Catalyst-Helper-AuthDBIC/tags/0.06/t/lib Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Controller Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Model Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/db Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script

zarquon at dev.catalyst.perl.org zarquon at dev.catalyst.perl.org
Wed Oct 1 10:15:35 BST 2008


Author: zarquon
Date: 2008-10-01 10:15:35 +0100 (Wed, 01 Oct 2008)
New Revision: 8483

Added:
   Catalyst-Helper-AuthDBIC/tags/0.06/
   Catalyst-Helper-AuthDBIC/tags/0.06/.gitignore
   Catalyst-Helper-AuthDBIC/tags/0.06/Changes
   Catalyst-Helper-AuthDBIC/tags/0.06/MANIFEST.SKIP
   Catalyst-Helper-AuthDBIC/tags/0.06/Makefile.PL
   Catalyst-Helper-AuthDBIC/tags/0.06/README
   Catalyst-Helper-AuthDBIC/tags/0.06/lib/
   Catalyst-Helper-AuthDBIC/tags/0.06/lib/Catalyst/
   Catalyst-Helper-AuthDBIC/tags/0.06/lib/Catalyst/Helper/
   Catalyst-Helper-AuthDBIC/tags/0.06/lib/Catalyst/Helper/AuthDBIC.pm
   Catalyst-Helper-AuthDBIC/tags/0.06/script/
   Catalyst-Helper-AuthDBIC/tags/0.06/script/auth_bootstrap.pl
   Catalyst-Helper-AuthDBIC/tags/0.06/t/
   Catalyst-Helper-AuthDBIC/tags/0.06/t/00-load.t
   Catalyst-Helper-AuthDBIC/tags/0.06/t/01-functions.t
   Catalyst-Helper-AuthDBIC/tags/0.06/t/02-usage.t
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/Makefile.PL
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp.pm
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Controller/
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Controller/Root.pm
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Model/
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Model/.gitignore
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/db/
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/db/auth.db,"",""
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/db/auth.db,,
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_create.pl
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_server.pl
   Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_test.pl
   Catalyst-Helper-AuthDBIC/tags/0.06/t/live-test.t
   Catalyst-Helper-AuthDBIC/tags/0.06/t/pod-coverage.t
   Catalyst-Helper-AuthDBIC/tags/0.06/t/pod.t
Modified:
   /
Log:
 r14053 at zaphod:  kd | 2008-09-25 12:01:54 +1000
 version 0.06 tags



Property changes on: 
___________________________________________________________________
Name: svk:merge
   - 1b129c88-ebf4-0310-add9-f09427935aba:/local/catalyst:4278
1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst:14052
3b9770f9-e80c-0410-a7de-cd203d167417:/local/catalyst:3514
dd8ad9ea-0304-0410-a433-df5f223e7bc0:/local/Catalyst:6909
   + 1b129c88-ebf4-0310-add9-f09427935aba:/local/catalyst:4278
1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst:14053
3b9770f9-e80c-0410-a7de-cd203d167417:/local/catalyst:3514
dd8ad9ea-0304-0410-a433-df5f223e7bc0:/local/Catalyst:6909

Added: Catalyst-Helper-AuthDBIC/tags/0.06/.gitignore
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/.gitignore	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/.gitignore	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,10 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+Catalyst-Helper-AuthDBIC-*
+cover_db

Added: Catalyst-Helper-AuthDBIC/tags/0.06/Changes
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/Changes	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/Changes	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,19 @@
+0.06 September 24 2008
+     - Moved from DBIx::Class::DigestColumns to DBIx::Class::EncodedColumn
+     - Added option for password or http credentials.
+0.05 Tue Sep 2 2008
+     - Bug fix for Multi::Level::App::Names
+     - Addition of model config to .conf file
+     - Changed from CatalystX starter to Module::Starter proper (make
+       installdeps now works)
+0.04 Mon Sep 1  2008
+     - Another stupid bug removed in Schema creation for Multi::Level::AppNames
+0.03 Mon Sep 1  2008
+     - Remove the UNIVERSAL::require dep
+     - Fix app_name to do the right thing with Multi::Level::AppNames
+0.02 Sun Aug 31 2008
+     - Changed Auth::Schema to $appname::Auth::Schema
+     - Added user admin scripts to script/myapp_adduser.pl
+0.01 Wed Aug 20
+     - Initial very rough release
+

Added: Catalyst-Helper-AuthDBIC/tags/0.06/MANIFEST.SKIP
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/MANIFEST.SKIP	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/MANIFEST.SKIP	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,8 @@
+.git/
+blib
+pm_to_blib
+MANIFEST.bak
+MANIFEST.SKIP~
+cover_db
+Makefile$
+Makefile.old$

Added: Catalyst-Helper-AuthDBIC/tags/0.06/Makefile.PL
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/Makefile.PL	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/Makefile.PL	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,32 @@
+use inc::Module::Install;
+
+name     'Catalyst-Helper-AuthDBIC';
+all_from 'lib/Catalyst/Helper/AuthDBIC.pm';
+author   'Kieren Diment <zarquon at cpan.org>';
+
+build_requires 'Test::More';
+
+build_requires 'Catalyst::Runtime';
+build_requires 'ok';
+requires 'DBIx::Class::EncodedColumn';
+requires 'PPI';
+requires 'DBIx::Class::Schema::Loader';
+build_requires 'Directory::Scratch';
+build_requires 'Test::Command';
+
+# not real deps but the generated bits of app need them.
+requires 'Catalyst::Plugin::Authentication';
+requires 'Catalyst::Plugin::Authorization::Roles';
+requires 'Catalyst::Plugin::Session';
+requires 'Catalyst::Plugin::Session::State::Cookie';
+requires 'Catalyst::Plugin::Session::Store::FastMmap';
+requires 'Catalyst::Authentication::Store::DBIx::Class';
+requires 'Catalyst::Authentication::Credential::HTTP';
+
+install_script glob('script/*.pl');
+
+
+auto_install;
+
+WriteAll;
+

Added: Catalyst-Helper-AuthDBIC/tags/0.06/README
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/README	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/README	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,3 @@
+Helper to provide a simple authentication scaffold for a Catalyst
+application.  Run the script authdbic.pl in your application's root
+directory to create a simple database based authentication system.

Added: Catalyst-Helper-AuthDBIC/tags/0.06/lib/Catalyst/Helper/AuthDBIC.pm
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/lib/Catalyst/Helper/AuthDBIC.pm	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/lib/Catalyst/Helper/AuthDBIC.pm	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,577 @@
+package Catalyst::Helper::AuthDBIC;
+use strict;
+use warnings;
+use Catalyst::Helper;
+our $VERSION = '0.06';
+use Carp;
+use DBI;
+use DBIx::Class::Schema::Loader qw/ make_schema_at /;
+use Memoize;
+use PPI;
+use PPI::Find;
+use Catalyst::Utils;
+use File::Spec;
+use Config;
+
+memoize('app_name');
+
+=head1 NAME
+
+Catalyst::Helper::AuthDBIC (EXPERIMENTAL)
+
+=head1 SUMMARY
+
+This is an experimental module to bootstrap the authentication portion
+of a Catalyst application.  It creates a Catalyst model,
+DBIx::Class::Schema classes, basic templates adjusts the required
+plugins for you, and configures authentication.  There are no options,
+and it doesn't do much inthe way of error checking for you, so you are
+recommended to back up your application before using this module.
+
+=head2 USAGE
+
+Run the auth_bootstrap.pl in your application's root dir.
+
+The helper also creates a scriptin the script dir.  To add a user
+(with an optional role) do:
+
+ myapp_auth_admin.pl -user username -passwd password [-role role] [-email me at example.com]
+
+=head2 sub app_name()
+
+Get the name of the application from Makefile.PL
+
+=cut
+
+sub app_name {
+    my $app_name;
+    my $file = "Makefile.PL";
+    open my ($FH), "<", $file or croak "Makefile.PL not found, run this script from your application root dir\n";
+    while (<$FH>) {
+        next unless /^name '(.*?)';/;
+        $app_name=$1;
+        $app_name =~ s/-/::/g; # only unsafe if you are already insane
+                              # because everything else in
+                              # Catalyst::Helper will also be broken
+                              # for you.
+        croak "Makefile.PL appears to have no name for the application\n" unless $app_name;
+        last;
+    }
+    return $app_name
+}
+
+=head2 sub make_model()
+
+Creates the sqlite auth db in ./db and makes the dbic schema and
+catalyst model with Catalyst::Helper::Model::DBIC::Schema
+
+=cut
+
+sub make_model {
+    # put sqlitedb in __path_to('db')__;
+    my $helper = Catalyst::Helper->new();
+    $helper->mk_dir('db');
+    my $dbh = DBI->connect("dbi:SQLite:dbname=db/auth.db","","");
+    my @sql = ("CREATE TABLE role (
+                id   INTEGER PRIMARY KEY,
+                role TEXT UNIQUE );",
+               "CREATE TABLE user (
+                id       INTEGER PRIMARY KEY,
+                username TEXT UNIQUE,
+                email    TEXT,
+                password TEXT,
+                status   TEXT,
+                role_text TEXT,
+                session_data TEXT );",
+               "CREATE TABLE user_role (
+                id   INTEGER PRIMARY KEY,
+                user INTEGER REFERENCES user(id),
+                roleid INTEGER REFERENCES role(id) );"
+           );
+
+    map { $dbh->do($_) } @sql;
+    my $app_prefix = Catalyst::Utils::appprefix(app_name());
+
+    make_schema_at(app_name() . "::Auth::Schema",
+                   {  components => ['EncodedColumn'],
+                      dump_directory => 'lib' ,
+                  },
+                   ["dbi:SQLite:dbname=db/auth.db", "",""]);
+
+    my @cmd = ( "./script/$app_prefix" . "_create.pl" ,
+                 'model',
+                 'Auth',
+                 'DBIC::Schema',
+                 app_name() . "::Auth::Schema",
+            );
+    system( @cmd );
+    my $schema_name = app_name() . "::Auth::Schema";
+    my $user_schema = "$schema_name"."::User";
+    my @path = split /::/, $user_schema;
+    my $user_schema_path = join '/', @path;
+    my $module = "lib/$user_schema_path.pm";
+    my $doc = PPI::Document->new($module);
+    my $digest_code = $helper->get_file(__PACKAGE__, 'digest');
+
+    my $comments = $doc->find(
+        sub { $_[1]->isa('PPI::Token::Comment')}
+    );
+    my $last_comment = $comments->[$#{$comments}];
+    $last_comment->set_content($digest_code);
+    $doc->save($module);
+
+    # we need to specify the dsn with __path_to(db/auth.db)__ in
+    # .conf, rather than code in the model.
+    my $conf_file = "$app_prefix.conf";
+
+    open my $FH, ">>", $conf_file;
+    my $conf = <<EOF;
+    <Model Auth>
+      schema_class $schema_name
+      connect_info dbi:SQLite:__path_to(db/auth.db)__
+      connect_info user
+      connect_info passwd # keep these here for dsns that need 'em
+    </Model>
+EOF
+    print $FH $conf;
+    close $FH;
+}
+
+=head2 sub mk_auth_controller()
+
+uses Catalyst::Helper to make a ::Controller::Auth
+
+=cut
+
+sub mk_auth_controller {
+    my $helper = Catalyst::Helper->new();
+    my $app_path = app_name();
+    $app_path =~ s/::/\//g;
+    my $controller_file = "lib/$app_path/Controller/Auth.pm";
+    $helper->render_file ('auth_controller',
+                          $controller_file,
+                          {app_name => app_name()});
+}
+
+=head2 sub add_plugins()
+
+    uses ppi to add the auth plugins in the use Catalyst qw// statement
+
+=cut
+
+sub add_plugins {
+    my ($module, $doc) = _get_ppi();
+    
+    my $find = PPI::Find->new( \&_find_use_catalyst);
+    my ($found) = $find->in($doc);
+    my $find_plugins = PPI::Find->new(\&_find_plugins);
+    my ($plugins) = $find_plugins->in($found);
+    croak "Your app is not using any plugins, so we can't continue\n" if !$plugins;
+    my $plugin_str = scalar($plugins);
+    my $tail = chop $plugin_str;
+    $plugin_str .= "\n               Authentication\n               Authorization::Roles\n               Session\n               Session::State::Cookie\n               Session::Store::FastMmap $tail";
+    $plugins->set_content($plugin_str);
+    $doc->save($module);
+}
+
+sub _find_plugins {
+    my ($element, $search) = @_;
+    return 1 if $element->isa('PPI::Token::QuoteLike::Words');
+    return 0
+}
+
+sub _find_use_catalyst {
+    my ($element, $search) = @_;
+    if ( $element->isa('PPI::Statement::Include') &&
+         $element->type eq 'use' &&
+         $element->module eq 'Catalyst'
+     ) {
+        return 1;
+    }
+    return 0;
+}
+
+=head2 sub add_config()
+
+Add the auth configuration in MyApp.pm
+
+=cut
+
+sub add_config {
+    my ($credential) = @_;
+    my ($module, $doc) = _get_ppi();
+    my $found = PPI::Find->new(\&_find_setup);
+    my ($setup) = $found->in($doc);
+    croak "unable to find __PACKAGE__->setup in $module\n" if !$setup;
+    my $auth_doc_plain;
+    
+    if ( $credential eq 'http' ) {
+        warn "Configuring http credential\n";
+        $auth_doc_plain = Catalyst::Helper->get_file(__PACKAGE__, 'auth_conf_http');
+    }
+    elsif ( $credential eq 'password' ) {
+        warn "Configuring password (web based) authentication credential\n";
+        $auth_doc_plain = Catalyst::Helper->get_file(__PACKAGE__, 'auth_conf_passwd');
+    }
+    
+    $auth_doc_plain =~ s/__MYSCHEMA__/Auth/msg;
+    my $auth_doc = PPI::Document->new(\$auth_doc_plain);
+    my $auth_conf = $auth_doc->find_first('PPI::Statement');
+    # the code produced here is a little ugly and lacks a \n between
+    # the config and the __PACKAGE__->setup declaration. The usage of
+    # PPI to modify source is also inconsistent here to elewhere.
+    $setup->insert_before($auth_conf);
+    $doc->save($module);
+}
+
+sub _find_setup {
+    my ($element, $search) = @_;
+    if ( $element->isa('PPI::Statement')
+         && $element =~ /setup.*?;/
+     ) {
+        return 1;
+    }
+    return 0;
+}
+
+sub _get_ppi {
+    my $app_name = app_name() || 'TestApp';
+    my @path = split /::/, $app_name;
+    my $app_path = join '/', @path;
+    my $module = "lib/$app_path.pm";
+    my $doc = PPI::Document->new($module);
+    return ($module, $doc);
+}
+
+=head2 sub write_templates()
+
+make the login, logout and unauth templates
+
+=cut
+
+sub write_templates {
+    my $helper = Catalyst::Helper->new();
+    my $login = $helper->get_file(__PACKAGE__, 'login.tt');
+    my $logout = $helper->get_file(__PACKAGE__, 'logout.tt');
+    my $unauth = $helper->get_file(__PACKAGE__, 'unauth.tt');
+    $helper->mk_dir("root/auth");
+    $helper->mk_file("root/auth/login.tt", $login);
+    $helper->mk_file("root/auth/logout.tt", $logout);
+    $helper->mk_file("root/auth/unauth.tt", $unauth);
+}
+
+=head2 sub update_makefile()
+
+Adds the auth and session dependencies to Makefile.PL
+
+=cut
+
+sub update_makefile {
+    my $deps = Catalyst::Helper->get_file(__PACKAGE__, 'requires');
+    my $doc = PPI::Document->new('Makefile.PL');
+    my $find = PPI::Find->new( \&_find_install_script );
+    my ($found) = $find->in($doc);
+    croak "There's something wrong with your Makefile.PL so we can't continue (can't find  the install_script directive\n" if ! $found;
+    my $install_script = $found->find_first('PPI::Token::Word');
+    my $install_script_str = scalar($install_script);
+    $install_script->set_content($deps . "\n" . $install_script_str);
+    $doc->save('Makefile.PL')
+}
+
+sub _find_install_script {
+    my ($element, $search) = @_;
+    if ($element->isa('PPI::Statement')
+            && $element =~ 'install_script') {
+        return 1;
+    }
+    return 0;
+}
+
+=head2 sub add_user_helper()
+
+A little script to add a user to the database.
+
+=cut
+
+sub add_user_helper {
+    my $helper = Catalyst::Helper->new;
+    my $app_prefix = Catalyst::Utils::appprefix(app_name());
+    my $script_dir = File::Spec->catdir( '.', 'script' );
+    my $script = "$script_dir\/$app_prefix\_auth_admin.pl";
+    my $startperl = "#!$Config{perlpath} -w";
+    $DB::single=1;
+    $helper->render_file('auth_admin',
+                         $script,
+                         { start_perl => $startperl,
+                           appprefix  => $app_prefix,
+                           startperl => $startperl,
+                           app_name => app_name(),
+                       });
+    chmod 0700, $script;
+}
+
+=head2 BUGS
+
+This is experimental, fairly rough code.  It's a proof of concept for
+helper modules for Catalyst that need to alter the application
+configuration, Makefile.PL and other parts of the application.  Bug
+reports, and patches are encouraged.  Report bugs or provide patches
+to http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Helper-AuthDBIC.
+
+=head2 AUTHOR
+
+Kieren Diment <zarquon at cpan.org>
+
+
+=head1 COPYRIGHT AND LICENCE
+
+Copyright (c) 2008 Kieren Diment
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
+
+__DATA__
+
+=begin pod_to_ignore
+
+__auth_controller__
+package [% app_name %]::Controller::Auth;
+
+use strict;
+use warnings;
+use base 'Catalyst::Controller';
+
+sub index :Path :Args(0) {
+    my ($self, $c) = @_;
+    $c->detach('get_login');
+}
+
+sub get_login : Local {
+    my ($self, $c) = @_;
+    $c->stash->{destination} = $c->req->path;
+    $c->stash->{template} = 'auth/login.tt';
+}
+
+sub logout : Local {
+    my ( $self, $c ) = @_;
+    $c->logout;
+    $c->stash->{template} = 'auth/logout.tt';
+}
+
+sub login : Local {
+    my ( $self, $c ) = @_;
+    my $user = $c->req->params->{user};
+    my $password = $c->req->params->{password};
+    $c->flash->{destination} = $c->req->params->{destination} || $c->req->path;
+    $c->stash->{remember} = $c->req->params->{remember};
+    if ( $user && $password ) {
+        if ( $c->authenticate( { username => $user,
+                                 password => $password } ) ) {
+            $c->{session}{expires} = 999999999999 if $c->req->params->{remember};
+            $c->res->redirect($c->uri_for($c->flash->{destination}));
+        }
+        else {
+            # login incorrect
+            $c->stash->{message} = 'Invalid user and/or password';
+            $c->stash->{template} =  'auth/login.tt';
+        }
+    }
+    else {
+        # invalid form input
+        $c->stash->{message} = 'invalid form input';
+        $c->stash->{template} =  'auth/login.tt';
+    }
+}
+
+sub unauthorized : Private {
+    my ($self, $c) = @_;
+    $c->stash->{template}= 'auth/unauth.tt';
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+[% app_name %]Controller::Auth
+
+=head2 SUMMARY
+
+This is a controller to provide simple authentication provided by
+Catalyst::Helper::AuthDBIC. The database schema provided by the Helper
+will also provide autheorization facilities.  As an example, If you
+wanted to use this controller to provide application wide requirement
+for login you would put something like the following in
+MyApp::Controller::Root:
+
+ sub auto : Private {
+      my ( $self, $c) = @_;
+      if ( !$c->user && $c->req->path !~ /^auth.*?login/) {
+          $c->forward('[% app_name %]::Controller::Auth');
+          return 0;
+      }
+      return 1;
+ }
+
+=cut
+
+__auth_conf_http__
+ __PACKAGE__->config( authentication => {
+    'default_realm' => 'users',
+    'realms' => {
+        'users' => {
+            'store' => {
+                'role_column' => 'role_text',
+                'user_class' => '__MYSCHEMA__::User',
+                'class' => 'DBIx::Class',
+            },
+            'credential' => {
+                 'password_type' => 'hashed',
+                 'password_field' => 'password',
+                 'password_hash_type' => 'SHA-1',
+                 'class' => 'HTTP',
+                 'type' => 'basic',
+             }
+        }
+    },
+});
+
+
+__auth_conf_password__
+ __PACKAGE__->config( authentication => {
+    'default_realm' => 'users',
+    'realms' => {
+        'users' => {
+            'store' => {
+                'role_column' => 'role_text',
+                'user_class' => '__MYSCHEMA__::User',
+                'class' => 'DBIx::Class',
+            },
+           'credential' => {
+                'password_type' => 'hashed',
+                'password_field' => 'password',
+                'password_hash_type' => 'SHA-1',
+                'class' => 'Password'
+            }
+        }
+    },
+});
+
+__digest__
+
+      __PACKAGE__->add_columns(
+        'password' => {
+          data_type     => 'CHAR',
+          size          => 40,
+          encode_column => 1,
+          encode_class  => 'Digest',
+          encode_args   => {algorithm => 'SHA-1', format => 'hex'},
+      });
+
+__requires__
+requires 'Catalyst::Plugin::Authentication';
+requires 'Catalyst::Plugin::Authorization::Roles';
+requires 'Catalyst::Plugin::Session';
+requires 'Catalyst::Plugin::Session::State::Cookie';
+requires 'Catalyst::Plugin::Session::Store::FastMmap';
+requires 'Catalyst::Authentication::Store::DBIx::Class';
+requires 'Catalyst::Authentication::Credential::HTTP';
+requires 'DBIx::Class::EncodedColumn;
+__login.tt__
+<h1> Please login</h1>
+[% IF c.stash.message != '' %] <h2 style='color:red'> [% c.stash.message %] </h2
+> [% END %]
+<form name="login" method='post' action='[% c.uri_for('/auth/login')  %]'>
+User: <input name='user' type='text' /><br />
+Password: <input name='password' type='password' /><br />
+<input type='checkbox' name='remember' >Remember me</input> <br />
+<input type='hidden' value='[% c.flash.destination  %]' />
+<input type='submit' name='Log In' /> &nbsp; <input type='reset' name='Reset' />
+</form>
+
+__logout.tt__
+<h1> Logout successful</h1>
+<a href='[% c.uri_for('/') %]'>Return to home page</a>
+__unauth.tt__
+<h1> [%c.user.id %]: You are not allowed to view this page.</h1>
+You can <a href="[% c.req.referrer  %]">go back</a> where you came from, or <a h
+ref="[% c.uri_for('/auth/logout') %]">logout</a> and try logging in again as a d
+ifferent user.  If you think this is an error, please contact <a href="mailto:[%
+c.config.admin %]">[% c.config.admin %]</a>
+
+__auth_admin__
+[% startperl %]
+
+use strict;
+use warnings;
+use Pod::Usage;
+use Getopt::Long;
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+use [% app_name %]::Auth::Schema;
+
+my $user = undef;
+my $passwd = undef;
+my $help = undef;
+my $role = undef;
+my $email = undef;
+my $schema = [% app_name %]::Auth::Schema->connect("dbi:SQLite:$Bin/../db/auth.db");
+
+GetOptions(
+    'user=s'    => \$user,
+    'pass|password|passwd=s' => \$passwd,
+    'role:s' => \$role,
+    'help' => \$help,
+    'email:s' => \$email,
+);
+
+pod2usage(1) if ( $help || !$user || !$passwd );
+
+add_user($schema, $user,$passwd,$role, $email);
+
+sub add_user {
+    my ($schema, $user, $passwd, $role, $email ) = @_;
+    my %user_insert = (
+        username => $user,
+        password => $passwd,
+        email   => $email,
+        role_text => $role,
+    );
+
+    my $role_rs = undef;
+    if ($role) {
+        $role_rs = $schema->resultset('Role')->find_or_create({role => $role});
+        $user_insert{role_text} = $role;
+    }
+    my $user_rs = $schema->resultset('User')->create(\%user_insert);
+    if ($role_rs) {
+        my $user_role_rs = $schema->resultset('UserRole')
+            ->create({ user => $user_rs,
+                       roleid => $role_rs});
+    }
+}
+
+=head1 NAME
+
+[% appprefix %]_auth_admin.pl - Sets the username and password for the generated authentication database
+
+=head1 SYNOPSIS
+
+[% appprefix %]_auth_admin.pl -user username -passwd password [-role role]
+
+ Options:
+   -user      username
+   -passwd    password
+   -role      role (optional)
+   -email     email address (optional)
+   -help      display this help and exit
+
+=cut

Added: Catalyst-Helper-AuthDBIC/tags/0.06/script/auth_bootstrap.pl
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/script/auth_bootstrap.pl	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/script/auth_bootstrap.pl	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use Catalyst::Helper::AuthDBIC;
+use Pod::Usage;
+
+=head1 NAME
+
+auth_bootstrap.pl
+
+=head1 SYNOPSIS
+
+ auth-bootstrap.pl  -credential (http|password)
+
+Boostrap simple database backed authentication for a Catalyst
+application.  The store argument is optional and defaults to http
+(basic) authentication.  Use of the password option provides some
+basic html templates and (buggy - patches welcome) pass through login.
+
+Once you're done running this script, add a user with the
+script/myapp_auth_admin.pl command (run myapp_auth_admin.pl -help for
+instructions), and then add some code to one of your controllers.  For
+example to require application wide authentication add the following to your Controller::Root :
+
+
+
+=cut
+
+
+use Getopt::Long;
+
+my $credential = '';
+my $help = undef;
+
+GetOptions ( "credential=s" => \$credential,
+         help => \$help);
+
+pod2usage(1) if ( $help || !$credential );
+
+if  ($credential !~ /^(http|password)$/) {
+    die "Valid credentials are 'http' for basic auth or 'password' for web based auth";
+}
+
+Catalyst::Helper::AuthDBIC::make_model();
+Catalyst::Helper::AuthDBIC::mk_auth_controller() if $credential eq 'password';
+Catalyst::Helper::AuthDBIC::add_plugins();
+Catalyst::Helper::AuthDBIC::add_config($credential);
+Catalyst::Helper::AuthDBIC::write_templates();
+Catalyst::Helper::AuthDBIC::update_makefile();
+Catalyst::Helper::AuthDBIC::add_user_helper();

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/00-load.t
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/00-load.t	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/00-load.t	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,6 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+use ok 'Catalyst::Helper::AuthDBIC';


Property changes on: Catalyst-Helper-AuthDBIC/tags/0.06/t/00-load.t
___________________________________________________________________
Name: svn:mime-type
   + text/script

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/01-functions.t
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/01-functions.t	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/01-functions.t	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More qw/no_plan/;;
+use ok 'Catalyst::Helper::AuthDBIC';
+use FindBin qw/$Bin/;
+my $app_dir = "$Bin/lib/";
+my $cwd = $ENV{PWD};
+chdir("$app_dir");
+my $app_name = Catalyst::Helper::AuthDBIC->app_name();
+ok($app_name eq 'TestApp', 'got app name');
+
+# Catalyst::Helper stuff is a pain to test :(
+# ok(Catalyst::Helper::AuthDBIC->make_model(), "model made ok");
+# ok(-e ("$app_dir/db/auth.db"), "db file made ok");
+
+# clean up
+
+unlink "$app_dir/db/auth.db";
+rmdir "$app_dir/db";


Property changes on: Catalyst-Helper-AuthDBIC/tags/0.06/t/01-functions.t
___________________________________________________________________
Name: svn:mime-type
   + text/script

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/02-usage.t
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/02-usage.t	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/02-usage.t	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,55 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::Command qw/no_plan/;
+use Test::More;
+use Directory::Scratch;
+use Path::Class;
+use FindBin qw/$Bin/;
+my $bootstrap = "$Bin/../script/auth_bootstrap.pl";
+
+use ok 'Catalyst::Helper::AuthDBIC';
+
+my $scratch = Directory::Scratch->new();
+my $wdir = Path::Class::Dir->new($scratch);
+
+chdir $wdir;
+exit_is_num ( 'catalyst.pl Test::App', 0 , 'test app');
+ok(chdir 'Test-App');
+exit_is_num ("/usr/bin/env perl $bootstrap -credential http", 0, 'auth bootstrap');
+exit_is_num( "/usr/bin/env perl script/test_app_auth_admin.pl -user fred -password wilma", 0 , "created user");
+
+my $controller = <<'EOF';
+
+package Test::App::Controller::Secret;
+
+use strict;
+use warnings;
+use parent 'Catalyst::Controller';
+
+sub auto : Private {
+    my ( $self, $c ) = @_;
+    $c->authenticate({realm => 'users'});
+}
+
+sub default : Path {
+    my ($self, $c) = @_;
+    $c->res->body('ok');
+}
+
+1;
+
+EOF
+
+my $controller_file;
+$controller_file = $wdir->subdir('Test-App')->subdir('lib')->subdir('Test')->subdir('App')->subdir('Controller')->file('Secret.pm');
+
+my $FH;
+
+open $FH, ">", $controller_file;
+print $FH $controller;
+close $FH;
+# stdout_like('$wdir/script/test_app_test.pl /secret', qr/Authorization required/ism, 'auth required');
+$DB::single=1;
+undef $scratch;


Property changes on: Catalyst-Helper-AuthDBIC/tags/0.06/t/02-usage.t
___________________________________________________________________
Name: svn:mime-type
   + text/script

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/Makefile.PL
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/Makefile.PL	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/Makefile.PL	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1 @@
+name 'TestApp';

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Controller/Root.pm
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Controller/Root.pm	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Controller/Root.pm	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,12 @@
+package TestApp::Controller::Root;
+use strict;
+use warnings;
+
+__PACKAGE__->config(namespace => q{});
+
+use base 'Catalyst::Controller';
+
+# your actions replace this one
+sub main :Path { $_[1]->res->body('<h1>It works</h1>') }
+
+1;

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp/Model/.gitignore
===================================================================

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp.pm
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp.pm	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/TestApp.pm	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,12 @@
+package TestApp;
+use strict;
+use warnings;
+
+use parent qw/Catalyst/;
+use Catalyst qw/
+                ConfigLoader
+                Static::Simple/;
+
+__PACKAGE__->setup;
+
+1;

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/db/auth.db,"",""
===================================================================

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/db/auth.db,,
===================================================================

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_create.pl
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_create.pl	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_create.pl	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,74 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use Catalyst::Helper;
+
+my $force = 0;
+my $mech  = 0;
+my $help  = 0;
+
+GetOptions(
+    'nonew|force'    => \$force,
+    'mech|mechanize' => \$mech,
+    'help|?'         => \$help
+ );
+
+pod2usage(1) if ( $help || !$ARGV[0] );
+
+my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, mech => $mech } );
+
+pod2usage(1) unless $helper->mk_component( 'TestApp', @ARGV );
+
+1;
+
+=head1 NAME
+
+testapp_create.pl - Create a new Catalyst Component
+
+=head1 SYNOPSIS
+
+testapp_create.pl [options] model|view|controller name [helper] [options]
+
+ Options:
+   -force        don't create a .new file where a file to be created exists
+   -mechanize    use Test::WWW::Mechanize::Catalyst for tests if available
+   -help         display this help and exits
+
+ Examples:
+   testapp_create.pl controller My::Controller
+   testapp_create.pl -mechanize controller My::Controller
+   testapp_create.pl view My::View
+   testapp_create.pl view MyView TT
+   testapp_create.pl view TT TT
+   testapp_create.pl model My::Model
+   testapp_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
+   dbi:SQLite:/tmp/my.db
+   testapp_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
+   dbi:Pg:dbname=foo root 4321
+
+ See also:
+   perldoc Catalyst::Manual
+   perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Create a new Catalyst Component.
+
+Existing component files are not overwritten.  If any of the component files
+to be created already exist the file will be written with a '.new' suffix.
+This behavior can be suppressed with the C<-force> option.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri at oook.de>
+Maintained by the Catalyst Core Team.
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut


Property changes on: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_create.pl
___________________________________________________________________
Name: svn:executable
   + *

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_server.pl
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_server.pl	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_server.pl	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,121 @@
+#!/usr/bin/env perl
+
+BEGIN { 
+    $ENV{CATALYST_ENGINE} ||= 'HTTP';
+    $ENV{CATALYST_SCRIPT_GEN} = 31;
+    require Catalyst::Engine::HTTP;
+}  
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+my $debug             = 0;
+my $fork              = 0;
+my $help              = 0;
+my $host              = undef;
+my $port              = 3000;
+my $keepalive         = 0;
+my $restart           = 0;
+my $restart_delay     = 1;
+my $restart_regex     = '\.yml$|\.yaml$|\.pm$';
+my $restart_directory = undef;
+my $background        = 0;
+my $pidfile           = "/tmp/testapp.pid";
+
+my @argv = @ARGV;
+
+GetOptions(
+    'debug|d'             => \$debug,
+    'fork'                => \$fork,
+    'help|?'              => \$help,
+    'host=s'              => \$host,
+    'port=s'              => \$port,
+    'keepalive|k'         => \$keepalive,
+    'restart|r'           => \$restart,
+    'restartdelay|rd=s'   => \$restart_delay,
+    'restartregex|rr=s'   => \$restart_regex,
+    'restartdirectory=s'  => \$restart_directory,
+    'daemon'              => \$background,
+    'pidfile=s'           => \$pidfile,          
+);
+
+pod2usage(1) if $help;
+
+if ( $restart ) {
+    $ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
+}
+if ( $debug ) {
+    $ENV{CATALYST_DEBUG} = 1;
+}
+
+# This is require instead of use so that the above environment
+# variables can be set at runtime.
+require TestApp;
+
+TestApp->run( $port, $host, {
+    argv              => \@argv,
+    'fork'            => $fork,
+    keepalive         => $keepalive,
+    restart           => $restart,
+    restart_delay     => $restart_delay,
+    restart_regex     => qr/$restart_regex/,
+    restart_directory => $restart_directory,
+    background        => $background,
+    pidfile           => $pidfile,				
+} );
+
+1;
+
+=head1 NAME
+
+testapp_server.pl - Catalyst Testserver
+
+=head1 SYNOPSIS
+
+testapp_server.pl [options]
+
+ Options:
+   -d -debug          force debug mode
+   -f -fork           handle each request in a new process
+                      (defaults to false)
+   -? -help           display this help and exits
+      -host           host (defaults to all)
+   -p -port           port (defaults to 3000)
+   -k -keepalive      enable keep-alive connections
+   -r -restart        restart when files get modified
+                      (defaults to false)
+   -rd -restartdelay  delay between file checks
+   -rr -restartregex  regex match files that trigger
+                      a restart when modified
+                      (defaults to '\.yml$|\.yaml$|\.pm$')
+   -restartdirectory  the directory to search for
+                      modified files
+                      (defaults to '../')
+
+   -daemon            background the server
+   -pidfile=filename  store the pid if the server in filename, if
+                      daemonizing
+
+ See also:
+   perldoc Catalyst::Manual
+   perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst Testserver for this application.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri at oook.de>
+Maintained by the Catalyst Core Team.
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut


Property changes on: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_server.pl
___________________________________________________________________
Name: svn:mime-type
   + text/script

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_test.pl
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_test.pl	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_test.pl	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,12 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/..";
+use Catalyst::Test 'TestApp';
+
+print request($ARGV[0])->content . "\n";
+
+1;


Property changes on: Catalyst-Helper-AuthDBIC/tags/0.06/t/lib/script/testapp_test.pl
___________________________________________________________________
Name: svn:mime-type
   + text/script

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/live-test.t
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/live-test.t	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/live-test.t	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+# setup library path
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+
+# make sure testapp works
+use ok 'TestApp';
+
+# a live test against TestApp, the test application
+use Test::WWW::Mechanize::Catalyst 'TestApp';
+my $mech = Test::WWW::Mechanize::Catalyst->new;
+$mech->get_ok('http://localhost/', 'get main page');
+$mech->content_like(qr/it works/i, 'see if it has our text');
+


Property changes on: Catalyst-Helper-AuthDBIC/tags/0.06/t/live-test.t
___________________________________________________________________
Name: svn:mime-type
   + text/script

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/pod-coverage.t
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/pod-coverage.t	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/pod-coverage.t	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();

Added: Catalyst-Helper-AuthDBIC/tags/0.06/t/pod.t
===================================================================
--- Catalyst-Helper-AuthDBIC/tags/0.06/t/pod.t	                        (rev 0)
+++ Catalyst-Helper-AuthDBIC/tags/0.06/t/pod.t	2008-10-01 09:15:35 UTC (rev 8483)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();




More information about the Catalyst-commits mailing list