X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=site_perl%2FRecord.pm;h=0f098b471e65e894ea93fa1d784245685cb138d7;hp=87de48cc48ca3539d3e4f258981c3b754a3a58a5;hb=1f2d8690193476319d61b20b78461eb1a3ff106e;hpb=f408cf19344c7d128bf98ffd9667810ca9bebc1b diff --git a/site_perl/Record.pm b/site_perl/Record.pm index 87de48cc4..0f098b471 100644 --- a/site_perl/Record.pm +++ b/site_perl/Record.pm @@ -4,7 +4,7 @@ use strict; use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK); use subs qw(reload_dbdef); use Exporter; -use Carp; +use Carp qw(carp cluck croak confess); use File::CounterFile; use FS::UID qw(dbh checkruid swapuid getotaker datasrc); use FS::dbdef; @@ -12,11 +12,12 @@ use FS::dbdef; @ISA = qw(Exporter); @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); -$File::CounterFile::DEFAULT_DIR = "/var/spool/freeside/counters" ; - -$dbdef_file = "/var/spool/freeside/dbdef.". datasrc; - -reload_dbdef unless $setup_hack; +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::Record'} = sub { + $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc; + $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc; + &reload_dbdef unless $setup_hack; #$setup_hack needed now? +}; =head1 NAME @@ -25,7 +26,7 @@ FS::Record - Database record objects =head1 SYNOPSIS use FS::Record; - use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef); + use FS::Record qw(dbh fields qsearch qsearchs dbdef); $record = new FS::Record 'table', \%hash; $record = new FS::Record 'table', { 'column' => 'value', ... }; @@ -50,11 +51,14 @@ FS::Record - Database record objects $hashref = $record->hashref; - $error = $record->add; + $error = $record->insert; + #$error = $record->add; #depriciated - $error = $record->del; + $error = $record->delete; + #$error = $record->del; #depriciated - $error = $new_record->rep($old_record); + $error = $new_record->replace($old_record); + #$error = $new_record->rep($old_record); #depriciated $value = $record->unique('column'); @@ -79,7 +83,8 @@ FS::Record - Database record objects $fields = hfields('table'); if ( $fields->{Field} ) { # etc. - @fields = fields 'table'; + @fields = fields 'table'; #as a subroutine + @fields = $record->fields; #as a method call =head1 DESCRIPTION @@ -88,75 +93,68 @@ FS::Record - Database record objects implemented on top of DBI. FS::Record is intended as a base class for table-specific classes to inherit from, i.e. FS::cust_main. -=head1 METHODS +=head1 CONSTRUCTORS =over 4 -=item new TABLE, HASHREF +=item new [ TABLE, ] HASHREF Creates a new record. It doesn't store it in the database, though. See -L<"add"> for that. +L<"insert"> for that. Note that the object stores this hash reference, not a distinct copy of the hash it points to. You can ask the object for a copy with the I method. +TABLE can only be omitted when a dervived class overrides the table method. + =cut sub new { - my($proto,$table,$hashref) = @_; - confess "Second arguement to FS::Record->new is not a HASH ref: ", - ref($hashref), " ", $hashref, "\n" - unless ref($hashref) eq 'HASH'; #bad practice? + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); - #check to make sure $table exists? (ask dbdef) + $self->{'Table'} = shift unless defined ( $self->table ); - foreach my $field ( FS::Record::fields $table ) { - $hashref->{$field}='' unless defined $hashref->{$field}; - } + my $hashref = $self->{'Hash'} = shift; - # mySQL must rtrim the inbound text strings or store them z-terminated - # I simulate this for Postgres below - # Turned off in favor of ChopBlanks in UID.pm (see man DBI) - #if (datasrc =~ m/Pg/) - #{ - # foreach my $index (keys %$hashref) - # { - # $$hashref{$index} = unpack("A255", $$hashref{$index}) - # if ($$hashref{$index} =~ m/ $/) ; - # } - #} - - foreach my $column ( FS::Record::fields $table ) { - #trim the '$' from money fields for Pg (beong HERE?) + foreach my $field ( $self->fields ) { + $hashref->{$field}='' unless defined $hashref->{$field}; + #trim the '$' from money fields for Pg (belong HERE?) #(what about Pg i18n?) if ( datasrc =~ m/Pg/ - && $dbdef->table($table)->column($column)->type eq 'money' ) { - ${$hashref}{$column} =~ s/^\$//; + && $self->dbdef_table->column($field)->type eq 'money' ) { + ${$hashref}{$field} =~ s/^\$//; } - #foreach my $column ( grep $dbdef->table($table)->column($_)->type eq 'money', keys %{$hashref} ) { - # ${$hashref}{$column} =~ s/^\$//; - #} } - my $class = ref($proto) || $proto; - my $self = { 'Table' => $table, - 'Hash' => $hashref, - }; + $self; +} +sub create { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; bless ($self, $class); - + if ( defined $self->table ) { + cluck "create constructor is depriciated, use new!"; + $self->new(@_); + } else { + croak "FS::Record::create called (not from a subclass)!"; + } } =item qsearch TABLE, HASHREF Searches the database for all records matching (at least) the key/value pairs -in HASHREF. Returns all the records found as FS::Record objects. +in HASHREF. Returns all the records found as `FS::TABLE' objects if that +module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record +objects. =cut -# Usage: @records = &FS::Search::qsearch($table,\%hash); -# Each element of @records is a FS::Record object. sub qsearch { my($table,$record) = @_; my($dbh) = dbh; @@ -166,36 +164,50 @@ sub qsearch { my($sth); my($statement) = "SELECT * FROM $table". ( @fields ? " WHERE ". join(' AND ', - map("$_ = ". _quote($record->{$_},$table,$_), @fields) - ) - : '' + map { + $record->{$_} eq '' + ? "$_ IS NULL" + : "$_ = ". _quote($record->{$_},$table,$_) + } @fields + ) : '' ); $sth=$dbh->prepare($statement) or croak $dbh->errstr; #is that a little too harsh? hmm. - map { - new FS::Record ($table,$sth->fetchrow_hashref); - } ( 1 .. $sth->execute ); + if ( eval ' scalar(@FS::'. $table. '::ISA);' ) { + map { + eval 'new FS::'. $table. ' ( $sth->fetchrow_hashref );'; + } ( 1 .. $sth->execute ); + } else { + cluck "qsearch: warning: FS::$table not loaded; returning generic FS::Record objects"; + map { + new FS::Record ($table,$sth->fetchrow_hashref); + } ( 1 .. $sth->execute ); + } } =item qsearchs TABLE, HASHREF -Searches the database for a record matching (at least) the key/value pairs -in HASHREF, and returns the record found as an FS::Record object. If more than -one record matches, it Bs but returns the first. If this happens, you -either made a logic error in asking for a single item, or your data is -corrupted. +Same as qsearch, except that if more than one record matches, it Bs but +returns the first. If this happens, you either made a logic error in asking +for a single item, or your data is corrupted. =cut sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash); my(@result) = qsearch(@_); - carp "Multiple records in scalar search!" if scalar(@result) > 1; + carp "warning: Multiple records in scalar search!" if scalar(@result) > 1; #should warn more vehemently if the search was on a primary key? $result[0]; } +=back + +=head1 METHODS + +=over 4 + =item table Returns the table name. @@ -203,7 +215,8 @@ Returns the table name. =cut sub table { - my($self) = @_; +# cluck "warning: FS::Record::table depriciated; supply one in subclass!"; + my $self = shift; $self -> {'Table'}; } @@ -235,7 +248,8 @@ sub get { } } sub getfield { - get(@_); + my $self = shift; + $self->get(@_); } =item set, setfield COLUMN, VALUE @@ -249,7 +263,8 @@ sub set { $self->{'Hash'}->{$field} = $value; } sub setfield { - set(@_); + my $self = shift; + $self->set(@_); } =item AUTLOADED METHODS @@ -297,41 +312,41 @@ sub hashref { $self->{'Hash'}; } -=item add +=item insert -Adds this record to the database. If there is an error, returns the error, +Inserts this record to the database. If there is an error, returns the error, otherwise returns false. =cut -sub add { - my($self) = @_; - my($dbh)=dbh; - my($table)=$self->table; +sub insert { + my $self = shift; + + my $error = $self->check; + return $error if $error; #single-field unique keys are given a value if false #(like MySQL's AUTO_INCREMENT) - foreach ( $dbdef->table($table)->unique->singles ) { + foreach ( $self->dbdef_table->unique->singles ) { $self->unique($_) unless $self->getfield($_); } #and also the primary key - my($primary_key)=$dbdef->table($table)->primary_key; + my $primary_key = $self->dbdef_table->primary_key; $self->unique($primary_key) if $primary_key && ! $self->getfield($primary_key); - my (@fields) = + my @fields = grep defined($self->getfield($_)) && $self->getfield($_) ne "", - fields($table) + $self->fields ; - my($sth); - my($statement)="INSERT INTO $table ( ". + my $statement = "INSERT INTO ". $self->table. " ( ". join(', ',@fields ). ") VALUES (". - join(', ',map(_quote($self->getfield($_),$table,$_), @fields)). + join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)). ")" ; - $sth = $dbh->prepare($statement) or return $dbh->errstr; + my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -344,29 +359,37 @@ sub add { ''; } -=item del +=item add + +Depriciated (use insert instead). + +=cut + +sub add { + cluck "warning: FS::Record::add depriciated!"; + insert @_; #call method in this scope +} + +=item delete Delete this record from the database. If there is an error, returns the error, otherwise returns false. =cut -sub del { - my($self) = @_; - my($dbh)=dbh; - my($table)=$self->table; +sub delete { + my $self = shift; - my($sth); - my($statement)="DELETE FROM $table WHERE ". join(' AND ', + my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ', map { $self->getfield($_) eq '' ? "$_ IS NULL" - : "$_ = ". _quote($self->getfield($_),$table,$_) - } ( $dbdef->table($table)->primary_key ) - ? ($dbdef->table($table)->primary_key) - : fields($table) + : "$_ = ". _quote($self->getfield($_),$self->table,$_) + } ( $self->dbdef_table->primary_key ) + ? ( $self->dbdef_table->primary_key) + : $self->fields ); - $sth = $dbh->prepare($statement) or return $dbh->errstr; + my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -374,8 +397,7 @@ sub del { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - my($rc); - $rc=$sth->execute or return $sth->errstr; + my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0"; undef $self; #no need to keep object! @@ -383,48 +405,57 @@ sub del { ''; } -=item rep OLD_RECORD +=item del + +Depriciated (use delete instead). + +=cut + +sub del { + cluck "warning: FS::Record::del depriciated!"; + &delete(@_); #call method in this scope +} + +=item replace OLD_RECORD Replace the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. =cut -sub rep { - my($new,$old)=@_; - my($dbh)=dbh; - my($table)=$old->table; - my(@fields)=fields($table); - my(@diff)=grep $new->getfield($_) ne $old->getfield($_), @fields; +sub replace { + my ( $new, $old ) = ( shift, shift ); - if ( scalar(@diff) == 0 ) { - carp "Records identical"; + my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; + unless ( @diff ) { + carp "warning: records identical"; return ''; } - return "Records not in same table!" unless $new->table eq $table; + return "Records not in same table!" unless $new->table eq $old->table; - my($sth); - my($statement)="UPDATE $table SET ". join(', ', + my $primary_key = $old->dbdef_table->primary_key; + return "Can't change $primary_key" + if $primary_key + && ( $old->getfield($primary_key) ne $new->getfield($primary_key) ); + + my $error = $new->check; + return $error if $error; + + my $statement = "UPDATE ". $old->table. " SET ". join(', ', map { - "$_ = ". _quote($new->getfield($_),$table,$_) + "$_ = ". _quote($new->getfield($_),$old->table,$_) } @diff ). ' WHERE '. join(' AND ', map { $old->getfield($_) eq '' ? "$_ IS NULL" - : "$_ = ". _quote($old->getfield($_),$table,$_) -# } @fields -# } ( primary_key($table) ? (primary_key($table)) : @fields ) - } ( $dbdef->table($table)->primary_key - ? ($dbdef->table($table)->primary_key) - : @fields - ) + : "$_ = ". _quote($old->getfield($_),$old->table,$_) + } ( $primary_key ? ( $primary_key ) : $old->fields ) ) ; - #warn $statement; - $sth = $dbh->prepare($statement) or return $dbh->errstr; + my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -432,14 +463,34 @@ sub rep { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - my($rc); - $rc=$sth->execute or return $sth->errstr; + my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found (or records identical)." if $rc eq "0E0"; ''; } +=item rep + +Depriciated (use replace instead). + +=cut + +sub rep { + cluck "warning: FS::Record::rep depriciated!"; + replace @_; #call method in this scope +} + +=item check + +Not yet implemented, croaks. Derived classes should provide a check method. + +=cut + +sub check { + croak "FS::Record::check not implemented; supply one in subclass!"; +} + =item unique COLUMN Replaces COLUMN in record with a unique number. Called by the B method @@ -644,6 +695,29 @@ sub ut_anything { ''; } +=item fields [ TABLE ] + +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). + +=cut + +# Usage: @fields = fields($table); +# @fields = $record->fields; +sub fields { + my $something = shift; + my $table; + if ( ref($something) ) { + $table = $something->table; + } else { + $table = $something; + } + #croak "Usage: \@fields = fields(\$table)\n or: \@fields = \$record->fields" unless $table; + my($table_obj) = $dbdef->table($table); + croak "Unknown table $table" unless $table_obj; + $table_obj->columns; +} =head1 SUBROUTINES @@ -700,7 +774,7 @@ It returns a hash-type list with the fields of this record's table set true. =cut sub hfields { - carp "hfields is depriciated"; + carp "warning: hfields is depriciated"; my($table)=@_; my(%hash); foreach (fields($table)) { @@ -709,23 +783,6 @@ sub hfields { \%hash; } -=item fields TABLE - -This returns a list of the columns in this record's table -(See L). - -=cut - -# Usage: @fields = fields($table); -sub fields { - my($table) = @_; - #my(@fields) = $dbdef->table($table)->columns; - croak "Usage: \@fields = fields(\$table)" unless $table; - my($table_obj) = $dbdef->table($table); - croak "Unknown table $table" unless $table_obj; - $table_obj->columns; -} - #sub _dump { # my($self)=@_; # join("\n", map { @@ -746,6 +803,10 @@ sub fields { =back +=head1 VERSION + +$Id: Record.pm,v 1.10 1998-12-29 11:59:33 ivan Exp $ + =head1 BUGS This module should probably be renamed, since much of the functionality is @@ -768,7 +829,7 @@ The ut_ methods should ask the dbdef for a default length. ut_sqltype (like ut_varchar) should all be defined -A fallback check method should be provided with uses the dbdef. +A fallback check method should be provided whith uses the dbdef. The ut_money method assumes money has two decimal digits. @@ -780,6 +841,9 @@ The _quote function should probably use ut_float instead of a regex. All the subroutines probably should be methods, here or elsewhere. +Probably should borrow/use some dbdef methods where appropriate (like sub +fields) + =head1 SEE ALSO L, L, L @@ -863,7 +927,29 @@ added pod documentation ivan@sisd.com 98-sep-6 ut_phonen got ''; at the end ivan@sisd.com 98-sep-27 $Log: Record.pm,v $ -Revision 1.2 1998-11-07 05:17:18 ivan +Revision 1.10 1998-12-29 11:59:33 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.9 1998/11/21 07:26:45 ivan +"Records identical" carp tells us it is just a warning. + +Revision 1.8 1998/11/15 11:02:04 ivan +bugsquash + +Revision 1.7 1998/11/15 10:56:31 ivan +qsearch gets sames "IS NULL" semantics as other WHERE clauses + +Revision 1.6 1998/11/15 05:31:03 ivan +bugfix for new config layout + +Revision 1.5 1998/11/13 09:56:51 ivan +change configuration file layout to support multiple distinct databases (with +own set of config files, export, etc.) + +Revision 1.4 1998/11/10 07:45:25 ivan +doc clarification + +Revision 1.2 1998/11/07 05:17:18 ivan In sub new, Pg wrapper for money fields from dbdef (FS::Record::fields $table), not keys of supplied hashref.