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);
-$DEBUG = 0;
+$DEBUG = 2;
$me = '[FS::Record]';
#ask FS::UID to run this stuff for us later
my $dbh = dbh;
my $table = $cache ? $cache->table : $stable;
+ my $pkey = $dbdef->table($table)->primary_key;
- my @fields = grep exists($record->{$_}), fields($table);
+ my @real_fields = grep exists($record->{$_}), real_fields($table);
+ my @virtual_fields = grep exists($record->{$_}), "FS::$table"->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 = $_;
} 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
$sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
- $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
-
+ my %result;
+ tie %result, "Tie::IxHash";
+ @virtual_fields = "FS::$table"->virtual_fields;
+ if($pkey) {
+ %result = %{ $sth->fetchall_hashref( $pkey ) };
+ } else {
+ my @stuff = @{ $sth->fetchall_arrayref( {} ) };
+ @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);
}
}
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 = vfieldpart_hashref($table);
+
+ 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 = vfieldpart_hashref($self->table);
+ 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)
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 {
: "( $_ 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 = vfieldpart_hashref($old->table);
+ 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;
+ return $@ if $@;
+ $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 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 $something = shift;
+ my $table;
+ $table = $something->table or confess "virtual_fields called on non-table";
+
+ confess "Unknown table $table" unless $dbdef->table($table);
+
+ # This should be smart enough to cache results.
+
+ 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;
+ return @$result;
+}
+
+
=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 ($table) = @_;
+
+ return () unless $table;
+ 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.
}
}
- '';
+ $self->SUPER::check;
}
return "Unknown typenum!"
unless $self->agent_type;
- '';
-
+ $self->SUPER::check;
}
=item agent_type
=head1 VERSION
-$Id: agent.pm,v 1.3 2002-03-24 18:23:47 ivan Exp $
+$Id: agent.pm,v 1.3.6.1 2003-06-23 22:19:30 khoff Exp $
=head1 BUGS
my $self = shift;
$self->ut_numbern('typenum')
- or $self->ut_text('atype');
+ or $self->ut_text('atype')
+ or $self->SUPER::check;
}
=head1 VERSION
-$Id: agent_type.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+$Id: agent_type.pm,v 1.1.16.1 2003-06-23 22:19:30 khoff Exp $
=head1 BUGS
$self->printed(0) if $self->printed eq '';
- ''; #no error
+ $self->SUPER::check;
}
=item previous
return "Unknown eventpart ". $self->eventpart
unless qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } );
- ''; #no error
+ $self->SUPER::check;
}
=item part_bill_event
$self->_date(time) unless $self->_date;
- ''; #no error
+ $self->SUPER::check;
}
=item cust_pay
=head1 VERSION
-$Id: cust_bill_pay.pm,v 1.12 2002-02-07 22:29:34 ivan Exp $
+$Id: cust_bill_pay.pm,v 1.12.8.1 2003-06-23 22:19:30 khoff Exp $
=head1 BUGS
return "Unknown invnum"
unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
- ''; #no error
+ $self->SUPER::check;
}
=item cust_pkg
|| $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
|| $self->ut_foreign_key('invnum', 'cust_pkg', 'invnum')
|| $self->ut_text('detail')
- ;
+ || $self->SUPER::check
+ ;
}
$self->otaker(getotaker);
- ''; #no error
+ $self->SUPER::check;
}
=item cust_refund
=head1 VERSION
-$Id: cust_credit.pm,v 1.16 2002-06-04 14:35:52 ivan Exp $
+$Id: cust_credit.pm,v 1.16.6.1 2003-06-23 22:19:31 khoff Exp $
=head1 BUGS
return "Cannot apply more than remaining value of invoice"
unless $self->amount <= $cust_bill->owed;
- ''; #no error
+ $self->SUPER::check;
}
=item sub cust_credit
=head1 VERSION
-$Id: cust_credit_bill.pm,v 1.7 2002-01-24 16:58:47 ivan Exp $
+$Id: cust_credit_bill.pm,v 1.7.8.1 2003-06-23 22:19:31 khoff Exp $
=head1 BUGS
return "unknown cust_credit.crednum: ". $self->crednum
unless qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
- ''; #no error
+ $self->SUPER::check;
}
=item cust_refund
=head1 VERSION
-$Id: cust_credit_refund.pm,v 1.9 2002-01-26 01:52:31 ivan Exp $
+$Id: cust_credit_refund.pm,v 1.9.8.1 2003-06-23 22:19:31 khoff Exp $
=head1 BUGS
#warn "AFTER: \n". $self->_dump;
- ''; #no error
+ $self->SUPER::check;
}
=item all_pkgs
|| $self->ut_textn('taxclass') # ...
|| $self->ut_money('exempt_amount')
|| $self->ut_textn('taxname')
- ;
+ || $self->SUPER::check
+ ;
+
}
return "Unknown customer"
unless qsearchs('cust_main',{ 'custnum' => $self->custnum });
- ''; #noerror
+ $self->SUPER::check;
}
=item checkdest
=head1 VERSION
-$Id: cust_main_invoice.pm,v 1.13 2002-09-18 22:50:44 ivan Exp $
+$Id: cust_main_invoice.pm,v 1.13.2.1 2003-06-23 22:19:31 khoff Exp $
=head1 BUGS
return $error if $error;
}
- ''; #no error
-
+ $self->SUPER::check;
}
=item cust_bill_pay
=head1 VERSION
-$Id: cust_pay.pm,v 1.24 2003-05-19 12:00:44 ivan Exp $
+$Id: cust_pay.pm,v 1.24.2.1 2003-06-23 22:19:32 khoff Exp $
=head1 BUGS
#check invnum, custnum, ?
- ''; #no error
+ $self->SUPER::check;
}
=back
=head1 VERSION
-$Id: cust_pay_batch.pm,v 1.6 2002-02-22 23:08:11 ivan Exp $
+$Id: cust_pay_batch.pm,v 1.6.6.1 2003-06-23 22:19:32 khoff Exp $
=head1 BUGS
$self->manual_flag($1);
}
- ''; #no error
+ $self->SUPER::check;
}
=item cancel
$self->otaker(getotaker);
- ''; #no error
+ $self->SUPER::check;
}
=back
=head1 VERSION
-$Id: cust_refund.pm,v 1.20 2002-11-19 09:51:58 ivan Exp $
+$Id: cust_refund.pm,v 1.20.2.1 2003-06-23 22:19:32 khoff Exp $
=head1 BUGS
if scalar(@cust_svc) >= $quantity && (!$ignore_quantity || !$quantity);
}
- ''; #no error
+ $self->SUPER::check;
}
=item part_svc
|| $self->ut_number('year') #check better
|| $self->ut_number('month') #check better
|| $self->ut_money('amount')
+ || $self->SUPER::check
;
}
die "ack!";
}
- ''; #no error
+ $self->SUPER::check;
}
=item increment_serial
=head1 VERSION
-$Id: domain_record.pm,v 1.15 2003-04-29 18:28:50 khoff Exp $
+$Id: domain_record.pm,v 1.15.2.1 2003-06-23 22:19:32 khoff Exp $
=head1 BUGS
|| $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
|| $self->ut_number('svcpart')
|| $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart')
+ || $self->SUPER::check
;
}
$self->locale =~ /^([\w\@]+)$/ or return "illegal locale: ". $self->locale;
$self->locale($1);
- ''; #no error
+ $self->SUPER::check
}
=back
|| $self->ut_text('nas')
|| $self->ut_ip('nasip')
|| $self->ut_domain('nasfqdn')
- || $self->ut_numbern('last');
+ || $self->ut_numbern('last')
+ || $self->SUPER::check
+ ;
}
=item heartbeat TIMESTAMP
=head1 VERSION
-$Id: nas.pm,v 1.6 2002-03-04 12:48:49 ivan Exp $
+$Id: nas.pm,v 1.6.6.1 2003-06-23 22:19:33 khoff Exp $
=head1 BUGS
}
}
- '';
-
+ $self->SUPER::check;
}
=back
#check exporttype?
- ''; #no error
+ $self->SUPER::check;
}
#=item part_svc
},
;
+tie my %router_options, 'Tie::IxHash',
+ 'protocol' => {
+ label=>'Protocol',
+ type =>'select',
+ options => [qw(telnet ssh)],
+ default => 'telnet'},
+ 'insert' => {label=>'Insert command', default=>'' },
+ 'delete' => {label=>'Delete command', default=>'' },
+ 'replace' => {label=>'Replace command', default=>'' },
+ 'Timeout' => {label=>'Time to wait for prompt', default=>'20' },
+ 'Prompt' => {label=>'Prompt string', default=>'#' }
+;
+
tie my %domain_shellcommands_options, 'Tie::IxHash',
'user' => { lable=>'Remote username', default=>'root' },
'useradd' => { label=>'Insert command',
},
'svc_broadband' => {
+ 'router' => {
+ 'desc' => 'Send a command to a router.',
+ 'options' => \%router_options,
+ 'notes' => '',
+ },
},
-
);
=back
#check options & values?
- ''; #no error
+ $self->SUPER::check;
}
=back
|| $self->ut_enum('recurtax', [ '', 'Y' ] )
|| $self->ut_textn('taxclass')
|| $self->ut_enum('disabled', [ '', 'Y' ] )
+ || $self->SUPER::check
;
}
or $self->ut_text('state')
or $self->ut_number('npa')
or $self->ut_number('nxx')
+ or $self->SUPER::check
;
}
=head1 VERSION
-$Id: part_pop_local.pm,v 1.1 2001-09-26 09:17:06 ivan Exp $
+$Id: part_pop_local.pm,v 1.1.8.1 2003-06-23 22:19:34 khoff Exp $
=head1 BUGS
$self->ut_numbern('refnum')
|| $self->ut_text('referral')
+ || $self->SUPER::check
;
}
=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
-=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
+=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed. For virtual fields, can also be 'X' for excluded.
TODOC: EXTRA_FIELDS_ARRAYREF
} );
my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
- if ( uc($flag) =~ /^([DF])$/ ) {
+ if ( uc($flag) =~ /^([DFX])$/ ) {
$part_svc_column->setfield('columnflag', $1);
$part_svc_column->setfield('columnvalue',
$self->getfield($svcdb.'__'.$field)
} );
my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
- if ( uc($flag) =~ /^([DF])$/ ) {
+ if ( uc($flag) =~ /^([DFX])$/ ) {
$part_svc_column->setfield('columnflag', $1);
$part_svc_column->setfield('columnvalue',
$new->getfield($svcdb.'__'.$field)
my @fields = eval { fields( $recref->{svcdb} ) }; #might die
return "Unknown svcdb!" unless @fields;
- ''; #no error
+ $self->SUPER::check;
}
=item part_svc_column COLUMNNAME
=item columnvalue - default or fixed value for the column
-=item columnflag - null, D or F
+=item columnflag - null, D, F, X (virtual fields)
=back
;
return $error if $error;
- $self->columnflag =~ /^([DF])$/
+ $self->columnflag =~ /^([DFX])$/
or return "illegal columnflag ". $self->columnflag;
$self->columnflag(uc($1));
- ''; #no error
+ $self->SUPER::check;
}
=back
=head1 VERSION
-$Id: part_svc_column.pm,v 1.1 2001-09-07 20:49:15 ivan Exp $
+$Id: part_svc_column.pm,v 1.1.8.1 2003-06-23 22:19:35 khoff Exp $
=head1 BUGS
return "Unknown pkgpart!" unless $self->part_pkg;
return "Unknown svcpart!" unless $self->part_svc;
- ''; #no error
+ $self->SUPER::check;
}
=item part_pkg
=head1 VERSION
-$Id: pkg_svc.pm,v 1.3 2002-06-10 01:39:50 khoff Exp $
+$Id: pkg_svc.pm,v 1.3.4.1 2003-06-23 22:19:35 khoff Exp $
=head1 BUGS
unless $self->ip || $self->nasport;
return "Unknown nasnum"
unless qsearchs('nas', { 'nasnum' => $self->nasnum } );
- ''; #no error
+ $self->SUPER::check;
}
=item session
=head1 VERSION
-$Id: port.pm,v 1.5 2001-02-14 04:33:06 ivan Exp $
+$Id: port.pm,v 1.5.14.1 2003-06-23 22:19:35 khoff Exp $
=head1 BUGS
|| $self->ut_alpha('identifier')
|| $self->ut_money('amount')
|| $self->utnumbern('seconds')
+ || $self->SUPER::check
;
}
$self->status('new') unless $self->status;
$self->_date(time) unless $self->_date;
- ''; #no error
+ $self->SUPER::check;
}
=item args
=head1 VERSION
-$Id: queue.pm,v 1.15 2002-07-02 06:48:59 ivan Exp $
+$Id: queue.pm,v 1.15.6.1 2003-06-23 22:19:35 khoff Exp $
=head1 BUGS
;
return $error if $error;
- ''; #no error
+ $self->SUPER::check;
}
=back
=head1 VERSION
-$Id: queue_arg.pm,v 1.1 2001-09-11 00:08:18 ivan Exp $
+$Id: queue_arg.pm,v 1.1.8.1 2003-06-23 22:19:35 khoff Exp $
=head1 BUGS
$self->ut_numbern('dependnum')
|| $self->ut_foreign_key('jobnum', 'queue', 'jobnum')
|| $self->ut_foreign_key('depend_jobnum', 'queue', 'jobnum')
+ || $self->SUPER::check
;
}
|| $self->ut_number('svcnum')
|| $self->ut_foreign_key('svcnum','svc_acct','svcnum')
|| $self->ut_text('groupname')
+ || $self->SUPER::check
;
}
|| $self->ut_text('routername');
return $error if $error;
- '';
+ $self->SUPER::check;
}
=item addr_block
return qsearch('addr_block', { routernum => $self->routernum });
}
-=item router_field
-
-Returns a list of FS::router_field objects assigned to this object.
-
-=cut
-
-sub router_field {
- my $self = shift;
-
- return qsearch('router_field', { routernum => $self->routernum });
-}
-
=item part_svc_router
Returns a list of FS::part_svc_router objects associated with this
=head1 SEE ALSO
-FS::svc_broadband, FS::router, FS::addr_block, FS::router_field, FS::part_svc,
+FS::svc_broadband, FS::router, FS::addr_block, FS::part_svc,
schema.html from the base documentation.
=cut
return $error if $error;
return "Unknown svcnum"
unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
- '';
+ $self->SUPER::check;
}
=item nas_heartbeat
=head1 VERSION
-$Id: session.pm,v 1.7 2001-04-15 13:35:12 ivan Exp $
+$Id: session.pm,v 1.7.14.1 2003-06-23 22:19:36 khoff Exp $
=head1 BUGS
use strict;
use vars qw( @ISA $noexport_hack );
-use FS::Record qw( qsearchs fields dbh );
+use FS::Record qw( qsearch qsearchs fields dbh );
use FS::cust_svc;
use FS::part_svc;
use FS::queue;
=over 4
+=cut
+
+sub virtual_fields {
+
+ # This restricts the fields based on part_svc_column and the svcpart of
+ # the service. There are four possible cases:
+ # 1. svcpart passed as part of the svc_x hash.
+ # 2. svcpart fetched via cust_svc based on svcnum.
+ # 3. No svcnum or svcpart. In this case, return ALL the fields with
+ # dbtable eq $self->table.
+ # 4. Called via "fields('svc_acct')" or something similar. In this case
+ # there is no $self object.
+
+ my $self = shift;
+ my $svcpart;
+ my @vfields = $self->SUPER::virtual_fields;
+
+ return @vfields unless (ref $self); # Case 4
+
+ if ($self->svcpart) { # Case 1
+ $svcpart = $self->svcpart;
+ } elsif (my $cust_svc = $self->cust_svc) { # Case 2
+ $svcpart = $cust_svc->svcpart;
+ } else { # Case 3
+ $svcpart = '';
+ }
+
+ if ($svcpart) { #Cases 1 and 2
+ my %flags = map { $_->columnname, $_->columnflag } (
+ qsearch ('part_svc_column', { svcpart => $svcpart } )
+ );
+ return grep { not ($flags{$_} eq 'X') } @vfields;
+ } else { # Case 3
+ return @vfields;
+ }
+ return ();
+}
+
+=item check
+
+Checks the validity of fields in this record.
+
+At present, this does nothing but call FS::Record::check (which, in turn,
+does nothing but run virtual field checks).
+
+=cut
+
+sub check {
+ my $self = shift;
+ $self->SUPER::check;
+}
+
=item insert [ JOBNUM_ARRAYREF ]
Adds this record to the database. If there is an error, returns the error,
#set default/fixed/whatever fields from part_svc
my $table = $self->table;
- foreach my $field ( grep { $_ ne 'svcnum' } fields($table) ) {
+ foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
my $part_svc_column = $part_svc->part_svc_column($field);
if ( $part_svc_column->columnflag eq $x ) {
$self->setfield( $field, $part_svc_column->columnvalue );
=head1 VERSION
-$Id: svc_Common.pm,v 1.12 2002-06-14 11:22:53 ivan Exp $
+$Id: svc_Common.pm,v 1.12.6.1 2003-06-23 22:19:36 khoff Exp $
=head1 BUGS
": ". $recref->{_password};
}
- ''; #no error
+ $self->SUPER::check;
}
=item radius
or $self->ut_number('ac')
or $self->ut_number('exch')
or $self->ut_numbern('loc')
+ or $self->SUPER::check
;
}
=head1 VERSION
-$Id: svc_acct_pop.pm,v 1.7 2002-04-10 13:42:48 ivan Exp $
+$Id: svc_acct_pop.pm,v 1.7.6.1 2003-06-23 22:19:37 khoff Exp $
=head1 BUGS
# Standard FS::svc_Common::replace
-=item sb_field
-
-Returns a list of FS::sb_field objects assigned to this object.
-
-=cut
-
-sub sb_field {
- my $self = shift;
-
- return qsearch( 'sb_field', { svcnum => $self->svcnum } );
-}
-
-=item sb_field_hashref
-
-Returns a hashref of the FS::sb_field key/value pairs for this object.
-
-Deprecated. Please don't use it.
-
-=cut
-
-# Kristian wrote this, but don't hold it against him. He was under a powerful
-# distracting influence whom he evidently found much more interesting than
-# svc_broadband.pm. I can't say I blame him.
-
-sub sb_field_hashref {
- my $self = shift;
- my $svcpart = shift;
-
- if ((not $svcpart) && ($self->cust_svc)) {
- $svcpart = $self->cust_svc->svcpart;
- }
-
- my $hashref = {};
-
- map {
- my $sb_field = qsearchs('sb_field', { sbfieldpart => $_->sbfieldpart,
- svcnum => $self->svcnum });
- $hashref->{$_->getfield('name')} = $sb_field ? $sb_field->getfield('value') : '';
- } qsearch('part_sb_field', { svcpart => $svcpart });
-
- return $hashref;
-
-}
-
=item suspend
Called by the suspend method of FS::cust_pkg (see FS::cust_pkg).
return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart;
}
-
- ''; #no error
+ $self->SUPER::check;
}
=item NetAddr
=head1 BUGS
-I think there's one place in the code where we actually use sb_field_hashref.
-That's a bug in itself.
-
-The real problem with it is that we're still grappling with the question of how
-tightly xfields should be integrated with real fields. There are a few
-different directions we could go with it--we I<could> override several
-functions in Record so that xfields behave almost exactly like real fields (can
-be set with setfield(), appear in fields() and hash(), used as criteria in
-qsearch(), etc.).
+The business with sb_field has been 'fixed', in a manner of speaking.
=head1 SEE ALSO
-FS::svc_Common, FS::Record, FS::addr_block, FS::sb_field,
+FS::svc_Common, FS::Record, FS::addr_block,
FS::part_svc, schema.html from the base documentation.
=cut
return "Unknown catchall" unless $svc_acct;
}
- $self->ut_textn('purpose');
+ my $error = $self->ut_textn('purpose')
+ or $self->SUPER::check;
+ return $error if $error;
}
$self->dst('');
}
- ''; #no error
+ $self->SUPER::check;
}
=item srcsvc_acct
return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc
unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
- ''; #no error
+ $self->SUPER::check;
+
}
=item domain_record
return "Unknown pkgpart"
unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
- ''; #no error
+ $self->SUPER::check;
}
=item part_pkg
=head1 VERSION
-$Id: type_pkgs.pm,v 1.2 2002-10-04 12:57:06 ivan Exp $
+$Id: type_pkgs.pm,v 1.2.2.1 2003-06-23 22:19:37 khoff Exp $
=head1 BUGS
'dstsvc' => 'service to which mail is to be forwarded',
'dst' => 'someone@another.domain.com to use when dstsvc is 0',
},
- 'svc_charge' => {
- 'amount' => 'amount',
- },
- 'svc_wo' => {
- 'worker' => 'Worker',
- '_date' => 'Date',
- },
+# 'svc_charge' => {
+# 'amount' => 'amount',
+# },
+# 'svc_wo' => {
+# 'worker' => 'Worker',
+# '_date' => 'Date',
+# },
'svc_www' => {
#'recnum' => '',
#'usersvc' => '',
},
'svc_broadband' => {
- 'actypenum' => 'This is the actypenum that refers to the type of AC that can be provisioned for this service. This field must be set fixed.',
'speed_down' => 'Maximum download speed for this service in Kbps. 0 denotes unlimited.',
'speed_up' => 'Maximum upload speed for this service in Kbps. 0 denotes unlimited.',
- 'acnum' => 'acnum of a specific AC that this service is restricted to. Not required',
'ip_addr' => 'IP address. Leave blank for automatic assignment.',
- 'ip_netmask' => 'Mask length, aka. netmask bits. (Eg. 255.255.255.0 == 24)',
- 'mac_addr' => 'MAC address which is used by some ACs for access control. Specified by 6 colon seperated hex octets. (Eg. 00:00:0a:bc:1a:2b)',
- 'location' => 'Defines the physically location at which this service was installed. This is not necessarily the billing address',
+ 'blocknum' => 'Address block.',
},
);
+ foreach $svcdb (keys(%defs)) {
+ my $self = "FS::$svcdb"->new;
+ foreach my $field ($self->virtual_fields) { # svc_Common::virtual_fields with a null svcpart returns all of them
+ my $pvf = $self->pvf($field);
+ my @list = $pvf->list;
+ if (scalar @list) {
+ $defs{$svcdb}->{$field} = { desc => $pvf->label,
+ type => 'select',
+ select_list => \@list };
+ } else {
+ warn "$field";
+ $defs{$svcdb}->{$field} = $pvf->label;
+ } #endif
+ } #next $field
+ } #next $svcdb
+
+
my @dbs = $hashref->{svcdb}
? ( $hashref->{svcdb} )
: qw( svc_acct svc_domain svc_forward svc_www svc_broadband );
if ( $def->{type} eq 'select' ) {
$html .= qq!<SELECT NAME="${layer}__${field}">!;
$html .= '<OPTION> </OPTION>' unless $value;
- foreach my $record ( qsearch( $def->{select_table}, {} ) ) {
- my $rvalue = $record->getfield($def->{select_key});
- $html .= qq!<OPTION VALUE="$rvalue"!.
- ( $rvalue==$value ? ' SELECTED>' : '>' ).
- $record->getfield($def->{select_label}). '</OPTION>';
- }
+ if ( $def->{select_table} ) {
+ foreach my $record ( qsearch( $def->{select_table}, {} ) ) {
+ my $rvalue = $record->getfield($def->{select_key});
+ $html .= qq!<OPTION VALUE="$rvalue"!.
+ ( $rvalue==$value ? ' SELECTED>' : '>' ).
+ $record->getfield($def->{select_label}). '</OPTION>';
+ } #next $record
+ } else { # select_list
+ foreach my $item ( @{$def->{select_list}} ) {
+ $html .= qq!<OPTION VALUE="$item"!.
+ ( $item eq $value ? ' SELECTED>' : '>' ).
+ $item. '</OPTION>';
+ } #next $item
+ } #endif
$html .= '</SELECT>';
} elsif ( $def->{type} eq 'radius_usergroup_selector' ) {
$html .= FS::svc_acct::radius_usergroup_selector(
projects / freeside.git / commitdiff