/[papo]/papo/xot/Xot/Table.pm
ViewVC logotype

Diff of /papo/xot/Xot/Table.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by jlenton, Mon May 19 19:06:08 2003 UTC revision 1.2 by jlenton, Mon Jun 30 03:42:06 2003 UTC
# Line 1  Line 1 
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);
# Line 31  sub init Line 48  sub init
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;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26