use File::CounterFile;
use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name);
use FS::dbdef;
-use diagnostics;
@ISA = qw(Exporter);
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
}
}
-=item qsearch TABLE, HASHREF
+=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL
Searches the database for all records matching (at least) the key/value pairs
in HASHREF. Returns all the records found as `FS::TABLE' objects if that
module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record
objects.
+###oops, argh, FS::Record::new only lets us create database fields.
+#Normal behaviour if SELECT is not specified is `*', as in
+#C<SELECT * FROM table WHERE ...>. However, there is an experimental new
+#feature where you can specify SELECT - remember, the objects returned,
+#although blessed into the appropriate `FS::TABLE' package, will only have the
+#fields you specify. This might have unwanted results if you then go calling
+#regular FS::TABLE methods
+#on it.
+
=cut
sub qsearch {
- my($table, $record) = @_;
+ my($table, $record, $select, $extra_sql ) = @_;
+ $select ||= '*';
my $dbh = dbh;
my @fields = grep exists($record->{$_}), fields($table);
- my $statement = "SELECT * FROM $table";
+ my $statement = "SELECT $select FROM $table";
if ( @fields ) {
- $statement .= " WHERE ". join(' AND ', map {
- if ( $record->{$_} eq '' || $record->{$_} eq undef ) {
+ $statement .= ' WHERE '. join(' AND ', map {
+ if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( driver_name eq 'Pg' ) {
"$_ IS NULL";
} else {
}
} @fields );
}
+ $statement .= " $extra_sql" if defined($extra_sql);
warn $statement if $DEBUG;
- my $sth = $dbh->prepare_cached($statement) or croak $dbh->errstr;
+ my $sth = $dbh->prepare_cached($statement)
+ or croak "$dbh->errstr doing $statement";
$sth->execute( map $record->{$_},
- grep $record->{$_} ne '' && $record->{$_} ne undef, @fields
+ grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
) or croak $dbh->errstr;
+ $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
local $SIG{PIPE} = 'IGNORE';
$sth->execute or return $sth->errstr;
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
'';
}
my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
undef $self; #no need to keep object!
my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found (or records identical)." if $rc eq "0E0";
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
'';
'';
}
-=item ut_phonen COLUMN
+=item ut_phonen COLUMN [ COUNTRY ]
Check/untaint phone numbers. May be null. If there is an error, returns
the error, otherwise returns false.
+Takes an optional two-letter ISO country code; without it or with unsupported
+countries, ut_phonen simply calls ut_alphan.
+
=cut
sub ut_phonen {
- my($self,$field)=@_;
+ my( $self, $field, $country ) = @_;
+ return $self->ut_alphan($field) unless defined $country;
my $phonen = $self->getfield($field);
if ( $phonen eq '' ) {
$self->setfield($field,'');
- } else {
+ } elsif ( $country eq 'US' ) {
$phonen =~ s/\D//g;
$phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
or return "Illegal (phone) $field: ". $self->getfield($field);
$phonen = "$1-$2-$3";
$phonen .= " x$4" if $4;
$self->setfield($field,$phonen);
+ } else {
+ warn "don't know how to check phone numbers for country $country";
+ return $self->ut_alphan($field);
}
'';
}
+=item ut_ip COLUMN
+
+Check/untaint ip addresses. IPv4 only for now.
+
+=cut
+
+sub ut_ip {
+ my( $self, $field ) = @_;
+ $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
+ or return "Illegal (IP address) $field: ". $self->getfield($field);
+ for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; }
+ $self->setfield($field, "$1.$2.$3.$3");
+ '';
+}
+
+=item ut_ipn COLUMN
+
+Check/untaint ip addresses. IPv4 only for now. May be null.
+
+=cut
+
+sub ut_ipn {
+ my( $self, $field ) = @_;
+ if ( $self->getfield($field) =~ /^()$/ ) {
+ $self->setfield($field,'');
+ '';
+ } else {
+ $self->ut_ip($field);
+ }
+}
+
+=item ut_domain COLUMN
+
+Check/untaint host and domain names.
+
+=cut
+
+sub ut_domain {
+ my( $self, $field ) = @_;
+ #$self->getfield($field) =~/^(\w+\.)*\w+$/
+ $self->getfield($field) =~/^(\w+\.)*\w+$/
+ or return "Illegal (domain) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=cut
+
=item ut_anything COLUMN
Untaints arbitrary data. Be careful.
# } (fields($self->table)) );
#}
+sub DESTROY { return; }
+
#sub DESTROY {
# my $self = shift;
# #use Carp qw(cluck);
=head1 VERSION
-$Id: Record.pm,v 1.4 2000-06-23 12:25:59 ivan Exp $
+$Id: Record.pm,v 1.12 2001-02-03 14:03:49 ivan Exp $
=head1 BUGS