X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=2c506ff0f260ccfbfa73064cfd8895513b9970db;hb=736136102c6fc01fbc9d70358e6e457a09687944;hp=7531cf0f33b8aad23bb044a72803cd2383358e86;hpb=d8db2e251eefc361bf435ad5a4cae26785fc6799;p=freeside.git

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 7531cf0f3..2c506ff0f 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -3,10 +3,10 @@ package FS::Record;
 use strict;
 use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
              %virtual_fields_cache
-             $conf $conf_encryption $money_char
+             $conf $conf_encryption $money_char $lat_lower $lon_upper
              $me
              $nowarn_identical $nowarn_classload
-             $no_update_diff $no_check_foreign
+             $no_update_diff $no_history $no_check_foreign
              @encrypt_payby
            );
 use Exporter;
@@ -38,6 +38,7 @@ use Tie::IxHash;
 @EXPORT_OK = qw(
   dbh fields hfields qsearch qsearchs dbdef jsearch
   str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql
+  midnight_sql
 );
 
 $DEBUG = 0;
@@ -46,6 +47,7 @@ $me = '[FS::Record]';
 $nowarn_identical = 0;
 $nowarn_classload = 0;
 $no_update_diff = 0;
+$no_history = 0;
 $no_check_foreign = 0;
 
 my $rsa_module;
@@ -56,18 +58,25 @@ my $rsa_decrypt;
 $conf = '';
 $conf_encryption = '';
 FS::UID->install_callback( sub {
+
   eval "use FS::Conf;";
   die $@ if $@;
   $conf = FS::Conf->new; 
   $conf_encryption = $conf->exists('encryption');
   $money_char = $conf->config('money_char') || '$';
+  my $nw_coords = $conf->exists('geocode-require_nw_coordinates');
+  $lat_lower = $nw_coords ? 1 : -90;
+  $lon_upper = $nw_coords ? -1 : 180;
+
   $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
+
   if ( driver_name eq 'Pg' ) {
     eval "use DBD::Pg ':pg_types'";
     die $@ if $@;
   } else {
     eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
   }
+
 } );
 
 =head1 NAME
@@ -655,6 +664,8 @@ sub get_real_fields {
             qq-( $column $op "" )-;
           }
         }
