[Catalyst-commits] r7597 - in CatalystX-CRUD/CatalystX-CRUD/trunk:
. lib/CatalystX lib/CatalystX/CRUD lib/CatalystX/CRUD/Model
lib/CatalystX/CRUD/ModelAdapter lib/CatalystX/CRUD/Object
lib/CatalystX/CRUD/Test t t/lib t/lib/MyApp
t/lib/MyApp/Controller t/lib/MyApp/Model
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Mon Apr 7 20:37:32 BST 2008
Author: karpet
Date: 2008-04-07 20:37:32 +0100 (Mon, 07 Apr 2008)
New Revision: 7597
Added:
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/File.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapter.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Form.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Model/FileAdapter.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/File.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/01-file.t
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/File.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Model/File.pm
Log:
* move AUTOLOAD() and can() hackery out of base Model into base
Object where it belongs. Now there is only 2 sins instead of the 3 in previous releases
(where we no longer monkey-patch the subs at run time).
* refactor tests to actually perform some CRUD.
* add ::ModelAdapter::File example.
* add envvar CXCRUD_TEST in base CX::CRUD to cluck() stack traces on exceptions. Mostly
useful during testing since the ::Test::Controller now returns only the error.
* renamed 'buffer' to 'content' in ::Object::File.
* ::Model::File->fetch() will now always return an object even if it does not yet
exist on the filesystem.
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/Changes
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/Changes 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/Changes 2008-04-07 19:37:32 UTC (rev 7597)
@@ -103,6 +103,16 @@
* 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.
+ * move AUTOLOAD() and can() hackery out of base Model into base Object where it belongs.
+ Now there is only 2 sins instead of the 3 in previous releases (where we no longer
+ monkey-patch the subs at run time).
+ * refactor tests to actually perform some CRUD.
+ * add ::ModelAdapter::File example.
+ * add envvar CXCRUD_TEST in base CX::CRUD to cluck() stack traces on exceptions. Mostly
+ useful during testing since the ::Test::Controller now returns only the error.
+ * renamed 'buffer' to 'content' in ::Object::File.
+ * ::Model::File->fetch() will now always return an object even if it does not yet
+ exist on the filesystem.
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -24,18 +24,18 @@
use base qw( CatalystX::CRUD::Controller );
__PACKAGE__->config(
- form_class => 'MyForm::Foo',
- init_form => 'init_with_foo',
- init_object => 'foo_from_form',
- default_template => 'path/to/foo/edit.tt',
- model_name => 'Foo',
- model_adapter => 'FooAdapter', # optional
- model_meta => { moniker => 'SomeTable' }, # optional
- primary_key => 'id',
- view_on_single_result => 0,
- page_size => 50,
- allow_GET_writes => 0,
- );
+ form_class => 'MyForm::Foo',
+ init_form => 'init_with_foo',
+ init_object => 'foo_from_form',
+ default_template => 'path/to/foo/edit.tt',
+ model_name => 'Foo',
+ model_adapter => 'FooAdapter', # optional
+ model_meta => { moniker => 'SomeTable' }, # optional
+ primary_key => 'id',
+ view_on_single_result => 0,
+ page_size => 50,
+ allow_GET_writes => 0,
+ );
1;
@@ -514,8 +514,7 @@
$c->response->redirect( $c->uri_for('') );
}
else {
- $c->response->redirect(
- $c->uri_for( '', $o->delegate->$pk, 'view' ) );
+ $c->response->redirect( $c->uri_for( '', $o->$pk, 'view' ) );
}
1;
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -57,7 +57,10 @@
I<path/to/file> is assumed to be in C<inc_path>
-If I<path/to/file> is empty or cannot be found, undef is returned.
+If I<path/to/file> is empty or cannot be found, the
+CatalystX::CRUD::Object::File object is returned but its content()
+will be undef. If its parent dir is '.', its dir()
+will be set to the first item in inc_path().
=cut
@@ -77,7 +80,13 @@
}
}
- return -s $file ? $file : undef;
+ # test if we found it or not
+ if ( $file->dir eq '.' ) {
+ $file = $self->object_class->new(
+ file => Path::Class::File->new( $self->inc_path->[0], $file ) );
+ }
+
+ return $file;
}
=head2 inc_path
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -108,48 +108,6 @@
}
$self->object_class($object_class);
- # some black magic hackery to make Object classes act like
- # they're overloaded delegate()s
- {
- no strict 'refs';
- no warnings 'redefine';
- *{ $object_class . '::AUTOLOAD' } = sub {
- my $obj = shift;
- my $obj_class = ref($obj) || $obj;
- my $method = our $AUTOLOAD;
- $method =~ s/.*://;
- return if $method eq 'DESTROY';
- if ( $obj->delegate->can($method) ) {
- return $obj->delegate->$method(@_);
- }
-
- $obj->throw_error(
- "method '$method' not implemented in class '$obj_class'");
-
- };
-
- # this overrides the basic $object_class->can
- # to always call secondary can() on its delegate.
- # we have to UNIVERSAL::can because we are overriding can()
- # in $class and would otherwise have a recursive nightmare.
- *{ $object_class . '::can' } = sub {
- my ( $obj, $method, @arg ) = @_;
- if ( ref($obj) ) {
-
- # object method tries object_class first,
- # then the delegate().
- return UNIVERSAL::can( $object_class, $method )
- || $obj->delegate->can( $method, @arg );
- }
- else {
-
- # class method
- return UNIVERSAL::can( $object_class, $method );
- }
- };
-
- }
-
}
if ( !defined $self->config->{page_size} ) {
$self->config->{page_size} = 50;
Added: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/File.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/File.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -0,0 +1,157 @@
+package CatalystX::CRUD::ModelAdapter::File;
+use strict;
+use warnings;
+use base qw(
+ CatalystX::CRUD::ModelAdapter
+ CatalystX::CRUD::Model::File
+ CatalystX::CRUD::Model::Utils
+);
+
+our $VERSION = '0.26';
+
+=head1 NAME
+
+CatalystX::CRUD::ModelAdapter::File - filesystem CRUD model adapter
+
+=head1 SYNOPSIS
+
+ package MyApp::Controller::Foo;
+ __PACKAGE__->config(
+ # ... other config here
+ model_adapter => 'CatalystX::CRUD::ModelAdapter::File',
+ model_name => 'MyFile',
+ );
+
+ 1;
+
+=head1 DESCRIPTION
+
+CatalystX::CRUD::ModelAdapter::File is an example
+implementation of CatalystX::CRUD::ModelAdapter. It basically proxies
+for CatalystX::CRUD::Model::File.
+
+=head1 METHODS
+
+Only new or overridden methods are documented here.
+
+=cut
+
+# must implement the following methods
+# but we just end up calling the Model::File superclass
+
+=head2 new_object( I<context>, I<args> )
+
+Implements required method.
+
+=cut
+
+sub new_object {
+ my ( $self, $c, @arg ) = @_;
+ $self->SUPER::new_object(@arg);
+}
+
+=head2 fetch( I<context>, I<args> )
+
+Implements required method.
+
+=cut
+
+sub fetch {
+ my ( $self, $c, @arg ) = @_;
+ $self->SUPER::new_object(@arg);
+}
+
+=head2 search( I<context>, I<args> )
+
+Implements required method.
+
+=cut
+
+sub search {
+ my ( $self, $c, @arg ) = @_;
+ $self->SUPER::new_object(@arg);
+}
+
+=head2 iterator( I<context>, I<args> )
+
+Implements required method.
+
+=cut
+
+sub iterator {
+ my ( $self, $c, @arg ) = @_;
+ $self->SUPER::new_object(@arg);
+}
+
+=head2 count( I<context>, I<args> )
+
+Implements required method.
+
+=cut
+
+sub count {
+ my ( $self, $c, @arg ) = @_;
+ $self->SUPER::new_object(@arg);
+}
+
+=head2 make_query( I<context>, I<args> )
+
+Implements required method.
+
+=cut
+
+sub make_query {
+ my ( $self, $c, @arg ) = @_;
+ $self->SUPER::new_object(@arg);
+}
+
+1;
+
+=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/Object/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -10,7 +10,7 @@
fallback => 1,
);
-__PACKAGE__->mk_accessors(qw( buffer ));
+__PACKAGE__->mk_accessors(qw( content file ));
our $VERSION = '0.26';
@@ -49,7 +49,7 @@
return $self;
}
-=head2 buffer
+=head2 content
The contents of the delegate() file object. Set when you call read().
Set it yourself and call create() or update() as appropriate to write to the file.
@@ -58,7 +58,7 @@
=head2 create
-Writes buffer() to a file. If the file already exists, will throw_error(), so
+Writes content() to a file. If the file already exists, will throw_error(), so
call it like:
-s $file ? $file->update : $file->create;
@@ -81,7 +81,7 @@
=head2 read
-Slurp contents of file into buffer(). No check is performed as to whether
+Slurp contents of file into content(). No check is performed as to whether
the file exists, so call like:
$file->read if -s $file;
@@ -90,7 +90,7 @@
sub read {
my $self = shift;
- $self->{buffer} = $self->delegate->slurp;
+ $self->{content} = $self->delegate->slurp;
return $self;
}
@@ -119,10 +119,10 @@
sub _write {
my $self = shift;
- my $dir = $self->delegate->dir;
+ my $dir = $self->delegate->dir;
$dir->mkpath;
- my $fh = $self->delegate->openw();
- print {$fh} $self->buffer;
+ my $fh = $self->delegate->openw();
+ print {$fh} $self->content;
$fh->close;
return -s $self->delegate;
}
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -1,7 +1,7 @@
package CatalystX::CRUD::Object;
use strict;
use warnings;
-use base qw( CatalystX::CRUD Class::Accessor::Fast );
+use base qw( Class::Accessor::Fast CatalystX::CRUD );
use Carp;
__PACKAGE__->mk_ro_accessors(qw( delegate ));
@@ -97,6 +97,56 @@
sub update { shift->throw_error("must implement update") }
sub delete { shift->throw_error("must implement delete") }
+=head2 AUTOLOAD
+
+Some black magic hackery to make Object classes act like
+they are overloaded delegate()s.
+
+=cut
+
+sub AUTOLOAD {
+ my $obj = shift;
+ my $obj_class = ref($obj) || $obj;
+ my $method = our $AUTOLOAD;
+ $method =~ s/.*://;
+ return if $method eq 'DESTROY';
+ if ( $obj->delegate->can($method) ) {
+ return $obj->delegate->$method(@_);
+ }
+
+ $obj->throw_error(
+ "method '$method' not implemented in class '$obj_class'");
+
+}
+
+# this overrides the basic can()
+# to always call secondary can() on its delegate.
+# we have to UNIVERSAL::can because we are overriding can()
+# and would otherwise have a recursive nightmare.
+
+=head2 can( I<method> )
+
+Overrides basic can() method to call can() first on the delegate
+and secondly (fallback) on the Object class itself.
+
+=cut
+
+sub can {
+ my ( $obj, $method, @arg ) = @_;
+ if ( ref($obj) ) {
+
+ # object method tries object_class first,
+ # then the delegate().
+ return UNIVERSAL::can( ref($obj), $method )
+ || $obj->delegate->can( $method, @arg );
+ }
+ else {
+
+ # class method
+ return UNIVERSAL::can( $obj, $method );
+ }
+}
+
1;
__END__
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -62,7 +62,7 @@
my $id = $c->req->params->{$pk} || $c->stash->{object_id};
# initialize the form with the object's values
- $form->$form_meth( $obj->delegate );
+ $form->$form_meth($obj);
# set param values from request
$form->params( $c->req->params );
@@ -81,7 +81,7 @@
}
# re-set object's values from the now-valid form
- $form->$obj_meth( $obj->delegate );
+ $form->$obj_meth($obj);
# set id explicitly since there's some bug
# with param() setting it in save()
@@ -113,14 +113,24 @@
=head2 end
-Serializes the object with serialize_object()
+If the stash() has an 'object' defined,
+serializes the object with serialize_object()
and sticks it in the response body().
+If there are any errors, replaces the normal Catalyst debug screen
+with contents of $c->error.
+
=cut
sub end : Private {
my ( $self, $c ) = @_;
- $c->res->body( $self->serialize_object( $c, $c->stash->{object} ) );
+ if ( defined $c->stash->{object} ) {
+ $c->res->body( $self->serialize_object( $c, $c->stash->{object} ) );
+ }
+ if ( @{ $c->error } ) {
+ $c->res->body( join( "\n", @{ $c->error } ) );
+ $c->clear_errors;
+ }
}
=head2 serialize_object( I<context>, I<object> )
@@ -135,7 +145,7 @@
my $fields = $self->config->{form_fields};
my $serial = {};
for my $f (@$fields) {
- $serial->{$f} = $object->$f;
+ $serial->{$f} = defined $object->$f ? $object->$f . '' : undef;
}
return Data::Dump::dump($serial);
}
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -55,6 +55,9 @@
sub throw_error {
my $self = shift;
my $msg = shift || 'unknown error';
+ if ( $ENV{CXCRUD_TEST} ) {
+ Carp::cluck();
+ }
Catalyst::Exception->throw($msg);
}
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/01-file.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/01-file.t 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/01-file.t 2008-04-07 19:37:32 UTC (rev 7597)
@@ -1,15 +1,16 @@
-use Test::More tests => 6;
+use Test::More tests => 15;
+use lib qw( lib t/lib );
+use_ok('CatalystX::CRUD::Model::File');
+use_ok('CatalystX::CRUD::Object::File');
-BEGIN {
- use lib qw( ../CatalystX-CRUD/lib );
- use_ok('CatalystX::CRUD::Model::File');
- use_ok('CatalystX::CRUD::Object::File');
-}
-
-use lib qw( t/lib );
use Catalyst::Test 'MyApp';
use Data::Dump qw( dump );
+use HTTP::Request::Common;
+$ENV{CXCRUD_TEST} = 1; # we want stack traces in exceptions
+
+###########################################
+# set up the test env and config
ok( get('/foo'), "get /foo" );
ok( my $response = request('/file/search'), "response for /file/search" );
@@ -20,3 +21,50 @@
ok( get('/autoload'), "get /autoload" );
+###########################################
+# do CRUD stuff
+
+my $res;
+
+# create
+ok( $res = request(
+ POST( '/file/testfile/save', [ content => 'hello world' ] )
+ ),
+ "POST new file"
+);
+
+is( $res->content,
+ '{ content => "hello world", file => "testfile" }',
+ "POST new file response"
+);
+
+# read the file we just created
+ok( $res = request( HTTP::Request->new( GET => '/file/testfile/view' ) ),
+ "GET new file" );
+
+#diag( $res->content );
+
+like( $res->content, qr/content => "hello world"/, "read file" );
+
+# update the file
+ok( $res = request(
+ POST( '/file/testfile/save', [ content => 'foo bar baz' ] )
+ ),
+ "update file"
+);
+
+like( $res->content, qr/content => "foo bar baz"/, "update file" );
+
+# delete the file
+
+ok( $res = request( POST( '/file/testfile/rm', [] ) ), "rm file" );
+
+#diag( $res->content );
+
+# confirm it is gone
+ok( $res = request( HTTP::Request->new( GET => '/file/testfile/view' ) ),
+ "confirm we nuked the file" );
+
+#diag( $res->content );
+
+like( $res->content, qr/content => undef/, "file nuked" );
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/File.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/File.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -1,29 +1,25 @@
package MyApp::Controller::File;
use strict;
-use base qw( CatalystX::CRUD::Controller );
+use base qw( CatalystX::CRUD::Test::Controller );
use Carp;
use Data::Dump qw( dump );
use File::Temp;
+use MyApp::Form;
-# test the view_on_single_result method
-# search for a file where we know there is only one
-# and then check for a redirect response code
-# NOTE we have to fake up the primary_key method
-# to just return the file path (the unique id)
-# and the form class to just use a dummy
-
-{
-
- package NoForm;
- sub new { return bless( {}, shift(@_) ); }
-}
-
__PACKAGE__->config(
primary_key => 'absolute',
- form_class => 'NoForm',
+ form_class => 'MyApp::Form',
+ form_fields => [qw( file content )],
model_name => 'File',
+ primary_key => 'file',
+ init_form => 'init_with_file',
+ init_object => 'file_from_form',
);
+# test the view_on_single_result method
+# search for a file where we know there is only one
+# and then check for a redirect response code
+
sub do_search {
my ( $self, $c, @arg ) = @_;
@@ -31,9 +27,10 @@
$self->config->{view_on_single_result} = 1;
my $tmpf = File::Temp->new;
-
- my $file = $c->model( $self->model_name )->new_object( file => $tmpf->filename );
-
+
+ my $file = $c->model( $self->model_name )
+ ->new_object( file => $tmpf->filename );
+
if ( my $uri = $self->view_on_single_result( $c, [$file] ) ) {
$c->response->redirect($uri);
return;
@@ -43,5 +40,4 @@
}
-
1;
Added: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapter.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapter.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapter.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -0,0 +1,20 @@
+package MyApp::Controller::FileAdapter;
+use strict;
+use base qw( CatalystX::CRUD::Test::Controller );
+use Carp;
+use Data::Dump qw( dump );
+use File::Temp;
+use MyApp::Form;
+
+__PACKAGE__->config(
+ primary_key => 'absolute',
+ form_class => 'MyApp::Form',
+ form_fields => [qw( file content )],
+ model_adapter => 'CatalystX::CRUD::ModelAdapter::File',
+ model_name => 'FileAdapter',
+ primary_key => 'file',
+ init_form => 'init_with_file',
+ init_object => 'file_from_form',
+);
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Form.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Form.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Form.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -0,0 +1,15 @@
+package MyApp::Form;
+use strict;
+use base qw( CatalystX::CRUD::Test::Form );
+
+sub file_from_form {
+ my $self = shift;
+ return $self->SUPER::object_from_form(@_);
+}
+
+sub init_with_file {
+ my $self = shift;
+ return $self->SUPER::init_with_object(@_);
+}
+
+1;
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Model/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Model/File.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Model/File.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -1,4 +1,5 @@
package MyApp::Model::File;
+use strict;
use base qw( CatalystX::CRUD::Model::File );
use MyApp::File;
__PACKAGE__->config->{object_class} = 'MyApp::File';
Added: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Model/FileAdapter.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Model/FileAdapter.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Model/FileAdapter.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -0,0 +1,9 @@
+package MyApp::Model::FileAdapter;
+use strict;
+use base qw( CatalystX::CRUD::Model::File );
+use MyApp::File;
+
+# don't think we need/want this do we?
+__PACKAGE__->config->{object_class} = 'MyApp::File';
+
+1;
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp.pm 2008-04-07 18:58:41 UTC (rev 7596)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp.pm 2008-04-07 19:37:32 UTC (rev 7597)
@@ -5,7 +5,7 @@
use Data::Dump qw( dump );
use File::Temp;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
__PACKAGE__->setup();
@@ -24,7 +24,7 @@
#carp dump $file;
- $file->buffer('hello world');
+ $file->content('hello world');
$file->create;
@@ -43,11 +43,11 @@
$file->read;
- if ( $file->buffer ne 'hello world' ) {
+ if ( $file->content ne 'hello world' ) {
croak "bad read";
}
- $file->buffer('change the text');
+ $file->content('change the text');
#carp dump $file;
More information about the Catalyst-commits
mailing list