use Locale::Country;
use DBI qw(:sql_types);
use DBIx::DBSchema 0.25;
+#use DBIx::DBSchema 0.33; #when check for ->can('unique_singles') is sub insert
+ #is removed
use FS::UID qw(dbh getotaker datasrc driver_name);
use FS::CurrentUser;
use FS::Schema qw(dbdef);
@ISA = qw(Exporter);
#export dbdef for now... everything else expects to find it here
-@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
+@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch
+ str2time_sql str2time_sql_closing );
$DEBUG = 0;
$me = '[FS::Record]';
#these are optional...
'select' => '*',
'extra_sql' => 'AND field ',
+ 'order_by' => 'ORDER BY something',
#'cache_obj' => '', #optional
'addl_from' => 'LEFT JOIN othtable USING ( field )',
}
=cut
sub qsearch {
- my($stable, $record, $select, $extra_sql, $cache, $addl_from );
+ my($stable, $record, $select, $extra_sql, $order_by, $cache, $addl_from );
if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too
my $opt = shift;
$stable = $opt->{'table'} or die "table name is required";
$record = $opt->{'hashref'} || {};
$select = $opt->{'select'} || '*';
$extra_sql = $opt->{'extra_sql'} || '';
+ $order_by = $opt->{'order_by'} || '';
$cache = $opt->{'cache_obj'} || '';
$addl_from = $opt->{'addl_from'} || '';
} else {
}
$statement .= " $extra_sql" if defined($extra_sql);
+ $statement .= " $order_by" if defined($order_by);
warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = $dbh->prepare($statement)
foreach my $field (
grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
) {
- if ( $record->{$field} =~ /^\d+(\.\d+)?$/
- && dbdef->table($table)->column($field)->type =~ /(int|(big)?serial)/i
- ) {
- $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
+ my $value = $record->{$field};
+ #done above in 1.7# $value = $value->{'value'} if ref($value);
+ my $type = dbdef->table($table)->column($field)->type;
+ if ( $type =~ /(int|(big)?serial)/i && $value =~ /^\d+(\.\d+)?$/ ) {
+ $sth->bind_param($bind++, $value, { TYPE => SQL_INTEGER } );
+ } elsif ( ( $type =~ /(numeric)/i && $value =~ /^[+-]?\d+(\.\d+)?$/)
+ || ( $type =~ /(real|float4)/i
+ && $value =~ /[-+]?\d*\.?\d+([eE][-+]?\d+)?/
+ )
+ ) {
+ $sth->bind_param($bind++, $value, { TYPE => SQL_FLOAT } );
} else {
- $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } );
+ $sth->bind_param($bind++, $value, { TYPE => SQL_VARCHAR } );
}
}
#single-field unique keys are given a value if false
#(like MySQL's AUTO_INCREMENT or Pg SERIAL)
- foreach ( $self->dbdef_table->unique->singles ) {
+ foreach ( $self->dbdef_table->can('unique_singles')
+ ? $self->dbdef_table->unique_singles
+ : $self->dbdef_table->unique->singles
+ ) {
$self->unique($_) unless $self->getfield($_);
}
'';
}
+=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
$self->setfield($field,'');
} elsif ( $country eq 'US' || $country eq 'CA' ) {
$phonen =~ s/\D//g;
+ $phonen = $conf->config('cust_main-default_areacode').$phonen
+ if length($phonen)==7 && $conf->config('cust_main-default_areacode');
$phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
or return gettext('illegal_phone'). " $field: ". $self->getfield($field);
$phonen = "$1-$2-$3";
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; };
# }
+=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. 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
+the current database.
+
+=cut
+
+sub str2time_sql {
+ my $driver = shift || driver_name;
+
+ return 'UNIX_TIMESTAMP(' if $driver =~ /^mysql/i;
+ return 'EXTRACT( EPOCH FROM ' if $driver =~ /^Pg/i;
+
+ warn "warning: unknown database type $driver; guessing how to convert ".
+ "dates to UNIX timestamps";
+ return 'EXTRACT(EPOCH FROM ';
+
+}
+
+=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