[Catalyst-commits] r7487 - in
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO: . trunk trunk/lib
trunk/lib/CatalystX trunk/lib/CatalystX/CRUD
trunk/lib/CatalystX/CRUD/Model
trunk/lib/CatalystX/CRUD/Object trunk/t trunk/t/lib
trunk/t/lib/My trunk/t/lib/MyApp trunk/t/lib/MyApp/Model
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Tue Mar 11 17:21:08 GMT 2008
Author: karpet
Date: 2008-03-11 17:21:06 +0000 (Tue, 11 Mar 2008)
New Revision: 7487
Added:
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/branches/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/MANIFEST
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Makefile.PL
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/README
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/00-load.t
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/01-rdbo.t
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/boilerplate.t
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Foo.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Controller/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/Foo.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Object.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/pod-coverage.t
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/pod.t
Log:
import from peknet
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,40 @@
+Revision history for CatalystX-CRUD-Model-RDBO
+
+0.01 20 Oct 2007
+ First version, released on an unsuspecting world.
+
+0.02 23 Oct 2007
+ * fix typo in POD that fooled CPAN into forking separate doc file
+ * added Sort::SQL to prereq list
+
+0.03 23 Oct 2007
+ * added Rose::DBx::TestDB to the prereq list
+
+0.04 1 November 2007
+ * RDBO Debug var set if CATALYST_DEBUG env var is true
+ * test for defined() param() values
+ * change reserved param names to start with _
+ * fix search() wantarray bug
+
+0.05 9 November 2007
+ * add method to get default available field names in make_query()
+ * allow for explicit _offset param as well as individual _sort and _dir params
+
+0.06 12 Nov 2007
+ * RDBO Debug var set if CATALYST_DEBUG env var is true -- moved to Xsetup() so it actually works.
+
+0.07 20 Nov 2007
+ * auto-discovery of PK to set a real column for default ORDER BY sorting in make_query()
+
+0.08 20 Dec 2007
+ * factor out sql generation into core CatalystX::CRUD::Model::Utils.
+
+0.09 04 Dec 2007
+ * add treat_like_int support
+
+0.10 29 Jan 2008
+ * made RDBO debugging depedent on CATALYST_DEBUG > 1
+
+0.11 06 Feb 2008
+ * fix bug with calculating treat_like_int(). Only set in hash if matches.
+
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/MANIFEST
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/MANIFEST (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/MANIFEST 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,15 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/CatalystX/CRUD/Model/RDBO.pm
+lib/CatalystX/CRUD/Object/RDBO.pm
+t/00-load.t
+t/01-rdbo.t
+t/boilerplate.t
+t/pod-coverage.t
+t/pod.t
+t/lib/My/Foo.pm
+t/lib/MyApp.pm
+t/lib/MyApp/Model/Foo.pm
+t/lib/MyApp/Object.pm
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Makefile.PL
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Makefile.PL (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Makefile.PL 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'CatalystX::CRUD::Model::RDBO',
+ AUTHOR => 'Peter Karman <karman at cpan.org>',
+ VERSION_FROM => 'lib/CatalystX/CRUD/Model/RDBO.pm',
+ #ABSTRACT_FROM => 'lib/CatalystX/CRUD/Model/RDBO.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'Data::Dump' => 0, # for testing
+ 'Rose::DB::Object' => 0,
+ 'CatalystX::CRUD' => 0.18,
+ 'Catalyst::Runtime' => 0,
+ 'Rose::DBx::TestDB' => 0,
+
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'CatalystX-CRUD-Model-RDBO-*' },
+);
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/README
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/README (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/README 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,38 @@
+CatalystX-CRUD-Model-RDBO
+
+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::Model::RDBO
+
+You can also look for information at:
+
+ Search CPAN
+ http://search.cpan.org/dist/CatalystX-CRUD-Model-RDBO
+
+ CPAN Request Tracker:
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD-Model-RDBO
+
+ AnnoCPAN, annotated CPAN documentation:
+ http://annocpan.org/dist/CatalystX-CRUD-Model-RDBO
+
+ CPAN Ratings:
+ http://cpanratings.perl.org/d/CatalystX-CRUD-Model-RDBO
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Peter Karman
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,389 @@
+package CatalystX::CRUD::Model::RDBO;
+use strict;
+use warnings;
+use base qw( CatalystX::CRUD::Model CatalystX::CRUD::Model::Utils );
+use CatalystX::CRUD::Iterator;
+
+our $VERSION = '0.11';
+
+__PACKAGE__->mk_ro_accessors(qw( name manager ));
+__PACKAGE__->config->{object_class} = 'CatalystX::CRUD::Object::RDBO';
+
+=head1 NAME
+
+CatalystX::CRUD::Model::RDBO - Rose::DB::Object CRUD
+
+=head1 SYNOPSIS
+
+ package MyApp::Model::Foo;
+ use base qw( CatalystX::CRUD::Model::RDBO );
+ __PACKAGE__->config(
+ name => 'My::RDBO::Foo',
+ manager => 'My::RDBO::Foo::Manager',
+ load_with => [qw( bar )],
+ page_size => 50,
+ );
+ 1;
+
+=head1 DESCRIPTION
+
+CatalystX::CRUD::Model::RDBO is a CatalystX::CRUD implementation for Rose::DB::Object.
+
+=head1 CONFIGURATION
+
+The config options can be set as in the SYNOPSIS example.
+
+=head1 METHODS
+
+=head2 name
+
+The name of the Rose::DB::Object-based class that the model represents.
+Accessible via name() or config->{name}.
+
+=head2 manager
+
+If C<manager> is not defined in config(),
+the Xsetup() method will attempt to load a class
+named with the C<name> value from config()
+with C<::Manager> appended.
+This assumes the namespace convention of Rose::DB::Object::Manager.
+
+If there is no such module in your @INC path, then
+the fall-back default is Rose::DB::Object::Manager.
+
+=cut
+
+=head2 Xsetup
+
+Implements the required Xsetup() method. Instatiates the model's
+name() and manager() values based on config().
+
+=cut
+
+sub Xsetup {
+ my $self = shift;
+
+ $self->NEXT::Xsetup(@_);
+
+ $self->{name} = $self->config->{name};
+ if ( !$self->name ) {
+ return if $self->throw_error("need to configure a Rose class name");
+ }
+
+ $self->{manager} = $self->config->{manager} || $self->name . '::Manager';
+
+ my $name = $self->name;
+ my $mgr = $self->manager;
+
+ eval "require $name";
+ if ($@) {
+ return if $self->throw_error($@);
+ }
+
+ # what kind of db driver are we using. makes a difference in make_query().
+ my $db = $name->new->db;
+ $self->use_ilike(1) if $db->driver eq 'pg';
+
+ # rdbo sql uses 'ne' for not equal
+ $self->ne_sign('ne');
+
+ # load the Manager
+ eval "require $mgr";
+
+ # don't fret -- just use RDBO::Manager
+ if ($@) {
+ $self->{manager} = 'Rose::DB::Object::Manager';
+ require Rose::DB::Object::Manager;
+ }
+
+ # turn on debugging help
+ if ( $ENV{CATALYST_DEBUG} && $ENV{CATALYST_DEBUG} > 1 ) {
+ $Rose::DB::Object::QueryBuilder::Debug = 1;
+ $Rose::DB::Object::Debug = 1;
+ }
+
+}
+
+=head2 new_object( @param )
+
+Returns a CatalystX::CRUD::Object::RDBO object.
+
+=cut
+
+sub new_object {
+ my $self = shift;
+ my $rdbo = $self->name;
+ my $obj;
+ eval { $obj = $rdbo->new(@_) };
+ if ( $@ or !$obj ) {
+ my $err = defined($obj) ? $obj->error : $@;
+ return if $self->throw_error("can't create new $rdbo object: $err");
+ }
+ return $self->NEXT::new_object( delegate => $obj );
+}
+
+=head2 fetch( @params )
+
+If present,
+ at I<params> is passed directly to name()'s new() method,
+and is expected to be an array of key/value pairs.
+Then the load() method is called on the resulting object.
+
+If @I<params> are not present, the new() object is simply returned,
+which is equivalent to calling new_object().
+
+All the methods called within fetch() are wrapped in an eval()
+and sanity checked afterwards. If there are any errors,
+throw_error() is called.
+
+Example:
+
+ my $foo = $c->model('Foo')->fetch( id => 1234 );
+ if (@{ $c->error })
+ {
+ # do something to deal with the error
+ }
+
+B<NOTE:> If the object's presence in the database is questionable,
+your controller code may want to use new_object() and then call
+load_speculative() yourself. Example:
+
+ my $foo = $c->model('Foo')->new_object( id => 1234 );
+ $foo->load_speculative;
+ if ($foo->not_found)
+ {
+ # do something
+ }
+
+=cut
+
+sub fetch {
+ my $self = shift;
+ my $obj = $self->new_object(@_) or return;
+
+ if (@_) {
+ my %v = @_;
+ my $ret;
+ my $name = $self->name;
+ my @arg = ();
+ if ( $self->config->{load_with} ) {
+ push( @arg, with => $self->config->{load_with} );
+ }
+ eval { $ret = $obj->read(@arg); };
+ if ( $@ or !$ret ) {
+ return
+ if $self->throw_error( join( " : ", $@, "no such $name" ) );
+ }
+
+ # special handling of fetching
+ # e.g. Catalyst::Plugin::Session::Store::DBI records.
+ if ( $v{id} ) {
+
+ # stringify in case it's a char instead of int
+ # as is the case with session ids
+ my $pid = $obj->delegate->id;
+ $pid =~ s,\s+$,,;
+ unless ( $pid eq $v{id} ) {
+
+ return
+ if $self->throw_error(
+ "Error fetching correct id:\nfetched: $v{id} "
+ . length( $v{id} )
+ . "\nbut got: $pid"
+ . length($pid) );
+ }
+ }
+ }
+
+ return $obj;
+}
+
+=head2 search( @params )
+
+ at I<params> is passed directly to the Manager get_objects() method.
+See the Rose::DB::Object::Manager documentation.
+
+Returns an array or array ref (based on wantarray) of
+CatalystX::CRUD::Object::RDBO objects.
+
+=cut
+
+sub search {
+ my $self = shift;
+ my $objs = $self->_get_objects( 'get_objects', @_ );
+
+ # save ourselves lots of method-call overhead.
+ my $class = $self->object_class;
+
+ my @wrapped = map { $class->new( delegate => $_ ) } @$objs;
+ return wantarray ? @wrapped : \@wrapped;
+}
+
+=head2 count( @params )
+
+ at I<params> is passed directly to the Manager get_objects_count() method.
+See the Rose::DB::Object::Manager documentation.
+
+Returns an integer.
+
+=cut
+
+sub count {
+ my $self = shift;
+ return $self->_get_objects( 'get_objects_count', @_ );
+}
+
+=head2 iterator( @params )
+
+ at I<params> is passed directly to the Manager get_objects_iterator() method.
+See the Rose::DB::Object::Manager documentation.
+
+Returns a CatalystX::CRUD::Iterator object whose next() method
+will return a CatalystX::CRUD::Object::RDBO object.
+
+=cut
+
+sub iterator {
+ my $self = shift;
+ my $iter = $self->_get_objects( 'get_objects_iterator', @_ );
+ return CatalystX::CRUD::Iterator->new( $iter, $self->object_class );
+}
+
+=head2 make_query( I<field_names> )
+
+Implement a RDBO-specific query factory based on request parameters.
+Return value can be passed directly to search(), iterator() or count() as
+documented in the CatalystX::CRUD::Model API.
+
+See CatalystX::CRUD::Model::Utils::make_sql_query() for API details.
+
+=cut
+
+sub _get_field_names {
+ my $self = shift;
+ return $self->{_field_names} if $self->{_field_names};
+ my @cols = $self->name->meta->column_names;
+ $self->{_field_names} = \@cols;
+ return \@cols;
+}
+
+=head2 treat_like_int
+
+Returns hash ref of all column names that return type =~ m/^date(time)$/.
+This is so that wildcard searches for date and datetime-based columns
+will get proper SQL rendering.
+
+=cut
+
+sub treat_like_int {
+ my $self = shift;
+ return $self->{_treat_like_int} if $self->{_treat_like_int};
+ $self->{_treat_like_int} = {};
+ my $col_names = $self->_get_field_names;
+
+ # treat wildcard timestamps like ints not text (>= instead of ILIKE)
+ for my $name (@$col_names) {
+ my $col = $self->name->meta->column($name);
+ $self->{_treat_like_int}->{$name} = 1
+ if $col->type =~ m/^date(time)?$/;
+ }
+
+ return $self->{_treat_like_int};
+}
+
+sub make_query {
+ my $self = shift;
+ my $c = $self->context;
+ my $field_names = shift || $self->_get_field_names;
+ my $q = $self->make_sql_query($field_names);
+
+ # dis-ambiguate common column names
+ $q->{sort_by} =~ s,\bname\ ,t1.name ,;
+ $q->{sort_by} =~ s,\bid\ ,t1.id ,;
+
+ return $q;
+}
+
+sub _get_objects {
+ my $self = shift;
+ my $method = shift || 'get_objects';
+ my @args = @_;
+ my $manager = $self->manager;
+ my $name = $self->name;
+ my @params = ( object_class => $name ); # not $self->object_class
+
+ if ( ref $args[0] eq 'HASH' ) {
+ push( @params, %{ $args[0] } );
+ }
+ elsif ( ref $args[0] eq 'ARRAY' ) {
+ push( @params, @{ $args[0] } );
+ }
+ else {
+ push( @params, @args );
+ }
+
+ push(
+ @params,
+ with_objects => $self->config->{load_with},
+ multi_many_ok => 1
+ ) if $self->config->{load_with};
+
+ return $manager->$method(@params);
+}
+
+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-model-rdbo at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD-Model-RDBO>.
+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::Model::RDBO
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/CatalystX-CRUD-Model-RDBO>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/CatalystX-CRUD-Model-RDBO>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD-Model-RDBO>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/CatalystX-CRUD-Model-RDBO>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+This module is based on Catalyst::Model::RDBO by the same author.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 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
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,139 @@
+package CatalystX::CRUD::Object::RDBO;
+use strict;
+use warnings;
+use base qw( CatalystX::CRUD::Object );
+
+our $VERSION = '0.11';
+
+=head1 NAME
+
+CatalystX::CRUD::Object::RDBO - Rose::DB::Object implementation of CatalystX::CRUD::Object
+
+=head1 SYNOPSIS
+
+ # fetch a row from MyApp::Model::Foo (which isa CatalystX::CRUD::Model)
+ my $foo = $c->model('Foo')->fetch( id => 1234 );
+ $foo->create;
+ $foo->read;
+ $foo->update;
+ $foo->delete;
+
+=head1 DESCRIPTION
+
+CatalystX::CRUD::Object::RDBO implements the required CRUD methods
+of a CatalystX::CRUD::Object subclass. It is intended for use
+with CatalystX::CRUD::Model::RDBO.
+
+=head1 METHODS
+
+Only new or overridden methods are documented here.
+
+=head2 load_speculative
+
+Calls load( speculative => 1 ) on the internal delegate() value.
+
+=cut
+
+# convenience methods
+sub load_speculative {
+ shift->delegate->load( speculative => 1 );
+}
+
+=head2 create
+
+Calls delegate->save().
+
+=cut
+
+# required methods
+sub create {
+ shift->delegate->save(@_);
+}
+
+=head2 read
+
+Calls delegate->load(). B<NOTE:> If you need a speculative load,
+use load_speculative() instead.
+
+=cut
+
+sub read {
+ shift->delegate->load(@_);
+}
+
+=head2 update
+
+Calls delegate->save().
+
+=cut
+
+sub update {
+ shift->delegate->save(@_);
+}
+
+=head2 delete
+
+Calls delegate->delete(@_).
+
+=cut
+
+sub delete {
+ shift->delegate->delete(@_);
+}
+
+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-model-rdbo at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD-Model-RDBO>.
+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::Model::RDBO
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/CatalystX-CRUD-Model-RDBO>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/CatalystX-CRUD-Model-RDBO>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD-Model-RDBO>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/CatalystX-CRUD-Model-RDBO>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+This module is based on Catalyst::Model::RDBO by the same author.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 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
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/00-load.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/00-load.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/00-load.t 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,10 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use lib qw( ../CatalystX-CRUD/lib );
+ use_ok( 'CatalystX::CRUD::Model::RDBO' );
+}
+
+diag( "Testing CatalystX::CRUD::Model::RDBO $CatalystX::CRUD::Model::RDBO::VERSION, Perl $], $^X" );
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/01-rdbo.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/01-rdbo.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/01-rdbo.t 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,16 @@
+use Test::More tests => 5;
+
+BEGIN {
+ use lib qw( ../CatalystX-CRUD/lib );
+ use_ok('CatalystX::CRUD::Model::RDBO');
+ use_ok('CatalystX::CRUD::Object::RDBO');
+ use_ok('Rose::DBx::TestDB');
+ use_ok('Rose::DB::Object');
+}
+
+use lib qw( t/lib );
+use Catalyst::Test 'MyApp';
+use Data::Dump qw( dump );
+
+ok( get('/foo'), "get /foo" );
+
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/boilerplate.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/boilerplate.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/boilerplate.t 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,48 @@
+#!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");
+ }
+}
+
+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)
+);
+
+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]/,
+ );
+}
+
+module_boilerplate_ok('lib/CatalystX/CRUD/Model/RDBO.pm');
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Foo.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Foo.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Foo.pm 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,43 @@
+package My::Foo;
+use base qw( Rose::DB::Object );
+use Carp;
+use Data::Dump qw( dump );
+
+# create a temp db
+my $db = Rose::DBx::TestDB->new;
+
+{
+ my $dbh = $db->dbh;
+
+ # create a schema to match this class
+ $dbh->do(
+ "create table foos ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(16) );"
+ );
+
+ # create some data
+ $dbh->do("insert into foos (name) values ('bar');");
+
+ # double check
+ my $sth = $dbh->prepare("SELECT * FROM foos");
+ $sth->execute;
+ croak "bad seed data in sqlite"
+ unless $sth->fetchall_arrayref->[0]->[0] == 1;
+
+ $sth = undef; # http://rt.cpan.org/Ticket/Display.html?id=22688
+ # does not seem to work.
+
+}
+
+__PACKAGE__->meta->setup(
+ table => 'foos',
+ columns => [
+ id => { type => 'serial', not_null => 1, primary_key => 1 },
+ name => { type => 'varchar', length => 16 },
+ ],
+);
+
+sub init_db {
+ return $db;
+}
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/Foo.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/Foo.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/Foo.pm 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,6 @@
+package MyApp::Model::Foo;
+use base qw( CatalystX::CRUD::Model::RDBO );
+__PACKAGE__->config->{object_class} = 'MyApp::Object';
+__PACKAGE__->config->{name} = 'My::Foo';
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Object.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Object.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Object.pm 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,4 @@
+package MyApp::Object;
+use base qw( CatalystX::CRUD::Object::RDBO );
+
+1;
\ No newline at end of file
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp.pm 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,29 @@
+package MyApp;
+use Catalyst::Runtime '5.70';
+use Catalyst;
+use Carp;
+
+our $VERSION = '0.01';
+
+__PACKAGE__->setup();
+
+sub foo : Local {
+
+ my ( $self, $c, @arg ) = @_;
+
+ my $thing = $c->model('Foo')->new_object( id => 1 );
+
+ for my $m (qw( create read update delete)) {
+ croak unless $thing->can($m);
+ }
+
+ # try fetching our seed data
+ $thing->read();
+
+ croak "bad read" unless ( $thing->delegate->name eq 'bar' );
+
+ $c->res->body("foo is a-ok");
+
+}
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/pod-coverage.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/pod-coverage.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/pod-coverage.t 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/pod.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/pod.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/pod.t 2008-03-11 17:21:06 UTC (rev 7487)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Catalyst-commits
mailing list