my @bind_type = ();
my $dbh = dbh;
foreach my $stable ( @stable ) {
+
+ carp '->qsearch on cust_main called' if $stable eq 'cust_main' && $DEBUG;
+
#stop altering the caller's hashref
my $record = { %{ shift(@record) || {} } };#and be liberal in receipt
my $select = shift @select;
eval "use FS::$table";
die $@ if $@;
+ carp '->cust_main called' if $table eq 'cust_main' && $DEBUG;
+
my $pkey_value = $self->$column();
my %search = ( $foreign_column => $pkey_value );
$self->{'Hash'};
}
+#fallbacks/generics
+
+sub API_getinfo {
+ my $self = shift;
+ +{ ( map { $_=>$self->$_ } $self->fields ),
+ };
+}
+
+sub API_insert {
+ my( $class, %opt ) = @_;
+ my $table = $class->table;
+ my $self = $class->new( { map { $_ => $opt{$_} } fields($table) } );
+ my $error = $self->insert;
+ return +{ 'error' => $error } if $error;
+ my $pkey = $self->pkey;
+ return +{ 'error' => '',
+ 'primary_key' => $pkey,
+ $pkey => $self->$pkey,
+ };
+}
+
=item modified
Returns true if any of this object's values have been modified with set (or via
#warn "msgcat ". \&msgcat. "\n";
#warn "notexist ". \¬exist. "\n";
#warn "AUTOLOAD ". \&AUTOLOAD. "\n";
+ # \p{Word} = alphanumerics, marks (diacritics), and connectors
+ # see perldoc perluniprops
$self->getfield($field)
- =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
+ =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
or return gettext('illegal_or_empty_text'). " $field: ".
$self->getfield($field);
$self->setfield($field,$1);
sub ut_name {
my( $self, $field ) = @_;
# warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
- $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
+ $self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/
or return gettext('illegal_name'). " $field: ". $self->getfield($field);
my $name = $1;
$name =~ s/^\s+//;
my $column_type = $column_obj->type;
my $nullable = $column_obj->null;
+ utf8::upgrade($value);
+
warn " $table.$column: $value ($column_type".
( $nullable ? ' NULL' : ' NOT NULL' ).
")\n" if $DEBUG > 2;