X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=ca68c3596ff17462fcc455f0df4131ea619616f4;hp=e63abf2ce75f68d965ed3e56e9789e3ebba9530d;hb=1ad547a47f16b4230762e752fbe48d460ed997e1;hpb=c405e80203f323a83b447d6fc899dbba32d52f2a

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index e63abf2ce..ca68c3596 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -3,7 +3,8 @@ package FS::Record;
 use strict;
 use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
              %virtual_fields_cache
-             $conf $conf_encryption $me
+             $conf $conf_encryption $money_char $lat_lower $lon_upper
+             $me
              $nowarn_identical $nowarn_classload
              $no_update_diff $no_check_foreign
              @encrypt_payby
@@ -38,6 +39,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;
@@ -56,17 +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
@@ -272,7 +282,7 @@ sub _bind_type {
 
   my $bind_type = { TYPE => SQL_VARCHAR };
 
-  if ( $type =~ /(big)?(int|serial)/i && $value =~ /^\d+(\.\d+)?$/ ) {
+  if ( $type =~ /(big)?(int|serial)/i && $value =~ /^-?\d+(\.\d+)?$/ ) {
 
     $bind_type = { TYPE => SQL_INTEGER };
 
@@ -568,6 +578,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
@@ -889,10 +901,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
@@ -927,7 +941,7 @@ sub insert {
                     || $self->isa('FS::payinfo_Mixin') )
                 && $self->payby
                 && !grep { $self->payby eq $_ } @encrypt_payby;
-      $self->{'saved'} = $self->getfield($field);
+      $saved->{$field} = $self->getfield($field);
       $self->setfield($field, $self->encrypt($self->getfield($field)));
     }
   }
@@ -1180,7 +1194,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 '';
   }
@@ -1836,7 +1852,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;
   }
 
@@ -2074,7 +2090,7 @@ sub ut_text {
   #warn "notexist ". \&notexist. "\n";
   #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
   $self->getfield($field)
-    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
+    =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
       or return gettext('illegal_or_empty_text'). " $field: ".
                  $self->getfield($field);
   $self->setfield($field,$1);
@@ -2084,7 +2100,7 @@ sub ut_text {
 =item ut_textn COLUMN
 
 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
+symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < >
 May be null.  If there is an error, returns the error, otherwise returns false.
 
 =cut
@@ -2215,6 +2231,42 @@ sub ut_hexn {
   $self->setfield($field, uc($1));
   '';
 }
+
+=item ut_mac_addr COLUMN
+
+Check/untaint mac addresses.  May be null.
+
+=cut
+
+sub ut_mac_addr {
+  my($self, $field) = @_;
+
+  my $mac = $self->get($field);
+  $mac =~ s/\s+//g;
+  $mac =~ s/://g;
+  $self->set($field, $mac);
+
+  my $e = $self->ut_hex($field);
+  return $e if $e;
+
+  return "Illegal (mac address) $field: ". $self->getfield($field)
+    unless length($self->getfield($field)) == 12;
+
+  '';
+
+}
+
+=item ut_mac_addrn COLUMN
+
+Check/untaint mac addresses.  May be null.
+
+=cut
+
+sub ut_mac_addrn {
+  my($self, $field) = @_;
+  ($self->getfield($field) eq '') ? '' : $self->ut_mac_addr($field);
+}
+
 =item ut_ip COLUMN
 
 Check/untaint ip addresses.  IPv4 only for now, though ::1 is auto-translated
@@ -2303,11 +2355,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/^(-)//;
 
@@ -2355,7 +2413,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, @_);
@@ -2363,10 +2421,9 @@ sub ut_coordn {
 
 }
 
-
 =item ut_domain COLUMN
 
-Check/untaint host and domain names.
+Check/untaint host and domain names.  May not be null.
 
 =cut
 
@@ -2374,11 +2431,27 @@ sub ut_domain {
   my( $self, $field ) = @_;
   #$self->getfield($field) =~/^(\w+\.)*\w+$/
   $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/
-    or return "Illegal (domain) $field: ". $self->getfield($field);
+    or return "Illegal (hostname) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
 
+=item ut_domainn COLUMN
+
+Check/untaint host and domain names.  May be null.
+
+=cut
+
+sub ut_domainn {
+  my( $self, $field ) = @_;
+  if ( $self->getfield($field) =~ /^()$/ ) {
+    $self->setfield($field,'');
+    '';
+  } else {
+    $self->ut_domain($field);
+  }
+}
+
 =item ut_name COLUMN
 
 Check/untaint proper names; allows alphanumerics, spaces and the following
@@ -2430,7 +2503,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);
     }
@@ -2505,6 +2578,22 @@ sub ut_enumn {
     : '';
 }
 
+=item ut_flag COLUMN
+
+Check/untaint a column if it contains either an empty string or 'Y'.  This
+is the standard form for boolean flags in Freeside.
+
+=cut
+
+sub ut_flag {
+  my( $self, $field ) = @_;
+  my $value = uc($self->getfield($field));
+  if ( $value eq '' or $value eq 'Y' ) {
+    $self->setfield($field, $value);
+    return '';
+  }
+  return "Illegal (flag) field $field: $value";
+}
 
 =item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
 
@@ -2747,6 +2836,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
@@ -2957,7 +3062,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
@@ -2978,6 +3083,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