diff options
| -rw-r--r-- | FS/FS/Record.pm | 26 | ||||
| -rw-r--r-- | FS/FS/dbdef.pm | 140 | ||||
| -rw-r--r-- | FS/FS/dbdef_colgroup.pm | 95 | ||||
| -rw-r--r-- | FS/FS/dbdef_column.pm | 174 | ||||
| -rw-r--r-- | FS/FS/dbdef_index.pm | 35 | ||||
| -rw-r--r-- | FS/FS/dbdef_table.pm | 235 | ||||
| -rw-r--r-- | FS/FS/dbdef_unique.pm | 36 | ||||
| -rw-r--r-- | TODO | 4 | ||||
| -rwxr-xr-x | bin/dbdef-create | 76 | ||||
| -rwxr-xr-x | bin/fs-setup | 54 |
10 files changed, 47 insertions, 828 deletions
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index b5f33e12b..113e1a18d 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -6,8 +6,8 @@ use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); use File::CounterFile; +use DBIx::DBSchema; use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name); -use FS::dbdef; @ISA = qw(Exporter); @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); @@ -126,7 +126,7 @@ sub new { $hashref->{$field}='' unless defined $hashref->{$field}; #trim the '$' and ',' from money fields for Pg (belong HERE?) #(what about Pg i18n?) - if ( driver_name eq 'Pg' + if ( driver_name =~ /^Pg$/i && $self->dbdef_table->column($field)->type eq 'money' ) { ${$hashref}{$field} =~ s/^\$//; ${$hashref}{$field} =~ s/\,//; @@ -178,7 +178,7 @@ sub qsearch { if ( @fields ) { $statement .= ' WHERE '. join(' AND ', map { if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { - if ( driver_name eq 'Pg' ) { + if ( driver_name =~ /^Pg$/i ) { "$_ IS NULL"; } else { qq-( $_ IS NULL OR $_ = "" )-; @@ -419,7 +419,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -492,7 +492,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -541,7 +541,7 @@ sub check { =item unique COLUMN Replaces COLUMN in record with a unique number. Called by the B<add> method -on primary keys and single-field unique columns (see L<FS::dbdef_table>). +on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>). Returns the new value. =cut @@ -805,7 +805,7 @@ sub ut_anything { This can be used as both a subroutine and a method call. It returns a list of the columns in this record's table, or an explicitly specified table. -(See L<FS::dbdef_table>). +(See L<DBIx::DBSchema::Table>). =cut @@ -831,15 +831,15 @@ sub fields { =item reload_dbdef([FILENAME]) -Load a database definition (see L<FS::dbdef>), optionally from a non-default -filename. This command is executed at startup unless -I<$FS::Record::setup_hack> is true. Returns a FS::dbdef object. +Load a database definition (see L<DBIx::DBSchema>), optionally from a +non-default filename. This command is executed at startup unless +I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object. =cut sub reload_dbdef { my $file = shift || $dbdef_file; - $dbdef = load FS::dbdef ($file); + $dbdef = load DBIx::DBSchema $file; } =item dbdef @@ -913,7 +913,7 @@ sub DESTROY { return; } =head1 VERSION -$Id: Record.pm,v 1.13 2001-02-20 16:31:06 ivan Exp $ +$Id: Record.pm,v 1.14 2001-04-15 12:56:30 ivan Exp $ =head1 BUGS @@ -958,7 +958,7 @@ be fixed. (only affects RDBMS which return uppercase column names) =head1 SEE ALSO -L<FS::dbdef>, L<FS::UID>, L<DBI> +L<DBIx::DBSchema>, L<FS::UID>, L<DBI> Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan. diff --git a/FS/FS/dbdef.pm b/FS/FS/dbdef.pm deleted file mode 100644 index b737fd53a..000000000 --- a/FS/FS/dbdef.pm +++ /dev/null @@ -1,140 +0,0 @@ -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>, - -=cut - -1; - diff --git a/FS/FS/dbdef_colgroup.pm b/FS/FS/dbdef_colgroup.pm deleted file mode 100644 index c25b07ada..000000000 --- a/FS/FS/dbdef_colgroup.pm +++ /dev/null @@ -1,95 +0,0 @@ -package FS::dbdef_colgroup; - -use strict; -use vars qw(@ISA); -use Exporter; - -@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> - -=cut - -1; - diff --git a/FS/FS/dbdef_column.pm b/FS/FS/dbdef_column.pm deleted file mode 100644 index e784e8495..000000000 --- a/FS/FS/dbdef_column.pm +++ /dev/null @@ -1,174 +0,0 @@ -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> or L<DBD::Pg>, will use -engine-specific syntax. - -=cut - -sub line { - my($self,$datasrc)=@_; - my($null)=$self->null; - if ( $datasrc =~ /mysql/ ) { #yucky mysql hack - $null ||= "NOT NULL" - } - if ( $datasrc =~ /Pg/ ) { #yucky Pg hack - $null ||= "NOT NULL"; - $null =~ s/^NULL$//; - } - 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 VERSION - -$Id: dbdef_column.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ - -=cut - -1; - diff --git a/FS/FS/dbdef_index.pm b/FS/FS/dbdef_index.pm deleted file mode 100644 index 49bf51dd9..000000000 --- a/FS/FS/dbdef_index.pm +++ /dev/null @@ -1,35 +0,0 @@ -package FS::dbdef_index; - -use strict; -use vars qw(@ISA); -use FS::dbdef_colgroup; - -@ISA=qw(FS::dbdef_colgroup); - -=head1 NAME - -FS::dbdef_unique.pm - Index object - -=head1 SYNOPSIS - - use FS::dbdef_index; - - # see FS::dbdef_colgroup methods - -=head1 DESCRIPTION - -FS::dbdef_unique objects represent the (non-unique) indices of a table -(L<FS::dbdef_table>). FS::dbdef_unique inherits from FS::dbdef_colgroup. - -=head1 BUGS - -Is this empty subclass needed? - -=head1 SEE ALSO - -L<FS::dbdef_colgroup>, L<FS::dbdef_record>, L<FS::Record> - -=cut - -1; - diff --git a/FS/FS/dbdef_table.pm b/FS/FS/dbdef_table.pm deleted file mode 100644 index 4b6d6619a..000000000 --- a/FS/FS/dbdef_table.pm +++ /dev/null @@ -1,235 +0,0 @@ -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) = $self->name. "__". $_ . "_index"; - $index =~ s/,\s*/_/g; - "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)" - } $self->unique->sql_list ), - ( map { - my($index) = $self->name. "__". $_ . "_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 VERSION - -$Id: dbdef_table.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ - -=cut - -1; - diff --git a/FS/FS/dbdef_unique.pm b/FS/FS/dbdef_unique.pm deleted file mode 100644 index fa28d585d..000000000 --- a/FS/FS/dbdef_unique.pm +++ /dev/null @@ -1,36 +0,0 @@ -package FS::dbdef_unique; - -use strict; -use vars qw(@ISA); -use FS::dbdef_colgroup; - -@ISA=qw(FS::dbdef_colgroup); - -=head1 NAME - -FS::dbdef_unique.pm - Unique object - -=head1 SYNOPSIS - - use FS::dbdef_unique; - - # see FS::dbdef_colgroup methods - -=head1 DESCRIPTION - -FS::dbdef_unique objects represent the unique indices of a database table -(L<FS::dbdef_table>). FS::dbdef_unique inherits from FS::dbdef_colgroup. - -=head1 BUGS - -Is this empty subclass needed? - -=head1 SEE ALSO - -L<FS::dbdef_colgroup>, L<FS::dbdef_record>, L<FS::Record> - -=cut - -1; - - @@ -1,4 +1,4 @@ -$Id: TODO,v 1.60 2001-04-15 10:33:40 ivan Exp $ +$Id: TODO,v 1.61 2001-04-15 12:56:30 ivan Exp $ If you are interested in helping with any of these, please join the *development* mailing list (send a blank message to @@ -10,8 +10,6 @@ ivan-freeside-devel-subscribe@sisd.com) to avoid duplication of effort. for 1.3.0: ******** -move to DBIx::DBSchema. (gets non-MySQL-specific dbdef-create) - finish transactions (svc_*.pm, fs_register/) Pg-style or universal-style locking in fs_sessmon FS/FS/nas.pm, or rewrite it diff --git a/bin/dbdef-create b/bin/dbdef-create index fe7475bec..902f7f145 100755 --- a/bin/dbdef-create +++ b/bin/dbdef-create @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: dbdef-create,v 1.2 1998-11-19 11:17:44 ivan Exp $ +# $Id: dbdef-create,v 1.3 2001-04-15 12:56:31 ivan Exp $ # # create dbdef file for existing mySQL database (needs SHOW|DESCRIBE command # not in Pg) based on fs-setup @@ -8,14 +8,17 @@ # ivan@sisd.com 98-jun-2 # # $Log: dbdef-create,v $ -# Revision 1.2 1998-11-19 11:17:44 ivan +# Revision 1.3 2001-04-15 12:56:31 ivan +# s/dbdef/DBIx::DBSchema/ +# +# Revision 1.2 1998/11/19 11:17:44 ivan # adminsuidsetup requires argument # use strict; use DBI; -use FS::dbdef; -use FS::UID qw(adminsuidsetup datasrc); +use DBIx::DBSchema; +use FS::UID qw(adminsuidsetup datasrc driver_name); my $user = shift or die &usage; @@ -24,70 +27,7 @@ my($dbh)=adminsuidsetup $user; #needs to match FS::Record my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc; -my($tables_sth)=$dbh->prepare("SHOW TABLES"); -my($tables_rv)=$tables_sth->execute; - -my(@tables); -foreach ( @{$tables_sth->fetchall_arrayref} ) { - my($table)=${$_}[0]; - #print "TABLE\t$table\n"; - - my($index_sth)=$dbh->prepare("SHOW INDEX FROM $table"); - my($primary_key)=''; - my(%index,%unique); - for ( 1 .. $index_sth->execute ) { - my($row)=$index_sth->fetchrow_hashref; - if ( ${$row}{'Key_name'} eq "PRIMARY" ) { - $primary_key=${$row}{'Column_name'}; - next; - } - if ( ${$row}{'Non_unique'} ) { #index - push @{$index{${$row}{'Key_name'}}}, ${$row}{'Column_name'}; - } else { #unique - push @{$unique{${$row}{'Key_name'}}}, ${$row}{'Column_name'}; - } - } - - my(@index)=values %index; - my(@unique)=values %unique; - #print "\tPRIMARY KEY $primary_key\n"; - foreach (@index) { - #print "\tINDEX\t", join(', ', @{$_}), "\n"; - } - foreach (@unique) { - #print "\tUNIQUE\t", join(', ', @{$_}), "\n"; - } - - my($columns_sth)=$dbh->prepare("SHOW COLUMNS FROM $table"); - my(@columns); - for ( 1 .. $columns_sth->execute ) { - my($row)=$columns_sth->fetchrow_hashref; - #print "\t", ${$row}{'Field'}, "\n"; - ${$row}{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/ - or die "Illegal type ${$row}{'Type'}\n"; - my($type,$length)=($1,$2); - my($null)=${$row}{'Null'}; - $null =~ s/YES/NULL/; - push @columns, new FS::dbdef_column ( - ${$row}{'Field'}, - $type, - $null, - $length, - ); - } - - #print "\n"; - push @tables, new FS::dbdef_table ( - $table, - $primary_key, - new FS::dbdef_unique (\@unique), - new FS::dbdef_index (\@index), - @columns, - ); - -} - -my($dbdef) = new FS::dbdef ( @tables ); +my $dbdef = new_native DBIx::DBSchema $dbh; #important $dbdef->save($dbdef_file); diff --git a/bin/fs-setup b/bin/fs-setup index b91633bf4..545c6a4df 100755 --- a/bin/fs-setup +++ b/bin/fs-setup @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: fs-setup,v 1.35 2001-04-15 09:36:43 ivan Exp $ +# $Id: fs-setup,v 1.36 2001-04-15 12:56:31 ivan Exp $ # # ivan@sisd.com 97-nov-8,9 # @@ -32,7 +32,10 @@ # fix radius attributes ivan@sisd.com 98-sep-27 # # $Log: fs-setup,v $ -# Revision 1.35 2001-04-15 09:36:43 ivan +# Revision 1.36 2001-04-15 12:56:31 ivan +# s/dbdef/DBIx::DBSchema/ +# +# Revision 1.35 2001/04/15 09:36:43 ivan # http://www.sisd.com/freeside/list-archive/msg01450.html # # Revision 1.34 2001/04/09 23:05:16 ivan @@ -135,7 +138,11 @@ BEGIN { $FS::Record::setup_hack = 1; } use strict; use DBI; -use FS::dbdef; +use DBIx::DBSchema; +use DBIx::DBSchema::Table; +use DBIx::DBSchema::Column; +use DBIx::DBSchema::ColGroup::Unique; +use DBIx::DBSchema::ColGroup::Index; use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets); use FS::Record; use FS::cust_main_county; @@ -189,19 +196,17 @@ my @money_type = ( 'decimal', '', '10,2' ); my(%tables)=&tables_hash_hack; #turn it into objects -my($dbdef) = new FS::dbdef ( map { +my($dbdef) = new DBIx::DBSchema ( map { my(@columns); while (@{$tables{$_}{'columns'}}) { my($name,$type,$null,$length)=splice @{$tables{$_}{'columns'}}, 0, 4; - push @columns, new FS::dbdef_column ( $name,$type,$null,$length ); + push @columns, new DBIx::DBSchema::Column ( $name,$type,$null,$length ); } - FS::dbdef_table->new( + DBIx::DBSchema::Table->new( $_, $tables{$_}{'primary_key'}, - #FS::dbdef_unique->new(@{$tables{$_}{'unique'}}), - #FS::dbdef_index->new(@{$tables{$_}{'index'}}), - FS::dbdef_unique->new($tables{$_}{'unique'}), - FS::dbdef_index->new($tables{$_}{'index'}), + DBIx::DBSchema::ColGroup::Unique->new($tables{$_}{'unique'}), + DBIx::DBSchema::ColGroup::Index->new($tables{$_}{'index'}), @columns, ); } (keys %tables) ); @@ -212,7 +217,7 @@ my($svc_acct)=$dbdef->table('svc_acct'); my($attribute); foreach $attribute (@attributes) { - $svc_acct->addcolumn ( new FS::dbdef_column ( + $svc_acct->addcolumn ( new DBIx::DBSchema::Column ( 'radius_'. $attribute, 'varchar', 'NULL', @@ -221,7 +226,7 @@ foreach $attribute (@attributes) { } foreach $attribute (@check_attributes) { - $svc_acct->addcolumn( new FS::dbdef_column ( + $svc_acct->addcolumn( new DBIx::DBSchema::Column ( 'rc_'. $attribute, 'varchar', 'NULL', @@ -241,13 +246,13 @@ foreach (qw(svc_acct svc_acct_sm svc_domain svc_www)) { my($col); foreach $col ( $table->columns ) { next if $col =~ /^svcnum$/; - $part_svc->addcolumn( new FS::dbdef_column ( + $part_svc->addcolumn( new DBIx::DBSchema::Column ( $table->name. '__' . $table->column($col)->name, 'varchar', #$table->column($col)->type, 'NULL', $char_d, #$table->column($col)->length, )); - $part_svc->addcolumn ( new FS::dbdef_column ( + $part_svc->addcolumn ( new DBIx::DBSchema::Column ( $table->name. '__'. $table->column($col)->name . "_flag", 'char', 'NULL', @@ -269,21 +274,10 @@ my($dbh)=adminsuidsetup $user; #create tables $|=1; -my($table); -foreach ($dbdef->tables) { - my($table)=$dbdef->table($_); - print "Creating $_..."; - - my($statement); - - #create table - foreach $statement ($table->sql_create_table(datasrc)) { - #print $statement, "\n"; - $dbh->do( $statement ) - or die "CREATE error: ",$dbh->errstr, "\ndoing statement: $statement"; - } - - print "\n"; +my @sql = $dbdef->sql($dbh); +foreach my $statement ( $dbdef->sql($dbh) ) { + $dbh->do( $statement ) + or die "CREATE error: ",$dbh->errstr, "\ndoing statement: $statement"; } #not really sample data (and shouldn't default to US) @@ -344,6 +338,8 @@ YE YU ZR ZM ZW $dbh->disconnect or die $dbh->errstr; +print "Freeside database initialized sucessfully\n"; + sub usage { die "Usage:\n fs-setup user\n"; } |