[freeside-commits] branch master updated. 95144265eeb3ecd13b16708dbdd75dd3701f92ad
Mitch Jackson
mitch at freeside.biz
Mon Nov 27 11:19:57 PST 2017
The branch, master has been updated
via 95144265eeb3ecd13b16708dbdd75dd3701f92ad (commit)
from 437042190fc83f5c2ed91386f44460d194278c84 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 95144265eeb3ecd13b16708dbdd75dd3701f92ad
Author: Mitch Jackson <mitch at freeside.biz>
Date: Mon Nov 27 19:13:40 2017 +0000
Added option for Credit Report to include Voided Credits RT#73200
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 479f9b1f1..21fef73e3 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 000000000..35c0cf401
--- /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 dbf0ff333..f81063cc8 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,19 @@ 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: Amount
push @header, emt('Amount');
push @fields, sub { $money_char .sprintf('%.2f', shift->amount) };
push @sort_fields, 'amount';
@@ -42,7 +54,7 @@ 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 +65,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 +124,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 +237,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.username as void_username',
+ 'cust_main.custnum as cust_main_custnum',
+ FS::UI::Web::cust_sql_fields(),
);
if ( $unapplied ) {
@@ -197,7 +311,7 @@ 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;
@@ -212,4 +326,57 @@ my $sql_query = {
'addl_from' => $addl_from. FS::UI::Web::join_cust_main('cust_credit')
};
+# Join to get reason text and void username to avoid two extra query per row
+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 access_user as vusers '.
+ 'on (vusers.usernum = 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,
+};
+
+if ($show_voided_credits) {
+
+ $sql_query = [$sql_query, $sql_query_void];
+
+ my $count_cust_credit;
+ my $count_cust_credit_void;
+ my $count_sum;
+
+ # Expected fields for count query are count, sum
+ # Get those totals here, and send a fake count query
+ my $count_row = qsearchs({
+ table => 'cust_credit',
+ select => 'count(*), sum(amount)',
+ extra_sql => $where,
+ addl_from => $addl_from . FS::UI::Web::join_cust_main('cust_credit'),
+ });
+ $count_cust_credit = $count_row->count || 0;
+ $count_sum = $count_row->sum || 0;
+
+ $count_row = qsearchs({
+ table => 'cust_credit_void',
+ select => 'count(*)',
+ extra_sql => $where_void,
+ addl_from => $addl_from_void,
+ });
+ $count_cust_credit_void = $count_row->count || 0;
+
+ my $count_combined = $count_cust_credit + $count_cust_credit_void;
+
+ # Fake count query providing needed values
+ $count_query = "SELECT $count_combined as count, $count_sum as sum";
+}
+
</%init>
diff --git a/httemplate/search/elements/search.html b/httemplate/search/elements/search.html
index 8658774e0..476b5095e 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 0d7a2770a..34e05394e 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>
+
-----------------------------------------------------------------------
Summary of changes:
FS/FS/Record.pm | 165 ++++++++++--------
.../elements/tr-select-show_voided_credits.html | 15 ++
httemplate/search/cust_credit.html | 185 ++++++++++++++++++++-
httemplate/search/elements/search.html | 107 ++++++++----
httemplate/search/report_cust_credit.html | 8 +-
5 files changed, 368 insertions(+), 112 deletions(-)
create mode 100644 httemplate/elements/tr-select-show_voided_credits.html
More information about the freeside-commits
mailing list