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.23;
+use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
$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');
$quoted_value = _quote($value,'table','field');
- #deprecated
+ #depriciated
$fields = hfields('table');
if ( $fields->{Field} ) { # etc.
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)!";
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'});
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( $op eq '=' ) {
if ( driver_name eq 'Pg' ) {
- qq-( $column IS NULL OR $column = '' )-;
+ my $type = $dbdef->table($table)->column($column)->type;
+ if ( $type =~ /(int|serial)/i ) {
+ qq-( $column IS NULL )-;
+ } else {
+ qq-( $column IS NULL OR $column = '' )-;
+ }
} else {
qq-( $column IS NULL OR $column = "" )-;
}
} elsif ( $op eq '!=' ) {
if ( driver_name eq 'Pg' ) {
- qq-( $column IS NOT NULL AND $column != '' )-;
+ my $type = $dbdef->table($table)->column($column)->type;
+ if ( $type =~ /(int|serial)/i ) {
+ qq-( $column IS NOT NULL )-;
+ } else {
+ qq-( $column IS NOT NULL AND $column != '' )-;
+ }
} else {
qq-( $column IS NOT NULL AND $column != "" )-;
}
grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
) {
if ( $record->{$field} =~ /^\d+(\.\d+)?$/
- && $dbdef->table($table)->column($field)->type =~ /(int)/i
+ && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
) {
$sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
} else {
=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'};
}
$field =~ s/.*://;
if ( defined($value) ) {
confess "errant AUTOLOAD $field for $self (arg $value)"
- unless $self->can('setfield');
+ unless ref($self) && $self->can('setfield');
$self->setfield($field,$value);
} else {
confess "errant AUTOLOAD $field for $self (no args)"
- unless $self->can('getfield');
+ unless ref($self) && $self->can('getfield');
$self->getfield($field);
}
}
sub hash {
my($self) = @_;
+ confess $self. ' -> hash: Hash attribute is undefined'
+ unless defined($self->{'Hash'});
%{ $self->{'Hash'} };
}
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 ).
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';
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;
'';
=cut
sub add {
- cluck "warning: FS::Record::add deprecated!";
+ cluck "warning: FS::Record::add depriciated!";
insert @_; #call method in this scope
}
map {
$self->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
- ? ( driver_name eq 'Pg'
+ ? ( driver_name =~ /^Pg$/i
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
=cut
sub del {
- cluck "warning: FS::Record::del deprecated!";
+ cluck "warning: FS::Record::del depriciated!";
&delete(@_); #call method in this scope
}
=cut
sub replace {
- my ( $new, $old ) = ( shift, shift );
+ my $new = shift;
+
+ my $old;
+ if ( @_ ) {
+ $old = shift;
+ } else {
+ warn "[debug]$me replace called with no arguments; autoloading old record\n"
+ if $DEBUG;
+ my $primary_key = $new->dbdef_table->primary_key;
+ if ( $primary_key ) {
+ $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } )
+ or croak "can't find ". $new->table. ".$primary_key ".
+ $new->$primary_key();
+ } else {
+ croak $new->table. " has no primary key; pass old record as argument";
+ }
+ }
+
warn "[debug]$me $new ->replace $old\n" if $DEBUG;
return "Records not in same table!" unless $new->table eq $old->table;
map {
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
- ? ( driver_name eq 'Pg'
- ? "$_ IS NULL"
+ ? ( driver_name =~ /^Pg$/i
+ ? "( $_ IS NULL OR $_ = '' ) "
: "( $_ IS NULL OR $_ = \"\" )"
)
: "$_ = ". _quote($old->getfield($_),$old->table,$_)
=cut
sub rep {
- cluck "warning: FS::Record::rep deprecated!";
+ cluck "warning: FS::Record::rep depriciated!";
replace @_; #call method in this scope
}
=item unique COLUMN
-B<Warning>: External use is B<deprecated>.
-
-Replaces COLUMN in record with a unique number, using counters in the
-filesystem. Used by the B<insert> method on single-field unique columns
-(see L<DBIx::DBSchema::Table>) 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<add> method
+on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>).
Returns the new value.
=cut
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!"
# 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;
'';
}
+=item ut_snumber COLUMN
+
+Check/untaint signed numeric data (whole numbers). May not be null. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_snumber {
+ my($self, $field) = @_;
+ $self->getfield($field) =~ /^(-?)\s*(\d+)$/
+ or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
+ $self->setfield($field, "$1$2");
+ '';
+}
+
=item ut_number COLUMN
Check/untaint simple numeric data (whole numbers). May not be null. If there
$self->getfield($field);
$self->setfield($field,$1);
} else {
- $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
- or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
- $self->setfield($field,$1);
+ if ( $self->getfield($field) =~ /^\s*$/ ) {
+ $self->setfield($field,'');
+ } else {
+ $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+ or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ }
}
'';
}
=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)) {
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.)
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.