[freeside-commits] branch FREESIDE_3_BRANCH updated. e78d51a5053c8d3c0c7192c8b5cdeff5999fafd7

Jonathan Prykop jonathan at 420.am
Fri Jan 29 13:16:11 PST 2016


The branch, FREESIDE_3_BRANCH has been updated
       via  e78d51a5053c8d3c0c7192c8b5cdeff5999fafd7 (commit)
       via  5773eb8d8b4168213482a7e61aa37e0dd05c69da (commit)
       via  488d3c15c9aaea2a17826600ee332f0af9b0634d (commit)
       via  e96bcf25f1d6eb21bb78b9c43bd00049840d9639 (commit)
       via  f1ce861d8f7a6431934b4bf5b69f5e7573043818 (commit)
      from  47e0575759844079506f0823d02cc96c0e89a88a (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 e78d51a5053c8d3c0c7192c8b5cdeff5999fafd7
Merge: 5773eb8 47e0575
Author: Jonathan Prykop <jonathan at freeside.biz>
Date:   Fri Jan 29 15:14:33 2016 -0600

    Merge branch 'FREESIDE_3_BRANCH' of git.freeside.biz:/home/git/freeside into FREESIDE_3_BRANCH


commit 5773eb8d8b4168213482a7e61aa37e0dd05c69da
Author: Jonathan Prykop <jonathan at freeside.biz>
Date:   Fri Jan 29 15:14:17 2016 -0600

    RT#39638 [selective v3 backport of commit 7516e3da0f17eeecba27219ef96a8b5f46af2083, link cdr to cust_bill_pkg_detail]

diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index cd05be3..a71b902 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -3844,6 +3844,9 @@ sub tables_hashref {
         #new
         'cdrbatchnum',      'int',    'NULL',      '', '', '',
 
+        # FK to cust_bill_pkg_detail; having a value here absolutely means
+        # that the CDR appears on an invoice
+        'detailnum',     'bigint',    'NULL',      '', '', '',
       ],
       'primary_key' => 'acctid',
       'unique' => [],
diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm
index 5a1d8ea..8ccf7af 100644
--- a/FS/FS/cdr.pm
+++ b/FS/FS/cdr.pm
@@ -161,6 +161,8 @@ following fields are currently supported:
 
 =item cdrbatch
 
+=item detailnum - Link to invoice detail (L<FS::cust_bill_pkg_detail>)
+
 =back
 
 =head1 METHODS
@@ -227,6 +229,7 @@ sub table_info {
         'freesiderewritestatus' => 'Freeside rewrite status',
         'cdrbatch'              => 'Legacy batch',
         'cdrbatchnum'           => 'Batch',
+        'detailnum'             => 'Freeside invoice detail line',
     },
 
   };
