use strict;
use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $me %dbdef_cache );
+ $me %dbdef_cache %virtual_fields_cache );
use subs qw(reload_dbdef);
use Exporter;
use Carp qw(carp cluck croak confess);
use File::CounterFile;
use Locale::Country;
use DBI qw(:sql_types);
-use DBIx::DBSchema 0.21;
+use DBIx::DBSchema 0.23;
use FS::UID qw(dbh getotaker datasrc driver_name);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
+use FS::part_virtual_field;
+
+use Tie::IxHash;
+
@ISA = qw(Exporter);
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
my $dbh = dbh;
my $table = $cache ? $cache->table : $stable;
+ my $dbdef_table = $dbdef->table($table)
+ or die "No schema for table $table found - ".
+ "do you need to create it or run dbdef-create?";
+ my $pkey = $dbdef_table->primary_key;
- my @fields = grep exists($record->{$_}), fields($table);
+ my @real_fields = grep exists($record->{$_}), real_fields($table);
+ my @virtual_fields;
+ if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+ @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
+ } else {
+ cluck "warning: FS::$table not loaded; virtual fields not searchable";
+ @virtual_fields = ();
+ }
my $statement = "SELECT $select FROM $stable";
- if ( @fields ) {
- $statement .= ' WHERE '. join(' AND ', map {
+ if ( @real_fields or @virtual_fields ) {
+ $statement .= ' WHERE '. join(' AND ',
+ ( map {
my $op = '=';
my $column = $_;
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( $op eq '=' ) {
if ( driver_name eq 'Pg' ) {
- if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) {
+ my $type = $dbdef->table($table)->column($column)->type;
+ if ( $type =~ /(int|serial)/i ) {
qq-( $column IS NULL )-;
} else {
qq-( $column IS NULL OR $column = '' )-;
}
} elsif ( $op eq '!=' ) {
if ( driver_name eq 'Pg' ) {
- if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) {
+ 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 {
"$column $op ?";
}
- } @fields );
+ } @real_fields ),
+ ( map {
+ my $op = '=';
+ my $column = $_;
+ if ( ref($record->{$_}) ) {
+ $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+ if ( uc($op) eq 'ILIKE' ) {
+ $op = 'LIKE';
+ $record->{$_}{'value'} = lc($record->{$_}{'value'});
+ $column = "LOWER($_)";
+ }
+ $record->{$_} = $record->{$_}{'value'};
+ }
+
+ # ... EXISTS ( SELECT name, value FROM part_virtual_field
+ # JOIN virtual_field
+ # ON part_virtual_field.vfieldpart = virtual_field.vfieldpart
+ # WHERE recnum = svc_acct.svcnum
+ # AND (name, value) = ('egad', 'brain') )
+
+ my $value = $record->{$_};
+
+ my $subq;
+
+ $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') .
+ "( SELECT part_virtual_field.name, virtual_field.value ".
+ "FROM part_virtual_field JOIN virtual_field ".
+ "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ".
+ "WHERE virtual_field.recnum = ${table}.${pkey} ".
+ "AND part_virtual_field.name = '${column}'".
+ ($value ?
+ " AND virtual_field.value ${op} '${value}'"
+ : "") . ")";
+ $subq;
+
+ } @virtual_fields ) );
+
}
+
$statement .= " $extra_sql" if defined($extra_sql);
warn "[debug]$me $statement\n" if $DEBUG > 1;
my $bind = 1;
foreach my $field (
- grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
+ grep defined( $record->{$_} ) && $record->{$_} ne '', @real_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 {
$sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
- $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
+ if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+ @virtual_fields = "FS::$table"->virtual_fields;
+ } else {
+ cluck "warning: FS::$table not loaded; virtual fields not returned either";
+ @virtual_fields = ();
+ }
+
+ my %result;
+ tie %result, "Tie::IxHash";
+ my @stuff = @{ $sth->fetchall_arrayref( {} ) };
+ if($pkey) {
+ %result = map { $_->{$pkey}, $_ } @stuff;
+ } else {
+ @result{@stuff} = @stuff;
+ }
+ $sth->finish;
+
+ if ( keys(%result) and @virtual_fields ) {
+ $statement =
+ "SELECT virtual_field.recnum, part_virtual_field.name, ".
+ "virtual_field.value ".
+ "FROM part_virtual_field JOIN virtual_field USING (vfieldpart) ".
+ "WHERE part_virtual_field.dbtable = '$table' AND ".
+ "virtual_field.recnum IN (".
+ join(',', keys(%result)). ") AND part_virtual_field.name IN ('".
+ join(q!', '!, @virtual_fields) . "')";
+ warn "[debug]$me $statement\n" if $DEBUG > 1;
+ $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement";
+ $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
+
+ foreach (@{ $sth->fetchall_arrayref({}) }) {
+ my $recnum = $_->{recnum};
+ my $name = $_->{name};
+ my $value = $_->{value};
+ if (exists($result{$recnum})) {
+ $result{$recnum}->{$name} = $value;
+ }
+ }
+ }
+
if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
#derivied class didn't override new method, so this optimization is safe
if ( $cache ) {
map {
new_or_cached( "FS::$table", { %{$_} }, $cache )
- } @{$sth->fetchall_arrayref( {} )};
+ } values(%result);
} else {
map {
new( "FS::$table", { %{$_} } )
- } @{$sth->fetchall_arrayref( {} )};
+ } values(%result);
}
} else {
warn "untested code (class FS::$table uses custom new method)";
map {
eval 'FS::'. $table. '->new( { %{$_} } )';
- } @{$sth->fetchall_arrayref( {} )};
+ } values(%result);
}
} else {
cluck "warning: FS::$table not loaded; returning FS::Record objects";
map {
FS::Record->new( $table, { %{$_} } );
- } @{$sth->fetchall_arrayref( {} )};
+ } values(%result);
}
}
$field =~ s/.*://;
if ( defined($value) ) {
confess "errant AUTOLOAD $field for $self (arg $value)"
- unless $ref($self) && $self->can('setfield');
+ unless ref($self) && $self->can('setfield');
$self->setfield($field,$value);
} else {
confess "errant AUTOLOAD $field for $self (no args)"
sub hash {
my($self) = @_;
+ confess $self. ' -> hash: Hash attribute is undefined'
+ unless defined($self->{'Hash'});
%{ $self->{'Hash'} };
}
my $table = $self->table;
#false laziness w/delete
- my @fields =
+ my @real_fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- $self->fields
+ real_fields($table)
;
- my @values = map { _quote( $self->getfield($_), $table, $_) } @fields;
+ my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
#eslaf
my $statement = "INSERT INTO $table ( ".
- join( ', ', @fields ).
+ join( ', ', @real_fields ).
") VALUES (".
join( ', ', @values ).
")"
$sth->execute or return $sth->errstr;
+ my $insertid = '';
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'};
$self->setfield($primary_key, $insertid);
}
+ my @virtual_fields =
+ grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+ $self->virtual_fields;
+ if (@virtual_fields) {
+ my %v_values = map { $_, $self->getfield($_) } @virtual_fields;
+
+ my $vfieldpart = $self->vfieldpart_hashref;
+
+ my $v_statement = "INSERT INTO virtual_field(recnum, vfieldpart, value) ".
+ "VALUES (?, ?, ?)";
+
+ my $v_sth = dbh->prepare($v_statement) or do {
+ dbh->rollback if $FS::UID::AutoCommit;
+ return dbh->errstr;
+ };
+
+ foreach (keys(%v_values)) {
+ $v_sth->execute($self->getfield($primary_key),
+ $vfieldpart->{$_},
+ $v_values{$_})
+ or do {
+ dbh->rollback if $FS::UID::AutoCommit;
+ return $v_sth->errstr;
+ };
+ }
+ }
+
+
my $h_sth;
if ( defined $dbdef->table('h_'. $table) ) {
my $h_statement = $self->_h_statement('insert');
: "$_ = ". _quote($self->getfield($_),$self->table,$_)
} ( $self->dbdef_table->primary_key )
? ( $self->dbdef_table->primary_key)
- : $self->fields
+ : real_fields($self->table)
);
warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = dbh->prepare($statement) or return dbh->errstr;
$h_sth = '';
}
+ my $primary_key = $self->dbdef_table->primary_key;
+ my $v_sth;
+ my @del_vfields;
+ my $vfp = $self->vfieldpart_hashref;
+ foreach($self->virtual_fields) {
+ next if $self->getfield($_) eq '';
+ unless(@del_vfields) {
+ my $st = "DELETE FROM virtual_field WHERE recnum = ? AND vfieldpart = ?";
+ $v_sth = dbh->prepare($st) or return dbh->errstr;
+ }
+ push @del_vfields, $_;
+ }
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
$h_sth->execute or return $h_sth->errstr if $h_sth;
+ $v_sth->execute($self->getfield($primary_key), $vfp->{$_})
+ or return $v_sth->errstr
+ foreach (@del_vfields);
+
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
#no need to needlessly destoy the data either (causes problems actually)
=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;
my $error = $new->check;
return $error if $error;
- my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
- unless ( @diff ) {
+ #my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
+ my %diff = map { ($new->getfield($_) ne $old->getfield($_))
+ ? ($_, $new->getfield($_)) : () } $old->fields;
+
+ unless ( keys(%diff) ) {
carp "[warning]$me $new -> replace $old: records identical";
return '';
}
my $statement = "UPDATE ". $old->table. " SET ". join(', ',
map {
"$_ = ". _quote($new->getfield($_),$old->table,$_)
- } @diff
+ } real_fields($old->table)
). ' WHERE '.
join(' AND ',
map {
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
? ( driver_name eq 'Pg'
- ? "$_ IS NULL"
+ ? "( $_ IS NULL OR $_ = '' )"
: "( $_ IS NULL OR $_ = \"\" )"
)
: "$_ = ". _quote($old->getfield($_),$old->table,$_)
- } ( $primary_key ? ( $primary_key ) : $old->fields )
+ } ( $primary_key ? ( $primary_key ) : real_fields($old->table) )
)
;
warn "[debug]$me $statement\n" if $DEBUG > 1;
$h_new_sth = '';
}
+ # For virtual fields we have three cases with different SQL
+ # statements: add, replace, delete
+ my $v_add_sth;
+ my $v_rep_sth;
+ my $v_del_sth;
+ my (@add_vfields, @rep_vfields, @del_vfields);
+ my $vfp = $old->vfieldpart_hashref;
+ foreach(grep { exists($diff{$_}) } $new->virtual_fields) {
+ if($diff{$_} eq '') {
+ # Delete
+ unless(@del_vfields) {
+ my $st = "DELETE FROM virtual_field WHERE recnum = ? ".
+ "AND vfieldpart = ?";
+ warn "[debug]$me $st\n" if $DEBUG > 2;
+ $v_del_sth = dbh->prepare($st) or return dbh->errstr;
+ }
+ push @del_vfields, $_;
+ } elsif($old->getfield($_) eq '') {
+ # Add
+ unless(@add_vfields) {
+ my $st = "INSERT INTO virtual_field (value, recnum, vfieldpart) ".
+ "VALUES (?, ?, ?)";
+ warn "[debug]$me $st\n" if $DEBUG > 2;
+ $v_add_sth = dbh->prepare($st) or return dbh->errstr;
+ }
+ push @add_vfields, $_;
+ } else {
+ # Replace
+ unless(@rep_vfields) {
+ my $st = "UPDATE virtual_field SET value = ? ".
+ "WHERE recnum = ? AND vfieldpart = ?";
+ warn "[debug]$me $st\n" if $DEBUG > 2;
+ $v_rep_sth = dbh->prepare($st) or return dbh->errstr;
+ }
+ push @rep_vfields, $_;
+ }
+ }
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
#not portable #return "Record not found (or records identical)." if $rc eq "0E0";
$h_old_sth->execute or return $h_old_sth->errstr if $h_old_sth;
$h_new_sth->execute or return $h_new_sth->errstr if $h_new_sth;
+
+ $v_del_sth->execute($old->getfield($primary_key),
+ $vfp->{$_})
+ or return $v_del_sth->errstr
+ foreach(@del_vfields);
+
+ $v_add_sth->execute($new->getfield($_),
+ $old->getfield($primary_key),
+ $vfp->{$_})
+ or return $v_add_sth->errstr
+ foreach(@add_vfields);
+
+ $v_rep_sth->execute($new->getfield($_),
+ $old->getfield($primary_key),
+ $vfp->{$_})
+ or return $v_rep_sth->errstr
+ foreach(@rep_vfields);
+
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
'';
=item check
-Not yet implemented, croaks. Derived classes should provide a check method.
+Checks virtual fields (using check_blocks). Subclasses should still provide
+a check method to validate real fields, foreign keys, etc., and call this
+method via $self->SUPER::check.
+
+(FIXME: Should this method try to make sure that it I<is> being called from
+a subclass's check method, to keep the current semantics as far as possible?)
=cut
sub check {
- confess "FS::Record::check not implemented; supply one in subclass!";
+ #confess "FS::Record::check not implemented; supply one in subclass!";
+ my $self = shift;
+
+ foreach my $field ($self->virtual_fields) {
+ for ($self->getfield($field)) {
+ # See notes on check_block in FS::part_virtual_field.
+ eval $self->pvf($field)->check_block;
+ if ( $@ ) {
+ #this is bad, probably want to follow the stack backtrace up and see
+ #wtf happened
+ my $err = "Fatal error checking $field for $self";
+ cluck "$err: $@";
+ return "$err (see log for backtrace): $@";
+
+ }
+ $self->setfield($field, $_);
+ }
+ }
+ '';
}
sub _h_statement {
my @fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- $self->fields
+ real_fields($self->table);
;
my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
'';
}
+=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);
+ }
}
'';
}
: '';
}
+
+=item virtual_fields [ TABLE ]
+
+Returns a list of virtual fields defined for the table. This should not
+be exported, and should only be called as an instance or class method.
+
+=cut
+
+sub virtual_fields {
+ my $self = shift;
+ my $table;
+ $table = $self->table or confess "virtual_fields called on non-table";
+
+ confess "Unknown table $table" unless $dbdef->table($table);
+
+ return () unless $self->dbdef->table('part_virtual_field');
+
+ unless ( $virtual_fields_cache{$table} ) {
+ my $query = 'SELECT name from part_virtual_field ' .
+ "WHERE dbtable = '$table'";
+ my $dbh = dbh;
+ my $result = $dbh->selectcol_arrayref($query);
+ confess $dbh->errstr if $dbh->err;
+ $virtual_fields_cache{$table} = $result;
+ }
+
+ @{$virtual_fields_cache{$table}};
+
+}
+
+
=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<DBIx::DBSchema::Table>).
+This is a wrapper for real_fields and virtual_fields. Code that called
+fields before should probably continue to call fields.
=cut
-# Usage: @fields = fields($table);
-# @fields = $record->fields;
sub fields {
my $something = shift;
my $table;
- if ( ref($something) ) {
+ if($something->isa('FS::Record')) {
$table = $something->table;
} else {
$table = $something;
+ $something = "FS::$table";
}
- #croak "Usage: \@fields = fields(\$table)\n or: \@fields = \$record->fields" unless $table;
- my($table_obj) = $dbdef->table($table);
- confess "Unknown table $table" unless $table_obj;
- $table_obj->columns;
+ return (real_fields($table), $something->virtual_fields());
}
=back
+=item pvf FIELD_NAME
+
+Returns the FS::part_virtual_field object corresponding to a field in the
+record (specified by FIELD_NAME).
+
+=cut
+
+sub pvf {
+ my ($self, $name) = (shift, shift);
+
+ if(grep /^$name$/, $self->virtual_fields) {
+ return qsearchs('part_virtual_field', { dbtable => $self->table,
+ name => $name } );
+ }
+ ''
+}
+
=head1 SUBROUTINES
=over 4
+=item real_fields [ TABLE ]
+
+Returns a list of the real columns in the specified table. Called only by
+fields() and other subroutines elsewhere in FS::Record.
+
+=cut
+
+sub real_fields {
+ my $table = shift;
+
+ my($table_obj) = $dbdef->table($table);
+ confess "Unknown table $table" unless $table_obj;
+ $table_obj->columns;
+}
+
=item reload_dbdef([FILENAME])
Load a database definition (see L<DBIx::DBSchema>), optionally from a
}
}
+=item vfieldpart_hashref TABLE
+
+Returns a hashref of virtual field names and vfieldparts applicable to the given
+TABLE.
+
+=cut
+
+sub vfieldpart_hashref {
+ my $self = shift;
+ my $table = $self->table;
+
+ return {} unless $self->dbdef->table('part_virtual_field');
+
+ my $dbh = dbh;
+ my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".
+ "dbtable = '$table'";
+ my $sth = $dbh->prepare($statement);
+ $sth->execute or croak "Execution of '$statement' failed: ".$dbh->errstr;
+ return { map { $_->{name}, $_->{vfieldpart} }
+ @{$sth->fetchall_arrayref({})} };
+
+}
+
+
=item hfields TABLE
This is deprecated. Don't use it.
projects / freeside.git / blobdiff