use strict;
use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $conf $conf_encryption $me
%virtual_fields_cache
+ $conf $conf_encryption $me
$nowarn_identical $nowarn_classload
$no_update_diff $no_check_foreign
@encrypt_payby
use FS::SearchCache;
use FS::Msgcat qw(gettext);
use NetAddr::IP; # for validation
+use Data::Dumper;
#use FS::Conf; #dependency loop bs, in install_callback below instead
use FS::part_virtual_field;
my $pkey = $dbdef_table->primary_key;
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"
- unless $nowarn_classload;
- @virtual_fields = ();
- }
my $statement .= "SELECT $select FROM $stable";
$statement .= " $addl_from" if $addl_from;
- if ( @real_fields or @virtual_fields ) {
+ if ( @real_fields ) {
$statement .= ' WHERE '. join(' AND ',
- get_real_fields($table, $record, \@real_fields) ,
- get_virtual_fields($table, $pkey, $record, \@virtual_fields),
- );
+ get_real_fields($table, $record, \@real_fields));
}
$statement .= " $extra_sql" if defined($extra_sql);
$sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
- # virtual fields and blessings are nonsense in a heterogeneous UNION, right?
my $table = $stable[0];
my $pkey = '';
$table = '' if grep { $_ ne $table } @stable;
$pkey = dbdef->table($table)->primary_key if $table;
- my @virtual_fields = ();
- if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
- @virtual_fields = "FS::$table"->virtual_fields;
- } else {
- cluck "warning: FS::$table not loaded; virtual fields not returned either"
- unless $nowarn_classload;
- @virtual_fields = ();
- }
-
my %result;
tie %result, "Tie::IxHash";
my @stuff = @{ $sth->fetchall_arrayref( {} ) };
$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;
- }
- }
- }
my @return;
if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
## makes this easier to read
-sub get_virtual_fields {
- my $table = shift;
- my $pkey = shift;
- my $record = shift;
- my $virtual_fields = shift;
-
- return
- ( 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 } ) ;
-}
-
sub get_real_fields {
my $table = shift;
my $record = shift;
}
- 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');
}
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';
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;
$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';
$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;
# Now that it has been saved, reset the encrypted fields so that $new
=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.
+Checks custom fields. Subclasses should still provide a check method to validate
+non-custom fields, foreign keys, etc., and call this method via $self->SUPER::check.
+
+=cut
+
+sub check {
+ my $self = shift;
+ foreach my $field ($self->virtual_fields) {
+ my $error = $self->ut_textn($field);
+ return $error if $error;
+ }
+ '';
+}
+
+=item virtual_fields [ TABLE ]
-(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?)
+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 check {
- #confess "FS::Record::check not implemented; supply one in subclass!";
+sub virtual_fields {
my $self = shift;
+ my $table;
+ $table = $self->table or confess "virtual_fields called on non-table";
- 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): $@";
+ confess "Unknown table $table" unless dbdef->table($table);
- }
- $self->setfield($field, $_);
- }
+ return () unless dbdef->table('part_virtual_field');
+
+ unless ( $virtual_fields_cache{$table} ) {
+ my $concat = [ "'cf_'", "name" ];
+ my $query = "SELECT ".concat_sql($concat).' from part_virtual_field ' .
+ "WHERE dbtable = '$table'";
+ my $dbh = dbh;
+ my $result = $dbh->selectcol_arrayref($query);
+ confess "Error executing virtual fields query: $query: ". $dbh->errstr
+ if $dbh->err;
+ $virtual_fields_cache{$table} = $result;
}
- '';
+
+ @{$virtual_fields_cache{$table}};
+
}
=item process_batch_import JOB OPTIONS_HASHREF PARAMS
}
-=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 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 "Error executing virtual fields query: $query: ". $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
+This is a wrapper for real_fields. Code that called
fields before should probably continue to call fields.
=cut
$table = $something;
$something = "FS::$table";
}
- return (real_fields($table), $something->virtual_fields());
-}
-
-=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 } );
- }
- ''
+ return (real_fields($table));
}
-=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 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 encrypt($value)
$table_obj->columns;
}
+=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) {
+ $name =~ s/^cf_//;
+ my $concat = [ "'cf_'", "name" ];
+ return qsearchs({ table => 'part_virtual_field',
+ hashref => { dbtable => $self->table,
+ name => $name
+ },
+ select => 'vfieldpart, dbtable, length, label, '.concat_sql($concat).' as name',
+ });
+ }
+ ''
+}
+
=item _quote VALUE, TABLE, COLUMN
This is an internal function used to construct SQL statements. It returns
=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 or empty (no default), `D' for default, `F' for fixed (unchangeable), `M' for manual selection from inventory, or `A' for automatic selection from inventory. For virtual fields, can also be 'X' for excluded.
+=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null or empty (no default), `D' for default, `F' for fixed (unchangeable), `M' for manual selection from inventory, or `A' for automatic selection from inventory.
=back
If you want to add part_svc_column records for fields that do not exist as
-(real or virtual) fields in the I<svcdb> table, make sure to list then in
+fields in the I<svcdb> table, make sure to list then in
EXTRA_FIELDS_ARRAYREF also.
If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are
keys %info,
;
- # yuck. maybe this won't be so bad when virtual fields become real fields
- my %vfields;
- foreach my $svcdb (grep dbdef->table($_), keys %svc_defs ) {
- eval "use FS::$svcdb;";
- my $self = "FS::$svcdb"->new;
- $vfields{$svcdb} = {};
- 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) {
- $svc_defs{$svcdb}->{$field} = { desc => $pvf->label,
- type => 'select',
- select_list => \@list };
- } else {
- $svc_defs{$svcdb}->{$field} = $pvf->label;
- } #endif
- $vfields{$svcdb}->{$field} = $pvf;
- warn "\$vfields{$svcdb}->{$field} = $pvf"
- if $DEBUG;
- } #next $field
- } #next $svcdb
-
$svc_defs = \%svc_defs; #cache
}
=head1 DESCRIPTION
-An FS::part_virtual_field object represents the definition of a virtual field
+An FS::part_virtual_field object represents the definition of a custom field
(see the BACKGROUND section). FS::part_virtual_field contains the name and
-base table of the field, as well as validation rules and UI hints about the
-display of the field. The actual data is stored in FS::virtual_field; see
-its manpage for details.
+base table of the field.
FS::part_virtual_field inherits from FS::Record. The following fields are
currently supported:
=item dbtable - table for which this virtual field is defined
-=item check_block - Perl code to validate/normalize data
-
-=item list_source - Perl code to generate a list of values (UI hint)
-
=item length - expected length of the value (UI hint)
=item label - descriptive label for the field (UI hint)
-=item sequence - sort key (UI hint; unimplemented)
-
=back
-=head1 BACKGROUND
-
-"Form is none other than emptiness,
- and emptiness is none other than form."
--- Heart Sutra
-
-The virtual field mechanism allows site admins to make trivial changes to
-the Freeside database schema without modifying the code. Specifically, the
-user can add custom-defined 'fields' to the set of data tracked by Freeside
-about objects such as customers and services. These fields are not associated
-with any logic in the core Freeside system, but may be referenced in peripheral
-code such as exports, price calculations, or alternate interfaces, or may just
-be stored in the database for future reference.
-
-This system was originally devised for svc_broadband, which (by necessity)
-comprises such a wide range of access technologies that no static set of fields
-could contain all the information needed by the exports. In an appalling
-display of False Laziness, a parallel mechanism was implemented for the
-router table, to store properties such as passwords to configure routers.
-
-The original system treated svc_broadband custom fields (sb_fields) as records
-in a completely separate table. Any code that accessed or manipulated these
-fields had to be aware that they were I<not> fields in svc_broadband, but
-records in sb_field. For example, code that inserted a svc_broadband with
-several custom fields had to create an FS::svc_broadband object, call its
-insert() method, and then create several FS::sb_field objects and call I<their>
-insert() methods.
-
-This created a problem for exports. The insert method on any FS::svc_Common
-object (including svc_broadband) automatically triggers exports after the
-record has been inserted. However, at this point, the sb_fields had not yet
-been inserted, so the export could not rely on their presence, which was the
-original purpose of sb_fields.
-
-Hence the new system. Virtual fields are appended to the field list of every
-record at the FS::Record level, whether the object is created ex nihilo with
-new() or fetched with qsearch(). The fields() method now returns a list of
-both real and virtual fields. The insert(), replace(), and delete() methods
-now update both the base table and the virtual fields, in a single transaction.
-
-A new method is provided, virtual_fields(), which gives only the virtual
-fields. UI code that dynamically generates form widgets to edit virtual field
-data should use this to figure out what fields are defined. (See below.)
-
-Subclasses may override virtual_fields() to restrict the set of virtual
-fields available. Some discipline and sanity on the part of the programmer
-are required; in particular, this function should probably not depend on any
-fields in the record other than the primary key, since the others may change
-after the object is instantiated. (Making it depend on I<virtual> fields is
-just asking for pain.) One use of this is seen in FS::svc_Common; another
-possibility is field-level access control based on FS::UID::getotaker().
-
-As a trivial case, a subclass may opt out of supporting virtual fields with
-the following code:
-
-sub virtual_fields { () }
-
=head1 METHODS
=over 4
sub table { 'part_virtual_field'; }
sub virtual_fields { () }
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-If there is an error, returns the error, otherwise returns false.
-Called by the insert and replace methods.
-
-=back
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error = $self->ut_text('name') ||
- $self->ut_text('dbtable') ||
- $self->ut_number('length')
- ;
- return $error if $error;
-
- # Make sure it's a real table with a numeric primary key
- my ($table, $pkey);
- if($table = dbdef->table($self->dbtable)) {
- if($pkey = $table->primary_key) {
- if($table->column($pkey)->type =~ /int/i) {
- # this is what it should be
- } else {
- $error = "$table.$pkey is not an integer";
- }
- } else {
- $error = "$table does not have a single-field primary key";
- }
- } else {
- $error = "$table does not exist in the schema";
- }
- return $error if $error;
-
- # Possibly some sanity checks for check_block and list_source?
-
- $self->SUPER::check;
-}
-
-=item list
-
-Evaluates list_source.
-
-=cut
-
-sub list {
- my $self = shift;
- return () unless $self->list_source;
-
- my @opts = eval($self->list_source);
- if($@) {
- warn $@;
- return ();
- } else {
- return @opts;
- }
-}
-
=item widget UI_TYPE MODE [ VALUE ]
Generates UI code for a widget suitable for editing/viewing the field, based on
list_source and length.
-The only UI_TYPE currently supported is 'HTML', and the only MODE is 'view'.
-Others will be added later.
+The only UI_TYPE currently supported is 'HTML', and possible MODEs are 'view'
+and 'edit'.
In HTML, all widgets are assumed to be table rows. View widgets look like
<TR><TD ALIGN="right">Label</TD><TD BGCOLOR="#ffffff">Value</TD></TR>
} elsif ($mode eq 'edit') {
$text = q!<TR><TD ALIGN="right">! . $label .
q!</TD><TD>!;
- if ($self->list_source) {
- $text .= q!<SELECT NAME="! . $self->name .
- q!" SIZE=1>! . "\n";
- foreach ($self->list) {
- $text .= q!<OPTION VALUE="! . $_ . q!"!;
- $text .= ' SELECTED' if ($_ eq $value);
- $text .= '>' . $_ . '</OPTION>' . "\n";
- }
- } else {
$text .= q!<INPUT NAME="! . $self->name .
q!" VALUE="! . escapeHTML($value) . q!"!;
if ($self->length) {
$text .= q! SIZE="! . $self->length . q!"!;
}
$text .= '>';
- }
$text .= q!</TD></TR>! . "\n";
} else {
return '';
return $text;
}
-=head1 NOTES
-=head2 Semantics of check_block:
+=item insert
-This has been changed from the sb_field implementation to make check_blocks
-simpler and more natural to Perl programmers who work on things other than
-Freeside.
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
-The check_block is eval'd with the (proposed) new value of the field in $_,
-and the object to be updated in $self. Its return value is ignored. The
-check_block may change the value of $_ to override the proposed value, or
-call die() (with an appropriate error message) to reject the update entirely;
-the error string will be returned as the output of the check() method.
+=item delete
-This makes check_blocks like
+Deletes this record from the database. If there is an error, returns the
+error, otherwise returns false.
-C<s/foo/bar/>
+=item replace OLD_RECORD
-do what you expect.
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
-The check_block is expected NOT to do anything freaky to $self, like modifying
-other fields or calling $self->check(). You have been warned.
+=item check
-(FIXME: Rewrite some of the warnings from part_sb_field and insert here.)
+If there is an error, returns the error, otherwise returns false.
+Called by the insert and replace methods.
-=head1 BUGS
+=back
-None. It's absolutely falwless.
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error = $self->ut_text('name') ||
+ $self->ut_text('dbtable') ||
+ $self->ut_number('length')
+ ;
+ return $error if $error;
+
+ # Make sure it's a real table with a numeric primary key
+ my ($table, $pkey);
+ if($table = dbdef->table($self->dbtable)) {
+ if($pkey = $table->primary_key) {
+ if($table->column($pkey)->type =~ /int/i) {
+ # this is what it should be
+ } else {
+ $error = "$table.$pkey is not an integer";
+ }
+ } else {
+ $error = "$table does not have a single-field primary key";
+ }
+ } else {
+ $error = "$table does not exist in the schema";
+ }
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=head1 NOTES
+
+=head1 BUGS
=head1 SEE ALSO
-L<FS::Record>, L<FS::virtual_field>
+L<FS::Record>
=cut
{ 'nullify_default' => 1, },
);
-#### NEW CUSTOM FIELDS (prevent columns from being dropped by upgrade)
+#### NEW CUSTOM FIELDS:
+# 1. prevent new custom field columns from being dropped by upgrade
+# 2. migrate old virtual fields to real fields (new custom fields)
+####
my $cfsth = $dbh->prepare("SELECT * FROM part_virtual_field")
or die $dbh->errstr;
$cfsth->execute or die $cfsth->errstr;
my $cf;
-# likely a very inefficient implementation of this
while ( $cf = $cfsth->fetchrow_hashref ) {
my $tbl = $cf->{'dbtable'};
my $name = $cf->{'name'};
- @statements = grep { $_ !~ /^\s*ALTER\s+TABLE\s+$tbl\s+DROP\s+COLUMN\s+cf_$name\s*$/i }
+ @statements = grep { $_ !~ /^\s*ALTER\s+TABLE\s+(h_|)$tbl\s+DROP\s+COLUMN\s+cf_$name\s*$/i }
@statements;
+ push @statements,
+ "ALTER TABLE $tbl ADD COLUMN cf_$name varchar(".$cf->{'length'}.")"
+ unless (dbdef->table($tbl) && dbdef->table($tbl)->column("cf_$name"));
+ push @statements,
+ "ALTER TABLE h_$tbl ADD COLUMN cf_$name varchar(".$cf->{'length'}.")"
+ unless (dbdef->table("h_$tbl") && dbdef->table("h_$tbl")->column("cf_$name"));
}
+warn "Custom fields schema upgrade completed";
@statements =
grep { $_ !~ /^CREATE +INDEX +h_queue/i } #useless, holds up queue insertion
warn "Re-initialization with updated schema completed in ". (time-$start). " seconds\n"; # if $DEBUG;
$start = time;
+#### NEW CUSTOM FIELDS:
+# 3. migrate old virtual field data to the new custom fields
+####
+$cfsth = $dbh->prepare("SELECT * FROM virtual_field left join part_virtual_field using (vfieldpart)")
+ or die $dbh->errstr;
+$cfsth->execute or die $cfsth->errstr;
+my @cfst;
+while ( $cf = $cfsth->fetchrow_hashref ) {
+ my $tbl = $cf->{'dbtable'};
+ my $name = $cf->{'name'};
+ my $dtable = dbdef->table($tbl);
+ next unless $dtable && $dtable->primary_key; # XXX: warn first?
+ my $pkey = $dtable->primary_key;
+ next unless $dtable->column($pkey)->type =~ /int/i; # XXX: warn first?
+ push @cfst, "UPDATE $tbl set cf_$name = '".$cf->{'value'}."' WHERE $pkey = ".$cf->{'recnum'};
+ push @cfst, "DELETE FROM virtual_field WHERE vfieldnum = ".$cf->{'vfieldnum'};
+}
+foreach my $cfst ( @cfst ) {
+ warn "$cfst\n";
+ $dbh->do( $cfst )
+ or die "Error: ". $dbh->errstr. "\n executing: $cfst";
+}
+warn "Custom fields data upgrade completed";
+
upgrade_config()
unless $DRY_RUN || $opt_s;
--- /dev/null
+<% include( 'elements/browse.html',
+ 'title' => 'Custom field definitions',
+ 'menubar' => [ 'Add a new field' => $p.'edit/part_virtual_field.html', ],
+ 'name' => 'custom fields',
+ 'query' => { 'table' => 'part_virtual_field',
+ 'hashref' => {},
+ 'order_by' => 'ORDER BY dbtable',
+ },
+ 'count_query' => 'SELECT COUNT(1) from part_virtual_field',
+ 'header' => [ '#',
+ 'Table',
+ 'Name',
+ 'Length',
+ 'Label',
+ ],
+ 'fields' => [ 'vfieldpart',
+ 'dbtable',
+ 'name',
+ 'length',
+ 'label',
+ ],
+ 'links' => [ [ $p.'edit/part_virtual_field.html?', 'vfieldpart' ],
+ '',
+ '',
+ '',
+ '',
+ ],
+ )
+%>
+<%init>
+
+die "access denied"
+ unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
+
+</%init>
<% &ntable("#cccccc") %>
+% foreach my $field ($cust_main->virtual_fields) {
+ <% $cust_main->pvf($field)->widget('HTML', 'edit',$cust_main->getfield($field)) %>
+% }
+
%# tags
<& /elements/tr-select-cust_tag.html,
'custnum' => $custnum,
<BR>
-
-% #YUCK. false laziness w/part_svc.pm. go away virtual fields, please
% my %vfields;
-% foreach my $svcdb ( FS::part_svc->svc_tables() ) {
-% eval "use FS::$svcdb;";
-% my $self = "FS::$svcdb"->new;
-% $vfields{$svcdb} = {};
-% foreach my $field ($self->virtual_fields) { # svc_Common::virtual_fields with a null svcpart returns all of them
-% my $pvf = $self->pvf($field);
-% $vfields{$svcdb}->{$field} = $pvf;
-% #warn "\$vfields{$svcdb}->{$field} = $pvf";
-% } #next $field
-% } #next $svcdb
-%
% #code duplication w/ edit/part_svc.cgi, should move this hash to part_svc.pm
% # and generalize the subs
% # condition sub is tested to see whether to disable display of this choice
--- /dev/null
+<% include('elements/edit.html',
+ 'name_singular' => 'custom field',
+ 'viewall_dir' => 'browse',
+ 'table' => 'part_virtual_field',
+ 'labels' => { 'vfieldpart' => '',
+ 'dbtable' => 'Table',
+ 'name' => 'Name',
+ 'length' => 'Length',
+ 'label' => 'Label',
+ 'dbtable_dummy' => 'Table',
+ },
+ 'fields' => [
+ { field=>'vfieldpart', type=>'hidden', },
+ { field=>'name', type=>'text', },
+ { field => 'dbtable',
+ type => 'select',
+ options => [ 'svc_broadband', 'router', 'cust_main', ],
+ },
+ { field=>'label', type=>'text', },
+ { field=>'length', type=>'text', },
+ ],
+ 'edit_callback' => $callback,
+ 'error_callback' => $callback,
+ 'html_init' => 'Please be patient after clicking the button as
+ this process may take more than 10 seconds.
+ <br><br>',
+ )
+%>
+<%init>
+
+my $callback = sub {
+ my ($cgi, $object, $fields) = (shift, shift, shift);
+ my @edit_fixed_fields = qw( dbtable name length );
+ foreach my $f ( @{$fields} ) {
+ # XXX: editing anything other than label is disabled for now
+ $f->{type} = 'fixed'
+ if $object->vfieldpart && grep { $f->{field} eq $_ } @edit_fixed_fields;
+ }
+};
+
+die "access denied"
+ unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
+
+</%init>
--- /dev/null
+<% include( 'elements/process.html',
+ 'table' => 'part_virtual_field',
+ 'viewall_dir' => 'browse',
+ 'precheck_callback' => sub {
+ my ($cgi) = @_;
+ $act = 'edit' if $cgi->param('vfieldpart');
+ my @permitted_tables = qw( svc_broadband router cust_main );
+ return 'Table not in list of permitted tables'
+ unless $cgi->param('dbtable')
+ && grep { $_ eq $cgi->param('dbtable') } @permitted_tables;
+ '';
+ },
+ 'noerror_callback' => sub {
+ my ($cgi, $object) = @_;
+ if ( $act eq 'add' ) {
+ use FS::Schema qw( reload_dbdef );
+ warn "cf add started schema modification, time=".time;
+ my $dbh = dbh;
+ my $sql = "ALTER TABLE ".$object->dbtable." ADD COLUMN cf_".$object->name." varchar(".$object->length.")";
+ $dbh->do($sql) or die $dbh->errstr;
+ $sql = "ALTER TABLE h_".$object->dbtable." ADD COLUMN cf_".$object->name." varchar(".$object->length.")";
+ $dbh->do($sql) or die $dbh->errstr;
+
+ # apparently nothing happens w/o commit here - but is this OK?
+ $dbh->commit or die $dbh->errstr;
+
+ # reload schema
+ my $dbdef_file = "/usr/local/etc/freeside/dbdef.".datasrc # XXX: fix this
+ my $dbdef = new_native DBIx::DBSchema $dbh;
+ $dbdef->save($dbdef_file);
+ delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload
+ reload_dbdef($dbdef_file);
+
+ warn "cf add done schema modification, time=".time;
+ }
+ # XXX: edit is going to be harder: possibly add editing length and renaming column
+ '';
+ },
+)
+%>
+<%init>
+
+my $act = 'add';
+
+die "access denied"
+ unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
+
+</%init>
if $curuser->access_right('Edit advertising sources')
|| $curuser->access_right('Edit global advertising sources');
if ( $curuser->access_right('Configuration') ) {
- $config_misc{'Virtual fields'} = [ $fsurl.'browse/part_virtual_field.cgi', 'Locally defined fields', ];
+ $config_misc{'Custom fields'} = [ $fsurl.'browse/part_virtual_field.html', 'Locally defined fields', ];
$config_misc{'Message catalog'} = [ $fsurl.'browse/msgcat.html', 'Change error messages and other customizable labels for each locale' ];
}
$config_misc{'Inventory classes and inventory'} = [ $fsurl.'browse/inventory_class.html', 'Setup inventory classes and stock inventory' ]
% }
+% foreach (sort { $a cmp $b } $cust_main->virtual_fields) {
+ <% $cust_main->pvf($_)->widget('HTML', 'view', $cust_main->getfield($_)) %>
+% }
+
% if ( $conf->exists('ticket_system-selfservice_edit_subject') ) {
<TR>
projects / freeside.git / commitdiff