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
|
# (c) Sound Object Logic 2000-2001
use strict;
use Tangram::Type;
package Tangram::Scalar;
use vars qw(@ISA);
@ISA = qw( Tangram::Type );
sub reschema
{
my ($self, $members, $class, $schema) = @_;
if (ref($members) eq 'ARRAY')
{
# short form
# transform into hash: { fieldname => { col => fieldname }, ... }
$members = $_[1] = map { $_ => { col => $schema->{normalize}->($_, 'colname') } } @$members;
}
for my $field (keys %$members)
{
my $def = $members->{$field};
unless (ref($def))
{
# not a reference: field => field
$def = $members->{$field} = { col => $schema->{normalize}->(($def || $field), 'fieldname') };
}
$self->field_reschema($field, $def, $schema);
}
return keys %$members;
}
sub field_reschema
{
my ($self, $field, $def, $schema) = @_;
$def->{col} ||= $schema->{normalize}->($field, 'colname');
}
sub query_expr
{
my ($self, $obj, $memdefs, $tid, $storage) = @_;
return map { $storage->expr($self, "t$tid.$memdefs->{$_}{col}", $obj) } keys %$memdefs;
}
sub remote_expr
{
my ($self, $obj, $tid, $storage) = @_;
$storage->expr($self, "t$tid.$self->{col}", $obj);
}
sub get_exporter
{
my ($self) = @_;
return if $self->{automatic};
my $field = $self->{name};
return "exists \$obj->{q{$field}} ? \$obj->{q{$field}} : undef";
}
sub get_importer
{
my ($self) = @_;
return "\$obj->{q{$self->{name}}} = shift \@\$row";
}
sub get_export_cols
{
return shift->{col};
}
sub get_import_cols
{
my ($self, $context) = @_;
return $self->{col};
}
sub literal
{
my ($self, $lit) = @_;
return $lit;
}
sub content
{
shift;
shift;
}
package Tangram::Number;
use vars qw(@ISA);
@ISA = qw( Tangram::Scalar );
sub get_export_cols
{
my ($self) = @_;
return exists $self->{automatic} ? () : ($self->{col});
}
package Tangram::Integer;
use vars qw(@ISA);
@ISA = qw( Tangram::Number );
$Tangram::Schema::TYPES{int} = Tangram::Integer->new;
package Tangram::Real;
use vars qw(@ISA);
@ISA = qw( Tangram::Number );
$Tangram::Schema::TYPES{real} = Tangram::Real->new;
package Tangram::String;
use vars qw(@ISA);
@ISA = qw( Tangram::Scalar );
$Tangram::Schema::TYPES{string} = Tangram::String->new;
sub literal
{
my ($self, $lit, $storage) = @_;
return $storage->{db}->quote($lit);
}
1;
|
