Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / FS / FS / Record.pm
index be35521..71eddc1 100644 (file)
@@ -506,7 +506,7 @@ sub qsearch {
     # Check for encrypted fields and decrypt them.
    ## only in the local copy, not the cached object
     if ( $conf_encryption 
-         && eval 'defined(@FS::'. $table . '::encrypted_fields)' ) {
+         && eval '@FS::'. $table . '::encrypted_fields' ) {
       foreach my $record (@return) {
         foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
           next if $field eq 'payinfo' 
@@ -529,6 +529,215 @@ sub qsearch {
   return @return;
 }
 
+=item _query
+
+Construct the SQL statement and parameter-binding list for qsearch.  Takes
+the qsearch parameters.
+
+Returns a hash containing:
+'table':      The primary table name (if there is one).
+'statement':  The SQL statement itself.
+'bind_type':  An arrayref of bind types.
+'value':      An arrayref of parameter values.
+'cache':      The cache object, if one was passed.
+
+=cut
+
+sub _query {
+  my( @stable, @record, @cache );
+  my( @select, @extra_sql, @extra_param, @order_by, @addl_from );
+  my @debug = ();
+  my $cursor = '';
+  my %union_options = ();
+  if ( ref($_[0]) eq 'ARRAY' ) {
+    my $optlist = shift;
+    %union_options = @_;
+    foreach my $href ( @$optlist ) {
+      push @stable,      ( $href->{'table'} or die "table name is required" );
+      push @record,      ( $href->{'hashref'}     || {} );
+      push @select,      ( $href->{'select'}      || '*' );
+      push @extra_sql,   ( $href->{'extra_sql'}   || '' );
+      push @extra_param, ( $href->{'extra_param'} || [] );
+      push @order_by,    ( $href->{'order_by'}    || '' );
+      push @cache,       ( $href->{'cache_obj'}   || '' );
+      push @addl_from,   ( $href->{'addl_from'}   || '' );
+      push @debug,       ( $href->{'debug'}       || '' );
+    }
+    die "at least one hashref is required" unless scalar(@stable);
+  } elsif ( ref($_[0]) eq 'HASH' ) {
+    my $opt = shift;
+    $stable[0]      = $opt->{'table'}       or die "table name is required";
+    $record[0]      = $opt->{'hashref'}     || {};
+    $select[0]      = $opt->{'select'}      || '*';
+    $extra_sql[0]   = $opt->{'extra_sql'}   || '';
+    $extra_param[0] = $opt->{'extra_param'} || [];
+    $order_by[0]    = $opt->{'order_by'}    || '';
+    $cache[0]       = $opt->{'cache_obj'}   || '';
+    $addl_from[0]   = $opt->{'addl_from'}   || '';
+    $debug[0]       = $opt->{'debug'}       || '';
+  } else {
+    ( $stable[0],
+      $record[0],
+      $select[0],
+      $extra_sql[0],
+      $cache[0],
+      $addl_from[0]
+    ) = @_;
+    $select[0] ||= '*';
+  }
+  my $cache = $cache[0];
+
+  my @statement = ();
+  my @value = ();
+  my @bind_type = ();
+
+  my $result_table = $stable[0];
+  foreach my $stable ( @stable ) {
+    #stop altering the caller's hashref
+    my $record      = { %{ shift(@record) || {} } };#and be liberal in receipt
+    my $select      = shift @select;
+    my $extra_sql   = shift @extra_sql;
+    my $extra_param = shift @extra_param;
+    my $order_by    = shift @order_by;
+    my $cache       = shift @cache;
+    my $addl_from   = shift @addl_from;
+    my $debug       = shift @debug;
+
+    #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
+    #for jsearch
+    $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
+    $stable = $1;
+
+    $result_table = '' if $result_table ne $stable;
+
+    my $table = $cache ? $cache->table : $stable;
+    my $dbdef_table = dbdef->table($table)
+      or die "No schema for table $table found - ".
+             "do you need to run freeside-upgrade?";
+    my $pkey = $dbdef_table->primary_key;
+
+    my @real_fields = grep exists($record->{$_}), real_fields($table);
+
+    my $statement .= "SELECT $select FROM $stable";
+    $statement .= " $addl_from" if $addl_from;
+    if ( @real_fields ) {
+      $statement .= ' WHERE '. join(' AND ',
+        get_real_fields($table, $record, \@real_fields));
+    }
+
+    $statement .= " $extra_sql" if defined($extra_sql);
+    $statement .= " $order_by"  if defined($order_by);
+
+    push @statement, $statement;
+
+    warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
+
+    foreach my $field (
+      grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
+    ) {
+
+      my $value = $record->{$field};
+      my $op = (ref($value) && $value->{op}) ? $value->{op} : '=';
+      $value = $value->{'value'} if ref($value);
+      my $type = dbdef->table($table)->column($field)->type;
+
+      my $bind_type = _bind_type($type, $value);
+
+      #if ( $DEBUG > 2 ) {
+      #  no strict 'refs';
+      #  %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} }
+      #    unless keys %TYPE;
+      #  warn "  bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n";
+      #}
+
+      push @value, $value;
+      push @bind_type, $bind_type;
+
+    }
+
+    foreach my $param ( @$extra_param ) {
+      my $bind_type = { TYPE => SQL_VARCHAR };
+      my $value = $param;
+      if ( ref($param) ) {
+        $value = $param->[0];
+        my $type = $param->[1];
+        $bind_type = _bind_type($type, $value);
+      }
+      push @value, $value;
+      push @bind_type, $bind_type;
+    }
+  }
+
+  my $statement = join( ' ) UNION ( ', @statement );
+  $statement = "( $statement )" if scalar(@statement) > 1;
+  $statement .= " $union_options{order_by}" if $union_options{order_by};
+
+  return {
+    statement => $statement,
+    bind_type => \@bind_type,
+    value     => \@value,
+    table     => $result_table,
+    cache     => $cache,
+  };
+}
+
+# qsearch should eventually use this
+sub _from_hashref {
+  my ($table, $cache, @hashrefs) = @_;
+  my @return;
+  # XXX get rid of these string evals at some point
+  # (when we have time to test it)
+  # my $class = "FS::$table" if $table;
+  # if ( $class and $class->isa('FS::Record') )
+  #   if ( $class->can('new') eq \&new )
+  #
+  if ( $table && eval 'scalar(@FS::'. $table. '::ISA);' ) {
+    if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
+      #derivied class didn't override new method, so this optimization is safe
+      if ( $cache ) {
+        @return = map {
+          new_or_cached( "FS::$table", { %{$_} }, $cache )
+        } @hashrefs;
+      } else {
+        @return = map {
+          new( "FS::$table", { %{$_} } )
+        } @hashrefs;
+      }
+    } else {
+      #okay, its been tested
+      # warn "untested code (class FS::$table uses custom new method)";
+      @return = map {
+        eval 'FS::'. $table. '->new( { %{$_} } )';
+      } @hashrefs;
+    }
+
+    # Check for encrypted fields and decrypt them.
+   ## only in the local copy, not the cached object
+    if ( $conf_encryption 
+         && eval '@FS::'. $table . '::encrypted_fields' ) {
+      foreach my $record (@return) {
+        foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
+          next if $field eq 'payinfo' 
+                    && ($record->isa('FS::payinfo_transaction_Mixin') 
+                        || $record->isa('FS::payinfo_Mixin') )
+                    && $record->payby
+                    && !grep { $record->payby eq $_ } @encrypt_payby;
+          # Set it directly... This may cause a problem in the future...
+          $record->setfield($field, $record->decrypt($record->getfield($field)));
+        }
+      }
+    }
+  } else {
+    cluck "warning: FS::$table not loaded; returning FS::Record objects"
+      unless $nowarn_classload;
+    @return = map {
+      FS::Record->new( $table, { %{$_} } );
+    } @hashrefs;
+  }
+  return @return;
+}
+
 ## makes this easier to read
 
 sub get_real_fields {
@@ -2829,13 +3038,8 @@ Checks to see if the string is encrypted and returns true or false (1/0) to indi
 
 sub is_encrypted {
   my ($self, $value) = @_;
-  # Possible Bug - Some work may be required here....
-
-  if ($value =~ /^M/ && length($value) > 80) {
-    return 1;
-  } else {
-    return 0;
-  }
+  # could be more precise about it, but this will do for now
+  $value =~ /^M/ && length($value) > 80;
 }
 
 =item decrypt($value)