@@ -338,8 +341,12 @@ sub check {
 
   #check the foreign keys even?
   #do we want to outright *reject* the CDR?
-  my $error =
-       $self->ut_numbern('acctid');
+  my $error = $self->ut_numbern('acctid');
+  return $error if $error;
+
+  if ( $self->freesidestatus ne 'done' ) {
+    $self->set('detailnum', ''); # can't have this on an unbilled call
+  }
 
   #add a config option to turn these back on if someone needs 'em
   #
@@ -352,8 +359,6 @@ sub check {
   #  # Telstra =1, Optus = 2, RSL COM = 3
   #  || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
 
-  return $error if $error;
-
   $self->SUPER::check;
 }
 
diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm
index d0cbdbe..dd118c1 100644
--- a/FS/FS/cust_bill_pkg_detail.pm
+++ b/FS/FS/cust_bill_pkg_detail.pm
@@ -86,15 +86,52 @@ sub table { 'cust_bill_pkg_detail'; }
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
+=cut
+
+sub insert {
+  my $self = shift;
+  my $error = $self->SUPER::insert(@_);
+  return $error if $error;
+
+  # link CDRs
+  my $acctids = $self->get('acctid') or return '';
+  $acctids = [ $acctids ] unless ref $acctids;
+  foreach my $acctid ( @$acctids ) {
+    my $cdr = FS::cdr->by_key($acctid);
+    $cdr->set('detailnum', $self->detailnum);
+    $error = $cdr->replace;
+    # this should never happen
+    return "error linking CDR #$acctid: $error" if $error;
+  }
+  '';
+}
+
 =item delete
 
 Delete this record from the database.
 
+=cut
+
+sub delete {
+  my $self = shift;
+  my $error = $self->SUPER::delete;
+  return $error if $error;
+  foreach my $cdr (qsearch('cdr', { detailnum => $self->detailnum })) {
+    $cdr->set('detailnum', '');
+    $error = $cdr->replace;
+    return "error unlinking CDR #" . $cdr->acctid . ": $error" if $error;
+  }
+}
+
 =item replace OLD_RECORD
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
+=cut
+
+# the replace method can be inherited from FS::Record (doesn't touch CDRs)
+
 =item check
 
 Checks all fields to make sure this is a valid line item detail.  If there is
diff --git a/FS/FS/detail_format.pm b/FS/FS/detail_format.pm
index 8840a00..be84680 100644
--- a/FS/FS/detail_format.pm
+++ b/FS/FS/detail_format.pm
@@ -178,6 +178,7 @@ Takes a single CDR and returns an invoice detail to describe it.
 
 By default, this maps the following fields from the CDR:
 
+acctid            => acctid
 rated_price       => amount
 rated_classnum    => classnum
 rated_seconds     => duration
@@ -208,6 +209,7 @@ sub single_detail {
   $price = 0 if $cdr->freesidestatus eq 'no-charge';
 
   FS::cust_bill_pkg_detail->new( {
+      'acctid'      => $cdr->acctid,
       'amount'      => $price,
       'classnum'    => $cdr->rated_classnum,
       'duration'    => $cdr->rated_seconds,
diff --git a/FS/FS/detail_format/sum_count.pm b/FS/FS/detail_format/sum_count.pm
index c40fcb8..253956f 100644
--- a/FS/FS/detail_format/sum_count.pm
+++ b/FS/FS/detail_format/sum_count.pm
@@ -24,6 +24,7 @@ sub header_detail {
 sub append {
   my $self = shift;
   my $svcnums = ($self->{svcnums} ||= {});
+  my $acctids = $self->{acctids} ||= [];
   foreach my $cdr (@_) {
     my $object = $self->{inbound} ? $cdr->cdr_termination(1) : $cdr;
     my $svcnum = $object->svcnum; # yes, $object->svcnum.
@@ -33,6 +34,8 @@ sub append {
     $subtotal->{count}++;
     $subtotal->{amount} += $object->rated_price
       if $object->freesidestatus ne 'no-charge';
+
+    push @$acctids, $cdr->acctid;
   }
 }
 
@@ -68,6 +71,7 @@ sub finish {
         startdate   => '', #could use the earliest startdate in the bunch?
         regionname  => '', #no, we're using prefix instead
         detail      => $self->csv->string,
+        acctid      => $self->{acctids},
     });
   } #foreach $svcnum
 
diff --git a/FS/FS/detail_format/sum_duration.pm b/FS/FS/detail_format/sum_duration.pm
index 1b967b4..c41bed3 100644
--- a/FS/FS/detail_format/sum_duration.pm
+++ b/FS/FS/detail_format/sum_duration.pm
@@ -24,6 +24,7 @@ sub header_detail {
 sub append {
   my $self = shift;
   my $svcnums = ($self->{svcnums} ||= {});
+  my $acctids = ($self->{acctids} ||= []);
   foreach my $cdr (@_) {
     my $object = $self->{inbound} ? $cdr->cdr_termination(1) : $cdr;
     my $svcnum = $object->svcnum; # yes, $object->svcnum.
@@ -34,6 +35,8 @@ sub append {
     $subtotal->{duration} += $object->rated_seconds;
     $subtotal->{amount} += $object->rated_price
       if $object->freesidestatus ne 'no-charge';
+
+    push @$acctids, $cdr->acctid;
   }
 }
 
@@ -70,6 +73,7 @@ sub finish {
         startdate   => '', #could use the earliest startdate in the bunch?
         regionname  => '', #no, we're using prefix instead
         detail      => $self->csv->string,
+        acctid      => $self->{acctids},
     });
   } #foreach $svcnum
 
diff --git a/FS/FS/detail_format/sum_duration_prefix.pm b/FS/FS/detail_format/sum_duration_prefix.pm
index cd7bbe3..3c33dc1 100644
--- a/FS/FS/detail_format/sum_duration_prefix.pm
+++ b/FS/FS/detail_format/sum_duration_prefix.pm
@@ -24,6 +24,7 @@ my $prefix_length = 6;
 sub append {
   my $self = shift;
   my $prefixes = ($self->{prefixes} ||= {});
+  my $acctids = ($self->{acctids} ||= []);
   foreach my $cdr (@_) {
     my (undef, $phonenum) = $cdr->parse_number(
       column => ( $self->{inbound} ? 'src' : 'dst' ),
@@ -52,6 +53,8 @@ sub append {
     $subtotal->{duration} += $object->rated_seconds;
     $subtotal->{amount} += $object->rated_price
       if $object->freesidestatus ne 'no-charge';
+
+    push @$acctids, $cdr->acctid;
   }
 }
 
@@ -91,6 +94,7 @@ sub finish {
         startdate   => '', #could use the earliest startdate in the bunch?
         regionname  => '', #no, we're using prefix instead
         detail      => $self->csv->string,
+        acctid      => $self->{acctids},
     });
   } #foreach $prefix
 }

commit 488d3c15c9aaea2a17826600ee332f0af9b0634d
Author: Jonathan Prykop <jonathan at freeside.biz>
Date:   Thu Jan 28 15:42:43 2016 -0600

    RT#39638: VoIP Usage cost reporting [bug fixes/cleanup]

diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm
index f8fea35..5a1d8ea 100644
--- a/FS/FS/cdr.pm
+++ b/FS/FS/cdr.pm
@@ -464,9 +464,9 @@ Sets the status and rated price.
 
 Available options are: inbound, rated_pretty_dst, rated_regionname,
 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
-rated_classnum, rated_ratename, and set_rate_cost (if true, will set
-a recalculated L</rate_cost> in the rated_cost field after the other
-fields are set; does not work with inbound.)
+rated_classnum, rated_ratename.  If rated_ratedetailnum is provided,
+will also set a recalculated L</rate_cost> in the rated_cost field 
+after the other fields are set (does not work with inbound.)
 
 If there is an error, returns the error, otherwise returns false.
 
@@ -504,7 +504,7 @@ sub set_status_and_rated_price {
         qw( pretty_dst regionname seconds minutes granularity
             ratedetailnum classnum ratename );
     $self->svcnum($svcnum) if $svcnum;
-    $self->rated_cost($self->rate_cost) if $opt{'set_rate_cost'};
+    $self->rated_cost($self->rate_cost) if $opt{'rated_ratedetailnum'};
 
     return $self->replace();
 
@@ -1005,7 +1005,6 @@ sub rate_prefix {
     'rated_ratedetailnum' => $rate_detail->ratedetailnum,
     'rated_classnum'      => $rate_detail->classnum, #rated_ratedetailnum?
     'rated_ratename'      => $ratename, #not rate_detail - Intrastate/Interstate
-    'set_rate_cost'       => 1,
   );
 
 }
diff --git a/httemplate/elements/menu.html b/httemplate/elements/menu.html
index 1d5789d..13478e9 100644
--- a/httemplate/elements/menu.html
+++ b/httemplate/elements/menu.html
@@ -290,6 +290,8 @@ $report_rating{'Call Detail Records (CDRs)'} = [ $fsurl.'search/report_cdr.html'
   if $curuser->access_right("Usage: Call Detail Records (CDRs)");
 $report_rating{'Unrateable CDRs'} = [ $fsurl.'search/cdr.html?freesidestatus=failed;cdrbatchnum=_ALL_' ]
   if $curuser->access_right("Usage: Unrateable CDRs");
+$report_rating{'Customer CDRs Profit/Loss'} = [ $fsurl.'search/report_customer_cdr_profit.html', 'Profit/loss from customer CDRs' ]
+  if $curuser->access_right('Financial reports');
 if ( $curuser->access_right("Usage: Time worked") ) {
   $report_rating{'Time worked'} = [ $fsurl.'search/report_rt_transaction.html', '' ];
   $report_rating{'Time worked summary per ticket'} = [ $fsurl.'search/report_rt_ticket.html', '' ];
@@ -398,8 +400,6 @@ if( $curuser->access_right('Financial reports') ) {
 
   $report_financial{'Customer Accounting Summary'} = [ $fsurl.'search/report_customer_accounting_summary.html', 'Customer accounting summary report' ];
 
-  $report_financial{'Customer Usage Profit/Loss'} = [ $fsurl.'search/report_customer_usage_profit.html', 'Customer usage profit/loss' ];
-
 } elsif($curuser->access_right('Receivables report')) {
 
   $report_financial{'A/R Aging'} = [ $fsurl.'search/report_receivables.html', 'Accounts Receivable Aging report' ];
diff --git a/httemplate/search/customer_usage_profit.html b/httemplate/search/customer_cdr_profit.html
similarity index 97%
rename from httemplate/search/customer_usage_profit.html
rename to httemplate/search/customer_cdr_profit.html
index 9fcc922..8dc0663 100644
--- a/httemplate/search/customer_usage_profit.html
+++ b/httemplate/search/customer_cdr_profit.html
@@ -67,7 +67,7 @@
       #warn "writing ".xl_rowcol_to_cell($r, $c)."\n";
         $worksheet->write( $r, $c, $cell->{value}, $format{$f} );
       }
-      $c++;
+      $c += $cell->{colspan} || 1;
     } #$cell
   $r++;
   } #$row
@@ -119,7 +119,8 @@ as <A HREF="<% "$myself;_type=xls" %>">Excel spreadsheet</A>
 <%init>
 
 die "access denied"
-  unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
+  unless $FS::CurrentUser::CurrentUser->access_right('Financial reports')
+      && $FS::CurrentUser::CurrentUser->access_right('List rating data');
 
 my ($agentnum,$sel_agent);
 if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
@@ -129,7 +130,7 @@ if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
 }
 my $title = $sel_agent ? $sel_agent->agent.' ' : '';
 
-$title .= 'Customer Usage Profit/Loss Report';
+$title .= 'Customer CDRs Profit/Loss Report';
 
 my @items  = ('cust_bill_pkg_recur', 'cust_bill_pkg_recur', 'cust_bill_pkg_detail', 'cust_bill_pkg_detail' );
 my @params = ( [], [ 'cost' => 1 ], [], [ 'cost' => 1 ] );
diff --git a/httemplate/search/report_customer_usage_profit.html b/httemplate/search/report_customer_cdr_profit.html
similarity index 71%
rename from httemplate/search/report_customer_usage_profit.html
rename to httemplate/search/report_customer_cdr_profit.html
index f16489b..2a5efc3 100755
--- a/httemplate/search/report_customer_usage_profit.html
+++ b/httemplate/search/report_customer_cdr_profit.html
@@ -1,6 +1,6 @@
-<% include('/elements/header.html', 'Customer Usage Profit/Loss Report' ) %>
+<% include('/elements/header.html', 'Customer CDRs Profit/Loss Report' ) %>
 
-<FORM ACTION="customer_usage_profit.html" METHOD="GET">
+<FORM ACTION="customer_cdr_profit.html" METHOD="GET">
 
   <TABLE BGCOLOR="#cccccc" CELLSPACING=0>
 
@@ -24,6 +24,7 @@
 <%init>
 
 die "access denied"
-  unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
+  unless $FS::CurrentUser::CurrentUser->access_right('Financial reports')
+      && $FS::CurrentUser::CurrentUser->access_right('List rating data');
 
 </%init>

commit e96bcf25f1d6eb21bb78b9c43bd00049840d9639
Author: Jonathan Prykop <jonathan at freeside.biz>
Date:   Mon Jan 25 23:25:44 2016 -0600

    RT#39638: VoIP Usage cost reporting [menu link]

diff --git a/httemplate/elements/menu.html b/httemplate/elements/menu.html
index f4aeec8..1d5789d 100644
--- a/httemplate/elements/menu.html
+++ b/httemplate/elements/menu.html
@@ -398,6 +398,8 @@ if( $curuser->access_right('Financial reports') ) {
 
   $report_financial{'Customer Accounting Summary'} = [ $fsurl.'search/report_customer_accounting_summary.html', 'Customer accounting summary report' ];
 
+  $report_financial{'Customer Usage Profit/Loss'} = [ $fsurl.'search/report_customer_usage_profit.html', 'Customer usage profit/loss' ];
+
 } elsif($curuser->access_right('Receivables report')) {
 
   $report_financial{'A/R Aging'} = [ $fsurl.'search/report_receivables.html', 'Accounts Receivable Aging report' ];

commit f1ce861d8f7a6431934b4bf5b69f5e7573043818
Author: Jonathan Prykop <jonathan at freeside.biz>
Date:   Mon Jan 25 22:59:47 2016 -0600

    RT#39638: VoIP Usage cost reporting

diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm
index eeb99ba..5fb5640 100644
--- a/FS/FS/Report/Table.pm
+++ b/FS/FS/Report/Table.pm
@@ -599,6 +599,10 @@ sub _cust_bill_pkg_recurring {
       $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, $_date);
   }
 
+  if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
+    push @where, "(cust_main.custnum = $1)";
+  }
+
   return "
   FROM $cust_bill_pkg 
   $cust_bill_pkg_join
@@ -606,6 +610,16 @@ sub _cust_bill_pkg_recurring {
 
 }
 
+=item cust_bill_pkg_recur: the total recur charges
+
+Most arguments as for C<cust_bill_pkg>, plus:
+
+'custnum': limit to this customer
+
+'cost': if true, return total recur costs instead
+
+=cut
+
 sub cust_bill_pkg_recur {
   my $self = shift;
   my ($speriod, $eperiod, $agentnum, %opt) = @_;
@@ -632,9 +646,11 @@ sub cust_bill_pkg_recur {
       ($cust_bill_pkg.edate - $cust_bill_pkg.sdate)";
   }
 
-  my $total_sql = 
-    "SELECT COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)" .
-    $self->_cust_bill_pkg_recurring(@_);
+  my $total_sql = $opt{'cost'}
+    ? "SELECT SUM(part_pkg.recur_cost)"
+    : "SELECT COALESCE(SUM(($cust_bill_pkg.recur - $item_usage) $recur_fraction),0)";
+
+  $total_sql .= $self->_cust_bill_pkg_recurring(@_);
 
   $self->scalar_sql($total_sql);
 }
@@ -650,10 +666,14 @@ sub cust_bill_pkg_count_pkgnum {
 
 =item cust_bill_pkg_detail: the total usage charges in detail lines.
 
-Arguments as for C<cust_bill_pkg>, plus:
+Most arguments as for C<cust_bill_pkg>, plus:
 
 'usageclass': limit to this usage class number.
 
+'custnum': limit to this customer
+
+'cost': if true, return total usage costs instead
+
 =cut
 
 sub cust_bill_pkg_detail {
@@ -686,7 +706,16 @@ sub cust_bill_pkg_detail {
     );
   }
 
+  if ( $opt{'custnum'} =~ /^(\d+)$/ ) {
+    push @where, "(cust_main.custnum = $1)";
+  }
+
   my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) ";
+  my $extra_join = '';
+  if ($opt{'cost'}) {
+    $extra_join = "   JOIN cdr USING ( detailnum ) ";
+    $total_sql  = " SELECT SUM(cdr.rated_cost) ";
+  }
 
   $total_sql .=
     " FROM cust_bill_pkg_detail
@@ -696,8 +725,9 @@ sub cust_bill_pkg_detail {
         LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
         LEFT JOIN part_pkg USING ( pkgpart )
         LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
-        LEFT JOIN part_fee USING ( feepart )
-      WHERE ".join( ' AND ', grep $_, @where );
+        LEFT JOIN part_fee USING ( feepart ) 
+    ".$extra_join.
+    " WHERE ".join( ' AND ', grep $_, @where );
 
   $self->scalar_sql($total_sql);
   
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index c855b1f..cd05be3 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -3819,6 +3819,7 @@ sub tables_hashref {
         'rated_ratedetailnum',        'int', 'NULL',      '', '', '',
         'rated_classnum',             'int', 'NULL',      '', '', '', 
         'rated_ratename',         'varchar', 'NULL', $char_d, '', '', 
+        'rated_cost',            'decimal', 'NULL',  '10,4', '', '',
 
         'carrierid',               'bigint', 'NULL',      '', '', '',
 
diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm
index cdca6fc..f8fea35 100644
--- a/FS/FS/cdr.pm
+++ b/FS/FS/cdr.pm
@@ -214,6 +214,7 @@ sub table_info {
         #'upstream_rateplanid'   => '',
         #'ratedetailnum'         => '',
         'rated_price'           => 'Rated price',
+        'rated_cost'            => 'Rated cost',
         #'distance'              => '',
         #'islocal'               => '',
         #'calltypenum'           => '',
@@ -463,7 +464,9 @@ Sets the status and rated price.
 
 Available options are: inbound, rated_pretty_dst, rated_regionname,
 rated_seconds, rated_minutes, rated_granularity, rated_ratedetailnum,
-rated_classnum, rated_ratename.
+rated_classnum, rated_ratename, and set_rate_cost (if true, will set
+a recalculated L</rate_cost> in the rated_cost field after the other
+fields are set; does not work with inbound.)
 
 If there is an error, returns the error, otherwise returns false.
 
@@ -501,6 +504,8 @@ sub set_status_and_rated_price {
         qw( pretty_dst regionname seconds minutes granularity
             ratedetailnum classnum ratename );
     $self->svcnum($svcnum) if $svcnum;
+    $self->rated_cost($self->rate_cost) if $opt{'set_rate_cost'};
+
     return $self->replace();
 
   }
@@ -1000,6 +1005,7 @@ sub rate_prefix {
     'rated_ratedetailnum' => $rate_detail->ratedetailnum,
     'rated_classnum'      => $rate_detail->classnum, #rated_ratedetailnum?
     'rated_ratename'      => $ratename, #not rate_detail - Intrastate/Interstate
+    'set_rate_cost'       => 1,
   );
 
 }
diff --git a/httemplate/search/customer_usage_profit.html b/httemplate/search/customer_usage_profit.html
new file mode 100644
index 0000000..9fcc922
--- /dev/null
+++ b/httemplate/search/customer_usage_profit.html
@@ -0,0 +1,252 @@
+% if ( $cgi->param('_type') =~ /(xls)$/ ) {
+<%perl>
+  # egregious false laziness w/ search/report_tax-xls.cgi
+  my $format = $FS::CurrentUser::CurrentUser->spreadsheet_format;
+  my $filename = $cgi->url(-relative => 1);
+  $filename =~ s/\.html$//;
+  $filename .= $format->{extension};
+  http_header('Content-Type' => $format->{mime_type});
+  http_header('Content-Disposition' => qq!attachment;filename="$filename"!);
+
+  my $output = '';
+  my $XLS = IO::String->new($output);
+  my $workbook = $format->{class}->new($XLS)
+    or die "Error opening .xls file: $!";
+
+  my $worksheet = $workbook->add_worksheet('Summary');
+
+  my %format = (
+    header => {
+      size      => 11,
+      bold      => 1,
+      align     => 'center',
+      valign    => 'vcenter',
+      text_wrap => 1,
+    },
+    money => {
+      size      => 11,
+      align     => 'right',
+      valign    => 'bottom',
+      num_format=> 8,
+    },
+    '' => {},
+  );
+  my %default = (
+      font      => 'Calibri',
+      border    => 1,
+  );
+  foreach (keys %format) {
+    my %f = (%default, %{$format{$_}});
+    $format{$_} = $workbook->add_format(%f);
+    $format{"m_$_"} = $workbook->add_format(%f);
+  }
+
+  my ($r, $c) = (0, 0);
+  for my $row (@rows) {
+    $c = 0;
+    my $thisrow = shift @cells;
+    for my $cell (@$thisrow) {
+      if (!ref($cell)) {
+        # placeholder, so increment $c so that we write to the correct place
+        $c++;
+        next;
+      }
+      # format name
+      my $f = '';
+      $f = 'header' if $row->{header} or $cell->{header};
+      $f = 'money' if $cell->{format} eq 'money';
+      if ( $cell->{rowspan} > 1 or $cell->{colspan} > 1 ) {
+        my $range = xl_range_formula(
+          'Summary',
+          $r, $r - 1 + ($cell->{rowspan} || 1),
+          $c, $c - 1 + ($cell->{colspan} || 1)
+        );
+        #warn "merging $range\n";
+        $worksheet->merge_range($range, $cell->{value}, $format{"m_$f"});
+      } else {
+      #warn "writing ".xl_rowcol_to_cell($r, $c)."\n";
+        $worksheet->write( $r, $c, $cell->{value}, $format{$f} );
+      }
+      $c++;
+    } #$cell
+  $r++;
+  } #$row
+  $workbook->close;
+
+  http_header('Content-Length' => length($output));
+  $m->print($output);
+</%perl>
+% } else {
+<& /elements/header.html, $title &>
+% my $myself = $cgi->self_url;
+<P ALIGN="right" CLASS="noprint">
+Download full reports<BR>
+as <A HREF="<% "$myself;_type=xls" %>">Excel spreadsheet</A>
+</P>
+<style type="text/css">
+.report * {
+  background-color: #f8f8f8;
+  border: 1px solid #999999;
+  padding: 2px;
+}
+.report td {
+  text-align: right;
+}
+.total { background-color: #f5f6be; }
+.shaded { background-color: #c8c8c8; }
+.totalshaded { background-color: #bfc094; }
+</style>
+<table class="report" width="100%" cellspacing=0>
+% foreach my $rowinfo (@rows) {
+  <tr<% $rowinfo->{class} ? ' class="'.$rowinfo->{class}.'"' : ''%>>
+%   my $thisrow = shift @cells;
+%   foreach my $cell (@$thisrow) {
+%     next if !ref($cell); # placeholders
+%     my $td = $cell->{header} ? 'th' : 'td';
+%     my $style = '';
+%     $style .= ' class="'.$cell->{class}.'"' if $cell->{class};
+%     $style .= " rowspan=".$cell->{rowspan} if $cell->{rowspan} > 1;
+%     $style .= " colspan=".$cell->{colspan} if $cell->{colspan} > 1;
+%     $style .= ' style="color: red"' if $cell->{value} < 0;
+      <<%$td%><%$style%>><% $cell->{value} |h %></<%$td%>>
+%   }
+  </tr>
+% }
+</table>
+
+<& /elements/footer.html &>
+% }
+<%init>
+
+die "access denied"
+  unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
+
+my ($agentnum,$sel_agent);
+if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
+  $agentnum = $1;
+  $sel_agent = qsearchs('agent', { 'agentnum' => $agentnum } );
+  die "agentnum $agentnum not found!" unless $sel_agent;
+}
+my $title = $sel_agent ? $sel_agent->agent.' ' : '';
+
+$title .= 'Customer Usage Profit/Loss Report';
+
+my @items  = ('cust_bill_pkg_recur', 'cust_bill_pkg_recur', 'cust_bill_pkg_detail', 'cust_bill_pkg_detail' );
+my @params = ( [], [ 'cost' => 1 ], [], [ 'cost' => 1 ] );
+
+my @labels = ();
+my @cross_params = ();
+
+my %search_hash;
+foreach (qw(agentnum)) {
+  if ( defined $cgi->param($_) ) {
+    $search_hash{$_} = $cgi->param($_);
+  }
+}
+
+my $query = FS::cust_main::Search->search(\%search_hash);
+my @cust_main = qsearch($query);
+
+foreach my $cust_main (@cust_main) {
+  push @cross_params, [ ('custnum' => $cust_main->custnum) ];
+}
+
+my %opt = (
+  items         => \@items,
+  params        => \@params,
+  cross_params  => \@cross_params,
+  agentnum      => $agentnum,
+);
+for ( qw(start_month start_year end_month end_year) ) {
+  if ( $cgi->param($_) =~ /^(\d+)$/ ) {
+    $opt{$_} = $1;
+  }
+}
+
+my $report = FS::Report::Table::Monthly->new(%opt);
+my $data = $report->data;
+
+### False laziness with customer_accounting_summary.html
+my @total;
+
+my @rows; # hashes of row info
+my @cells; # arrayrefs of cell info
+# We use Excel currency format, but not Excel dates, because
+# these are whole months and there's no nice way to express that.
+# This is the historical behavior for monthly reports.
+
+# header row
+$rows[0] = {};
+$cells[0] = [
+  { header => 1, rowspan => 2 },
+  map {
+    { header => 1, colspan => 5, value => time2str('%b %Y', $_) }
+  } @{ $data->{speriod} }
+];
+my $ncols = scalar(@{ $data->{speriod} });
+
+$rows[1] = {};
+$cells[1] = [ '',
+  map { 
+  ( 
+    { header => 1, value => mt('Recur Fee') },
+    { header => 1, value => mt('Recur Cost') },
+    { header => 1, value => mt('Usage Fee') },
+    { header => 1, value => mt('Usage Cost') },
+    { header => 1, value => mt('Profit'), class => 'shaded' },
+  ) } (1..$ncols)
+];
+
+my $row = 0;
+foreach my $cust_main (@cust_main) { # correspond to cross_params
+  my $skip = 1; # skip the customer iff ALL of their values are zero
+  push @rows, {};
+  my @thisrow;
+  # customer name
+  push @thisrow,
+    { value   => $cust_main->name,
+      header  => 1
+    };
+  for my $col (0..$ncols-1) { # the month
+    my $profit = 0;
+    for my $item (0..3) { # recur/recur_cost/usage/usage_cost
+      my $value = $data->{data}[$item][$col][$row];
+      $skip = 0 if abs($value) > 0.005;
+      push @thisrow, { value => sprintf('%0.2f', $value), format => 'money' };
+      $total[$col * 5 + $item] += $value;
+      $profit += (($item % 2) ? -1 : 1) * $value;
+    } #item
+    push @thisrow, { 
+      value => sprintf('%0.2f', $profit), 
+      format => 'money',
+      class => 'shaded',
+    };
+    $total[$col * 5 + 4] += $profit;
+  } #month
+  push @cells, \@thisrow;
+
+  if ( $skip ) {
+    # all values are zero--remove the rows we just added
+    pop @rows;
+    pop @cells;
+  }
+  $row++;
+}
+
+push @rows, { class => 'total' };
+my @thisrow;
+push @thisrow,
+  { value => mt('Total'),
+    header => 1
+  };
+for my $col (0..($ncols * 5)-1) { # month and recur/recur_cost/usage/usage_cost/profit
+  my $value = $total[$col];
+  push @thisrow, { 
+    value => sprintf('%0.2f', $value), 
+    format => 'money',
+    class => ($col % 5 == 4) ? 'totalshaded' : 'total',
+  };
+}
+push @cells, \@thisrow;
+
+</%init>
diff --git a/httemplate/search/report_customer_usage_profit.html b/httemplate/search/report_customer_usage_profit.html
new file mode 100755
index 0000000..f16489b
--- /dev/null
+++ b/httemplate/search/report_customer_usage_profit.html
@@ -0,0 +1,29 @@
+<% include('/elements/header.html', 'Customer Usage Profit/Loss Report' ) %>
+
+<FORM ACTION="customer_usage_profit.html" METHOD="GET">
+
+  <TABLE BGCOLOR="#cccccc" CELLSPACING=0>
+
+    <% include( '/elements/tr-select-agent.html',
+                 'curr_value'    => scalar( $cgi->param('agentnum') ),
+                 'label'         => 'Agent ',
+                 'disable_empty' => 0,
+             )
+    %>
+
+    <% include('/elements/tr-select-from_to.html' ) %>
+    
+  </TABLE>
+
+<BR>
+<INPUT TYPE="submit" VALUE="Get Report">
+
+</FORM>
+
+<% include('/elements/footer.html') %>
+<%init>
+
+die "access denied"
+  unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
+
+</%init>

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

Summary of changes:
 FS/FS/Report/Table.pm                             |   42 +++-
 FS/FS/Schema.pm                                   |    4 +
 FS/FS/cdr.pm                                      |   20 +-
 FS/FS/cust_bill_pkg_detail.pm                     |   37 +++
 FS/FS/detail_format.pm                            |    2 +
 FS/FS/detail_format/sum_count.pm                  |    4 +
 FS/FS/detail_format/sum_duration.pm               |    4 +
 FS/FS/detail_format/sum_duration_prefix.pm        |    4 +
 httemplate/elements/menu.html                     |    2 +
 httemplate/search/customer_cdr_profit.html        |  253 +++++++++++++++++++++
 httemplate/search/report_customer_cdr_profit.html |   30 +++
 11 files changed, 391 insertions(+), 11 deletions(-)
 create mode 100644 httemplate/search/customer_cdr_profit.html
 create mode 100755 httemplate/search/report_customer_cdr_profit.html




More information about the freeside-commits mailing list