[Catalyst-commits] r7508 - in CatalystX-CRUD/CatalystX-CRUD/trunk:
. lib/CatalystX lib/CatalystX/CRUD lib/CatalystX/CRUD/Model
lib/CatalystX/CRUD/Test
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Mon Mar 17 14:57:12 GMT 2008
Author: karpet
Date: 2008-03-17 14:57:10 +0000 (Mon, 17 Mar 2008)
New Revision: 7508
Added:
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Form.pm
Modified:
CatalystX-CRUD/CatalystX-CRUD/trunk/Changes
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/Utils.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/REST.pm
Log:
add new Test classes and new ModelAdapter class. refactor Controller to use ModelAdapter class if defined. fix some REST bugs.
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/Changes
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/Changes 2008-03-17 14:56:17 UTC (rev 7507)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/Changes 2008-03-17 14:57:10 UTC (rev 7508)
@@ -97,5 +97,12 @@
* fix bug in Iterator to test for !next() rather than !defined(next())
* re-set action in ::REST->default so that RPC-style template naming works
* use :Path instead of :Private on ::REST->default
+ * fix several bugs with action() set in ::REST
+ * ::Controller->form now calls NEXT::form. This is for REST compat and @INC oddness.
+ * added new ::ModelAdapter class and refactored base Controller to use it.
+ * moved make_pager() from base ::Model to ::Model::Utils
+ * added new ::Test classes to ease writing controller-agnostic tests.
+ * new, optional 'make_query' method in Controller.
+
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm 2008-03-17 14:56:17 UTC (rev 7507)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm 2008-03-17 14:57:10 UTC (rev 7508)
@@ -6,7 +6,10 @@
Catalyst::Controller
);
use Carp;
+use Catalyst::Utils;
+__PACKAGE__->mk_accessors(qw( model_adapter ));
+
our $VERSION = '0.26';
=head1 NAME
@@ -26,6 +29,7 @@
init_object => 'foo_from_form',
default_template => 'path/to/foo/edit.tt',
model_name => 'Foo',
+ model_adapter => 'FooAdapter', # optional
primary_key => 'id',
view_on_single_result => 0,
page_size => 50,
@@ -96,7 +100,7 @@
Attribute: chained to namespace, expecting one argument.
-Calls B<model_name> read() method with a single key/value pair,
+Calls B<do_model> read() method with a single key/value pair,
using the B<primary_key> config value as the key and the I<primary_key> as the value.
The return value of read() is saved in stash() as C<object>.
@@ -110,7 +114,7 @@
$c->stash->{object_id} = $id;
$c->log->debug("fetching id = $id") if $c->debug;
my @arg = $id ? ( $self->primary_key() => $id ) : ();
- $c->stash->{object} = $c->model( $self->model_name )->fetch(@arg);
+ $c->stash->{object} = $self->do_model( $c, 'fetch', @arg );
if ( $self->has_errors($c) or !$c->stash->{object} ) {
$self->throw_error( 'No such ' . $self->model_name );
}
@@ -220,6 +224,7 @@
# get a valid object
my $obj = $self->form_to_object($c);
if ( !$obj ) {
+ $c->log->debug("form_to_object() returned false") if $c->debug;
return 0;
}
@@ -332,6 +337,64 @@
The following methods are not visible via the URI namespace but
directly affect the dispatch chain.
+=head2 new( I<c>, I<args> )
+
+Sets up the controller instance, detecting and instantiating the model_adapter
+if set in config().
+
+=cut
+
+sub new {
+ my ( $class, $app_class, $args ) = @_;
+ my $self = $class->NEXT::new( $app_class, $args );
+
+ # if model_adapter class is defined, load and instantiate it.
+ if ( $self->config->{model_adapter} ) {
+ Catalyst::Utils->ensure_class_loaded(
+ $self->config->{model_adapter} );
+ $self->model_adapter( $self->config->{model_adapter}
+ ->new( { model_name => $self->config->{model_name} } ) );
+ }
+ return $self;
+}
+
+=head2 do_model( I<context>, I<method>, I<args> )
+
+Checks for presence of model_adapter() instance and calls I<method> on either model()
+or model_adapter() as appropriate.
+
+=cut
+
+sub do_model {
+ my $self = shift;
+ my $c = shift or $self->throw_error("context required");
+ my $method = shift or $self->throw_error("method required");
+ if ( $self->model_adapter ) {
+ return $self->model_adapter->$method( $c, @_ );
+ }
+ else {
+ return $c->model( $self->model_name )->$method(@_);
+ }
+}
+
+=head2 model_can( I<context>, I<method_name> )
+
+Returns can() value from model_adapter() or model() as appropriate.
+
+=cut
+
+sub model_can {
+ my $self = shift;
+ my $c = shift or $self->throw_error("context required");
+ my $method = shift or $self->throw_error("method name required");
+ if ( $self->model_adapter ) {
+ return $self->model_adapter->can($method);
+ }
+ else {
+ return $c->model( $self->model_name )->can($method);
+ }
+}
+
=head2 form
Returns an instance of config->{form_class}. A single form object is instantiated and
@@ -341,7 +404,7 @@
=cut
sub form {
- my $self = shift;
+ my ( $self, $c ) = @_;
$self->{_form} ||= $self->form_class->new;
if ( $self->{_form}->can('clear') ) {
$self->{_form}->clear;
@@ -349,6 +412,7 @@
elsif ( $self->{_form}->can('reset') ) {
$self->{_form}->reset;
}
+ $self->NEXT::form($c);
return $self->{_form};
}
@@ -474,6 +538,16 @@
$self->can_write($c) ? 'edit' : 'view' );
}
+=head2 make_query( I<context>, I<arg> )
+
+This is an optional method. If implemented, do_search() will call this method
+and pass the return value on to the appropriate model methods. If not implemented,
+the model will be tested for a make_query() method and it will be called instead.
+
+Either the controller subclass or the model B<must> implement a make_query() method.
+
+=cut
+
=head2 do_search( I<context>, I<arg> )
Prepare and execute a search. Called internally by list()
@@ -497,11 +571,21 @@
$c->stash->{view_on_single_result} = 1
unless exists $c->stash->{view_on_single_result};
- my $query = $c->model( $self->model_name )->make_query(@arg);
- my $count = $c->model( $self->model_name )->count($query) || 0;
+ my $query;
+ if ( $self->can('make_query') ) {
+ $query = $self->make_query( $c, @arg );
+ }
+ elsif ( $self->model_can( $c, 'make_query' ) ) {
+ $query = $self->do_model( $c, 'make_query', @arg );
+ }
+ else {
+ $self->throw_error(
+ "neither controller nor model implement a make_query() method");
+ }
+ my $count = $self->do_model( $c, 'count', $query ) || 0;
my $results;
unless ( $c->stash->{fetch_no_results} ) {
- $results = $c->model( $self->model_name )->search($query);
+ $results = $self->do_model( $c, 'search', $query );
}
if ( $results
and $count == 1
@@ -511,12 +595,15 @@
$c->response->redirect($uri);
}
else {
+
+ my $pager;
+ if ( $count && $self->model_can( $c, 'make_pager' ) ) {
+ $pager = $self->do_model( $c, 'make_pager', $count, $results );
+ }
+
$c->stash->{results} = {
- count => $count,
- pager => $count
- ? ( $c->model( $self->model_name )->make_pager( $count, $results )
- || undef )
- : undef,
+ count => $count,
+ pager => $pager,
results => $results,
query => $query,
};
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/Utils.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/Utils.pm 2008-03-17 14:56:17 UTC (rev 7507)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/Utils.pm 2008-03-17 14:57:10 UTC (rev 7508)
@@ -3,6 +3,7 @@
use warnings;
use base qw( CatalystX::CRUD Class::Accessor::Fast );
use Sort::SQL;
+use Data::Pageset;
__PACKAGE__->mk_accessors(qw( use_ilike ne_sign ));
our $VERSION = '0.26';
@@ -229,6 +230,34 @@
return { sql => \@sql, query => \%query };
}
+=head2 make_pager( I<total>, I<results> )
+
+Returns a Data::Pageset object using I<total>,
+either the C<_page_size> param or the value of page_size(),
+and the C<_page> param or C<1>.
+
+If the C<_no_page> request param is true, will return undef.
+B<NOTE:> Model authors should check (and respect) the C<_no_page>
+param when constructing queries.
+
+=cut
+
+sub make_pager {
+ my ( $self, $count, $results ) = @_;
+ my $c = $self->context;
+ return if $c->req->param('_no_page');
+ return Data::Pageset->new(
+ { total_entries => $count,
+ entries_per_page => $c->req->param('_page_size')
+ || $self->page_size,
+ current_page => $c->req->param('_page')
+ || 1,
+ pages_per_set => 10, #TODO make this configurable?
+ mode => 'slide',
+ }
+ );
+}
+
1;
__END__
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model.pm 2008-03-17 14:56:17 UTC (rev 7507)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model.pm 2008-03-17 14:57:10 UTC (rev 7508)
@@ -7,7 +7,6 @@
Catalyst::Model
);
use Carp;
-use Data::Pageset;
our $VERSION = '0.26';
@@ -166,34 +165,6 @@
sub page_size { shift->config->{page_size} }
-=head2 make_pager( I<total>, I<results> )
-
-Returns a Data::Pageset object using I<total>,
-either the C<_page_size> param or the value of page_size(),
-and the C<_page> param or C<1>.
-
-If the C<_no_page> request param is true, will return undef.
-B<NOTE:> Model authors should check (and respect) the C<_no_page>
-param when constructing queries.
-
-=cut
-
-sub make_pager {
- my ( $self, $count, $results ) = @_;
- my $c = $self->context;
- return if $c->req->param('_no_page');
- return Data::Pageset->new(
- { total_entries => $count,
- entries_per_page => $c->req->param('_page_size')
- || $self->page_size,
- current_page => $c->req->param('_page')
- || 1,
- pages_per_set => 10, #TODO make this configurable?
- mode => 'slide',
- }
- );
-}
-
=head2 new_object
Returns CatalystX::CRUD::Object->new(). A sane default, assuming
@@ -295,6 +266,8 @@
=cut
+sub make_query { shift->throw_error("must implement make_query()") }
+
1;
__END__
Added: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter.pm 2008-03-17 14:57:10 UTC (rev 7508)
@@ -0,0 +1,168 @@
+package CatalystX::CRUD::ModelAdapter;
+use strict;
+use warnings;
+use base qw( CatalystX::CRUD Class::Accessor::Fast );
+use Carp;
+
+__PACKAGE__->mk_accessors(qw( model_name context ));
+
+=head1 NAME
+
+CatalystX::CRUD::ModelAdapter - make CRUD Controllers work with non-CRUD models
+
+=head1 SYNOPSIS
+
+ package My::ModelAdapter::Foo;
+ use base qw( CatalystX::CRUD::ModelAdapter );
+
+ # must implement the following methods
+ sub new_object { }
+ sub fetch { }
+ sub search { }
+ sub iterator { }
+ sub count { }
+ sub make_query { }
+
+ 1;
+
+ # then in your CX::CRUD::Controller subclass
+ package MyApp::Controller::CRUD;
+ use base qw( CatalystX::CRUD::Controller );
+
+ __PACKAGE__->config(
+ 'model_adapter' => 'My::ModelAdapter::Foo'
+ );
+
+ 1;
+
+=head1 DESCRIPTION
+
+CatalystX::CRUD::ModelAdapter allows you to use existing, non-CRUD Models with
+the CatalystX::CRUD::Controller API. The ModelAdapter class implements a similar
+API to the CX::CRUD::Model, but does not inherit from Catalyst::Model and should
+not sit in the ::Model namespace.
+
+If a 'model_adapter' config value is present
+in a CX::CRUD::Controller subclass, the ModelAdapter instance will be called
+instead of the 'model_name' instance. The B<model_name> accessor is available
+on the ModelAdapter instance and is set automatically at instantiation time
+by the calling Controller.
+
+This documentation is intended for ModelAdapter developers.
+
+=head1 CONFIGURATION
+
+You may configure your CXCM-derived Models in the usual way (see the Catalyst
+Manual).
+
+=head1 METHODS
+
+CatalystX::CRUD::Model inherits from CatalystX::CRUD.
+
+The following methods should be implemented in your subclass.
+
+=head2 new_object( I<context> )
+
+Should return a new instance from the Model you are adapting.
+
+=cut
+
+sub new_object { shift->throw_error("must implement new_object"); }
+
+=head2 fetch( I<context>, I<args> )
+
+Should return an instance of the Model you are adapting, based
+on I<args>.
+
+=cut
+
+sub fetch { shift->throw_error("must implement fetch") }
+
+=head2 search( I<context>, I<args> )
+
+Should return an arrayref of instances of the Model you are adapting,
+based on I<args>.
+
+=cut
+
+sub search { shift->throw_error("must implement search") }
+
+=head2 iterator( I<context>, I<args> )
+
+Should return an iterator of instances of the Model you are adapting,
+based on I<args>.
+
+=cut
+
+sub iterator { shift->throw_error("must implement iterator") }
+
+=head2 count( I<context>, I<args> )
+
+Should return an integer representing the numbef of matching instances
+of the Model you are adapting, based on I<args>.
+
+=cut
+
+sub count { shift->throw_error("must implement count") }
+
+=head2 make_query( I<context> )
+
+Should return appropriate values for passing to search(), iterator() and
+count(). See CataystX::CRUD::Model for examples.
+
+=cut
+
+sub make_query { shift->throw_error("must implement make_query()") }
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Peter Karman, C<< <perl at peknet.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-catalystx-crud at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc CatalystX::CRUD
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/CatalystX-CRUD>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/CatalystX-CRUD>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/CatalystX-CRUD>
+
+=back
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Peter Karman, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/REST.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/REST.pm 2008-03-17 14:56:17 UTC (rev 7507)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/REST.pm 2008-03-17 14:57:10 UTC (rev 7508)
@@ -4,6 +4,7 @@
use base qw( CatalystX::CRUD::Controller );
use Carp;
+use Data::Dump qw( dump );
our $VERSION = '0.26';
@@ -104,7 +105,8 @@
my $method = $self->req_method($c);
if ( !defined $oid && $method eq 'GET' ) {
- $c->action( $c->action->namespace . '/list' );
+ $c->action->name('list');
+ $c->action->reverse( join( '/', $c->action->namespace, 'list' ) );
return $self->list($c);
}
@@ -112,11 +114,17 @@
$self->fetch( $c, $oid );
# what RPC-style method to call
- my $to_call = defined($rpc) || $http_method_map{$method};
+ my $to_call = defined($rpc) ? $rpc : $http_method_map{$method};
+
+ # backwards compat naming for RPC style
+ if ( $to_call =~ m/^(create|edit)$/ ) {
+ $to_call .= '_form';
+ }
$c->log->debug("$method -> $to_call") if $c->debug;
- # so auto-template-deduction works just like RPC style
- $c->action( $c->action->namespace . '/' . $to_call );
+ # so TT (others?) auto-template-deduction works just like RPC style
+ $c->action->name($to_call);
+ $c->action->reverse( join( '/', $c->action->namespace, $to_call ) );
return $self->can($to_call) ? $self->$to_call($c) : $self->view($c);
}
@@ -154,6 +162,7 @@
sub edit {
my ( $self, $c ) = @_;
+ Data::Dump::dump $c->stash;
return $self->NEXT::edit($c);
}
Added: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm 2008-03-17 14:57:10 UTC (rev 7508)
@@ -0,0 +1,196 @@
+package CatalystX::CRUD::Test::Controller;
+use strict;
+use warnings;
+use base qw( CatalystX::CRUD::Controller );
+use Carp;
+use Data::Dump;
+
+our $VERSION = '0.26';
+
+=head1 NAME
+
+CatalystX::CRUD::Test::Controller - mock controller class for testing CatalystX::CRUD packages
+
+=head1 SYNOPSIS
+
+ package MyApp::Controller::Foo;
+ use strict;
+ use base qw( CatalystX::CRUD::Test::Controller );
+
+ use MyForm;
+
+ __PACKAGE__->config(
+ form_class => 'MyForm',
+ form_fields => [qw( one two three )],
+ init_form => 'init_with_foo',
+ init_object => 'foo_from_form',
+ default_template => 'no/such/file',
+ model_name => 'Foo',
+ primary_key => 'id',
+ view_on_single_result => 0,
+ page_size => 50,
+ allow_GET_writes => 0,
+ );
+
+ 1;
+
+
+=head1 DESCRIPTION
+
+CatalystX::CRUD::Test::Controller is a mock controller class for
+testing CatalystX::CRUD packages. It implements the required Controller
+methods and overrides others to work with CatalystX::CRUD::Test::Form.
+
+=head1 METHODS
+
+=head2 form_to_object
+
+The flow of this methods comes more or less verbatim from the RHTMLO controller.
+
+Returns the object from stash() initialized with the form and request params.
+
+=cut
+
+sub form_to_object {
+ my ( $self, $c ) = @_;
+ my $form = $c->stash->{form};
+ my $obj = $c->stash->{object};
+ my $obj_meth = $self->init_object;
+ my $form_meth = $self->init_form;
+ my $pk = $self->primary_key
+ ; # id always comes from url but not necessarily from form
+ my $id = $c->req->params->{$pk} || $c->stash->{object_id};
+
+ # initialize the form with the object's values
+ $form->$form_meth( $obj->delegate );
+
+ # set param values from request
+ $form->params( $c->req->params );
+ $form->param( $pk => $id );
+
+ # override form's values with those from params
+ # no_clear is important because we already initialized with object
+ # and we do not want to undo those mods.
+ $form->init_fields( no_clear => 1 );
+
+ # return if there was a problem with any param values
+ unless ( $form->validate() ) {
+ $c->stash->{error} = $form->error; # NOT throw_error()
+ $c->stash->{template} ||= $self->default_template; # MUST specify
+ return 0;
+ }
+
+ # re-set object's values from the now-valid form
+ $form->$obj_meth( $obj->delegate );
+
+ # set id explicitly since there's some bug
+ # with param() setting it in save()
+ $obj->$pk($id);
+
+ # let serial column work its magic
+ $obj->$pk(undef)
+ if ( !$obj->$pk || $obj->$pk eq '0' || $id eq '0' );
+
+ #carp "object $pk == $id ? " . $obj->$pk;
+
+ #carp $self->serialize_object( $c, $obj );
+
+ return $obj;
+}
+
+=head2 form
+
+Returns a new C<form_class> object every time, initialized with C<form_fields>.
+
+=cut
+
+sub form {
+ my ( $self, $c ) = @_;
+ my $form_class = $self->config->{form_class};
+ my $form = $form_class->new( { fields => $self->config->{form_fields} } );
+ return $form;
+}
+
+=head2 end
+
+Serializes the object with serialize_object()
+and sticks it in the response body().
+
+=cut
+
+sub end : Private {
+ my ( $self, $c ) = @_;
+ $c->res->body( $self->serialize_object( $c, $c->stash->{object} ) );
+}
+
+=head2 serialize_object( I<context>, I<object> )
+
+Serializes I<object> for response. Default is just to create hashref
+of key/value pairs and send through Data::Dump::dump().
+
+=cut
+
+sub serialize_object {
+ my ( $self, $c, $object ) = @_;
+ my $fields = $self->config->{form_fields};
+ my $serial = {};
+ for my $f (@$fields) {
+ $serial->{$f} = $object->$f;
+ }
+ return Data::Dump::dump($serial);
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Peter Karman, C<< <perl at peknet.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-catalystx-crud at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc CatalystX::CRUD
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/CatalystX-CRUD>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/CatalystX-CRUD>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/CatalystX-CRUD>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Peter Karman, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Added: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Form.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Form.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Form.pm 2008-03-17 14:57:10 UTC (rev 7508)
@@ -0,0 +1,222 @@
+package CatalystX::CRUD::Test::Form;
+use strict;
+use warnings;
+use Carp;
+use Data::Dump;
+use base qw( Class::Accessor::Fast );
+
+__PACKAGE__->mk_accessors(qw( params fields ));
+
+our $VERSION = '0.26';
+
+=head1 NAME
+
+CatalystX::CRUD::Test::Form - mock form class for testing CatalystX::CRUD packages
+
+=head1 SYNOPSIS
+
+ package MyApp::Form::Foo;
+ use strict;
+ use base qw( CatalystX::CRUD::Test::Form );
+
+ sub foo_from_form {
+ my $self = shift;
+ return $self->SUPER::object_from_form(@_);
+ }
+
+ sub init_with_foo {
+ my $self = shift;
+ return $self->SUPER::init_with_object(@_);
+ }
+
+ 1;
+
+
+=head1 DESCRIPTION
+
+CatalystX::CRUD::Test::Form is a mock form class for testing CatalystX::CRUD
+packages. The API is similar to Rose::HTML::Form, but implements very naive
+methods only.
+
+=head1 METHODS
+
+
+=head2 new( I<args> )
+
+Returns new object instance. I<args> must be a hashref and
+must contain at least a key/value pair for B<fields>.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ croak "fields() required to be an ARRAY ref"
+ unless $self->fields and ref( $self->fields ) eq 'ARRAY';
+ $self->params( { map { $_ => undef } @{ $self->fields } } )
+ unless $self->params;
+ return $self;
+}
+
+=head2 fields( [ I<arrayref> ] )
+
+Get/set the arrayref of field names.
+
+This must be set in new().
+
+=head2 params( [ I<hashref> ] )
+
+Get/set the hashref of key/value pairs for the form object. The keys should
+be the names of form fields and should match the value of fields().
+
+=head2 param( I<key> => I<val> )
+
+Sets the key/value pair for a field. I<key> should be the name of a field,
+as indicated by params().
+
+=cut
+
+sub param {
+ my $self = shift;
+ my $key = shift;
+ croak "key required" if !defined $key;
+ my $val = shift;
+ $self->params->{$key} = $val;
+}
+
+=head2 init_fields
+
+Placeholder only. Does nothing.
+
+=cut
+
+sub init_fields {
+ my $self = shift;
+
+ # nothing to do
+ #$self->dump;
+}
+
+=head2 clear
+
+Resets params() to an empty hashref.
+
+=cut
+
+sub clear {
+ my $self = shift;
+ $self->params( {} );
+}
+
+=head2 validate
+
+Does nothing. Always returns true.
+
+=cut
+
+sub validate {
+ my $self = shift;
+
+ # nothing to do in this poor man's form.
+ #$self->dump;
+
+ 1;
+}
+
+=head2 init_with_object( I<object> )
+
+You should override this method in your subclass. Basically sets all
+accessors in form equal to the equivalent value in I<object>.
+
+Returns the Form object.
+
+=cut
+
+sub init_with_object {
+ my ( $self, $object ) = @_;
+ for my $f ( keys %{ $self->params } ) {
+ $self->params->{$f} = $object->$f;
+ }
+ return $self;
+}
+
+=head2 object_from_form( I<object> )
+
+You should override this method in your subclass. Basically sets all
+accessors in I<object> equal to the equivalent value in form.
+
+=cut
+
+sub object_from_form {
+ my ( $self, $object ) = @_;
+ for my $f ( keys %{ $self->params } ) {
+ $object->$f( $self->params->{$f} );
+ }
+ return $object;
+}
+
+=head2 dump
+
+Wrapper around Data::Dump::dump. Returns the form object serialized.
+
+=cut
+
+sub dump {
+ my $self = shift;
+ Data::Dump::dump($self);
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Peter Karman, C<< <perl at peknet.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-catalystx-crud at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc CatalystX::CRUD
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/CatalystX-CRUD>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/CatalystX-CRUD>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/CatalystX-CRUD>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Peter Karman, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm 2008-03-17 14:56:17 UTC (rev 7507)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm 2008-03-17 14:57:10 UTC (rev 7508)
@@ -4,18 +4,12 @@
use strict;
use Catalyst::Exception;
+our $VERSION = '0.26';
+
=head1 NAME
CatalystX::CRUD - CRUD framework for Catalyst applications
-=head1 VERSION
-
-Version 0.01
-
-=cut
-
-our $VERSION = '0.26';
-
=head1 DESCRIPTION
This document is an overview of the CatalystX::CRUD framework and API.
@@ -106,6 +100,8 @@
=head1 ACKNOWLEDGEMENTS
+Thanks to Zbigniew Lukasiak and Matt Trout for feedback and API ideas.
+
=head1 COPYRIGHT & LICENSE
Copyright 2007 Peter Karman, all rights reserved.
More information about the Catalyst-commits
mailing list