diff options
Diffstat (limited to 'FS')
| -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 |
7 files changed, 13 insertions, 728 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; - - |