Complex many to many example

From ClassDBI

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

Bugfixes are welcome!

#!/usr/bin/perl -w  --
#
# storyimage.t - Class::DBI many-to-many relationship test script
#
#
# Usage: perl -MTest::Harness='$verbose,runtests' \
#             -we '$verbose=1; runtests @ARGV' storyimage.t
#
# Usage: storyimage.t
#
#
# If you wish to KEEP the database at end of test, then
#    set the STORYIMAGE_DONT_DELETE_DB environment variable.
#
# To inspect the database created by running the test, run:
#    dbish dbi:SQLite:dbname=./storyimage.sqlite

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";

# Security stuff (to make script -T clean)
$ENV{PATH} = "/usr/bin:/bin:/usr/local/bin";
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

#
# Base class
#

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", ,  );

#
# Story
#

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' } );

#
# StoryImage
#

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(@_) }

#
# Image
#

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" );

#
# Main program
#

package MyDB;

# Set up DB

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";
}

# Populate DB

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') );

#
# Story tests
#
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)"
);

#
# Image tests
#

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" );

#
# Functions starteth yonder
#

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;
    }
}