1 |
package Xot::Table; |
package Xot::Table; |
2 |
use strict; |
use strict; |
3 |
use Xot::Field; |
use Xot::Field; |
4 |
|
use Xot::Reference; |
5 |
|
use Xot::Style; |
6 |
|
use Xot::Index; |
7 |
|
use base qw(Xot::Accessors); |
8 |
|
|
9 |
|
Xot::Table->plain(qw(name xot)); |
10 |
|
Xot::Table->multi('field' => 'Xot::Field', |
11 |
|
'table' => 'Xot::Table', |
12 |
|
'index' => 'Xot::Index', |
13 |
|
'style' => 'Xot::Style', |
14 |
|
); |
15 |
|
|
16 |
sub new |
my $_old_length=0; |
17 |
{ |
my $_tty = -t STDERR; |
|
my $class = shift; |
|
|
my $self = bless {}, $class; |
|
|
|
|
|
$self->init(@_); |
|
|
|
|
|
return $self; |
|
|
} |
|
18 |
|
|
19 |
sub init |
sub init |
20 |
{ |
{ |
21 |
my $self = shift; |
my ($self, $xot, $twig) = splice @_, 0, 3; |
22 |
my $table = shift; |
my $name = $twig->att('name'); |
23 |
|
die "must call init with a twig" |
24 |
|
unless defined $twig; |
25 |
|
|
26 |
die "must call init with a table" |
if ($_tty) |
27 |
unless defined $table; |
{ |
28 |
|
my $length = length($name); |
29 |
|
my $back = $_old_length > $length ? $_old_length - $length : 0; |
30 |
|
|
31 |
$self->table($table->att("name")); |
print STDERR $name, ' 'x$back, "\b"x($back+$length); |
32 |
|
$_old_length = $length; |
33 |
|
} |
34 |
|
|
35 |
my ($fields, $styles) = $table->children; |
$self->name($name); |
36 |
|
$self->xot($xot); |
37 |
|
$self->twig($twig); |
38 |
|
|
39 |
|
my ($fields) = $twig->children('fields'); |
40 |
|
my ($styles) = $twig->children('styles'); |
41 |
|
my ($indices) = $twig->children('indices'); |
42 |
|
my ($constraints) = $twig->children('constraints'); |
43 |
|
|
44 |
$self->add_field($_) |
$self->add_field($_) |
45 |
foreach ($fields->children); |
foreach ($fields->children); |
48 |
$self->add_style($_) |
$self->add_style($_) |
49 |
foreach ($styles->children); |
foreach ($styles->children); |
50 |
} |
} |
51 |
|
if ($indices) |
52 |
|
{ |
53 |
|
$self->add_index($_) |
54 |
|
foreach ($indices->children); |
55 |
|
} |
56 |
} |
} |
57 |
|
|
58 |
sub table |
sub primary_key |
|
{ |
|
|
my $self = shift; |
|
|
my $table = shift; |
|
|
|
|
|
$self->{NAME} = $table |
|
|
if defined $table; |
|
|
|
|
|
return $self->{NAME}; |
|
|
} |
|
|
|
|
|
sub add_field |
|
|
{ |
|
|
my $self = shift; |
|
|
my $twig = shift; |
|
|
|
|
|
my $name = $twig->att("name"); |
|
|
my $field = Xot::Field->new($twig); |
|
|
|
|
|
$self->field($name => $field); |
|
|
} |
|
|
|
|
|
sub fields |
|
|
{ |
|
|
my $self = shift; |
|
|
|
|
|
return keys %{ $self->{FIELDS} || {} }; |
|
|
} |
|
|
|
|
|
sub field |
|
59 |
{ |
{ |
60 |
my $self = shift; |
my $self = shift; |
|
my $name = shift; |
|
|
my $field = shift; |
|
|
|
|
|
$self->{FIELDS}->{$name} = $field |
|
|
if defined $field; |
|
61 |
|
|
62 |
return $self->{FIELDS}->{$name}; |
if (not exists $self->{PKEY}) |
63 |
} |
{ |
64 |
|
my @pkeys = map $_->index_fields, grep $_->type eq 'primary_key', $self->indexs; |
65 |
|
|
66 |
sub add_style |
Carp::confess("I don't deal with multiple primary keys (yet)") |
67 |
{ |
if (@pkeys>1); |
68 |
my $self = shift; |
Carp::confess("Table has no primary key") |
69 |
my $twig = shift; |
unless (@pkeys); |
70 |
|
|
71 |
my $name = $twig->att("name"); |
$self->{PKEY} = $pkeys[0]->field; |
72 |
|
} |
73 |
|
|
74 |
push @{$self->{STYLES}}, $name; |
return $self->{PKEY}; |
75 |
} |
} |
76 |
|
|
|
sub styles |
|
|
{ |
|
|
my $self = shift; |
|
|
|
|
|
return @{$self->{STYLES}}; |
|
|
} |
|
77 |
|
|
78 |
1; |
1; |