1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
|
use lib 't';
BEGIN {
# to handle systems with no installed Test module
# we include the t dir (where a copy of Test.pm is located)
# as a fallback
eval { require Test; };
use Test;
plan tests => 5;
}
use DBIx::DBStag;
use FileHandle;
my $moviedata = getmoviedata();
my ($hdr, @data) = process($moviedata);
my $dbhstag = DBIx::DBStag->new;
my $ss = <<EOM
(schema
(cols
(col
(relation "dir")
(name "lname"))
(col
(relation "dir")
(name "fname"))
(col
(relation "dir")
(name "country"))
(col
(relation "movie")
(name "name"))
(col
(relation "movie")
(name "genre"))
(col
(relation "star")
(name "lname"))
(col
(relation "star")
(name "fname"))
(col
(relation "character")
(name "name")))
(constraints
(primarykey
(relation "movie")
(col "name"))
(primarykey
(relation "dir")
(col "lname")
(col "fname")))
(aliases
(alias
(name "dir")
(table "person")))
(top "mset")
(nesting
(movie
(dir 1)
(character
(star 1)))))
EOM
;
my $mstruct =
$dbhstag->normalize($ss, \@data);
print $mstruct->xml;
my @movies = $mstruct->where('movie',
sub {
grep {
$_->sgetnode_person->sget_lname eq 'coen'
} shift->getnode_dir
});
ok(@movies == 1);
my $movie = shift @movies;
ok($movie->sget_name eq 'barton fink');
my @characters = $movie->get_character;
ok(@characters == 2);
my $schema = Data::Stag->from('sxprstr', $ss);
my $astruct = $schema->sgetnode_aliases;
$astruct->addnode_alias(Data::Stag->new(alias=>[
[name=>'movie'],
[table=>'work']]));
print $schema->sxpr;
my $dirstruct =
$dbhstag->normalize(-schema=>$schema,
-rows=>\@data,
-top=>"dirset",
-aliaspolicy=>'n',
-nesting=>"'(dirset(dir(movie(star(character 1)))))");
print $dirstruct->sxpr, "\n";
my @dirs = $dirstruct->getnode_dir;
ok(@dirs == 6);
my @coens = grep {$_->sgetnode_person->sget_lname eq 'coen'} @dirs;
ok(@coens == 2);
exit 0;
#
sub process{
my $data = shift;
my @data = map {chomp;[split(/\,\s*/, $_)]} split(/\n/,$data);
# first line is header line
my $hdr = shift @data;
$hdr->[0] =~ s/^\#//;
return ($hdr, @data);
}
sub getmoviedata {
return <<EOM
#director.lname, director.fname, dir.country, film.name, film.genre, actor.lname, actor.fname, character.name
lucas, george, US, star wars, sci-fi, ford, harrison, han solo
lucas, george, US, star wars, sci-fi, fisher, carrie, princess leia
lucas, george, US, star wars, sci-fi, hamill, mark, luke skywalker
lucas, george, US, star wars, sci-fi, earl-jones, james, darth vader
lucas, george, US, star wars, sci-fi, prowse, david, darth vader
lucas, george, US, star wars, sci-fi, guiness, alec, obi-wan kenobi
lucas, george, US, attack of the clones, sci-fi, mcgregor, ewan, obi-wan kenobi
lucas, george, US, attack of the clones, sci-fi, portman, natalie, princess amigdala
jackson, peter, new zealand, braindead, horror, -, -, -, -
jackson, peter, new zealand, lord of the rings, fantasy, lee, christopher, saruman
jackson, peter, new zealand, lord of the rings, fantasy, kellan, ian, gandalf
kurosawa, akira, japan, seven samurai, samurai, mifune, toshiro, Kikuchiyo
cameron, john, US, terminator, sci-fi, schwarzenegger, arnold, terminator
cameron, john, US, terminator2, sci-fi, schwarzenegger, arnold, terminator
coen, joel, US, barton fink, odd, turturro, john, barton fink
coen, ethan, US, barton fink, odd, turturro, john, barton fink
coen, joel, US, barton fink, odd, goodman, john, charlie meadows
coen, ethan, US, barton fink, odd, goodman, john, charlie meadows
EOM
}
sub getcharacterdata {
return <<EOM
gandalf, goody, staff
luke skywalker, goody, lightsaber
darth vader, baddy, lightsaber
EOM
}
sub getanimaldata {
return <<EOM
#rel.t, rel.subj, rel.obj
isa, dog, mammal
isa, cat, mammal
isa, mammal, animal
isa, zebra, horse
isa, horse, mammal
isa, unicorn, horse
isa, unicorn, imaginary-animal
instance-of, rover, dog
instance-of, whiskers, cat
instance-of, spot, dog
parent-of, spot, rover
EOM
}
|