[Catalyst-commits] r8298 - in CatalystX-CRUD/CatalystX-CRUD/trunk:
lib/CatalystX/CRUD lib/CatalystX/CRUD/Model
lib/CatalystX/CRUD/Object lib/CatalystX/CRUD/Test t
t/lib/MyApp/Controller/REST
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Tue Aug 26 21:22:32 BST 2008
Author: karpet
Date: 2008-08-26 21:22:32 +0100 (Tue, 26 Aug 2008)
New Revision: 8298
Modified:
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/REST.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm
CatalystX-CRUD/CatalystX-CRUD/trunk/t/03-rest.t
CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/REST/File.pm
Log:
more REST tests and get File model search feature to actually work
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm 2008-08-26 20:22:09 UTC (rev 8297)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Model/File.pm 2008-08-26 20:22:32 UTC (rev 8298)
@@ -77,22 +77,26 @@
# look through inc_path
for my $dir ( @{ $self->inc_path } ) {
- my $test = $self->object_class->new(
- file => Path::Class::File->new( $dir, $file ) );
+ my $test = Path::Class::File->new( $dir, $file );
if ( -s $test ) {
- $file = $test;
+ $file->{delegate} = $test;
$file->read;
last;
}
}
- # 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 ) );
+ #carp dump $file;
+
+ # make sure delegate() has absolute path
+ # while file() is relative to inc_path.
+ if ( $file->dir eq '.' or !$file->dir->is_absolute ) {
+ $file->{delegate}
+ = Path::Class::File->new( $self->inc_path->[0], $file );
}
+ #carp dump $file;
+
return $file;
}
@@ -126,23 +130,57 @@
=cut
-sub search {
- my $self = shift;
- my $filter_sub = shift || $self->make_query;
+sub _find {
+ my ( $self, $filter_sub, $root ) = @_;
my %files;
my $find_sub = sub {
- carp "File::Find::Dir = $File::Find::dir\nfile = $_\n";
- return unless $filter_sub->($_);
- $files{$File::Find::name}++;
- };
- find( $find_sub, @{ $self->inc_path } );
+ #warn "File::Find::Dir = $File::Find::dir";
+ #warn "file = $_";
+ #warn "name = $File::Find::name";
- carp dump \%files;
+ my $dir = Path::Class::dir($File::Find::dir);
+ my $f = Path::Class::file($File::Find::name);
+ return if $dir eq $f;
- return [ map { $self->new_object( file => $_ ) } sort keys %files ];
+ return unless $filter_sub->( $root, $dir, $f );
+
+ # we want the file path relative to $root
+ # since that is the PK
+ my $rel = $dir->relative($root);
+ $rel =~ s!^\./!!;
+ my $key = Path::Class::file( $rel, $_ );
+
+ #warn "$key => $f";
+
+ $files{$key} = $f if -f $f;
+ };
+ find(
+ { follow => 1,
+ wanted => $find_sub,
+ },
+ @{ $self->inc_path }
+ );
+ return \%files;
}
+sub search {
+ my $self = shift;
+ my $filter_sub = shift || $self->make_query;
+ my @objects;
+ for my $root ( @{ $self->inc_path } ) {
+ my $files = $self->_find( $filter_sub, $root );
+ for my $relative ( sort keys %$files ) {
+ my $obj = $self->new_object(
+ file => $relative,
+ delegate => $files->{$relative}
+ );
+ push @objects, $obj;
+ }
+ }
+ return \@objects;
+}
+
=head2 count( I<filter_CODE> )
Returns number of files matching I<filter_CODE>. See search for a description
@@ -151,15 +189,14 @@
=cut
sub count {
- my $self = shift;
+ my $self = shift;
my $filter_sub = shift || $self->make_query;
- my $count;
- my $find_sub = sub {
- carp "File::Find::Dir = $File::Find::dir\nfile = $_\n";
- return unless $filter_sub->($_);
- $count++;
- };
- find( $find_sub, @{ $self->inc_path } );
+ my $count = 0;
+ for my $root ( @{ $self->inc_path } ) {
+ my $files = $self->_find( $filter_sub, $root );
+ $count += scalar keys %$files;
+ }
+
return $count;
}
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm 2008-08-26 20:22:09 UTC (rev 8297)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Object/File.pm 2008-08-26 20:22:32 UTC (rev 8298)
@@ -46,7 +46,7 @@
my $self = $class->next::method(@_);
my $file = $self->{file} or $self->throw_error("file param required");
$self->{delegate}
- = Path::Class::File->new( ref $file eq 'ARRAY' ? @$file : $file );
+ ||= Path::Class::File->new( ref $file eq 'ARRAY' ? @$file : $file );
return $self;
}
@@ -125,6 +125,8 @@
my $fh = $self->delegate->openw();
print {$fh} $self->content;
$fh->close;
+
+ #warn "file written to $self";
return -s $self->delegate;
}
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/REST.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/REST.pm 2008-08-26 20:22:09 UTC (rev 8297)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/REST.pm 2008-08-26 20:22:32 UTC (rev 8298)
@@ -10,6 +10,8 @@
our $VERSION = '0.30';
+#warn "REST VERSION = $VERSION";
+
=head1 NAME
CatalystX::CRUD::REST - RESTful CRUD controller
@@ -132,7 +134,7 @@
= map { $_ => 1 } qw( create read update delete edit save rm view );
my %related_methods = map { $_ => 1 } qw( add remove );
-sub rest : Path Args {
+sub rest : Path {
my ( $self, $c, @arg ) = @_;
my $method = $self->req_method($c);
@@ -240,6 +242,7 @@
my $method = $self->req_method($c);
if ( !length $oid && $method eq 'GET' ) {
+ $c->log->debug("GET request with no OID") if $c->debug;
$c->action->name('list');
$c->action->reverse( join( '/', $c->action->namespace, 'list' ) );
return $self->list($c);
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm 2008-08-26 20:22:09 UTC (rev 8297)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/lib/CatalystX/CRUD/Test/Controller.pm 2008-08-26 20:22:32 UTC (rev 8298)
@@ -6,6 +6,8 @@
use Data::Dump;
use Class::C3;
+__PACKAGE__->mk_accessors( qw( form_fields ) );
+
our $VERSION = '0.30';
=head1 NAME
@@ -61,16 +63,12 @@
# id always comes from url but not necessarily from form
my $id = $c->stash->{object_id};
- my %pk = $self->get_primary_key( $c, $id );
# initialize the form with the object's values
$form->$form_meth($obj);
# set param values from request
$form->params( $c->req->params );
- for my $field ( keys %pk ) {
- $form->param( $field => $pk{$field} );
- }
# override form's values with those from params
# no_clear is important because we already initialized with object
@@ -87,21 +85,6 @@
# re-set object's values from the now-valid form
$form->$obj_meth($obj);
- # set PK(s) explicitly
- for my $field ( keys %pk ) {
- $obj->$field( $pk{$field} );
- }
-
- # let serial column work its magic
- # if this is a first-time save (create)
- if ( scalar( keys %pk ) == 1 or $id eq '0' ) {
- my ( $field, $value ) = each %pk;
- $obj->$field(undef)
- if ( !$obj->$field || $obj->$field eq '0' || $value eq '0' );
- }
-
- #carp $self->serialize_object( $c, $obj );
-
return $obj;
}
@@ -113,8 +96,8 @@
sub form {
my ( $self, $c ) = @_;
- my $form_class = $self->config->{form_class};
- my $arg = { fields => $self->config->{form_fields} };
+ my $form_class = $self->form_class;
+ my $arg = { fields => $self->form_fields };
my $form = $form_class->new($arg);
return $form;
}
@@ -135,6 +118,13 @@
if ( defined $c->stash->{object} ) {
$c->res->body( $self->serialize_object( $c, $c->stash->{object} ) );
}
+ elsif ( defined $c->stash->{results} ) {
+ my @body;
+ while ( my $result = $c->stash->{results}->next ) {
+ push( @body, $self->serialize_object( $c, $result ) );
+ }
+ $c->res->body( join( "\n", @body ) );
+ }
if ( $self->has_errors($c) ) {
my $err = join( "\n", @{ $c->error } );
$c->log->error($err) if $c->debug;
@@ -153,7 +143,7 @@
sub serialize_object {
my ( $self, $c, $object ) = @_;
- my $fields = $self->config->{form_fields};
+ my $fields = $self->form_fields;
my $serial = {};
for my $f (@$fields) {
$serial->{$f} = defined $object->$f ? $object->$f . '' : undef;
Modified: CatalystX-CRUD/CatalystX-CRUD/trunk/t/03-rest.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD/trunk/t/03-rest.t 2008-08-26 20:22:09 UTC (rev 8297)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/03-rest.t 2008-08-26 20:22:32 UTC (rev 8298)
@@ -1,4 +1,4 @@
-use Test::More tests => 47;
+use Test::More tests => 54;
use strict;
use lib qw( lib t/lib );
use_ok('CatalystX::CRUD::Model::File');
@@ -25,6 +25,7 @@
"POST new file response"
);
+####################################################
# read the file we just created
ok( $res = request( HTTP::Request->new( GET => '/rest/file/testfile' ) ),
"GET new file" );
@@ -33,6 +34,7 @@
like( $res->content, qr/content => "hello world"/, "read file" );
+####################################################
# update the file
ok( $res = request(
POST( '/rest/file/testfile', [ content => 'foo bar baz' ] )
@@ -42,6 +44,7 @@
like( $res->content, qr/content => "foo bar baz"/, "update file" );
+####################################################
# create related file
ok( $res = request(
POST(
@@ -59,12 +62,23 @@
is( $res->headers->{status}, 302, "new file 302 redirect status" );
+###################################################
+# test with no args
+
+#system("tree t/lib/MyApp/root");
+
+ok( $res = request('/rest/file'), "/ request with multiple items" );
+is( $res->headers->{status}, 200, "/ request with multiple items lists" );
+ok( $res->content =~ qr/foo bar baz/ && $res->content =~ qr/hello world/,
+ "content has 2 files" );
+
+###################################################
# test the Arg matching with no rpc
ok( $res = request('/rest/file/create'), "/rest/file/create" );
is( $res->headers->{status}, 302, "/rest/file/create" );
ok( $res = request('/rest/file'), "zero" );
-is( $res->headers->{status}, 302, "redirect == zero" );
+is( $res->headers->{status}, 200, "zero => list()" );
ok( $res = request('/rest/file/testfile'), "one" );
is( $res->headers->{status}, 200, "oid == one" );
ok( $res = request('/rest/file/testfile/view'), "view" );
@@ -100,7 +114,7 @@
ok( $res = request('/rest/file/create'), "/rest/file/create" );
is( $res->headers->{status}, 302, "/rest/file/create" );
ok( $res = request('/rest/file'), "zero with rpc" );
-is( $res->headers->{status}, 302, "redirect == zero with rpc" );
+is( $res->headers->{status}, 200, "zero with rpc => list()" );
ok( $res = request('/rest/file/testfile'), "one with rpc" );
is( $res->headers->{status}, 200, "oid == one with rpc" );
ok( $res = request('/rest/file/testfile/view'), "view with rpc" );
@@ -147,6 +161,15 @@
"rm file2"
);
+ok( $res = request(
+ POST(
+ '/rest/file/otherdir%2ftestfile2/delete',
+ [ _http_method => 'DELETE' ]
+ )
+ ),
+ "rm otherdir/testfile2"
+);
+
#diag( $res->content );
# confirm it is gone
@@ -157,3 +180,8 @@
like( $res->content, qr/content => undef/, "file nuked" );
+ok( $res = request('/rest/file'), "/ request with no items" );
+
+#dump $res;
+is( $res->headers->{status}, 200, "/ request with no items == 200" );
+is( $res->content, "", "no content for no results" );
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 2008-08-26 20:22:09 UTC (rev 8297)
+++ CatalystX-CRUD/CatalystX-CRUD/trunk/t/lib/MyApp/Controller/REST/File.pm 2008-08-26 20:22:32 UTC (rev 8298)
@@ -20,30 +20,15 @@
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
-
-# TODO real search
-
sub do_search {
-
my ( $self, $c, @arg ) = @_;
+ $self->next::method( $c, @arg );
- $self->config->{view_on_single_result} = 1;
+ #carp dump $c->stash->{results};
- my $tmpf = File::Temp->new;
-
- 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;
+ for my $file ( @{ $c->stash->{results}->{results} } ) {
+ $file->read;
}
-
- $self->throw_error("view_on_single_result failed");
-
}
sub end : Private {
More information about the Catalyst-commits
mailing list