X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=b620c0114653f74b20e25728ad2493e28a64f9f7;hb=608586dce994179032e58eb7aee1ae9d163fe406;hp=801b89daf84cfac24467eee44240f9354758d579;hpb=eb9668a6f3181ee02cb335272c5ee4616e61fd09;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 801b89daf..b620c0114 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2,7 +2,7 @@ package FS::Record; 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); @@ -10,14 +10,10 @@ use File::CounterFile; use Locale::Country; use DBI qw(:sql_types); use DBIx::DBSchema 0.23; -use FS::UID qw(dbh getotaker datasrc driver_name); +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); @@ -64,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'); @@ -90,7 +88,7 @@ FS::Record - Database record objects $quoted_value = _quote($value,'table','field'); - #deprecated + #depriciated $fields = hfields('table'); if ( $fields->{Field} ) { # etc. @@ -169,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)!"; @@ -204,21 +202,18 @@ sub qsearch { 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'}); @@ -260,45 +255,8 @@ sub qsearch { } 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; @@ -308,7 +266,7 @@ sub qsearch { 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 @@ -325,64 +283,31 @@ sub qsearch { $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( {} )}; } } @@ -438,7 +363,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'}; } @@ -537,6 +462,8 @@ To make a distinct duplicate of an FS::Record object, you can do: sub hash { my($self) = @_; + confess $self. ' -> hash: Hash attribute is undefined' + unless defined($self->{'Hash'}); %{ $self->{'Hash'} }; } @@ -565,41 +492,25 @@ 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 @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 ). ")" @@ -607,6 +518,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'; @@ -615,92 +535,7 @@ sub insert { 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; ''; @@ -713,7 +548,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 } @@ -731,14 +566,14 @@ sub delete { 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; @@ -752,19 +587,6 @@ sub delete { $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'; @@ -775,10 +597,6 @@ sub delete { 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) @@ -794,7 +612,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 } @@ -836,11 +654,8 @@ sub replace { 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 ''; } @@ -848,18 +663,18 @@ sub replace { 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; @@ -883,44 +698,6 @@ sub replace { $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'; @@ -932,24 +709,6 @@ sub replace { #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; ''; @@ -963,34 +722,18 @@ 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 } =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 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 { @@ -998,7 +741,7 @@ 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; @@ -1012,13 +755,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 @@ -1027,6 +765,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!" @@ -1042,8 +782,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; @@ -1307,9 +1048,13 @@ sub ut_zip { $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); + } } ''; } @@ -1394,94 +1139,36 @@ sub ut_foreign_keyn { : ''; } - -=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). =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), optionally from a @@ -1540,40 +1227,16 @@ sub _quote { } } -=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)) { @@ -1609,7 +1272,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.) @@ -1617,7 +1280,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.