[Catalyst-commits] r14377 - in CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk: . lib lib/CatalystX lib/CatalystX/CRUD lib/CatalystX/CRUD/Controller t t/lib t/lib/MyApp t/lib/MyApp/Controller t/lib/MyApp/Controller/REST t/lib/MyApp/Model t/lib/MyApp/root t/lib/MyApp/script

karpet at dev.catalyst.perl.org karpet at dev.catalyst.perl.org
Fri Nov 2 04:09:24 GMT 2012


Author: karpet
Date: 2012-11-02 04:09:24 +0000 (Fri, 02 Nov 2012)
New Revision: 14377

Added:
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/Changes
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/MANIFEST
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/Makefile.PL
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/README
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/lib/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/lib/CatalystX/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/lib/CatalystX/CRUD/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/lib/CatalystX/CRUD/Controller/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/lib/CatalystX/CRUD/Controller/REST.pm
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/00-load.t
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/001-file.t
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/boilerplate.t
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp.pm
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/REST/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/REST/File.pm
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/Root.pm
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/File.pm
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Form.pm
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/File.pm
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/FileSearch.pm
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/root/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/root/favicon.ico
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/root/otherdir/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/script/
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/script/myapp_server.pl
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/pod-coverage.t
   CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/pod.t
Log:
first pass. not much works yet.

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/Changes
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/Changes	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/Changes	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,5 @@
+Revision history for CatalystX-CRUD-Controller-REST
+
+0.01    Date/time
+        First version, released on an unsuspecting world.
+

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/MANIFEST
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/MANIFEST	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/MANIFEST	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,8 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/CatalystX/CRUD/Controller/REST.pm
+t/00-load.t
+t/pod-coverage.t
+t/pod.t

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/Makefile.PL
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/Makefile.PL	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/Makefile.PL	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use inc::Module::Install;
+
+# Define metadata
+name 'CatalystX-CRUD-Controller-REST';
+perl_version '5.008003';
+
+all_from 'lib/CatalystX/CRUD/Controller/REST.pm';
+
+requires 'Test::More'                            => 0;
+requires 'CatalystX::CRUD'                       => 0.53;
+requires 'Catalyst::Action::REST'                => 0;
+requires 'Scalar::Util'                          => 0;
+requires 'JSON::XS'                              => 2.23;
+
+license 'perl';
+homepage 'http://dev.catalyst.perl.org/repos/Catalyst/CatalystX-CRUD/CatalystX-CRUD-Controller-REST';
+bugtracker 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD-Controller-REST';
+repository 'http://dev.catalyst.perl.org/repos/Catalyst/CatalystX-CRUD/CatalystX-CRUD-Controller-REST';
+
+WriteAll;

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/README
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/README	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/README	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,55 @@
+CatalystX-CRUD-Controller-REST
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the README
+file from a module distribution so that people browsing the archive
+can use it to get an idea of the module's uses. It is usually a good idea
+to provide version information here so that people can decide whether
+fixes for the module are worth downloading.
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+	perl Makefile.PL
+	make
+	make test
+	make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+    perldoc CatalystX::CRUD::Controller::REST
+
+You can also look for information at:
+
+    RT, CPAN's request tracker
+        http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD-Controller-REST
+
+    AnnoCPAN, Annotated CPAN documentation
+        http://annocpan.org/dist/CatalystX-CRUD-Controller-REST
+
+    CPAN Ratings
+        http://cpanratings.perl.org/d/CatalystX-CRUD-Controller-REST
+
+    Search CPAN
+        http://search.cpan.org/dist/CatalystX-CRUD-Controller-REST/
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2012 Peter Karman
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/lib/CatalystX/CRUD/Controller/REST.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/lib/CatalystX/CRUD/Controller/REST.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/lib/CatalystX/CRUD/Controller/REST.pm	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,137 @@
+package CatalystX::CRUD::Controller::REST;
+use Moose;
+use namespace::autoclean;
+
+use Data::Dump qw( dump );
+
+BEGIN {
+    extends 'Catalyst::Controller::REST', 'CatalystX::CRUD::Controller',;
+}
+
+our $VERSION = '0.001';
+
+=head1 NAME
+
+CatalystX::CRUD::Controller::REST - Catalyst::Controller::REST with CRUD
+
+=head1 SYNOPSIS
+
+ package MyApp::Controller::Foo;
+ use Moose;
+ use namespace::autoclean;
+
+ BEGIN { extends 'CatalystX::CRUD::Controller::REST' }
+
+=head1 DESCRIPTION
+
+This module is B<not> to be confused with CatalystX::CRUD::REST.
+This is not a drop-in replacement for existing CatalystX::CRUD::Controllers.
+
+This module extends Catalyst::Controller::REST to work with the
+CatalystX::CRUD::Controller API.
+
+=cut
+
+=head1 METHODS
+
+=cut
+
+# override all the CRUD methods to undo their attributes
+# and create *_HTTP methods instead.
+
+sub create       { }
+sub read         { }
+sub update       { }
+sub delete       { }
+sub add          { }
+sub edit         { }
+sub save         { }
+sub view         { }
+sub remove       { }
+sub rm           { }
+sub list_related { }
+sub view_related { }
+
+sub list : Path('') : Args(0) : ActionClass('REST') { }
+
+sub list_GET {
+    my ( $self, $c ) = @_;
+    $c->log->debug('list_GET');
+    $self->SUPER::list($c);
+    $self->status_ok( $c, entity => $c->stash->{results}->serialize );
+}
+
+sub search : Local : Args(0) : ActionClass('REST') { }
+
+sub search_GET {
+    my ( $self, $c ) = @_;
+    $c->log->debug('search_GET');
+    $self->SUPER::search($c);
+    if ( !blessed( $c->stash->{results} ) ) {
+        $self->status_bad_request( $c,
+            message => 'Must provide search parameters' );
+    }
+    else {
+        $self->status_ok( $c, entity => $c->stash->{results}->serialize );
+    }
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Peter Karman, C<< <karman at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-catalystx-crud-controller-rest at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD-Controller-REST>.  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::Controller::REST
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD-Controller-REST>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/CatalystX-CRUD-Controller-REST>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/CatalystX-CRUD-Controller-REST>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/CatalystX-CRUD-Controller-REST/>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2012 Peter Karman.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+
+=cut

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/00-load.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/00-load.t	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/00-load.t	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+    use_ok( 'CatalystX::CRUD::Controller::REST' );
+}
+
+diag( "Testing CatalystX::CRUD::Controller::REST $CatalystX::CRUD::Controller::REST::VERSION, Perl $], $^X" );

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/001-file.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/001-file.t	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/001-file.t	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,187 @@
+#!/usr/bin/env perl
+
+use Test::More tests => 54;
+use strict;
+use lib qw( lib t/lib );
+use_ok('CatalystX::CRUD::Model::File');
+use_ok('CatalystX::CRUD::Object::File');
+
+use Catalyst::Test 'MyApp';
+use Data::Dump qw( dump );
+use HTTP::Request::Common;
+
+###########################################
+# do CRUD stuff
+
+my $res;
+
+# create
+ok( $res = request(
+        POST( '/rest/file/testfile', [ 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 => '/rest/file/testfile' ) ),
+    "GET new file" );
+
+#diag( $res->content );
+
+like( $res->content, qr/content => "hello world"/, "read file" );
+
+####################################################
+# update the file
+ok( $res = request(
+        POST( '/rest/file/testfile', [ content => 'foo bar baz' ] )
+    ),
+    "update file"
+);
+
+like( $res->content, qr/content => "foo bar baz"/, "update file" );
+
+####################################################
+# create related file
+ok( $res = request(
+        POST(
+            '/rest/file/otherdir%2ftestfile2',
+            [ content => 'hello world 2' ]
+        )
+    ),
+    "POST new file2"
+);
+
+is( $res->content,
+    '{ content => "hello world 2", file => "otherdir/testfile2" }',
+    "POST new file2 response"
+);
+
+is( $res->code, 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->code, 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->code, 302, "/rest/file/create" );
+ok( $res = request('/rest/file'), "zero" );
+is( $res->code, 200, "zero => list()" );
+ok( $res = request('/rest/file/testfile'), "one" );
+is( $res->code, 200, "oid == one" );
+ok( $res = request('/rest/file/testfile/view'), "view" );
+is( $res->code, 404, "rpc == two" );
+ok( $res
+        = request(
+        POST( '/rest/file/testfile/dir/otherdir%2ftestfile2', [] ) ),
+    "three"
+);
+is( $res->code, 204, "related == three" );
+ok( $res = request(
+        POST( '/rest/file/testfile/dir/otherdir%2ftestfile2/rpc', [] )
+    ),
+    "four"
+);
+is( $res->code, 404, "404 == related rpc with no enable_rpc_compat" );
+ok( $res = request('/rest/file/testfile/two/three/four/five'), "five" );
+is( $res->code, 404, "404 == five" );
+ok( $res = request(
+        POST(
+            '/rest/file/testfile/dir/otherdir%2ftestfile2',
+            [ 'x-tunneled-method' => 'DELETE' ]
+        )
+    ),
+    "three"
+);
+is( $res->code, 204, "related == three" );
+
+# turn rpc enable on and run again
+MyApp->controller('REST::File')->enable_rpc_compat(1);
+
+ok( $res = request('/rest/file/create'), "/rest/file/create" );
+is( $res->code, 302, "/rest/file/create" );
+ok( $res = request('/rest/file'), "zero with rpc" );
+is( $res->code, 200, "zero with rpc => list()" );
+ok( $res = request('/rest/file/testfile'), "one with rpc" );
+is( $res->code, 200, "oid == one with rpc" );
+ok( $res = request('/rest/file/testfile/view'), "view with rpc" );
+is( $res->code, 200, "rpc == two with rpc" );
+ok( $res = request(
+        POST( '/rest/file/testfile/dir/otherdir%2ftestfile2/add', [] )
+    ),
+    "three with rpc"
+);
+is( $res->code, 204, "related == three with rpc" );
+ok( $res = request(
+        POST( '/rest/file/testfile/dir/otherdir%2ftestfile2/rpc', [] )
+    ),
+    "four"
+);
+is( $res->code, 404, "404 == related rpc with enable_rpc_compat" );
+
+ok( $res = request('/rest/file/testfile/two/three/four/five'),
+    "five with rpc" );
+is( $res->code, 404, "404 == five with rpc" );
+
+ok( $res = request(
+        POST(
+            '/rest/file/testfile/dir/otherdir%2ftestfile2/remove',
+            [ 'x-tunneled-method' => 'DELETE' ]
+        )
+    ),
+    "three with rpc"
+);
+is( $res->code, 204, "related == three with rpc" );
+
+# delete the file
+
+ok( $res = request(
+        POST( '/rest/file/testfile', [ _http_method => 'DELETE' ] )
+    ),
+    "rm file"
+);
+
+ok( $res = request(
+        POST( '/rest/file/testfile2/delete', [ _http_method => 'DELETE' ] )
+    ),
+    "rm file2"
+);
+
+ok( $res = request(
+        POST(
+            '/rest/file/otherdir%2ftestfile2/delete',
+            [ _http_method => 'DELETE' ]
+        )
+    ),
+    "rm otherdir/testfile2"
+);
+
+#diag( $res->content );
+
+# confirm it is gone
+ok( $res = request( HTTP::Request->new( GET => '/rest/file/testfile' ) ),
+    "confirm we nuked the file" );
+
+#diag( $res->content );
+
+like( $res->content, qr/content => undef/, "file nuked" );
+
+ok( $res = request('/rest/file'), "/ request with no items" );
+
+#dump $res;
+is( $res->code, 200, "/ request with no items == 200" );
+is( $res->content, "", "no content for no results" );

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/boilerplate.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/boilerplate.t	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/boilerplate.t	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,55 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+    my ($filename, %regex) = @_;
+    open( my $fh, '<', $filename )
+        or die "couldn't open $filename for reading: $!";
+
+    my %violated;
+
+    while (my $line = <$fh>) {
+        while (my ($desc, $regex) = each %regex) {
+            if ($line =~ $regex) {
+                push @{$violated{$desc}||=[]}, $.;
+            }
+        }
+    }
+
+    if (%violated) {
+        fail("$filename contains boilerplate text");
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+    } else {
+        pass("$filename contains no boilerplate text");
+    }
+}
+
+sub module_boilerplate_ok {
+    my ($module) = @_;
+    not_in_file_ok($module =>
+        'the great new $MODULENAME'   => qr/ - The great new /,
+        'boilerplate description'     => qr/Quick summary of what the module/,
+        'stub function definition'    => qr/function[12]/,
+    );
+}
+
+TODO: {
+  local $TODO = "Need to replace the boilerplate text";
+
+  not_in_file_ok(README =>
+    "The README is used..."       => qr/The README is used/,
+    "'version information here'"  => qr/to provide version information/,
+  );
+
+  not_in_file_ok(Changes =>
+    "placeholder date/time"       => qr(Date/time)
+  );
+
+  module_boilerplate_ok('lib/CatalystX/CRUD/Controller/REST.pm');
+
+
+}
+

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/REST/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/REST/File.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/REST/File.pm	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,35 @@
+package MyApp::Controller::REST::File;
+use strict;
+use base qw(
+    CatalystX::CRUD::Controller::REST
+    CatalystX::CRUD::Test::Controller
+);
+use Carp;
+use Data::Dump qw( dump );
+use File::Temp;
+use MyApp::Form;
+use MRO::Compat;
+use mro 'c3';
+
+__PACKAGE__->config(
+    primary_key => 'absolute',
+    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',
+);
+
+sub do_search {
+    my ( $self, $c, @arg ) = @_;
+    $self->next::method( $c, @arg );
+
+    #carp dump $c->stash->{results};
+
+    for my $file ( @{ $c->stash->{results}->{results} } ) {
+        $file->read;
+    }
+}
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/Root.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/Root.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Controller/Root.pm	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,127 @@
+package MyApp::Controller::Root;
+use strict;
+use base qw( Catalyst::Controller );
+use Carp;
+use Data::Dump qw( dump );
+
+__PACKAGE__->config->{namespace} = '';
+
+sub index : Path : Args(0) {
+    my ( $self, $c ) = @_;
+
+    # Hello World
+    $c->response->body( $c->welcome_message );
+}
+
+sub default : Path {
+    my ( $self, $c ) = @_;
+    $c->response->body('Page not found');
+    $c->response->status(404);
+}
+
+my @temp_files;
+
+sub push_temp_files {
+    shift;
+    push( @temp_files, @_ );
+}
+
+END {
+    for my $f (@temp_files) {
+        warn "unlinking $f\n" if $ENV{CATALYST_DEBUG};
+        $f->remove;
+    }
+}
+
+sub foo : Local {
+
+    my ( $self, $c, @arg ) = @_;
+
+    #carp "inc_path: " . dump $c->model('File')->inc_path;
+
+    my $file
+        = $c->model('File')
+        ->new_object(
+        file => [ $c->model('File')->inc_path->[0], 'crud_temp_file' ] );
+
+    $self->push_temp_files($file);
+
+    #carp dump $file;
+
+    $file->content('hello world');
+
+    $file->create or croak "failed to create $file : $!";
+
+    my $filename = $file->basename;
+
+    #carp "filename = $filename";
+
+    $file = $c->model('File')->fetch( file => $filename );
+
+    #carp dump $file;
+
+    $file->read;
+
+    if ( $file->content ne 'hello world' ) {
+        croak "bad read";
+    }
+
+    $file->content('change the text');
+
+    #carp $file;
+
+    $file->update;
+
+    $file = $c->model('File')->fetch( file => $filename );
+
+    #carp $file;
+
+    $c->res->body("foo is a-ok");
+
+}
+
+sub autoload : Local {
+    my ( $self, $c ) = @_;
+
+    my $file = $c->model('File')->new_object(
+        file    => [ $c->model('File')->inc_path->[0], 'autoload_test' ],
+        content => 'test AUTOLOAD black magic'
+    );
+
+    $self->push_temp_files($file);
+
+    $file->create;
+
+    #warn "testing basename on $file";
+
+    # test that calling $file->foo actually calls foo()
+    # on $file->delegate and not $file itself
+    eval { $file->basename };
+    if ($@) {
+        warn "failed to call ->basename on $file: $@";
+        return;
+    }
+
+    unless ( $file->can('basename') ) {
+        warn "can't can(basename) but can ->basename";
+        return;
+    }
+
+    # test that we can still call read() and can(read) on the parent object
+    eval { $file->read };
+    if ($@) {
+        warn "$file cannot read() - $@ $!";
+        return;
+    }
+
+    eval { $file->can('read') };
+    if ($@) {
+        warn "$file cannot can(read) - $@ $!";
+        return;
+    }
+
+    $c->res->body("autoload is a-ok");
+
+}
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/File.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/File.pm	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,5 @@
+package MyApp::File;
+use base qw( CatalystX::CRUD::Object::File );
+
+1;
+

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Form.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Form.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Form.pm	2012-11-02 04:09:24 UTC (rev 14377)
@@ -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;

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/File.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/File.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/File.pm	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,10 @@
+package MyApp::Model::File;
+use strict;
+use base qw(
+    CatalystX::CRUD::Model::File
+);
+use MyApp::File;
+__PACKAGE__->config( object_class => 'MyApp::File' );
+
+1;
+

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/FileSearch.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/FileSearch.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/Model/FileSearch.pm	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,23 @@
+package MyApp::Model::FileSearch;
+use strict;
+use base qw(
+    CatalystX::CRUD::Model::File
+    CatalystX::CRUD::Model::Utils
+);
+use MyApp::File;
+__PACKAGE__->config( object_class => 'MyApp::File' );
+use mro 'c3';
+
+sub make_query {
+    my ($self) = @_;
+    my $q = $self->make_sql_query( $self->context->controller->form_fields );
+
+    # we test $q in 04-query.t
+    $self->context->stash( query => $q );
+
+    # but File model expects a sub ref
+    return $self->next::method;
+}
+
+1;
+

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/root/favicon.ico
===================================================================
(Binary files differ)


