[Catalyst-commits] r8069 - in
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk: . lib
lib/CatalystX lib/CatalystX/CRUD
lib/CatalystX/CRUD/ModelAdapter t t/MyDB t/MyDB/Main t/lib
t/lib/MyApp t/lib/MyApp/Controller t/lib/MyApp/Model
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Wed Jul 2 05:15:34 BST 2008
Author: karpet
Date: 2008-07-02 05:15:33 +0100 (Wed, 02 Jul 2008)
New Revision: 8069
Added:
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/Changes
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/MANIFEST
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/Makefile.PL
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/README
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/DBIC.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/00-load.t
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/01-dbic.t
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Artist.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Cd.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Track.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/example.sql
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/insertdb.pl
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Controller/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Controller/CRUD.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Model/
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Model/Main.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyForm.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyModelAdapter.pm
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/pod-coverage.t
CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/pod.t
Log:
first pass. basic search/crud works. still needs docs and more tests
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/Changes
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/Changes (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/Changes 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,5 @@
+Revision history for CatalystX-CRUD-ModelAdapter-DBIC
+
+0.01 xxxx
+ First version, released on an unsuspecting world.
+
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/MANIFEST
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/MANIFEST (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/MANIFEST 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,10 @@
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+Makefile.PL
+README
+lib/CatalystX/CRUD/ModelAdapter/DBIC.pm
+t/00-load.t
+t/01-dbic.t
+t/pod-coverage.t
+t/pod.t
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/Makefile.PL
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/Makefile.PL (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/Makefile.PL 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+use lib qw( ../../CatalystX-CRUD/trunk/lib t );
+
+WriteMakefile(
+ NAME => 'CatalystX::CRUD::ModelAdapter::DBIC',
+ AUTHOR => 'Peter Karman <karman at cpan.org>',
+ VERSION_FROM => 'lib/CatalystX/CRUD/ModelAdapter/DBIC.pm',
+ ABSTRACT_FROM => 'lib/CatalystX/CRUD/ModelAdapter/DBIC.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'CatalystX::CRUD' => 0.27,
+ 'DBIx::Class' => 0,
+ 'Catalyst::Model::DBIC::Schema' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'CatalystX-CRUD-ModelAdapter-DBIC-*' },
+);
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/README
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/README (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/README 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,38 @@
+CatalystX-CRUD-ModelAdapter-DBIC
+
+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::ModelAdapter::DBIC
+
+You can also look for information at:
+
+ Search CPAN
+ http://search.cpan.org/dist/CatalystX-CRUD-ModelAdapter-DBIC
+
+ CPAN Request Tracker:
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD-ModelAdapter-DBIC
+
+ AnnoCPAN, annotated CPAN documentation:
+ http://annocpan.org/dist/CatalystX-CRUD-ModelAdapter-DBIC
+
+ CPAN Ratings:
+ http://cpanratings.perl.org/d/CatalystX-CRUD-ModelAdapter-DBIC
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2008 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-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/DBIC.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/DBIC.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/DBIC.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,233 @@
+package CatalystX::CRUD::ModelAdapter::DBIC;
+use warnings;
+use strict;
+use base qw( CatalystX::CRUD::ModelAdapter CatalystX::CRUD::Model::Utils );
+use Class::C3;
+use Scalar::Util qw( weaken );
+
+our $VERSION = '0.01';
+
+=head1 NAME
+
+CatalystX::CRUD::ModelAdapter::DBIC - CRUD for Catalyst::Model::DBIC::Schema
+
+=head1 SYNOPSIS
+
+ # create an adapter class (NOTE not in ::Model namespace)
+ package MyApp::MyDBICAdapter;
+ use strict;
+ use base qw( CatalystX::CRUD::ModelAdapter::DBIC );
+
+ 1;
+
+ # your main DBIC::Schema model
+ package MyApp::Model::MyDBIC;
+ use strict;
+ use base qw( Catalyst::Model::DBIC::Schema );
+
+ 1;
+
+=head1 DESCRIPTION
+
+
+=head1 METHODS
+
+
+=cut
+
+sub new_object {
+ my $self = shift;
+ my $controller = shift;
+ my $c = shift;
+ my $moniker = $self->_get_moniker( $controller, $c );
+ return $c->model( $self->model_name )->resultset($moniker)
+ ->new_result( {} );
+}
+
+sub fetch {
+ my $self = shift;
+ my $controller = shift;
+ my $c = shift;
+ my $moniker = $self->_get_moniker( $controller, $c );
+ if (@_) {
+ my $dbic_obj;
+ eval {
+ $dbic_obj
+ = $c->model( $self->model_name )->resultset($moniker)
+ ->find( {@_} );
+ };
+ if ( $@ or !$dbic_obj ) {
+ my $err = defined($dbic_obj) ? $dbic_obj->error : $@;
+ return
+ if $self->throw_error(
+ "can't create new $moniker object: $err");
+ }
+
+ return $dbic_obj;
+ }
+ else {
+ return $self->new_object( $controller, $c );
+ }
+}
+
+sub search {
+ my ( $self, $controller, $c, @arg ) = @_;
+ my $query = shift(@arg) || $self->make_query( $c, $controller );
+ my @rs
+ = $c->model( $self->model_name )
+ ->resultset( $self->_get_moniker( $controller, $c ) )
+ ->search(@$query);
+ return wantarray ? @rs : \@rs;
+}
+
+sub _get_moniker {
+ my ( $self, $controller, $c ) = @_;
+ my $moniker = $c->stash->{dbic_schema}
+ || $controller->model_meta->{dbic_schema}
+ or $self->throw_error(
+ "must define a dbic_schema for each CRUD controller");
+ return $moniker;
+}
+
+sub iterator {
+ my ( $self, $controller, $c, @arg ) = @_;
+ my $query = shift(@arg) || $self->make_query( $c, $controller );
+ my $rs
+ = $c->model( $self->model_name )
+ ->resultset( $self->_get_moniker( $controller, $c ) )
+ ->search(@$query);
+ return $rs;
+}
+
+sub count {
+ my ( $self, $controller, $c, @arg ) = @_;
+ my $query = shift(@arg) || $self->make_query( $c, $controller );
+ return $c->model( $self->model_name )
+ ->resultset( $self->_get_moniker( $controller, $c ) )->count(@$query);
+}
+
+sub make_query {
+ my $self = shift;
+ my $c = shift;
+ my $controller = shift;
+ my $field_names = shift
+ || $self->_get_field_names( $controller, $c );
+
+ # TODO sort order and limit/offset support
+ # it's already in $q but need DBIC syntax
+
+ # Model::Utils (make_sql_query) assumes ACCEPT_CONTEXT accessor
+ $self->{context} = $c;
+ weaken( $self->{context} );
+
+ my @query;
+ my $q = $self->make_sql_query($field_names);
+
+ push( @query,
+ { @{ $q->{query} } },
+ $controller->model_meta->{resultset_opts} )
+ if $controller->model_meta->{resultset_opts};
+
+ return \@query;
+}
+
+sub _get_field_names {
+ my $self = shift;
+ my $controller = shift;
+ my $c = shift;
+ return $self->{_field_names} if $self->{_field_names};
+
+ my $obj = $c->model( $self->model_name )
+ ->composed_schema->source( $self->_get_moniker( $controller, $c ) );
+ my @cols = $obj->columns;
+ my @rels = $obj->relationships;
+
+ my @fields;
+ for my $rel (@rels) {
+ my $info = $obj->relationship_info($rel);
+ my $rel_class = $info->{source};
+ my @rel_cols = $rel_class->columns;
+ push( @fields, map { $rel . '.' . $_ } @rel_cols );
+ }
+ for my $col (@cols) {
+ push( @fields, 'me.' . $col );
+ }
+
+ $self->{_field_names} = \@fields;
+
+ return \@fields;
+}
+
+sub create {
+ my ( $self, $c, $object ) = @_;
+ $object->insert;
+}
+
+sub read {
+ my ( $self, $c, $object ) = @_;
+ $object->find; # TODO is this right?
+}
+
+sub update {
+ my ( $self, $c, $object ) = @_;
+ $object->update;
+
+}
+
+sub delete {
+ my ( $self, $c, $object ) = @_;
+ $object->delete;
+}
+
+=head1 AUTHOR
+
+Peter Karman, C<< <karman at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-catalystx-crud-modeladapter-dbic at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD-ModelAdapter-DBIC>.
+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::ModelAdapter::DBIC
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/CatalystX-CRUD-ModelAdapter-DBIC>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/CatalystX-CRUD-ModelAdapter-DBIC>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD-ModelAdapter-DBIC>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/CatalystX-CRUD-ModelAdapter-DBIC>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Peter Karman, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/00-load.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/00-load.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/00-load.t 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,12 @@
+#!perl -T
+
+use Test::More tests => 1;
+use lib qw( ../../CatalystX-CRUD/trunk/lib t );
+
+BEGIN {
+ use_ok('CatalystX::CRUD::ModelAdapter::DBIC');
+}
+
+diag(
+ "Testing CatalystX::CRUD::ModelAdapter::DBIC $CatalystX::CRUD::ModelAdapter::DBIC::VERSION, Perl $], $^X"
+);
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/01-dbic.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/01-dbic.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/01-dbic.t 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,51 @@
+use Test::More tests => 13;
+
+BEGIN {
+ use lib qw( ../../CatalystX-CRUD/trunk/lib t );
+ use_ok('CatalystX::CRUD::ModelAdapter::DBIC');
+
+ system("cd t/ && $^X insertdb.pl") and die "can't create db: $!";
+}
+
+END { unlink('t/example.db') unless $ENV{PERL_DEBUG}; }
+
+use lib qw( t/lib );
+use Catalyst::Test 'MyApp';
+use Data::Dump qw( dump );
+use HTTP::Request::Common;
+
+ok( my $res = request('/test1'), "get /test1" );
+is( $res->content, 13, "right number of results" );
+ok( $res = request('/crud/test2?cd.title=Bad'), "get /test2" );
+is( $res->content, 3, "iterator for cd.title=Bad" );
+ok( $res = request('/crud/test3?cd.title=Bad'), "get /test3" );
+is( $res->content, 3, "search for cd.title=Bad" );
+ok( $res = request('/crud/test4?cd.title=Bad'), "get /test4" );
+is( $res->content, 3, "count for cd.title=Bad" );
+
+# read
+ok( $res = request( HTTP::Request->new( GET => '/crud/1/view' ) ),
+ "GET view" );
+
+#diag( $res->content );
+is( $res->content, '{ cd => 3, title => "Beat It", trackid => 1 }',
+ "GET track 1" );
+
+# create
+ok( $res = request(
+ POST(
+ '/crud/0/save',
+ [ cd => 3,
+ title => 'Something New, Something Blue',
+ trackid => 0
+ ]
+ )
+ ),
+ "POST new track"
+);
+
+#diag( $res->content );
+is( $res->content,
+ '{ cd => 3, title => "Something New, Something Blue", trackid => 8 }',
+ "POST new track"
+);
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Artist.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Artist.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Artist.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,9 @@
+package MyDB::Main::Artist;
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/PK::Auto Core/);
+__PACKAGE__->table('artist');
+__PACKAGE__->add_columns(qw/ artistid name /);
+__PACKAGE__->set_primary_key('artistid');
+__PACKAGE__->has_many( 'cds' => 'MyDB::Main::Cd' );
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Cd.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Cd.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Cd.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,10 @@
+package MyDB::Main::Cd;
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/PK::Auto Core/);
+__PACKAGE__->table('cd');
+__PACKAGE__->add_columns(qw/ cdid artist title/);
+__PACKAGE__->set_primary_key('cdid');
+__PACKAGE__->belongs_to( 'artist' => 'MyDB::Main::Artist' );
+__PACKAGE__->has_many( 'tracks' => 'MyDB::Main::Track' );
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Track.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Track.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Track.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,9 @@
+package MyDB::Main::Track;
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/PK::Auto Core/);
+__PACKAGE__->table('track');
+__PACKAGE__->add_columns(qw/ trackid cd title/);
+__PACKAGE__->set_primary_key('trackid');
+__PACKAGE__->belongs_to( 'cd' => 'MyDB::Main::Cd' );
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,5 @@
+package MyDB::Main;
+use base qw/DBIx::Class::Schema/;
+__PACKAGE__->load_classes(qw/Artist Cd Track/);
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/example.sql
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/example.sql (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/example.sql 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,16 @@
+CREATE TABLE artist (
+ artistid INTEGER PRIMARY KEY AUTOINCREMENT,
+ name TEXT NOT NULL
+ );
+
+CREATE TABLE cd (
+ cdid INTEGER PRIMARY KEY AUTOINCREMENT,
+ artist INTEGER NOT NULL REFERENCES artist(artistid),
+ title TEXT NOT NULL
+ );
+
+CREATE TABLE track (
+ trackid INTEGER PRIMARY KEY AUTOINCREMENT,
+ cd INTEGER NOT NULL REFERENCES cd(cdid),
+ title TEXT NOT NULL
+ );
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/insertdb.pl
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/insertdb.pl (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/insertdb.pl 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,76 @@
+#!/usr/bin/perl -w
+
+use MyDB::Main;
+use strict;
+
+my $schema = MyDB::Main->connect('dbi:SQLite:example.db');
+my $dbh = $schema->storage->dbh;
+
+$dbh->do(
+ qq{
+CREATE TABLE artist (
+ artistid INTEGER PRIMARY KEY AUTOINCREMENT,
+ name TEXT NOT NULL
+ );}
+) or die;
+
+$dbh->do(
+ qq{
+CREATE TABLE cd (
+ cdid INTEGER PRIMARY KEY AUTOINCREMENT,
+ artist INTEGER NOT NULL REFERENCES artist(artistid),
+ title TEXT NOT NULL
+ );
+}
+) or die;
+
+$dbh->do(
+ qq{
+CREATE TABLE track (
+ trackid INTEGER PRIMARY KEY AUTOINCREMENT,
+ cd INTEGER NOT NULL REFERENCES cd(cdid),
+ title TEXT NOT NULL
+ );
+}
+) or die;
+
+# here's some of the sql that is going to be generated by the schema
+# INSERT INTO artist VALUES (NULL,'Michael Jackson');
+# INSERT INTO artist VALUES (NULL,'Eminem');
+
+my @artists = ( ['Michael Jackson'], ['Eminem'] );
+$schema->populate( 'Artist', [ [qw/name/], @artists, ] );
+
+my %albums = (
+ 'Thriller' => 'Michael Jackson',
+ 'Bad' => 'Michael Jackson',
+ 'The Marshall Mathers LP' => 'Eminem',
+);
+
+my @cds;
+foreach my $lp ( sort keys %albums ) {
+ my $artist
+ = $schema->resultset('Artist')->search( { name => $albums{$lp} } );
+ push @cds, [ $lp, $artist->first ];
+}
+
+$schema->populate( 'Cd', [ [qw/title artist/], @cds, ] );
+
+my %tracks = (
+ 'Beat It' => 'Thriller',
+ 'Billie Jean' => 'Thriller',
+ 'Dirty Diana' => 'Bad',
+ 'Smooth Criminal' => 'Bad',
+ 'Leave Me Alone' => 'Bad',
+ 'Stan' => 'The Marshall Mathers LP',
+ 'The Way I Am' => 'The Marshall Mathers LP',
+);
+
+my @tracks;
+foreach my $track ( sort keys %tracks ) {
+ my $cdname
+ = $schema->resultset('Cd')->search( { title => $tracks{$track}, } );
+ push @tracks, [ $cdname->first, $track ];
+}
+
+$schema->populate( 'Track', [ [qw/cd title/], @tracks, ] );
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Controller/CRUD.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Controller/CRUD.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Controller/CRUD.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,81 @@
+package MyApp::Controller::CRUD;
+use strict;
+use warnings;
+use base qw( CatalystX::CRUD::Test::Controller );
+use Carp;
+use Data::Dump;
+use MyForm;
+
+__PACKAGE__->config(
+ form_class => 'MyForm',
+ form_fields => [qw( title cd trackid )],
+ init_form => 'init_with_track',
+ init_object => 'track_from_form',
+ default_template => 'no/such/file',
+ model_name => 'Main',
+ model_adapter => 'MyModelAdapter',
+ model_meta => {
+ dbic_schema => 'Track',
+ resultset_opts => {
+ join => [qw/ cd /],
+ prefetch => [qw/ cd /]
+ }
+ },
+ primary_key => 'trackid',
+ view_on_single_result => 0,
+ page_size => 50,
+ allow_GET_writes => 0,
+);
+
+sub serialize_object {
+ my ( $self, $c, $object ) = @_;
+ my $fields = $c->stash->{form}->fields;
+ my $serial = {};
+ for my $f (@$fields) {
+ if ( $f eq 'cd' && defined $object->$f ) {
+ $serial->{$f} = $object->$f->cdid;
+ }
+ else {
+ $serial->{$f} = $object->$f;
+ }
+ }
+ return Data::Dump::dump($serial);
+}
+
+# iterator
+sub test2 : Local {
+ my ( $self, $c ) = @_;
+
+ my $count = 0;
+
+ my $rs = $self->do_model( $c, 'iterator' );
+ while ( my $track = $rs->next ) {
+ #$self->serialize_object( $c, $track );
+ $count++;
+ }
+
+ $c->res->body($count);
+}
+
+# search
+sub test3 : Local {
+ my ( $self, $c ) = @_;
+
+ my $count = 0;
+ my @results = $self->do_model( $c, 'search' );
+ for my $r (@results) {
+ #$self->serialize_object( $c, $r );
+ $count++;
+ }
+
+ $c->res->body($count);
+}
+
+# count
+sub test4 : Local {
+ my ( $self, $c ) = @_;
+ my $count = $self->do_model( $c, 'count' );
+ $c->res->body($count);
+}
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Model/Main.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Model/Main.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp/Model/Main.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,11 @@
+package MyApp::Model::Main;
+use base qw( Catalyst::Model::DBIC::Schema );
+
+__PACKAGE__->config(
+ schema_class => 'MyDB::Main',
+ connect_info =>
+ [ 'dbi:SQLite:' . MyApp->path_to() . '/../../example.db' ],
+
+);
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyApp.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,115 @@
+package MyApp;
+use strict;
+use warnings;
+use Catalyst;
+use Catalyst::Runtime;
+
+__PACKAGE__->setup();
+
+# mimic testdb.pl from the cookbook
+sub test1 : Local {
+ my ( $self, $c ) = @_;
+
+ my $schema = $c->model('Main')->schema;
+ my $count = 0;
+
+ get_tracks_by_cd( $schema, \$count, 'Bad' );
+ get_tracks_by_artist( $schema, \$count, 'Michael Jackson' );
+
+ get_cd_by_track( $schema, \$count, 'Stan' );
+ get_cds_by_artist( $schema, \$count, 'Michael Jackson' );
+
+ get_artist_by_track( $schema, \$count, 'Dirty Diana' );
+ get_artist_by_cd( $schema, \$count, 'The Marshall Mathers LP' );
+
+ $c->res->body($count);
+}
+
+#################################################################
+## private functions
+
+sub get_tracks_by_cd {
+ my $schema = shift;
+ my $count = shift;
+ my $cdtitle = shift;
+ my $rs = $schema->resultset('Track')->search(
+ { 'cd.title' => $cdtitle },
+ { join => [qw/ cd /],
+ prefetch => [qw/ cd /]
+ }
+ );
+ while ( my $track = $rs->next ) {
+ $$count++;
+ }
+
+}
+
+sub get_tracks_by_artist {
+ my $schema = shift;
+ my $count = shift;
+ my $artistname = shift;
+ my $rs = $schema->resultset('Track')->search(
+ { 'artist.name' => $artistname },
+ { join => { 'cd' => 'artist' }, }
+ );
+ while ( my $track = $rs->next ) {
+ $$count++;
+ }
+
+}
+
+sub get_cd_by_track {
+ my $schema = shift;
+ my $count = shift;
+ my $tracktitle = shift;
+
+ my $rs
+ = $schema->resultset('Cd')->search( { 'tracks.title' => $tracktitle },
+ { join => [qw/ tracks /], } );
+ my $cd = $rs->first;
+ $$count++;
+}
+
+sub get_cds_by_artist {
+ my $schema = shift;
+ my $count = shift;
+ my $artistname = shift;
+
+ my $rs = $schema->resultset('Cd')->search(
+ { 'artist.name' => $artistname },
+ { join => [qw/ artist /],
+ prefetch => [qw/ artist /]
+ }
+ );
+ while ( my $cd = $rs->next ) {
+ $$count++;
+ }
+
+}
+
+sub get_artist_by_track {
+ my $schema = shift;
+ my $count = shift;
+ my $tracktitle = shift;
+
+ my $rs = $schema->resultset('Artist')->search(
+ { 'tracks.title' => $tracktitle },
+ { join => { 'cds' => 'tracks' } }
+ );
+ my $artist = $rs->first;
+ $$count++;
+}
+
+sub get_artist_by_cd {
+ my $schema = shift;
+ my $count = shift;
+ my $cdtitle = shift;
+
+ my $rs = $schema->resultset('Artist')
+ ->search( { 'cds.title' => $cdtitle }, { join => [qw/ cds /], } );
+ my $artist = $rs->first;
+ $$count++;
+}
+
+1;
+
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyForm.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyForm.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyForm.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,15 @@
+package MyForm;
+use strict;
+use base qw( CatalystX::CRUD::Test::Form );
+
+sub init_with_track {
+ my $self = shift;
+ return $self->SUPER::init_with_object(@_);
+}
+
+sub track_from_form {
+ my $self = shift;
+ return $self->SUPER::object_from_form(@_);
+}
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyModelAdapter.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyModelAdapter.pm (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/lib/MyModelAdapter.pm 2008-07-02 04:15:33 UTC (rev 8069)
@@ -0,0 +1,5 @@
+package MyModelAdapter;
+use strict;
+use base qw( CatalystX::CRUD::ModelAdapter::DBIC );
+
+1;
Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/pod-coverage.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/pod-coverage.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/pod-coverage.t 2008-07-02 04:15:33 UTC (rev 8069)
@@ -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-ModelAdapter-DBIC/trunk/t/pod.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/pod.t (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/pod.t 2008-07-02 04:15:33 UTC (rev 8069)
@@ -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