X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=dd8cc542c803ec30f4396c73b5e24827f5331dd8;hp=0d989e30054d0cf4a2ba7492a44344325f0dddfe;hb=d220c8a4bfa1aee8f17ed71c2dba655160dd3595;hpb=b4a403644cb80a612dd028882f971bdd20839275

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 0d989e300..dd8cc542c 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -8,7 +8,6 @@ use Carp qw(carp cluck croak confess);
 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);
@@ -150,25 +149,35 @@ sub create {
   }
 }
 
-=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 {
@@ -179,13 +188,16 @@ sub qsearch {
       }
     } @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 ) {
@@ -377,6 +389,7 @@ sub insert {
   local $SIG{PIPE} = 'IGNORE';
 
   $sth->execute or return $sth->errstr;
+  dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
 }
@@ -426,6 +439,7 @@ sub delete {
 
   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!
 
@@ -497,6 +511,7 @@ sub replace {
 
   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;
 
   '';
 
@@ -694,29 +709,84 @@ sub ut_alphan {
   '';
 }
 
-=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.
@@ -826,6 +896,8 @@ sub hfields {
 #  } (fields($self->table)) );
 #}
 
+sub DESTROY { return; }
+
 #sub DESTROY {
 #  my $self = shift;
 #  #use Carp qw(cluck);
@@ -841,7 +913,7 @@ sub hfields {
 
 =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