site_perl/dbdef_table.pm

   1 package FS::dbdef_table;
   2
   3 use strict;
   4 #use Carp;
   5 use Exporter;
   6 use vars qw(@ISA);
   7 use FS::dbdef_column;
   8
   9 @ISA = qw(Exporter);
  10
  11 =head1 NAME
  12
  13 FS::dbdef_table - Table objects
  14
  15 =head1 SYNOPSIS
  16
  17   use FS::dbdef_table;
  18
  19   $dbdef_table = new FS::dbdef_table (
  20     "table_name",
  21     "primary_key",
  22     $FS_dbdef_unique_object,
  23     $FS_dbdef_index_object,
  24     @FS_dbdef_column_objects,
  25   );
  26
  27   $dbdef_table->addcolumn ( $FS_dbdef_column_object );
  28
  29   $table_name = $dbdef_table->name;
  30   $dbdef_table->name ("table_name");
  31
  32   $table_name = $dbdef_table->primary_keye;
  33   $dbdef_table->primary_key ("primary_key");
  34
  35   $FS_dbdef_unique_object = $dbdef_table->unique;
  36   $dbdef_table->unique ( $FS_dbdef_unique_object );
  37
  38   $FS_dbdef_index_object = $dbdef_table->index;
  39   $dbdef_table->index ( $FS_dbdef_index_object );
  40
  41   @column_names = $dbdef->columns;
  42
  43   $FS_dbdef_column_object = $dbdef->column;
  44
  45   @sql_statements = $dbdef->sql_create_table;
  46   @sql_statements = $dbdef->sql_create_table $datasrc;
  47
  48 =head1 DESCRIPTION
  49
  50 FS::dbdef_table objects represent a single database table.
  51
  52 =head1 METHODS
  53
  54 =over 4
  55
  56 =item new
  57
  58 Creates a new FS::dbdef_table object.
  59
  60 =cut
  61
  62 sub new {
  63   my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
  64
  65   my(%columns) = map { $_->name, $_ } @columns;
  66
  67   #check $primary_key, $unique and $index to make sure they are $columns ?
  68   # (and sanity check?)
  69
  70   my $class = ref($proto) || $proto;
  71   my $self = {
  72     'name'        => $name,
  73     'primary_key' => $primary_key,
  74     'unique'      => $unique,
  75     'index'       => $index,
  76     'columns'     => \%columns,
  77   };
  78
  79   bless ($self, $class);
  80
  81 }
  82
  83 =item addcolumn
  84
  85 Adds this FS::dbdef_column object.
  86
  87 =cut
  88
  89 sub addcolumn {
  90   my($self,$column)=@_;
  91   ${$self->{'columns'}}{$column->name}=$column; #sanity check?
  92 }
  93
  94 =item name
  95
  96 Returns or sets the table name.
  97
  98 =cut
  99
 100 sub name {
 101   my($self,$value)=@_;
 102   if ( defined($value) ) {
 103     $self->{name} = $value;
 104   } else {
 105     $self->{name};
 106   }
 107 }
 108
 109 =item primary_key
 110
 111 Returns or sets the primary key.
 112
 113 =cut
 114
 115 sub primary_key {
 116   my($self,$value)=@_;
 117   if ( defined($value) ) {
 118     $self->{primary_key} = $value;
 119   } else {
 120     #$self->{primary_key};
 121     #hmm.  maybe should untaint the entire structure when it comes off disk
 122     # cause if you don't trust that, ?
 123     $self->{primary_key} =~ /^(\w*)$/
 124       #aah!
 125       or die "Illegal primary key ", $self->{primary_key}, " in dbdef!\n";
 126     $1;
 127   }
 128 }
 129
 130 =item unique
 131
 132 Returns or sets the FS::dbdef_unique object.
 133
 134 =cut
 135
 136 sub unique {
 137   my($self,$value)=@_;
 138   if ( defined($value) ) {
 139     $self->{unique} = $value;
 140   } else {
 141     $self->{unique};
 142   }
 143 }
 144
 145 =item index
 146
 147 Returns or sets the FS::dbdef_index object.
 148
 149 =cut
 150
 151 sub index {
 152   my($self,$value)=@_;
 153   if ( defined($value) ) {
 154     $self->{'index'} = $value;
 155   } else {
 156     $self->{'index'};
 157   }
 158 }
 159
 160 =item columns
 161
 162 Returns a list consisting of the names of all columns.
 163
 164 =cut
 165
 166 sub columns {
 167   my($self)=@_;
 168   keys %{$self->{'columns'}};
 169 }
 170
 171 =item column "column"
 172
 173 Returns the column object (see L<FS::dbdef_column>) for "column".
 174
 175 =cut
 176
 177 sub column {
 178   my($self,$column)=@_;
 179   $self->{'columns'}->{$column};
 180 }
 181
 182 =item sql_create_table [ $datasrc ]
 183
 184 Returns an array of SQL statments to create this table.
 185
 186 If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
 187 syntax.  Non-standard syntax for other engines (if applicable) may also be
 188 supported in the future.
 189
 190 =cut
 191
 192 sub sql_create_table {
 193   my($self,$datasrc)=@_;
 194
 195   my(@columns)=map { $self->column($_)->line($datasrc) } $self->columns;
 196   push @columns, "PRIMARY KEY (". $self->primary_key. ")"
 197     if $self->primary_key;
 198   if ( $datasrc =~ /mysql/ ) { #yucky mysql hack
 199     push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
 200     push @columns, map "INDEX ($_)", $self->index->sql_list;
 201   }
 202
 203   "CREATE TABLE ". $self->name. " ( ". join(", ", @columns). " )",
 204   ( map {
 205     my($index) = $_ . "_index";
 206     $index =~ s/,\s*/_/g;
 207     "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)"
 208   } $self->unique->sql_list ),
 209   ( map {
 210     my($index) = $_ . "_index";
 211     $index =~ s/,\s*/_/g;
 212     "CREATE INDEX $index ON ". $self->name. " ($_)"
 213   } $self->index->sql_list ),
 214   ;
 215
 216
 217 }
 218
 219 =back
 220
 221 =head1 BUGS
 222
 223 =head1 SEE ALSO
 224
 225 L<FS::dbdef>, L<FS::dbdef_unique>, L<FS::dbdef_index>, L<FS::dbdef_unique>,
 226 L<DBI>
 227
 228 =head1 HISTORY
 229
 230 class for dealing with table definitions
 231
 232 ivan@sisd.com 98-apr-18
 233
 234 gained extra functions (should %columns be an IxHash?)
 235 ivan@sisd.com 98-may-11
 236
 237 sql_create_table returns a list of statments, not just one, and now it
 238 does indices (plus mysql hack) ivan@sisd.com 98-jun-2
 239
 240 untaint primary_key... hmm.  is this a hack around a bigger problem?
 241 looks like, did the same thing singles in colgroup!
 242 ivan@sisd.com 98-jun-4
 243
 244 pod ivan@sisd.com 98-sep-24
 245
 246 =cut
 247
 248 1;
 249