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
|
package MusicStore;
use CD;
use Tangram qw(:core :compat_quiet);
use Tangram::Schema;
use Tangram::IntrArray;
use Tangram::TimePiece;
use Tangram::IntrSet;
use Tangram::Set;
use Tangram::IDBIF;
our $schema =
({
classes => [
CD => {
fields => {
string => [ qw(title) ],
timepiece => [ qw(publishdate) ],
iarray => { songs => { class => 'CD::Song',
aggreg => 1,
back => 'cd',
},
},
}
},
CD::Song => {
fields => {
string => [ qw(name) ],
}
},
CD::Artist => {
abstract => 1,
fields => {
string => [ qw(name popularity) ],
iset => { cds => { class => 'CD',
aggreg => 1,
back => 'artist' },
},
},
},
CD::Person => {
bases => [ "CD::Artist" ],
fields => {
string => [ qw(gender haircolor) ],
timepiece => [ qw(birthdate) ],
}
},
CD::Band => {
bases => [ "CD::Artist" ],
fields => {
timepiece => [ qw(creationdate enddate) ],
set => { members => { class => 'CD::Person',
table => "artistgroup",
},
},
},
},
],
});
our $pixie_like_schema =
({
classes =>
[
HASH =>
{
table => "objects",
sql => { sequence => "oid_sequence" },
fields => { idbif => undef },
},
],
});
use Storable qw(dclone);
our $new_schema = dclone $schema;
push @{ $new_schema->{classes} },
(
"CD::Compilation" =>
{ # CD sub-class with an author per track
bases => [ qw(CD) ],
},
"CD::Compilation::Song" =>
{
bases => [ qw(CD::Song) ],
fields => {
ref => { artist => { class => "CD::Artist" },
},
},
},
);
# munge all the table names
$new_schema->{normalize} = sub {
my $class_name = shift;
(my $table_name = $class_name) =~ s{::}{_}g;
$table_name =~ s{^}{new_};
return $table_name;
};
# normalisation isn't applied to manually configured names!
$new_schema->{classes}[9]{fields}{set}{members}{table}
= "new_artistgroup";
$new_schema->{control} = "new_Tangram";
sub AUTOLOAD {
my ($func) = ($AUTOLOAD =~ m/.*::(.*)$/);
return Tangram::Schema->new(${$func})
}
1;
|
