Complex many to many example

The following program should illustrate some of the points in the ComplexManyToMany cookbook example.

Bugfixes are welcome!

# # # # # # # use 5.005_62;   # for using our use strict; use warnings; use diagnostics; our ($VERSION) = sprintf '%d.%03d', q$Revision: 1.15 $ =~ /(\d+)/g; our ($DEBUG)  = 1; our ($DBFILE) = "./storyimage.sqlite"; $ENV{PATH} = "/usr/bin:/bin:/usr/local/bin"; delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # # package MyDB; use base qw( Class::DBI::SQLite ); use Data::Dumper; $Data::Dumper::Indent = 1; use Test::More tests => 15; our (%SQL_CREATE); __PACKAGE__->set_db( 'Main', "dbi:SQLite:dbname=$DBFILE", ,  ); # # package Story; use base qw( MyDB ); $MyDB::SQL_CREATE{stories} = " CREATE TABLE stories (    story_id integer primary key,     title varchar,     author varchar,     content text   ); "; Story->table("stories"); Story->columns( All => qw(story_id title author content) ); Story->has_many( images => StoryImage => { order_by => 'priority' } ); # # package StoryImage; use base qw( MyDB ); $MyDB::SQL_CREATE{story_images} = " CREATE TABLE story_images (    id integer primary key,     story integer,     image integer,     priority integer,     unique (story, image)   ); "; StoryImage->table("story_images"); StoryImage->columns( All => qw(id story image priority) ); StoryImage->columns( TEMP => qw(image_id file_name caption) ); StoryImage->has_a( image => 'Image' ); StoryImage->has_a( story => 'Story' ); StoryImage->add_trigger( after_update => sub { shift->image->update } ); StoryImage->add_trigger(    before_create => sub {         my ($data) = @_;         my %image_data;         foreach my $column (qw(image_id caption file_name)) {             $image_data{$column} = delete( $data->{$column} )               if exists $data->{$column};         }         $data->{image} = Image->find_or_create( \%image_data );     } ); sub file_name { shift->image->file_name(@_) } sub caption  { shift->image->caption(@_) } sub stories  { shift->image->stories(@_) } # # package Image; use base qw( MyDB ); $MyDB::SQL_CREATE{images} = " CREATE TABLE images (    image_id integer primary key,     file_name varchar,     caption varchar   ); "; Image->table("images"); Image->columns( All => qw(image_id file_name caption) ); Image->has_many( stories => [ StoryImage => 'story' ], "image" ); # # package MyDB; if ( __PACKAGE__->can('db_Main') ) { if ( !-f $DBFILE ) { diag "DEBUG: Setting up DB '$DBFILE' (did not find old DB).\n" if $DEBUG; __PACKAGE__->db_Main->do($_) for values %MyDB::SQL_CREATE; }    else { diag "DEBUG: Found existing DB '$DBFILE'.\n" if $DEBUG; } } else { die "ERROR: db_Main method not available in " . __PACKAGE__ . ". Setup failed.\n"; } my $story = Story->find_or_create(    {         title   => "A Modest Proposal",         author  => "Jonathan Swift",         content =>           "It is a melancholy object to those who walk through this...",     } ); isa_ok( $story, "Story", q("A Modest Proposal") ); my $other_story = Story->find_or_create(    {         title   => "The Devil's Dictionary",         author  => "Ambrose Bierce",         content =>           "air, n.: A nutritious substance supplied by a bountiful Providence"           . " for the fattening of the poor."     } ); isa_ok( $other_story, "Story", q("The Devil's Dictionary") ); my $first_storyimage = $story->add_to_images(    {         file_name => "pretty.jpg",         caption   => "A pretty angel.",         priority  => 100,                 # low     } ); isa_ok( $first_storyimage, "StoryImage", q(first story's image 'pretty.jpg') ); my $other_storyimage = $other_story->add_to_images(    {         image_id => $first_storyimage->image,         priority => 200,                        # really, really low     } ); isa_ok( $other_storyimage, "StoryImage", q(other story's image 'pretty.jpg') ); # # my $all_stories = Story->retrieve_all; is( $all_stories->count, 2, "Number of stories" ) or $DEBUG and diag Dumper $all_stories; my $first_story = $all_stories->first; isa_ok( $first_story, "Story", "First story" ); my $first_story_images = $first_story->images; is( $first_story_images->count, 1, "Number of images in first story" ) or $DEBUG and diag Dumper $first_story_images; my $first_story_first_image = $first_story_images->first; isa_ok( $first_story_first_image, "StoryImage", "First story's first image" ); is( $first_story_first_image->file_name,    "pretty.jpg", "First story image file_name" ); is_deeply(    [ $first_story_first_image->stories ],     [ 1, 2 ],     "Story id's where first story image is used"   ) or $DEBUG and diag Dumper [ $first_story_first_image->stories ]; is_deeply(    [ map { $_->title } $first_story_first_image->stories ],     [ "A Modest Proposal", "The Devil's Dictionary" ],     "Story titles where first story image is used"   ) or $DEBUG and diag Dumper [ map { $_->title } $first_story_first_image->stories ]; is(    $first_story_first_image->caption,     "A pretty angel.",     "First storyimage caption (before change)" ); $first_story_first_image->caption("A pretty devil."); $first_story_first_image->image->update;   # Boo! Hiss! is(    $first_story_first_image->caption,     "A pretty devil.",     "First storyimage caption (after change)" ); # # my $all_images = Image->retrieve_all; is( $all_images->count, 1, "Total number of images" ); my $first_image = $all_images->first; isa_ok( $first_image, "Image", "First found image" ); # # END { if ( !defined $ENV{STORYIMAGE_DONT_DELETE_DB} ) { diag "DEBUG: Pulling down DB '$DBFILE' (set \$ENV{STORYIMAGE_DONT_DELETE_DB} to keep DB.)" if $DEBUG; unlink $DBFILE || die "Cannot unlink dbfile '$DBFILE': $!\n"; }    else { diag "DEBUG: Will not delete DB file '$DBFILE' (unset \$ENV{STORYIMAGE_DONT_DELETE_DB} to delete the DB at end of test run.) DEBUG: run 'dbish dbi:SQLite:dbname=$DBFILE' to inspect DB contents.\n" if $DEBUG; } }
 * 1) !/usr/bin/perl -w --
 * 1) storyimage.t - Class::DBI many-to-many relationship test script
 * 1) Usage: perl -MTest::Harness='$verbose,runtests' \
 * 2)             -we '$verbose=1; runtests @ARGV' storyimage.t
 * 1) Usage: storyimage.t
 * 1) If you wish to KEEP the database at end of test, then
 * 2)    set the STORYIMAGE_DONT_DELETE_DB environment variable.
 * 1) To inspect the database created by running the test, run:
 * 2)    dbish dbi:SQLite:dbname=./storyimage.sqlite
 * 1) Security stuff (to make script -T clean)
 * 1) Base class
 * 1) Story
 * 1) StoryImage
 * 1) Image
 * 1) Main program
 * 1) Set up DB
 * 1) Populate DB
 * 1) Story tests
 * 1) Image tests
 * 1) Functions starteth yonder