use strict;
use vars qw($VERSION);
-$VERSION = '3.9git';
+$VERSION = '3.91~git';
#find missing entries in this file with:
# for a in `ls *pm | cut -d. -f1`; do grep 'L<FS::'$a'>' ../FS.pm >/dev/null || echo "missing $a" ; done
},
{
+ 'key' => 'password-insecure',
+ 'section' => 'password',
+ 'description' => 'Disable all password security checks and allow entry of insecure passwords. NOT RECOMMENDED.',
+ 'type' => 'checkbox',
+ 'per_agent' => 1,
+ },
+
+ {
'key' => 'datavolume-forcemegabytes',
'section' => 'UI',
'description' => 'All data volumes are expressed in megabytes',
my $self = shift;
my $password = shift;
+ my $cust_main = $self->cust_main;
+
+ # workaround for non-inserted services
+ if ( !$cust_main and $self->get('pkgnum') ) {
+ my $cust_pkg = FS::cust_pkg->by_key($self->get('pkgnum'));
+ $cust_main = $cust_pkg->cust_main if $cust_pkg;
+ }
+ warn "is_password_allowed: no customer could be identified" if !$cust_main;
+ return '' if $cust_main && $conf->config_bool('password-insecure', $cust_main->agentnum);
+
# basic checks using Data::Password;
# options for Data::Password
$DICTIONARY = 4; # minimum length of disallowed words
return '' unless $self->get($self->primary_key); # for validating new passwords pre-insert
#check against customer fields
- my $cust_main = $self->cust_main;
if ($cust_main) {
my @words;
# words from cust_main
my @otherparts = ();
if ( ref($self) eq 'FS::cust_bill' && $cust_main->email_csv_cdr ) {
- if ( $conf->exists('voip-cust_email_csv_cdr_zip') ) {
+ if ( $conf->config('voip-cdr_email_attach') eq 'zip' ) {
my $data = join('', map "$_\n",
$self->call_details(prepend_billed_number=>1)
die "Error zipping CDR attachment: $!" unless $status == AZ_OK;
push @otherparts, build MIME::Entity
- 'Type' => 'application/zip',
- 'Encoding' => 'base64',
- 'Data' => $zipdata,
+ 'Type' => 'application/zip',
+ 'Encoding' => 'base64',
+ 'Data' => $zipdata,
+ 'Disposition' => 'attachment',
'Filename' => 'usage-'. $self->invnum. '.zip',
;
- } else {
+ } else { # } elsif ( $conf->config('voip-cdr_email_attach') eq 'csv' ) {
push @otherparts, build MIME::Entity
'Type' => 'text/csv',
use strict;
use base qw( FS::cdr );
-use vars qw( %info %cdrtypes);
+use vars qw( %info );
use DateTime;
-use FS::Record qw( qsearch );
+use FS::Record qw( qsearchs );
use FS::cdr_type;
my ($tmp_mday, $tmp_mon, $tmp_year);
'type' => 'csv',
'sep_char' => ',',
'disabled' => 0,
- 'header_buffer' => sub {
-
- %cdrtypes = ( map { $_->cdrtypename => $_->cdrtypenum }
- qsearch('cdr_type', {})
- );
- },
#listref of what to do with each field from the CDR, in order
'import_fields' => [
sub { # 5. Call Category (LOCAL, NATIONAL, FREECALL, MOBILE)
my ($cdr, $data) = @_;
$data ||= 'none';
- $cdr->cdrtypenum($cdrtypes{$data} || '');
+
+ my $cdr_type = qsearchs('cdr_type', { 'cdrtypename' => $data } );
+ $cdr->set('cdrtypenum', $cdr_type->cdrtypenum) if $cdr_type;
$cdr->set('dcontext', $data);
},
sub { # 6. Start Date (DDMMYYYY
$cust_bill{ $invnum}->custnum == $arg{custnum}
or die "lineitem #$billpkgnum not found\n";
- # calculate credit ratio.
- # (First deduct any existing credits applied to this line item, to avoid
- # rounding errors.)
- my $charged = $cust_bill_pkg->get($setuprecur);
- my $previously_credited =
- $cust_bill_pkg->credited( '', '', setuprecur => $setuprecur) || 0;
-
- $charged -= $previously_credited;
+ # tax_Xlocation records don't distinguish setup and recur, so calculate
+ # the fraction of setup+recur (after deducting credits) that's setup. This
+ # will also be the fraction of tax (after deducting credits) that's tax on
+ # setup.
+ my ($setup, $recur);
+ $setup = $cust_bill_pkg->get('setup') || 0;
+ if ($setup) {
+ $setup -= $cust_bill_pkg->credited('', '', setuprecur => 'setup') || 0;
+ }
+ $recur = $cust_bill_pkg->get('recur') || 0;
+ if ($recur) {
+ $recur -= $cust_bill_pkg->credited('', '', setuprecur => 'recur') || 0;
+ }
+ my $setup_ratio = $setup / ($setup + $recur);
+
+ # Calculate the fraction of tax to credit: it's the fraction of this charge
+ # (either setup or recur) that's being credited.
+ my $charged = ($setuprecur eq 'setup') ? $setup : $recur;
+ next if $charged == 0; # shouldn't happen, but still...
+
if ($charged < $amount) {
$error = "invoice #$invnum: tried to credit $amount, but only $charged was charged";
last;
}
- my $ratio = $amount / $charged;
+ my $credit_ratio = $amount / $charged;
# gather taxes that apply to the selected item
foreach my $table (
foreach ($tax_link->cust_credit_bill_pkg) {
$tax_amount -= $_->amount;
}
- my $tax_credit = sprintf('%.2f', $tax_amount * $ratio);
+ # split tax amount based on setuprecur
+ # (this method ensures that, if you credit both setup and recur tax,
+ # it always equals the entire tax despite any rounding)
+ my $setup_tax = sprintf('%.2f', $tax_amount * $setup_ratio);
+ if ( $setuprecur eq 'setup' ) {
+ $tax_amount = $setup_tax;
+ } else {
+ $tax_amount = $tax_amount - $setup_tax;
+ }
+ my $tax_credit = sprintf('%.2f', $tax_amount * $credit_ratio);
my $pkey = $tax_link->get($tax_link->primary_key);
push @taxlines, {
table => $table,
$upgrade = 0; #go away after setup+start dates cleaned up for old customers
+our $cache_enabled = 0;
+
sub _simplecache {
my( $self, $hashref ) = @_;
- if ( $hashref->{'pkg'} ) {
+ if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
$self->{'_pkgpart'} = FS::part_pkg->new($hashref);
}
}
--- /dev/null
+package FS::part_event::Condition::cust_pay_payby;
+
+use strict;
+use base qw( FS::part_event::Condition );
+use FS::payby;
+use FS::Record qw( qsearchs );
+use FS::cust_pay;
+
+sub description { 'Type of most recent payment'; }
+
+tie my %payby, 'Tie::IxHash', FS::payby->payment_payby2payname;
+
+sub option_fields {
+ (
+ 'payby' => {
+ label => 'Payment type',
+ type => 'checkbox-multiple',
+ options => [ keys %payby ],
+ option_labels => \%payby,
+ },
+ );
+}
+
+sub condition {
+ my($self, $object) = @_;
+
+ my $cust_main = $self->cust_main($object);
+
+ my $cust_pay = qsearchs({ 'table' => 'cust_pay',
+ 'hashref' => { 'custnum'=>$cust_main->custnum },
+ 'order_by' => 'ORDER BY _date DESC LIMIT 1',
+ })
+ or return 0;
+
+ my $payby = $self->option('payby') || {};
+ $payby->{ $cust_pay->payby };
+
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+
+use DBI;
+use Date::Format 'time2str';
+use Date::Parse 'str2time';
+use Getopt::Long;
+
+use FS::Record qw(qsearchs dbh);
+use FS::UID qw(adminsuidsetup);
+use FS::cdr;
+use FS::cdr_batch;
+use Time::Local;
+
+sub usage {
+ "Import cdrs from an Evariste CSRP postgres database.
+
+Date range defaults from the enddate of the last evariste import
+batch to the most recent midnight. Imports cdrs for calls that
+ended on or after startdate, before enddate.
+
+Usage:
+freeside-cdr-evariste -d database -h host -u dbusername -p dbpass
+ [-s startdate] [-e enddate] freesideuser
+";
+}
+
+my ($db,$host,$username,$password,$startdate,$enddate,$verbose);
+GetOptions(
+ "db=s" => \$db,
+ "enddate=s" => \$enddate,
+ "host=s" => \$host,
+ "password=s" => \$password,
+ "startdate=s" => \$startdate,
+ "username=s" => \$username
+);
+
+my $fsuser = $ARGV[-1];
+
+die usage() unless $db && $host && $password && $username && $fsuser;
+
+adminsuidsetup($fsuser);
+
+if ($startdate) {
+ $startdate = str2time($startdate) or die "Can't parse startdate $startdate";
+ $startdate = time2str("%Y-%m-%d %H:%M:%S",$startdate);
+}
+unless ($startdate) {
+ my $lastbatch = qsearchs({
+ 'table' => 'cdr_batch',
+ 'hashref' => { 'cdrbatch' => {op=>'like', value=>"evariste-import-$host-$db\%"}},
+ 'order_by' => 'ORDER BY _date DESC LIMIT 1',
+ });
+ $startdate = time2str("%Y-%m-%d %H:%M:%S", $lastbatch->_date) if $lastbatch;
+}
+$startdate ||= '2010-01-01 00:00:00'; #seems decently in the past
+
+my @now = localtime();
+my $now = timelocal(0,0,0,$now[3],$now[4],$now[5]); #most recent midnight
+if ($enddate) {
+ $enddate = str2time($enddate) or die "Can't parse enddate $enddate";
+ $now = $enddate;
+ $enddate = time2str("%Y-%m-%d %H:%M:%S",$enddate);
+}
+$enddate ||= time2str("%Y-%m-%d %H:%M:%S",$now);
+
+my $cdbh = DBI->connect("dbi:Pg:database=$db;host=$host", $username, $password)
+ or die $DBI::errstr;
+
+# selecting by end_time rather than start_time
+# so we don't lose records between batches
+my $csth = $cdbh->prepare('SELECT c.*, cp.* FROM cdr c
+LEFT JOIN cdr_rate_postproc cp ON cp.cdr_id = c.id
+WHERE end_time >= ? AND end_time < ?')
+ or die $cdbh->errstr;
+
+$csth->execute($startdate,$enddate)
+ or die $csth->errstr;
+
+$FS::UID::AutoCommit = 0;
+
+my $cdrbatchname = "evariste-import-$host-$db-". time2str('%Y/%m/%d-%T',$now);
+die "Batch $cdrbatchname already exists, please specify a different end date. \n\n" . usage()
+ if FS::cdr_batch->row_exists('cdrbatch = ?', $cdrbatchname);
+my $cdr_batch = new FS::cdr_batch({
+ 'cdrbatch' => $cdrbatchname,
+ '_date' => $now,
+});
+my $error = $cdr_batch->insert;
+if ($error) {
+ dbh->rollback;
+ die "Error creating batch: $error";
+}
+
+while (my $row = $csth->fetchrow_hashref) {
+ next if FS::cdr->row_exists('uniqueid = ?', $row->{'id'});
+ my $cdr = FS::cdr->new ({
+ # from cdr table
+ 'cdrbatchnum' => $cdr_batch->cdrbatchnum,
+ 'uniqueid' => $row->{'id'},
+ 'src' => $row->{'src'},
+ 'dst' => $row->{'dest'},
+ 'startdate' => int(str2time($row->{'start_time'})),
+ 'answerdate' => int(str2time($row->{'answer_time'})),
+ 'enddate' => int(str2time($row->{'end_time'})),
+ 'duration' => $row->{'duration_sec'},
+ 'accountcode' => $row->{'customer_id'},
+ 'src_ip_addr' => $row->{'src_ip'},
+ 'dst_ip_addr' => $row->{'dest_ip'},
+ # from cdr_rate_postproc table
+ 'billsec' => $row->{'rate_bill_sec'},
+ 'upstream_price' => $row->{'rate_cost_net'},
+ });
+ $error = $cdr->insert;
+ if ($error) {
+ dbh->rollback or die dbh->errstr;
+ die "Error inserting cdr: $error";
+ }
+}
+
+$csth->finish;
+
+dbh->commit or die dbh->errstr;
+
+exit;
+
+
+
# Add the build information to changelog
-dch -b --newversion $GIT_VERSION~$DATE "Auto-Build"
+dch -b --newversion $GIT_VERSION-$DATE "Auto-Build"
# Using pbuilder and pdebuild in chroot instead of building directly : dpkg-buildpackage -b -rfakeroot -uc -us
use FS::cust_svc;
my $user = shift or die &usage;
-adminsuidsetup;
+adminsuidsetup $user;
my $svcpart = shift or die &usage;
+freeside (3.91git~20160205-1) UNRELEASED; urgency=low
+
+ * Testing version of freeside.
+
+ -- Jeremy Davis <jeremyd-debian@freeside.biz> Fri, 05 Feb 2016 17:01:21 -0500
+
+freeside (3.9) UNRELEASED; urgency=low
+
+ * Stable version of freeside.
+
+ -- Jeremy Davis <jeremyd-debian@freeside.biz> Fri, 05 Feb 2016 02:07:21 -0500
+
freeside (3.9git~20160120-1) UNRELEASED; urgency=low
* Testing version of freeside.
Pre-Depends: freeside-lib
# dbconfig-common
Depends: ${perl:Depends}, ${shlibs:Depends}, ${misc:Depends}, freeside-webui,
- debconf, cron, openbsd-inetd, tcpd, undersmtpd, ssmtp, freeside-lib (>= 3.8git~20151123)
+ debconf, cron, openbsd-inetd, tcpd, undersmtpd, ssmtp, freeside-lib (>= 3.8)
Description: Billing and trouble ticketing for service providers
Freeside is a web-based billing, trouble ticketing and network monitoring
application. It includes features for ISPs and WISPs, hosting providers and
% } else {
<FONT SIZE="-1">
% }
-© 2015 Freeside Internet Services, Inc.<BR>
+© 2016 Freeside Internet Services, Inc.<BR>
All rights reserved.<BR>
Licensed under the terms of the<BR>
GNU <b>Affero</b> General Public License.<BR>
<INPUT TYPE="hidden" NAME="squelch_cdr" VALUE="<% $cust_main->squelch_cdr %>">
% }
-% if ( $conf->config('voip-cdr_email_attach') ) {
+% if ( my $attach = $conf->config('voip-cdr_email_attach') ) {
<TR>
- <TD COLSPAN="2"><INPUT TYPE="checkbox" NAME="email_csv_cdr" VALUE="Y" <% $cust_main->email_csv_cdr eq "Y" ? 'CHECKED' : '' %>> <% mt('Attach CDRs as CSV to emailed invoices') |h %></TD>
+ <TD COLSPAN="2"><INPUT TYPE="checkbox" NAME="email_csv_cdr" VALUE="Y" <% $cust_main->email_csv_cdr eq "Y" ? 'CHECKED' : '' %>> <% mt('Attach CDRs as '. uc($attach). ' to emailed invoices') |h %></TD>
</TR>
% } else {
<INPUT TYPE="hidden" NAME="email_csv_cdr" VALUE="<% $cust_main->email_csv_cdr %>">
<INPUT TYPE="text" ID="clear_password" NAME="clear_password" VALUE="<% $password %>" SIZE=<% $pmax2 %> MAXLENGTH=<% $pmax %>>
<& /elements/random_pass.html, 'clear_password' &><BR>
<DIV ID="clear_password_result" STYLE="font-size: smaller"></DIV>
- <& '/elements/validate_password.html',
- 'fieldid' => 'clear_password',
- 'svcnum' => $svcnum
+ <& /elements/validate_password.html,
+ 'fieldid' => 'clear_password',
+ 'svcnum' => $svcnum ,
+ 'pkgnum' => $pkgnum,
&>
</TD>
</TR>
<INPUT ID="password_field" TYPE="text">
<DIV ID="password_field_result">
<& '/elements/validate_password.html',
- fieldid => 'password_field',
- svcnum => $svcnum
+ fieldid => 'password_field',
+ svcnum => $svcnum,
+ pkgnum => $pkgnum, # used if the service doesn't exist yet
&>
The ID of the input field can be anything; the ID of the DIV in which to display results
var resultfield = document.getElementById(fieldid);
if (this.value) {
resultfield.innerHTML = '<SPAN STYLE="color: blue;">Validating password...</SPAN>';
- validate_password('fieldid',fieldid,'svcnum','<% $opt{'svcnum'} %>','password',this.value,
+ validate_password('fieldid',fieldid,
+ 'svcnum',<% $opt{'svcnum'} |js_string %>,
+ 'pkgnum',<% $opt{'pkgnum'} |js_string %>,
+ 'password',this.value,
function (result) {
result = JSON.parse(result);
var resultfield = document.getElementById(result.fieldid);
</TR>
<TR>
% if ( $old{$pre.'company'} ) {
- <TD><% $old{$pre.'company'} %></TD>
+ <TD><% $old{$pre.'company'} |h %></TD>
% }
</TR>
<TR>
- <TD><% $old{$pre.'address1'} %></TD>
+ <TD><% $old{$pre.'address1'} |h %></TD>
<TD ROWSPAN=3><FONT COLOR="#ff0000"><B><% $new{$pre.'error'} %></B></FONT></TD>
</TR>
<TR>
- <TD><% $old{$pre.'address2'} %></TD>
+ <TD><% $old{$pre.'address2'} |h %></TD>
</TR>
<TR>
- <TD><% $old{$pre.'city'} %>, <% $old{$pre.'state'} %> <% $old{$pre.'zip'} %></TD>
+ <TD><% $old{$pre.'city'} |h %>, <% $old{$pre.'state'} |h %> <% $old{$pre.'zip'} |h %></TD>
</TR>
% } else { # not an error
% $rows++ if !$new{$pre.'addr_clean'};
<TR>
% if ( $old{$pre.'company'} ) {
<TR>
- <TD><% $old{$pre.'company'} %></TD>
- <TD><% $new{$pre.'company'} %></TD>
+ <TD><% $old{$pre.'company'} |h %></TD>
+ <TD><% $new{$pre.'company'} |h %></TD>
</TR>
% }
<TR>
- <TD><% $old{$pre.'address1'} %></TD>
- <TD><% $new{$pre.'address1'} %></TD>
+ <TD><% $old{$pre.'address1'} |h %></TD>
+ <TD><% $new{$pre.'address1'} |h %></TD>
</TR>
<TR>
- <TD><% $old{$pre.'address2'} %></TD>
- <TD><% $new{$pre.'address2'} %></TD>
+ <TD><% $old{$pre.'address2'} |h %></TD>
+ <TD><% $new{$pre.'address2'} |h %></TD>
</TR>
<TR>
- <TD><% $old{$pre.'city'} %>, <% $old{$pre.'state'} %> <% $old{$pre.'zip'} %></TD>
- <TD><% $new{$pre.'city'} %>, <% $new{$pre.'state'} %> <% $new{$pre.'zip'} %></TD>
+ <TD><% $old{$pre.'city'} |h %>, <% $old{$pre.'state'} |h %> <% $old{$pre.'zip'} |h %></TD>
+ <TD><% $new{$pre.'city'} |h %>, <% $new{$pre.'state'} |h %> <% $new{$pre.'zip'} |h %></TD>
</TR>
% } # if error
Confirm census tract
% }
</B><BR>
-<% $location{address1} %> <% $location{address2} %><BR>
-<% $location{city} %>, <% $location{state} %> <% $location{zip} %><BR>
+<% $location{address1} |h %> <% $location{address2} |h %><BR>
+<% $location{city} |h %>, <% $location{state} |h %> <% $location{zip} |h %><BR>
<BR>
% my $querystring = "census_year=$year&latitude=".$cache->get('latitude').'&longitude='.$cache->get('longitude');
<A HREF="http://maps.ffiec.gov/FFIECMapper/TGMapSrv.aspx?<% $querystring %>"
<% include('/elements/tr-fixed.html',
'field' => 'from',
'label' => 'From:',
- 'value' => scalar( $from ),
+ 'value' => $from,
)
%>
<% include('/elements/tr-fixed.html',
'field' => 'subject',
'label' => 'Subject:',
- 'value' => scalar( $subject ),
+ 'value' => $subject,
)
%>
<%doc>
-Requires cgi params 'password' (plaintext) and 'sub' ('validate_password' is only
-acceptable value.) Also accepts 'svcnum' (for svc_acct, will otherwise create an
-empty dummy svc_acct) and 'fieldid' (for html post-processing, passed along in
-results for convenience.)
-
-Returns a json-encoded hashref with keys of 'valid' (set to 1 if object is valid),
-'error' (error text if password is invalid) or 'syserror' (error text if password
-could not be validated.) Only one of these keys will be set. Will also set
-'fieldid' if it was passed.
+Requires cgi params 'password' (plaintext) and 'sub' ('validate_password' is
+only acceptable value.) Also accepts 'svcnum' (for svc_acct, will otherwise
+create an empty dummy svc_acct), 'pkgnum' (for when the svc_acct isn't yet
+inserted), and 'fieldid' (for html post-processing, passed along in results
+for convenience.)
+
+Returns a json-encoded hashref with keys of 'valid' (set to 1 if object is
+valid), 'error' (error text if password is invalid) or 'syserror' (error text
+if password could not be validated.) Only one of these keys will be set.
+Will also set 'fieldid' if it was passed.
</%doc>
<% encode_json($result) %>
$result{'syserror'} = 'Invalid svcnum' unless $svcnum =~ /^\d*$/;
return \%result if $result{'syserror'};
+ my $pkgnum = $arg{'pkgnum'};
+ $result{'syserror'} = 'Invalid pkgnum' unless $pkgnum =~ /^\d*$/;
+ return \%result if $result{'syserror'};
+
my $svc_acct = $svcnum
? qsearchs('svc_acct',{'svcnum' => $svcnum})
- : (new FS::svc_acct {});
+ : FS::svc_acct->new({ 'pkgnum' => $pkgnum });
$result{'syserror'} = 'Could not find service' unless $svc_acct;
return \%result if $result{'syserror'};
: 'all_pkgs';
#false laziness w/httemplate/view/cust_main/packages.html
-my $select = '*, setup_option.optionvalue AS _opt_setup_fee, '.
- 'recur_option.optionvalue AS _opt_recur_fee',
+my $select = join(',',
+ 'cust_pkg.*',
+ 'part_pkg.*',
+ 'setup_option.optionvalue AS _opt_setup_fee',
+ 'recur_option.optionvalue AS _opt_recur_fee',
+ );
+
my $addl_from = qq{
LEFT JOIN part_pkg USING ( pkgpart )
LEFT JOIN part_pkg_option AS setup_option
AND recur_option.optionname = 'recur_fee' )
};
+local($FS::cust_pkg::cache_enabled) = 1; #for $cust_pkg->part_pkg
my %all_pkgs = map { $_->custnum =>
[ $_->$pkgs_method({ select => $select,
addl_from => $addl_from,
},
sub { my $c = shift;
sprintf( $money_char.'%.2f',
- $c->part_pkg->base_recur($c)
+ $c->base_recur
);
},
sub { FS::part_pkg::freq_pretty(shift); },
-% 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><BR>
-% # as <A HREF="<% "$myself;_type=csv" %>">CSV file</A> # is this still needed?
-</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 .= " rowspan=".$cell->{rowspan} if $cell->{rowspan} > 1;
-% $style .= " colspan=".$cell->{colspan} if $cell->{colspan} > 1;
- <<%$td%><%$style%>><% $cell->{value} |h %></<%$td%>>
-% }
- </tr>
-% }
-</table>
-
-<& /elements/footer.html &>
-% }
+<& elements/grid-report.html,
+ title => $title,
+ rows => \@rows,
+ cells => \@cells,
+&>
<%init>
die "access denied"
$rows[0] = {};
$cells[0] = [
{ header => 1, rowspan => 2, colspan => ($setuprecur ? 4 : 3) },
- ($setuprecur ? '' : ()),
map {
{ header => 1, colspan => ($grossdiscount ? 3 : 2), value => time2str('%b %Y', $_) },
- ''
} @{ $data->{speriod} }
];
my $ncols = scalar(@{ $data->{speriod} });
$rows[1] = {};
-$cells[1] = [ '',
- ($setuprecur ? '' : ()),
+$cells[1] = [
map {
( ($grossdiscount
? (
rowspan => ($setuprecur ? 2 : 1),
},
;
- } else {
- push @thisrow, '';
}
if ( $setuprecur ) {
# subheading
header => 1,
colspan => 3,
rowspan => ($setuprecur ? 2 : 1), };
- } else {
- push @thisrow, '';
}
if ( $setuprecur ) {
push @thisrow,
-% 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->{colspan} || 1;
- } #$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 &>
-% }
+<& elements/grid-report.html,
+ title => $title,
+ rows => \@rows,
+ cells => \@cells,
+ head => $head,
+ # would be better handled with Mason inheritance? consider this. easy enough
+ # to change it at this point.
+&>
<%init>
die "access denied"
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' };
+ push @thisrow, {
+ value => sprintf('%0.2f', $value),
+ format => 'money',
+ class => ($value < 0 ? 'negative' : ''),
+ };
$total[$col * 5 + $item] += $value;
$profit += (($item % 2) ? -1 : 1) * $value;
} #item
}
push @cells, \@thisrow;
+my $head = q[
+<style>
+ .negative { color: red }
+</style>
+];
</%init>
--- /dev/null
+<%doc>
+
+Simple display front-end for reports that produce some kind of data table,
+which the user can request as an Excel spreadsheet. /elements/header.html
+and /elements/footer.html are included automatically, so don't include them
+again.
+
+This element defines "total", "shaded", and "totalshaded" CSS classes. For
+anything else, insert a <style> element via the 'head' argument.
+
+Usage:
+
+<& elements/grid-report.html,
+ title => 'My Report',
+ rows => [
+ { header => 1, },
+ ...
+ ],
+ cells => [
+ [ # row 0
+ { value => '123.45',
+ # optional
+ format => 'money',
+ header => 1,
+ rowspan => 2,
+ colspan => 3,
+ class => 'shaded',
+ },
+ ...
+ ],
+ ],
+ head => q[<div>Thing to insert before the table</div>],
+ foot => q[<span>That's all folks!</span>].
+&>
+</%doc>
+% if ( $cgi->param('_type') =~ /(xls)$/ ) {
+<%perl>
+ # egregious false laziness w/ search/report_tax-xls.cgi
+ # and search/customer_cdr_profit.html
+ 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);
+ # indices in these correspond to column positions
+ my @rowspans;
+ my @widths;
+
+ for my $row (@rows) {
+ $c = 0;
+ my $thisrow = shift @cells;
+ for my $cell (@$thisrow) {
+ # skip over cells that are occupied by rowspans above them
+ while ($rowspans[$c]) {
+ $rowspans[$c]--;
+ $c++;
+ }
+
+ # skip this cell if it's empty, also
+ next if !ref($cell);
+ # 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} );
+ }
+
+ # estimate column width, as in search-xls, but without date formats
+ my $width = length($cell->{value}) / ($cell->{colspan} || 1);
+ $width *= 1.1 if $f eq 'header';
+ $width++ if $f eq 'money'; # for money symbol
+ $width += 2; # pad it
+
+ for (1 .. ($cell->{colspan} || 1)) {
+ # adjust minimum widths to allow for this cell's contents
+ $widths[$c] = $width if $width > ($widths[$c] || 0);
+
+ # and if this cell has a rowspan, block off that many rows below it
+ if ( $cell->{rowspan} > 1 ) {
+ $rowspans[$c] = $cell->{rowspan} - 1;
+ }
+ $c++;
+ }
+ } #$cell
+ $r++;
+ } #$row
+
+ $c = 0;
+ for my $c (0 .. scalar(@widths) - 1) {
+ $worksheet->set_column($c, $c, $widths[$c]);
+ }
+ $workbook->close;
+
+ http_header('Content-Length' => length($output));
+ $m->print($output);
+</%perl>
+% } else {
+<& /elements/header.html, $title &>
+<% $head %>
+% my $myself = $cgi->self_url;
+<P ALIGN="right" CLASS="noprint">
+Download full reports<BR>
+as <A HREF="<% "$myself;_type=xls" %>">Excel spreadsheet</A><BR>
+</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 .= " rowspan=".$cell->{rowspan} if $cell->{rowspan} > 1;
+% $style .= " colspan=".$cell->{colspan} if $cell->{colspan} > 1;
+% $style .= ' class="' . $cell->{class} . '"' if $cell->{class};
+ <<%$td%><%$style%>><% $cell->{value} |h %></<%$td%>>
+% }
+ </tr>
+% }
+</table>
+<% $foot %>
+<& /elements/footer.html &>
+% }
+<%args>
+$title
+@rows
+@cells
+$head => ''
+$foot => ''
+</%args>
</TR>
% }
-% if ( $conf->config('voip-cdr_email_attach') ) {
+% if ( my $attach = $conf->config('voip-cdr_email_attach') ) {
<TR>
- <TD ALIGN="right"><% mt('Email CDRs as CSV') |h %></TD>
+ <TD ALIGN="right"><% mt('Email CDRs as '.uc($attach)) |h %></TD>
<TD BGCOLOR="#ffffff"><% $cust_main->email_csv_cdr ? $yes : $no %></TD>
</TR>
% }
projects / freeside.git / commitdiff