+      } elsif ( $op eq '!=' ) {
+        qq-( $column IS NULL OR $column != ? )-;
       #if this needs to be re-enabled, it needs to use a custom op like
       #"APPROX=" or something (better name?, not '=', to avoid affecting other
       # searches
@@ -976,10 +987,12 @@ sub insert {
   my $error = $self->check;
   return $error if $error;
 
-  #single-field unique keys are given a value if false
+  #single-field non-null unique keys are given a value if empty
   #(like MySQL's AUTO_INCREMENT or Pg SERIAL)
   foreach ( $self->dbdef_table->unique_singles) {
-    $self->unique($_) unless $self->getfield($_);
+    next if $self->getfield($_);
+    next if $self->dbdef_table->column($_)->null eq 'NULL';
+    $self->unique($_);
   }
 
   #and also the primary key, if the database isn't going to
@@ -1309,7 +1322,9 @@ sub replace {
                    ? ($_, $new->getfield($_)) : () } $old->fields;
                    
   unless (keys(%diff) || $no_update_diff ) {
-    carp "[warning]$me $new -> replace $old: records identical"
+    carp "[warning]$me ". ref($new)."->replace ".
+           ( $primary_key ? "$primary_key ".$new->get($primary_key) : '' ).
+         ": records identical"
       unless $nowarn_identical;
     return '';
   }
@@ -1769,7 +1784,7 @@ sub batch_import {
 
     if ( $type eq 'csv' ) {
 
-      my %attr = ();
+      my %attr = ( 'binary' => 1, );
       $attr{sep_char} = $sep_char if $sep_char;
       $parser = new Text::CSV_XS \%attr;
 
@@ -2006,7 +2021,7 @@ sub _h_statement {
   ;
 
   # If we're encrypting then don't store the payinfo in the history
-  if ( $conf && $conf->exists('encryption') ) {
+  if ( $conf && $conf->exists('encryption') && $self->table ne 'banned_pay' ) {
     @fields = grep { $_ ne 'payinfo' } @fields;
   }
 
@@ -2205,11 +2220,18 @@ is an error, returns the error, otherwise returns false.
 
 sub ut_money {
   my($self,$field)=@_;
-  $self->setfield($field, 0) if $self->getfield($field) eq '';
-  $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);
+
+  if ( $self->getfield($field) eq '' ) {
+    $self->setfield($field, 0);
+  } elsif ( $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{1})\s*$/ ) {
+    #handle one decimal place without barfing out
+    $self->setfield($field, ( ($1||''). ($2||''). ($3.'0') ) || 0);
+  } elsif ( $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/ ) {
+    $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0);
+  } else {
+    return "Illegal (money) $field: ". $self->getfield($field);
+  }
+
   '';
 }
 
@@ -2509,11 +2531,17 @@ for lower and upper bounds, respectively.
 =cut
 
 sub ut_coord {
-
   my ($self, $field) = (shift, shift);
 
-  my $lower = shift if scalar(@_);
-  my $upper = shift if scalar(@_);
+  my($lower, $upper);
+  if ( $field =~ /latitude/ ) {
+    $lower = $lat_lower;
+    $upper = 90;
+  } elsif ( $field =~ /longitude/ ) {
+    $lower = -180;
+    $upper = $lon_upper;
+  }
+
   my $coord = $self->getfield($field);
   my $neg = $coord =~ s/^(-)//;
 
@@ -2561,7 +2589,7 @@ sub ut_coordn {
 
   my ($self, $field) = (shift, shift);
 
-  if ($self->getfield($field) =~ /^$/) {
+  if ($self->getfield($field) =~ /^\s*$/) {
     return '';
   } else {
     return $self->ut_coord($field, @_);
@@ -2599,10 +2627,29 @@ sub ut_name {
 #  warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
   $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
     or return gettext('illegal_name'). " $field: ". $self->getfield($field);
-  $self->setfield($field,$1);
+  my $name = $1;
+  $name =~ s/^\s+//; 
+  $name =~ s/\s+$//; 
+  $name =~ s/\s+/ /g;
+  $self->setfield($field, $name);
   '';
 }
 
+=item ut_namen COLUMN
+
+Check/untaint proper names; allows alphanumerics, spaces and the following
+punctuation: , . - '
+
+May not be null.
+
+=cut
+
+sub ut_namen {
+  my( $self, $field ) = @_;
+  return $self->setfield($field, '') if $self->getfield($field) =~ /^$/;
+  $self->ut_name($field);
+}
+
 =item ut_zip COLUMN
 
 Check/untaint zip codes.
@@ -2636,7 +2683,7 @@ sub ut_zip {
     {
       $self->setfield($field,'');
     } else {
-      $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+      $self->getfield($field) =~ /^\s*(\w[\w\-\s]{0,8}\w)\s*$/
         or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
       $self->setfield($field,$1);
     }
@@ -3023,6 +3070,22 @@ sub scalar_sql {
   defined($scalar) ? $scalar : '';
 }
 
+=item count [ WHERE ]
+
+Convenience method for the common case of "SELECT COUNT(*) FROM table", 
+with optional WHERE.  Must be called as method on a class with an 
+associated table.
+
+=cut
+
+sub count {
+  my($self, $where) = (shift, shift);
+  my $table = $self->table or die 'count called on object of class '.ref($self);
+  my $sql = "SELECT COUNT(*) FROM $table";
+  $sql .= " WHERE $where" if $where;
+  $self->scalar_sql($sql);
+}
+
 =back
 
 =head1 SUBROUTINES
@@ -3210,7 +3273,7 @@ sub not_regexp_sql {
 
 =item concat_sql [ DRIVER_NAME ] ITEMS_ARRAYREF
 
-Returns the items concatendated based on database type, using "CONCAT()" for
+Returns the items concatenated based on database type, using "CONCAT()" for
 mysql and " || " for Pg and other databases.
 
 You can pass an optional driver name such as "Pg", "mysql" or
@@ -3231,6 +3294,24 @@ sub concat_sql {
 
 }
 
+=item midnight_sql DATE
+
+Returns an SQL expression to convert DATE (a unix timestamp) to midnight 
+on that day in the system timezone, using the default driver name.
+
+=cut
+
+sub midnight_sql {
+  my $driver = driver_name;
+  my $expr = shift;
+  if ( $driver =~ /^mysql/i ) {
+    "UNIX_TIMESTAMP(DATE(FROM_UNIXTIME($expr)))";
+  }
+  else {
+    "EXTRACT( EPOCH FROM DATE(TO_TIMESTAMP($expr)) )";
+  }
+}
+
 =back
 
 =head1 BUGS