use strict;
use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $me %dbdef_cache %virtual_fields_cache );
+ $me %dbdef_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 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);
-use FS::part_virtual_field;
-
-use Tie::IxHash;
-
@ISA = qw(Exporter);
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
$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 $dbh = dbh;
my $table = $cache ? $cache->table : $stable;
- my $pkey = $dbdef->table($table)->primary_key;
- my @real_fields = grep exists($record->{$_}), real_fields($table);
- my @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
+ my @fields = grep exists($record->{$_}), fields($table);
my $statement = "SELECT $select FROM $stable";
- if ( @real_fields or @virtual_fields ) {
- $statement .= ' WHERE '. join(' AND ',
- ( map {
+ if ( @fields ) {
+ $statement .= ' WHERE '. join(' AND ', map {
my $op = '=';
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'});
} else {
"$column $op ?";
}
- } @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 ) );
-
+ } @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 '', @real_fields
+ grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
) {
if ( $record->{$field} =~ /^\d+(\.\d+)?$/
&& $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
$sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
- my %result;
- tie %result, "Tie::IxHash";
- @virtual_fields = "FS::$table"->virtual_fields;
-
- my @stuff = @{ $sth->fetchall_arrayref( {} ) };
- if($pkey) {
- %result = map { $_->{$pkey}, $_ } @stuff;
- } else {
- @result{@stuff} = @stuff;
- }
+ $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
- $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 )
- } values(%result);
+ } @{$sth->fetchall_arrayref( {} )};
} else {
map {
new( "FS::$table", { %{$_} } )
- } values(%result);
+ } @{$sth->fetchall_arrayref( {} )};
}
} else {
warn "untested code (class FS::$table uses custom new method)";
map {
eval 'FS::'. $table. '->new( { %{$_} } )';
- } values(%result);
+ } @{$sth->fetchall_arrayref( {} )};
}
} else {
cluck "warning: FS::$table not loaded; returning FS::Record objects";
map {
FS::Record->new( $table, { %{$_} } );
- } values(%result);
+ } @{$sth->fetchall_arrayref( {} )};
}
}
=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'};
}
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 @real_fields =
+ my @fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- real_fields($table)
+ $self->fields
;
- my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
+ my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
#eslaf
- my $statement = "INSERT INTO $table ( ".
- join( ', ', @real_fields ).
+ 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;
-
- my $insertid = '';
- if ( $db_seq ) { # get inserted id from the database, if applicable
- warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
- 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 @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');
- 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 $_ = \"\" )"
)
: "$_ = ". _quote($self->getfield($_),$self->table,$_)
} ( $self->dbdef_table->primary_key )
? ( $self->dbdef_table->primary_key)
- : real_fields($self->table)
+ : $self->fields
);
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 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;
my $error = $new->check;
return $error if $error;
- #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) ) {
+ my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
+ unless ( @diff ) {
carp "[warning]$me $new -> replace $old: records identical";
return '';
}
my $statement = "UPDATE ". $old->table. " SET ". join(', ',
map {
"$_ = ". _quote($new->getfield($_),$old->table,$_)
- } real_fields($old->table)
+ } @diff
). ' WHERE '.
join(' AND ',
map {
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
- ? ( driver_name eq 'Pg'
- ? "( $_ IS NULL OR $_ = '' )"
+ ? ( driver_name =~ /^Pg$/i
+ ? "( $_ IS NULL OR $_ = '' ) "
: "( $_ IS NULL OR $_ = \"\" )"
)
: "$_ = ". _quote($old->getfield($_),$old->table,$_)
- } ( $primary_key ? ( $primary_key ) : real_fields($old->table) )
+ } ( $primary_key ? ( $primary_key ) : $old->fields )
)
;
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;
'';
=cut
sub rep {
- cluck "warning: FS::Record::rep deprecated!";
+ cluck "warning: FS::Record::rep depriciated!";
replace @_; #call method in this scope
}
=item check
-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?)
+Not yet implemented, croaks. Derived classes should provide a check method.
=cut
sub check {
- #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;
- return $@ if $@;
- $self->setfield($field, $_);
- }
- }
- '';
+ confess "FS::Record::check not implemented; supply one in subclass!";
}
sub _h_statement {
my @fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- real_fields($self->table);
+ $self->fields
;
my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
=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;
$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 is a wrapper for real_fields and virtual_fields. Code that called
-fields before should probably continue to call fields.
+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>).
=cut
+# Usage: @fields = fields($table);
+# @fields = $record->fields;
sub fields {
my $something = shift;
my $table;
- if($something->isa('FS::Record')) {
+ if ( ref($something) ) {
$table = $something->table;
} else {
$table = $something;
- $something = "FS::$table";
}
- return (real_fields($table), $something->virtual_fields());
+ #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;
}
=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.
+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.