[Catalyst-commits] r8160 - in trunk/examples: .
Catalyst-Model-Validated Catalyst-Model-Validated/lib
Catalyst-Model-Validated/lib/Catalyst
Catalyst-Model-Validated/lib/Catalyst/Model
Catalyst-Model-Validated/lib/MyApp
Catalyst-Model-Validated/lib/MyApp/Controller
Catalyst-Model-Validated/lib/MyApp/Model
Catalyst-Model-Validated/lib/MyApp/Model/User
Catalyst-Model-Validated/lib/MyApp/Schema
Catalyst-Model-Validated/lib/MyApp/Schema/Result
Catalyst-Model-Validated/lib/MyApp/Types
Catalyst-Model-Validated/lib/MyApp/User
Catalyst-Model-Validated/lib/MyApp/User/List
Catalyst-Model-Validated/lib/MyApp/User/List/Role
Catalyst-Model-Validated/lib/MyApp/User/Role
Catalyst-Model-Validated/lib/MyApp/View
Catalyst-Model-Validated/root Catalyst-Model-Validated/root/share
Catalyst-Model-Validated/root/share/errors
Catalyst-Model-Validated/root/share/fields
Catalyst-Model-Validated/root/user
Catalyst-Model-Validated/script Catalyst-Model-Validated/t
edenc at dev.catalyst.perl.org
edenc at dev.catalyst.perl.org
Wed Jul 23 19:18:32 BST 2008
Author: edenc
Date: 2008-07-23 19:18:31 +0100 (Wed, 23 Jul 2008)
New Revision: 8160
Added:
trunk/examples/Catalyst-Model-Validated/
trunk/examples/Catalyst-Model-Validated/Changes
trunk/examples/Catalyst-Model-Validated/MANIFEST
trunk/examples/Catalyst-Model-Validated/Makefile.PL
trunk/examples/Catalyst-Model-Validated/README
trunk/examples/Catalyst-Model-Validated/db_file
trunk/examples/Catalyst-Model-Validated/lib/
trunk/examples/Catalyst-Model-Validated/lib/Catalyst/
trunk/examples/Catalyst-Model-Validated/lib/Catalyst/Model/
trunk/examples/Catalyst-Model-Validated/lib/Catalyst/Model/Validated.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/Root.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/User.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/DB.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User/List.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema/Result/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema/Result/User.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/Core.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/Email.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List/Role/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List/Role/All.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Compare.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Create.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Delete.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Update.pm
trunk/examples/Catalyst-Model-Validated/lib/MyApp/View/
trunk/examples/Catalyst-Model-Validated/lib/MyApp/View/TT.pm
trunk/examples/Catalyst-Model-Validated/root/
trunk/examples/Catalyst-Model-Validated/root/root.tt
trunk/examples/Catalyst-Model-Validated/root/share/
trunk/examples/Catalyst-Model-Validated/root/share/Email
trunk/examples/Catalyst-Model-Validated/root/share/LoginName
trunk/examples/Catalyst-Model-Validated/root/share/Str
trunk/examples/Catalyst-Model-Validated/root/share/errors/
trunk/examples/Catalyst-Model-Validated/root/share/errors/Email
trunk/examples/Catalyst-Model-Validated/root/share/errors/LoginName
trunk/examples/Catalyst-Model-Validated/root/share/errors/LoginNameNotUnique
trunk/examples/Catalyst-Model-Validated/root/share/errors/Password
trunk/examples/Catalyst-Model-Validated/root/share/errors/Str
trunk/examples/Catalyst-Model-Validated/root/share/errors/required
trunk/examples/Catalyst-Model-Validated/root/share/field
trunk/examples/Catalyst-Model-Validated/root/share/fields/
trunk/examples/Catalyst-Model-Validated/root/share/fields/Email
trunk/examples/Catalyst-Model-Validated/root/share/fields/LoginName
trunk/examples/Catalyst-Model-Validated/root/share/fields/Password
trunk/examples/Catalyst-Model-Validated/root/share/fields/Str
trunk/examples/Catalyst-Model-Validated/root/user/
trunk/examples/Catalyst-Model-Validated/root/user/create.tt
trunk/examples/Catalyst-Model-Validated/root/user/list.tt
trunk/examples/Catalyst-Model-Validated/root/user/update.tt
trunk/examples/Catalyst-Model-Validated/root/user/view.tt
trunk/examples/Catalyst-Model-Validated/script/
trunk/examples/Catalyst-Model-Validated/script/myapp_cgi.pl
trunk/examples/Catalyst-Model-Validated/script/myapp_create.pl
trunk/examples/Catalyst-Model-Validated/script/myapp_fastcgi.pl
trunk/examples/Catalyst-Model-Validated/script/myapp_server.pl
trunk/examples/Catalyst-Model-Validated/script/myapp_test.pl
trunk/examples/Catalyst-Model-Validated/t/
trunk/examples/Catalyst-Model-Validated/t/00-load.t
trunk/examples/Catalyst-Model-Validated/t/01-basic.t
trunk/examples/Catalyst-Model-Validated/t/pod.t
trunk/examples/Catalyst-Model-Validated/t/view_TT.t
trunk/examples/Catalyst-Model-Validated/var/
Log:
first draft of Catalyst::Model::Validated, with sample app
Added: trunk/examples/Catalyst-Model-Validated/Changes
===================================================================
--- trunk/examples/Catalyst-Model-Validated/Changes (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/Changes 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,5 @@
+Revision history for Catalyst-Model-ValidatedAction
+
+0.01 Date/time
+ First version, released on an unsuspecting world.
+
Added: trunk/examples/Catalyst-Model-Validated/MANIFEST
===================================================================
--- trunk/examples/Catalyst-Model-Validated/MANIFEST (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/MANIFEST 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,8 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/Catalyst/Model/ValidatedAction.pm
+t/00-load.t
+t/pod-coverage.t
+t/pod.t
Added: trunk/examples/Catalyst-Model-Validated/Makefile.PL
===================================================================
--- trunk/examples/Catalyst-Model-Validated/Makefile.PL (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/Makefile.PL 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,12 @@
+use inc::Module::Install;
+
+name 'Catalyst-Model-ValidatedAction';
+all_from 'lib/Catalyst/Model/ValidatedAction.pm';
+author 'Eden Cardim <edencardim at gmail.com>';
+
+build_requires 'Test::More';
+
+auto_install;
+
+WriteAll;
+
Added: trunk/examples/Catalyst-Model-Validated/README
===================================================================
--- trunk/examples/Catalyst-Model-Validated/README (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/README 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,52 @@
+Catalyst-Model-ValidatedAction
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the README
+file from a module distribution so that people browsing the archive
+can use it to get an idea of the module's uses. It is usually a good idea
+to provide version information here so that people can decide whether
+fixes for the module are worth downloading.
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc Catalyst::Model::ValidatedAction
+
+You can also look for information at:
+
+ RT, CPAN's request tracker
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Model-ValidatedAction
+
+ AnnoCPAN, Annotated CPAN documentation
+ http://annocpan.org/dist/Catalyst-Model-ValidatedAction
+
+ CPAN Ratings
+ http://cpanratings.perl.org/d/Catalyst-Model-ValidatedAction
+
+ Search CPAN
+ http://search.cpan.org/dist/Catalyst-Model-ValidatedAction
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2008 Eden Cardim
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
Added: trunk/examples/Catalyst-Model-Validated/db_file
===================================================================
(Binary files differ)
Property changes on: trunk/examples/Catalyst-Model-Validated/db_file
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/Catalyst-Model-Validated/lib/Catalyst/Model/Validated.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/Catalyst/Model/Validated.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/Catalyst/Model/Validated.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,217 @@
+package Catalyst::Model::Validated;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+Catalyst::Model::Validated - The great new Catalyst::Model::ValidatedAction!
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+ package MyApp::Types::Email;
+
+ use Email::Valid;
+ subtype 'Email'
+ => as 'Str'
+ => where { Email::Valid->address($_) }
+
+ package MyApp::User;
+
+ use Moose;
+
+ has email => (isa => 'Email', is => 'rw', required => 1);
+ has password => (isa => 'Str', is => 'rw', required => 1);
+
+ package MyApp::Model::User;
+
+ use Moose;
+ extends 'Catalyst::Model::ValidatedAction';
+
+ __PACKAGE__->config( model_class => 'MyApp::User' );
+
+ has store => ( isa => 'DBIx::Class::ResultSet', is => 'rw', required => 1 );
+
+ after 'validate' => sub {
+ my($self) = @_;
+ $self->assert_unique($self->params->{email});
+ }
+
+ sub assert_unique {
+ my($self, $value) = @_;
+ $self->set_error(email => 'exists')
+ if $self->store->find($value);
+ }
+
+ sub create {
+ my($self) = @_;
+ return $self->store->create($self->params);
+ }
+
+ sub update {
+ my($self, $obj) = @_;
+ return $obj->update($self->params);
+ }
+
+ sub load {
+ my($self, $username) = @_;
+ return $self->store->find($username);
+ }
+
+ package MyApp::Controller::User;
+
+ use base qw/Catalyst::Controller/;
+
+ sub base : Chained('/') CaptureArgs(0) PathPart('user') {
+ my($self, $c) = @_;
+ my $model = $c->stash->{model} = $c->model('User');
+ $model->store($c->model('DB::User'));
+ }
+
+ sub create : Chained('base') Args(0) {
+ my ( $self, $c ) = @_;
+ my $model = $c->stash->{model};
+ $model->params( $c->req->params );
+ if ( !$model->has_errors ) {
+ my $user = $model->create;
+ $c->res->redirect( $c->uri_for( $c->controller->action_for('view') ),
+ $user->id );
+ }
+ }
+
+ sub load : Chained('base') CaptureArgs(1) PathPart('') {
+ my($self, $c, $username) = @_;
+ my $model = $c->stash->{model};
+ $c->stash->{user} = $model->load($username);
+ }
+
+ sub update : Chained('load') Args(0) {
+ my($self, $c) = @_;
+ my $model = $c->stash->{model};
+ my $user = $c->stash->{user};
+ $model->update()
+ }
+
+...in a View nearby...
+
+ <form action="[% c.uri_for(c.controller('User').action_for('create')) %]"
+ method="post">
+ <input type="text" name=""/>
+ <input type="password" name=""/>
+ </form>
+
+=cut
+
+use Moose;
+
+extends qw/Moose::Object Catalyst::Component/;
+
+has _params => (
+ isa => 'HashRef',
+ is => 'rw',
+ lazy_fail => 1,
+ trigger => sub { shift->adopt_params(@_) },
+ predicate => 'has_params'
+);
+has errors => ( isa => 'HashRef', is => 'rw', lazy_build => 1 );
+has fields => ( isa => 'HashRef', is => 'rw', lazy_build => 1 );
+
+sub params {
+ shift->_params(@_);
+}
+
+sub _build_errors { {} }
+
+sub set_error {
+ my ( $self, $attr_name, $error ) = @_;
+ push @{ $self->errors->{$attr_name} }, $error;
+}
+
+sub _build_fields {
+ my ($self) = @_;
+ my $meta = $self->model_class->meta;
+ return {
+ map {
+ $_->name => $_->has_type_constraint
+ ? $_->type_constraint->name
+ : 'NoType'
+ } $meta->compute_all_applicable_attributes
+ };
+}
+
+sub _build_model_object {
+ my($self) = @_;
+ return $self->model_class->new($self->params);
+}
+
+override COMPONENT => sub {
+ my ( $class, $app ) = @_;
+ my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
+ $arguments = $class->merge_config_hashes( $class->config, $arguments );
+ $class->config(%$arguments);
+ my $model_class = $class->config->{model_class};
+ Class::MOP::load_class($model_class)
+ or confess("Couldn't load ${model_class}: $@");
+ return $class;
+};
+
+sub ACCEPT_CONTEXT {
+ my ( $class, $c ) = @_;
+ return $class->new( %{ $class->config } );
+}
+
+sub model_class {
+ shift->config->{model_class};
+}
+
+sub adopt_params {
+ my ( $self, $params ) = @_;
+ $self->clear_errors;
+ $self->validate($params);
+}
+
+sub validate {
+ my ( $self, $params ) = @_;
+ my $meta = $self->model_class->meta;
+
+ my %errors;
+ foreach my $attr ( $meta->compute_all_applicable_attributes ) {
+ my $init_arg = $attr->init_arg;
+ my $value = $params->{$init_arg};
+
+ $self->set_error( $init_arg, 'required' )
+ if $attr->is_required && !defined($value) || !length($value);
+
+ if ( $attr->has_type_constraint ) {
+ my $tc = $attr->type_constraint;
+ $value = $tc->coercion->coerce($value)
+ if $tc->has_coercion && $attr->should_coerce;
+ $self->set_error( $init_arg, $tc->name )
+ unless defined( $tc->check($value) );
+ }
+ }
+}
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Eden Cardim, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+
+=cut
+
+1;
+__END__
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/Root.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/Root.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/Root.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,21 @@
+package MyApp::Controller::Root;
+
+use warnings;
+use strict;
+
+use base qw/Catalyst::Controller/;
+
+__PACKAGE__->config( namespace => '' );
+
+sub base : Chained('/') PathPart('') CaptureArgs(0) {}
+
+sub root : Chained('base') PathPart('') Args(0) {
+ my ( $self, $c ) = @_;
+ $c->res->redirect( $c->controller('User')->action_for('list') );
+}
+
+sub user : Chained('base') CaptureArgs(0) {}
+
+sub end : ActionClass('RenderView') {}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/User.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/User.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Controller/User.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,59 @@
+package MyApp::Controller::User;
+
+use warnings;
+use strict;
+
+use base qw/Catalyst::Controller/;
+
+sub base : Chained('.') PathPart('') CaptureArgs(0) {
+ my ( $self, $c ) = @_;
+ $c->stash->{current_model_instance} = $c->model('User');
+ $c->model->store( $c->model('DB::User') );
+}
+
+sub create : Chained('base') Args(0) {
+ my ( $self, $c ) = @_;
+ $c->model->params( $c->req->params );
+ $c->detach unless $c->req->method eq 'POST';
+ $c->detach if $c->model->has_errors;
+ my $user = $c->model->create or $c->error_500;
+ $c->res->redirect(
+ $c->uri_for( $c->controller->action_for('view'), [ $user->login_name ] ) );
+}
+
+sub fetch : Chained('base') PathPart('') CaptureArgs(1) {
+ my ( $self, $c, $login_name ) = @_;
+ $c->stash->{user} = $c->model->fetch($login_name);
+}
+
+sub update : Chained('fetch') Args(0) {
+ my ( $self, $c ) = @_;
+ my $user = $c->stash->{user};
+ $c->model->params( { $user->get_columns, %{ $c->req->params } } );
+ $c->detach unless $c->req->method eq 'POST';
+ $c->detach if $c->model->has_errors;
+ $user = $c->model->update( $user ) or $c->error_500;
+ $c->res->redirect(
+ $c->uri_for( $c->controller->action_for('view'), [ $user->login_name ] ) );
+}
+
+sub delete : Chained('fetch') Args(0) {
+ my ( $self, $c ) = @_;
+ $c->model->delete( $c->stash->{user} );
+ $c->res->redirect( $c->uri_for( $c->controller->action_for('list') ) );
+}
+
+sub view : Chained('fetch') PathPart('') Args(0) {}
+
+sub user_list : Chained('base') PathPart('') CaptureArgs(0) {
+ my ( $self, $c ) = @_;
+ my $user_model = $c->model;
+ $c->stash->{current_model_instance} = $c->model('User::List');
+ $c->model->user_model($user_model);
+ $c->model->params( $c->req->params );
+ $c->error_500 if $c->model->has_errors;
+}
+
+sub list : Chained('user_list') Args(0) {}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/DB.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/DB.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/DB.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,13 @@
+package MyApp::Model::DB;
+
+use warnings;
+use strict;
+
+use base qw/Catalyst::Model::DBIC::Schema/;
+
+__PACKAGE__->config(
+ schema_class => 'MyApp::Schema',
+ connect_info => [ 'dbi:SQLite:db_file', '', '' ]
+);
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User/List.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User/List.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User/List.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,33 @@
+package MyApp::Model::User::List;
+
+use warnings;
+use strict;
+
+use Moose;
+
+extends 'Catalyst::Model::Validated';
+
+__PACKAGE__->config(
+ model_class => 'MyApp::User::List',
+ per_page => 10,
+ page => 1
+);
+
+has user_model => (
+ is => 'rw',
+ lazy_fail => 1,
+ handles => [qw/store public_fields/]
+);
+
+before 'validate' => sub {
+ my ($self) = @_;
+ $self->params->{$_} ||= $self->config->{$_} for qw/per_page page/;
+};
+
+sub list {
+ my ($self) = @_;
+ return $self->store->search_rs( {},
+ { map { $_ => $self->params->{$_} } qw/per_page page/ } );
+}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Model/User.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,43 @@
+package MyApp::Model::User;
+
+use warnings;
+use strict;
+
+use Moose;
+
+extends 'Catalyst::Model::Validated';
+with 'MyApp::User::Role::Create';
+with 'MyApp::User::Role::Update';
+with 'MyApp::User::Role::Delete';
+
+__PACKAGE__->config( model_class => 'MyApp::User', per_page => 10, page => 1 );
+
+has _store => (
+ isa => 'DBIx::Class::ResultSet',
+ is => 'rw',
+ init_arg => 'store',
+ lazy_fail => 1
+);
+
+sub store { shift->_store( @_ ? @_ : () ) }
+
+after 'validate' => sub {
+ my($self) = @_;
+ my $login_name = $self->params->{login_name};
+ if($self->fetch($login_name)) {
+ $self->set_error('login_name' => 'LoginNameNotUnique');
+ }
+};
+
+sub fetch {
+ my ( $self, $login_name ) = @_;
+ $self->store->find( $login_name, { key => 'user_login_name' } );
+}
+
+sub public_fields {
+ my $fields = shift->fields;
+ delete $fields->{password};
+ return $fields;
+}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema/Result/User.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema/Result/User.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema/Result/User.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,23 @@
+package MyApp::Schema::Result::User;
+
+use warnings;
+use strict;
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->load_components(qw/Core/);
+
+__PACKAGE__->table('user');
+
+__PACKAGE__->add_columns(
+ id => { data_type => 'INTEGER', is_auto_increment => 1, is_nullable => 0 },
+ login_name => { data_type => 'VARCHAR', is_nullable => 0 },
+ email => { data_type => 'VARCHAR', is_nullable => 0 },
+ password => { data_type => 'VARCHAR', is_nullable => 0 }
+);
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->add_unique_constraint( [qw/login_name/] );
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Schema.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,10 @@
+package MyApp::Schema;
+
+use warnings;
+use strict;
+
+use base qw/DBIx::Class::Schema/;
+
+__PACKAGE__->load_namespaces;
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/Core.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/Core.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/Core.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,16 @@
+package MyApp::Types::Core;
+
+use warnings;
+use strict;
+
+use Moose::Util::TypeConstraints;
+
+subtype 'Password'
+ => as 'Str'
+ => where { length >= 6 };
+
+subtype 'LoginName'
+ => as 'Str'
+ => where { length > 0 && !/\s/ };
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/Email.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/Email.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/Types/Email.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,12 @@
+package MyApp::Types::Email;
+
+use warnings;
+use strict;
+
+use Moose::Util::TypeConstraints;
+
+use Email::Valid;
+
+subtype 'Email'
+ => as 'Str'
+ => where { Email::Valid->address($_) };
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List/Role/All.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List/Role/All.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List/Role/All.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,16 @@
+package MyApp::User::List::Role::All;
+
+use warnings;
+use strict;
+
+use Moose::Role;
+
+requires 'store';
+
+sub list {
+ my ($self) = @_;
+ warn $self->store->search_rs( {}, { $self->params } );
+ return $self->store->search_rs( {}, { $self->params } );
+}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/List.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,11 @@
+package MyApp::User::List;
+
+use warnings;
+use strict;
+
+use Moose;
+
+has per_page => ( isa => 'Int', is => 'rw', required => 1 );
+has page => ( isa => 'Int', is => 'rw', required => 1 );
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Compare.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Compare.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Compare.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,13 @@
+package MyApp::User::Role::Compare;
+
+use warnings;
+use strict;
+
+use Moose::Role;
+
+sub is_equal {
+ my($self, $user_a, $user_b) = @_;
+ return $user_a->id == $user_b->id;
+}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Create.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Create.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Create.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,16 @@
+package MyApp::User::Role::Create;
+
+use warnings;
+use strict;
+
+use Moose::Role;
+
+requires 'store';
+requires 'params';
+
+sub create {
+ my($self) = @_;
+ $self->store->create($self->params);
+}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Delete.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Delete.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Delete.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,13 @@
+package MyApp::User::Role::Delete;
+
+use warnings;
+use strict;
+
+use Moose::Role;
+
+sub delete {
+ my($self, $user) = @_;
+ $user->delete;
+}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Update.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Update.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/User/Role/Update.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,15 @@
+package MyApp::User::Role::Update;
+
+use warnings;
+use strict;
+
+use Moose::Role;
+
+requires 'params';
+
+sub update {
+ my($self, $user) = @_;
+ $user->update($self->params);
+}
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/User.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/User.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/User.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,12 @@
+package MyApp::User;
+
+use Moose;
+
+use MyApp::Types::Core;
+use MyApp::Types::Email;
+
+has email => ( isa => 'Email', is => 'rw', required => 1 );
+has login_name => ( isa => 'LoginName', is => 'rw', required => 1 );
+has password => ( isa => 'Password', is => 'rw', required => 1 );
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp/View/TT.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp/View/TT.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp/View/TT.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,31 @@
+package MyApp::View::TT;
+
+use strict;
+use base 'Catalyst::View::TT';
+
+__PACKAGE__->config(TEMPLATE_EXTENSION => '.tt');
+
+=head1 NAME
+
+MyApp::View::TT - TT View for MyApp
+
+=head1 DESCRIPTION
+
+TT View for MyApp.
+
+=head1 AUTHOR
+
+=head1 SEE ALSO
+
+L<MyApp>
+
+Eden Cardim,,,
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/lib/MyApp.pm
===================================================================
--- trunk/examples/Catalyst-Model-Validated/lib/MyApp.pm (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/lib/MyApp.pm 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,23 @@
+package MyApp;
+
+=pod
+
+This is a sample app for testing and improving Catalyst::Model::Validate, please
+fix things where applicable
+
+=cut
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+use parent qw/Catalyst/;
+
+our $VERSION = '0.01';
+
+__PACKAGE__->config( name => 'MyApp' );
+
+__PACKAGE__->setup(qw/ConfigLoader Static::Simple/);
+
+1;
Added: trunk/examples/Catalyst-Model-Validated/root/root.tt
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/root.tt (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/root.tt 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+test
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/Email
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/Email (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/Email 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+[% INCLUDE share/Str %]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/LoginName
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/LoginName (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/LoginName 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,3 @@
+<a href="[% c.uri_for(c.controller.action_for('view'), [value]) %]">
+ [% value %]
+</a>
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/Str
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/Str (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/Str 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+[% value %]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/errors/Email
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/errors/Email (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/errors/Email 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+must be an email string
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/errors/LoginName
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/errors/LoginName (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/errors/LoginName 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+must not contain spaces
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/errors/LoginNameNotUnique
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/errors/LoginNameNotUnique (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/errors/LoginNameNotUnique 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+that name is taken, please choose another
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/errors/Password
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/errors/Password (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/errors/Password 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+6 characters min 16 characters max
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/errors/Str
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/errors/Str (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/errors/Str 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+must be a string of no more than 255 characters
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/errors/required
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/errors/required (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/errors/required 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+required
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/field
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/field (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/field 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+<input type="[% type %]" name ="[% name %]" value="[% value %]"/>
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/fields/Email
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/fields/Email (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/fields/Email 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+[% INCLUDE share/fields/Str %]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/fields/LoginName
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/fields/LoginName (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/fields/LoginName 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+[% INCLUDE share/fields/Str %]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/fields/Password
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/fields/Password (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/fields/Password 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+[% INCLUDE share/field type = 'password' %]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/share/fields/Str
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/share/fields/Str (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/share/fields/Str 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+[% INCLUDE share/field type = 'text' %]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/user/create.tt
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/user/create.tt (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/user/create.tt 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,21 @@
+<form method="post">
+[%
+
+FOREACH field IN c.model.fields.keys;
+
+ type = c.model.fields.$field;
+ '<p>';
+ field; ': '; INCLUDE "share/fields/$type"
+ name = field
+ value = c.model.params.$field; ' ';
+ FOREACH error IN c.model.errors.$field;
+ INCLUDE "share/errors/$error" name = field;
+ ', ' UNLESS loop.last;
+ END;
+ "</p>\n";
+
+END;
+
+'<input type="submit"/>';x
+
+%]</form>
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/user/list.tt
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/user/list.tt (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/user/list.tt 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,26 @@
+<a href="[% c.uri_for(c.controller.action_for('create')) %]">
+ create new user
+</a><br/>
+<table>
+<tr>[%
+
+FOREACH field IN c.model.public_fields.keys;
+ '<th>'; field; '</th>';
+END;
+
+"</tr>\n";
+
+list = c.model.list;
+
+WHILE (user = list.next);
+ '<tr>';
+ FOREACH field IN c.model.public_fields.keys;
+ type = c.model.public_fields.$field;
+ '<td>'; INCLUDE "share/$type" value = user.$field; '</td>';
+ END;
+ "</tr>\n";
+END;
+
+"</table>\n";
+
+%]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/user/update.tt
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/user/update.tt (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/user/update.tt 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1 @@
+[% INCLUDE user/create.tt %]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/root/user/view.tt
===================================================================
--- trunk/examples/Catalyst-Model-Validated/root/user/view.tt (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/root/user/view.tt 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,20 @@
+<a href="[% c.uri_for(c.controller.action_for('list')) %]">
+ user list
+</a>
+ 
+<a href="[% c.uri_for(c.controller.action_for('update'), [user.login_name]) %]">
+ update
+</a>
+ 
+<a href="[% c.uri_for(c.controller.action_for('delete'), [user.login_name]) %]">
+ delete
+</a><br/>
+[%
+
+FOREACH field IN c.model.public_fields.keys;
+
+ field; ': '; user.$field; "<br/>\n";
+
+END;
+
+%]
\ No newline at end of file
Added: trunk/examples/Catalyst-Model-Validated/script/myapp_cgi.pl
===================================================================
--- trunk/examples/Catalyst-Model-Validated/script/myapp_cgi.pl (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/script/myapp_cgi.pl 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,37 @@
+#!/usr/bin/perl -w
+
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
+
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use MyApp;
+
+MyApp->run;
+
+1;
+
+=head1 NAME
+
+myapp_cgi.pl - Catalyst CGI
+
+=head1 SYNOPSIS
+
+See L<Catalyst::Manual>
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as a cgi script.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri at oook.de>
+
+=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: trunk/examples/Catalyst-Model-Validated/script/myapp_cgi.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/Catalyst-Model-Validated/script/myapp_create.pl
===================================================================
--- trunk/examples/Catalyst-Model-Validated/script/myapp_create.pl (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/script/myapp_create.pl 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,75 @@
+#!/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( 'MyApp', @ARGV );
+
+1;
+
+=head1 NAME
+
+myapp_create.pl - Create a new Catalyst Component
+
+=head1 SYNOPSIS
+
+myapp_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:
+ myapp_create.pl controller My::Controller
+ myapp_create.pl controller My::Controller BindLex
+ myapp_create.pl -mechanize controller My::Controller
+ myapp_create.pl view My::View
+ myapp_create.pl view MyView TT
+ myapp_create.pl view TT TT
+ myapp_create.pl model My::Model
+ myapp_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
+ dbi:SQLite:/tmp/my.db
+ myapp_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: trunk/examples/Catalyst-Model-Validated/script/myapp_create.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/Catalyst-Model-Validated/script/myapp_fastcgi.pl
===================================================================
--- trunk/examples/Catalyst-Model-Validated/script/myapp_fastcgi.pl (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/script/myapp_fastcgi.pl 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,80 @@
+#!/usr/bin/perl -w
+
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use MyApp;
+
+my $help = 0;
+my ( $listen, $nproc, $pidfile, $manager, $detach, $keep_stderr );
+
+GetOptions(
+ 'help|?' => \$help,
+ 'listen|l=s' => \$listen,
+ 'nproc|n=i' => \$nproc,
+ 'pidfile|p=s' => \$pidfile,
+ 'manager|M=s' => \$manager,
+ 'daemon|d' => \$detach,
+ 'keeperr|e' => \$keep_stderr,
+);
+
+pod2usage(1) if $help;
+
+MyApp->run(
+ $listen,
+ { nproc => $nproc,
+ pidfile => $pidfile,
+ manager => $manager,
+ detach => $detach,
+ keep_stderr => $keep_stderr,
+ }
+);
+
+1;
+
+=head1 NAME
+
+myapp_fastcgi.pl - Catalyst FastCGI
+
+=head1 SYNOPSIS
+
+myapp_fastcgi.pl [options]
+
+ Options:
+ -? -help display this help and exits
+ -l -listen Socket path to listen on
+ (defaults to standard input)
+ can be HOST:PORT, :PORT or a
+ filesystem path
+ -n -nproc specify number of processes to keep
+ to serve requests (defaults to 1,
+ requires -listen)
+ -p -pidfile specify filename for pid file
+ (requires -listen)
+ -d -daemon daemonize (requires -listen)
+ -M -manager specify alternate process manager
+ (FCGI::ProcManager sub-class)
+ or empty string to disable
+ -e -keeperr send error messages to STDOUT, not
+ to the webserver
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as fastcgi.
+
+=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: trunk/examples/Catalyst-Model-Validated/script/myapp_fastcgi.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/Catalyst-Model-Validated/script/myapp_server.pl
===================================================================
--- trunk/examples/Catalyst-Model-Validated/script/myapp_server.pl (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/script/myapp_server.pl 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,115 @@
+#!/usr/bin/perl -w
+
+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/../lib";
+
+my $debug = 0;
+my $fork = 0;
+my $help = 0;
+my $host = undef;
+my $port = $ENV{MYAPP_PORT} || $ENV{CATALYST_PORT} || 3000;
+my $keepalive = 0;
+my $restart = $ENV{MYAPP_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
+my $restart_delay = 1;
+my $restart_regex = '(?:/|^)(?!\.#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$';
+my $restart_directory = undef;
+my $follow_symlinks = 0;
+
+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,
+ 'followsymlinks' => \$follow_symlinks,
+);
+
+pod2usage(1) if $help;
+
+if ( $restart && $ENV{CATALYST_ENGINE} eq 'HTTP' ) {
+ $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 MyApp;
+
+MyApp->run( $port, $host, {
+ argv => \@argv,
+ 'fork' => $fork,
+ keepalive => $keepalive,
+ restart => $restart,
+ restart_delay => $restart_delay,
+ restart_regex => qr/$restart_regex/,
+ restart_directory => $restart_directory,
+ follow_symlinks => $follow_symlinks,
+} );
+
+1;
+
+=head1 NAME
+
+myapp_server.pl - Catalyst Testserver
+
+=head1 SYNOPSIS
+
+myapp_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$|\.conf|\.pm$')
+ -restartdirectory the directory to search for
+ modified files, can be set mulitple times
+ (defaults to '[SCRIPT_DIR]/..')
+ -follow_symlinks follow symlinks in search directories
+ (defaults to false. this is a no-op on Win32)
+ 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: trunk/examples/Catalyst-Model-Validated/script/myapp_server.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/Catalyst-Model-Validated/script/myapp_test.pl
===================================================================
--- trunk/examples/Catalyst-Model-Validated/script/myapp_test.pl (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/script/myapp_test.pl 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Catalyst::Test 'MyApp';
+
+my $help = 0;
+
+GetOptions( 'help|?' => \$help );
+
+pod2usage(1) if ( $help || !$ARGV[0] );
+
+print request($ARGV[0])->content . "\n";
+
+1;
+
+=head1 NAME
+
+myapp_test.pl - Catalyst Test
+
+=head1 SYNOPSIS
+
+myapp_test.pl [options] uri
+
+ Options:
+ -help display this help and exits
+
+ Examples:
+ myapp_test.pl http://localhost/some_action
+ myapp_test.pl /some_action
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst action from the command line.
+
+=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: trunk/examples/Catalyst-Model-Validated/script/myapp_test.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/Catalyst-Model-Validated/t/00-load.t
===================================================================
--- trunk/examples/Catalyst-Model-Validated/t/00-load.t (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/t/00-load.t 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,10 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('Catalyst::Model::Validated');
+}
+
+diag( "Testing Catalyst::Model::Validated $Catalyst::Model::Validated::VERSION,"
+ . " Perl $], $^X" );
Added: trunk/examples/Catalyst-Model-Validated/t/01-basic.t
===================================================================
--- trunk/examples/Catalyst-Model-Validated/t/01-basic.t (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/t/01-basic.t 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,82 @@
+use warnings;
+use strict;
+
+use Test::More qw/no_plan/;
+use Data::Dump;
+
+package Test::Foo;
+
+use Moose;
+use Moose::Util::TypeConstraints;
+
+coerce 'HashRef' => from 'Str' => via { eval };
+
+has bar => ( isa => 'Str', is => 'rw', required => 1 );
+has baz => ( isa => 'HashRef', is => 'rw', coerce => 1 );
+has read_only => ( isa => 'Str', is => 'ro', required => 1 );
+
+package Test::Model::Foo;
+
+use Moose;
+
+extends 'Catalyst::Model::Validated';
+
+__PACKAGE__->config( model_class => 'Test::Foo' );
+
+package main;
+
+ok( ( my $model = Test::Model::Foo->COMPONENT )
+ ->isa('Catalyst::Model::Validated') );
+isa_ok($model = $model->ACCEPT_CONTEXT, 'Catalyst::Model::Validated');
+ok( !$model->has_errors );
+
+$model->params(
+ {
+ bar => 'test string',
+ baz => Data::Dump::dump( { foo => 'bar' } ),
+ read_only => 'read only string'
+ }
+);
+ok( !$model->has_errors );
+
+$model->params(
+ {
+ bar => {},
+ baz => Data::Dump::dump( { foo => 'bar' } ),
+ read_only => 'read only string'
+ }
+);
+ok( $model->has_errors );
+is_deeply( $model->errors, { bar => ['Str'] } );
+
+$model->params(
+ {
+ baz => Data::Dump::dump( [ foo => 'bar' ] ),
+ read_only => 'read only string'
+ }
+);
+ok( $model->has_errors );
+is_deeply( $model->errors,
+ { bar => [ 'required', 'Str' ], baz => ['HashRef'] } );
+
+$model->params(
+ {
+ bar => 'test string',
+ baz => Data::Dump::dump( [ foo => 'bar' ] ),
+ read_only => {},
+ bogus => 'value'
+ }
+);
+ok( $model->has_errors );
+is_deeply( $model->errors, { baz => ['HashRef'], read_only => ['Str'] } );
+
+$model->params( {} );
+ok( $model->has_errors );
+is_deeply(
+ $model->errors,
+ {
+ bar => [qw/required Str/],
+ baz => [qw/HashRef/],
+ read_only => [qw/required Str/]
+ }
+);
Added: trunk/examples/Catalyst-Model-Validated/t/pod.t
===================================================================
--- trunk/examples/Catalyst-Model-Validated/t/pod.t (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/t/pod.t 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();
Added: trunk/examples/Catalyst-Model-Validated/t/view_TT.t
===================================================================
--- trunk/examples/Catalyst-Model-Validated/t/view_TT.t (rev 0)
+++ trunk/examples/Catalyst-Model-Validated/t/view_TT.t 2008-07-23 18:18:31 UTC (rev 8160)
@@ -0,0 +1,6 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'MyApp::View::TT' }
+
More information about the Catalyst-commits
mailing list