# -*- perl -*-
# test script for the Persistathon - set TANGRAM_TRACE=1 in the
# environment for a nice log of what queries Tangram is running.
use lib "t/musicstore";
use Prerequisites;
use strict;
use Test::More tests => 24;
use Tangram::Storage;
# various items that will "persist" between test blocks
use vars qw($storage);
my ($oid, $id, $r_cd, $r_artist, $band, $row, $join, $filter);
# open a storage connection - this will be
# Tangram::Relational->connect(), etc.
$storage = DBConfig->dialect->connect(MusicStore->schema, DBConfig->cparm);
{
# 1. create a new database object of each type in the schema
my ($cd, @songs, $band, @people);
$band = CD::Band->new
({ name => "The Upbeats",
popularity => "World Famous in New Zealand",
cds => Set::Object->new
(
$cd=
CD->new({title => "The Upbeats",
publishdate => iso('2004-04-01'),
songs => [
@songs=
CD::Song->new({name => "Hello"}),
CD::Song->new({name => "Drizzle"}),
CD::Song->new({name => "From the Deep"}),
],
}),
),
members => Set::Object->new
(
@people =
CD::Person->new({ name => "Jeremy Glenn" }),
CD::Person->new({ name => "Dylan Jones" }),
),
});
# stick it in
$oid = $storage->insert($band);
$id = $storage->export_object($band);
ok($oid, "Inserted a band and associated objects");
# 2. print the object IDs
if ( -t STDIN ) { #unless running in the harness...
diag($_) foreach
("Band: ".$storage->export_object($band),
"People: ".join(",", $storage->export_object(@people)),
"CD storage ID: ".$storage->export_object($cd),
"Songs: ".join(",", $storage->export_object(@songs)));
}
# put in some extra data for fun
require 'insert_extra_data.pl';
}
# objects should now be gone, as they have fallen out of scope
is($CD::c, 0, "no objects leaked");
{
# two loading strategies - one is the `exported' object, where you
# pass in a type and an ID - note that any superclass is OK (the
# import is polymorphic)
$band = $storage->import_object("CD::Artist", $id);
isa_ok($band, "CD::Band", "Band loaded by exported ID");
# the second is to import by oid, which includes the class ID...
my $band2 = $storage->load($oid);
isa_ok($band2, "CD::Band", "Band loaded by OID");
is($band, $band2, "Seperate loads returned same object");
}
is($CD::c, 1, "no objects leaked");
{
# 4. fetch an artist record by name (exact match)
$r_artist = $storage->remote("CD::Artist");
my @artists = $storage->select
( $r_artist,
$r_artist->{name} eq "The Upbeats" );
is(@artists, 1, "got an object out");
# extra demonstration - is it the same object as $band ?
is($artists[0], $band, "selects return cached objects");
}
is($CD::c, 1, "no objects leaked");
{
# 5. fetch an artist record with a search term (globbing / LIKE /
# etc)
my (@artists) = $storage->select
( $r_artist,
$r_artist->{name}->upper()->like(uc("%beat%")),
);
is(@artists, 2, "got two artists matching %beat%");
ok(Set::Object->new(@artists)->includes($band),
"select still returns cached objects");
undef($band);
}
is($CD::c, 0, "no objects leaked");
{
# 6. fetch CD records by matching on a partial *artist's* name,
# using a cursor if possible.
$r_cd = $storage->remote("CD");
$join = ($r_cd->{artist} == $r_artist);
my $query = $r_artist->{name}->upper()->like(uc("%beat%"));
my $filter = $join & $query;
my $cursor = $storage->cursor ( $r_cd, $filter );
my @cds;
while ( my $cd = $cursor->current ) {
push @cds, $cd;
$cursor->next;
}
is(@cds, 3, "Found three CDs by artists matching %beat%");
# if we just wanted the count:
my ($count) = $storage->count($filter);
is($count, 3, "Can do simple COUNT() queries");
# maybe some other aggregation type queries:
($row) = $storage->select
( undef, # no object
filter => $filter,
retrieve => [ $r_cd->{publishdate}->min(),
$r_cd->{publishdate}->max(),
],
);
# this could probably be considered a design caveat
$_ = $storage->from_dbms("date", $_) foreach @$row;
}
is($CD::c, 0, "no objects leaked");
{
is_deeply($row, [ '1999-10-26T00:00:00', '2004-04-01T00:00:00' ],
"aggregation type queries");
# 7. fetch unique CD records by matching on a partial artist's
# *or* partial CD name, using a cursor if possible.
my $query =
( $r_artist->{name}->upper()->like(uc("%beat%"))
| $r_cd->{title}->upper()->like(uc("%beat%")) );
my $filter = $join & $query;
my $cursor = $storage->cursor ( $r_cd, $filter );
my @cds=();
while ( my $cd = $cursor->current ) {
diag ("found cd = " .$cd->title.", artist = ".$cd->artist->name);
push @cds, $cd;
$cursor->next;
}
is(@cds, 4, "Found four CDs by CD or artist name matching %beat%");
}
is($CD::c, 0, "no objects leaked");
{
#use YAML;
#local($Tangram::TRACE) = \*STDERR;
#local($Tangram::DEBUG_LEVEL) = 3;
# 8. update a record or two
my ($pfloyd) = $storage->select
( $r_artist,
$r_artist->{name} eq "Pink Floyd" );
my $cd;
$pfloyd->cds->insert
($cd=
CD->new({ title => "The Dark Side of The Moon",
publishdate => iso("2004-04-06"),
songs => [ map { CD::Song->new({ name => $_ }) }
"Speak To Me/Breathe", "On The Run",
"Time", "The Great Gig in the Sky",
"Money", "Us And Them",
"Any Colour You Like", "Brain Damage",
"Eclipse",
],
})
);
$pfloyd->popularity("legendary");
$storage->update($pfloyd);
ok($storage->id($cd), "Automatically added a new Set member");
}
is($CD::c, 0, "no objects leaked");
{
my ($pfloyd) = $storage->select
( $r_artist,
$r_artist->{name} eq "Pink Floyd" );
is($pfloyd->popularity, "legendary", "saved an object property");
}
is($CD::c, 0, "no objects leaked");
{
# 9. delete some records
my (@gonners) = $storage->select
($r_artist,
$r_artist->{popularity} eq "one hit wonder");
$storage->erase(@gonners);
ok(!$storage->id($gonners[0]), "No longer part of storage");
}
is($CD::c, 0, "no objects leaked");
our %formats;
BEGIN {
%formats =
( 4 => "%Y",
10 => "%Y-%m-%d",
19 => "%Y-%m-%dT%H:%M:%S",
);
}
sub iso {
my $str = shift;
Time::Piece->strptime($str, $formats{length($str)});
}