diff options
author | levinse <levinse> | 2011-07-22 18:59:27 +0000 |
---|---|---|
committer | levinse <levinse> | 2011-07-22 18:59:27 +0000 |
commit | c405e80203f323a83b447d6fc899dbba32d52f2a (patch) | |
tree | aa7cc7ad31c43eb012ad3d9b787ee0a51bb6b4ac /FS/FS | |
parent | 99e8e2006117bd4b97ebb1daf897cc257265dc3f (diff) |
custom fields, RT11714
Diffstat (limited to 'FS/FS')
-rw-r--r-- | FS/FS/Record.pm | 343 | ||||
-rw-r--r-- | FS/FS/part_svc.pm | 26 | ||||
-rwxr-xr-x | FS/FS/part_virtual_field.pm | 224 |
3 files changed, 118 insertions, 475 deletions
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 411e9110f..e63abf2ce 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2,8 +2,8 @@ package FS::Record; 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 @@ -23,6 +23,7 @@ use FS::Schema qw(dbdef); 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; @@ -378,22 +379,12 @@ sub qsearch { 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); @@ -459,21 +450,11 @@ sub qsearch { $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( {} ) }; @@ -485,28 +466,6 @@ sub qsearch { $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 ) { @@ -556,50 +515,6 @@ sub qsearch { ## 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; @@ -1110,34 +1025,6 @@ sub insert { } - 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'); @@ -1209,17 +1096,6 @@ sub delete { } 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'; @@ -1231,9 +1107,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; @@ -1362,44 +1235,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'; @@ -1412,23 +1247,6 @@ sub replace { $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 @@ -1470,35 +1288,49 @@ sub rep { =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 @@ -2737,40 +2569,9 @@ sub ut_agentnum_acl { } -=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 @@ -2784,48 +2585,9 @@ sub fields { $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) @@ -3006,6 +2768,29 @@ sub real_fields { $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 diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 3ae79a6df..1306d4199 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -82,12 +82,12 @@ the part_svc_column table appropriately (see L<FS::part_svc_column>). =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 @@ -618,28 +618,6 @@ sub _svc_defs { 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 } diff --git a/FS/FS/part_virtual_field.pm b/FS/FS/part_virtual_field.pm index f5a416110..4e6d2e4bd 100755 --- a/FS/FS/part_virtual_field.pm +++ b/FS/FS/part_virtual_field.pm @@ -29,11 +29,9 @@ FS::part_virtual_field - Object methods for part_virtual_field records =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: @@ -46,75 +44,12 @@ 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 @@ -128,87 +63,13 @@ Create a new record. To add the record to the database, see "insert". 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> @@ -235,22 +96,12 @@ sub widget { } 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 ''; @@ -261,38 +112,67 @@ sub widget { 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 |