&& dbdef->table($table)->column($field)->type =~ /(int|(big)?serial)/i
) {
$sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
+ }elsif ( $record->{$field} =~ /^[+-]?\d+(\.\d+)?$/
+ && dbdef->table($table)->column($field)->type =~ /(numeric)/i
+ ) {
+ $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_FLOAT } );
+ }elsif ( $record->{$field} =~ /[-+]?\d*\.?\d+([eE][-+]?\d+)?/
+ && dbdef->table($table)->column($field)->type =~ /(float4)/i
+ ) {
+ $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_FLOAT } );
} else {
$sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } );
}
sub ut_float {
my($self,$field)=@_ ;
- ($self->getfield($field) =~ /^(\d+\.\d+)$/ ||
- $self->getfield($field) =~ /^(\d+)$/ ||
- $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
- $self->getfield($field) =~ /^(\d+e\d+)$/)
+ ($self->getfield($field) =~ /^\s*(\d+\.\d+)\s*$/ ||
+ $self->getfield($field) =~ /^\s*(\d+)\s*$/ ||
+ $self->getfield($field) =~ /^\s*(\d+\.\d+e\d+)\s*$/ ||
+ $self->getfield($field) =~ /^\s*(\d+e\d+)\s*$/)
or return "Illegal or empty (float) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
sub ut_sfloat {
my($self,$field)=@_ ;
- ($self->getfield($field) =~ /^(-?\d+\.\d+)$/ ||
- $self->getfield($field) =~ /^(-?\d+)$/ ||
- $self->getfield($field) =~ /^(-?\d+\.\d+[eE]-?\d+)$/ ||
- $self->getfield($field) =~ /^(-?\d+[eE]-?\d+)$/)
+ ($self->getfield($field) =~ /^\s*(-?\d+\.\d+)\s*$/ ||
+ $self->getfield($field) =~ /^\s*(-?\d+)\s*$/ ||
+ $self->getfield($field) =~ /^\s*(-?\d+\.\d+[eE]-?\d+)\s*$/ ||
+ $self->getfield($field) =~ /^\s*(-?\d+[eE]-?\d+)\s*$/)
or return "Illegal or empty (float) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
sub ut_snumber {
my($self, $field) = @_;
- $self->getfield($field) =~ /^(-?)\s*(\d+)$/
+ $self->getfield($field) =~ /^\s*(-?)\s*(\d+)\s*$/
or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
$self->setfield($field, "$1$2");
'';
sub ut_snumbern {
my($self, $field) = @_;
- $self->getfield($field) =~ /^(-?)\s*(\d*)$/
+ $self->getfield($field) =~ /^\s*(-?)\s*(\d*)\s*$/
or return "Illegal (numeric) $field: ". $self->getfield($field);
if ($1) {
return "Illegal (numeric) $field: ". $self->getfield($field)
sub ut_number {
my($self,$field)=@_;
- $self->getfield($field) =~ /^(\d+)$/
+ $self->getfield($field) =~ /^\s*(\d+)\s*$/
or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
sub ut_numbern {
my($self,$field)=@_;
- $self->getfield($field) =~ /^(\d*)$/
+ $self->getfield($field) =~ /^\s*(\d*)\s*$/
or return "Illegal (numeric) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
sub ut_money {
my($self,$field)=@_;
$self->setfield($field, 0) if $self->getfield($field) eq '';
- $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/
+ $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/
or return "Illegal (money) $field: ". $self->getfield($field);
#$self->setfield($field, "$1$2$3" || 0);
$self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0);
'';
}
+=item ut_alpha_lower COLUMN
+
+Check/untaint lowercase alphanumeric strings (no spaces). May not be null. If
+there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_alpha_lower {
+ my($self,$field)=@_;
+ $self->getfield($field) =~ /[[:upper:]]/
+ and return "Uppercase characters are not permitted in $field";
+ $self->ut_alpha($field);
+}
+
=item ut_phonen COLUMN [ COUNTRY ]
Check/untaint phone numbers. May be null. If there is an error, returns
if ( $self->$field() ) {
- return "Access deined"
+ return "Access denied"
unless $curuser->agentnum($self->$field());
} else {
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
''
}
-=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 _quote VALUE, TABLE, COLUMN
-
-This is an internal function used to construct SQL statements. It returns
-VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
-type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
-
-=cut
-
-sub _quote {
- my($value, $table, $column) = @_;
- my $column_obj = dbdef->table($table)->column($column);
- my $column_type = $column_obj->type;
- my $nullable = $column_obj->null;
-
- warn " $table.$column: $value ($column_type".
- ( $nullable ? ' NULL' : ' NOT NULL' ).
- ")\n" if $DEBUG > 2;
-
- if ( $value eq '' && $nullable ) {
- 'NULL'
- } elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) {
- cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
- "using 0 instead";
- 0;
- } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
- ! $column_type =~ /(char|binary|text)$/i ) {
- $value;
- } else {
- dbh->quote($value);
- }
-}
-
=item vfieldpart_hashref TABLE
Returns a hashref of virtual field names and vfieldparts applicable to the given
}
-
-=item hfields TABLE
-
-This is deprecated. 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";
- my($table)=@_;
- my(%hash);
- foreach (fields($table)) {
- $hash{$_}=1;
- }
- \%hash;
-}
-
-sub _dump {
- my($self)=@_;
- join("\n", map {
- "$_: ". $self->getfield($_). "|"
- } (fields($self->table)) );
-}
-
=item encrypt($value)
Encrypts the credit card using a combination of PK to encrypt and uuencode to armour.
=cut
-
sub encrypt {
my ($self, $value) = @_;
my $encrypted;
}
}
+=item h_search ACTION
+
+Given an ACTION, either "insert", or "delete", returns the appropriate history
+record corresponding to this record, if any.
+
+=cut
+
+sub h_search {
+ my( $self, $action ) = @_;
+
+ my $table = $self->table;
+ $table =~ s/^h_//;
+
+ my $primary_key = dbdef->table($table)->primary_key;
+
+ qsearchs({
+ 'table' => "h_$table",
+ 'hashref' => { $primary_key => $self->$primary_key(),
+ 'history_action' => $action,
+ },
+ });
+
+}
+
+=item h_date ACTION
+
+Given an ACTION, either "insert", or "delete", returns the timestamp of the
+appropriate history record corresponding to this record, if any.
+
+=cut
+
+sub h_date {
+ my($self, $action) = @_;
+ my $h = $self->h_search($action);
+ $h ? $h->history_date : '';
+}
+
+=back
+
+=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 _quote VALUE, TABLE, COLUMN
+
+This is an internal function used to construct SQL statements. It returns
+VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
+type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
+
+=cut
+
+sub _quote {
+ my($value, $table, $column) = @_;
+ my $column_obj = dbdef->table($table)->column($column);
+ my $column_type = $column_obj->type;
+ my $nullable = $column_obj->null;
+
+ warn " $table.$column: $value ($column_type".
+ ( $nullable ? ' NULL' : ' NOT NULL' ).
+ ")\n" if $DEBUG > 2;
+
+ if ( $value eq '' && $nullable ) {
+ 'NULL'
+ } elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) {
+ cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
+ "using 0 instead";
+ 0;
+ } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
+ ! $column_type =~ /(char|binary|text)$/i ) {
+ $value;
+ } else {
+ dbh->quote($value);
+ }
+}
+
+=item hfields TABLE
+
+This is deprecated. 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";
+ my($table)=@_;
+ my(%hash);
+ foreach (fields($table)) {
+ $hash{$_}=1;
+ }
+ \%hash;
+}
+
+sub _dump {
+ my($self)=@_;
+ join("\n", map {
+ "$_: ". $self->getfield($_). "|"
+ } (fields($self->table)) );
+}
+
sub DESTROY { return; }
#sub DESTROY {
# return ! eval { join('',@_), kill 0; 1; };
# }
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
=item str2time_sql [ DRIVER_NAME ]
Returns a function to convert to unix time based on database type, such as
-"EXTRACT( EPOCH FROM" for Pg or "UNIX_TIMESTAMP(" for mysql. You are
-responsible for the closing parenthesis yourself. Don't let it down. It's a
-sensitive parenthesis.
+"EXTRACT( EPOCH FROM" for Pg or "UNIX_TIMESTAMP(" for mysql. See
+the str2time_sql_closing method to return a closing string rather than just
+using a closing parenthesis as previously suggested.
You can pass an optional driver name such as "Pg", "mysql" or
$dbh->{Driver}->{Name} to return a function for that database instead of
}
+=item str2time_sql_closing [ DRIVER_NAME ]
+
+Returns the closing suffix of a function to convert to unix time based on
+database type, such as ")::integer" for Pg or ")" for mysql.
+
+You can pass an optional driver name such as "Pg", "mysql" or
+$dbh->{Driver}->{Name} to return a function for that database instead of
+the current database.
+
+=cut
+
+sub str2time_sql_closing {
+ my $driver = shift || driver_name;
+
+ return ' )::INTEGER ' if $driver =~ /^Pg/i;
+ return ' ) ';
+}
+
=back
=head1 BUGS
projects / freeside.git / blobdiff