Property changes on: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/root/favicon.ico
___________________________________________________________________
Added: svn:mime-type
   + application/octet-stream

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/script/myapp_server.pl
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/script/myapp_server.pl	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp/script/myapp_server.pl	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,10 @@
+#!/usr/bin/env perl
+
+BEGIN {
+    $ENV{CATALYST_SCRIPT_GEN} = 40;
+}
+
+use Catalyst::ScriptRunner;
+Catalyst::ScriptRunner->run('MyApp', 'Server');
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/lib/MyApp.pm	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,23 @@
+package MyApp;
+
+use Catalyst qw(
+    Static::Simple
+);
+use Carp;
+use Data::Dump qw( dump );
+
+our $VERSION = '0.001';
+
+__PACKAGE__->config( foo => 'bar' );
+__PACKAGE__->config->{bad} = 'juju';
+__PACKAGE__->config(use_request_uri_for_path => 1);
+
+__PACKAGE__->setup();
+
+#warn dump MyApp->config;
+
+Class::C3::initialize();    # fix MRO
+
+#warn dump MyApp->config;
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/pod-coverage.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/pod-coverage.t	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/pod-coverage.t	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+    if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+    if $@;
+
+all_pod_coverage_ok();

Added: CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/pod.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/pod.t	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Controller-REST/trunk/t/pod.t	2012-11-02 04:09:24 UTC (rev 14377)
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();




More information about the Catalyst-commits mailing list