X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=5cf77d3e71a3997fe2419721a7046279ffaecb5b;hb=2dea7078530a565f2300b52b6d235b5eaf2df9e0;hp=c711f1214b26ea43c6905913bbb2b639489e4b9e;hpb=94494835be39e34474d8564a8cde9fdd389fcdbe;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index c711f1214..5cf77d3e7 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -9,8 +9,8 @@ use Carp qw(carp cluck croak confess); use File::CounterFile; use Locale::Country; use DBI qw(:sql_types); -use DBIx::DBSchema 0.21; -use FS::UID qw(dbh getotaker datasrc driver_name); +use DBIx::DBSchema 0.19; +use FS::UID qw(dbh checkruid getotaker datasrc driver_name); use FS::SearchCache; use FS::Msgcat qw(gettext); @@ -60,12 +60,14 @@ FS::Record - Database record objects $hashref = $record->hashref; $error = $record->insert; + #$error = $record->add; #deprecated $error = $record->delete; + #$error = $record->del; #deprecated $error = $new_record->replace($old_record); + #$error = $new_record->rep($old_record); #deprecated - # external use deprecated - handled by the database (at least for Pg, mysql) $value = $record->unique('column'); $error = $record->ut_float('column'); @@ -86,7 +88,7 @@ FS::Record - Database record objects $quoted_value = _quote($value,'table','field'); - #deprecated + #depriciated $fields = hfields('table'); if ( $fields->{Field} ) { # etc. @@ -165,7 +167,7 @@ sub create { my $self = {}; bless ($self, $class); if ( defined $self->table ) { - cluck "create constructor is deprecated, use new!"; + cluck "create constructor is depriciated, use new!"; $self->new(@_); } else { croak "FS::Record::create called (not from a subclass)!"; @@ -211,7 +213,7 @@ sub qsearch { my $column = $_; if ( ref($record->{$_}) ) { $op = $record->{$_}{'op'} if $record->{$_}{'op'}; - #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg'; + #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i; if ( uc($op) eq 'ILIKE' ) { $op = 'LIKE'; $record->{$_}{'value'} = lc($record->{$_}{'value'}); @@ -359,7 +361,7 @@ Returns the table name. =cut sub table { -# cluck "warning: FS::Record::table deprecated; supply one in subclass!"; +# cluck "warning: FS::Record::table depriciated; supply one in subclass!"; my $self = shift; $self -> {'Table'}; } @@ -486,40 +488,24 @@ sub insert { return $error if $error; #single-field unique keys are given a value if false - #(like MySQL's AUTO_INCREMENT or Pg SERIAL) + #(like MySQL's AUTO_INCREMENT) foreach ( $self->dbdef_table->unique->singles ) { $self->unique($_) unless $self->getfield($_); } - - #and also the primary key, if the database isn't going to + #and also the primary key my $primary_key = $self->dbdef_table->primary_key; - my $db_seq = 0; - if ( $primary_key ) { - my $col = $self->dbdef_table->column($primary_key); - - $db_seq = - uc($col->type) eq 'SERIAL' - || ( driver_name eq 'Pg' - && defined($col->default) - && $col->default =~ /^nextval\(/i - ) - || ( driver_name eq 'mysql' - && defined($col->local) - && $col->local =~ /AUTO_INCREMENT/i - ); - $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq; - } + $self->unique($primary_key) + if $primary_key && ! $self->getfield($primary_key); - my $table = $self->table; #false laziness w/delete my @fields = grep defined($self->getfield($_)) && $self->getfield($_) ne "", $self->fields ; - my @values = map { _quote( $self->getfield($_), $table, $_) } @fields; + my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; #eslaf - my $statement = "INSERT INTO $table ( ". + my $statement = "INSERT INTO ". $self->table. " ( ". join( ', ', @fields ). ") VALUES (". join( ', ', @values ). @@ -528,6 +514,15 @@ sub insert { warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; + my $h_sth; + if ( defined $dbdef->table('h_'. $self->table) ) { + my $h_statement = $self->_h_statement('insert'); + warn "[debug]$me $h_statement\n" if $DEBUG > 2; + $h_sth = dbh->prepare($h_statement) or return dbh->errstr; + } else { + $h_sth = ''; + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -536,64 +531,7 @@ sub insert { local $SIG{PIPE} = 'IGNORE'; $sth->execute or return $sth->errstr; - - if ( $db_seq ) { # get inserted id from the database, if applicable - warn "[debug]$me retreiving sequence from database\n" if $DEBUG; - my $insertid = ''; - if ( driver_name eq 'Pg' ) { - - my $oid = $sth->{'pg_oid_status'}; - my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?"; - my $i_sth = dbh->prepare($i_sql) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - $i_sth->execute($oid) or do { - dbh->rollback if $FS::UID::AutoCommit; - return $i_sth->errstr; - }; - $insertid = $i_sth->fetchrow_arrayref->[0]; - - } elsif ( driver_name eq 'mysql' ) { - - $insertid = dbh->{'mysql_insertid'}; - # work around mysql_insertid being null some of the time, ala RT :/ - unless ( $insertid ) { - warn "WARNING: DBD::mysql didn't return mysql_insertid; ". - "using SELECT LAST_INSERT_ID();"; - my $i_sql = "SELECT LAST_INSERT_ID()"; - my $i_sth = dbh->prepare($i_sql) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - $i_sth->execute or do { - dbh->rollback if $FS::UID::AutoCommit; - return $i_sth->errstr; - }; - $insertid = $i_sth->fetchrow_arrayref->[0]; - } - - } else { - dbh->rollback if $FS::UID::AutoCommit; - return "don't know how to retreive inserted ids from ". driver_name. - ", try using counterfiles (maybe run dbdef-create?)"; - } - $self->setfield($primary_key, $insertid); - } - - my $h_sth; - if ( defined $dbdef->table('h_'. $table) ) { - my $h_statement = $self->_h_statement('insert'); - warn "[debug]$me $h_statement\n" if $DEBUG > 2; - $h_sth = dbh->prepare($h_statement) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - } else { - $h_sth = ''; - } $h_sth->execute or return $h_sth->errstr if $h_sth; - dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; ''; @@ -606,7 +544,7 @@ Depriciated (use insert instead). =cut sub add { - cluck "warning: FS::Record::add deprecated!"; + cluck "warning: FS::Record::add depriciated!"; insert @_; #call method in this scope } @@ -624,7 +562,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -670,7 +608,7 @@ Depriciated (use delete instead). =cut sub del { - cluck "warning: FS::Record::del deprecated!"; + cluck "warning: FS::Record::del depriciated!"; &delete(@_); #call method in this scope } @@ -710,7 +648,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -763,7 +701,7 @@ Depriciated (use replace instead). =cut sub rep { - cluck "warning: FS::Record::rep deprecated!"; + cluck "warning: FS::Record::rep depriciated!"; replace @_; #call method in this scope } @@ -796,13 +734,8 @@ sub _h_statement { =item unique COLUMN -B: External use is B. - -Replaces COLUMN in record with a unique number, using counters in the -filesystem. Used by the B method on single-field unique columns -(see L) and also as a fallback for primary keys -that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql). - +Replaces COLUMN in record with a unique number. Called by the B method +on primary keys and single-field unique columns (see L). Returns the new value. =cut @@ -811,6 +744,8 @@ sub unique { my($self,$field) = @_; my($table)=$self->table; + #croak("&FS::UID::checkruid failed") unless &checkruid; + croak "Unique called on field $field, but it is ", $self->getfield($field), ", not null!" @@ -826,8 +761,9 @@ sub unique { # my($counter) = new File::CounterFile "$user/$table.$field",0; # endhack - my $index = $counter->inc; - $index = $counter->inc while qsearchs($table, { $field=>$index } ); + my($index)=$counter->inc; + $index=$counter->inc + while qsearchs($table,{$field=>$index}); #just in case $index =~ /^(\d*)$/; $index=$1; @@ -1231,28 +1167,36 @@ type (see L) does not end in `char' or `binary'. =cut sub _quote { - my($value,$table,$field)=@_; - my($dbh)=dbh; - if ( $value =~ /^\d+(\.\d+)?$/ && -# ! ( datatype($table,$field) =~ /^char/ ) - ! $dbdef->table($table)->column($field)->type =~ /(char|binary|text)$/i - ) { + my($value, $table, $column) = @_; + my $column_obj = $dbdef->table($table)->column($column); + my $column_type = $column_obj->type; + + if ( $value eq '' && $column_type =~ /^int/ ) { + if ( $column_obj->null ) { + 'NULL'; + } else { + cluck "WARNING: Attempting to set non-null integer $table.$column null; ". + "using 0 instead"; + 0; + } + } elsif ( $value =~ /^\d+(\.\d+)?$/ && + ! $column_type =~ /(char|binary|text)$/i ) { $value; } else { - $dbh->quote($value); + dbh->quote($value); } } =item hfields TABLE -This is deprecated. Don't use it. +This is depriciated. Don't use it. It returns a hash-type list with the fields of this record's table set true. =cut sub hfields { - carp "warning: hfields is deprecated"; + carp "warning: hfields is depriciated"; my($table)=@_; my(%hash); foreach (fields($table)) { @@ -1288,7 +1232,7 @@ sub DESTROY { return; } This module should probably be renamed, since much of the functionality is of general use. It is not completely unlike Adapter::DBI (see below). -Exported qsearch and qsearchs should be deprecated in favor of method calls +Exported qsearch and qsearchs should be depriciated in favor of method calls (against an FS::Record object like the old search and searchs that qsearch and qsearchs were on top of.) @@ -1296,7 +1240,7 @@ The whole fields / hfields mess should be removed. The various WHERE clauses should be subroutined. -table string should be deprecated in favor of DBIx::DBSchema::Table. +table string should be depriciated in favor of DBIx::DBSchema::Table. No doubt we could benefit from a Tied hash. Documenting how exists / defined true maps to the database (and WHERE clauses) would also help.