[Bast-commits] r5306 - in DBIx-Class-Schema-PopulateMore/truck: .
lib lib/DBIx lib/DBIx/Class lib/DBIx/Class/Schema
lib/DBIx/Class/Schema/PopulateMore
lib/DBIx/Class/Schema/PopulateMore/Inflator
lib/DBIx/Class/Schema/PopulateMore/Test
lib/DBIx/Class/Schema/PopulateMore/Test/Schema
lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result
lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet t t/author
jnapiorkowski at dev.catalyst.perl.org
jnapiorkowski at dev.catalyst.perl.org
Tue Jan 13 02:46:29 GMT 2009
Author: jnapiorkowski
Date: 2009-01-13 02:46:28 +0000 (Tue, 13 Jan 2009)
New Revision: 5306
Added:
DBIx-Class-Schema-PopulateMore/truck/Changes
DBIx-Class-Schema-PopulateMore/truck/MANIFEST
DBIx-Class-Schema-PopulateMore/truck/MANIFEST.SKIP
DBIx-Class-Schema-PopulateMore/truck/META.yml
DBIx-Class-Schema-PopulateMore/truck/Makefile.PL
DBIx-Class-Schema-PopulateMore/truck/README
DBIx-Class-Schema-PopulateMore/truck/lib/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Command.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Date.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Env.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Index.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Company.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/CompanyPerson.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/EmploymentHistory.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/FriendList.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Gender.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Person.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet/
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet/Person.pm
DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Visitor.pm
DBIx-Class-Schema-PopulateMore/truck/t/
DBIx-Class-Schema-PopulateMore/truck/t/00-load.t
DBIx-Class-Schema-PopulateMore/truck/t/01-schema.t
DBIx-Class-Schema-PopulateMore/truck/t/02-yaml_example.t
DBIx-Class-Schema-PopulateMore/truck/t/author/
DBIx-Class-Schema-PopulateMore/truck/t/author/newlines.t
DBIx-Class-Schema-PopulateMore/truck/t/author/pod-coverage.t
DBIx-Class-Schema-PopulateMore/truck/t/author/pod.t
Log:
Added: DBIx-Class-Schema-PopulateMore/truck/Changes
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/Changes (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/Changes 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,15 @@
+Revision history for Perl extension DBIx-Class-Schema-PopulateMore.
+
+0.04 Friday, June 04, 2008
+ - Moved namespace of component from DBIx-Class-PopulateMore
+ - Minor documentation updates
+
+0.03 Friday, May 29, 2008
+ - Fixed missing dependencies from Makefile.PL
+ - Documentation and example improvements
+
+0.02 Friday, May 29, 2008
+ - Fix for messed up POD and missing Makefile.PL
+
+0.01 Friday, May 29, 2008
+ - Initial release
Added: DBIx-Class-Schema-PopulateMore/truck/MANIFEST
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/MANIFEST (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/MANIFEST 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,39 @@
+Changes
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/DBIx/Class/Schema/PopulateMore.pm
+lib/DBIx/Class/Schema/PopulateMore/Command.pm
+lib/DBIx/Class/Schema/PopulateMore/Inflator.pm
+lib/DBIx/Class/Schema/PopulateMore/Inflator/Date.pm
+lib/DBIx/Class/Schema/PopulateMore/Inflator/Env.pm
+lib/DBIx/Class/Schema/PopulateMore/Inflator/Index.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Company.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/CompanyPerson.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/EmploymentHistory.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/FriendList.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Gender.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Person.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet.pm
+lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet/Person.pm
+lib/DBIx/Class/Schema/PopulateMore/Visitor.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t-author/newlines.t
+t-author/pod-coverage.t
+t-author/pod.t
+t/00-load.t
+t/01-schema.t
+t/02-yaml_example.t
Added: DBIx-Class-Schema-PopulateMore/truck/MANIFEST.SKIP
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/MANIFEST.SKIP (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/MANIFEST.SKIP 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,40 @@
+
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# for developers only :)
+^TODO$
+^VERSIONING\.SKETCH$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\b\.#
+
+# avoid OS X finder files
+\.DS_Store$
+
+
+# Don't ship the last dist we built :)
+\.tar\.gz$
+
+# Skip maint stuff
+^maint/
\ No newline at end of file
Added: DBIx-Class-Schema-PopulateMore/truck/META.yml
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/META.yml (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/META.yml 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,30 @@
+---
+abstract: 'An enhanced populate method'
+author:
+ - 'John Napiorkowski <jjn1056 at yahoo.com>'
+build_requires:
+ DBIx::Class: 0.08010
+ File::Find: 0
+ File::Temp: 0
+ Test::More: 0
+ YAML::Tiny: 0
+distribution_type: module
+generated_by: 'Module::Install version 0.72'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
+name: DBIx-Class-Schema-PopulateMore
+no_index:
+ directory:
+ - inc
+ - t
+requires:
+ Data::Visitor: 0.15
+ DateTimeX::Easy: 0.082
+ List::MoreUtils: 0.22
+ Module::Pluggable: 3.8
+ Moose: 0.48
+ MooseX::AttributeHelpers: 0.09
+ perl: 5.8.6
+version: 0.04
Added: DBIx-Class-Schema-PopulateMore/truck/Makefile.PL
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/Makefile.PL (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/Makefile.PL 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,24 @@
+use inc::Module::Install;
+
+perl_version '5.008006';
+name 'DBIx-Class-Schema-PopulateMore';
+all_from 'lib/DBIx/Class/Schema/PopulateMore.pm';
+author 'John Napiorkowski <jjn1056 at yahoo.com>';
+
+requires 'Moose' => '0.48';
+requires 'MooseX::AttributeHelpers' => '0.09';
+requires 'DateTimeX::Easy' => '0.082';
+requires 'List::MoreUtils' => '0.22';
+requires 'Module::Pluggable' => '3.8';
+requires 'Data::Visitor' => '0.15';
+
+build_requires 'DBIx::Class' => '0.08010';
+build_requires 'Test::More';
+build_requires 'File::Find';
+build_requires 'File::Temp';
+build_requires 'YAML::Tiny';
+
+auto_install;
+
+WriteAll;
+
Added: DBIx-Class-Schema-PopulateMore/truck/README
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/README (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/README 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,63 @@
+DBIx-Class-Schema-PopulateMore
+
+This is a DBIC::Schema component and stand alone class that is an enhanced
+version of the builtin method "$schema->populate". What it does is make it
+easier when you are doing a first time setup and need to insert a bunch of
+rows, like the first time you deploy a new database, or after you update it.
+
+It's not as full featured as L<DBIx::Class::Fixtures> but is targeted more
+directly at making it easier to just take a prewritten perl structure --or one
+loaded from a configuration file-- and setup your database.
+
+Most of us using L<DBIx::CLass> have written a version of this at one time or
+another. What is special to this component is the fact that unlike the normal
+populate method you can insert to multiple result_sources in one go. While
+doing this, we index the created rows so as to make it easy to reference them
+in relationships. I did this because I think it's very ugly to have to type in
+all the primary keys by hand, particularly if your PK is multi column, or is
+using some lengthy format such as uuid. Also, we can embed macro like commands
+in the row values to do inflation for us. For example, any value starting with
+"!Index:" will substitute it's value for that of the relating fields in the
+named row.
+
+Please see the pod for L<DBIx::Class::Schema::PopulateMore> for additional details and
+examples. Also you can see the tests which provide a detailed example.
+
+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 DBIx::Class::Schema::PopulateMore
+
+You can also look for information at:
+
+ RT, CPAN's request tracker
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-Schema-PopulateMore
+
+ AnnoCPAN, Annotated CPAN documentation
+ http://annocpan.org/dist/DBIx-Class-Schema-PopulateMore
+
+ CPAN Ratings
+ http://cpanratings.perl.org/d/DBIx-Class-Schema-PopulateMore
+
+ Search CPAN
+ http://search.cpan.org/dist/DBIx-Class-Schema-PopulateMore
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2008 John Napiorkowski
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Command.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Command.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Command.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,362 @@
+package DBIx::Class::Schema::PopulateMore::Command;
+
+use Moose;
+use MooseX::AttributeHelpers;
+use List::MoreUtils qw(pairwise);
+use DBIx::Class::Schema::PopulateMore::Visitor;
+use Module::Pluggable::Object;
+
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Command - Command Class to Populate a Schema
+
+=head1 DESCRIPTION
+
+This is a command pattern class to manage the job of populating a
+L<DBIx::Class::Schema> with information. We break this out because the
+actual job is a bit complex, is likely to grow more complex, and so that
+we can more easily identify refactorable and reusable parts.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head2 schema
+
+This is the Schema we are populating
+
+=cut
+
+has 'schema' => (
+ is=>'ro',
+ required=>1,
+ isa=>'DBIx::Class::Schema',
+);
+
+
+=head2 definitions
+
+This is an arrayref of information used to populate tables in the database
+
+=cut
+
+has 'definitions' => (
+ is=>'ro',
+ required=>1,
+ isa=>"ArrayRef[HashRef]",
+ auto_deref=>1,
+);
+
+
+=head2 match_condition
+
+How we know the value is really something to inflate or perform a substitution
+on. This get's the namespace of the substitution plugin and it's other data.
+
+=cut
+
+has 'match_condition' => (
+ is=>'ro',
+ required=>1,
+ isa=>'RegexpRef',
+ default=>sub {qr/^!(\w+:.+)$/ },
+);
+
+
+=head2 visitor
+
+We define a visitor so that we can perform the value inflations and or
+substitutions. This is still a little work in progress, but it's getting
+neater
+
+=cut
+
+has 'visitor' => (
+ is=>'ro',
+ isa=>'DBIx::Class::Schema::PopulateMore::Visitor',
+ lazy_build=>1,
+ handles => [
+ 'callback',
+ 'visit',
+ ],
+);
+
+
+=head2 rs_index
+
+The index of previously inflated resultsets. Basically when we create a new
+row in the table, we cache the result object so that it can be used as a
+dependency in creating another.
+
+Eventually will be moved into the constructor for a plugin
+
+=head2 set_rs_index
+
+Set an index value to an inflated result
+
+=head2 get_rs_index
+
+given an index, returns the related inflated resultset
+
+=cut
+
+has 'rs_index' => (
+ metaclass=>'Collection::Hash',
+ is=>'rw',
+ isa=>'HashRef[Object]',
+ lazy=>1,
+ default=>sub {{}},
+ provides=> {
+ set => 'set_rs_index',
+ get => 'get_rs_index',
+ },
+);
+
+
+=head2 inflator_loader
+
+Loads each of the available inflators, provider access to the objects
+
+=cut
+
+has 'inflator_loader' => (
+ is=>'ro',
+ isa=>'Module::Pluggable::Object',
+ lazy_build=>1,
+ handles=>{
+ 'inflators' => 'plugins',
+ },
+);
+
+
+=head2 inflator_dispatcher
+
+Holds an object that can perform dispatching to the inflators.
+
+=cut
+
+has 'inflator_dispatcher' => (
+ metaclass=>'Collection::Hash',
+ is=>'rw',
+ isa=>'HashRef[Object]',
+ lazy_build=>1,
+ provides=>{
+ 'keys' => 'inflator_list',
+ 'get' => 'get_inflator',
+ },
+);
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 _build_visitor
+
+lazy build for the L</visitor> attribute.
+
+=cut
+
+sub _build_visitor
+{
+ my $self = shift @_;
+
+ DBIx::Class::Schema::PopulateMore::Visitor->new({
+ match_condition=>$self->match_condition
+ });
+}
+
+
+=head2 _build_inflator_loader
+
+lazy build for the L</inflator_loader> attribute
+
+=cut
+
+sub _build_inflator_loader
+{
+ my $self = shift @_;
+
+ return Module::Pluggable::Object->new(
+ search_path => 'DBIx::Class::Schema::PopulateMore::Inflator',
+ require => 1,
+ except => 'DBIx::Class::Schema::PopulateMore::Inflator',
+ );
+}
+
+
+=head2 _build_inflator_dispatcher
+
+lazy build for the L</inflator_dispatcher> attribute
+
+=cut
+
+sub _build_inflator_dispatcher
+{
+ my $self = shift @_;
+
+ my %inflators;
+ for my $inflator ($self->inflators)
+ {
+ my $inflator_obj = $inflator->new;
+ my $name = $inflator_obj->name;
+
+ $inflators{$name} = $inflator_obj;
+
+ }
+
+ return \%inflators;
+}
+
+
+=head2 execute
+
+The command classes main method. Returns a Hash of the created result
+rows, where each key is the named index and the value is the row object.
+
+=cut
+
+sub execute
+{
+ my ($self) = @_;
+
+ foreach my $definition ($self->definitions)
+ {
+ my ($source, $info) = each %$definition;
+ my @fields = $self->coerce_to_array($info->{fields});
+
+ my $data = $self
+ ->callback(sub {
+ $self->dispatch_inflator(shift);
+ })
+ ->visit($info->{data});
+
+ while( my ($rs_key, $values) = each %{$data} )
+ {
+ my @values = $self->coerce_to_array($values);
+
+ my $new = $self->create_fixture(
+ $rs_key => $source,
+ $self->merge_fields_values([@fields], [@values])
+ );
+ }
+ }
+
+ return %{$self->rs_index};
+}
+
+
+=head2 dispatch_inflator
+
+Dispatch to the correct inflator
+
+=cut
+
+sub dispatch_inflator
+{
+ my $self = shift @_;
+ my ($name, $command) = split(':', shift);
+
+ if( my $inflator = $self->get_inflator($name) )
+ {
+ $inflator->inflate($self, $command);
+ }
+ else
+ {
+ my $available = join(', ', $self->inflator_list);
+ confess "Can't Handle $name, available are: $available";
+ }
+}
+
+
+=head2 create_fixture({})
+
+Given a hash suitable for a L<DBIx::Class::Resultset> create method, attempt to
+update or create a row in the named source.
+
+returns the newly created row or throws an exception if there is a failure
+
+=cut
+
+sub create_fixture
+{
+ my ($self, $rs_key => $source, @create) = @_;
+
+ my $new = $self
+ ->schema
+ ->resultset($source)
+ ->update_or_create({@create});
+
+ $self->set_rs_index("$source.$rs_key" => $new);
+
+ return $new;
+}
+
+
+=head2 merge_fields_values
+
+Given a fields and values, combine to a hash suitable for using in a create_fixture
+row statement.
+
+=cut
+
+sub merge_fields_values
+{
+ my ($self, $fields, $values) = @_;
+
+ return pairwise {
+ $self->field_value($a,$b)
+ } (@$fields, @$values);
+}
+
+
+=head2 field_value
+
+Correctly create an array from the fields, values variables, skipping those
+where the value is undefined.
+
+=cut
+
+sub field_value
+{
+ my ($self, $a, $b) = @_;
+
+ if(defined $a && defined $b)
+ {
+ return $a => $b;
+ }
+ else
+ {
+ return;
+ }
+}
+
+
+=head2 coerce_to_array
+
+given a value that is either an arrayref or a scalar, put it into array context
+and return that array.
+
+=cut
+
+sub coerce_to_array
+{
+ my ($self, $value) = @_;
+
+ return ref $value eq 'ARRAY' ? @$value:($value);
+}
+
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Date.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Date.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Date.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,59 @@
+package DBIx::Class::Schema::PopulateMore::Inflator::Date;
+
+use Moose;
+use DateTimeX::Easy;
+extends 'DBIx::Class::Schema::PopulateMore::Inflator';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Inflator::Date - Returns A L<DateTime> object
+
+=head1 DESCRIPTION
+
+Sometimes you need to put dates into your table rows, but this can be a big
+hassle to do, particularly in a crossplatform way. This plugin will assist
+in this. It also makes it easy to insert relative date/times. such as 'now',
+'last week', etc. See L<DateTimeX::Easy> for more information on how we
+coerce dates.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 inflate($command, $string)
+
+This is called by Populate's dispatcher, when there is a match.
+
+=cut
+
+sub inflate
+{
+ my ($self, $command, $string) = @_;
+
+ if(my $dt = DateTimeX::Easy->new($string, default_time_zone=>'UTC'))
+ {
+ return $dt;
+ }
+ else
+ {
+ confess "Couldn't deal with $string as a date";
+ }
+
+}
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Env.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Env.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Env.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,57 @@
+package DBIx::Class::Schema::PopulateMore::Inflator::Env;
+
+use Moose;
+extends 'DBIx::Class::Schema::PopulateMore::Inflator';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Inflator::Env - inflated via the %ENV hash
+
+=head1 DESCRIPTION
+
+So that a value in a fixture or populate can be set via %ENV. Checks the
+command and it's upcased version.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 inflate($command, $string)
+
+This is called by Populate's dispatcher, when there is a match.
+
+=cut
+
+sub inflate
+{
+ my ($self, $command, $string) = @_;
+
+ if( defined $ENV{$string} )
+ {
+ return $ENV{$string};
+ }
+ elsif( defined $ENV{uc $string} )
+ {
+ return $ENV{uc $string};
+ }
+
+ return;
+}
+
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Index.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Index.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator/Index.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,49 @@
+package DBIx::Class::Schema::PopulateMore::Inflator::Index;
+
+use Moose;
+extends 'DBIx::Class::Schema::PopulateMore::Inflator';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Inflator::Index - Coerce DateTime from Strings
+
+=head1 DESCRIPTION
+
+Allows you to make the value equal to the result object of a previously
+inserted row.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 inflate($command, $string)
+
+This is called by Populate's dispatcher, when there is a match.
+
+=cut
+
+sub inflate
+{
+ my ($self, $command, $string) = @_;
+
+ return $command->get_rs_index($string)
+ || confess "Bad Index in Fixture: $string";
+}
+
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Inflator.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,67 @@
+package DBIx::Class::Schema::PopulateMore::Inflator;
+
+use Moose;
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Inflator - Base Class for keyword Inflators
+
+=head1 DESCRIPTION
+
+When L<DBIx::Class::Schema::PopulateMore::Command> executes, it uses a vistor object
+(see L<DBIx::Class::Schema::PopulateMore::Visitor> to descend the key values of the
+data hash that is used to put stuff into the given tables. If it finds a value
+that matches a particular regexp, that means the value needs to be inflated and
+it's passed to the inflating dispatcher, which finds the correct Inflator based
+on the given namespace.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 name
+
+returns the name of this inflator. Should be something you expect to be unique
+across all defined inflators. Defaults to something based on the namespace.
+
+=cut
+
+sub name
+{
+ my $class = ref shift @_;
+ my $package = __PACKAGE__;
+ my ($name) = ($class =~m/^$package\:\:(.+)$/);
+
+ return $name;
+}
+
+
+=head2 inflate($command, $string)
+
+This is called by L<DBIx::Class::Schema::PopulateMore::Command> dispatcher, when there
+is a match detected by the visitor.
+
+=cut
+
+sub inflate
+{
+ confess "You forgot to implement ->inflate";
+}
+
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Company.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Company.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Company.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,103 @@
+package #hide from pause
+ DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Company;
+
+use base 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Company - A Company Class
+
+=head1 DESCRIPTION
+
+Companies are entities people work for. A person can work for one or more
+companies. For the purposed of making this easy (for now) we will say that
+a company can exist without employees and that there is no logic preventing
+a person from working for more than one company at a time.
+
+=head1 PACKAGE METHODS
+
+This module defines the following package methods
+
+=head2 table
+
+Name of the Physical table in the database
+
+=cut
+
+__PACKAGE__
+ ->table('company');
+
+
+=head2 add_columns
+
+Add columns and meta information
+
+=head3 company_id
+
+Primary Key which is an auto generated autoinc
+
+=head3 name
+
+The company's name
+
+=cut
+
+__PACKAGE__
+ ->add_columns(
+ company_id => {
+ data_type=>'integer',
+ },
+ name => {
+ data_type=>'integer',
+ });
+
+
+=head2 primary_key
+
+Sets the Primary keys for this table
+
+=cut
+
+__PACKAGE__
+ ->set_primary_key(qw/company_id/);
+
+
+=head2 company_persons
+
+Each Company might have a resultset from the company_person table. This is a
+bridge table in a many-many type relationship
+
+=cut
+
+__PACKAGE__
+ ->has_many(
+ company_persons => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::CompanyPerson',
+ {'foreign.fk_company_id' => 'self.company_id'});
+
+
+=head2 employees
+
+A resultset of Persons via a resultset of connecting CompanyPersons
+
+=cut
+
+__PACKAGE__
+ ->many_to_many( employees => 'company_persons', 'employee' );
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/CompanyPerson.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/CompanyPerson.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/CompanyPerson.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,117 @@
+package #hide from pause
+ DBIx::Class::Schema::PopulateMore::Test::Schema::Result::CompanyPerson;
+
+use base 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::Result::CompanyPerson - Bridge between Company and Person
+
+=head1 DESCRIPTION
+
+Bridge table for many to many style relationship between Company and Person.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 PACKAGE METHODS
+
+This module defines the following package methods
+
+=head2 table
+
+Name of the Physical table in the database
+
+=cut
+
+__PACKAGE__
+ ->table('company_person');
+
+
+=head2 add_columns
+
+Add columns and meta information
+
+=head3 fk_person_id
+
+ID of the person with a companies
+
+=head3 fk_company_id
+
+ID of the company with persons
+
+=cut
+
+__PACKAGE__
+ ->add_columns(
+ fk_person_id => {
+ data_type=>'integer',
+ },
+ fk_company_id => {
+ data_type=>'integer',
+ },
+);
+
+
+=head2 primary_key
+
+Sets the Primary keys for this table
+
+=cut
+
+__PACKAGE__
+ ->set_primary_key(qw/fk_person_id fk_company_id/);
+
+
+=head2 employee
+
+The person that is employeed by a company
+
+=cut
+
+__PACKAGE__
+ ->belongs_to( employee => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Person', {
+ 'foreign.person_id' => 'self.fk_person_id' });
+
+
+=head2 company
+
+The company that employees the person
+
+=cut
+
+__PACKAGE__
+ ->belongs_to( company => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Company', {
+ 'foreign.company_id' => 'self.fk_company_id' });
+
+
+=head2 employment_history
+
+each instance of a company_person has a related employment history
+
+=cut
+
+__PACKAGE__
+ ->has_one (employment_history => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::EmploymentHistory', {
+ 'foreign.fk_company_id' => 'self.fk_company_id',
+ 'foreign.fk_person_id' => 'self.fk_person_id',
+ });
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/EmploymentHistory.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/EmploymentHistory.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/EmploymentHistory.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,100 @@
+package #hide from pause
+ DBIx::Class::Schema::PopulateMore::Test::Schema::Result::EmploymentHistory;
+
+use base 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::Result::EmploymentHistory - Information about a Persons as an Employee;
+
+=head1 DESCRIPTION
+
+Additional Information about a person when working for a company
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 PACKAGE METHODS
+
+This module defines the following package methods
+
+=head2 table
+
+Name of the Physical table in the database
+
+=cut
+
+__PACKAGE__
+ ->table('employment_history');
+
+
+=head2 add_columns
+
+Add columns and meta information
+
+=head3 fk_person_id, fk_company_id
+
+two fields making up a key to the CompanyPerson
+
+=head3 started
+
+The date we started working for the company
+
+=cut
+
+__PACKAGE__
+ ->add_columns(
+ employment_history_id => {
+ data_type=>'integer',
+ },
+ fk_person_id => {
+ data_type=>'integer',
+ },
+ fk_company_id => {
+ data_type=>'integer',
+ },
+ started => {
+ data_type=>'datetime',
+ default_value=>'date("now")',
+ });
+
+
+=head2 primary_key
+
+Sets the Primary keys for this table
+
+=cut
+
+__PACKAGE__
+ ->set_primary_key(qw/employment_history_id/);
+
+
+=head2 employment_history
+
+each instance of a company_person has a related employment history
+
+=cut
+
+__PACKAGE__
+ ->belongs_to (company_person => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::CompanyPerson', {
+ 'foreign.fk_company_id' => 'self.fk_company_id',
+ 'foreign.fk_person_id' => 'self.fk_person_id',
+ });
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/FriendList.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/FriendList.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/FriendList.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,104 @@
+package #hide from pause
+ DBIx::Class::Schema::PopulateMore::Test::Schema::Result::FriendList;
+
+use base 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::Result::FriendList - An example Friends Class;
+
+=head1 DESCRIPTION
+
+Probably not the best way to do a friend list relationship.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 PACKAGE METHODS
+
+This module defines the following package methods
+
+=head2 table
+
+Name of the Physical table in the database
+
+=cut
+
+__PACKAGE__
+ ->table('friend_list');
+
+
+=head2 add_columns
+
+Add columns and meta information
+
+=head3 fk_person_id
+
+ID of the person with friends
+
+=head3 fk_friend_id
+
+Who is the friend?
+
+=cut
+
+__PACKAGE__
+ ->add_columns(
+ fk_person_id => {
+ data_type=>'integer',
+ },
+ fk_friend_id => {
+ data_type=>'integer',
+ },
+);
+
+
+=head2 primary_key
+
+Sets the Primary keys for this table
+
+=cut
+
+__PACKAGE__
+ ->set_primary_key(qw/fk_person_id fk_friend_id/);
+
+
+=head2 befriender
+
+The person that 'owns' the friendship (list)
+
+=cut
+
+__PACKAGE__
+ ->belongs_to( befriender => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Person', {
+ 'foreign.person_id' => 'self.fk_person_id' });
+
+
+=head2 friendee
+
+The actual friend that befriender is listing
+
+=cut
+
+__PACKAGE__
+ ->belongs_to( friendee => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Person', {
+ 'foreign.person_id' => 'self.fk_friend_id' });
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Gender.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Gender.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Gender.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,102 @@
+package #hide from pause
+ DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Gender;
+
+use base 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Gender - A Gender Class
+
+=head1 DESCRIPTION
+
+Tests for this type of FK relationship
+
+=head1 PACKAGE METHODS
+
+This module defines the following package methods
+
+=head2 table
+
+Name of the Physical table in the database
+
+=cut
+
+__PACKAGE__
+ ->table('gender');
+
+
+=head2 add_columns
+
+Add columns and meta information
+
+=head3 gender_id
+
+Primary Key which is an auto generated UUID
+
+=head3 label
+
+Text label of the gender (ie, 'male', 'female', 'transgender', etc.).
+
+=cut
+
+__PACKAGE__
+ ->add_columns(
+ gender_id => {
+ data_type=>'integer',
+ },
+ label => {
+ data_type=>'varchar',
+ size=>12,
+ },
+ );
+
+
+=head2 primary_key
+
+Sets the Primary keys for this table
+
+=cut
+
+__PACKAGE__
+ ->set_primary_key(qw/gender_id/);
+
+
+=head2
+
+Marks the unique columns
+
+=cut
+
+__PACKAGE__
+ ->add_unique_constraint('gender_label_unique' => [ qw/label/ ]);
+
+
+=head2 people
+
+A resultset of people with this gender
+
+=cut
+
+__PACKAGE__
+ ->has_many(
+ people => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Person',
+ {'foreign.fk_gender_id' => 'self.gender_id'}
+ );
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Person.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Person.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result/Person.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,178 @@
+package #hide from pause
+ DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Person;
+
+use base 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Person - A Person Class
+
+=head1 DESCRIPTION
+
+Tests for this type of FK relationship
+
+=head1 PACKAGE METHODS
+
+This module defines the following package methods
+
+=head2 table
+
+Name of the Physical table in the database
+
+=cut
+
+__PACKAGE__
+ ->table('person');
+
+
+=head2 add_columns
+
+Add columns and meta information
+
+=head3 person_id
+
+Primary Key which is an auto generated autoinc
+
+=head3 fk_gender_id
+
+foreign key to the Gender table
+
+=head3 name
+
+Just an ordinary name
+
+=head3 age
+
+The person's age
+
+=head3 created
+
+When the person was added to the database
+
+=cut
+
+__PACKAGE__
+ ->add_columns(
+ person_id => {
+ data_type=>'integer',
+ },
+ fk_gender_id => {
+ data_type=>'integer',
+ },
+ name => {
+ data_type=>'varchar',
+ size=>32,
+ },
+ age => {
+ data_type=>'integer',
+ default_value=>25,
+ },
+ created => {
+ data_type=>'datetime',
+ default_value=>'date("now")',
+ });
+
+
+=head2 primary_key
+
+Sets the Primary keys for this table
+
+=cut
+
+__PACKAGE__
+ ->set_primary_key(qw/person_id/);
+
+
+=head2 friendlist
+
+Each Person might have a resultset of friendlist
+
+=cut
+
+__PACKAGE__
+ ->has_many(
+ friendlist => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::FriendList',
+ {'foreign.fk_person_id' => 'self.person_id'});
+
+
+=head2 gender
+
+This person's gender
+
+=cut
+
+__PACKAGE__
+ ->belongs_to( gender => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Gender', {
+ 'foreign.gender_id' => 'self.fk_gender_id' });
+
+
+=head2 fanlist
+
+A resultset of the people listing me as a friend (if any)
+
+=cut
+
+__PACKAGE__
+ ->belongs_to( fanlist => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::FriendList', {
+ 'foreign.fk_friend_id' => 'self.person_id' });
+
+
+=head2 friends
+
+A resultset of Persons who are in my FriendList
+
+=cut
+
+__PACKAGE__
+ ->many_to_many( friends => 'friendlist', 'friendee' );
+
+
+=head2 fans
+
+A resultset of people that have me in their friendlist
+
+=cut
+
+__PACKAGE__
+ ->many_to_many( fans => 'fanlist', 'befriender' );
+
+
+=head2 companies_person
+
+Each Person might have a resultset from the company_person table. This is a
+bridge table in a many-many type relationship
+
+=cut
+
+__PACKAGE__
+ ->has_many(
+ companies_person => 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::CompanyPerson',
+ {'foreign.fk_person_id' => 'self.person_id'});
+
+
+=head2 companies
+
+A resultset of Companies via a resultset of connecting CompanyPersons
+
+=cut
+
+__PACKAGE__
+ ->many_to_many( companies => 'companies_person', 'company' );
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/Result.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,47 @@
+package # hide from PAUSE
+ DBIx::Class::Schema::PopulateMore::Test::Schema::Result;
+
+use base 'DBIx::Class';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::Result - A base result class
+
+=head1 DESCRIPTION
+
+Defines the base case for loading DBIC Schemas. We add in some additional
+helpful functions for administering you schemas.
+
+=head1 PACKAGE METHODS
+
+The following is a list of package methods declared with this class.
+
+=head2 load_components
+
+Components to preload.
+
+=cut
+
+__PACKAGE__->load_components(qw/
+ PK::Auto
+ InflateColumn::DateTime
+ Core
+/);
+
+
+=head1 METHODS
+
+This module declares the following methods.
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
\ No newline at end of file
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet/Person.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet/Person.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet/Person.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,44 @@
+package #hide from pause
+ DBIx::Class::Schema::PopulateMore::Test::Schema::ResultSet::Person;
+
+use base 'DBIx::Class::Schema::PopulateMore::Test::Schema::ResultSet';
+
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::ResultSet::Person - Person Resultset
+
+=head1 DESCRIPTION
+
+Resultset Methods for the Person Source
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 older_than($int)
+
+Only people over a given age
+
+=cut
+
+sub older_than
+{
+ my ($self, $age) = @_;
+
+ return $self->search({age=>{'>'=>$age}});
+}
+
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema/ResultSet.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,39 @@
+package # hide from PAUSE
+ DBIx::Class::Schema::PopulateMore::Test::Schema::ResultSet;
+
+use base 'DBIx::Class::ResultSet';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema::ResultSet - A base ResultSet Class
+
+=head1 DESCRIPTION
+
+All ResultSet classes will inherit from this. This provides some base function
+for all your resultsets and it is also the default resultset if you don't
+bother to declare a custom resultset in the resultset namespace
+
+=head1 PACKAGE METHODS
+
+The following is a list of package methods declared with this class.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This module declares the following methods
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
\ No newline at end of file
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Test/Schema.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,113 @@
+package # hide from PAUSE
+ DBIx::Class::Schema::PopulateMore::Test::Schema;
+
+use File::Temp qw(tempfile);
+use base 'DBIx::Class::Schema';
+
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Test::Schema; Test Schema
+
+=head1 DESCRIPTION
+
+Defines the base case for loading DBIC Schemas. This schema currently defines
+three sources, Person, FriendList, and Gender
+
+=head1 PACKAGE METHODS
+
+The following is a list of package methods declared with this class.
+
+=head2 load_components
+
+Load the components
+
+=cut
+
+__PACKAGE__->load_components(qw/
+ +DBIx::Class::Schema::PopulateMore
+/);
+
+
+=head2 load_namespaces
+
+Automatically load the classes and resultsets from their default namespaces.
+
+=cut
+
+__PACKAGE__->load_namespaces(
+ default_resultset_class => 'ResultSet',
+);
+
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This module declares the following methods
+
+=head2 connect_and_setup
+
+Creates a schema, deploys a database and sets the testing data. By default we
+use a L<DBD::SQLite> database created
+
+=cut
+
+sub connect_and_setup {
+ my $class = shift @_;
+
+ my ($dsn, $user, $pass) = (
+ $ENV{DBIC_POPULATE_DSN} || $class->default_dsn,
+ $ENV{DBIC_POPULATE_USER} || '',
+ $ENV{DBIC_POPULATE_PASS} || '',
+ );
+
+ return $class
+ ->connect($dsn, $user, $pass, { AutoCommit => 1 })
+ ->setup;
+}
+
+
+=head2 default_dsn
+
+returns a dsn string, suitable for passing to L<DBD::SQLite>, creating the
+database as a temporary file.
+
+=cut
+
+sub default_dsn
+{
+ my $class = shift @_;
+ my ($fh, $filename) = tempfile(UNLINK=>1);
+ return "dbi:SQLite:${filename}";
+}
+
+
+=head2 setup
+
+deploy a database and populate it with the initial data
+
+=cut
+
+sub setup {
+ my $self = shift @_;
+ $self->deploy();
+ return $self;
+}
+
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Visitor.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Visitor.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore/Visitor.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,140 @@
+package DBIx::Class::Schema::PopulateMore::Visitor;
+
+use Moose;
+extends 'Data::Visitor', 'Moose::Object';
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore::Visitor - Visitor for the Populate Data
+
+=head1 SYNOPSIS
+
+ ##Example Usage
+
+See Tests for more example usage.
+
+=head1 DESCRIPTION
+
+When populating a table, sometimes we need to inflate values that we won't
+know of in advance. For example we might have a column that is FK to another
+column in another table. We want to make it easy to 'tag' a value as something
+other than a real value to be inserted into the table.
+
+Right now we only have one substitution to do, which is the FK one mentioned
+above, but we might eventually create other substitution types so we've broken
+this out to make it neat and easy to do so.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head2 update_callback
+
+The coderef to be execute should the match condition succeed
+
+=cut
+
+has 'update_callback' => (
+ is=>'rw',
+ required=>1,
+ lazy=>1,
+ isa=>'CodeRef',
+ default=> sub {
+ return sub {
+ return shift;
+ };
+ },
+);
+
+=head2 match_condition
+
+How we know the value is really something to inflate or perform a substitution
+on. This get's the namespace of the substitution plugin and it's other data.
+
+The default behavior (where there is no substitution namespace, is to do the
+inflate to resultset. This is the most common usecase.
+
+=cut
+
+has 'match_condition' => (
+ is=>'ro',
+ required=>1,
+ isa=>'RegexpRef'
+);
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 callback
+
+Given a coderef, sets the current callback and returns self so that we can chain
+
+=cut
+
+sub callback
+{
+ my $self = shift @_;
+ $self->update_callback(shift @_);
+ return $self;
+}
+
+
+=head2 visit_value
+
+Overload from the base case L<Data::Visitor> Here is where we make the choice
+as to if this value needs to be inflated via a plugin
+
+=cut
+
+sub visit_value
+{
+ my ($self, $data) = @_;
+
+ if(my $item = $self->match_or_not($data))
+ {
+ return $self->update_callback->($item);
+ }
+
+ return $data;
+}
+
+
+=head2 match_or_not
+
+We break this out to handle the uglyness surrounding dealing with undef values
+and also to make it easier on subclassers.
+
+=cut
+
+sub match_or_not
+{
+ my ($self, $data) = @_;
+ my $match_condition = $self->match_condition;
+
+ if( !defined $data )
+ {
+ return;
+ }
+ elsif(my ($item) = ($data=~m/$match_condition/))
+ {
+ return $item;
+ }
+
+ return;
+}
+
+
+=head1 AUTHOR
+
+Please see L<DBIx::Class::Schema::PopulateMore> For authorship information
+
+=head1 LICENSE
+
+Please see L<DBIx::Class::Schema::PopulateMore> For licensing terms.
+
+=cut
+
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore.pm
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore.pm (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/lib/DBIx/Class/Schema/PopulateMore.pm 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,269 @@
+package DBIx::Class::Schema::PopulateMore;
+
+use warnings;
+use strict;
+
+use DBIx::Class::Schema::PopulateMore::Command;
+
+=head1 NAME
+
+DBIx::Class::Schema::PopulateMore - An enhanced populate method
+
+=head1 VERSION
+
+Version 0.04
+
+=cut
+
+our $VERSION = '0.04';
+
+=head1 SYNOPSIS
+
+The following is example usage for this component.
+
+ package Myapp::Schema;
+ use base qw/DBIx::Class::Schema/;
+
+ __PACKAGE__->load_components(qw/+DBIx::Class::Schema::PopulateMore/);
+ __PACKAGE__->load_namespaces();
+
+ ## All the rest of your setup
+
+Then assuming you have ResultSources of Gender, Person and FriendList:
+
+ my $setup_rows = [
+
+ {Gender => {
+ fields => 'label',
+ data => {
+ male => 'male',
+ female => 'female',
+ }}},
+
+ {Person => {
+ fields => ['name', 'age', 'gender'],
+ data => {
+ john => ['john', 38, "!Index:Gender.male"],
+ jane => ['jane', 40, '!Index:Gender.female'],
+ }}},
+
+ {FriendList => {
+ fields => ['person', 'friend', 'created_date'],
+ data => {
+ john_jane => [
+ '!Index:Person.john',
+ '!Index:Person.jane'
+ '!Date: March 30, 1996',
+ ],
+ }}},
+ ];
+
+ $schema->populate_more($setup_rows);
+
+Please see the test cases for more detailed examples.
+
+=head1 DESCRIPTION
+
+This is a L<DBIx::Class::Schema> component that prodives an enhanced version
+of the builtin method DBIx::Class::Schema->populate". What it does is make it
+easier when you are doing a first time setup and need to insert a bunch of
+rows, like the first time you deploy a new database, or after you update it.
+
+It's not as full featured as L<DBIx::Class::Fixtures> but is targeted more
+directly at making it easier to just take a prewritten perl structure --or one
+loaded from a configuration file-- and setup your database.
+
+Most of us using L<DBIx::CLass> have written a version of this at one time or
+another. What is special to this component is the fact that unlike the normal
+populate method you can insert to multiple result_sources in one go. While
+doing this, we index the created rows so as to make it easy to reference them
+in relationships. I did this because I think it's very ugly to have to type in
+all the primary keys by hand, particularly if your PK is multi column, or is
+using some lengthy format such as uuid. Also, we can embed expansion commands
+in the row values to do inflation for us. For example, any value starting with
+"!Index:" will substitute it's value for that of the relating fields in the
+named row.
+
+This distribution supplies three expansion commands:
+
+=over 4
+
+=item Index
+
+Use for creating relationships. This is a string in the form of "Source.Label"
+where the Source is the name of the result source that you are creating rows in
+and Label is a key name from from key part of the data hash.
+
+=item Env
+
+Get's it's value from %ENV. Typically this will be setup in your shell or at
+application runtime.
+
+=item Date
+
+converts it's value to a L<DateTime> object. Will use a various methods to try
+and coerce a string, like "today", or "January 6, 1974". Makes it easier to
+insert dates into your database without knowing or caring about the expected
+format. For this to work correctly, you need to use the class component
+L<DBIx::Class::InflateColumn::DateTime> and mark your column data type as
+'datetime' or similar.
+
+It's trivial to write more; please feel free to post me your contributions.
+
+=back
+
+Please note the when inserting rows, we are actually calling "create_or_update"
+on each data item, so this will not be as fast as using $schema->bulk_insert.
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 populate_more ($ArrayRef)
+
+Given an arrayref formatted as in the L</SYNOPSIS> example, populate a rows in
+a database. Confesses on errors.
+
+The $ArrayRef contains one or more elements in the following pattern;
+
+ {Source => {
+ fields => [qw/ column belongs_to has_many/],
+ data => {
+ key_1 => ['value', $row, \@rows ],
+ }}}
+
+'Source' is the name of a DBIC source (as in $schema->resultset($Source)->...)
+while fields is an arrayref of either columns or named relationships and data
+is a hashref of rows that you will insert into the Source.
+
+See L</SYNOPSIS> for more.
+
+=cut
+
+sub populate_more
+{
+ my $self = shift @_;
+
+ if( my $arg = shift @_)
+ {
+ if( ref $arg eq 'ARRAY')
+ {
+ DBIx::Class::Schema::PopulateMore::Command
+ ->new(
+ definitions=>$arg,
+ schema=>$self )
+ ->execute;
+ }
+ else
+ {
+ $self->throw_exception("Supplied Argument is not an ArrayRef");
+ }
+ }
+ else
+ {
+ $self->throw_exception("Argument is required.");
+ }
+}
+
+
+=head1 ARGUMENT NOTES
+
+The perl structed used in L</populate_more> was designed to be reasonable
+friendly to type in most of the popular configuration formats. For example,
+the above serialized to YAML would look like:
+
+ - Gender:
+ fields: label
+ data:
+ female: female
+ male: male
+ - Person:
+ fields:
+ - name
+ - age
+ - gender
+ data:
+ jane:
+ - jane
+ - 40
+ - '!Index:Gender.female'
+ john:
+ - john
+ - 38
+ - !Index:Gender.male'
+ - FriendList:
+ fields:
+ - person
+ - friend
+ - created_date
+ data:
+ john_jane:
+ - '!Index:Person.john'
+ - '!Index:Person.jane'
+ - '!Date: March 30, 1996'
+
+Since the argument is an arrayref, the same base result source can appear as
+many times as you like. This could be useful when a second insert to a given
+source requires completion of other inserts. The insert order follows the
+index of the arrayref you create.
+
+=head1 AUTHOR
+
+John Napiorkowski, C<< <jjn1056 at yahoo.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to:
+
+ C<bug-DBIx-Class-Schema-PopulateMore at rt.cpan.org>
+
+or through the web interface at:
+
+ L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBIx-Class-Schema-PopulateMore>
+
+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 DBIx::Class::Schema::PopulateMore
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-Schema-PopulateMore>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/DBIx-Class-Schema-PopulateMore>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/DBIx-Class-Schema-PopulateMore>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/DBIx-Class-Schema-PopulateMore>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+Thanks to the entire L<DBIx::Class> team for providing such a useful and
+extensible ORM. Also thanks to the L<Moose> developers for making it fun and
+easy to write beautiful Perl.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
Added: DBIx-Class-Schema-PopulateMore/truck/t/00-load.t
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/t/00-load.t (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/t/00-load.t 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,24 @@
+use warnings;
+use strict;
+
+use DBIx::Class::Schema::PopulateMore;
+use Test::More tests => 16;
+
+diag( "Testing DBIx::Class::Schema::PopulateMore $DBIx::Class::Schema::PopulateMore::VERSION, Perl $], $^X" );
+use_ok( 'DBIx::Class::Schema::PopulateMore' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Command' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Inflator' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Visitor' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Inflator::Index' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Inflator::Date' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Inflator::Env' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema::ResultSet' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Gender' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Person' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::FriendList' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema::ResultSet::Person' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::Company' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema::Result::CompanyPerson' );
+use_ok( 'DBIx::Class::Schema::PopulateMore::Test::Schema' );
+
Added: DBIx-Class-Schema-PopulateMore/truck/t/01-schema.t
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/t/01-schema.t (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/t/01-schema.t 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,185 @@
+use warnings;
+use strict;
+
+use Test::More tests => 31;
+use DBIx::Class::Schema::PopulateMore::Test::Schema;
+
+ok my $schema = DBIx::Class::Schema::PopulateMore::Test::Schema->connect_and_setup
+=> 'Got a schema';
+
+diag "Created Datebase with @{$schema->storage->connect_info}[0]";
+
+ok $schema->can('populate_more')
+=> 'schema has required method';
+
+ok my @sources = sort($schema->sources)
+=> 'got some sources';
+
+is_deeply \@sources, [qw/
+ Company CompanyPerson
+ EmploymentHistory FriendList
+ Gender Person/]
+=> 'Got expected sources';
+
+ok my $populate = [
+
+ {Gender => {
+ fields => 'label',
+ data => {
+ male => 'male',
+ female => 'female',
+ }}},
+
+ {Person => {
+ fields => ['name', 'age', 'gender'],
+ data => {
+ john => ['john', 38, "!Index:Gender.male"],
+ jane => ['jane', 40, '!Index:Gender.female'],
+ }}},
+
+ {Company => {
+ fields => ['name', 'company_persons'],
+ data => {
+ bms => ['bristol meyers squibb', [
+ {employee=>'!Index:Person.john'},
+ {employee=>'!Index:Person.jane'},
+ ]],
+ takkle => ['takkle', [
+ {
+ employee => '!Index:Person.john',
+ employment_history => {
+ started=>'!Date:january 1, 2000',
+ }
+ },
+ ]],
+ }}},
+
+ {FriendList => {
+ fields => ['befriender', 'friendee'],
+ data => {
+ john_jane => ['!Index:Person.john', '!Index:Person.jane'],
+ }}},
+
+ {Person => {
+ fields => ['name', 'age', 'gender', 'friendlist'],
+ data => {
+ mike => ['mike', 25, "!Index:Gender.male", [
+ {friendee=>'!Index:Person.john'},
+ {friendee=>'!Index:Person.jane'},
+ ]],
+ }}},
+
+ {CompanyPerson => {
+ fields => ['employee', 'company', 'employment_history'],
+ data => {
+ mike_at_takkle => [
+ '!Index:Person.mike',
+ '!Index:Company.takkle',
+ {started=>'!Date:yesterday'}
+ ],
+ }}},
+
+] => 'Create structure to populate_more with';
+
+ok my %index = $schema->populate_more($populate)
+=> 'Successful populated.';
+
+## Find some Genders
+
+GENDER: {
+
+ ok my $gender_rs = $schema->resultset('Gender')
+ => 'Got a resultset of genders';
+
+ is $gender_rs->count, 2
+ => 'Got expected number of genders';
+
+ ok $gender_rs->find({label=>'male'})
+ => 'Found male';
+
+ ok $gender_rs->find({label=>'female'})
+ => 'Found female';
+
+ ok ! $gender_rs->find({label=>'transgender'})
+ => 'Correctly didn not find transgender';
+
+}
+
+
+## Find some People
+
+PERSON: {
+
+ ok my $person_rs = $schema->resultset('Person')
+ => 'Got a person resultset';
+
+ is $person_rs->count, 3
+ => 'Got expected number of person_rs';
+
+ ok my $john = $person_rs->search({name=>'john'})->first
+ => 'Found John';
+
+ is $john->age, 38
+ => 'Got correct age for john';
+
+ ok my $jane = $person_rs->search({name=>'jane'})->first
+ => 'Found John';
+
+ is $jane->age, 40
+ => 'Got correct age for jane';
+
+}
+
+## Find some companies
+
+COMPANY: {
+
+ ok my $company_rs = $schema->resultset('Company')
+ => 'Got a person resultset';
+
+ is $company_rs->count, 2
+ => 'Got expected number of person_rs';
+
+ ok my $takkle = $company_rs->search({name=>'takkle'})->first
+ => 'Found takkle';
+
+ ok my $company_persons_rs = $takkle->company_persons
+ => 'got company_persons';
+
+ is $company_persons_rs->count, 2
+ => 'got right number of $company_persons_rs';
+
+ ok my $employees_rs = $takkle->employees
+ => 'got some employees';
+
+ ok my $john = $employees_rs->search({name=>'john'})->first
+ => 'found john';
+
+ is $john->age, 38
+ => 'got correct age';
+
+ ok my $bms = $company_rs->search({name=>'bristol meyers squibb'})->first
+ => 'Found bristol meyers squibb';
+
+ is $bms->employees->count, 2
+ => 'got correct count for bms employees';
+
+}
+
+## Test Friendlist
+
+FRIENDLIST: {
+
+ ok my $friendlist_rs = $schema->resultset('FriendList')
+ => 'Got a friendlist resultset';
+
+ is $friendlist_rs->count, 3
+ => 'Got expected number of friendlist_rs';
+
+ ok my $mike = $schema->resultset('Person')->search({name=>'mike'})->first
+ => 'found mike';
+
+ is $mike->friends, 2
+ => 'got correct number of friends for mike';
+
+}
Added: DBIx-Class-Schema-PopulateMore/truck/t/02-yaml_example.t
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/t/02-yaml_example.t (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/t/02-yaml_example.t 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,205 @@
+use warnings;
+use strict;
+
+use Test::More tests => 31;
+use DBIx::Class::Schema::PopulateMore::Test::Schema;
+use YAML::Tiny;
+
+## This is just a quick example to show what this might look like if you
+## loaded from an external file, like yaml. It's evil cut 'n paste from
+## the standard test.
+
+ok my $schema = DBIx::Class::Schema::PopulateMore::Test::Schema->connect_and_setup
+=> 'Got a schema';
+
+diag "Created Datebase with @{$schema->storage->connect_info}[0]";
+
+ok $schema->can('populate_more')
+=> 'schema has required method';
+
+ok my @sources = sort($schema->sources)
+=> 'got some sources';
+
+is_deeply \@sources, [qw/
+ Company CompanyPerson
+ EmploymentHistory FriendList
+ Gender Person/]
+=> 'Got expected sources';
+
+my $string = join('', <DATA>);
+
+ok my $yaml = YAML::Tiny->read_string( $string )
+=> 'loaded yaml config';
+
+ok my %index = $schema->populate_more($yaml->[0])
+=> 'Successful populated.';
+
+## Find some Genders
+
+GENDER: {
+
+ ok my $gender_rs = $schema->resultset('Gender')
+ => 'Got a resultset of genders';
+
+ is $gender_rs->count, 2
+ => 'Got expected number of genders';
+
+ ok $gender_rs->find({label=>'male'})
+ => 'Found male';
+
+ ok $gender_rs->find({label=>'female'})
+ => 'Found female';
+
+ ok ! $gender_rs->find({label=>'transgender'})
+ => 'Correctly didn not find transgender';
+
+}
+
+
+## Find some People
+
+PERSON: {
+
+ ok my $person_rs = $schema->resultset('Person')
+ => 'Got a person resultset';
+
+ is $person_rs->count, 3
+ => 'Got expected number of person_rs';
+
+ ok my $john = $person_rs->search({name=>'john'})->first
+ => 'Found John';
+
+ is $john->age, 38
+ => 'Got correct age for john';
+
+ ok my $jane = $person_rs->search({name=>'jane'})->first
+ => 'Found John';
+
+ is $jane->age, 40
+ => 'Got correct age for jane';
+
+}
+
+## Find some companies
+
+COMPANY: {
+
+ ok my $company_rs = $schema->resultset('Company')
+ => 'Got a person resultset';
+
+ is $company_rs->count, 2
+ => 'Got expected number of person_rs';
+
+ ok my $takkle = $company_rs->search({name=>'takkle'})->first
+ => 'Found takkle';
+
+ ok my $company_persons_rs = $takkle->company_persons
+ => 'got company_persons';
+
+ is $company_persons_rs->count, 2
+ => 'got right number of $company_persons_rs';
+
+ ok my $employees_rs = $takkle->employees
+ => 'got some employees';
+
+ ok my $john1 = $employees_rs->search({name=>'john'})->first
+ => 'found john';
+
+ is $john1->age, 38
+ => 'got correct age';
+
+ ok my $bms = $company_rs->search({name=>'bristol meyers squibb'})->first
+ => 'Found bristol meyers squibb';
+
+ is $bms->employees->count, 2
+ => 'got correct count for bms employees';
+
+}
+
+## Test Friendlist
+
+FRIENDLIST: {
+
+ ok my $friendlist_rs = $schema->resultset('FriendList')
+ => 'Got a friendlist resultset';
+
+ is $friendlist_rs->count, 3
+ => 'Got expected number of friendlist_rs';
+
+ ok my $mike = $schema->resultset('Person')->search({name=>'mike'})->first
+ => 'found mike';
+
+ is $mike->friends, 2
+ => 'got correct number of friends for mike';
+
+}
+__DATA__
+---
+- Gender:
+ data:
+ female: female
+ male: male
+ fields: label
+- Person:
+ data:
+ jane:
+ - jane
+ - 40
+ - '!Index:Gender.female'
+ john:
+ - john
+ - 38
+ - '!Index:Gender.male'
+ fields:
+ - name
+ - age
+ - gender
+- Company:
+ data:
+ bms:
+ - bristol meyers squibb
+ -
+ - employee: '!Index:Person.john'
+ - employee: '!Index:Person.jane'
+ takkle:
+ - takkle
+ -
+ - employee: '!Index:Person.john'
+ employment_history:
+ started: '!Date:january 1, 2000'
+ fields:
+ - name
+ - company_persons
+- FriendList:
+ data:
+ john_jane:
+ - '!Index:Person.john'
+ - '!Index:Person.jane'
+ fields:
+ - befriender
+ - friendee
+- Person:
+ data:
+ mike:
+ - mike
+ - 25
+ - '!Index:Gender.male'
+ -
+ - friendee: '!Index:Person.john'
+ - friendee: '!Index:Person.jane'
+ fields:
+ - name
+ - age
+ - gender
+ - friendlist
+- CompanyPerson:
+ data:
+ mike_at_takkle:
+ - '!Index:Person.mike'
+ - '!Index:Company.takkle'
+ - started: '!Date:yesterday'
+ fields:
+ - employee
+ - company
+ - employment_history
+
Added: DBIx-Class-Schema-PopulateMore/truck/t/author/newlines.t
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/t/author/newlines.t (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/t/author/newlines.t 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+BEGIN {
+
+ use Test::More;
+ use File::Find;
+
+ # Are we an author test?
+ plan skip_all => 'Skipping author tests'
+ unless $ENV{RUN_AUTHOR_TESTS};
+
+}
+
+my @files;
+
+ find({
+ wanted => \&process,
+ follow => 0
+ }, '.');
+
+sub process
+{
+ my $file = $_;
+
+ return if $File::Find::dir =~m/\.svn/;
+ return if $File::Find::dir =~m/archive/;
+
+ push @files, $File::Find::name
+ if $file =~m/\.yml$|\.pm$|\.pod$|\.tt$|\.txt$|\.js$|\.css$|\.sql$|\.html$/;
+}
+
+my $CR = "\015"; # Apple II family, Mac OS thru version 9
+my $CRLF = "\015\012"; # CP/M, MP/M, DOS, Microsoft Windows
+my $FF = "\014"; # printer form feed
+my $LF = "\012"; # Unix, Linux, Xenix, Mac OS X, BeOS, Amiga
+
+my $test_builder = Test::More->builder;
+
+if( $#files )
+{
+ $test_builder->plan(tests => ($#files+1)*2);
+
+ foreach my $file (@files)
+ {
+ ## Get a good filehandle
+ open( my $fh, '<', $file)
+ or fail "Can't open $file, can't finish testing";
+
+ ## Only need to test the first line.
+ my ($first, $second) = <$fh>;
+
+ ## Don't need this anymore
+ close($fh);
+
+ SKIP: {
+
+ skip "$file is Empty!", 2 unless $first;
+
+ ## Are we DOS or MACOS/APPLE?
+ ok $first!~m/$CRLF$|$CR$|$FF$/, "$file isn't in a forbidden format";
+
+ ## If there is more than one line, we HAVE to be UNIX
+
+ SKIP: {
+
+ skip "$file only has a single line", 1 unless $second;
+ ok $first=~m/$LF$/, "$file Is unix linefeed";
+ }
+ }
+ }
+}
+else
+{
+ $test_builder->plan(skip_all => 'No Text Files Found! (This is probably BIG Trouble...');
+}
+
+
+1;
\ No newline at end of file
Added: DBIx-Class-Schema-PopulateMore/truck/t/author/pod-coverage.t
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/t/author/pod-coverage.t (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/t/author/pod-coverage.t 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use Test::More;
+
+# Are we an author test?
+plan skip_all => 'Skipping author tests'
+ unless $ENV{RUN_AUTHOR_TESTS};
+
+# 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: DBIx-Class-Schema-PopulateMore/truck/t/author/pod.t
===================================================================
--- DBIx-Class-Schema-PopulateMore/truck/t/author/pod.t (rev 0)
+++ DBIx-Class-Schema-PopulateMore/truck/t/author/pod.t 2009-01-13 02:46:28 UTC (rev 5306)
@@ -0,0 +1,16 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Are we an author test?
+plan skip_all => 'Skipping author tests'
+ unless $ENV{RUN_AUTHOR_TESTS};
+
+# 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 Bast-commits
mailing list