[Catalyst-commits] r14379 - 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/MyApp/Controller
t/lib/MyApp/Controller/REST
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Sun Nov 4 03:10:37 GMT 2012
Author: karpet
Date: 2012-11-04 03:10:37 +0000 (Sun, 04 Nov 2012)
New Revision: 14379
Added:
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ControllerRole.pm
Modified:
CatalystX-CRUD/CatalystX-CRUD/trunk/MANIFEST
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/File.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/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/Results.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/Controller/FetchRewrite.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/File.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapter.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapterMultiPK.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/REST/File.pm
Log:
refactor some Controller methods into a Role class; Model::File->fetch() now returns undef if file does not exist
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/MANIFEST
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/MANIFEST 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/MANIFEST 2012-11-04 03:10:37 UTC (rev 14379)
@@ -1,6 +1,7 @@
Changes
lib/CatalystX/CRUD.pm
lib/CatalystX/CRUD/Controller.pm
+lib/CatalystX/CRUD/ControllerRole.pm
lib/CatalystX/CRUD/Iterator.pm
lib/CatalystX/CRUD/Iterator/File.pm
lib/CatalystX/CRUD/Model.pm
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Controller.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -1,10 +1,12 @@
package CatalystX::CRUD::Controller;
-use strict;
-use warnings;
-use base qw(
- CatalystX::CRUD
- Catalyst::Controller
-);
+use Moose;
+
+BEGIN {
+ extends qw(
+ CatalystX::CRUD
+ Catalyst::Controller
+ );
+}
use Carp;
use Catalyst::Utils;
use CatalystX::CRUD::Results;
@@ -37,6 +39,9 @@
naked_results => 0,
);
+# apply Role *after* we declare accessors above
+with 'CatalystX::CRUD::ControllerRole';
+
our $VERSION = '0.53_01';
=head1 NAME
@@ -171,103 +176,6 @@
}
}
-=head2 get_primary_key( I<context>, I<pk_value> )
-
-Should return an array of the name of the field(s) to fetch() I<pk_value> from
-and their respective values.
-
-The default behaviour is to return B<primary_key> and the
-corresponding value(s) from I<pk_value>.
-
-However, if you have other unique fields in your schema, you
-might return a unique field other than the primary key.
-This allows for a more flexible URI scheme.
-
-A good example is Users. A User record might have a numerical id (uid)
-and a username, both of which are unique. So if username 'foobar'
-has a B<primary_key> (uid) of '1234', both these URIs could fetch the same
-record:
-
- /uri/for/user/1234
- /uri/for/user/foobar
-
-Again, the default behaviour is to return the B<primary_key> field name(s)
-from config() (accessed via $self->primary_key) but you can override
-get_primary_key() in your subclass to provide more flexibility.
-
-If your primary key is composed of multiple columns, your return value
-should include all those columns and their values as extracted
-from I<pk_value>. Multiple values are assumed to be joined with C<;;>.
-See make_primary_key_string().
-
-=cut
-
-sub get_primary_key {
- my ( $self, $c, $id ) = @_;
- return () unless defined $id and length $id;
- my $pk = $self->primary_key;
- my @ret;
- if ( ref $pk ) {
- my @val = split( m/;;/, $id );
- for my $col (@$pk) {
- push( @ret, $col => shift(@val) );
- }
- }
- else {
- @ret = ( $pk => $id );
- }
- return @ret;
-}
-
-=head2 make_primary_key_string( I<object> )
-
-Using value of B<primary_string> constructs a URI-ready
-string based on values in I<object>. I<object> is often
-the value of:
-
- $c->stash->{object}
-
-but could be any object that has accessor methods with
-the same names as the field(s) specified by B<primary_key>.
-
-Multiple values are joined with C<;;> and any C<;> or C</> characters
-in the column values are URI-escaped.
-
-=cut
-
-sub make_primary_key_string {
- my ( $self, $obj ) = @_;
- my $pk = $self->primary_key;
- my $id;
- if ( ref $pk ) {
- my @vals;
- for my $field (@$pk) {
- my $v = scalar $obj->$field;
- $v = '' unless defined $v;
- $v =~ s/;/\%3b/g;
- push( @vals, $v );
- }
-
- # if we had no vals, return undef
- if ( !grep {length} @vals ) {
- return $id;
- }
-
- $id = join( ';;', @vals );
- }
- else {
- $id = $obj->$pk;
- }
-
- return $id unless defined $id;
-
- # must escape any / in $id since passing it to uri_for as-is
- # will break.
- $id =~ s!/!\%2f!g;
-
- return $id;
-}
-
=head2 create
Attribute: Local
@@ -393,13 +301,7 @@
sub save : PathPart Chained('fetch') Args(0) {
my ( $self, $c ) = @_;
- if ( !$self->allow_GET_writes ) {
- if ( $c->req->method ne 'POST' ) {
- $c->res->status(400);
- $c->res->body('GET request not allowed');
- return;
- }
- }
+ $self->_check_idempotent($c);
if ($c->request->params->{'_delete'}
or ( exists $c->request->params->{'x-tunneled-method'}
@@ -458,13 +360,7 @@
sub rm : PathPart Chained('fetch') Args(0) {
my ( $self, $c ) = @_;
- if ( !$self->allow_GET_writes ) {
- if ( $c->req->method ne 'POST' ) {
- $c->res->status(400);
- $c->res->body('GET request not allowed');
- return;
- }
- }
+ $self->_check_idempotent($c);
return if $self->has_errors($c);
unless ( $self->can_write($c) ) {
$self->throw_error('Permission denied');
@@ -606,11 +502,11 @@
sub _check_idempotent {
my ( $self, $c ) = @_;
if ( !$self->allow_GET_writes ) {
- if ( uc( $c->req->method ) ne 'POST' ) {
+ if ( uc( $c->req->method ) eq 'GET' ) {
$c->log->warn( "allow_GET_writes!=true, related method="
. uc( $c->req->method ) );
$c->res->status(405);
- $c->res->header( 'Allow' => 'POST' );
+ $c->res->header( 'Allow' => 'POST,PUT,DELETE' );
$c->res->body('GET request not allowed');
$c->stash->{error} = 1; # so has_errors() will return true
return;
@@ -747,59 +643,10 @@
sub new {
my ( $class, $app_class, $args ) = @_;
my $self = $class->next::method( $app_class, $args );
-
- # if model_adapter class is defined, load and instantiate it.
- if ( $self->model_adapter ) {
- Catalyst::Utils::ensure_class_loaded( $self->model_adapter );
- $self->model_adapter(
- $self->model_adapter->new(
- { model_name => $self->model_name,
- model_meta => $self->model_meta,
- app_class => $app_class,
- }
- )
- );
- }
+ $self->instantiate_model_adapter($app_class);
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( $self, $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
Added: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ControllerRole.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ControllerRole.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ControllerRole.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -0,0 +1,175 @@
+package CatalystX::CRUD::ControllerRole;
+use Moose::Role;
+use Catalyst::Utils;
+
+requires 'throw_error';
+requires 'model_adapter';
+requires 'model_name';
+
+has 'primary_key' => (
+ is => 'rw',
+ isa => 'String',
+);
+
+=head2 get_primary_key( I<context>, I<pk_value> )
+
+Should return an array of the name of the field(s) to fetch() I<pk_value> from
+and their respective values.
+
+The default behaviour is to return B<primary_key> and the
+corresponding value(s) from I<pk_value>.
+
+However, if you have other unique fields in your schema, you
+might return a unique field other than the primary key.
+This allows for a more flexible URI scheme.
+
+A good example is Users. A User record might have a numerical id (uid)
+and a username, both of which are unique. So if username 'foobar'
+has a B<primary_key> (uid) of '1234', both these URIs could fetch the same
+record:
+
+ /uri/for/user/1234
+ /uri/for/user/foobar
+
+Again, the default behaviour is to return the B<primary_key> field name(s)
+from config() (accessed via $self->primary_key) but you can override
+get_primary_key() in your subclass to provide more flexibility.
+
+If your primary key is composed of multiple columns, your return value
+should include all those columns and their values as extracted
+from I<pk_value>. Multiple values are assumed to be joined with C<;;>.
+See make_primary_key_string().
+
+=cut
+
+sub get_primary_key {
+ my ( $self, $c, $id ) = @_;
+ return () unless defined $id and length $id;
+ my $pk = $self->primary_key;
+ my @ret;
+ if ( ref $pk ) {
+ my @val = split( m/;;/, $id );
+ for my $col (@$pk) {
+ push( @ret, $col => shift(@val) );
+ }
+ }
+ else {
+ @ret = ( $pk => $id );
+ }
+ return @ret;
+}
+
+=head2 make_primary_key_string( I<object> )
+
+Using value of B<primary_string> constructs a URI-ready
+string based on values in I<object>. I<object> is often
+the value of:
+
+ $c->stash->{object}
+
+but could be any object that has accessor methods with
+the same names as the field(s) specified by B<primary_key>.
+
+Multiple values are joined with C<;;> and any C<;> or C</> characters
+in the column values are URI-escaped.
+
+=cut
+
+sub make_primary_key_string {
+ my ( $self, $obj ) = @_;
+ my $pk = $self->primary_key;
+ my $id;
+ if ( ref $pk ) {
+ my @vals;
+ for my $field (@$pk) {
+ my $v = scalar $obj->$field;
+ $v = '' unless defined $v;
+ $v =~ s/;/\%3b/g;
+ push( @vals, $v );
+ }
+
+ # if we had no vals, return undef
+ if ( !grep {length} @vals ) {
+ return $id;
+ }
+
+ $id = join( ';;', @vals );
+ }
+ else {
+ $id = $obj->$pk;
+ }
+
+ return $id unless defined $id;
+
+ # must escape any / in $id since passing it to uri_for as-is
+ # will break.
+ $id =~ s!/!\%2f!g;
+
+ return $id;
+}
+
+=head2 instantiate_model_adapter( I<app_class> )
+
+If model_adapter() is set to a string of the adapter class
+name, this method will instantiate
+the model_adapter with its new() method, passing in
+model_name(), model_meta() and I<app_class>.
+
+=cut
+
+sub instantiate_model_adapter {
+ my $self = shift;
+ my $app_class = shift or $self->throw_error("app_class required");
+
+ # if model_adapter class is defined, load and instantiate it.
+ if ( $self->model_adapter ) {
+ Catalyst::Utils::ensure_class_loaded( $self->model_adapter );
+ $self->model_adapter(
+ $self->model_adapter->new(
+ { model_name => $self->model_name,
+ model_meta => $self->model_meta,
+ app_class => $app_class,
+ }
+ )
+ );
+ }
+}
+
+=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( $self, $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);
+ }
+}
+
+1;
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -72,17 +72,39 @@
I<path/to/file> is assumed to be in C<inc_path>
-If I<path/to/file> is empty or cannot be found, the
+If I<path/to/file> is empty, 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().
+If I<path/to/file> is not found, undef is returned.
+
=cut
sub fetch {
my $self = shift;
my $file = $self->new_object(@_);
+ $file = $self->prep_new_object($file);
+ return defined -s $file ? $file : undef;
+}
+=head2 prep_new_object( I<file> )
+
+Searches inc_path() and calls I<file> read() method
+if file is found.
+
+Also verifies that the delegate() has an absolute path set.
+
+Called internally by fetch().
+
+Returns I<file>.
+
+=cut
+
+sub prep_new_object {
+ my $self = shift;
+ my $file = shift or croak "file required";
+
# look through inc_path
for my $dir ( @{ $self->inc_path } ) {
my $test = $self->object_class->delegate_class->new( $dir, $file );
@@ -105,7 +127,6 @@
}
#carp dump $file;
-
return $file;
}
@@ -129,7 +150,7 @@
return sub {
my ( $root, $dir, $f ) = @_;
return 0
- if $dir =~ m!/\.(svn|git)!;
+ if $dir and $dir =~ m!/\.(svn|git)!;
return 1;
};
}
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/File.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/ModelAdapter/File.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -32,7 +32,7 @@
=cut
-=head2 new_object( I<context>, I<args> )
+=head2 new_object( I<controller>, I<context>, I<args> )
Implements required method.
@@ -44,7 +44,7 @@
$model->new_object(@arg);
}
-=head2 fetch( I<context>, I<args> )
+=head2 fetch( I<controller>, I<context>, I<args> )
Implements required method.
@@ -56,6 +56,18 @@
$model->fetch(@arg);
}
+=head2 prep_new_object( I<controller>, I<context>, I<file> )
+
+Implements required method.
+
+=cut
+
+sub prep_new_object {
+ my ( $self, $controller, $c, $file ) = @_;
+ my $model = $c->model( $self->model_name );
+ $model->prep_new_object($file);
+}
+
=head2 search( I<context>, I<args> )
Implements required method.
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -46,8 +46,8 @@
my $class = shift;
my $self = $class->next::method(@_);
my $file = $self->{file} or $self->throw_error("file param required");
- $self->{delegate}
- ||= $self->delegate_class->new( ref $file eq 'ARRAY' ? @$file : $file );
+ $self->{delegate} ||= $self->delegate_class->new(
+ ref $file eq 'ARRAY' ? @$file : $file );
return $self;
}
@@ -127,10 +127,22 @@
print {$fh} $self->content;
$fh->close;
- #warn "file written to $self";
+ #warn length($self->content) . " bytes written to $self";
+
return -s $self->delegate;
}
+=head2 serialize
+
+Returns the File object as a hashref with 2 keys: path and content.
+
+=cut
+
+sub serialize {
+ my $self = shift;
+ return { path => $self->delegate . "", content => $self->content };
+}
+
1;
__END__
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -1,14 +1,19 @@
package CatalystX::CRUD::Object;
-use strict;
-use warnings;
use Moose;
with 'MooseX::Emulate::Class::Accessor::Fast';
with 'Catalyst::ClassData';
-use base qw( CatalystX::CRUD );
+use base 'CatalystX::CRUD';
+
use Carp;
+use Data::Dump qw( dump );
use MRO::Compat;
use mro 'c3';
+#use overload
+# '""' => sub { return dump( $_[0]->serialize ) . "" },
+# 'bool' => sub {1},
+# fallback => 1;
+
__PACKAGE__->mk_ro_accessors(qw( delegate ));
__PACKAGE__->mk_classdata('delegate_class');
@@ -103,6 +108,24 @@
sub update { shift->throw_error("must implement update") }
sub delete { shift->throw_error("must implement delete") }
+=head2 serialize
+
+Stringify the object. This class overloads the string operators
+to call this method.
+
+Your delegate class should implement a serialize() method
+or stringify to something useful.
+
+=cut
+
+sub serialize {
+ my $self = shift;
+ return "" unless defined $self->delegate;
+ return $self->delegate->can('serialize')
+ ? $self->delegate->serialize
+ : $self->delegate . "";
+}
+
=head2 AUTOLOAD
Some black magic hackery to make Object classes act like
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Results.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Results.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Results.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -1,17 +1,16 @@
package CatalystX::CRUD::Results;
-use strict;
-use warnings;
-use base qw( Class::Accessor::Fast );
+use Moose;
+with 'MooseX::Emulate::Class::Accessor::Fast';
use Carp;
-use Scalar::Util qw( blessed );
use Data::Dump qw( dump );
use MRO::Compat;
use mro 'c3';
-use overload
- '""' => sub { return dump( $_[0]->serialize ) . ""; },
- 'bool' => sub {1},
- fallback => 1;
+#use overload
+# '""' => sub { return dump( $_[0]->serialize ) . "" },
+# 'bool' => sub {1},
+# fallback => 1;
+
__PACKAGE__->mk_ro_accessors(qw( count pager query results ));
our $VERSION = '0.53_01';
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -6,7 +6,7 @@
use Data::Dump;
use mro 'c3';
-__PACKAGE__->mk_accessors( qw( form_fields ) );
+__PACKAGE__->mk_accessors(qw( form_fields ));
our $VERSION = '0.53_01';
@@ -115,6 +115,7 @@
sub end : Private {
my ( $self, $c ) = @_;
+ $c->log->debug('test controller end()') if $c->debug;
if ( defined $c->stash->{object} ) {
$c->res->body( $self->serialize_object( $c, $c->stash->{object} ) );
}
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -39,7 +39,10 @@
sub has_errors {
my $self = shift;
my $c = shift or $self->throw_error("context object required");
- return scalar( @{ $c->error } ) || $c->stash->{error} || 0;
+ return
+ scalar( @{ $c->error } )
+ || $c->stash->{error}
+ || 0;
}
=head2 throw_error( I<msg> )
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/01-file.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/01-file.t 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/01-file.t 2012-11-04 03:10:37 UTC (rev 14379)
@@ -1,3 +1,5 @@
+#!/usr/bin/env perl
+
use Test::More tests => 40;
use strict;
use lib qw( lib t/lib );
@@ -59,6 +61,7 @@
# test for default()
ok( $res = request('/file/testfile'), "get /file/testfile" );
+#diag( $res->content );
is( $res->code, 404, "default is 404" );
# create related file
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FetchRewrite.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FetchRewrite.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FetchRewrite.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -17,6 +17,25 @@
init_object => 'file_from_form',
);
+sub fetch : Chained('/') PathPrefix CaptureArgs(1) {
+ my ( $self, $c, $id ) = @_;
+ eval { $self->next::method( $c, $id ); };
+ if ($@) {
+
+ #$c->log->error($@) if $c->debug;
+ if ( $@ =~ m/^No such File/ ) {
+ my $file = $self->do_model( $c, 'new_object', file => $id );
+ $file = $self->do_model( $c, 'prep_new_object', $file );
+ $c->log->debug("empty file object:$file") if $c->debug;
+ $c->stash( object => $file );
+ }
+ else {
+ # re-throw
+ $self->throw_error($@);
+ }
+ }
+}
+
# append the namespace qualifier for objects
sub _parse_PathPrefix_attr {
my ( $self, $c, $name, $value ) = @_;
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/File.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/File.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -16,6 +16,25 @@
view_on_single_result => 1,
);
+sub fetch : Chained('/') PathPrefix CaptureArgs(1) {
+ my ( $self, $c, $id ) = @_;
+ eval { $self->next::method( $c, $id ); };
+ if ($@) {
+
+ #$c->log->error($@) if $c->debug;
+ if ( $@ =~ m/^No such File/ ) {
+ my $file = $self->do_model( $c, 'new_object', file => $id );
+ $file = $self->do_model( $c, 'prep_new_object', $file );
+ $c->log->debug("empty file object:$file") if $c->debug;
+ $c->stash( object => $file );
+ }
+ else {
+ # re-throw
+ $self->throw_error($@);
+ }
+ }
+}
+
# 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
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapter.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapter.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapter.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -16,4 +16,23 @@
init_object => 'file_from_form',
);
+sub fetch : Chained('/') PathPrefix CaptureArgs(1) {
+ my ( $self, $c, $id ) = @_;
+ eval { $self->next::method( $c, $id ); };
+ if ($@) {
+
+ #$c->log->error($@) if $c->debug;
+ if ( $@ =~ m/^No such File/ ) {
+ my $file = $self->do_model( $c, 'new_object', file => $id );
+ $file = $self->do_model( $c, 'prep_new_object', $file );
+ $c->log->debug("empty file object:$file") if $c->debug;
+ $c->stash( object => $file );
+ }
+ else {
+ # re-throw
+ $self->throw_error($@);
+ }
+ }
+}
+
1;
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapterMultiPK.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapterMultiPK.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/FileAdapterMultiPK.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -16,4 +16,23 @@
init_object => 'file_from_form',
);
+sub fetch : Chained('/') PathPrefix CaptureArgs(1) {
+ my ( $self, $c, $id ) = @_;
+ eval { $self->next::method( $c, $id ); };
+ if ($@) {
+
+ #$c->log->error($@) if $c->debug;
+ if ( $@ =~ m/^No such File/ ) {
+ my $file = $self->do_model( $c, 'new_object', file => $id );
+ $file = $self->do_model( $c, 'prep_new_object', $file );
+ $c->log->debug("empty file object:$file") if $c->debug;
+ $c->stash( object => $file );
+ }
+ else {
+ # re-throw
+ $self->throw_error($@);
+ }
+ }
+}
+
1;
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/REST/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/REST/File.pm 2012-11-02 04:21:04 UTC (rev 14378)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/REST/File.pm 2012-11-04 03:10:37 UTC (rev 14379)
@@ -21,6 +21,25 @@
init_object => 'file_from_form',
);
+sub fetch {
+ my ( $self, $c, $id ) = @_;
+ eval { $self->next::method( $c, $id ); };
+ if ($@) {
+
+ #$c->log->error($@) if $c->debug;
+ if ( $@ =~ m/^No such File/ ) {
+ my $file = $self->do_model( $c, 'new_object', file => $id );
+ $file = $self->do_model( $c, 'prep_new_object', $file );
+ $c->log->debug("empty file object:$file") if $c->debug;
+ $c->stash( object => $file );
+ }
+ else {
+ # re-throw
+ $self->throw_error($@);
+ }
+ }
+}
+
sub do_search {
my ( $self, $c, @arg ) = @_;
$self->next::method( $c, @arg );
More information about the Catalyst-commits
mailing list