[freeside-commits] branch rt73200 created. 3ef7da76ba001a29911b36cd5e48411cf4d7a0c6

Mitch Jackson mitch at 420.am
Mon Oct 30 13:54:41 PDT 2017


The branch, rt73200 has been created
        at  3ef7da76ba001a29911b36cd5e48411cf4d7a0c6 (commit)

- Log -----------------------------------------------------------------
commit 3ef7da76ba001a29911b36cd5e48411cf4d7a0c6
Author: Mitch Jackson <mitch at freeside.biz>
Date:   Mon Oct 30 20:44:19 2017 +0000

    RT# 73200 Added option for Credit Report to include voided credits

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 479f9b1..21fef73 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -67,7 +67,7 @@ FS::UID->install_callback( sub {
 
   eval "use FS::Conf;";
   die $@ if $@;
-  $conf = FS::Conf->new; 
+  $conf = FS::Conf->new;
   $conf_encryption           = $conf->exists('encryption');
   $conf_encryptionmodule     = $conf->config('encryptionmodule');
   $conf_encryptionpublickey  = join("\n",$conf->config('encryptionpublickey'));
@@ -104,7 +104,7 @@ FS::Record - Database record objects
 
     $record  = qsearchs FS::Record 'table', \%hash;
     $record  = qsearchs FS::Record 'table', { 'column' => 'value', ... };
-    @records = qsearch  FS::Record 'table', \%hash; 
+    @records = qsearch  FS::Record 'table', \%hash;
     @records = qsearch  FS::Record 'table', { 'column' => 'value', ... };
 
     $table = $record->table;
@@ -174,14 +174,14 @@ Creates a new record.  It doesn't store it in the database, though.  See
 L<"insert"> for that.
 
 Note that the object stores this hash reference, not a distinct copy of the
-hash it points to.  You can ask the object for a copy with the I<hash> 
+hash it points to.  You can ask the object for a copy with the I<hash>
 method.
 
 TABLE can only be omitted when a dervived class overrides the table method.
 
 =cut
 
-sub new { 
+sub new {
   my $proto = shift;
   my $class = ref($proto) || $proto;
   my $self = {};
@@ -192,10 +192,10 @@ sub new {
     carp "warning: FS::Record::new called with table name ". $self->{'Table'}
       unless $nowarn_classload;
   }
-  
+
   $self->{'Hash'} = shift;
 
-  foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { 
+  foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
     $self->{'Hash'}{$field}='';
   }
 
@@ -489,6 +489,26 @@ sub qsearch {
     croak $error;
   }
 
+
+  # Determine how to format rows returned form a union query:
+  #
+  # * When all queries involved in the union are from the same table:
+  #   Return an array of FS::$table_name objects
+  #
+  # * When union query is performed on multiple tables,
+  #   Return an array of FS::Record objects
+  #   ! Note:  As far as I can tell, this functionality was broken, and
+  #   !        actually results in a crash.  Behavior is left intact
+  #   !        as-is, in case the results are in use somewhere
+  #
+  # * Union query is performed on multiple table,
+  #       and $union_options{classname_from_column} = 1
+  #   Return an array of FS::$classname objects, where $classname is
+  #   derived for each row from a static field inserted each returned
+  #   row of data.
+  #   e.g.: SELECT custnum,first,last,'cust_main' AS `__classname`'.
+
+
   my $table = $stable[0];
   my $pkey = '';
   $table = '' if grep { $_ ne $table } @stable;
@@ -508,7 +528,21 @@ sub qsearch {
   #below was refactored out to _from_hashref, this should use it at some point
 
   my @return;
-  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+  if ($union_options{classname_from_column}) {
+
+    # todo
+    # I'm not implementing the cache for this use case, at least not yet
+    # -mjackson
+
+    for my $row (@stuff) {
+      my $table_class = $row->{__classname}
+        or die "`__classname` column must be set when ".
+               "using \$union_options{classname_from_column}";
+      push @return, new("FS::$table_class",$row);
+    }
+
+  }
+  elsif ( 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 ) {
@@ -531,12 +565,12 @@ sub qsearch {
     # Check for encrypted fields and decrypt them.
    ## only in the local copy, not the cached object
     no warnings 'deprecated'; # XXX silence the warning for now
-    if ( $conf_encryption 
+    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') 
+          next if $field eq 'payinfo'
+                    && ($record->isa('FS::payinfo_transaction_Mixin')
                         || $record->isa('FS::payinfo_Mixin') )
                     && $record->payby
                     && !grep { $record->payby eq $_ } @encrypt_payby;
@@ -657,7 +691,7 @@ sub _query {
     push @statement, $statement;
 
     warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
- 
+
 
     foreach my $field (
       grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
@@ -740,12 +774,12 @@ sub _from_hashref {
 
     # Check for encrypted fields and decrypt them.
    ## only in the local copy, not the cached object
-    if ( $conf_encryption 
+    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') 
+          next if $field eq 'payinfo'
+                    && ($record->isa('FS::payinfo_transaction_Mixin')
                         || $record->isa('FS::payinfo_Mixin') )
                     && $record->payby
                     && !grep { $record->payby eq $_ } @encrypt_payby;
@@ -772,7 +806,7 @@ sub get_real_fields {
   $alias_main ||= $table;
 
   ## could be optimized more for readability
-  return ( 
+  return (
     map {
 
       my $op = '=';
@@ -833,7 +867,7 @@ sub get_real_fields {
       }
 
     } @{ $real_fields }
-  );  
+  );
 }
 
 =item by_key PRIMARY_KEY_VALUE
@@ -871,7 +905,7 @@ single SELECT spanning multiple tables, and cache the results for subsequent
 method calls.  Interface will almost definately change in an incompatible
 fashion.
 
-Arguments: 
+Arguments:
 
 =cut
 
@@ -955,7 +989,7 @@ sub get {
   # to avoid "Use of unitialized value" errors
   if ( defined ( $self->{Hash}->{$field} ) ) {
     $self->{Hash}->{$field};
-  } else { 
+  } else {
     '';
   }
 }
@@ -970,7 +1004,7 @@ Sets the value of the column/field/key COLUMN to VALUE.  Returns VALUE.
 
 =cut
 
-sub set { 
+sub set {
   my($self,$field,$value) = @_;
   $self->{'modified'} = 1;
   $self->{'Hash'}->{$field} = $value;
@@ -1029,7 +1063,7 @@ sub AUTOLOAD {
     my %search = ( $foreign_column => $pkey_value );
 
     # FS::Record->$method() ?  they're actually just subs :/
-    if ( $method eq 'qsearchs' ) { 
+    if ( $method eq 'qsearchs' ) {
       return $pkey_value ? qsearchs( $table, \%search ) : '';
     } elsif ( $method eq 'qsearch' ) {
       return $pkey_value ? qsearch(  $table, \%search ) : ();
@@ -1043,7 +1077,7 @@ sub AUTOLOAD {
     $self->setfield($field,$value);
   } else {
     $self->getfield($field);
-  }    
+  }
 }
 
 # efficient (also, old, doesn't support FK stuff)
@@ -1054,7 +1088,7 @@ sub AUTOLOAD {
 #    $_[0]->setfield($field, $_[1]);
 #  } else {
 #    $_[0]->getfield($field);
-#  }    
+#  }
 #}
 
 # get_fk_method(TABLE, FIELD)
@@ -1175,7 +1209,7 @@ sub hash {
   my($self) = @_;
   confess $self. ' -> hash: Hash attribute is undefined'
     unless defined($self->{'Hash'});
-  %{ $self->{'Hash'} }; 
+  %{ $self->{'Hash'} };
 }
 
 =item hashref
@@ -1331,14 +1365,14 @@ sub insert {
   }
 
   my $table = $self->table;
-  
+
   # Encrypt before the database
   if (    scalar( eval '@FS::'. $table . '::encrypted_fields')
        && $conf_encryption
   ) {
     foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
-      next if $field eq 'payinfo' 
-                && ($self->isa('FS::payinfo_transaction_Mixin') 
+      next if $field eq 'payinfo'
+                && ($self->isa('FS::payinfo_transaction_Mixin')
                     || $self->isa('FS::payinfo_Mixin') )
                 && $self->payby
                 && !grep { $self->payby eq $_ } @encrypt_payby;
@@ -1361,7 +1395,7 @@ sub insert {
     $statement .= 'DEFAULT VALUES';
 
   } else {
-  
+
     if ( $use_placeholders ) {
 
       @bind_values = map $self->getfield($_), @real_fields;
@@ -1395,7 +1429,7 @@ sub insert {
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE'; 
+  local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
@@ -1405,7 +1439,7 @@ sub insert {
   # get inserted id from the database, if applicable & needed
   if ( $db_seq && ! $self->getfield($primary_key) ) {
     warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
-  
+
     my $insertid = '';
 
     if ( driver_name eq 'Pg' ) {
@@ -1454,7 +1488,7 @@ sub insert {
     } else {
 
       dbh->rollback if $FS::UID::AutoCommit;
-      return "don't know how to retreive inserted ids from ". driver_name. 
+      return "don't know how to retreive inserted ids from ". driver_name.
              ", try using counterfiles (maybe run dbdef-create?)";
 
     }
@@ -1478,7 +1512,7 @@ sub insert {
 
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
-  # Now that it has been saved, reset the encrypted fields so that $new 
+  # Now that it has been saved, reset the encrypted fields so that $new
   # can still be used.
   foreach my $field (keys %{$saved}) {
     $self->setfield($field, $saved->{$field});
@@ -1537,7 +1571,7 @@ sub delete {
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE'; 
+  local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
@@ -1545,7 +1579,7 @@ sub delete {
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
   $h_sth->execute or return $h_sth->errstr if $h_sth;
-  
+
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   #no need to needlessly destoy the data either (causes problems actually)
@@ -1595,15 +1629,15 @@ sub replace {
 
   my $error = $new->check;
   return $error if $error;
-  
+
   # Encrypt for replace
   my $saved = {};
   if (    scalar( eval '@FS::'. $new->table . '::encrypted_fields')
        && $conf_encryption
   ) {
     foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
-      next if $field eq 'payinfo' 
-                && ($new->isa('FS::payinfo_transaction_Mixin') 
+      next if $field eq 'payinfo'
+                && ($new->isa('FS::payinfo_transaction_Mixin')
                     || $new->isa('FS::payinfo_Mixin') )
                 && $new->payby
                 && !grep { $new->payby eq $_ } @encrypt_payby;
@@ -1615,7 +1649,7 @@ sub replace {
   #my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
   my %diff = map { ($new->getfield($_) ne $old->getfield($_))
                    ? ($_, $new->getfield($_)) : () } $old->fields;
-                   
+
   unless (keys(%diff) || $no_update_diff ) {
     carp "[warning]$me ". ref($new)."->replace ".
            ( $primary_key ? "$primary_key ".$new->get($primary_key) : '' ).
@@ -1626,7 +1660,7 @@ sub replace {
 
   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
-      "$_ = ". _quote($new->getfield($_),$old->table,$_) 
+      "$_ = ". _quote($new->getfield($_),$old->table,$_)
     } real_fields($old->table)
   ). ' WHERE '.
     join(' AND ',
@@ -1676,7 +1710,7 @@ sub replace {
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE'; 
+  local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
@@ -1688,7 +1722,7 @@ sub replace {
 
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
-  # Now that it has been saved, reset the encrypted fields so that $new 
+  # Now that it has been saved, reset the encrypted fields so that $new
   # can still be used.
   foreach my $field (keys %{$saved}) {
     $new->setfield($field, $saved->{$field});
@@ -1732,7 +1766,7 @@ non-custom fields, etc., and call this method via $self->SUPER::check.
 
 =cut
 
-sub check { 
+sub check {
     my $self = shift;
     foreach my $field ($self->virtual_fields) {
         my $error = $self->ut_textn($field);
@@ -1743,7 +1777,7 @@ sub check {
 
 =item virtual_fields [ TABLE ]
 
-Returns a list of virtual fields defined for the table.  This should not 
+Returns a list of virtual fields defined for the table.  This should not
 be exported, and should only be called as an instance or class method.
 
 =cut
@@ -1837,8 +1871,8 @@ format_types).
 
 =back
 
-PARAMS is a hashref (or base64-encoded Storable hashref) containing the 
-POSTed data.  It must contain the field "uploaded files", generated by 
+PARAMS is a hashref (or base64-encoded Storable hashref) containing the
+POSTed data.  It must contain the field "uploaded files", generated by
 /elements/file-upload.html and containing the list of uploaded files.
 Currently only supports a single file named "file".
 
@@ -1853,7 +1887,7 @@ sub process_batch_import {
   my %formats = %{ $opt->{formats} };
 
   warn Dumper($param) if $DEBUG;
-  
+
   my $files = $param->{'uploaded_files'}
     or die "No files provided.\n";
 
@@ -2193,7 +2227,7 @@ sub batch_import {
       next if $line =~ /^\s*$/; #skip empty lines
 
       $line = &{$row_callback}($line) if $row_callback;
-      
+
       next if $line =~ /^\s*$/; #skip empty lines
 
       $parser->parse($line) or do {
@@ -2246,7 +2280,7 @@ sub batch_import {
     foreach my $field ( @fields ) {
 
       my $value = shift @columns;
-     
+
       if ( ref($field) eq 'CODE' ) {
         #&{$field}(\%hash, $value);
         push @later, $field, $value;
@@ -2371,7 +2405,7 @@ sub _h_statement {
 
 =item unique COLUMN
 
-B<Warning>: External use is B<deprecated>.  
+B<Warning>: External use is B<deprecated>.
 
 Replaces COLUMN in record with a unique number, using counters in the
 filesystem.  Used by the B<insert> method on single-field unique columns
@@ -2542,7 +2576,7 @@ sub ut_numbern {
 
 =item ut_decimal COLUMN[, DIGITS]
 
-Check/untaint decimal numbers (up to DIGITS decimal places.  If there is an 
+Check/untaint decimal numbers (up to DIGITS decimal places.  If there is an
 error, returns the error, otherwise returns false.
 
 =item ut_decimaln COLUMN[, DIGITS]
@@ -2707,7 +2741,7 @@ error, returns the error, otherwise returns false.
 
 sub ut_alphan {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^(\w*)$/ 
+  $self->getfield($field) =~ /^(\w*)$/
     or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
@@ -2722,7 +2756,7 @@ an error, returns the error, otherwise returns false.
 
 sub ut_alphasn {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^([\w ]*)$/ 
+  $self->getfield($field) =~ /^([\w ]*)$/
     or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
@@ -3041,8 +3075,8 @@ sub ut_name {
   $self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/
     or return gettext('illegal_name'). " $field: ". $self->getfield($field);
   my $name = $1;
-  $name =~ s/^\s+//; 
-  $name =~ s/\s+$//; 
+  $name =~ s/^\s+//;
+  $name =~ s/\s+$//;
   $name =~ s/\s+/ /g;
   $self->setfield($field, $name);
   '';
@@ -3123,7 +3157,7 @@ see L<Locale::Country>.
 sub ut_country {
   my( $self, $field ) = @_;
   unless ( $self->getfield($field) =~ /^(\w\w)$/ ) {
-    if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/ 
+    if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/
          && country2code($1) ) {
       $self->setfield($field,uc(country2code($1)));
     }
@@ -3379,7 +3413,7 @@ sub loadRSA {
     if ($conf_encryptionpublickey && $conf_encryptionpublickey ne '') {
       $rsa_encrypt = $rsa_module->new_public_key($conf_encryptionpublickey);
     }
-    
+
     # Intitalize Decryption
     if ($conf_encryptionprivatekey && $conf_encryptionprivatekey ne '') {
       $rsa_decrypt = $rsa_module->new_private_key($conf_encryptionprivatekey);
@@ -3447,8 +3481,8 @@ sub scalar_sql {
 
 =item count [ WHERE [, PLACEHOLDER ...] ]
 
-Convenience method for the common case of "SELECT COUNT(*) FROM table", 
-with optional WHERE.  Must be called as method on a class with an 
+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
@@ -3485,7 +3519,7 @@ sub row_exists {
 
 =item real_fields [ TABLE ]
 
-Returns a list of the real columns in the specified table.  Called only by 
+Returns a list of the real columns in the specified table.  Called only by
 fields() and other subroutines elsewhere in FS::Record.
 
 =cut
@@ -3500,7 +3534,7 @@ sub real_fields {
 
 =item pvf FIELD_NAME
 
-Returns the FS::part_virtual_field object corresponding to a field in the 
+Returns the FS::part_virtual_field object corresponding to a field in the
 record (specified by FIELD_NAME).
 
 =cut
@@ -3513,7 +3547,7 @@ sub pvf {
     my $concat = [ "'cf_'", "name" ];
     return qsearchs({   table   =>  'part_virtual_field',
                         hashref =>  { dbtable => $self->table,
-                                      name    => $name 
+                                      name    => $name
                                     },
                         select  =>  'vfieldpart, dbtable, length, label, '.concat_sql($concat).' as name',
                     });
@@ -3547,7 +3581,7 @@ sub _quote {
     cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
           "using 0 instead";
     0;
-  } elsif ( $value =~ /^\d+(\.\d+)?$/ && 
+  } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
             ! $column_type =~ /(char|binary|text)$/i ) {
     $value;
   } elsif (( $column_type =~ /^bytea$/i || $column_type =~ /(blob|varbinary)/i )
@@ -3611,7 +3645,7 @@ the current database.
 
 =cut
 
-sub str2time_sql { 
+sub str2time_sql {
   my $driver = shift || driver_name;
 
   return 'UNIX_TIMESTAMP('      if $driver =~ /^mysql/i;
@@ -3634,7 +3668,7 @@ the current database.
 
 =cut
 
-sub str2time_sql_closing { 
+sub str2time_sql_closing {
   my $driver = shift || driver_name;
 
   return ' )::INTEGER ' if $driver =~ /^Pg/i;
@@ -3708,7 +3742,7 @@ sub concat_sql {
 
 =item group_concat_sql COLUMN, DELIMITER
 
-Returns an SQL expression to concatenate an aggregate column, using 
+Returns an SQL expression to concatenate an aggregate column, using
 GROUP_CONCAT() for mysql and array_to_string() and array_agg() for Pg.
 
 =cut
@@ -3726,7 +3760,7 @@ sub group_concat_sql {
 
 =item midnight_sql DATE
 
-Returns an SQL expression to convert DATE (a unix timestamp) to midnight 
+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
@@ -3798,4 +3832,3 @@ http://poop.sf.net/
 =cut
 
 1;
-
diff --git a/httemplate/elements/tr-select-show_voided_credits.html b/httemplate/elements/tr-select-show_voided_credits.html
new file mode 100644
index 0000000..35c0cf4
--- /dev/null
+++ b/httemplate/elements/tr-select-show_voided_credits.html
@@ -0,0 +1,15 @@
+  <TR>
+    <TD ALIGN="right"><% $opt{'label'} || 'Show Voided Credits' %></TD>
+    <TD>
+      <select name='show_voided_credits'>
+        <option value=""></option>
+        <option value="0">no</option>
+        <option value="1">yes</option>
+      </select>
+    </TD>
+  </TR>
+<%init>
+
+my %opt = @_;
+
+</%init>
diff --git a/httemplate/search/cust_credit.html b/httemplate/search/cust_credit.html
index dbf0ff3..d927596 100755
--- a/httemplate/search/cust_credit.html
+++ b/httemplate/search/cust_credit.html
@@ -11,13 +11,16 @@
                  'links' => \@links,
                  'color' => \@color,
                  'style' => \@style,
+                 'classname_from_column' => 1,
 &>
 <%init>
 
 die "access denied"
   unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
 
-my $money_char = FS::Conf->new->config('money_char') || '$';
+my $conf = new FS::Conf;
+
+my $money_char = $conf->config('money_char') || '$';
 
 my $title = emt('Credit Search Results');
 
@@ -30,10 +33,33 @@ my $clink = sub {
     : '';
 };
 
+# form selectbox for show_voided_credits:
+# - value='': use default from $conf
+# - value="0" : override default, do not show voided credits
+# - value="1" : override default, show voided credits
+my $show_voided_credits;
+$show_voided_credits = $conf->config('show_voided_credits');
+$show_voided_credits = $cgi->param('show_voided_credits')
+  if $cgi->param('show_voided_credits') =~ /^(\d)$/;
+
+
 my (@header, @fields, @sort_fields, $align, @links, @color, @style);
 $align = '';
 
-#amount
+
+# Report Column: is_voided
+if ($show_voided_credits) {
+  push @header, "";
+  push @fields, sub { shift->isa('FS::cust_credit_void') ? 'VOIDED' : "" };
+  push @sort_fields, '';
+  $align .= 'r';
+  push @links, '';
+  push @color, 'red';
+  push @style, '';
+}
+
+
+# Report Column: Amount
 push @header, emt('Amount');
 push @fields, sub { $money_char .sprintf('%.2f', shift->amount) };
 push @sort_fields, 'amount';
@@ -42,7 +68,8 @@ push @links, '';
 push @color, '';
 push @style, '';
 
-# unapplied amount
+
+# Report Column: Unapplied Amount
 if ($unapplied) {
   push @header, emt('Unapplied');
   push @fields, sub { $money_char .sprintf('%.2f', shift->unapplied_amount) };
@@ -53,7 +80,8 @@ if ($unapplied) {
   push @style, '';
 }
 
-push @header, emt('Date'), 
+# Report Columns: Date, By, Reason, Info
+push @header, emt('Date'),
               emt('By'),
               emt('Reason'),
               emt('Info'),
@@ -111,6 +139,51 @@ push @links, map { $_ ne 'Cust. Status' ? $clink : '' }
 push @color, FS::UI::Web::cust_colors();
 push @style, FS::UI::Web::cust_styles();
 
+if ( $show_voided_credits ) {
+
+  # Report Column: Void By:
+  push @header, emt('Void By');
+  push @fields, sub {
+    my $rec = shift;
+    return $rec->void_username
+      if $rec->isa('FS::cust_credit_void');
+    return '';
+  };
+  push @sort_fields, '';
+  $align .= 'l';
+  push @links, '';
+  push @color, '';
+  push @style, '';
+
+  # Report Column: Void Date:
+  push @header, emt('Void Date');
+  push @fields, sub {
+    my $rec = shift;
+    return time2str('%b %d %Y', $rec->void_date )
+      if $rec->isa('FS::cust_credit_void');
+    return '';
+  };
+  push @sort_fields, '';
+  $align .= 'l';
+  push @links, '';
+  push @color, '';
+  push @style, '';
+
+  # Report Column: Void Reason:
+  push @header, emt('Void Reason');
+  push @fields, sub {
+    my $rec = shift;
+    return $rec->void_reason_text
+      if $rec->isa('FS::cust_credit_void');
+    return '';
+  };
+  push @sort_fields, '';
+  $align .= 'l';
+  push @links, '';
+  push @color, '';
+  push @style, '';
+}
+
 
 my @search = ();
 my $addl_from = '';
@@ -179,13 +252,69 @@ push @search, "_date >= $beginning ",
 
 push @search, FS::UI::Web::parse_lt_gt($cgi, 'amount' );
 
-#here is the agent virtualization
+# Agent virtualization
 push @search, $FS::CurrentUser::CurrentUser->agentnums_sql(table=>'cust_main');
 
 my @select = (
-    'cust_credit.*',
-    'cust_main.custnum as cust_main_custnum',
-    FS::UI::Web::cust_sql_fields(),
+  "'cust_credit' as __classname",
+  qw(cust_credit.crednum
+     cust_credit.custnum
+     cust_credit._date
+     cust_credit.amount
+     cust_credit.currency
+     cust_credit.otaker
+     cust_credit.usernum
+     cust_credit.reason
+     cust_credit.reasonnum
+     cust_credit.addlinfo
+     cust_credit.closed
+     cust_credit.pkgnum
+     cust_credit.eventnum
+     cust_credit.commission_agentnum
+     cust_credit.commission_salesnum
+     cust_credit.commission_pkgnum
+     cust_credit.commission_invnum
+     cust_credit.credbatch
+     ),
+  'Null as void_date',
+  'Null as void_usernum',
+  'Null as void_reasonnum',
+  'Null as void_reason',
+  'Null as void_reason_text',
+  'Null as void_username',
+  'cust_main.custnum as cust_main_custnum',
+  FS::UI::Web::cust_sql_fields(),
+);
+my @select_void = (
+  "'cust_credit_void' as __classname",
+  qw(cust_credit_void.crednum
+     cust_credit_void.custnum
+     cust_credit_void._date
+     cust_credit_void.amount
+     cust_credit_void.currency
+     cust_credit_void.otaker
+     cust_credit_void.usernum
+     cust_credit_void.reason
+     cust_credit_void.reasonnum
+     cust_credit_void.addlinfo
+     cust_credit_void.closed
+     cust_credit_void.pkgnum
+     cust_credit_void.eventnum
+     cust_credit_void.commission_agentnum
+     cust_credit_void.commission_salesnum
+     cust_credit_void.commission_pkgnum
+     cust_credit_void.commission_invnum
+     ),
+  'Null as credbatch',
+  qw(cust_credit_void.void_date
+     cust_credit_void.void_usernum
+     cust_credit_void.void_reasonnum
+     cust_credit_void.void_reason
+  ),
+  'reason.reason as void_reason_text',
+  'vusers.name as void_username',
+  'cust_main.custnum as cust_main_custnum',
+  FS::UI::Web::cust_sql_fields(),
 );
 
 if ( $unapplied ) {
@@ -197,10 +326,13 @@ my $where = 'WHERE '. join(' AND ', @search);
 
 my $count_query = 'SELECT COUNT(*), SUM(amount) ';
 $count_query .= ', SUM(' . FS::cust_credit->unapplied_sql . ') ' if $unapplied;
-$count_query .= 'FROM cust_credit'. 
+$count_query .= 'FROM cust_credit'.
                   $addl_from. FS::UI::Web::join_cust_main('cust_credit').
                   $where;
 
+# Temp override
+$count_query = 'SELECT 100,100,100,100';
+
 my @count_addl = ( $money_char.'%.2f total credited (gross)' );
 push @count_addl, $money_char.'%.2f unapplied' if $unapplied;
 
@@ -212,4 +344,27 @@ my $sql_query   = {
   'addl_from' => $addl_from. FS::UI::Web::join_cust_main('cust_credit')
 };
 
+# Necessary because cust_credit_void.reason is not being populated
+
+my $addl_from_void = join(' ',
+  $addl_from,
+  FS::UI::Web::join_cust_main('cust_credit_void'),
+  ' LEFT JOIN reason ON (reason.reasonnum = cust_credit_void.void_reasonnum) ',
+  ' LEFT JOIN users as vusers on (vusers.id = cust_credit_void.void_usernum) ',
+);
+
+my $where_void = $where;
+$where_void =~ s/cust_credit/cust_credit_void/g;
+
+my $sql_query_void = {
+  'table'     => 'cust_credit_void',
+  'select'    => join(', ', at select_void),
+  'hashref'   => {},
+  'extra_sql' => $where_void,
+  'addl_from' => $addl_from_void,
+};
+
+$sql_query = [$sql_query, $sql_query_void]
+  if $show_voided_credits;
+
 </%init>
diff --git a/httemplate/search/elements/search.html b/httemplate/search/elements/search.html
index 8658774..476b509 100644
--- a/httemplate/search/elements/search.html
+++ b/httemplate/search/elements/search.html
@@ -9,7 +9,7 @@ Example:
     ###
 
     'title'         => 'Page title',
-    
+
     'name_singular' => 'item',  #singular name for the records returned
        #OR#                     # (preferred, will be pluralized automatically)
     'name'          => 'items', #plural name for the records returned
@@ -30,10 +30,10 @@ Example:
                        'addl_from' => '', #'LEFT JOIN othertable USING ( key )',
                        'extra_sql' => '', #'AND otherstuff', #'WHERE onlystuff',
                        'order_by'  => 'ORDER BY something',
-   
+
                      },
                      # "select * from tablename";
-   
+
     #required unless 'query' is an SQL query string (shouldn't be...)
     'count_query' => 'SELECT COUNT(*) FROM tablename',
 
@@ -47,7 +47,7 @@ Example:
     'header'      => [ '#',
                        'Item',
                        { 'label' => 'Another Item',
-                         
+
                        },
                      ],
 
@@ -70,11 +70,11 @@ Example:
     'redirect_empty' => sub { my( $cgi ) = @_;
                               popurl(2).'view/item.html';
                             },
-   
+
     ###
     # optional
     ###
-   
+
     # some HTML callbacks...
     'menubar'          => '', #menubar arrayref
     'html_init'        => '', #after the header/menubar and before the pager
@@ -85,21 +85,21 @@ Example:
     'html_foot'        => '', #at the bottom
     'html_posttotal'   => '', #at the bottom
                               # (these three can be strings or coderefs)
-    
+
     'count_addl' => [], #additional count fields listref of sprintf strings or coderefs
                         # [ $money_char.'%.2f total paid', ],
-   
+
     #second (smaller) header line, currently only for HTML
     'header2      => [ '#',
                        'Item',
                        { 'label' => 'Another Item',
-                         
+
                        },
                      ],
 
     #listref of column footers
     'footer'      => [],
-    
+
     #disabling things
     'disable_download'  => '', # set true to hide the CSV/Excel download links
     'disable_total'     => '', # set true to hide the total"
@@ -107,7 +107,7 @@ Example:
     'disable_nonefound' => '', # set true to disable the "No matching Xs found"
                                # message
     'nohtmlheader'      => '', # set true to remove the header and menu bar
- 
+
     #handling "disabled" fields in the records
     'disableable' => 1,  # set set to 1 (or column position for "disabled"
                          # status col) to enable if this table has a "disabled"
@@ -140,7 +140,7 @@ Example:
     'order_by_sql' => {              #to keep complex SQL expressions out of cgi order_by value,
       'fieldname' => 'sql snippet',  #  maps fields/sort_fields values to sql snippets
     }
-   
+
     #listref - each item is the empty string,
     #          or a listref of link and method name to append,
     #          or a listref of link and coderef to run and append
@@ -155,7 +155,7 @@ Example:
     #one letter for each column, left/right/center/none
     # or pass a listref with full values: [ 'left', 'right', 'center', '' ]
     'align'       => 'lrc.',
-   
+
     #listrefs of ( scalars or coderefs )
     # currently only HTML, maybe eventually Excel too
     'color'       => [],
@@ -166,11 +166,11 @@ Example:
     # Excel-specific listref of ( hashrefs or coderefs )
     # each hashref: http://search.cpan.org/dist/Spreadsheet-WriteExcel/lib/Spreadsheet/WriteExcel.pm#Format_methods_and_Format_properties
     'xls_format' => => [],
-   
+
 
     # miscellany
    'download_label' => 'Download this report',
-                        # defaults to 'Download full results' 
+                        # defaults to 'Download full results'
    'link_field'     => 'pkgpart'
                         # will create internal links for each row,
                         # with the value of this field as the NAME attribute
@@ -210,7 +210,7 @@ Example:
           )
 %>
 %
-% } 
+% }
 <%init>
 
 my(%opt) = @_;
@@ -304,10 +304,10 @@ if ( $opt{'agent_virt'} ) {
       $opt{$att} ||= [ map '', @{ $opt{'fields'} } ];
     }
 
-    splice @{ $opt{'header'} }, $pos, 0, 'Agent'; 
-    splice @{ $opt{'align'}  }, $pos, 0, 'c'; 
-    splice @{ $opt{'style'}  }, $pos, 0, ''; 
-    splice @{ $opt{'size'}   }, $pos, 0, ''; 
+    splice @{ $opt{'header'} }, $pos, 0, 'Agent';
+    splice @{ $opt{'align'}  }, $pos, 0, 'c';
+    splice @{ $opt{'style'}  }, $pos, 0, '';
+    splice @{ $opt{'size'}   }, $pos, 0, '';
     splice @{ $opt{'fields'} }, $pos, 0,
       sub { $_[0]->agentnum ? $_[0]->agent->agent : '(global)'; };
     splice @{ $opt{'color'}  }, $pos, 0, '';
@@ -329,7 +329,7 @@ if ( $opt{'disableable'} ) {
 
     my $table = $query->{'table'};
 
-    $count_query .= 
+    $count_query .=
       ( $count_query =~ /\bWHERE\b/i ? ' AND ' : ' WHERE ' ).
       "( $table.disabled = '' OR $table.disabled IS NULL )";
 
@@ -342,10 +342,10 @@ if ( $opt{'disableable'} ) {
       $opt{$att} ||= [ map '', @{ $opt{'fields'} } ];
     }
 
-    splice @{ $opt{'header'} }, $pos, 0, 'Status'; 
-    splice @{ $opt{'align'}  }, $pos, 0, 'c'; 
-    splice @{ $opt{'style'}  }, $pos, 0, 'b'; 
-    splice @{ $opt{'size'}   }, $pos, 0, ''; 
+    splice @{ $opt{'header'} }, $pos, 0, 'Status';
+    splice @{ $opt{'align'}  }, $pos, 0, 'c';
+    splice @{ $opt{'style'}  }, $pos, 0, 'b';
+    splice @{ $opt{'size'}   }, $pos, 0, '';
     splice @{ $opt{'fields'} }, $pos, 0,
       sub { shift->disabled ? 'DISABLED' : 'Active'; };
     splice @{ $opt{'color'}  }, $pos, 0,
@@ -411,6 +411,7 @@ my $header = [ map { ref($_) ? $_->{'label'} : $_ } @{$opt{header}} ];
 my $rows;
 
 my ($order_by_key,$order_by_desc) = ($order_by =~ /^\s*(.*?)(\s+DESC)?\s*$/i);
+my $union_order_by;
 $opt{'order_by_sql'} ||= {};
 $order_by_desc ||= '';
 $order_by = $opt{'order_by_sql'}{$order_by_key} . $order_by_desc
@@ -421,6 +422,8 @@ if ( ref $query ) {
   if (ref($query) eq 'HASH') {
     @query = $query;
 
+    # Assemble peices of order_by information as SQL fragment,
+    # store as query->{order_by}
     if ( $order_by ) {
       if ( $query->{'order_by'} ) {
         if ( $query->{'order_by'} =~ /^(\s*ORDER\s+BY\s+)?(\S.*)$/is ) {
@@ -433,27 +436,59 @@ if ( ref $query ) {
         $query->{'order_by'} = "ORDER BY $order_by";
       }
     }
-
     $query->{'order_by'} .= " $limit";
 
   } elsif (ref($query) eq 'ARRAY') {
-    # do we still use this? it was for the old 477 report.
+    # Presented query is a UNION query, with multiple query references
     @query = @{ $query };
+
+    # Assemble peices of order_by information as SQL fragment,
+    # store as $union_order_by.  Omit order_by/limit from individual
+    # $query hashrefs, because this is a union query
+    #
+    # ! Currently, order_by data is only fetched from $cgi->param('order_by')
+    # ! for union queries. If it eventually needs to be passed within query
+    # ! hashrefs, or as mason template options, would need implemented
+    $union_order_by = " ORDER BY $order_by " if $order_by;
+    $union_order_by .= " $limit " if $limit;
+
   } else {
-    die "invalid query reference";
+    die "invalid query reference ($query)";
   }
 
   #eval "use FS::$opt{'query'};";
   my @param = qw( select table addl_from hashref extra_sql order_by debug );
-  $rows = [ qsearch( [ map { my $query = $_;
-                             ({ map { $_ => $query->{$_} } @param });
-                           }
-                       @query
-                     ],
-                     #'order_by' => $opt{order_by}. " ". $limit,
-                   )
-          ]; 
+  if ($opt{classname_from_column}) {
+    # Perform a union of multiple queries, while using the
+    # classname_from_column qsearch union option
+
+    # Constrain hashkeys for each query from @param
+    @query = map{
+      my $query = $_;
+      my $new_query = {};
+      $new_query->{$_} = $query->{$_} for @param;
+      $new_query;
+    } @query;
+
+    $rows = [
+      qsearch(
+        \@query,
+        order_by => $union_order_by,
+        classname_from_column => 1,
+      )
+    ];
 
+  } else {
+    # default perform a query with qsearch
+    $rows = [ qsearch( [ map { my $query = $_;
+                               ({ map { $_ => $query->{$_} } @param });
+                             }
+                         @query
+                       ],
+                       #'order_by' => $opt{order_by}. " ". $limit,
+                     )
+            ];
+  }
 } else { # not ref $query; plain SQL (still used as of 07/2015)
 
   $query .= " $limit";
diff --git a/httemplate/search/report_cust_credit.html b/httemplate/search/report_cust_credit.html
index 0d7a277..34e0539 100644
--- a/httemplate/search/report_cust_credit.html
+++ b/httemplate/search/report_cust_credit.html
@@ -24,6 +24,11 @@
                 'field' => 'amount',
   &>
 
+  <& /elements/tr-select-show_voided_credits.html,
+                'label' => emt('Show Voided Credits'),
+  &>
+
+
 </TABLE>
 
 <BR>
@@ -42,7 +47,8 @@ my $access_user = $FS::CurrentUser::CurrentUser->access_users_hashref('table' =>
 
 my $unapplied = $cgi->param('unapplied') ? 1 : 0;
 
-my $title = $cgi->param('unapplied') ? 
+my $title = $cgi->param('unapplied') ?
               'Unapplied credit report' : 'Credit report';
 
 </%init>
+

-----------------------------------------------------------------------




More information about the freeside-commits mailing list