File: norm2.t

package info (click to toggle)
libdbix-dbstag-perl 0.12-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, stretch
  • size: 1,424 kB
  • ctags: 826
  • sloc: perl: 6,152; sql: 588; xml: 221; lisp: 59; makefile: 20
file content (161 lines) | stat: -rw-r--r-- 4,351 bytes parent folder | download | duplicates (3)
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
}