This commit was manufactured by cvs2svn to create branch 'freeside_import'.
authorcvs2git <cvs2git>
Fri, 25 Sep 1998 07:47:28 +0000 (07:47 +0000)
committercvs2git <cvs2git>
Fri, 25 Sep 1998 07:47:28 +0000 (07:47 +0000)
site_perl/dbdef.pm [new file with mode: 0644]
site_perl/dbdef_colgroup.pm [new file with mode: 0644]

diff --git a/site_perl/dbdef.pm b/site_perl/dbdef.pm
new file mode 100644 (file)
index 0000000..ac31bff
--- /dev/null
@@ -0,0 +1,174 @@
+package FS::dbdef;
+
+use strict;
+use vars qw(@ISA);
+use Exporter;
+use Carp;
+use FreezeThaw qw(freeze thaw cmpStr);
+use FS::dbdef_table;
+use FS::dbdef_unique;
+use FS::dbdef_index;
+use FS::dbdef_column;
+
+@ISA = qw(Exporter);
+
+=head1 NAME
+
+FS::dbdef - Database objects
+
+=head1 SYNOPSIS
+
+  use FS::dbdef;
+
+  $dbdef = new FS::dbdef (@dbdef_table_objects);
+  $dbdef = load FS::dbdef "filename";
+
+  $dbdef->save("filename");
+
+  $dbdef->addtable($dbdef_table_object);
+
+  @table_names = $dbdef->tables;
+
+  $FS_dbdef_table_object = $dbdef->table;
+
+=head1 DESCRIPTION
+
+FS::dbdef objects are collections of FS::dbdef_table objects and represnt
+a database (a collection of tables).
+
+=head1 METHODS
+
+=over 4
+
+=item new TABLE, TABLE, ...
+
+Creates a new FS::dbdef object
+
+=cut
+
+sub new {
+  my($proto,@tables)=@_;
+  my(%tables)=map  { $_->name, $_ } @tables; #check for duplicates?
+
+  my($class) = ref($proto) || $proto;
+  my($self) = {
+    'tables' => \%tables,
+  };
+
+  bless ($self, $class);
+
+}
+
+=item load FILENAME
+
+Loads an FS::dbdef object from a file.
+
+=cut
+
+sub load {
+  my($proto,$file)=@_; #use $proto ?
+  open(FILE,"<$file") or die "Can't open $file: $!";
+  my($string)=join('',<FILE>); #can $string have newlines?  pry not?
+  close FILE or die "Can't close $file: $!";
+  my($self)=thaw $string;
+  #no bless needed?
+  $self;
+}
+
+=item save FILENAME
+
+Saves an FS::dbdef object to a file.
+
+=cut
+
+sub save {
+  my($self,$file)=@_;
+  my($string)=freeze $self;
+  open(FILE,">$file") or die "Can't open $file: $!";
+  print FILE $string;
+  close FILE or die "Can't close file: $!";
+  my($check_self)=thaw $string;
+  die "Verify error: Can't freeze and thaw dbdef $self"
+    if (cmpStr($self,$check_self));
+}
+
+=item addtable TABLE
+
+Adds this FS::dbdef_table object.
+
+=cut
+
+sub addtable {
+  my($self,$table)=@_;
+  ${$self->{'tables'}}{$table->name}=$table; #check for dupliates?
+}
+
+=item tables 
+
+Returns the names of all tables.
+
+=cut
+
+sub tables {
+  my($self)=@_;
+  keys %{$self->{'tables'}};
+}
+
+=item table TABLENAME
+
+Returns the named FS::dbdef_table object.
+
+=cut
+
+sub table {
+  my($self,$table)=@_;
+  $self->{'tables'}->{$table};
+}
+
+=head1 BUGS
+
+Each FS::dbdef object should have a name which corresponds to its name within
+the SQL database engine.
+
+=head1 SEE ALSO
+
+L<FS::dbdef_table>, L<FS::Record>,
+
+=head1 HISTORY
+
+beginning of abstraction into a class (not really)
+
+ivan@sisd.com 97-dec-4
+
+added primary_key
+ivan@sisd.com 98-jan-20
+
+added datatype (very kludgy and needs to be cleaned)
+ivan@sisd.com 98-feb-21
+
+perltrap (sigh) masked by mysql 3.20->3,21 ivan@sisd.com 98-mar-2
+
+Change 'type' to 'atype' in agent_type
+Changed attributes to special words which are changed in fs-setup
+       ie. double(10,2) <=> MONEYTYPE
+Changed order of some of the field definitions because Pg6.3 is picky
+Changed 'day' to 'daytime' in cust_main
+Changed type of tax from tinyint to real
+Change 'password' to '_password' in svc_acct
+Pg6.3 does not allow 'field char(x) NULL'
+       bmccane@maxbaud.net     98-apr-3
+
+rewrite: now properly OO.  See also FS::dbdef_{table,column,unique,index}
+
+ivan@sisd.com 98-apr-17
+
+gained some extra functions ivan@sisd.com 98-may-11
+
+now knows how to Freeze and Thaw itself ivan@sisd.com 98-jun-2
+
+pod ivan@sisd.com 98-sep-23
+
+=cut
+
+1;
+
diff --git a/site_perl/dbdef_colgroup.pm b/site_perl/dbdef_colgroup.pm
new file mode 100644 (file)
index 0000000..64f2e30
--- /dev/null
@@ -0,0 +1,107 @@
+package FS::dbdef_colgroup;
+
+use strict;
+use vars qw(@ISA);
+
+@ISA = qw(Exporter);
+
+=head1 NAME
+
+FS::dbdef_colgroup - Column group objects
+
+=head1 SYNOPSIS
+
+  use FS::dbdef_colgroup;
+
+  $colgroup = new FS::dbdef_colgroup ( $lol );
+  $colgroup = new FS::dbdef_colgroup (
+    [
+      [ 'single_column' ],
+      [ 'multiple_columns', 'another_column', ],
+    ]
+  );
+
+  @sql_lists = $colgroup->sql_list;
+
+  @singles = $colgroup->singles;
+
+=head1 DESCRIPTION
+
+FS::dbdef_colgroup objects represent sets of sets of columns.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Creates a new FS::dbdef_colgroup object.
+
+=cut
+
+sub new {
+  my($proto, $lol) = @_;
+
+  my $class = ref($proto) || $proto;
+  my $self = {
+    'lol' => $lol,
+  };
+
+  bless ($self, $class);
+
+}
+
+=item sql_list
+
+Returns a flat list of comma-separated values, for SQL statements.
+
+=cut
+
+sub sql_list { #returns a flat list of comman-separates lists (for sql)
+  my($self)=@_;
+   grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}};
+}
+
+=item singles
+
+Returns a flat list of all single item lists.
+
+=cut
+
+sub singles { #returns single-field groups as a flat list
+  my($self)=@_;
+  #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}};
+  map { 
+    ${$_}[0] =~ /^(\w+)$/
+      #aah!
+      or die "Illegal column ", ${$_}[0], " in colgroup!";
+    $1;
+  } grep scalar(@{$_}) == 1, @{$self->{'lol'}};
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::dbdef_table>, L<FS::dbdef_unique>, L<FS::dbdef_index>,
+L<FS::dbdef_column>, L<FS::dbdef>, L<perldsc>
+
+=head1 HISTORY
+
+class for dealing with groups of groups of columns (used as a base class by
+FS::dbdef_{unique,index} )
+
+ivan@sisd.com 98-apr-19
+
+added singles, fixed sql_list to skip empty lists ivan@sisd.com 98-jun-2
+
+untaint things we're returning in sub singels ivan@sisd.com 98-jun-4
+
+pod ivan@sisd.com 98-sep-24
+
+=cut
+
+1;
+