[Catalyst-commits] r7507 - in
CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t: . lib
lib/MyApp/Controller
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Mon Mar 17 14:56:18 GMT 2008
Author: karpet
Date: 2008-03-17 14:56:17 +0000 (Mon, 17 Mar 2008)
New Revision: 7507
Modified:
CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/00-load.t
CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/01-dbic.t
CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/lib/MyApp/Controller/CRUD.pm
CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/lib/MyForm.pm
Log:
move test form and controller into base CX::CRUD::Test classes
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/00-load.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/00-load.t 2008-03-15 05:21:42 UTC (rev 7506)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/00-load.t 2008-03-17 14:56:17 UTC (rev 7507)
@@ -1,7 +1,7 @@
#!perl -T
use Test::More tests => 1;
-use lib qw( ../CatalystX-CRUD/lib t );
+use lib qw( ../../CatalystX-CRUD/trunk/lib t );
BEGIN {
use_ok( 'CatalystX::CRUD::Model::DBIC' );
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/01-dbic.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/01-dbic.t 2008-03-15 05:21:42 UTC (rev 7506)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/01-dbic.t 2008-03-17 14:56:17 UTC (rev 7507)
@@ -1,7 +1,7 @@
use Test::More tests => 14;
BEGIN {
- use lib qw( ../CatalystX-CRUD/lib t );
+ use lib qw( ../../CatalystX-CRUD/trunk/lib t );
use_ok('CatalystX::CRUD::Model::DBIC');
use_ok('CatalystX::CRUD::Object::DBIC');
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/lib/MyApp/Controller/CRUD.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/lib/MyApp/Controller/CRUD.pm 2008-03-15 05:21:42 UTC (rev 7506)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/lib/MyApp/Controller/CRUD.pm 2008-03-17 14:56:17 UTC (rev 7507)
@@ -1,13 +1,14 @@
package MyApp::Controller::CRUD;
use strict;
use warnings;
-use base qw( CatalystX::CRUD::Controller );
+use base qw( CatalystX::CRUD::Test::Controller );
use Carp;
use Data::Dump;
use MyForm;
__PACKAGE__->config(
form_class => 'MyForm',
+ form_fields => [qw( title cd trackid )],
init_form => 'init_with_track',
init_object => 'track_from_form',
default_template => 'no/such/file',
@@ -18,67 +19,7 @@
allow_GET_writes => 0,
);
-sub form {
- my ( $self, $c ) = @_;
- my $form = $self->SUPER::form($c);
- $form->fields( [qw( title cd trackid )] );
- return $form;
-}
-
-# this more or less verbatim from RHTMLO controller.
-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( $c, $obj );
-
- return $obj;
-}
-
-sub end : Private {
- my ( $self, $c ) = @_;
- $c->res->body( $self->serialize( $c, $c->stash->{object} ) );
-}
-
-sub serialize {
+sub serialize_object {
my ( $self, $c, $object ) = @_;
my $fields = $c->stash->{form}->fields;
my $serial = {};
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/lib/MyForm.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/lib/MyForm.pm 2008-03-15 05:21:42 UTC (rev 7506)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-DBIC/trunk/t/lib/MyForm.pm 2008-03-17 14:56:17 UTC (rev 7507)
@@ -1,71 +1,15 @@
package MyForm;
use strict;
-use warnings;
-use Carp;
-use Data::Dump;
-use base qw( Class::Accessor::Fast );
+use base qw( CatalystX::CRUD::Test::Form );
-__PACKAGE__->mk_accessors(qw( params fields ));
-
-# poor man's form class
-
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
- $self->params( {} );
- return $self;
-}
-
-sub param {
+sub init_with_track {
my $self = shift;
- my $key = shift;
- croak "key required" if !defined $key;
- my $val = shift;
- $self->params->{$key} = $val;
+ return $self->SUPER::init_with_object(@_);
}
-sub init_fields {
- my $self = shift;
-
- # nothing to do
- #$self->dump;
-}
-
-sub clear {
- my $self = shift;
- $self->params( {} );
-}
-
-sub validate {
- my $self = shift;
-
- # nothing to do in this poor man's form.
- #$self->dump;
-
- 1;
-}
-
-sub init_with_track {
- my ( $self, $track ) = @_;
- for my $f ( keys %{ $self->params } ) {
- $self->params->{$f} = $track->$f;
- }
- #$self->dump;
- return $self;
-}
-
sub track_from_form {
- my ( $self, $track ) = @_;
- for my $f ( keys %{ $self->params } ) {
- $track->$f( $self->params->{$f} );
- }
- #Data::Dump::dump($track);
- return $track;
-}
-
-sub dump {
my $self = shift;
- Data::Dump::dump($self);
+ return $self->SUPER::object_from_form(@_);
}
1;
More information about the Catalyst-commits
mailing list