[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>
+&nbsp
+<a href="[% c.uri_for(c.controller.action_for('update'), [user.login_name]) %]">
+  update
+</a>
+&nbsp
+<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