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);
$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/\,//;
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 $_ = "" )-;
map {
$self->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
- ? ( driver_name eq 'Pg'
+ ? ( driver_name =~ /^Pg$/i
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
map {
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
- ? ( driver_name eq 'Pg'
+ ? ( driver_name =~ /^Pg$/i
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
=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
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
=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
=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
=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.
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
-
-$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
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
#!/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
# 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;
#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);
#!/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
#
# 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
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;
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) );
my($attribute);
foreach $attribute (@attributes) {
- $svc_acct->addcolumn ( new FS::dbdef_column (
+ $svc_acct->addcolumn ( new DBIx::DBSchema::Column (
'radius_'. $attribute,
'varchar',
'NULL',
}
foreach $attribute (@check_attributes) {
- $svc_acct->addcolumn( new FS::dbdef_column (
+ $svc_acct->addcolumn( new DBIx::DBSchema::Column (
'rc_'. $attribute,
'varchar',
'NULL',
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',
#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)
$dbh->disconnect or die $dbh->errstr;
+print "Freeside database initialized sucessfully\n";
+
sub usage {
die "Usage:\n fs-setup user\n";
}
projects / freeside.git / commitdiff