Initial revision

2 files changed, 424 insertions, 0 deletions

diff --git a/site_perl/dbdef_column.pm b/site_perl/dbdef_column.pm
new file mode 100644
index 000000000..023b57d1f
--- /dev/null
+++ b/site_perl/dbdef_column.pm
@@ -0,0 +1,175 @@
+package FS::dbdef_column;
+
+use strict;
+#use Carp;
+use Exporter;
+use vars qw(@ISA);
+
+@ISA = qw(Exporter);
+
+=head1 NAME
+
+FS::dbdef_column - Column object
+
+=head1 SYNOPSIS
+
+  use FS::dbdef_column;
+
+  $column_object = new FS::dbdef_column ( $name, $sql_type, '' );
+  $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL' );
+  $column_object = new FS::dbdef_column ( $name, $sql_type, '', $length );
+  $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL', $length );
+
+  $name = $column_object->name;
+  $column_object->name ( 'name' );
+
+  $name = $column_object->type;
+  $column_object->name ( 'sql_type' );
+
+  $name = $column_object->null;
+  $column_object->name ( 'NOT NULL' );
+
+  $name = $column_object->length;
+  $column_object->name ( $length );
+
+  $sql_line = $column->line;
+  $sql_line = $column->line $datasrc;
+
+=head1 DESCRIPTION
+
+FS::dbdef::column objects represend columns in tables (see L<FS::dbdef_table>).
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Creates a new FS::dbdef_column object.
+
+=cut
+
+sub new {
+  my($proto,$name,$type,$null,$length)=@_;
+
+  #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
+
+  $null =~ s/^NOT NULL$//i;
+
+  my $class = ref($proto) || $proto;
+  my $self = {
+    'name'   => $name,
+    'type'   => $type,
+    'null'   => $null,
+    'length' => $length,
+  };
+
+  bless ($self, $class);
+
+}
+
+=item name
+
+Returns or sets the column name.
+
+=cut
+
+sub name {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+  #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
+    $self->{'name'} = $value;
+  } else {
+    $self->{'name'};
+  }
+}
+
+=item type
+
+Returns or sets the column type.
+
+=cut
+
+sub type {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{'type'} = $value;
+  } else {
+    $self->{'type'};
+  }
+}
+
+=item null
+
+Returns or sets the column null flag.
+
+=cut
+
+sub null {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $value =~ s/^NOT NULL$//i;
+    $self->{'null'} = $value;
+  } else {
+    $self->{'null'};
+  }
+}
+
+=item type
+
+Returns or sets the column length.
+
+=cut
+
+sub length {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{'length'} = $value;
+  } else {
+    $self->{'length'};
+  }
+}
+
+=item line [ $datasrc ]
+
+Returns an SQL column definition.
+
+If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
+syntax.  Non-standard syntax for other engines (if applicable) may also be
+supported in the future.
+
+=cut
+
+sub line {
+  my($self,$datasrc)=@_;
+  my($null)=$self->null;
+  $null ||= "NOT NULL" if $datasrc =~ /mysql/; #yucky mysql hack
+  join(' ',
+    $self->name,
+    $self->type. ( $self->length ? '('.$self->length.')' : '' ),
+    $null,
+  );
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::dbdef_table>, L<FS::dbdef>, L<DBI>
+
+=head1 HISTORY
+
+class for dealing with column definitions
+
+ivan@sisd.com 98-apr-17
+
+now methods can be used to get or set data ivan@sisd.com 98-may-11
+
+mySQL-specific hack for null (what should be default?) ivan@sisd.com 98-jun-2
+
+=cut
+
+1;
+
diff --git a/site_perl/dbdef_table.pm b/site_perl/dbdef_table.pm
new file mode 100644
index 000000000..bc1454d9e
--- /dev/null
+++ b/site_perl/dbdef_table.pm
@@ -0,0 +1,249 @@
+package FS::dbdef_table;
+
+use strict;
+#use Carp;
+use Exporter;
+use vars qw(@ISA);
+use FS::dbdef_column;
+
+@ISA = qw(Exporter);
+
+=head1 NAME
+
+FS::dbdef_table - Table objects
+
+=head1 SYNOPSIS
+
+  use FS::dbdef_table;
+
+  $dbdef_table = new FS::dbdef_table (
+    "table_name",
+    "primary_key",
+    $FS_dbdef_unique_object,
+    $FS_dbdef_index_object,
+    @FS_dbdef_column_objects,
+  );
+
+  $dbdef_table->addcolumn ( $FS_dbdef_column_object );
+
+  $table_name = $dbdef_table->name;
+  $dbdef_table->name ("table_name");
+
+  $table_name = $dbdef_table->primary_keye;
+  $dbdef_table->primary_key ("primary_key");
+
+  $FS_dbdef_unique_object = $dbdef_table->unique;
+  $dbdef_table->unique ( $FS_dbdef_unique_object );
+
+  $FS_dbdef_index_object = $dbdef_table->index;
+  $dbdef_table->index ( $FS_dbdef_index_object );
+
+  @column_names = $dbdef->columns;
+
+  $FS_dbdef_column_object = $dbdef->column;
+
+  @sql_statements = $dbdef->sql_create_table;
+  @sql_statements = $dbdef->sql_create_table $datasrc;
+
+=head1 DESCRIPTION
+
+FS::dbdef_table objects represent a single database table.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Creates a new FS::dbdef_table object.
+
+=cut
+
+sub new {
+  my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
+
+  my(%columns) = map { $_->name, $_ } @columns;
+
+  #check $primary_key, $unique and $index to make sure they are $columns ?
+  # (and sanity check?)
+
+  my $class = ref($proto) || $proto;
+  my $self = {
+    'name'        => $name,
+    'primary_key' => $primary_key,
+    'unique'      => $unique,
+    'index'       => $index,
+    'columns'     => \%columns,
+  };
+
+  bless ($self, $class);
+
+}
+
+=item addcolumn
+
+Adds this FS::dbdef_column object. 
+
+=cut
+
+sub addcolumn {
+  my($self,$column)=@_;
+  ${$self->{'columns'}}{$column->name}=$column; #sanity check?
+}
+
+=item name
+
+Returns or sets the table name.
+
+=cut
+
+sub name {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{name} = $value;
+  } else {
+    $self->{name};
+  }
+}
+
+=item primary_key
+
+Returns or sets the primary key.
+
+=cut
+
+sub primary_key {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{primary_key} = $value;
+  } else {
+    #$self->{primary_key};
+    #hmm.  maybe should untaint the entire structure when it comes off disk 
+    # cause if you don't trust that, ?
+    $self->{primary_key} =~ /^(\w*)$/ 
+      #aah!
+      or die "Illegal primary key ", $self->{primary_key}, " in dbdef!\n";
+    $1;
+  }
+}
+
+=item unique
+
+Returns or sets the FS::dbdef_unique object.
+
+=cut
+
+sub unique { 
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{unique} = $value;
+  } else {
+    $self->{unique};
+  }
+}
+
+=item index
+
+Returns or sets the FS::dbdef_index object.
+
+=cut
+
+sub index { 
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{'index'} = $value;
+  } else {
+    $self->{'index'};
+  }
+}
+
+=item columns
+
+Returns a list consisting of the names of all columns.
+
+=cut
+
+sub columns {
+  my($self)=@_;
+  keys %{$self->{'columns'}};
+}
+
+=item column "column"
+
+Returns the column object (see L<FS::dbdef_column>) for "column".
+
+=cut
+
+sub column {
+  my($self,$column)=@_;
+  $self->{'columns'}->{$column};
+}
+
+=item sql_create_table [ $datasrc ]
+
+Returns an array of SQL statments to create this table.
+
+If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
+syntax.  Non-standard syntax for other engines (if applicable) may also be
+supported in the future.
+
+=cut
+
+sub sql_create_table { 
+  my($self,$datasrc)=@_;
+
+  my(@columns)=map { $self->column($_)->line($datasrc) } $self->columns;
+  push @columns, "PRIMARY KEY (". $self->primary_key. ")"
+    if $self->primary_key;
+  if ( $datasrc =~ /mysql/ ) { #yucky mysql hack
+    push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
+    push @columns, map "INDEX ($_)", $self->index->sql_list;
+  }
+
+  "CREATE TABLE ". $self->name. " ( ". join(", ", @columns). " )",
+  ( map {
+    my($index) = $_ . "_index";
+    $index =~ s/,\s*/_/g;
+    "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)"
+  } $self->unique->sql_list ),
+  ( map {
+    my($index) = $_ . "_index";
+    $index =~ s/,\s*/_/g;
+    "CREATE INDEX $index ON ". $self->name. " ($_)"
+  } $self->index->sql_list ),
+  ;  
+
+
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::dbdef>, L<FS::dbdef_unique>, L<FS::dbdef_index>, L<FS::dbdef_unique>,
+L<DBI>
+
+=head1 HISTORY
+
+class for dealing with table definitions
+
+ivan@sisd.com 98-apr-18
+
+gained extra functions (should %columns be an IxHash?)
+ivan@sisd.com 98-may-11
+
+sql_create_table returns a list of statments, not just one, and now it
+does indices (plus mysql hack) ivan@sisd.com 98-jun-2
+
+untaint primary_key... hmm.  is this a hack around a bigger problem?
+looks like, did the same thing singles in colgroup!
+ivan@sisd.com 98-jun-4
+
+pod ivan@sisd.com 98-sep-24
+
+=cut
+
+1;
+