From a6b56c331ccd2fa42c74c5f01555ff407c14e3cf Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Tue, 11 Aug 2015 17:05:16 -0700 Subject: throw an error during RBC batch import if the batch has the wrong account number, #37476 --- FS/FS/pay_batch/RBC.pm | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/pay_batch/RBC.pm b/FS/FS/pay_batch/RBC.pm index 53f810852..644c73c8b 100644 --- a/FS/FS/pay_batch/RBC.pm +++ b/FS/FS/pay_batch/RBC.pm @@ -5,6 +5,7 @@ use vars qw(@ISA %import_info %export_info $name); use Date::Format 'time2str'; use FS::Conf; use Encode 'encode'; +use feature 'state'; my $conf; my ($client_num, $shortname, $longname, $trans_code, $testmode, $i, $declined, $totaloffset); @@ -30,9 +31,10 @@ $name = 'RBC'; 'filetype' => 'fixed', #this only really applies to Debit Detail, but we otherwise only need first char 'formatre' => - '^(.).{18}(.{4}).{3}(.).{11}(.{19}).{6}(.{30}).{17}(.{9})(.{18}).{6}(.{14}).{23}(.).{9}\r?$', + '^(.).{3}(.{10}).{5}(.{4}).{3}(.).{11}(.{19}).{6}(.{30}).{17}(.{9})(.{18}).{6}(.{14}).{23}(.).{9}\r?$', 'fields' => [ qw( recordtype + clientnum batchnum subtype paybatchnum @@ -43,11 +45,24 @@ $name = 'RBC'; status ) ], 'hook' => sub { - my $hash = shift; - $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 ); - $hash->{'_date'} = time; - $hash->{'payinfo'} =~ s/^(\S+).*/$1/; # these often have trailing spaces - $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'}; + # pull client_num from config and check it against what's in the batch + state $clientnum ||= do { + my $conf = FS::Conf->new; + my @config = $conf->config("batchconfig-RBC"); + $config[0]; + }; + + my $hash = shift; + $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 ); + $hash->{'_date'} = time; + $hash->{'payinfo'} =~ s/^(\S+).*/$1/; # these often have trailing spaces + $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'}; + + if ( $clientnum and $hash->{clientnum} ne $clientnum ) { + die "RBC client number in batch (".$hash->{clientnum}.") does not ". + "match configuration.\n"; + } + ''; }, 'approved' => sub { my $hash = shift; -- cgit v1.2.1 From a73684bba1b297715a95eabb8845c5212523f4e1 Mon Sep 17 00:00:00 2001 From: Jeremy Davis Date: Wed, 12 Aug 2015 14:26:14 -0400 Subject: #31495 Date changes for Earthlink --- FS/FS/cdr/earthlink.pm | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/cdr/earthlink.pm b/FS/FS/cdr/earthlink.pm index 5042f6fa5..c6c4e1535 100644 --- a/FS/FS/cdr/earthlink.pm +++ b/FS/FS/cdr/earthlink.pm @@ -3,11 +3,13 @@ package FS::cdr::earthlink; use strict; use vars qw( @ISA %info $date); use Time::Local; -use FS::cdr qw(_cdr_date_parser_maker _cdr_min_parser_maker); +use FS::cdr qw(_cdr_min_parser_maker); use Date::Parse; @ISA = qw(FS::cdr); +my ($tmp_mday, $tmp_mon, $tmp_year); + %info = ( 'name' => 'Earthlink', 'weight' => 120, @@ -15,14 +17,30 @@ use Date::Parse; 'import_fields' => [ skip(3), #Account number/ SERVICE LOC / BILL NUMBER - sub { my($cdr, $date) = @_; - $date; - }, #date + sub { my($cdr, $date) = @_; + $date =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4})$/ + or die "unparseable date: $date"; + ($tmp_mon, $tmp_mday, $tmp_year) = ($1, $2, $3); + }, #date sub { my($cdr, $time) = @_; + $time =~ /^(\d{1,2}):(\d{1,2}):(\d{1,2}) (AM|PM)$/ + or die "unparsable time: $time"; #maybe we shouldn't die... + my $hour = $1; + $hour += 12 if $4 eq 'PM' && $hour != 12; + $hour = 0 if $4 eq 'AM' && $hour == 12; + + my $dt = DateTime->new( + year => $tmp_year, + month => $tmp_mon, + day => $tmp_mday, + hour => $hour, + minute => $2, + second => $3, + time_zone => 'local', + ); + $cdr->set('startdate', $dt->epoch); - my $datetime = $date. " ". $time; - $cdr->set('startdate', $datetime ); - }, #time + }, skip(1), #TollFreeNumber sub { my($cdr, $src) = @_; $src =~ s/\D//g; -- cgit v1.2.1 From 4a6b0868fabbc617f05b1f9981c52b28d3cb2bcb Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Wed, 12 Aug 2015 21:48:43 -0500 Subject: RT#25026: Option to include taxes in sales report --- FS/FS/Report/Table.pm | 32 +++++++++++++++++++++++++++++--- 1 file changed, 29 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 63e5318c3..4b1ad05d6 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -485,9 +485,9 @@ sub cust_pkg_recur_cost { =item cust_bill_pkg: the total package charges on invoice line items. -'charges': limit the type of charges included (setup, recur, usage, discount). -Should be a string containing one or more of 'S', 'R', 'U', or 'D'; if -unspecified, defaults to all three. +'charges': limit the type of charges included (setup, recur, usage, discount, taxes). +Should be a string containing one or more of 'S', 'R', or 'U'; or 'D' or 'T' (discount +and taxes should not be combined with the others.) If unspecified, defaults to 'SRU'. 'classnum': limit to this package class. @@ -517,6 +517,7 @@ sub cust_bill_pkg { $sum += $self->cust_bill_pkg_recur(@_) if $charges{R}; $sum += $self->cust_bill_pkg_detail(@_) if $charges{U}; $sum += $self->cust_bill_pkg_discount(@_) if $charges{D}; + $sum += $self->cust_bill_pkg_taxes(@_) if $charges{T}; if ($opt{'average_per_cust_pkg'}) { my $count = $self->cust_bill_pkg_count_pkgnum(@_); @@ -727,6 +728,31 @@ sub cust_bill_pkg_discount { $self->scalar_sql($total_sql); } +sub cust_bill_pkg_taxes { + my $self = shift; + my ($speriod, $eperiod, $agentnum, %opt) = @_; + + $agentnum ||= $opt{'agentnum'}; + + my @where = ( + '(cust_bill_pkg.pkgnum != 0 OR feepart IS NOT NULL)', + $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), + $self->with_report_option(%opt), + $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), + $self->with_refnum(%opt), + $self->with_cust_classnum(%opt) + ); + + my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg_tax_location.amount),0) + FROM cust_bill_pkg + $cust_bill_pkg_join + LEFT JOIN cust_bill_pkg_tax_location + ON (cust_bill_pkg.billpkgnum = cust_bill_pkg_tax_location.taxable_billpkgnum) + WHERE " . join(' AND ', grep $_, @where); + + $self->scalar_sql($total_sql); +} + ##### package churn report ##### =item active_pkg: The number of packages that were active at the start of -- cgit v1.2.1 From d19d491320789ae2e621d35cc7d67ac1c7696367 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Fri, 14 Aug 2015 14:38:43 -0700 Subject: add "tax collected" to tax liability report, #26770 --- FS/FS/Report/Tax.pm | 43 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 34 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/Report/Tax.pm b/FS/FS/Report/Tax.pm index 23c16452e..0923d55cf 100644 --- a/FS/FS/Report/Tax.pm +++ b/FS/FS/Report/Tax.pm @@ -52,9 +52,10 @@ sub report_internal { } # %breakdown: short name => field identifier + # null classnum should remain null, not be converted to zero %breakdown = ( 'taxclass' => 'cust_main_county.taxclass', - 'pkgclass' => 'part_pkg.classnum', + 'pkgclass' => 'COALESCE(part_fee.classnum,part_pkg.classnum)', 'city' => 'cust_main_county.city', 'district' => 'cust_main_county.district', 'state' => 'cust_main_county.state', @@ -69,7 +70,8 @@ sub report_internal { my $join_cust_pkg = $join_cust. ' LEFT JOIN cust_pkg USING ( pkgnum ) - LEFT JOIN part_pkg USING ( pkgpart ) '; + LEFT JOIN part_pkg USING ( pkgpart ) + LEFT JOIN part_fee USING ( feepart ) '; my $from_join_cust_pkg = " FROM cust_bill_pkg $join_cust_pkg "; @@ -239,7 +241,7 @@ sub report_internal { # there isn't one for 'sales', because we calculate sales by adding up # the taxable and exempt columns. - # TAX QUERIES (billed tax, credited tax) + # TAX QUERIES (billed tax, credited tax, collected tax) # ----------- # sum of billed tax: @@ -252,14 +254,16 @@ sub report_internal { if ( $breakdown{pkgclass} ) { # If we're not grouping by package class, this is unnecessary, and # probably really expensive. + # Remember that fees also have package classes. $taxfrom .= " LEFT JOIN cust_bill_pkg AS taxable ON (cust_bill_pkg_tax_location.taxable_billpkgnum = taxable.billpkgnum) LEFT JOIN cust_pkg ON (taxable.pkgnum = cust_pkg.pkgnum) - LEFT JOIN part_pkg USING (pkgpart)"; + LEFT JOIN part_pkg USING (pkgpart) + LEFT JOIN part_fee ON (taxable.feepart = part_fee.feepart) "; } - my $istax = "cust_bill_pkg.pkgnum = 0"; + my $istax = "cust_bill_pkg.pkgnum = 0 and cust_bill_pkg.feepart is null"; $sql{tax} = "$select SUM(cust_bill_pkg_tax_location.amount) $taxfrom @@ -272,8 +276,8 @@ sub report_internal { $group_all"; # sum of credits applied against billed tax - # ($creditfrom includes join of taxable item to part_pkg if with_pkgclass - # is on) + # ($creditfrom includes join of taxable item to part_pkg/part_fee if + # with_pkgclass is on) my $creditfrom = $taxfrom . ' JOIN cust_credit_bill_pkg USING (billpkgtaxlocationnum)' . ' JOIN cust_credit_bill USING (creditbillnum)'; @@ -296,6 +300,27 @@ sub report_internal { $creditwhere AND $istax $group_all"; + # sum of tax paid + # this suffers from the same ambiguity as anything else that applies + # received payments to specific packages, but in reality the discrepancy + # should be minimal since people either pay their bill or don't. + # the join is on billpkgtaxlocationnum to avoid cross-producting. + + my $paidfrom = $taxfrom . + ' JOIN cust_bill_pay_pkg'. + ' ON (cust_bill_pay_pkg.billpkgtaxlocationnum ='. + ' cust_bill_pkg_tax_location.billpkgtaxlocationnum)'; + + $sql{tax_paid} = "$select SUM(cust_bill_pay_pkg.amount) + $paidfrom + $where AND $istax + $group"; + + $all_sql{tax_paid} = "$select_all SUM(cust_bill_pay_pkg.amount) + $paidfrom + $where AND $istax + $group_all"; + my %data; my %total; # note that we use keys(%sql) here and keys(%all_sql) later. nothing @@ -303,7 +328,7 @@ sub report_internal { # as for the individual category queries foreach my $k (keys(%sql)) { my $stmt = $sql{$k}; - warn "\n".uc($k).":\n".$stmt."\n" if $DEBUG; + warn "\n".uc($k).":\n".$stmt."\n" if $DEBUG > 1; my $sth = dbh->prepare($stmt); # eight columns: pkgclass, taxclass, state, county, city, district # taxnums (comma separated), value @@ -322,7 +347,7 @@ sub report_internal { push @$bin, [ $k, $row->[6], $row->[7] ]; } } - warn "DATA:\n".Dumper(\%data) if $DEBUG > 1; + warn "DATA:\n".Dumper(\%data) if $DEBUG; foreach my $k (keys %all_sql) { warn "\nTOTAL ".uc($k).":\n".$all_sql{$k}."\n" if $DEBUG; -- cgit v1.2.1 From 89525f062092c185344ec7318406b1c9086d1eda Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Mon, 17 Aug 2015 23:01:31 -0500 Subject: RT#18830: Upload file to message template --- FS/FS/Schema.pm | 14 +++ FS/FS/template_image.pm | 222 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 236 insertions(+) create mode 100644 FS/FS/template_image.pm (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 184c6c951..55dc99eca 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -204,6 +204,7 @@ sub dbdef_dist { && ( ! /^queue(_arg|_depend|_stat)?$/ || ! $opt->{'queue-no_history'} ) && ! $tables_hashref_torrus->{$_} && ! /^cacti_page$/ + && ! /^template_image$/ } $dbdef->tables ) { @@ -6346,6 +6347,19 @@ sub tables_hashref { ], }, + 'template_image' => { + 'columns' => [ + 'imgnum', 'serial', '', '', '', '', + 'name', 'varchar', '', $char_d, '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'mime_type', 'varchar', '', $char_d, '', '', + 'base64', 'text', '', '', '', '', + ], + 'primary_key' => 'imgnum', + 'unique' => [ ], + 'index' => [ ['name'], ['agentnum'] ], + }, + 'cust_msg' => { 'columns' => [ 'custmsgnum', 'serial', '', '', '', '', diff --git a/FS/FS/template_image.pm b/FS/FS/template_image.pm new file mode 100644 index 000000000..e7f4baba5 --- /dev/null +++ b/FS/FS/template_image.pm @@ -0,0 +1,222 @@ +package FS::template_image; +use base qw( FS::Agent_Mixin FS::Record ); + +use strict; +use FS::Record qw( qsearchs ); +use File::Slurp qw( slurp ); +use MIME::Base64 qw( encode_base64 ); + +my %ext_to_type = ( + 'jpeg' => 'image/jpeg', + 'jpg' => 'image/jpeg', + 'png' => 'image/png', + 'gif' => 'image/gif', +); + +=head1 NAME + +FS::template_image - Object methods for template_image records + +=head1 SYNOPSIS + + use FS::template_image; + + $record = new FS::template_image { + 'name' => 'logo', + 'agentnum' => $agentnum, + 'base64' => encode_base64($rawdata), + 'mime_type' => 'image/jpg', + }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::template_image object represents an uploaded image for insertion into templates. +FS::template_image inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item imgnum - primary key + +=item name - unique name, for selecting/editing images + +=item agentnum - image agent + +=item mime-type - image mime-type + +=item base64 - base64-encoded raw contents of image file + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new object. To add the object to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'template_image'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=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 + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('imgnum','agentnum') + || $self->ut_text('name','mime-type') + || $self->ut_anything('base64') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item src + +Returns a data url for this image, incorporating mime_type & base64 + +=cut + +sub src { + my $self = shift; + 'data:' + . $self->mime_type + . ';base64,' + . $self->base64; +} + +=item html + +Returns html for a basic img tag for this image (no attributes) + +=cut + +sub html { + my $self = shift; + ''; +} + +=item process_image_delete + +Process for deleting an image. Run as a job using L. + +=cut + +sub process_image_delete { + my $job = shift; + my $param = shift; + my $template_image = qsearchs('template_image',{ 'imgnum' => $param->{'imgnum'} }) + or die "Could not load template_image"; + my $error = $template_image->delete; + die $error if $error; + ''; +} + +=item process_image_upload + +Process for uploading an image. Run as a job using L. + +=cut + +sub process_image_upload { + my $job = shift; + my $param = shift; + + my $files = $param->{'uploaded_files'} + or die "No files provided.\n"; + + my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files; + + my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; + my $file = $dir. $files{'file'}; + + my $type; + if ( $file =~ /\.(\w+)$/i ) { + my $ext = lc($1); + die "Unrecognized file extension $ext" + unless $ext_to_type{$ext}; + $type = $ext_to_type{$ext}; + } else { + die "Cannot upload image file without extension" + } + + my $template_image = new FS::template_image { + 'name' => $param->{'name'}, + 'mime_type' => $type, + 'agentnum' => $param->{'agentnum'}, + 'base64' => encode_base64( slurp($file, binmode => ':raw'), '' ), + }; + my $error = $template_image->insert(); + die $error if $error; + unlink $file; + ''; + +} + +=back + +=head1 BUGS + +Will be described here once found. + +=head1 SEE ALSO + +L + +=cut + +1; + -- cgit v1.2.1 From 9bbc67e3460dc0045df5262e89c662104e4edd9a Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 19 Aug 2015 17:07:55 -0700 Subject: make discount-show-always work correctly when an invoice has more than one package charge, #32545, fallout from #10481 --- FS/FS/cust_main/Billing.pm | 70 +++++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 35 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 0bc0fbd39..5c10c639a 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -883,53 +883,53 @@ sub bill { sub _omit_zero_value_bundles { my @in = @_; - my @cust_bill_pkg = (); - my @cust_bill_pkg_bundle = (); - my $sum = 0; - my $discount_show_always = 0; + my @out = (); + my @bundle = (); + my $discount_show_always = $conf->exists('discount-show-always'); + my $show_this = 0; + + # this is a pack-and-deliver pattern. every time there's a cust_bill_pkg + # _without_ pkgpart_override, that's the start of the new bundle. if there's + # an existing bundle, and it contains a nonzero amount (or a zero amount + # that's displayable anyway), push all line items in the bundle. foreach my $cust_bill_pkg ( @in ) { - $discount_show_always = ($cust_bill_pkg->get('discounts') - && scalar(@{$cust_bill_pkg->get('discounts')}) - && $conf->exists('discount-show-always')); - - warn " pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ". - "setup_show_zero ". $cust_bill_pkg->setup_show_zero. - "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n" - if $DEBUG > 0; - - if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) { - push @cust_bill_pkg, @cust_bill_pkg_bundle - if $sum > 0 - || ($sum == 0 && ( $discount_show_always - || grep {$_->recur_show_zero || $_->setup_show_zero} - @cust_bill_pkg_bundle - ) - ); - @cust_bill_pkg_bundle = (); - $sum = 0; + if (scalar(@bundle) and !$cust_bill_pkg->pkgpart_override) { + # ship out this bundle and reset it + if ( $show_this ) { + push @out, @bundle; + } + @bundle = (); + $show_this = 0; } - $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur; - push @cust_bill_pkg_bundle, $cust_bill_pkg; + # add this item to the current bundle + push @bundle, $cust_bill_pkg; + # determine if it makes the bundle displayable + if ( $cust_bill_pkg->setup > 0 + or $cust_bill_pkg->recur > 0 + or $cust_bill_pkg->setup_show_zero + or $cust_bill_pkg->recur_show_zero + or ($discount_show_always + and scalar(@{ $cust_bill_pkg->get('discounts')}) + ) + ) { + $show_this++; + } } - push @cust_bill_pkg, @cust_bill_pkg_bundle - if $sum > 0 - || ($sum == 0 && ( $discount_show_always - || grep {$_->recur_show_zero || $_->setup_show_zero} - @cust_bill_pkg_bundle - ) - ); + # last bundle + if ( $show_this) { + push @out, @bundle; + } warn " _omit_zero_value_bundles: ". scalar(@in). - '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n" + '->'. scalar(@out). "\n" #. Dumper(@out). "\n" if $DEBUG > 2; - (@cust_bill_pkg); - + @out; } sub _make_lines { -- cgit v1.2.1 From 2dddd8e1742bf2e8ebe9f2d3e560bc78bba95cff Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Thu, 20 Aug 2015 01:42:15 -0500 Subject: RT#14829: automatic payments triggered by bill now show up as Payment by fs_queue --- FS/FS/Schema.pm | 4 ++++ FS/FS/queue.pm | 21 +++++++++++++++++++++ FS/bin/freeside-queued | 5 +++++ 3 files changed, 30 insertions(+) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 55dc99eca..a799ceebe 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -4333,6 +4333,7 @@ sub tables_hashref { 'custnum', 'int', 'NULL', '', '', '', 'secure', 'char', 'NULL', 1, '', '', 'priority', 'int', 'NULL', '', '', '', + 'usernum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'jobnum', 'unique' => [], @@ -4346,6 +4347,9 @@ sub tables_hashref { { columns => [ 'custnum' ], table => 'cust_main', }, + { columns => [ 'usernum' ], + table => 'access_user', + }, ], }, diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 1b52ac4fc..f7f09485d 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -97,6 +97,10 @@ Optional link to customer (see L). Secure flag, 'Y' indicates that when using encryption, the job needs to be run on a machine with the private key. +=item usernum + +For access_user that created the job + =cut =back @@ -151,6 +155,8 @@ sub insert { $self->custnum( $args{'custnum'} ) if $args{'custnum'}; + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -235,6 +241,7 @@ sub check { || $self->ut_enum('status',['', qw( new locked failed done )]) || $self->ut_anything('statustext') || $self->ut_numbern('svcnum') + || $self->ut_foreign_keyn('usernum', 'access_user', 'usernum') ; return $error if $error; @@ -357,6 +364,20 @@ sub update_statustext { #''; } +=item access_user + +Returns FS::access_user object (if any) associated with this user. + +Returns nothing if not found. + +=cut + +sub access_user { + my $self = shift; + my $usernum = $self->usernum || return (); + return qsearchs('access_user',{ 'usernum' => $usernum }) || (); +} + =back =head1 SUBROUTINES diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 7c4cf1b64..398b03d12 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -218,8 +218,13 @@ while (1) { # don't put @args in the log, may expose passwords $log->info('starting job ('.$ljob->job.')'); warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; + # switch user only if a job user is available + my $oldCurrentUser = $FS::CurrentUser::CurrentUser; + my $jobuser = $ljob->access_user; + local $FS::CurrentUser::CurrentUser = $jobuser if $jobuser; local $FS::UID::AutoCommit = 0; # so that we can clean up failures eval $eval; #throw away return value? suppose so + $FS::CurrentUser::CurrentUser = $oldCurrentUser if $jobuser; if ( $@ ) { dbh->rollback; my %hash = $ljob->hash; -- cgit v1.2.1 From ed3c8f7e9284bcfafd37c8c693084ab12f8f9f40 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Mon, 24 Aug 2015 17:23:33 -0500 Subject: RT#14829: automatic payments triggered by bill now show up as Payment by fs_queue [fixed local CurrentUser] --- FS/FS/queue.pm | 27 ++++++++++++++------------- FS/bin/freeside-queued | 11 +++++------ 2 files changed, 19 insertions(+), 19 deletions(-) (limited to 'FS') diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index f7f09485d..67d124d02 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -364,19 +364,20 @@ sub update_statustext { #''; } -=item access_user - -Returns FS::access_user object (if any) associated with this user. - -Returns nothing if not found. - -=cut - -sub access_user { - my $self = shift; - my $usernum = $self->usernum || return (); - return qsearchs('access_user',{ 'usernum' => $usernum }) || (); -} +# not needed in 4 +#=item access_user +# +#Returns FS::access_user object (if any) associated with this user. +# +#Returns nothing if not found. +# +#=cut +# +#sub access_user { +# my $self = shift; +# my $usernum = $self->usernum || return (); +# return qsearchs('access_user',{ 'usernum' => $usernum }) || (); +#} =back diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 398b03d12..36871b295 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -218,13 +218,12 @@ while (1) { # don't put @args in the log, may expose passwords $log->info('starting job ('.$ljob->job.')'); warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; - # switch user only if a job user is available - my $oldCurrentUser = $FS::CurrentUser::CurrentUser; - my $jobuser = $ljob->access_user; - local $FS::CurrentUser::CurrentUser = $jobuser if $jobuser; local $FS::UID::AutoCommit = 0; # so that we can clean up failures - eval $eval; #throw away return value? suppose so - $FS::CurrentUser::CurrentUser = $oldCurrentUser if $jobuser; + do { + # switch user only if a job user is available + local $FS::CurrentUser::CurrentUser = $ljob->access_user || $FS::CurrentUser::CurrentUser; + eval $eval; #throw away return value? suppose so + }; if ( $@ ) { dbh->rollback; my %hash = $ljob->hash; -- cgit v1.2.1 From 00e05a457f164bb5ae1734fbbff09aa00ee25d6a Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 24 Aug 2015 16:10:49 -0700 Subject: fix display of setup fee discounts when recurring fee is zero, #32545 --- FS/FS/Template_Mixin.pm | 45 ++++++++++++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 17 deletions(-) (limited to 'FS') diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 757701aa8..e9b60a86c 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -3010,7 +3010,9 @@ sub _items_cust_bill_pkg { } my $summary_page = $opt{summary_page} || ''; #unused my $multisection = defined($category) || defined($locationnum); - my $discount_show_always = 0; + # this variable is the value of the config setting, not whether it applies + # to this particular line item. + my $discount_show_always = $conf->exists('discount-show-always'); my $maxlength = $conf->config('cust_bill-latex_lineitem_maxlength') || 40; @@ -3050,11 +3052,13 @@ sub _items_cust_bill_pkg { if (exists($_->{unit_amount})) { $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ); } - push @b, { %$_ } - if $_->{amount} != 0 - || $discount_show_always - || ( ! $_->{_is_setup} && $_->{recur_show_zero} ) - || ( $_->{_is_setup} && $_->{setup_show_zero} ) + push @b, { %$_ }; + # we already decided to create this display line; don't reconsider it + # now. + # if $_->{amount} != 0 + # || $discount_show_always + # || ( ! $_->{_is_setup} && $_->{recur_show_zero} ) + # || ( $_->{_is_setup} && $_->{setup_show_zero} ) ; $_ = undef; } @@ -3181,6 +3185,7 @@ sub _items_cust_bill_pkg { if ( (!$type || $type eq 'S') && ( $cust_bill_pkg->setup != 0 || $cust_bill_pkg->setup_show_zero + || ($discount_show_always and $cust_bill_pkg->unitsetup > 0) ) ) { @@ -3188,10 +3193,12 @@ sub _items_cust_bill_pkg { warn "$me _items_cust_bill_pkg adding setup\n" if $DEBUG > 1; + # append the word 'Setup' to the setup line if there's going to be + # a recur line for the same package (i.e. not a one-time charge) my $description = $desc; $description .= ' Setup' if $cust_bill_pkg->recur != 0 - || $discount_show_always + || ($discount_show_always and $cust_bill_pkg->unitrecur > 0) || $cust_bill_pkg->recur_show_zero; $description .= $cust_bill_pkg->time_period_pretty( $part_pkg, @@ -3255,11 +3262,18 @@ sub _items_cust_bill_pkg { } + # should we show a recur line? + # if type eq 'S', then NO, because we've been told not to. + # otherwise, show the recur line if: + # - there's a recurring charge + # - or recur_show_zero is on + # - or there's a positive unitrecur (so it's been discounted to zero) + # and discount-show-always is on if ( ( !$type || $type eq 'R' || $type eq 'U' ) && ( $cust_bill_pkg->recur != 0 - || $cust_bill_pkg->setup == 0 - || $discount_show_always + || !defined($s) + || ($discount_show_always and $cust_bill_pkg->unitrecur > 0) || $cust_bill_pkg->recur_show_zero ) ) @@ -3501,9 +3515,6 @@ sub _items_cust_bill_pkg { } # foreach $display - $discount_show_always = ($cust_bill_pkg->cust_bill_pkg_discount - && $conf->exists('discount-show-always')); - } foreach ( $s, $r, ($opt{skip_usage} ? () : $u ), $d ) { @@ -3515,11 +3526,11 @@ sub _items_cust_bill_pkg { $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ); } - push @b, { %$_ } - if $_->{amount} != 0 - || $discount_show_always - || ( ! $_->{_is_setup} && $_->{recur_show_zero} ) - || ( $_->{_is_setup} && $_->{setup_show_zero} ) + push @b, { %$_ }; + #if $_->{amount} != 0 + # || $discount_show_always + # || ( ! $_->{_is_setup} && $_->{recur_show_zero} ) + # || ( $_->{_is_setup} && $_->{setup_show_zero} ) } } -- cgit v1.2.1 From e6796fcb87b17c937eacfacacd933da7bc5f0996 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Tue, 25 Aug 2015 01:40:21 -0700 Subject: RBC download script: option to avoid closing the batch, #35228 --- FS/FS/pay_batch.pm | 40 ++++++++++++++++++++++------------------ FS/bin/freeside-rbc-download | 9 ++++++--- 2 files changed, 28 insertions(+), 21 deletions(-) (limited to 'FS') diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index df969a00f..2a522b46e 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -222,6 +222,8 @@ I - an L module I - an L object for a batch gateway. This takes precedence over I. +I - do not try to close batches + Supported format keys (defined in the specified FS::pay_batch module) are: I - required, can be CSV, fixed, variable, XML @@ -456,26 +458,28 @@ sub import_results { } # foreach (@all_values) # decide whether to close batches that had payments posted - foreach my $batchnum (keys %target_batches) { - my $pay_batch = FS::pay_batch->by_key($batchnum); - my $close = 1; - if ( defined($close_condition) ) { - # Allow the module to decide whether to close the batch. - # $close_condition can also die() to abort the whole import. - $close = eval { $close_condition->($pay_batch) }; - if ( $@ ) { - $dbh->rollback; - die $@; + if ( !$param->{no_close} ) { + foreach my $batchnum (keys %target_batches) { + my $pay_batch = FS::pay_batch->by_key($batchnum); + my $close = 1; + if ( defined($close_condition) ) { + # Allow the module to decide whether to close the batch. + # $close_condition can also die() to abort the whole import. + $close = eval { $close_condition->($pay_batch) }; + if ( $@ ) { + $dbh->rollback; + die $@; + } } - } - if ( $close ) { - my $error = $pay_batch->set_status('R'); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + if ( $close ) { + my $error = $pay_batch->set_status('R'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } - } - } + } # foreach $batchnum + } # if (!$param->{no_close}) $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; diff --git a/FS/bin/freeside-rbc-download b/FS/bin/freeside-rbc-download index 376b839e1..3f692fa0f 100755 --- a/FS/bin/freeside-rbc-download +++ b/FS/bin/freeside-rbc-download @@ -10,13 +10,13 @@ use FS::Record qw(qsearch qsearchs); use FS::pay_batch; use FS::Conf; -use vars qw( $opt_v $opt_a $opt_f ); -getopts('va:f:'); +use vars qw( $opt_v $opt_a $opt_f $opt_n ); +getopts('va:f:n'); #$Net::SFTP::Foreign::debug = -1; sub usage { " Usage: - freeside-rbc-download [ -v ] [ -a archivedir ] [ -f filename ] user\n + freeside-rbc-download [ -v ] [ -n ] [ -a archivedir ] [ -f filename ] user\n " } sub debug { @@ -102,6 +102,7 @@ for my $dir ( $ftp->nlst ) { my $error = FS::pay_batch->import_results( filehandle => $fh, format => 'RBC', + no_close => ($opt_n ? 1 : 0), ); if ( $error ) { @@ -146,6 +147,8 @@ matching the pattern. This can be used to reprocess a specific file. -a directory: Archive the files in the specified directory. +-n: Do not try to close batches after applying results. + user: freeside username =head1 BUGS -- cgit v1.2.1 From ca501bda179434c87d9150780a80d3d64b68e358 Mon Sep 17 00:00:00 2001 From: Jeremy Davis Date: Wed, 26 Aug 2015 15:17:02 -0400 Subject: Ticket #37472 Import calls with Internal ID 50 --- FS/FS/cdr/aapt.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cdr/aapt.pm b/FS/FS/cdr/aapt.pm index 600a1920f..3c4964317 100644 --- a/FS/FS/cdr/aapt.pm +++ b/FS/FS/cdr/aapt.pm @@ -77,7 +77,7 @@ my %UNIT_SCALE = ( #Table 2.1.4 'calltypenum', # usage ID (CUSG) sub { # ID type my ($cdr, $data, $conf, $param) = @_; - if ($data != 1) { + if ($data !~ /(1|50)/) { warn "AAPT: service ID type is not telephone number.\n"; $param->{skiprow} = 1; } -- cgit v1.2.1 From 33f1c704766af0621159d5a8453379b6706d8c8a Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 27 Aug 2015 14:46:31 -0700 Subject: external message services: core refactoring of msg_template --- FS/FS/Schema.pm | 23 ++ FS/FS/cust_msg.pm | 19 +- FS/FS/msg_template.pm | 331 +++------------- FS/FS/msg_template/email.pm | 911 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 1014 insertions(+), 270 deletions(-) create mode 100644 FS/FS/msg_template/email.pm (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index a799ceebe..311313a4e 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -6320,8 +6320,11 @@ sub tables_hashref { 'mime_type', 'varchar', '', $char_d, '', '', 'body', 'blob', 'NULL', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', + # migrate these to msg_template_email 'from_addr', 'varchar', 'NULL', 255, '', '', 'bcc_addr', 'varchar', 'NULL', 255, '', '', + # change to not null on v5 + 'msgclass', 'varchar', 'NULL', 16, '', '', ], 'primary_key' => 'msgnum', 'unique' => [ ], @@ -6333,6 +6336,26 @@ sub tables_hashref { ], }, + 'msg_template_http' => { + 'columns' => [ + 'num', 'serial', '', '', '', '', + 'msgnum', 'int', '', '', '', '', + 'prepare_url', 'varchar', 'NULL', 255, '', '', + 'send_url', 'varchar', 'NULL', 255, '', '', + 'username', 'varchar', 'NULL', $char_d, '', '', + 'password', 'varchar', 'NULL', $char_d, '', '', + 'content', 'text', 'NULL', '', '', '', + ], + 'primary_key' => 'num', + 'unique' => [ [ 'msgnum' ], ], + 'index' => [ ], + 'foreign_keys' => [ + { columns => [ 'msgnum' ], + table => 'msg_template', + }, + ], + }, + 'template_content' => { 'columns' => [ 'contentnum', 'serial', '', '', '', '', diff --git a/FS/FS/cust_msg.pm b/FS/FS/cust_msg.pm index 72f64b9c5..934632725 100644 --- a/FS/FS/cust_msg.pm +++ b/FS/FS/cust_msg.pm @@ -45,7 +45,7 @@ from FS::Record. The following fields are currently supported: =item header - message header -=item body - message body +=item body - message body (as a complete MIME document) =item error - Email::Sender error message (or null for success) @@ -150,10 +150,27 @@ sub check { $self->SUPER::check; } +=item send + +Sends the message through its parent L. Returns an error +message on error, or an empty string. + +=cut + +sub send { + my $self = shift; + my $msg_template = $self->msg_template + or return 'message was created without a template object'; + $msg_template->send_prepared($self); +} + =item entity Returns the complete message as a L. +XXX this only works if the message in fact contains a MIME entity. Messages +created by external APIs may not look like that. + =item parts Returns a list of the MIME parts contained in the message, as L diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index c52b6336e..180e9de4d 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -4,22 +4,9 @@ use base qw( FS::Record ); use strict; use vars qw( $DEBUG $conf ); -use Date::Format qw( time2str ); -use File::Temp; -use IPC::Run qw(run); -use Text::Template; - -use HTML::Entities qw( decode_entities encode_entities ) ; -use HTML::FormatText; -use HTML::TreeBuilder; -use Encode; - -use FS::Misc qw( generate_email send_email do_print ); use FS::Conf; use FS::Record qw( qsearch qsearchs ); -use FS::UID qw( dbh ); -use FS::cust_main; use FS::cust_msg; use FS::template_content; @@ -59,6 +46,9 @@ supported: =item msgname - Name of the template. This will appear in the user interface; if it needs to be localized for some users, add it to the message catalog. +=item msgclass - The L subclass that this should belong to. +Defaults to 'email'. + =item agentnum - Agent associated with this template. Can be NULL for a global template. @@ -66,6 +56,8 @@ global template. =item from_addr - Source email address. +=item bcc_addr - Bcc all mail to this address. + =item disabled - disabled ('Y' or NULL). =back @@ -87,41 +79,20 @@ points to. You can ask the object for a copy with the I method. sub table { 'msg_template'; } +sub _rebless { + my $self = shift; + my $class = 'FS::msg_template::' . $self->msgclass; + eval "use $class;"; + bless($self, $class) unless $@; + $self; +} + =item insert [ CONTENT ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. -A default (no locale) L object will be created. CONTENT -is an optional hash containing 'subject' and 'body' for this object. - -=cut - -sub insert { - my $self = shift; - my %content = @_; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::insert; - if ( !$error ) { - $content{'msgnum'} = $self->msgnum; - $content{'subject'} ||= ''; - $content{'body'} ||= ''; - my $template_content = new FS::template_content (\%content); - $error = $template_content->insert; - } - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit if $oldAutoCommit; - return; -} +# inherited =item delete @@ -129,61 +100,31 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record +# inherited =item replace [ OLD_RECORD ] [ CONTENT ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If -supplied, an L object will be created (or modified, if -one already exists for this locale). - =cut -sub replace { +# inherited + +sub replace_check { my $self = shift; - my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') ) - ? shift - : $self->replace_old; - my %content = @_; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::replace($old); - - if ( !$error and %content ) { - $content{'locale'} ||= ''; - my $new_content = qsearchs('template_content', { - 'msgnum' => $self->msgnum, - 'locale' => $content{'locale'}, - } ); - if ( $new_content ) { - $new_content->subject($content{'subject'}); - $new_content->body($content{'body'}); - $error = $new_content->replace; - } - else { - $content{'msgnum'} = $self->msgnum; - $new_content = new FS::template_content \%content; - $error = $new_content->insert; + my $old = $self->replace_old; + # don't allow changing msgclass, except null to not-null (for upgrade) + if ( $old->msgclass ) { + if ( !$self->msgclass ) { + $self->set('msgclass', $old->msgclass); + } else { + return "Can't change message template class from ".$old->msgclass. + " to ".$self->msgclass."."; } } - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit; - $dbh->commit if $oldAutoCommit; - return; + ''; } - - =item check @@ -206,6 +147,10 @@ sub check { || $self->ut_textn('mime_type') || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->ut_textn('from_addr') + || $self->ut_textn('bcc_addr') + # fine for now, but change this to some kind of dynamic check if we + # ever have more than two msgclasses + || $self->ut_enum('msgclass', [ qw(email http) ]), ; return $error if $error; @@ -214,25 +159,10 @@ sub check { $self->SUPER::check; } -=item content_locales - -Returns a hashref of the L objects attached to -this template, with the locale as key. - -=cut - -sub content_locales { - my $self = shift; - return $self->{'_content_locales'} ||= +{ - map { $_->locale , $_ } - qsearch('template_content', { 'msgnum' => $self->msgnum }) - }; -} - =item prepare OPTION => VALUE -Fills in the template and returns a hash of the 'from' address, 'to' -addresses, subject line, and body. +Fills in the template and returns an L object, containing the +message to be sent. This method must be provided by the subclass. Options are passed as a list of name/value pairs: @@ -276,18 +206,23 @@ A hash reference of additional substitutions =cut sub prepare { + die "unimplemented"; +} + +=item prepare_substitutions OPTION => VALUE ... + +Takes the same arguments as L, and returns a hashref of the +substitution variables. + +=cut + +sub prepare_substitutions { my( $self, %opt ) = @_; my $cust_main = $opt{'cust_main'}; # or die 'cust_main required'; my $object = $opt{'object'} or die 'object required'; - # localization - my $locale = $cust_main && $cust_main->locale || ''; - warn "no locale for cust#".$cust_main->custnum."; using default content\n" - if $DEBUG and $cust_main && !$locale; - my $content = $self->content($locale); - - warn "preparing template '".$self->msgname."\n" + warn "preparing substitutions for '".$self->msgname."'\n" if $DEBUG; my $subs = $self->substitutions; @@ -340,110 +275,19 @@ sub prepare { $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}}; } - $_ = encode_entities($_ || '') foreach values(%hash); - - ### - # clean up template - ### - my $subject_tmpl = new Text::Template ( - TYPE => 'STRING', - SOURCE => $content->subject, - ); - my $subject = $subject_tmpl->fill_in( HASH => \%hash ); - - my $body = $content->body; - my ($skin, $guts) = eviscerate($body); - @$guts = map { - $_ = decode_entities($_); # turn all punctuation back into itself - s/\r//gs; # remove \r's - s/]*>/\n/gsi; # and
tags - s/

/\n/gsi; # and

- s/<\/p>//gsi; # and

- s/\240/ /gs; # and   - $_ - } @$guts; - - $body = '{ use Date::Format qw(time2str); "" }'; - while(@$skin || @$guts) { - $body .= shift(@$skin) || ''; - $body .= shift(@$guts) || ''; - } - - ### - # fill-in - ### - - my $body_tmpl = new Text::Template ( - TYPE => 'STRING', - SOURCE => $body, - ); - - $body = $body_tmpl->fill_in( HASH => \%hash ); - - ### - # and email - ### - - my @to; - if ( exists($opt{'to'}) ) { - @to = split(/\s*,\s*/, $opt{'to'}); - } elsif ( $cust_main ) { - @to = $cust_main->invoicing_list_emailonly; - } else { - die 'no To: address or cust_main object specified'; - } - - my $from_addr = $self->from_addr; - - if ( !$from_addr ) { - - my $agentnum = $cust_main ? $cust_main->agentnum : ''; - - if ( $opt{'from_config'} ) { - $from_addr = $conf->config($opt{'from_config'}, $agentnum); - } - $from_addr ||= $conf->invoice_from_full($agentnum); - } -# my @cust_msg = (); -# if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) { -# my $cust_msg = FS::cust_msg->new({ -# 'custnum' => $cust_main->custnum, -# 'msgnum' => $self->msgnum, -# 'status' => 'prepared', -# }); -# $cust_msg->insert; -# @cust_msg = ('cust_msg' => $cust_msg); -# } - - my $text_body = encode('UTF-8', - HTML::FormatText->new(leftmargin => 0, rightmargin => 70) - ->format( HTML::TreeBuilder->new_from_content($body) ) - ); - ( - 'custnum' => ( $cust_main ? $cust_main->custnum : ''), - 'msgnum' => $self->msgnum, - 'from' => $from_addr, - 'to' => \@to, - 'bcc' => $self->bcc_addr || undef, - 'subject' => $subject, - 'html_body' => $body, - 'text_body' => $text_body - ); - + return \%hash; } -=item send OPTION => VALUE +=item send OPTION => VALUE ... -Fills in the template and sends it to the customer. Options are as for -'prepare'. +Creates a message with L (taking all the same options) and sends it. =cut -# broken out from prepare() in case we want to queue the sending, -# preview it, etc. sub send { my $self = shift; - send_email(generate_email($self->prepare(@_))); + my $cust_msg = $self->prepare(@_); + $self->send_prepared($cust_msg); } =item render OPTION => VALUE ... @@ -455,6 +299,9 @@ Options are as for 'prepare', but 'from' and 'to' are meaningless. =cut +# XXX not sure where this ends up post-refactoring--a separate template +# class? it doesn't use the same rendering OR output machinery as ::email + # will also have options to set paper size, margins, etc. sub render { @@ -507,8 +354,6 @@ my $usage_warning = sub { return ['', '', '']; }; -#my $conf = new FS::Conf; - #return contexts and fill-in values # If you add anything, be sure to add a description in # httemplate/edit/msg_template.html. @@ -686,19 +531,11 @@ sub substitutions { =item content LOCALE -Returns the L object appropriate to LOCALE, if there -is one. If not, returns the one with a NULL locale. +Stub, returns nothing. =cut -sub content { - my $self = shift; - my $locale = shift; - qsearchs('template_content', - { 'msgnum' => $self->msgnum, 'locale' => $locale }) || - qsearchs('template_content', - { 'msgnum' => $self->msgnum, 'locale' => '' }); -} +sub content {} =item agent @@ -827,10 +664,16 @@ sub _upgrade_data { } $content{body} = $body; $msg_template->set('body', ''); - my $error = $msg_template->replace(%content); die $error if $error; } + + if ( !$msg_template->msgclass ) { + # set default message class + $msg_template->set('msgclass', 'email'); + my $error = $msg_template->replace; + die $error if $error; + } } ### @@ -863,56 +706,6 @@ sub _populate_initial_data { #class method } -sub eviscerate { - # Every bit as pleasant as it sounds. - # - # We do this because Text::Template::Preprocess doesn't - # actually work. It runs the entire template through - # the preprocessor, instead of the code segments. Which - # is a shame, because Text::Template already contains - # the code to do this operation. - my $body = shift; - my (@outside, @inside); - my $depth = 0; - my $chunk = ''; - while($body || $chunk) { - my ($first, $delim, $rest); - # put all leading non-delimiters into $first - ($first, $rest) = - ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s); - $chunk .= $first; - # put a leading delimiter into $delim if there is one - ($delim, $rest) = - ($rest =~ /^([{}]?)(.*)$/s); - - if( $delim eq '{' ) { - $chunk .= '{'; - if( $depth == 0 ) { - push @outside, $chunk; - $chunk = ''; - } - $depth++; - } - elsif( $delim eq '}' ) { - $depth--; - if( $depth == 0 ) { - push @inside, $chunk; - $chunk = ''; - } - $chunk .= '}'; - } - else { - # no more delimiters - if( $depth == 0 ) { - push @outside, $chunk . $rest; - } # else ? something wrong - last; - } - $body = $rest; - } - (\@outside, \@inside); -} - =back =head1 BUGS diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm new file mode 100644 index 000000000..1133faafe --- /dev/null +++ b/FS/FS/msg_template/email.pm @@ -0,0 +1,911 @@ +package FS::msg_template::email; +use base qw( FS::msg_template ); + +use strict; +use vars qw( $DEBUG $conf ); + +# stuff needed for template generation +use Date::Format qw( time2str ); +use File::Temp; +use IPC::Run qw(run); +use Text::Template; + +use HTML::Entities qw( decode_entities encode_entities ) ; +use HTML::FormatText; +use HTML::TreeBuilder; +use Encode; + +# needed to send email +use FS::Misc qw( generate_email ); +use FS::Conf; +use Email::Sender::Simple qw( sendmail ); + +use FS::Record qw( qsearch qsearchs ); + +# needed to manage template_content objects +use FS::template_content; +use FS::UID qw( dbh ); + +use FS::cust_msg; + +FS::UID->install_callback( sub { $conf = new FS::Conf; } ); + +our $DEBUG = 1; +our $me = '[FS::msg_template::email]'; + +=head1 NAME + +FS::msg_template::email - Construct email notices with Text::Template. + +=head1 DESCRIPTION + +FS::msg_template::email is a message processor in which the template contains +L strings for the message subject line and body, and the +message is delivered by email. + +Currently the C and C fields used by this processor are +in the main msg_template table. + +=head1 METHODS + +=over 4 + +=item insert [ CONTENT ] + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +A default (no locale) L object will be created. CONTENT +is an optional hash containing 'subject' and 'body' for this object. + +=cut + +sub insert { + my $self = shift; + my %content = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( !$error ) { + $content{'msgnum'} = $self->msgnum; + $content{'subject'} ||= ''; + $content{'body'} ||= ''; + my $template_content = new FS::template_content (\%content); + $error = $template_content->insert; + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit if $oldAutoCommit; + return; +} + +=item replace [ OLD_RECORD ] [ CONTENT ] + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If +supplied, an L object will be created (or modified, if +one already exists for this locale). + +=cut + +sub replace { + my $self = shift; + my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') ) + ? shift + : $self->replace_old; + my %content = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::replace($old); + + if ( !$error and %content ) { + $content{'locale'} ||= ''; + my $new_content = qsearchs('template_content', { + 'msgnum' => $self->msgnum, + 'locale' => $content{'locale'}, + } ); + if ( $new_content ) { + $new_content->subject($content{'subject'}); + $new_content->body($content{'body'}); + $error = $new_content->replace; + } + else { + $content{'msgnum'} = $self->msgnum; + $new_content = new FS::template_content \%content; + $error = $new_content->insert; + } + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit; + $dbh->commit if $oldAutoCommit; + return; +} + +=item content_locales + +Returns a hashref of the L objects attached to +this template, with the locale as key. + +=cut + +sub content_locales { + my $self = shift; + return $self->{'_content_locales'} ||= +{ + map { $_->locale , $_ } + qsearch('template_content', { 'msgnum' => $self->msgnum }) + }; +} + +=item prepare OPTION => VALUE + +Fills in the template and returns an L object. + +Options are passed as a list of name/value pairs: + +=over 4 + +=item cust_main + +Customer object (required). + +=item object + +Additional context object (currently, can be a cust_main, cust_pkg, +cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband, +domain) ). If the object is a svc_*, its cust_pkg will be fetched and +used for substitution. + +As a special case, this may be an arrayref of two objects. Both +objects will be available for substitution, with their field names +prefixed with 'new_' and 'old_' respectively. This is used in the +rt_ticket export when exporting "replace" events. + +=item from_config + +Configuration option to use as the source address, based on the customer's +agentnum. If unspecified (or the named option is empty), 'invoice_from' +will be used. + +The I field in the template takes precedence over this. + +=item to + +Destination address. The default is to use the customer's +invoicing_list addresses. Multiple addresses may be comma-separated. + +=item substitutions + +A hash reference of additional substitutions + +=item msgtype + +A string identifying the kind of message this is. Currently can be "invoice", +"receipt", "admin", or null. Expand this list as necessary. + +=back + +=cut + +sub prepare { + + my( $self, %opt ) = @_; + + my $cust_main = $opt{'cust_main'}; # or die 'cust_main required'; + my $object = $opt{'object'} or die 'object required'; + + my $hashref = $self->prepare_substitutions(%opt); + + # localization + my $locale = $cust_main && $cust_main->locale || ''; + warn "no locale for cust#".$cust_main->custnum."; using default content\n" + if $DEBUG and $cust_main && !$locale; + my $content = $self->content($locale); + + warn "preparing template '".$self->msgname."\n" + if $DEBUG; + + $_ = encode_entities($_ || '') foreach values(%$hashref); + + ### + # clean up template + ### + my $subject_tmpl = new Text::Template ( + TYPE => 'STRING', + SOURCE => $content->subject, + ); + + warn "$me filling in subject template\n" if $DEBUG; + my $subject = $subject_tmpl->fill_in( HASH => $hashref ); + + my $body = $content->body; + my ($skin, $guts) = eviscerate($body); + @$guts = map { + $_ = decode_entities($_); # turn all punctuation back into itself + s/\r//gs; # remove \r's + s/]*>/\n/gsi; # and
tags + s/

/\n/gsi; # and

+ s/<\/p>//gsi; # and

+ s/\240/ /gs; # and   + $_ + } @$guts; + + $body = '{ use Date::Format qw(time2str); "" }'; + while(@$skin || @$guts) { + $body .= shift(@$skin) || ''; + $body .= shift(@$guts) || ''; + } + + ### + # fill-in + ### + + my $body_tmpl = new Text::Template ( + TYPE => 'STRING', + SOURCE => $body, + ); + + warn "$me filling in body template\n" if $DEBUG; + $body = $body_tmpl->fill_in( HASH => $hashref ); + + ### + # and email + ### + + my @to; + if ( exists($opt{'to'}) ) { + @to = split(/\s*,\s*/, $opt{'to'}); + } elsif ( $cust_main ) { + @to = $cust_main->invoicing_list_emailonly; + } else { + die 'no To: address or cust_main object specified'; + } + + my $from_addr = $self->from_addr; + + if ( !$from_addr ) { + + my $agentnum = $cust_main ? $cust_main->agentnum : ''; + + if ( $opt{'from_config'} ) { + $from_addr = $conf->config($opt{'from_config'}, $agentnum); + } + $from_addr ||= $conf->invoice_from_full($agentnum); + } + + my $text_body = encode('UTF-8', + HTML::FormatText->new(leftmargin => 0, rightmargin => 70) + ->format( HTML::TreeBuilder->new_from_content($body) ) + ); + + warn "$me constructing MIME entities\n" if $DEBUG; + my %email = generate_email( + 'from' => $from_addr, + 'to' => \@to, + 'bcc' => $self->bcc_addr || undef, + 'subject' => $subject, + 'html_body' => $body, + 'text_body' => $text_body, + ); + + warn "$me creating message headers\n" if $DEBUG; + my $env_from = $from_addr; + $env_from =~ s/^\s*//; $env_from =~ s/\s*$//; + if ( $env_from =~ /^(.*)\s*<(.*@.*)>$/ ) { + # a common idiom + $env_from = $2; + } + + my $domain; + if ( $env_from =~ /\@([\w\.\-]+)/ ) { + $domain = $1; + } else { + warn 'no domain found in invoice from address '. $env_from . + '; constructing Message-ID (and saying HELO) @example.com'; + $domain = 'example.com'; + } + my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain"; + + my $time = time; + my $message = MIME::Entity->build( + 'From' => $from_addr, + 'To' => join(', ', @to), + 'Sender' => $from_addr, + 'Reply-To' => $from_addr, + 'Date' => time2str("%a, %d %b %Y %X %z", $time), + 'Subject' => Encode::encode('MIME-Header', $subject), + 'Message-ID' => "<$message_id>", + 'Encoding' => '7bit', + 'Type' => 'multipart/related', + ); + + #$message->head->replace('Content-type', + # 'multipart/related; '. + # 'boundary="' . $message->head->multipart_boundary . '"; ' . + # 'type=multipart/alternative' + #); + + # XXX a facility to attach additional parts is necessary at some point + foreach my $part (@{ $email{mimeparts} }) { + warn "$me appending part ".$part->mime_type."\n" if $DEBUG; + $message->add_part( $part ); + } + + # effective To: address (not in headers) + push @to, $self->bcc_addr if $self->bcc_addr; + my $env_to = join(', ', @to); + + my $cust_msg = FS::cust_msg->new({ + 'custnum' => $cust_main->custnum, + 'msgnum' => $self->msgnum, + '_date' => $time, + 'env_from' => $env_from, + 'env_to' => $env_to, + 'header' => $message->header_as_string, + 'body' => $message->body_as_string, + 'error' => '', + 'status' => 'prepared', + 'msgtype' => ($opt{'msgtype'} || ''), + }); + + return $cust_msg; +} + +=item send_prepared CUST_MSG + +Takes the CUST_MSG object and sends it to its recipient. + +=cut + +sub send_prepared { + my $self = shift; + my $cust_msg = shift or die "cust_msg required"; + + my $domain = 'example.com'; + if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) { + $domain = $1; + } + + my @to = split(/\s*,\s*/, $cust_msg->env_to); + + my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), + 'helo' => $domain ); + + my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') ); + $smtp_opt{'port'} = $port; + + my $transport; + if ( defined($enc) && $enc eq 'starttls' ) { + $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); + $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); + } else { + if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { + $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); + } + $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; + $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); + } + + warn "$me sending message\n" if $DEBUG; + my $message = join("\n\n", $cust_msg->header, $cust_msg->body); + local $@; + eval { + sendmail( $message, { transport => $transport, + from => $cust_msg->env_from, + to => \@to }) + }; + my $error = ''; + if(ref($@) and $@->isa('Email::Sender::Failure')) { + $error = $@->code.' ' if $@->code; + $error .= $@->message; + } + else { + $error = $@; + } + + $cust_msg->set('error', $error); + $cust_msg->set('status', $error ? 'failed' : 'sent'); + if ( $cust_msg->custmsgnum ) { + $cust_msg->replace; + } else { + $cust_msg->insert; + } + + $error; +} + +=item render OPTION => VALUE ... + +Fills in the template and renders it to a PDF document. Returns the +name of the PDF file. + +Options are as for 'prepare', but 'from' and 'to' are meaningless. + +=cut + +# will also have options to set paper size, margins, etc. + +sub render { + my $self = shift; + eval "use PDF::WebKit"; + die $@ if $@; + my %opt = @_; + my %hash = $self->prepare(%opt); + my $html = $hash{'html_body'}; + + # Graphics/stylesheets should probably go in /var/www on the Freeside + # machine. + my $script_path = `/usr/bin/which freeside-wkhtmltopdf`; + chomp $script_path; + my $kit = PDF::WebKit->new(\$html); #%options + # hack to use our wrapper script + $kit->configure(sub { shift->wkhtmltopdf($script_path) }); + + $kit->to_pdf; +} + +=item print OPTIONS + +Render a PDF and send it to the printer. OPTIONS are as for 'render'. + +=cut + +sub print { + my( $self, %opt ) = @_; + do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum ); +} + +# helper sub for package dates +my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' }; + +# helper sub for money amounts +my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) }; + +# helper sub for usage-related messages +my $usage_warning = sub { + my $svc = shift; + foreach my $col (qw(seconds upbytes downbytes totalbytes)) { + my $amount = $svc->$col; next if $amount eq ''; + my $method = $col.'_threshold'; + my $threshold = $svc->$method; next if $threshold eq ''; + return [$col, $amount, $threshold] if $amount <= $threshold; + # this only returns the first one that's below threshold, if there are + # several. + } + return ['', '', '']; +}; + +#my $conf = new FS::Conf; + +#return contexts and fill-in values +# If you add anything, be sure to add a description in +# httemplate/edit/msg_template.html. +sub substitutions { + { 'cust_main' => [qw( + display_custnum agentnum agent_name + + last first company + name name_short contact contact_firstlast + address1 address2 city county state zip + country + daytime night mobile fax + + has_ship_address + ship_name ship_name_short ship_contact ship_contact_firstlast + ship_address1 ship_address2 ship_city ship_county ship_state ship_zip + ship_country + + paymask payname paytype payip + num_cancelled_pkgs num_ncancelled_pkgs num_pkgs + classname categoryname + balance + credit_limit + invoicing_list_emailonly + cust_status ucfirst_cust_status cust_statuscolor cust_status_label + + signupdate dundate + packages recurdates + ), + [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ], + #compatibility: obsolete ship_ fields - use the non-ship versions + map ( + { my $field = $_; + [ "ship_$field" => sub { shift->$field } ] + } + qw( last first company daytime night fax ) + ), + # ship_name, ship_name_short, ship_contact, ship_contact_firstlast + # still work, though + [ expdate => sub { shift->paydate_epoch } ], #compatibility + [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ], + [ dundate_ymd => sub { $ymd->(shift->dundate) } ], + [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ], + [ otaker_first => sub { shift->access_user->first } ], + [ otaker_last => sub { shift->access_user->last } ], + [ payby => sub { FS::payby->shortname(shift->payby) } ], + [ company_name => sub { + $conf->config('company_name', shift->agentnum) + } ], + [ company_address => sub { + $conf->config('company_address', shift->agentnum) + } ], + [ company_phonenum => sub { + $conf->config('company_phonenum', shift->agentnum) + } ], + [ selfservice_server_base_url => sub { + $conf->config('selfservice_server-base_url') #, shift->agentnum) + } ], + ], + # next_bill_date + 'cust_pkg' => [qw( + pkgnum pkg_label pkg_label_long + location_label + status statuscolor + + start_date setup bill last_bill + adjourn susp expire + labels_short + ), + [ pkg => sub { shift->part_pkg->pkg } ], + [ pkg_category => sub { shift->part_pkg->categoryname } ], + [ pkg_class => sub { shift->part_pkg->classname } ], + [ cancel => sub { shift->getfield('cancel') } ], # grrr... + [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ], + [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ], + [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ], + [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ], + [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ], + [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ], + [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ], + [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ], + + # not necessarily correct for non-flat packages + [ setup_fee => sub { shift->part_pkg->option('setup_fee') } ], + [ recur_fee => sub { shift->part_pkg->option('recur_fee') } ], + + [ freq_pretty => sub { shift->part_pkg->freq_pretty } ], + + ], + 'cust_bill' => [qw( + invnum + _date + _date_pretty + due_date + ), + [ due_date2str => sub { shift->due_date2str('short') } ], + ], + #XXX not really thinking about cust_bill substitutions quite yet + + # for welcome and limit warning messages + 'svc_acct' => [qw( + svcnum + username + domain + ), + [ password => sub { shift->getfield('_password') } ], + [ column => sub { &$usage_warning(shift)->[0] } ], + [ amount => sub { &$usage_warning(shift)->[1] } ], + [ threshold => sub { &$usage_warning(shift)->[2] } ], + ], + 'svc_domain' => [qw( + svcnum + domain + ), + [ registrar => sub { + my $registrar = qsearchs('registrar', + { registrarnum => shift->registrarnum} ); + $registrar ? $registrar->registrarname : '' + } + ], + [ catchall => sub { + my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall }); + $svc_acct ? $svc_acct->email : '' + } + ], + ], + 'svc_phone' => [qw( + svcnum + phonenum + countrycode + domain + ) + ], + 'svc_broadband' => [qw( + svcnum + speed_up + speed_down + ip_addr + mac_addr + ) + ], + # for payment receipts + 'cust_pay' => [qw( + paynum + _date + ), + [ paid => sub { sprintf("%.2f", shift->paid) } ], + # overrides the one in cust_main in cases where a cust_pay is passed + [ payby => sub { FS::payby->shortname(shift->payby) } ], + [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ], + [ payinfo => sub { + my $cust_pay = shift; + ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ? + $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo) + } ], + ], + # for payment decline messages + # try to support all cust_pay fields + # 'error' is a special case, it contains the raw error from the gateway + 'cust_pay_pending' => [qw( + _date + error + ), + [ paid => sub { sprintf("%.2f", shift->paid) } ], + [ payby => sub { FS::payby->shortname(shift->payby) } ], + [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ], + [ payinfo => sub { + my $pending = shift; + ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ? + $pending->paymask : $pending->decrypt($pending->payinfo) + } ], + ], + }; +} + +=item content LOCALE + +Returns the L object appropriate to LOCALE, if there +is one. If not, returns the one with a NULL locale. + +=cut + +sub content { + my $self = shift; + my $locale = shift; + qsearchs('template_content', + { 'msgnum' => $self->msgnum, 'locale' => $locale }) || + qsearchs('template_content', + { 'msgnum' => $self->msgnum, 'locale' => '' }); +} + +=item agent + +Returns the L object for this template. + +=cut + +sub _upgrade_data { + my ($self, %opts) = @_; + + ### + # First move any historical templates in config to real message templates + ### + + my @fixes = ( + [ 'alerter_msgnum', 'alerter_template', '', '', '' ], + [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ], + [ 'decline_msgnum', 'declinetemplate', '', '', '' ], + [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ], + [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ], + [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ], + [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ], + ); + + my @agentnums = ('', map {$_->agentnum} qsearch('agent', {})); + foreach my $agentnum (@agentnums) { + foreach (@fixes) { + my ($newname, $oldname, $subject, $from, $bcc) = @$_; + if ($conf->exists($oldname, $agentnum)) { + my $new = new FS::msg_template({ + 'msgname' => $oldname, + 'agentnum' => $agentnum, + 'from_addr' => ($from && $conf->config($from, $agentnum)) || '', + 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '', + 'subject' => ($subject && $conf->config($subject, $agentnum)) || '', + 'mime_type' => 'text/html', + 'body' => join('
',$conf->config($oldname, $agentnum)), + }); + my $error = $new->insert; + die $error if $error; + $conf->set($newname, $new->msgnum, $agentnum); + $conf->delete($oldname, $agentnum); + $conf->delete($from, $agentnum) if $from; + $conf->delete($subject, $agentnum) if $subject; + } + } + + if ( $conf->exists('alert_expiration', $agentnum) ) { + my $msgnum = $conf->exists('alerter_msgnum', $agentnum); + my $template = FS::msg_template->by_key($msgnum) if $msgnum; + if (!$template) { + warn "template for alerter_msgnum $msgnum not found\n"; + next; + } + # this is now a set of billing events + foreach my $days (30, 15, 5) { + my $event = FS::part_event->new({ + 'agentnum' => $agentnum, + 'event' => "Card expiration warning - $days days", + 'eventtable' => 'cust_main', + 'check_freq' => '1d', + 'action' => 'notice', + 'disabled' => 'Y', #initialize first + }); + my $error = $event->insert( 'msgnum' => $msgnum ); + if ($error) { + warn "error creating expiration alert event:\n$error\n\n"; + next; + } + # make it work like before: + # only send each warning once before the card expires, + # only warn active customers, + # only warn customers with CARD/DCRD, + # only warn customers who get email invoices + my %conds = ( + 'once_every' => { 'run_delay' => '30d' }, + 'cust_paydate_within' => { 'within' => $days.'d' }, + 'cust_status' => { 'status' => { 'active' => 1 } }, + 'payby' => { 'payby' => { 'CARD' => 1, + 'DCRD' => 1, } + }, + 'message_email' => {}, + ); + foreach (keys %conds) { + my $condition = FS::part_event_condition->new({ + 'conditionname' => $_, + 'eventpart' => $event->eventpart, + }); + $error = $condition->insert( %{ $conds{$_} }); + if ( $error ) { + warn "error creating expiration alert event:\n$error\n\n"; + next; + } + } + $error = $event->initialize; + if ( $error ) { + warn "expiration alert event was created, but not initialized:\n$error\n\n"; + } + } # foreach $days + $conf->delete('alerter_msgnum', $agentnum); + $conf->delete('alert_expiration', $agentnum); + + } # if alerter_msgnum + + } + + ### + # Move subject and body from msg_template to template_content + ### + + foreach my $msg_template ( qsearch('msg_template', {}) ) { + if ( $msg_template->subject || $msg_template->body ) { + # create new default content + my %content; + $content{subject} = $msg_template->subject; + $msg_template->set('subject', ''); + + # work around obscure Pg/DBD bug + # https://rt.cpan.org/Public/Bug/Display.html?id=60200 + # (though the right fix is to upgrade DBD) + my $body = $msg_template->body; + if ( $body =~ /^x([0-9a-f]+)$/ ) { + # there should be no real message templates that look like that + warn "converting template body to TEXT\n"; + $body = pack('H*', $1); + } + $content{body} = $body; + $msg_template->set('body', ''); + + my $error = $msg_template->replace(%content); + die $error if $error; + } + } + + ### + # Add new-style default templates if missing + ### + $self->_populate_initial_data; + +} + +sub _populate_initial_data { #class method + #my($class, %opts) = @_; + #my $class = shift; + + eval "use FS::msg_template::InitialData;"; + die $@ if $@; + + my $initial_data = FS::msg_template::InitialData->_initial_data; + + foreach my $hash ( @$initial_data ) { + + next if $hash->{_conf} && $conf->config( $hash->{_conf} ); + + my $msg_template = new FS::msg_template($hash); + my $error = $msg_template->insert( @{ $hash->{_insert_args} || [] } ); + die $error if $error; + + $conf->set( $hash->{_conf}, $msg_template->msgnum ) if $hash->{_conf}; + + } + +} + +sub eviscerate { + # Every bit as pleasant as it sounds. + # + # We do this because Text::Template::Preprocess doesn't + # actually work. It runs the entire template through + # the preprocessor, instead of the code segments. Which + # is a shame, because Text::Template already contains + # the code to do this operation. + my $body = shift; + my (@outside, @inside); + my $depth = 0; + my $chunk = ''; + while($body || $chunk) { + my ($first, $delim, $rest); + # put all leading non-delimiters into $first + ($first, $rest) = + ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s); + $chunk .= $first; + # put a leading delimiter into $delim if there is one + ($delim, $rest) = + ($rest =~ /^([{}]?)(.*)$/s); + + if( $delim eq '{' ) { + $chunk .= '{'; + if( $depth == 0 ) { + push @outside, $chunk; + $chunk = ''; + } + $depth++; + } + elsif( $delim eq '}' ) { + $depth--; + if( $depth == 0 ) { + push @inside, $chunk; + $chunk = ''; + } + $chunk .= '}'; + } + else { + # no more delimiters + if( $depth == 0 ) { + push @outside, $chunk . $rest; + } # else ? something wrong + last; + } + $body = $rest; + } + (\@outside, \@inside); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + -- cgit v1.2.1 From 76e8fffdfe3b6f6f8ab422038b62e40cc10f95e8 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 27 Aug 2015 19:18:42 -0700 Subject: #21564, external message services: preview and send messages through the UI --- FS/FS/Schema.pm | 1 + FS/FS/cust_main_Mixin.pm | 41 ++-- FS/FS/cust_msg.pm | 10 +- FS/FS/msg_template.pm | 2 + FS/FS/msg_template/email.pm | 448 ++++++-------------------------------------- 5 files changed, 88 insertions(+), 414 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 311313a4e..12211d1e1 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -6400,6 +6400,7 @@ sub tables_hashref { 'error', 'varchar', 'NULL', 255, '', '', 'status', 'varchar', '',$char_d, '', '', 'msgtype', 'varchar', 'NULL', 16, '', '', + 'preview', 'text', 'NULL', '', '', '', ], 'primary_key' => 'custmsgnum', 'unique' => [ ], diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index bdad511fa..3d05f8473 100644 --- a/FS/FS/cust_main_Mixin.pm +++ b/FS/FS/cust_main_Mixin.pm @@ -445,6 +445,10 @@ sub email_search_result { my $success = 0; my %sent_to = (); + if ( !$msg_template ) { + # XXX create on the fly + } + #eventually order+limit magic to reduce memory use? foreach my $obj ( qsearch($sql_query) ) { @@ -459,36 +463,19 @@ sub email_search_result { } my $cust_main = $obj->cust_main; - tie my %message, 'Tie::IxHash'; if ( !$cust_main ) { next; # unlinked object; nothing else we can do } - if ( $msg_template ) { - # Now supports other context objects. - %message = $msg_template->prepare( - 'cust_main' => $cust_main, - 'object' => $obj, - ); - } - else { - my @to = $cust_main->invoicing_list_emailonly; - next if !@to; - - %message = ( - 'from' => $from, - 'to' => \@to, - 'subject' => $subject, - 'html_body' => $html_body, - 'text_body' => $text_body, - 'custnum' => $cust_main->custnum, - ); - } #if $msg_template + my $cust_msg = $msg_template->prepare( + 'cust_main' => $cust_main, + 'object' => $obj, + ); # For non-cust_main searches, we avoid duplicates based on message - # body text. + # body text. my $unique = $cust_main->custnum; - $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main'; + $unique .= sha1($cust_msg->text_body) if $class ne 'FS::cust_main'; if( $sent_to{$unique} ) { # avoid duplicates $dups++; @@ -497,18 +484,20 @@ sub email_search_result { $sent_to{$unique} = 1; - $error = send_email( generate_email( %message ) ); + $error = $cust_msg->send; if($error) { # queue the sending of this message so that the user can see what we # tried to do, and retry if desired + # (note the cust_msg itself also now has a status of 'failed'; that's + # fine, as it will get its status reset if we retry the job) my $queue = new FS::queue { - 'job' => 'FS::Misc::process_send_email', + 'job' => 'FS::cust_msg::process_send', 'custnum' => $cust_main->custnum, 'status' => 'failed', 'statustext' => $error, }; - $queue->insert(%message); + $queue->insert($cust_msg->custmsgnum); push @retry_jobs, $queue; } else { diff --git a/FS/FS/cust_msg.pm b/FS/FS/cust_msg.pm index 934632725..ec2c961a3 100644 --- a/FS/FS/cust_msg.pm +++ b/FS/FS/cust_msg.pm @@ -47,8 +47,12 @@ from FS::Record. The following fields are currently supported: =item body - message body (as a complete MIME document) +=item preview - HTML fragment to show as a preview of the message + =item error - Email::Sender error message (or null for success) +=item status - "prepared", "sent", or "failed" + =back =head1 METHODS @@ -137,6 +141,7 @@ sub check { || $self->ut_textn('env_to') || $self->ut_anything('header') || $self->ut_anything('body') + || $self->ut_anything('preview') || $self->ut_enum('status', \@statuses) || $self->ut_textn('error') || $self->ut_enum('msgtype', [ '', @@ -159,8 +164,9 @@ message on error, or an empty string. sub send { my $self = shift; - my $msg_template = $self->msg_template - or return 'message was created without a template object'; + # it's still allowed to have cust_msgs without message templates, but only + # for email. + my $msg_template = $self->msg_template || 'FS::msg_template::email'; $msg_template->send_prepared($self); } diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index 180e9de4d..d7d9f50a8 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -10,6 +10,8 @@ use FS::Record qw( qsearch qsearchs ); use FS::cust_msg; use FS::template_content; +use Date::Format qw(time2str); + FS::UID->install_callback( sub { $conf = new FS::Conf; } ); $DEBUG=0; diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm index 1133faafe..275dc82bb 100644 --- a/FS/FS/msg_template/email.pm +++ b/FS/FS/msg_template/email.pm @@ -26,11 +26,12 @@ use FS::Record qw( qsearch qsearchs ); use FS::template_content; use FS::UID qw( dbh ); +# needed to manage prepared messages use FS::cust_msg; FS::UID->install_callback( sub { $conf = new FS::Conf; } ); -our $DEBUG = 1; +our $DEBUG = 0; our $me = '[FS::msg_template::email]'; =head1 NAME @@ -362,74 +363,12 @@ sub prepare { 'error' => '', 'status' => 'prepared', 'msgtype' => ($opt{'msgtype'} || ''), + 'preview' => $body, # html content only }); return $cust_msg; } -=item send_prepared CUST_MSG - -Takes the CUST_MSG object and sends it to its recipient. - -=cut - -sub send_prepared { - my $self = shift; - my $cust_msg = shift or die "cust_msg required"; - - my $domain = 'example.com'; - if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) { - $domain = $1; - } - - my @to = split(/\s*,\s*/, $cust_msg->env_to); - - my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), - 'helo' => $domain ); - - my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') ); - $smtp_opt{'port'} = $port; - - my $transport; - if ( defined($enc) && $enc eq 'starttls' ) { - $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); - $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); - } else { - if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { - $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); - } - $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; - $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); - } - - warn "$me sending message\n" if $DEBUG; - my $message = join("\n\n", $cust_msg->header, $cust_msg->body); - local $@; - eval { - sendmail( $message, { transport => $transport, - from => $cust_msg->env_from, - to => \@to }) - }; - my $error = ''; - if(ref($@) and $@->isa('Email::Sender::Failure')) { - $error = $@->code.' ' if $@->code; - $error .= $@->message; - } - else { - $error = $@; - } - - $cust_msg->set('error', $error); - $cust_msg->set('status', $error ? 'failed' : 'sent'); - if ( $cust_msg->custmsgnum ) { - $cust_msg->replace; - } else { - $cust_msg->insert; - } - - $error; -} - =item render OPTION => VALUE ... Fills in the template and renders it to a PDF document. Returns the @@ -491,183 +430,6 @@ my $usage_warning = sub { return ['', '', '']; }; -#my $conf = new FS::Conf; - -#return contexts and fill-in values -# If you add anything, be sure to add a description in -# httemplate/edit/msg_template.html. -sub substitutions { - { 'cust_main' => [qw( - display_custnum agentnum agent_name - - last first company - name name_short contact contact_firstlast - address1 address2 city county state zip - country - daytime night mobile fax - - has_ship_address - ship_name ship_name_short ship_contact ship_contact_firstlast - ship_address1 ship_address2 ship_city ship_county ship_state ship_zip - ship_country - - paymask payname paytype payip - num_cancelled_pkgs num_ncancelled_pkgs num_pkgs - classname categoryname - balance - credit_limit - invoicing_list_emailonly - cust_status ucfirst_cust_status cust_statuscolor cust_status_label - - signupdate dundate - packages recurdates - ), - [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ], - #compatibility: obsolete ship_ fields - use the non-ship versions - map ( - { my $field = $_; - [ "ship_$field" => sub { shift->$field } ] - } - qw( last first company daytime night fax ) - ), - # ship_name, ship_name_short, ship_contact, ship_contact_firstlast - # still work, though - [ expdate => sub { shift->paydate_epoch } ], #compatibility - [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ], - [ dundate_ymd => sub { $ymd->(shift->dundate) } ], - [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ], - [ otaker_first => sub { shift->access_user->first } ], - [ otaker_last => sub { shift->access_user->last } ], - [ payby => sub { FS::payby->shortname(shift->payby) } ], - [ company_name => sub { - $conf->config('company_name', shift->agentnum) - } ], - [ company_address => sub { - $conf->config('company_address', shift->agentnum) - } ], - [ company_phonenum => sub { - $conf->config('company_phonenum', shift->agentnum) - } ], - [ selfservice_server_base_url => sub { - $conf->config('selfservice_server-base_url') #, shift->agentnum) - } ], - ], - # next_bill_date - 'cust_pkg' => [qw( - pkgnum pkg_label pkg_label_long - location_label - status statuscolor - - start_date setup bill last_bill - adjourn susp expire - labels_short - ), - [ pkg => sub { shift->part_pkg->pkg } ], - [ pkg_category => sub { shift->part_pkg->categoryname } ], - [ pkg_class => sub { shift->part_pkg->classname } ], - [ cancel => sub { shift->getfield('cancel') } ], # grrr... - [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ], - [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ], - [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ], - [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ], - [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ], - [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ], - [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ], - [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ], - - # not necessarily correct for non-flat packages - [ setup_fee => sub { shift->part_pkg->option('setup_fee') } ], - [ recur_fee => sub { shift->part_pkg->option('recur_fee') } ], - - [ freq_pretty => sub { shift->part_pkg->freq_pretty } ], - - ], - 'cust_bill' => [qw( - invnum - _date - _date_pretty - due_date - ), - [ due_date2str => sub { shift->due_date2str('short') } ], - ], - #XXX not really thinking about cust_bill substitutions quite yet - - # for welcome and limit warning messages - 'svc_acct' => [qw( - svcnum - username - domain - ), - [ password => sub { shift->getfield('_password') } ], - [ column => sub { &$usage_warning(shift)->[0] } ], - [ amount => sub { &$usage_warning(shift)->[1] } ], - [ threshold => sub { &$usage_warning(shift)->[2] } ], - ], - 'svc_domain' => [qw( - svcnum - domain - ), - [ registrar => sub { - my $registrar = qsearchs('registrar', - { registrarnum => shift->registrarnum} ); - $registrar ? $registrar->registrarname : '' - } - ], - [ catchall => sub { - my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall }); - $svc_acct ? $svc_acct->email : '' - } - ], - ], - 'svc_phone' => [qw( - svcnum - phonenum - countrycode - domain - ) - ], - 'svc_broadband' => [qw( - svcnum - speed_up - speed_down - ip_addr - mac_addr - ) - ], - # for payment receipts - 'cust_pay' => [qw( - paynum - _date - ), - [ paid => sub { sprintf("%.2f", shift->paid) } ], - # overrides the one in cust_main in cases where a cust_pay is passed - [ payby => sub { FS::payby->shortname(shift->payby) } ], - [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ], - [ payinfo => sub { - my $cust_pay = shift; - ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ? - $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo) - } ], - ], - # for payment decline messages - # try to support all cust_pay fields - # 'error' is a special case, it contains the raw error from the gateway - 'cust_pay_pending' => [qw( - _date - error - ), - [ paid => sub { sprintf("%.2f", shift->paid) } ], - [ payby => sub { FS::payby->shortname(shift->payby) } ], - [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ], - [ payinfo => sub { - my $pending = shift; - ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ? - $pending->paymask : $pending->decrypt($pending->payinfo) - } ], - ], - }; -} - =item content LOCALE Returns the L object appropriate to LOCALE, if there @@ -684,168 +446,84 @@ sub content { { 'msgnum' => $self->msgnum, 'locale' => '' }); } -=item agent - -Returns the L object for this template. - =cut -sub _upgrade_data { - my ($self, %opts) = @_; +=back - ### - # First move any historical templates in config to real message templates - ### +=head2 CLASS METHODS - my @fixes = ( - [ 'alerter_msgnum', 'alerter_template', '', '', '' ], - [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ], - [ 'decline_msgnum', 'declinetemplate', '', '', '' ], - [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ], - [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ], - [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ], - [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ], - ); - - my @agentnums = ('', map {$_->agentnum} qsearch('agent', {})); - foreach my $agentnum (@agentnums) { - foreach (@fixes) { - my ($newname, $oldname, $subject, $from, $bcc) = @$_; - if ($conf->exists($oldname, $agentnum)) { - my $new = new FS::msg_template({ - 'msgname' => $oldname, - 'agentnum' => $agentnum, - 'from_addr' => ($from && $conf->config($from, $agentnum)) || '', - 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '', - 'subject' => ($subject && $conf->config($subject, $agentnum)) || '', - 'mime_type' => 'text/html', - 'body' => join('
',$conf->config($oldname, $agentnum)), - }); - my $error = $new->insert; - die $error if $error; - $conf->set($newname, $new->msgnum, $agentnum); - $conf->delete($oldname, $agentnum); - $conf->delete($from, $agentnum) if $from; - $conf->delete($subject, $agentnum) if $subject; - } - } +=over 4 - if ( $conf->exists('alert_expiration', $agentnum) ) { - my $msgnum = $conf->exists('alerter_msgnum', $agentnum); - my $template = FS::msg_template->by_key($msgnum) if $msgnum; - if (!$template) { - warn "template for alerter_msgnum $msgnum not found\n"; - next; - } - # this is now a set of billing events - foreach my $days (30, 15, 5) { - my $event = FS::part_event->new({ - 'agentnum' => $agentnum, - 'event' => "Card expiration warning - $days days", - 'eventtable' => 'cust_main', - 'check_freq' => '1d', - 'action' => 'notice', - 'disabled' => 'Y', #initialize first - }); - my $error = $event->insert( 'msgnum' => $msgnum ); - if ($error) { - warn "error creating expiration alert event:\n$error\n\n"; - next; - } - # make it work like before: - # only send each warning once before the card expires, - # only warn active customers, - # only warn customers with CARD/DCRD, - # only warn customers who get email invoices - my %conds = ( - 'once_every' => { 'run_delay' => '30d' }, - 'cust_paydate_within' => { 'within' => $days.'d' }, - 'cust_status' => { 'status' => { 'active' => 1 } }, - 'payby' => { 'payby' => { 'CARD' => 1, - 'DCRD' => 1, } - }, - 'message_email' => {}, - ); - foreach (keys %conds) { - my $condition = FS::part_event_condition->new({ - 'conditionname' => $_, - 'eventpart' => $event->eventpart, - }); - $error = $condition->insert( %{ $conds{$_} }); - if ( $error ) { - warn "error creating expiration alert event:\n$error\n\n"; - next; - } - } - $error = $event->initialize; - if ( $error ) { - warn "expiration alert event was created, but not initialized:\n$error\n\n"; - } - } # foreach $days - $conf->delete('alerter_msgnum', $agentnum); - $conf->delete('alert_expiration', $agentnum); - - } # if alerter_msgnum +=item send_prepared CUST_MSG - } +Takes the CUST_MSG object and sends it to its recipient. This is a class +method because everything needed to send the message is stored in the +CUST_MSG already. - ### - # Move subject and body from msg_template to template_content - ### +=cut - foreach my $msg_template ( qsearch('msg_template', {}) ) { - if ( $msg_template->subject || $msg_template->body ) { - # create new default content - my %content; - $content{subject} = $msg_template->subject; - $msg_template->set('subject', ''); - - # work around obscure Pg/DBD bug - # https://rt.cpan.org/Public/Bug/Display.html?id=60200 - # (though the right fix is to upgrade DBD) - my $body = $msg_template->body; - if ( $body =~ /^x([0-9a-f]+)$/ ) { - # there should be no real message templates that look like that - warn "converting template body to TEXT\n"; - $body = pack('H*', $1); - } - $content{body} = $body; - $msg_template->set('body', ''); +sub send_prepared { + my $self = shift; + my $cust_msg = shift or die "cust_msg required"; - my $error = $msg_template->replace(%content); - die $error if $error; - } + my $domain = 'example.com'; + if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) { + $domain = $1; } - ### - # Add new-style default templates if missing - ### - $self->_populate_initial_data; - -} + my @to = split(/\s*,\s*/, $cust_msg->env_to); -sub _populate_initial_data { #class method - #my($class, %opts) = @_; - #my $class = shift; + my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), + 'helo' => $domain ); - eval "use FS::msg_template::InitialData;"; - die $@ if $@; + my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') ); + $smtp_opt{'port'} = $port; + + my $transport; + if ( defined($enc) && $enc eq 'starttls' ) { + $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); + $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); + } else { + if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { + $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); + } + $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; + $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); + } - my $initial_data = FS::msg_template::InitialData->_initial_data; + warn "$me sending message\n" if $DEBUG; + my $message = join("\n\n", $cust_msg->header, $cust_msg->body); + local $@; + eval { + sendmail( $message, { transport => $transport, + from => $cust_msg->env_from, + to => \@to }) + }; + my $error = ''; + if(ref($@) and $@->isa('Email::Sender::Failure')) { + $error = $@->code.' ' if $@->code; + $error .= $@->message; + } + else { + $error = $@; + } - foreach my $hash ( @$initial_data ) { + $cust_msg->set('error', $error); + $cust_msg->set('status', $error ? 'failed' : 'sent'); + if ( $cust_msg->custmsgnum ) { + $cust_msg->replace; + } else { + $cust_msg->insert; + } - next if $hash->{_conf} && $conf->config( $hash->{_conf} ); + $error; +} - my $msg_template = new FS::msg_template($hash); - my $error = $msg_template->insert( @{ $hash->{_insert_args} || [] } ); - die $error if $error; +=back - $conf->set( $hash->{_conf}, $msg_template->msgnum ) if $hash->{_conf}; - - } +=cut -} +# internal use only sub eviscerate { # Every bit as pleasant as it sounds. @@ -897,8 +575,6 @@ sub eviscerate { (\@outside, \@inside); } -=back - =head1 BUGS =head1 SEE ALSO -- cgit v1.2.1 From 46bbbb1a78fd822805226abea832b6206273c091 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Fri, 28 Aug 2015 00:56:49 -0500 Subject: RT#37064: Add action link to manually refund a payment --- FS/FS/access_user.pm | 37 ++++++++++++++ FS/FS/cust_main/Billing_Realtime.pm | 1 + FS/FS/cust_pay.pm | 96 +++++++++++++++++++++++++++++++++++++ 3 files changed, 134 insertions(+) (limited to 'FS') diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index a3f55bc76..ecab32d32 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -587,6 +587,43 @@ sub access_right { } +=item refund_rights PAYBY + +Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a +list of the refund rights associated with that $payby. + +Returns empty list if $payby wasn't recognized. + +=cut + +sub refund_rights { + my $self = shift; + my $payby = shift; + my @rights = (); + push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/; + push @rights, 'Post check refund' if $payby eq 'BILL'; + push @rights, 'Post cash refund ' if $payby eq 'CASH'; + push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/; + push @rights, 'Refund credit card payment' if $payby eq 'CARD'; + push @rights, 'Refund Echeck payment' if $payby eq 'CHEK'; + return @rights; +} + +=item refund_access_right PAYBY + +Returns true if user has L for any L +for the specified payby. + +=cut + +sub refund_access_right { + my $self = shift; + my $payby = shift; + my @rights = $self->refund_rights($payby); + return '' unless @rights; + return $self->access_right(\@rights); +} + =item default_customer_view Returns the default customer view for this user, from the diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index d973896c8..fda3ae040 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -1649,6 +1649,7 @@ sub realtime_refund_bop { $order_number = $refund->order_number if $refund->can('order_number'); + # change this to just use $cust_pay->delete_cust_bill_pay? while ( $cust_pay && $cust_pay->unapplied < $amount ) { my @cust_bill_pay = $cust_pay->cust_bill_pay; last unless @cust_bill_pay; diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 5d4f67fe7..59d77742c 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -821,6 +821,102 @@ sub amount { $self->paid(); } +=item delete_cust_bill_pay OPTIONS + +Deletes all associated cust_bill_pay records. + +If option 'unapplied' is a specified, only deletes until +this object's 'unapplied' value is >= the specified amount. +(Deletes in order returned by L.) + +=cut + +sub delete_cust_bill_pay { + my $self = shift; + my %opt = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $unapplied = $self->unapplied; #only need to look it up once + + my $error = ''; + + # Maybe we should reverse the order these get deleted in? + # ie delete newest first? + # keeping consistent with how bop refunds work, for now... + foreach my $cust_bill_pay ( $self->cust_bill_pay ) { + last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'}); + $unapplied += $cust_bill_pay->amount; + $error = $cust_bill_pay->delete; + last if $error; + } + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; +} + +=item refund HASHREF + +Accepts input for creating a new FS::cust_refund object. +Unapplies payment from invoices up to the amount of the refund, +creates the refund and applies payment to refund. Allows entire +process to be handled in one transaction. + +Causes a fatal error if called on CARD or CHEK payments. + +=cut + +sub refund { + my $self = shift; + my $hash = shift; + die "Cannot call cust_pay->refund on " . $self->payby + if grep { $_ eq $self->payby } qw(CARD CHEK); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'}); + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $hash->{'paynum'} = $self->paynum; + my $new = new FS::cust_refund ( $hash ); + $error = $new->insert; + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; +} + =back =head1 CLASS METHODS -- cgit v1.2.1 From 42837bd9ef4c47b1885564c2e56c4ca0f1e36e77 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Fri, 28 Aug 2015 11:42:09 -0700 Subject: add BILL to allowed payment type list, from #23741 --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index a22e236a2..1714c575a 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -2619,7 +2619,7 @@ and customer address. Include units.', 'section' => 'billing', 'description' => 'Available payment types.', 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD DCRD CHEK DCHK CASH WEST MCRD MCHK PPAL) ], + 'select_enum' => [ qw(CARD DCRD CHEK DCHK BILL CASH WEST MCRD MCHK PPAL) ], }, { -- cgit v1.2.1 From 46b9a9665971f30562b0a6a6231561116399d3a0 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Fri, 28 Aug 2015 15:40:58 -0700 Subject: typo --- FS/FS/msg_template/email.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm index 275dc82bb..f8ebfa06c 100644 --- a/FS/FS/msg_template/email.pm +++ b/FS/FS/msg_template/email.pm @@ -492,7 +492,7 @@ sub send_prepared { } warn "$me sending message\n" if $DEBUG; - my $message = join("\n\n", $cust_msg->header, $cust_msg->body); + my $message = join("\n", $cust_msg->header, $cust_msg->body); local $@; eval { sendmail( $message, { transport => $transport, -- cgit v1.2.1 From 81e562e6067ccf33c24ab3713163a0eefb1438bd Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sat, 29 Aug 2015 13:07:45 -0700 Subject: fix password reset emails based on svc_acct email address, fallout from #25533 --- FS/FS/ClientAPI/MyAccount.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 824ff67cb..6332dd75b 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -3032,7 +3032,7 @@ sub reset_passwd { my($username, $domain) = split('@', $p->{'email'}); my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ); if ( $svc_domain ) { - $svc_acct = qsearchs('svc_acct', { 'username' => $p->{'username'}, + $svc_acct = qsearchs('svc_acct', { 'username' => $username, 'domsvc' => $svc_domain->svcnum } ); if ( $svc_acct ) { @@ -3120,7 +3120,7 @@ sub reset_passwd { my $reset_session = { 'svcnum' => $svc_acct->svcnum, - 'agentnum' => + 'agentnum' => $svc_acct->cust_main->agentnum, }; my $timeout = '1 hour'; #? -- cgit v1.2.1 From a008b601383d5693a197f4bf57ed5ba7887f3065 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sat, 29 Aug 2015 13:37:23 -0700 Subject: #21564, external message services: REST client --- FS/FS/msg_template.pm | 100 ++++++++++++++++++++++++++-- FS/FS/msg_template/email.pm | 11 +--- FS/FS/msg_template/http.pm | 155 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 253 insertions(+), 13 deletions(-) create mode 100644 FS/FS/msg_template/http.pm (limited to 'FS') diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index d7d9f50a8..827bb9883 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -35,6 +35,12 @@ FS::msg_template - Object methods for msg_template records $error = $record->check; +=head1 NOTE + +This uses a table-per-subclass ORM strategy, which is a somewhat cleaner +version of what we do elsewhere with _option tables. We could easily extract +that functionality into a base class, or even into FS::Record itself. + =head1 DESCRIPTION An FS::msg_template object represents a customer message template. @@ -81,20 +87,66 @@ points to. You can ask the object for a copy with the I method. sub table { 'msg_template'; } +sub extension_table { ''; } # subclasses don't HAVE to have extensions + sub _rebless { my $self = shift; my $class = 'FS::msg_template::' . $self->msgclass; eval "use $class;"; bless($self, $class) unless $@; + + # merge in the extension fields + if ( $self->msgnum and $self->extension_table ) { + my $extension = $self->_extension; + if ( $extension ) { + $self->{Hash} = { $self->hash, $extension->hash }; + } + } + $self; } +# Returns the subclass-specific extension record for this object. For internal +# use only; everyone else is supposed to think of this as a single record. + +sub _extension { + my $self = shift; + if ( $self->extension_table and $self->msgnum ) { + local $FS::Record::nowarn_classload = 1; + return qsearchs($self->extension_table, { msgnum => $self->msgnum }); + } + return; +} + =item insert [ CONTENT ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. -# inherited +=cut + +sub insert { + my $self = shift; + $self->_rebless; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + my $error = $self->SUPER::insert; + # calling _extension at this point makes it copy the msgnum, so links work + if ( $self->extension_table ) { + local $FS::Record::nowarn_classload = 1; + my $extension = FS::Record->new($self->extension_table, { $self->hash }); + $error ||= $extension->insert; + } + + if ( $error ) { + dbh->rollback if $oldAutoCommit; + } else { + dbh->commit if $oldAutoCommit; + } + $error; +} =item delete @@ -102,16 +154,56 @@ Delete this record from the database. =cut -# inherited +sub delete { + my $self = shift; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + my $error; + my $extension = $self->_extension; + if ( $extension ) { + $error = $extension->delete; + } + + $error ||= $self->SUPER::delete; + + if ( $error ) { + dbh->rollback if $oldAutoCommit; + } else { + dbh->commit if $oldAutoCommit; + } + $error; +} -=item replace [ OLD_RECORD ] [ CONTENT ] +=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 -# inherited +sub replace { + my $new = shift; + my $old = shift || $new->replace_old; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + my $error = $new->SUPER::replace($old, @_); + + my $extension = $new->_extension; + if ( $extension ) { + $error ||= $extension->replace; + } + + if ( $error ) { + dbh->rollback if $oldAutoCommit; + } else { + dbh->commit if $oldAutoCommit; + } + $error; +} sub replace_check { my $self = shift; diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm index f8ebfa06c..e6d5a5a99 100644 --- a/FS/FS/msg_template/email.pm +++ b/FS/FS/msg_template/email.pm @@ -448,17 +448,10 @@ sub content { =cut -=back - -=head2 CLASS METHODS - -=over 4 - =item send_prepared CUST_MSG -Takes the CUST_MSG object and sends it to its recipient. This is a class -method because everything needed to send the message is stored in the -CUST_MSG already. +Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine" +configuration option will be used to find the outgoing mail server. =cut diff --git a/FS/FS/msg_template/http.pm b/FS/FS/msg_template/http.pm new file mode 100644 index 000000000..51dfcffc2 --- /dev/null +++ b/FS/FS/msg_template/http.pm @@ -0,0 +1,155 @@ +package FS::msg_template::http; +use base qw( FS::msg_template ); + +use strict; +use vars qw( $DEBUG $conf ); + +# needed to talk to the external service +use LWP::UserAgent; +use HTTP::Request::Common; +use JSON; + +# needed to manage prepared messages +use FS::cust_msg; + +our $DEBUG = 1; +our $me = '[FS::msg_template::http]'; + +sub extension_table { 'msg_template_http' } + +=head1 NAME + +FS::msg_template::http - Send messages via a web service. + +=head1 DESCRIPTION + +FS::msg_template::http is a message processor in which the message is exported +to a web service, at both the prepare and send stages. + +=head1 METHODS + +=cut + +sub check { + my $self = shift; + return + $self->ut_textn('prepare_url') + || $self->ut_textn('send_url') + || $self->ut_textn('username') + || $self->ut_textn('password') + || $self->ut_anything('content') + || $self->SUPER::check; +} + +sub prepare { + + my( $self, %opt ) = @_; + + my $json = JSON->new->canonical(1); + + my $cust_main = $opt{'cust_main'}; # or die 'cust_main required'; + my $object = $opt{'object'} or die 'object required'; + + my $hashref = $self->prepare_substitutions(%opt); + + my $document = $json->decode( $self->content || '{}' ); + $document = { + 'msgname' => $self->msgname, + 'msgtype' => $opt{'msgtype'}, + %$document, + %$hashref + }; + + my $request_content = $json->encode($document); + warn "$me ".$self->prepare_url."\n" if $DEBUG; + warn "$request_content\n\n" if $DEBUG > 1; + my $ua = LWP::UserAgent->new; + my $request = POST( + $self->prepare_url, + 'Content-Type' => 'application/json', + 'Content' => $request_content, + ); + if ( $self->username ) { + $request->authorization_basic( $self->username, $self->password ); + } + my $response = $ua->request($request); + warn "$me received:\n" . $response->as_string . "\n\n" if $DEBUG; + + my $cust_msg = FS::cust_msg->new({ + 'custnum' => $cust_main->custnum, + 'msgnum' => $self->msgnum, + '_date' => time, + 'msgtype' => ($opt{'msgtype'} || ''), + }); + + if ( $response->is_success ) { + $cust_msg->set(body => $response->decoded_content); + $cust_msg->set(status => 'prepared'); + } else { + $cust_msg->set(status => 'failed'); + $cust_msg->set(error => $response->decoded_content); + } + + $cust_msg; +} + +=item send_prepared CUST_MSG + +Takes the CUST_MSG object and sends it to its recipient. + +=cut + +sub send_prepared { + my $self = shift; + my $cust_msg = shift or die "cust_msg required"; + # don't just fail if called as a class method + if (!ref $self) { + $self = $cust_msg->msg_template; + } + + # use cust_msg->header for anything? we _could_... + my $request_content = $cust_msg->body; + + warn "$me ".$self->send_url."\n" if $DEBUG; + warn "$request_content\n\n" if $DEBUG > 1; + my $ua = LWP::UserAgent->new; + my $request = POST( + $self->send_url, + 'Content-Type' => 'application/json', + 'Content' => $request_content, + ); + if ( $self->username ) { + $request->authorization_basic( $self->username, $self->password ); + } + my $response = $ua->request($request); + warn "$me received:\n" . $response->as_string . "\n\n" if $DEBUG; + + my $error; + if ( $response->is_success ) { + $cust_msg->set(status => 'sent'); + } else { + $error = $response->decoded_content; + $cust_msg->set(error => $error); + $cust_msg->set(status => 'failed'); + } + + if ( $cust_msg->custmsgnum ) { + $cust_msg->replace; + } else { + $cust_msg->insert; + } + + $error; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; -- cgit v1.2.1 From 2631ae913a1546b2f54f1355017e34b8b4a088bd Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sat, 29 Aug 2015 13:58:58 -0700 Subject: #21564: queueable sending --- FS/FS/cust_msg.pm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_msg.pm b/FS/FS/cust_msg.pm index ec2c961a3..db026808c 100644 --- a/FS/FS/cust_msg.pm +++ b/FS/FS/cust_msg.pm @@ -205,6 +205,25 @@ sub parts { =back +=head1 SUBROUTINES + +=over 4 + +=item process_send CUSTMSGNUM + +Given a C value, sends the message. It must already +have been prepared (via L). + +=cut + +sub process_send { + my $custmsgnum = shift; + my $cust_msg = FS::cust_msg->by_key($custmsgnum) + or die "cust_msg #$custmsgnum not found"; + my $error = $cust_msg->send; + die $error if $error; +} + =head1 SEE ALSO L, L, L. -- cgit v1.2.1 From beeeec140a0479d5757031d9ace0e40871d41d22 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sat, 29 Aug 2015 16:00:43 -0700 Subject: eliminate "defined(@array) is deprecated" warnings --- FS/FS/Record.pm | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index d6892a96c..fafceacb5 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1300,8 +1300,7 @@ sub insert { my $table = $self->table; # Encrypt before the database - if ( defined(eval '@FS::'. $table . '::encrypted_fields') - && scalar( eval '@FS::'. $table . '::encrypted_fields') + if ( scalar( eval '@FS::'. $table . '::encrypted_fields') && $conf_encryption ) { foreach my $field (eval '@FS::'. $table . '::encrypted_fields') { @@ -1543,9 +1542,8 @@ sub replace { # Encrypt for replace my $saved = {}; - if ( $conf_encryption - && defined(eval '@FS::'. $new->table . '::encrypted_fields') - && scalar( eval '@FS::'. $new->table . '::encrypted_fields') + if ( scalar( eval '@FS::'. $new->table . '::encrypted_fields') + && $conf_encryption ) { foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') { next if $field eq 'payinfo' -- cgit v1.2.1 From 42292b1e5813f6e9657f08137dffc68a3c810b01 Mon Sep 17 00:00:00 2001 From: Rob Van Dam Date: Thu, 6 Aug 2015 16:56:15 -0600 Subject: Renamed $br to $br_permonth to clarify value is base_recur_permonth, NOT base_recur --- FS/FS/part_pkg/discount_Mixin.pm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg/discount_Mixin.pm b/FS/FS/part_pkg/discount_Mixin.pm index 31802758c..47cb2516b 100644 --- a/FS/FS/part_pkg/discount_Mixin.pm +++ b/FS/FS/part_pkg/discount_Mixin.pm @@ -40,8 +40,8 @@ sub calc_discount { my($self, $cust_pkg, $sdate, $details, $param ) = @_; my $conf = new FS::Conf; - my $br = $self->base_recur_permonth($cust_pkg, $sdate); - $br += $param->{'override_charges'} if $param->{'override_charges'}; + my $br_permonth = $self->base_recur_permonth($cust_pkg, $sdate); + $br_permonth += $param->{'override_charges'} if $param->{'override_charges'}; my $tot_discount = 0; #UI enforces just 1 for now, will need ordering when they can be stacked @@ -83,7 +83,7 @@ sub calc_discount { my $amount = 0; $amount += $discount->amount if $cust_pkg->pkgpart == $param->{'real_pkgpart'}; - $amount += sprintf('%.2f', $discount->percent * $br / 100 ); + $amount += sprintf('%.2f', $discount->percent * $br_permonth / 100 ); my $chg_months = defined($param->{'months'}) ? $param->{'months'} : $cust_pkg->part_pkg->freq; @@ -133,7 +133,7 @@ sub calc_discount { }; } - $amount = min($amount, $br); + $amount = min($amount, $br_permonth); $amount *= $months; } @@ -147,9 +147,9 @@ sub calc_discount { && !defined $param->{'setup_charge'} ) { - $discount_left = $br - $amount; + $discount_left = $br_permonth - $amount; if ( $discount_left < 0 ) { - $amount = $br; + $amount = $br_permonth; $param->{'discount_left_setup'}{$discount->discountnum} = 0 - $discount_left; } @@ -188,7 +188,7 @@ sub calc_discount { #} #push @$details, $d; - #push @$details, sprintf( $format, $money_char, $br ); + #push @$details, sprintf( $format, $money_char, $br_permonth ); } -- cgit v1.2.1 From 0f8882fa700977c08688d3bdf6412ad06f0e618e Mon Sep 17 00:00:00 2001 From: Rob Van Dam Date: Thu, 6 Aug 2015 17:05:28 -0600 Subject: Changed min() call to reduce possibility of rounding error returning a discount > base_recur. Also added comments for other possible problem areas --- FS/FS/part_pkg/discount_Mixin.pm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg/discount_Mixin.pm b/FS/FS/part_pkg/discount_Mixin.pm index 47cb2516b..abde93f8f 100644 --- a/FS/FS/part_pkg/discount_Mixin.pm +++ b/FS/FS/part_pkg/discount_Mixin.pm @@ -42,7 +42,10 @@ sub calc_discount { my $br_permonth = $self->base_recur_permonth($cust_pkg, $sdate); $br_permonth += $param->{'override_charges'} if $param->{'override_charges'}; - + + my $br = $self->base_recur($cust_pkg, $sdate); + $br += $param->{'override_charges'} * ($cust_pkg->part_pkg->freq || 0) if $param->{'override_charges'}; + my $tot_discount = 0; #UI enforces just 1 for now, will need ordering when they can be stacked @@ -83,7 +86,7 @@ sub calc_discount { my $amount = 0; $amount += $discount->amount if $cust_pkg->pkgpart == $param->{'real_pkgpart'}; - $amount += sprintf('%.2f', $discount->percent * $br_permonth / 100 ); + $amount += sprintf('%.2f', $discount->percent * $br_permonth / 100 ); # FIXME: should this use $br / $freq to avoid rounding errors? my $chg_months = defined($param->{'months'}) ? $param->{'months'} : $cust_pkg->part_pkg->freq; @@ -133,8 +136,7 @@ sub calc_discount { }; } - $amount = min($amount, $br_permonth); - $amount *= $months; + $amount = min($amount * $months, $br); } $amount = sprintf('%.2f', $amount + 0.00000001 ); #so 1.005 rounds to 1.01 @@ -147,9 +149,9 @@ sub calc_discount { && !defined $param->{'setup_charge'} ) { - $discount_left = $br_permonth - $amount; + $discount_left = $br_permonth - $amount; # FIXME: $amount is no longer permonth at this point! if ( $discount_left < 0 ) { - $amount = $br_permonth; + $amount = $br_permonth; # FIXME: seems like this should *= $months $param->{'discount_left_setup'}{$discount->discountnum} = 0 - $discount_left; } -- cgit v1.2.1 From 9fd03716b831bd00a725a63edbe19cfe6b88aea0 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sat, 29 Aug 2015 21:27:20 -0700 Subject: #21564: user interface for REST client --- FS/FS/msg_template.pm | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index 827bb9883..4c2ac4bd4 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -5,7 +5,7 @@ use strict; use vars qw( $DEBUG $conf ); use FS::Conf; -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_msg; use FS::template_content; @@ -95,11 +95,16 @@ sub _rebless { eval "use $class;"; bless($self, $class) unless $@; - # merge in the extension fields + # merge in the extension fields (but let fields in $self override them) + # except don't ever override the extension's primary key, it's immutable if ( $self->msgnum and $self->extension_table ) { my $extension = $self->_extension; if ( $extension ) { - $self->{Hash} = { $self->hash, $extension->hash }; + my $ext_key = $extension->get($extension->primary_key); + $self->{Hash} = { $extension->hash, + $self->hash, + $extension->primary_key => $ext_key + }; } } @@ -194,6 +199,8 @@ sub replace { my $extension = $new->_extension; if ( $extension ) { + # merge changes into the extension record and replace it + $extension->{Hash} = { $extension->hash, $new->hash }; $error ||= $extension->replace; } @@ -212,7 +219,7 @@ sub replace_check { if ( $old->msgclass ) { if ( !$self->msgclass ) { $self->set('msgclass', $old->msgclass); - } else { + } elsif ( $old->msgclass ne $self->msgclass ) { return "Can't change message template class from ".$old->msgclass. " to ".$self->msgclass."."; } -- cgit v1.2.1 From 18b3f884eb44c9d0dea2cedc82c5788f7031e162 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sun, 30 Aug 2015 22:30:10 -0700 Subject: fix invoice deletion vs. cust_pay_batch records, #37837 --- FS/FS/cust_bill.pm | 16 ++++++++++++++-- FS/FS/cust_pay_batch.pm | 15 ++++++++++++++- 2 files changed, 28 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 7ea586a90..410fa7bf7 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -297,13 +297,13 @@ sub _delete { foreach my $table (qw( cust_credit_bill - cust_bill_pay - cust_pay_batch cust_bill_pay_batch + cust_bill_pay cust_bill_batch cust_bill_pkg )) { #cust_event # problematic + #cust_pay_batch # unnecessary foreach my $linked ( $self->$table() ) { my $error = $linked->delete; @@ -2913,6 +2913,18 @@ sub call_details { ( $header, grep { $_ ne $header } @details ); } +=item cust_pay_batch + +Returns all L records linked to this invoice. Deprecated, +will be removed. + +=cut + +sub cust_pay_batch { + carp "FS::cust_bill->cust_pay_batch is deprecated"; + my $self = shift; + qsearch('cust_pay_batch', { 'invnum' => $self->invnum }); +} =back diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index a5fa89b19..8dd644681 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -3,7 +3,7 @@ use base qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record ); use strict; use vars qw( $DEBUG ); -use Carp qw( confess ); +use Carp qw( carp confess ); use Business::CreditCard 0.28; use FS::Record qw(dbh qsearch qsearchs); @@ -502,6 +502,19 @@ sub unbatch_and_delete { } +=item cust_bill + +Returns the invoice linked to this batched payment. Deprecated, will be +removed. + +=cut + +sub cust_bill { + carp "FS::cust_pay_batch->cust_bill is deprecated"; + my $self = shift; + $self->invnum ? qsearchs('cust_bill', { invnum => $self->invnum }) : ''; +} + =back =head1 BUGS -- cgit v1.2.1 From b5cfff7585a9107889dfd55208c52d24d27c4b1c Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 31 Aug 2015 13:32:38 -0700 Subject: repeatability cleanup, #37340 --- FS/FS/TicketSystem/RT_External.pm | 8 ++++---- FS/FS/UI/Web.pm | 1 + FS/FS/part_pkg/prorate_calendar.pm | 2 +- 3 files changed, 6 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/TicketSystem/RT_External.pm b/FS/FS/TicketSystem/RT_External.pm index 9f07732c7..b5414b97c 100644 --- a/FS/FS/TicketSystem/RT_External.pm +++ b/FS/FS/TicketSystem/RT_External.pm @@ -315,22 +315,22 @@ sub href_params_new_ticket { my $subtype = $object->table; my $pkey = $object->get($object->primary_key); - my %param = ( + my @param = ( 'Queue' => ($cust_main->agent->ticketing_queueid || $default_queueid), 'new-MemberOf'=> "freeside://freeside/$subtype/$pkey", 'Requestors' => $requestors, ); - ( $self->baseurl.'Ticket/Create.html', %param ); + ( $self->baseurl.'Ticket/Create.html', @param ); } sub href_new_ticket { my $self = shift; - my( $base, %param ) = $self->href_params_new_ticket(@_); + my( $base, @param ) = $self->href_params_new_ticket(@_); my $uri = new URI $base; - $uri->query_form(%param); + $uri->query_form(@param); $uri; } diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 13b2e2dc0..0e54aa26f 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -623,6 +623,7 @@ sub random_id { if (!defined $NO_RANDOM_IDS) { my $conf = FS::Conf->new; $NO_RANDOM_IDS = $conf->exists('no_random_ids') ? 1 : 0; + warn "TEST MODE--RANDOM ID NUMBERS DISABLED\n" if $NO_RANDOM_IDS; } if ( $NO_RANDOM_IDS ) { if ( $digits > 0 ) { diff --git a/FS/FS/part_pkg/prorate_calendar.pm b/FS/FS/part_pkg/prorate_calendar.pm index 83a80f5d0..c50cae0d7 100644 --- a/FS/FS/part_pkg/prorate_calendar.pm +++ b/FS/FS/part_pkg/prorate_calendar.pm @@ -36,7 +36,7 @@ use base 'FS::part_pkg::flat'; }, 'fieldorder' => [ 'cutoff_day', 'prorate_defer_bill', 'prorate_round_day', 'prorate_verbose' ], 'freq' => 'm', - 'weight' => 20, + 'weight' => 23, ); my %freq_max_days = ( # the length of the shortest period of each cycle type -- cgit v1.2.1 From 653b350d0f8cc69e66e265537a3775f512fd5dda Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 31 Aug 2015 14:55:34 -0700 Subject: one more repeatability fix + documentation, #37340 --- FS/FS/cdr.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm index 1a3666099..775c79114 100644 --- a/FS/FS/cdr.pm +++ b/FS/FS/cdr.pm @@ -1463,7 +1463,7 @@ as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values. sub invoice_formats { map { ($_ => $export_names{$_}->{'name'}) } grep { $export_names{$_}->{'invoice_header'} } - keys %export_names; + sort keys %export_names; } =item invoice_header FORMAT -- cgit v1.2.1 From 6163b943f45e083a87cc03344eb775a9edd553ce Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 31 Aug 2015 22:16:37 -0700 Subject: allow services with a tower but no sector to appear in search results, #33056 --- FS/FS/svc_Tower_Mixin.pm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/svc_Tower_Mixin.pm b/FS/FS/svc_Tower_Mixin.pm index 2555b9e50..d6776791c 100644 --- a/FS/FS/svc_Tower_Mixin.pm +++ b/FS/FS/svc_Tower_Mixin.pm @@ -27,7 +27,13 @@ sub tower_sector_sql { my $in = join(',', map { /^(\d+)$/ ? $1 : () } @$value); my @orwhere; push @orwhere, "tower_sector.$field IN ($in)" if $in; - push @orwhere, "tower_sector.$field IS NULL" if grep /^none$/, @$value; + if ( grep /^none$/, @$value ) { + # then allow this field to be null + push @orwhere, "tower_sector.$field IS NULL"; + # and if this field is the sector, also allow the default sector + # on the tower + push @orwhere, "sectorname = '_default'" if $field eq 'sectornum'; + } push @where, '( '.join(' OR ', @orwhere).' )'; } elsif ( $value =~ /^(\d+)$/ ) { -- cgit v1.2.1 From e0e76b55a2f83c19e4114eefe4dabcab092808b4 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Tue, 1 Sep 2015 23:11:05 -0500 Subject: RT#32892: Monthly Sales Tax Report --- FS/FS/Report/Table.pm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) (limited to 'FS') diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 4b1ad05d6..4b22b60b8 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -753,6 +753,33 @@ sub cust_bill_pkg_taxes { $self->scalar_sql($total_sql); } +#all credits applied to matching pkg line items (ie not taxes or fees) + +sub cust_bill_pkg_credits { + my $self = shift; + my ($speriod, $eperiod, $agentnum, %opt) = @_; + + $agentnum ||= $opt{'agentnum'}; + + my @where = ( + '(cust_bill_pkg.pkgnum != 0 OR feepart IS NOT NULL)', + $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), + $self->with_report_option(%opt), + $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), + $self->with_refnum(%opt), + $self->with_cust_classnum(%opt) + ); + + my $total_sql = "SELECT COALESCE(SUM(cust_credit_bill_pkg.amount),0) + FROM cust_bill_pkg + $cust_bill_pkg_join + LEFT JOIN cust_credit_bill_pkg + USING ( billpkgnum ) + WHERE " . join(' AND ', grep $_, @where); + + $self->scalar_sql($total_sql); +} + ##### package churn report ##### =item active_pkg: The number of packages that were active at the start of -- cgit v1.2.1 From 5cbb1285d26ffe2f7fbf8aed14b5b3d7c037fe83 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Wed, 2 Sep 2015 21:05:28 -0500 Subject: RT#32892: Monthly Sales Tax Report [fixed names and colors] --- FS/FS/Report/Table.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 4b22b60b8..eeb99bac5 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -753,7 +753,7 @@ sub cust_bill_pkg_taxes { $self->scalar_sql($total_sql); } -#all credits applied to matching pkg line items (ie not taxes or fees) +#all credits applied to matching pkg line items (ie not taxes) sub cust_bill_pkg_credits { my $self = shift; -- cgit v1.2.1 From f5955dde67c2015cab4a7892d64799d3adbd7968 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 7 Sep 2015 17:40:25 -0700 Subject: "1 months", eww --- FS/FS/discount.pm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/discount.pm b/FS/FS/discount.pm index 361e0b4b2..e11335741 100644 --- a/FS/FS/discount.pm +++ b/FS/FS/discount.pm @@ -196,7 +196,13 @@ sub description { ( my $months = $self->months ) =~ s/\.0+$//; $months =~ s/(\.\d*[1-9])0+$/$1/; - $desc .= " for $months months" if $months; + if ($months) { + if ($months == 1) { + $desc .= " for 1 month"; + } else { + $desc .= " for $months months"; + } + } $desc .= ', applies to setup' if $self->setup; -- cgit v1.2.1 From 1813f9f4ff4d48ad6bf76d70c01edd67c5a4bfa4 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Mon, 7 Sep 2015 17:40:30 -0700 Subject: rework discount calculation, #20613, #19173, #19354 --- FS/FS/part_pkg/discount_Mixin.pm | 196 +++++++++++++++++++++++---------------- 1 file changed, 115 insertions(+), 81 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_pkg/discount_Mixin.pm b/FS/FS/part_pkg/discount_Mixin.pm index abde93f8f..5de7d8ea5 100644 --- a/FS/FS/part_pkg/discount_Mixin.pm +++ b/FS/FS/part_pkg/discount_Mixin.pm @@ -28,11 +28,15 @@ sub calc_recur { =head METHODS -=item calc_discount +=item calc_discount CUST_PKG, SDATE, DETAILS_ARRAYREF, PARAM_HASHREF -Takes all the arguments of calc_recur. Calculates and returns the amount -by which to reduce the recurring fee; also increments months used on the -discount. +Takes all the arguments of calc_recur. Calculates and returns the amount +by which to reduce the charge; also increments months used on the discount. + +If there is a setup fee, this will be called once with 'setup_charge' => the +setup fee amount (and should return the discount to be applied to the setup +charge, if any), and again without it (for the recurring fee discount). +PARAM_HASHREF carries over between the two invocations. =cut @@ -40,9 +44,6 @@ sub calc_discount { my($self, $cust_pkg, $sdate, $details, $param ) = @_; my $conf = new FS::Conf; - my $br_permonth = $self->base_recur_permonth($cust_pkg, $sdate); - $br_permonth += $param->{'override_charges'} if $param->{'override_charges'}; - my $br = $self->base_recur($cust_pkg, $sdate); $br += $param->{'override_charges'} * ($cust_pkg->part_pkg->freq || 0) if $param->{'override_charges'}; @@ -83,52 +84,125 @@ sub calc_discount { my $discount_left; my $discount = $cust_pkg_discount->discount; #UI enforces one or the other (for now? probably for good) + # $chg_months: the number of months we are charging recur for + # $months: $chg_months or the months left on the discount, whchever is less + + my $chg_months = $cust_pkg->part_pkg->freq || 1; + if ( defined($param->{'months'}) ) { # then override + $chg_months = $param->{'months'}; + } + + my $months = $chg_months; + if ( $discount->months ) { + $months = min( $chg_months, + $discount->months - $cust_pkg_discount->months_used ); + } + + # $amount is now the (estimated) discount amount on the recurring charge. + # if it's a percent discount, that's base recur * percentage. + my $amount = 0; - $amount += $discount->amount - if $cust_pkg->pkgpart == $param->{'real_pkgpart'}; - $amount += sprintf('%.2f', $discount->percent * $br_permonth / 100 ); # FIXME: should this use $br / $freq to avoid rounding errors? - my $chg_months = defined($param->{'months'}) ? - $param->{'months'} : - $cust_pkg->part_pkg->freq; - - my $months = $discount->months - ? min( $chg_months, - $discount->months - $cust_pkg_discount->months_used ) - : $chg_months; if (defined $param->{'setup_charge'}) { + + # we are calculating the setup discount. + # if this discount doesn't apply to setup fees, skip it. + # if it's a percent discount, set $amount = percent * setup_charge. + # if it's a flat amount discount for one month: + # - if the discount amount > setup_charge, then set it to setup_charge, + # and set 'discount_left_recur' to the difference. + # - otherwise set it to just the discount amount. + # if it's a flat amount discount for other than one month: + # - skip the discount. unsure, leaving it alone for now. + next unless $discount->setup; + $months = 0; # never count a setup discount as a month of discount + # (the recur discount in the same month should do it) + if ( $discount->percent > 0 ) { - $amount = sprintf('%.2f', $discount->percent * $param->{'setup_charge'} / 100 ); - $months = 1; - } elsif ( $discount->amount > 0 && $discount->months == 1) { - $discount_left = $param->{'setup_charge'} - $discount->amount; - $amount = $param->{'setup_charge'} if $discount_left < 0; - $amount = $discount->amount if $discount_left >= 0; - $months = 1; - + $amount = $discount->percent * $param->{'setup_charge'} / 100; + } elsif ( $discount->amount > 0 && ($discount->months || 0) == 1) { + # apply the discount amount, up to a maximum of the setup charge + $amount = min($discount->amount, $param->{'setup_charge'}); + $discount_left = sprintf('%.2f', $discount->amount - $amount); # transfer remainder of discount, if any, to recur - $param->{'discount_left_recur'}{$discount->discountnum} = - 0 - $discount_left if $discount_left < 0; + $param->{'discount_left_recur'}{$discount->discountnum} = $discount_left; } else { + # I guess we don't allow multiple-month flat amount discounts to + # apply to setup? next; } - } elsif ( defined $param->{'discount_left_recur'}{$discount->discountnum} - && $param->{'discount_left_recur'}{$discount->discountnum} > 0 - ) { - # use up transferred remainder of discount from setup + + } else { + + # we are calculating a recurring fee discount. estimate the recurring + # fee: + # XXX it would be more accurate for calc_recur to just _tell us_ what + # it's going to charge + + my $recur_charge = $br * ($cust_pkg->quantity || 1) * $chg_months / $self->freq; + # round this, because the real recur charge is rounded + $recur_charge = sprintf('%.2f', $recur_charge); + + # if it's a percentage discount, calculate it based on that estimate. + # otherwise use the flat amount. + + if ( $discount->percent > 0 ) { + $amount = $recur_charge * $discount->percent / 100; + } elsif ( $discount->amount > 0 + and $cust_pkg->pkgpart == $param->{'real_pkgpart'} ) { + $amount = $discount->amount * $months; + } + + if ( exists $param->{'discount_left_recur'}{$discount->discountnum} ) { + # there is a discount_left_recur entry for this discountnum, so this + # is the second (recur) pass on the discount. use up transferred + # remainder of discount from setup. + # + # note that discount_left_recur can now be zero. $amount = $param->{'discount_left_recur'}{$discount->discountnum}; $param->{'discount_left_recur'}{$discount->discountnum} = 0; - $months = 1; - } elsif ( $discount->setup - && $discount->months == 1 - && $discount->amount > 0 - ) { - next; - } + $months = 1; # XXX really? not $chg_months? + } + #elsif ( $discount->setup + # && ($discount->months || 0) == 1 + # && $discount->amount > 0 + # ) { + # next; + # + # RT #11512: bugfix to prevent applying flat discount to both setup + # and recur. The original implementation ignored discount_left_recur + # if it was zero, so if the setup fee used up the entire flat + # discount, the recurring charge would get to use the entire flat + # discount also. This bugfix was a kludge. Instead, we now allow + # discount_left_recur to be zero in that case, and then the available + # recur discount is zero. + #} + + # transfer remainder of discount, if any, to setup + # this is used when the recur phase wants to add a setup fee + # (prorate_defer_bill): the "discount_left_setup" amount will + # be subtracted in _make_lines. + if ( $discount->setup && $discount->amount > 0 + && ($discount->months || 0) != 1 + ) + { + # $amount is no longer permonth at this point! correct. very good. + $discount_left = $amount - $recur_charge; # backward, as above + if ( $discount_left > 0 ) { + $amount = $recur_charge; + $param->{'discount_left_setup'}{$discount->discountnum} = + 0 - $discount_left; + } + } - if ( ! defined $param->{'setup_charge'} ) { + # cap the discount amount at the recur charge + $amount = min($amount, $recur_charge); + + # if this is the base pkgpart, schedule increment_months_used to run at + # the end of billing. (addon packages haven't been calculated yet, so + # don't let the discount expire during the billing process. RT#17045.) if ( $cust_pkg->pkgpart == $param->{'real_pkgpart'} ) { push @{ $param->{precommit_hooks} }, sub { my $error = $cust_pkg_discount->increment_months_used($months); @@ -136,62 +210,22 @@ sub calc_discount { }; } - $amount = min($amount * $months, $br); } $amount = sprintf('%.2f', $amount + 0.00000001 ); #so 1.005 rounds to 1.01 next unless $amount > 0; - # transfer remainder of discount, if any, to setup - if ( $discount->setup && $discount->amount > 0 - && (!$discount->months || $discount->months != 1) - && !defined $param->{'setup_charge'} - ) - { - $discount_left = $br_permonth - $amount; # FIXME: $amount is no longer permonth at this point! - if ( $discount_left < 0 ) { - $amount = $br_permonth; # FIXME: seems like this should *= $months - $param->{'discount_left_setup'}{$discount->discountnum} = - 0 - $discount_left; - } - } - #record details in cust_bill_pkg_discount my $cust_bill_pkg_discount = new FS::cust_bill_pkg_discount { 'pkgdiscountnum' => $cust_pkg_discount->pkgdiscountnum, 'amount' => $amount, 'months' => $months, + # XXX should have a 'setuprecur' }; push @{ $param->{'discounts'} }, $cust_bill_pkg_discount; $tot_discount += $amount; - #add details on discount to invoice - # no longer! this is now done during rendering based on the existence - # of the cust_bill_pkg_discount record - # - #my $money_char = $conf->config('money_char') || '$'; - #$months = sprintf('%.2f', $months) if $months =~ /\./; - - #my $d = 'Includes '; - #my $format; - - #if ( $months eq '1' ) { - # $d .= "discount of $money_char$amount"; - # $d .= " each" if $cust_pkg->quantity > 1; - # $format = 'Undiscounted amount: %s%.2f'; - #} else { - # $d .= 'setup ' if defined $param->{'setup_charge'}; - # $d .= 'discount of '. $discount->description_short; - # $d .= " for $months months" - # unless defined $param->{'setup_charge'}; - # $d .= ": $money_char$amount" if $discount->percent; - # $format = 'Undiscounted monthly amount: %s%.2f'; - #} - - #push @$details, $d; - #push @$details, sprintf( $format, $money_char, $br_permonth ); - } sprintf('%.2f', $tot_discount); -- cgit v1.2.1 From a4245323f5dad7d8e9d19f2be4e3f5b036274276 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 9 Sep 2015 00:18:16 -0700 Subject: fix weird behavior with bundles where base package has zero recur, #32460 --- FS/FS/cust_main/Billing.pm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 5c10c639a..2d7b690df 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -880,6 +880,7 @@ sub bill { } #discard bundled packages of 0 value +# XXX we should reconsider whether we even need this sub _omit_zero_value_bundles { my @in = @_; @@ -888,11 +889,20 @@ sub _omit_zero_value_bundles { my $discount_show_always = $conf->exists('discount-show-always'); my $show_this = 0; + # Sort @in the same way we do during invoice rendering, so we can identify + # bundles. See FS::Template_Mixin::_items_nontax. + @in = sort { $a->pkgnum <=> $b->pkgnum or + $a->sdate <=> $b->sdate or + ($a->pkgpart_override ? 0 : -1) or + ($b->pkgpart_override ? 0 : 1) or + $b->hidden cmp $a->hidden or + $a->pkgpart_override <=> $b->pkgpart_override + } @in; + # this is a pack-and-deliver pattern. every time there's a cust_bill_pkg # _without_ pkgpart_override, that's the start of the new bundle. if there's # an existing bundle, and it contains a nonzero amount (or a zero amount # that's displayable anyway), push all line items in the bundle. - foreach my $cust_bill_pkg ( @in ) { if (scalar(@bundle) and !$cust_bill_pkg->pkgpart_override) { -- cgit v1.2.1 From 34eed3944f194c9a1c20420801c05fd134cf6147 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 9 Sep 2015 19:20:18 -0700 Subject: fix bad internal link --- FS/FS/tax_rate.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 1094968c6..c6fe243d4 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -2328,7 +2328,7 @@ EOF my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.'; $reportname =~ s/^$dropstring//; - my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname"; + my $reporturl = "%%%ROOTURL%%%/misc/queued_report.html?report=$reportname"; die "view\n"; } -- cgit v1.2.1 From 8d76610b4329151076c7e2b81891406df36d18bb Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Thu, 10 Sep 2015 12:23:31 -0700 Subject: correct regex for importing with id 50, RT#37472 --- FS/FS/cdr/aapt.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cdr/aapt.pm b/FS/FS/cdr/aapt.pm index 3c4964317..934608c72 100644 --- a/FS/FS/cdr/aapt.pm +++ b/FS/FS/cdr/aapt.pm @@ -77,7 +77,7 @@ my %UNIT_SCALE = ( #Table 2.1.4 'calltypenum', # usage ID (CUSG) sub { # ID type my ($cdr, $data, $conf, $param) = @_; - if ($data !~ /(1|50)/) { + if ($data !~ /^(1|50)$/) { warn "AAPT: service ID type is not telephone number.\n"; $param->{skiprow} = 1; } -- cgit v1.2.1 From 9896275b96170e2a97e313e64c7aa5bfaf12a087 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 10 Sep 2015 16:27:43 -0700 Subject: improve usage_class_summary with number of calls and total minutes, #37122 --- FS/FS/Template_Mixin.pm | 2 +- FS/FS/cust_bill.pm | 12 +++++++++--- 2 files changed, 10 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index e9b60a86c..206c03cde 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -1519,7 +1519,7 @@ sub print_generic { # usage subtotals if ( $conf->exists('usage_class_summary') and $self->can('_items_usage_class_summary') ) { - my @usage_subtotals = $self->_items_usage_class_summary(escape => $escape_function); + my @usage_subtotals = $self->_items_usage_class_summary(escape => $escape_function, 'money_char' => $other_money_char); if ( @usage_subtotals ) { unshift @sections, $usage_subtotals[0]->{section}; # do not summarize unshift @detail_items, @usage_subtotals; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 410fa7bf7..09424ba52 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -2661,10 +2661,12 @@ sub _items_usage_class_summary { my %opt = @_; my $escape = $opt{escape} || sub { $_[0] }; + my $money_char = $opt{money_char}; my $invnum = $self->invnum; my @classes = qsearch({ 'table' => 'usage_class', - 'select' => 'classnum, classname, SUM(amount) AS amount', + 'select' => 'classnum, classname, SUM(amount) AS amount,'. + ' COUNT(*) AS calls, SUM(duration) AS duration', 'addl_from' => ' LEFT JOIN cust_bill_pkg_detail USING (classnum)' . ' LEFT JOIN cust_bill_pkg USING (billpkgnum)', 'extra_sql' => " WHERE cust_bill_pkg.invnum = $invnum". @@ -2675,17 +2677,21 @@ sub _items_usage_class_summary { my @l; my $section = { description => &{$escape}($self->mt('Usage Summary')), - no_subtotal => 1, usage_section => 1, + subtotal => 0, }; foreach my $class (@classes) { + $section->{subtotal} += $class->get('amount'); push @l, { 'description' => &{$escape}($class->classname), - 'amount' => sprintf('%.2f', $class->amount), + 'amount' => $money_char.sprintf('%.2f', $class->get('amount')), + 'quantity' => $class->get('calls'), + 'duration' => $class->get('duration'), 'usage_classnum' => $class->classnum, 'section' => $section, }; } + $section->{subtotal} = $money_char.sprintf('%.2f', $section->{subtotal}); return @l; } -- cgit v1.2.1 From 8eeac13d3a8b231efd786eca0555087de5dbb17e Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Thu, 10 Sep 2015 21:33:37 -0500 Subject: RT#33410: Package GB add-ons --- FS/FS/cust_pkg.pm | 12 ++++++++--- FS/FS/cust_pkg_usageprice.pm | 5 +++++ FS/FS/part_pkg/sqlradacct_hour.pm | 15 +++++++++++-- FS/FS/part_pkg_usageprice.pm | 44 ++++++++++++++++++++++++++++++++++++--- 4 files changed, 68 insertions(+), 8 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c5a3d2e58..0ef7aa0fa 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2296,9 +2296,15 @@ sub change { } } - # transfer usage pricing add-ons, if we're not changing pkgpart - if ( $same_pkgpart ) { - foreach my $old_cust_pkg_usageprice ($self->cust_pkg_usageprice) { + # transfer usage pricing add-ons, if we're not changing pkgpart or if they were specified + if ( $same_pkgpart || $opt->{'cust_pkg_usageprice'}) { + my @old_cust_pkg_usageprice; + if ($opt->{'cust_pkg_usageprice'}) { + @old_cust_pkg_usageprice = @{ $opt->{'cust_pkg_usageprice'} }; + } else { + @old_cust_pkg_usageprice = $self->cust_pkg_usageprice; + } + foreach my $old_cust_pkg_usageprice (@old_cust_pkg_usageprice) { my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice { 'pkgnum' => $cust_pkg->pkgnum, 'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart, diff --git a/FS/FS/cust_pkg_usageprice.pm b/FS/FS/cust_pkg_usageprice.pm index 5b6b18c70..29e627882 100644 --- a/FS/FS/cust_pkg_usageprice.pm +++ b/FS/FS/cust_pkg_usageprice.pm @@ -163,6 +163,11 @@ sub apply { #this has no multiplication involved, its just a set only #} elsif ( $target eq 'svc_conferencing.confqualitynum' ) { + + } elsif ( $target eq 'sqlradacct_hour.recur_included_total' ) { + + $error = "Cannot call apply on target $target"; + } if ( $error ) { diff --git a/FS/FS/part_pkg/sqlradacct_hour.pm b/FS/FS/part_pkg/sqlradacct_hour.pm index 79e64fbab..206bea0d0 100644 --- a/FS/FS/part_pkg/sqlradacct_hour.pm +++ b/FS/FS/part_pkg/sqlradacct_hour.pm @@ -105,7 +105,18 @@ sub calc_recur { 'AcctOutputOctets' ) / BU; - my $total = $input + $output - $self->option('recur_included_total'); + my $included_total = $self->option('recur_included_total') || 0; + my $addoncharge = 0; + foreach my $cust_pkg_usageprice ($cust_pkg->cust_pkg_usageprice) { + my $part_pkg_usageprice = $cust_pkg_usageprice->part_pkg_usageprice; + $included_total += $cust_pkg_usageprice->quantity * $part_pkg_usageprice->amount; + $addoncharge += $cust_pkg_usageprice->price; + } + my $raw_total = $input + $output; + push(@$details,sprintf( "%.3f %ss included, %.3f %ss used", $included_total, BA, $raw_total, BA )) + if $included_total; + + my $total = $input + $output - $included_total; $total = 0 if $total < 0; $input = $input - $self->option('recur_included_input'); $input = 0 if $input < 0; @@ -153,7 +164,7 @@ sub calc_recur { sprintf('%.1f', $hours). " hours: $hourscharge"; } - my $charges = $hourscharge + $inputcharge + $outputcharge + $totalcharge; + my $charges = $hourscharge + $inputcharge + $outputcharge + $totalcharge + $addoncharge; if ( $self->option('global_cap') && $charges > $self->option('global_cap') ) { $charges = $self->option('global_cap'); push @$details, "Usage charges capped at: $charges"; diff --git a/FS/FS/part_pkg_usageprice.pm b/FS/FS/part_pkg_usageprice.pm index 9c3b1be87..b33904e9e 100644 --- a/FS/FS/part_pkg_usageprice.pm +++ b/FS/FS/part_pkg_usageprice.pm @@ -111,13 +111,46 @@ sub check { || $self->ut_enum('action', [ 'increment', 'set' ]) || $self->ut_enum('target', [ 'svc_acct.totalbytes', 'svc_acct.seconds', 'svc_conferencing.participants', - 'svc_conferencing.confqualitynum' +# 'svc_conferencing.confqualitynum', + 'sqlradacct_hour.recur_included_total' ] ) || $self->ut_text('amount') ; return $error if $error; + #Check target against package + #UI doesn't currently prevent these from happing, + #so keep error messages informative + my $part_pkg = $self->part_pkg; + my $target = $self->target; + my $label = $self->target_info->{'label'}; + my ($needs_svcdb, $needs_plan); + if ( $target =~ /^svc_acct.(\w+)$/ ) { + $needs_svcdb = 'svc_acct'; + } elsif ( $target eq 'svc_conferencing.participants' ) { + $needs_svcdb = 'svc_conferencing'; + } elsif ( $target =~ /^sqlradacct_hour.(\w+)$/ ) { + $needs_plan = 'sqlradacct_hour'; + } + if ($needs_svcdb) { + my $has_svcdb = 0; + foreach my $pkg_svc ($part_pkg->pkg_svc) { + next unless $pkg_svc->quantity; + my $svcdb = $pkg_svc->part_svc->svcdb; + $has_svcdb = 1 + if $svcdb eq $needs_svcdb; + last if $has_svcdb; + } + return "Usage pricing add-on \'$label\' can only be used on packages with at least one $needs_svcdb service.\n" + unless $has_svcdb; + } + if ($needs_plan) { + return "Usage pricing add-on \'$label\' can only be used on packages with pricing plan \'" . + FS::part_pkg->plan_info->{$needs_plan}->{'shortname'} . "\'\n" + unless ref($part_pkg) eq 'FS::part_pkg::' . $needs_plan; + } + $self->SUPER::check; } @@ -147,10 +180,10 @@ sub targets { #'svc_acct.totalbytes' => { label => 'Megabytes', # multiplier => 1048576, # }, - 'svc_acct.totalbytes' => { label => 'Gigabytes', + 'svc_acct.totalbytes' => { label => 'Total Gigabytes', multiplier => 1073741824, }, - 'svc_acct.seconds' => { label => 'Hours', + 'svc_acct.seconds' => { label => 'Total Hours', multiplier => 3600, }, 'svc_conferencing.participants' => { label => 'Conference Participants', @@ -160,6 +193,11 @@ sub targets { # and then value comes from a select, not a text field # 'svc_conferencing.confqualitynum' => { label => 'Conference Quality', # }, + + # this bypasses usual apply methods, handled entirely in sqlradacct_hour + 'sqlradacct_hour.recur_included_total' => { label => 'Included Gigabytes', + multiplier => 1 }, #recur_included_total is stored in GB + ; \%targets; -- cgit v1.2.1 From 7ee96ef046f8e5167a4dda7c4322485549ec29c3 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Thu, 17 Sep 2015 19:27:10 -0500 Subject: RT#35197: Apply changes button in Edit rate plan screen clears the global default --- FS/FS/rate.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index 8ee9a83be..03dde041b 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -469,8 +469,11 @@ sub process { warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG; my @param = ( 'job'=>$job ); - push @param, 'rate_detail'=>\@rate_detail - unless $param->{'preserve_rate_detail'}; + if ($param->{'preserve_rate_detail'}) { + $rate->default_detailnum($old->default_detailnum); + } else { + push @param, 'rate_detail'=>\@rate_detail; + } $error = $rate->replace( $old, @param ); -- cgit v1.2.1 From c0c5709fb022b83a482d0b35f7094505766d5868 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Fri, 18 Sep 2015 10:18:43 -0700 Subject: send commission reports by email, #33101 --- FS/FS/AccessRight.pm | 1 + FS/FS/Mason.pm | 4 + FS/FS/Schema.pm | 31 +++++ FS/FS/cust_bill_pkg.pm | 10 +- FS/FS/cust_msg.pm | 1 + FS/FS/msg_template/email.pm | 12 ++ FS/FS/msg_template/http.pm | 4 + FS/FS/report_batch.pm | 321 ++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 8 ++ FS/t/report_batch.t | 5 + 10 files changed, 395 insertions(+), 2 deletions(-) create mode 100644 FS/FS/report_batch.pm create mode 100644 FS/t/report_batch.t (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 9274ad858..53c7cf622 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -288,6 +288,7 @@ tie my %rights, 'Tie::IxHash', 'Billing event reports', 'Receivables report', 'Financial reports', + { rightname=>'Send reports to customers', global=>1 }, { rightname=> 'List inventory', global=>1 }, { rightname=>'View email logs', global=>1 }, { rightname=>'View system logs' }, diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index ae4f07cdb..98a75c8df 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -405,6 +405,10 @@ if ( -e $addl_handler_use_file ) { use FS::cust_pkg_reason_fee; use FS::part_svc_link; use FS::access_user_log; + use FS::report_batch; + use FS::report_batch; + use FS::report_batch; + use FS::report_batch; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 12211d1e1..85fbbeb8a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -7124,6 +7124,37 @@ sub tables_hashref { ], }, + 'report_batch' => { + 'columns' => [ + 'reportbatchnum', 'serial', '', '', '', '', + 'reportname', 'varchar', '', 255, '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'send_date', @date_type, '', '', + 'sdate', @date_type, '', '', + 'edate', @date_type, '', '', + 'usernum', 'int', 'NULL', '', '', '', + 'msgnum', 'int', 'NULL', '', '', '', + # add report params here as necessary + ], + 'primary_key' => 'reportbatchnum', + 'unique' => [], + 'index' => [], + 'foreign_keys' => [ + { columns => [ 'agentnum' ], + table => 'agent', + references => [ 'agentnum' ], + }, + { columns => [ 'usernum' ], + table => 'access_user', + references => [ 'usernum' ], + }, + { columns => [ 'msgnum' ], + table => 'msg_template', + references => [ 'msgnum' ], + }, + ], + }, + # name type nullability length default local #'new_table' => { diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 8233ce0d6..178042666 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -1124,7 +1124,10 @@ sub tax_locationnum { if ( $self->pkgnum ) { # normal sales return $self->cust_pkg->tax_locationnum; } elsif ( $self->feepart ) { # fees - return $self->cust_bill->cust_main->ship_locationnum; + my $custnum = $self->fee_origin->custnum; + if ( $custnum ) { + return FS::cust_main->by_key($custnum)->ship_locationnum; + } } else { # taxes return ''; } @@ -1135,7 +1138,10 @@ sub tax_location { if ( $self->pkgnum ) { # normal sales return $self->cust_pkg->tax_location; } elsif ( $self->feepart ) { # fees - return $self->cust_bill->cust_main->ship_location; + my $custnum = $self->fee_origin->custnum; + if ( $custnum ) { + return FS::cust_main->by_key($custnum)->ship_location; + } } else { # taxes return; } diff --git a/FS/FS/cust_msg.pm b/FS/FS/cust_msg.pm index db026808c..27272b8a3 100644 --- a/FS/FS/cust_msg.pm +++ b/FS/FS/cust_msg.pm @@ -148,6 +148,7 @@ sub check { 'invoice', 'receipt', 'admin', + 'report', ]) ; return $error if $error; diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm index e6d5a5a99..377dbb17b 100644 --- a/FS/FS/msg_template/email.pm +++ b/FS/FS/msg_template/email.pm @@ -200,6 +200,12 @@ A hash reference of additional substitutions A string identifying the kind of message this is. Currently can be "invoice", "receipt", "admin", or null. Expand this list as necessary. +=item override_content + +A string to use as the HTML body; if specified, replaces the entire +body of the message. This should be used ONLY by L and may +go away in the future. + =back =cut @@ -265,6 +271,12 @@ sub prepare { warn "$me filling in body template\n" if $DEBUG; $body = $body_tmpl->fill_in( HASH => $hashref ); + # override $body if requested + if ( $opt{'override_content'} ) { + warn "$me overriding template body with requested content" if $DEBUG; + $body = $opt{'override_content'}; + } + ### # and email ### diff --git a/FS/FS/msg_template/http.pm b/FS/FS/msg_template/http.pm index 51dfcffc2..a2b0986ea 100644 --- a/FS/FS/msg_template/http.pm +++ b/FS/FS/msg_template/http.pm @@ -59,6 +59,10 @@ sub prepare { %$document, %$hashref }; + # put override content _somewhere_ so it can be used + if ( $opt{'override_content'} ) { + $document{'content'} = $opt{'override_content'}; + } my $request_content = $json->encode($document); warn "$me ".$self->prepare_url."\n" if $DEBUG; diff --git a/FS/FS/report_batch.pm b/FS/FS/report_batch.pm new file mode 100644 index 000000000..64412dfba --- /dev/null +++ b/FS/FS/report_batch.pm @@ -0,0 +1,321 @@ +package FS::report_batch; +use base qw( FS::Record ); + +use strict; +use FS::Record qw( qsearch qsearchs dbdef ); +use FS::msg_template; +use FS::cust_main; +use FS::Misc::DateTime qw(parse_datetime); +use FS::Mason qw(mason_interps); +use URI::Escape; +use HTML::Defang; + +our $DEBUG = 0; + +=head1 NAME + +FS::report_batch - Object methods for report_batch records + +=head1 SYNOPSIS + + use FS::report_batch; + + $record = new FS::report_batch \%hash; + $record = new FS::report_batch { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::report_batch object represents an order to send a batch of reports to +their respective customers or other contacts. FS::report_batch inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item reportbatchnum + +primary key + +=item reportname + +The name of the report, which will be the same as the file name (minus any +directory names). There's an enumerated set of these; you can't use just any +report. + +=item send_date + +The date the report was sent. + +=item agentnum + +The agentnum to limit the report to, if any. + +=item sdate + +The start date of the report period. + +=item edate + +The end date of the report period. + +=item usernum + +The user who ordered the report. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new report batch. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'report_batch'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Deletes this record from the database. + +=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. + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('reportbatchnum') + || $self->ut_text('reportname') + || $self->ut_numbern('agentnum') + || $self->ut_numbern('sdate') + || $self->ut_numbern('edate') + || $self->ut_numbern('usernum') + ; + return $error if $error; + + $self->set('send_date', time); + + $self->SUPER::check; +} + +=back + +=head1 SUBROUTINES + +=over 4 + +=item process_send_report JOB, PARAMS + +Takes a hash of PARAMS, determines all contacts who need to receive a report, +and sends it to them. On completion, creates and stores a report_batch record. +JOB is a queue job to receive status messages. + +PARAMS can include: + +- reportname: the name of the report (listed in the C<%sendable_reports> hash). +Required. +- msgnum: the L to use for this report. Currently the +content of the template is ignored, but the subject line and From/Bcc addresses +are still used. Required. +- agentnum: the agent to limit the report to. +- beginning, ending: the date range to run the report, as human-readable +dates (I unix timestamps). + +=cut + +# trying to keep this data-driven, with parameters that tell how the report is +# to be handled rather than callbacks. +# - path: where under the document root the report is located +# - domain: which table to query for objects on which the report is run. +# Each record in that table produces one report. +# - cust_main: the method on that object that returns its linked customer (to +# which the report will be sent). If the table has a 'custnum' field, this +# can be omitted. +our %sendable_reports = ( + 'sales_commission_pkg' => { + 'name' => 'Sales commission per package', + 'path' => '/search/sales_commission_pkg.html', + 'domain' => 'sales', + 'cust_main' => 'sales_cust_main', + }, +); + +sub process_send_report { + my $job = shift; + my $param = shift; + + my $msgnum = $param->{'msgnum'}; + my $template = FS::msg_template->by_key($msgnum) + or die "msg_template $msgnum not found\n"; + + my $reportname = $param->{'reportname'}; + my $info = $sendable_reports{$reportname} + or die "don't know how to send report '$reportname'\n"; + + # the most important thing: which report is it? + my $path = $info->{'path'}; + + # find all targets for the report: + # - those matching the agentnum if there is one. + # - those that aren't disabled. + my $domain = $info->{domain}; + my $dbt = dbdef->table($domain); + my $hashref = {}; + if ( $param->{'agentnum'} and $dbt->column('agentnum') ) { + $hashref->{'agentnum'} = $param->{'agentnum'}; + } + if ( $dbt->column('disabled') ) { + $hashref->{'disabled'} = ''; + } + my @records = qsearch($domain, $hashref); + my $num_targets = scalar(@records); + return if $num_targets == 0; + my $sent = 0; + + my $outbuf; + my ($fs_interp) = mason_interps('standalone', 'outbuf' => \$outbuf); + # if generating the report fails, we want to capture the error and exit, + # not send it. + $fs_interp->error_mode('fatal'); + $fs_interp->error_format('brief'); + + # we have to at least have an RT::Handle + require RT; + RT::LoadConfig(); + RT::Init(); + + # hold onto all the reports until we're sure they generated correctly. + my %cust_main; + my %report_content; + + # grab the stylesheet + ### note: if we need the ability to support different stylesheets, this + ### is the place to put it in + eval { $fs_interp->exec('/elements/freeside.css') }; + die "couldn't load stylesheet via Mason: $@\n" if $@; + my $stylesheet = $outbuf; + + my $pkey = $dbt->primary_key; + foreach my $rec (@records) { + + $job->update_statustext(int( 100 * $sent / $num_targets )); + my $pkey_val = $rec->get($pkey); # e.g. sales.salesnum + + # find the customer we're sending to, and their email + my $cust_main; + if ( $info->{'cust_main'} ) { + my $cust_method = $info->{'cust_main'}; + $cust_main = $rec->$cust_method; + } elsif ( $rec->custnum ) { + $cust_main = FS::cust_main->by_key($rec->custnum); + } else { + warn "$pkey = $pkey_val has no custnum; not sending report\n"; + next; + } + my @email = $cust_main->invoicing_list_emailonly; + if (!@email) { + warn "$pkey = $pkey_val has no email destinations\n" if $DEBUG; + next; + } + + # params to send to the report (as if from the user's browser) + my @report_param = ( # maybe list these in $info + agentnum => $param->{'agentnum'}, + beginning => $param->{'beginning'}, + ending => $param->{'ending'}, + $pkey => $pkey_val, + _type => 'html-print', + ); + + # build a query string + my $query_string = ''; + while (@report_param) { + $query_string .= uri_escape(shift @report_param) + . '=' + . uri_escape(shift @report_param); + $query_string .= ';' if @report_param; + } + warn "$path?$query_string\n\n" if $DEBUG; + + # run the report! + $FS::Mason::Request::QUERY_STRING = $query_string; + $FS::Mason::Request::FSURL = ''; + $outbuf = ''; + eval { $fs_interp->exec($path) }; + die "creating report for $pkey = $pkey_val: $@" if $@; + + # make some adjustments to the report + my $html_defang; + $html_defang = HTML::Defang->new( + url_callback => sub { 1 }, # strip all URLs (they're not accessible) + tags_to_callback => [ 'body' ], # and after the BODY tag... + tags_callback => sub { + my $isEndTag = $_[4]; + $html_defang->add_to_output("\n\n") + unless $isEndTag; + }, + ); + $outbuf = $html_defang->defang($outbuf); + + $cust_main{ $cust_main->custnum } = $cust_main; + $report_content{ $cust_main->custnum } = $outbuf; + } # foreach $rec + + $job->update_statustext('Sending reports...'); + foreach my $custnum (keys %cust_main) { + # create an email message with the report as body + # change this when backporting to 3.x + $template->send( + cust_main => $cust_main{$custnum}, + object => $cust_main{$custnum}, + msgtype => 'report', + override_content => $report_content{$custnum}, + ); + } + + my $self = FS::report_batch->new({ + reportname => $param->{'reportname'}, + agentnum => $param->{'agentnum'}, + sdate => parse_datetime($param->{'beginning'}), + edate => parse_datetime($param->{'ending'}), + usernum => $job->usernum, + msgnum => $param->{'msgnum'}, + }); + my $error = $self->insert; + warn "error recording completion of report: $error\n" if $error; + +} + +=head1 SEE ALSO + +L + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 5b73b728c..5041ccd68 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -850,3 +850,11 @@ FS/part_svc_link.pm t/part_svc_link.t FS/access_user_log.pm t/access_user_log.t +FS/report_batch.pm +t/report_batch.t +FS/report_batch.pm +t/report_batch.t +FS/report_batch.pm +t/report_batch.t +FS/report_batch.pm +t/report_batch.t diff --git a/FS/t/report_batch.t b/FS/t/report_batch.t new file mode 100644 index 000000000..42fc8936a --- /dev/null +++ b/FS/t/report_batch.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::report_batch; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 15278bb4dcfaf4bdb79c7f8781320e24ef8f1e7d Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Sat, 19 Sep 2015 18:11:54 -0500 Subject: RT#35197: Apply changes button in Edit rate plan screen clears the global default [removed preserve_rate_detail, always true] --- FS/FS/rate.pm | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index 03dde041b..d26d11697 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -469,11 +469,8 @@ sub process { warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG; my @param = ( 'job'=>$job ); - if ($param->{'preserve_rate_detail'}) { - $rate->default_detailnum($old->default_detailnum); - } else { - push @param, 'rate_detail'=>\@rate_detail; - } + + $rate->default_detailnum($old->default_detailnum); $error = $rate->replace( $old, @param ); -- cgit v1.2.1 From 01698260f2624212ab71be26bb4c644c0aeea2e4 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sat, 19 Sep 2015 10:56:59 -0700 Subject: add credited sales column to tax report, #37088 --- FS/FS/Report/Tax.pm | 110 +++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 92 insertions(+), 18 deletions(-) (limited to 'FS') diff --git a/FS/FS/Report/Tax.pm b/FS/FS/Report/Tax.pm index 0923d55cf..f114c1c6b 100644 --- a/FS/FS/Report/Tax.pm +++ b/FS/FS/Report/Tax.pm @@ -182,26 +182,92 @@ sub report_internal { $all_sql{exempt_monthly} = $all_exempt; $all_sql{exempt_monthly} =~ s/EXEMPT_WHERE/exempt_monthly = 'Y'/; + # credits applied to taxable sales + # Note that negative exemptions (from exempt sales being credited) are NOT + # counted when calculating the exempt amount. (See above.) Therefore we need + # to NOT include any credits against exempt sales in this amount, either. + # These two subqueries implement that. They have joins to cust_credit_bill + # and cust_bill so that credits can be filtered by application date if + # requested. + + # Each row here is the sum of credits applied to a line item. + my $sales_credit = + "SELECT billpkgnum, SUM(cust_credit_bill_pkg.amount) AS credited + FROM cust_credit_bill_pkg + JOIN cust_credit_bill USING (creditbillnum) + JOIN cust_bill USING (invnum) + WHERE cust_bill._date >= $beginning AND cust_bill._date <= $ending + GROUP BY billpkgnum + "; + + # Each row here is the sum of negative exemptions applied to a combination + # of line item and tax definition. + my $exempt_credit = + "SELECT cust_credit_bill_pkg.billpkgnum, taxnum, + 0 - SUM(cust_tax_exempt_pkg.amount) AS exempt_credited + FROM cust_credit_bill_pkg + LEFT JOIN cust_tax_exempt_pkg USING (creditbillpkgnum) + JOIN cust_credit_bill USING (creditbillnum) + JOIN cust_bill USING (invnum) + WHERE cust_bill._date >= $beginning AND cust_bill._date <= $ending + GROUP BY cust_credit_bill_pkg.billpkgnum, taxnum + "; + + if ( $opt{credit_date} eq 'cust_credit_bill' ) { + $sales_credit =~ s/cust_bill._date/cust_credit_bill._date/g; + $exempt_credit =~ s/cust_bill._date/cust_credit_bill._date/g; + } + + $sql{sales_credited} = "$select + SUM(COALESCE(credited, 0) - COALESCE(exempt_credited, 0)) + FROM cust_main_county + JOIN ($pkg_tax) AS pkg_tax USING (taxnum) + JOIN cust_bill_pkg USING (billpkgnum) + LEFT JOIN ($sales_credit) AS sales_credit USING (billpkgnum) + LEFT JOIN ($exempt_credit) AS exempt_credit USING (billpkgnum, taxnum) + $join_cust_pkg $where AND $nottax + $group + "; + + $all_sql{sales_credited} = "$select_all + SUM(COALESCE(credited, 0) - COALESCE(exempt_credited, 0)) + FROM cust_main_county + JOIN ($pkg_tax) AS pkg_tax USING (taxnum) + JOIN cust_bill_pkg USING (billpkgnum) + LEFT JOIN ($sales_credit) AS sales_credit USING (billpkgnum) + LEFT JOIN ($exempt_credit) AS exempt_credit USING (billpkgnum, taxnum) + $join_cust_pkg $where AND $nottax + $group + "; + # taxable sales $sql{taxable} = "$select - SUM(cust_bill_pkg.setup + cust_bill_pkg.recur - COALESCE(exempt_charged, 0)) + SUM(cust_bill_pkg.setup + cust_bill_pkg.recur + - COALESCE(exempt_charged, 0) + - COALESCE(credited, 0) + + COALESCE(exempt_credited, 0) + ) FROM cust_main_county JOIN ($pkg_tax) AS pkg_tax USING (taxnum) JOIN cust_bill_pkg USING (billpkgnum) - LEFT JOIN ($pkg_tax_exempt) AS pkg_tax_exempt - ON (pkg_tax_exempt.billpkgnum = cust_bill_pkg.billpkgnum - AND pkg_tax_exempt.taxnum = cust_main_county.taxnum) + LEFT JOIN ($pkg_tax_exempt) AS pkg_tax_exempt USING (billpkgnum, taxnum) + LEFT JOIN ($sales_credit) AS sales_credit USING (billpkgnum) + LEFT JOIN ($exempt_credit) AS exempt_credit USING (billpkgnum, taxnum) $join_cust_pkg $where AND $nottax $group"; $all_sql{taxable} = "$select_all - SUM(cust_bill_pkg.setup + cust_bill_pkg.recur - COALESCE(exempt_charged, 0)) + SUM(cust_bill_pkg.setup + cust_bill_pkg.recur + - COALESCE(exempt_charged, 0) + - COALESCE(credited, 0) + + COALESCE(exempt_credited, 0) + ) FROM cust_main_county JOIN ($pkg_tax) AS pkg_tax USING (taxnum) JOIN cust_bill_pkg USING (billpkgnum) - LEFT JOIN ($pkg_tax_exempt) AS pkg_tax_exempt - ON (pkg_tax_exempt.billpkgnum = cust_bill_pkg.billpkgnum - AND pkg_tax_exempt.taxnum = cust_main_county.taxnum) + LEFT JOIN ($pkg_tax_exempt) AS pkg_tax_exempt USING (billpkgnum, taxnum) + LEFT JOIN ($sales_credit) AS sales_credit USING (billpkgnum) + LEFT JOIN ($exempt_credit) AS exempt_credit USING (billpkgnum, taxnum) $join_cust_pkg $where AND $nottax $group_all"; @@ -211,27 +277,35 @@ sub report_internal { # estimated tax (taxable * rate) $sql{estimated} = "$select SUM(cust_main_county.tax / 100 * - (cust_bill_pkg.setup + cust_bill_pkg.recur - COALESCE(exempt_charged, 0)) + (cust_bill_pkg.setup + cust_bill_pkg.recur + - COALESCE(exempt_charged, 0) + - COALESCE(credited, 0) + + COALESCE(exempt_credited, 0) + ) ) FROM cust_main_county JOIN ($pkg_tax) AS pkg_tax USING (taxnum) JOIN cust_bill_pkg USING (billpkgnum) - LEFT JOIN ($pkg_tax_exempt) AS pkg_tax_exempt - ON (pkg_tax_exempt.billpkgnum = cust_bill_pkg.billpkgnum - AND pkg_tax_exempt.taxnum = cust_main_county.taxnum) + LEFT JOIN ($pkg_tax_exempt) AS pkg_tax_exempt USING (billpkgnum, taxnum) + LEFT JOIN ($sales_credit) AS sales_credit USING (billpkgnum) + LEFT JOIN ($exempt_credit) AS exempt_credit USING (billpkgnum, taxnum) $join_cust_pkg $where AND $nottax $group"; $all_sql{estimated} = "$select_all SUM(cust_main_county.tax / 100 * - (cust_bill_pkg.setup + cust_bill_pkg.recur - COALESCE(exempt_charged, 0)) + (cust_bill_pkg.setup + cust_bill_pkg.recur + - COALESCE(exempt_charged, 0) + - COALESCE(credited, 0) + + COALESCE(exempt_credited, 0) + ) ) FROM cust_main_county JOIN ($pkg_tax) AS pkg_tax USING (taxnum) JOIN cust_bill_pkg USING (billpkgnum) - LEFT JOIN ($pkg_tax_exempt) AS pkg_tax_exempt - ON (pkg_tax_exempt.billpkgnum = cust_bill_pkg.billpkgnum - AND pkg_tax_exempt.taxnum = cust_main_county.taxnum) + LEFT JOIN ($pkg_tax_exempt) AS pkg_tax_exempt USING (billpkgnum, taxnum) + LEFT JOIN ($sales_credit) AS sales_credit USING (billpkgnum) + LEFT JOIN ($exempt_credit) AS exempt_credit USING (billpkgnum, taxnum) $join_cust_pkg $where AND $nottax $group_all"; @@ -290,12 +364,12 @@ sub report_internal { $creditwhere =~ s/cust_bill._date/cust_credit_bill._date/g; } - $sql{credit} = "$select SUM(cust_credit_bill_pkg.amount) + $sql{tax_credited} = "$select SUM(cust_credit_bill_pkg.amount) $creditfrom $creditwhere AND $istax $group"; - $all_sql{credit} = "$select_all SUM(cust_credit_bill_pkg.amount) + $all_sql{tax_credited} = "$select_all SUM(cust_credit_bill_pkg.amount) $creditfrom $creditwhere AND $istax $group_all"; -- cgit v1.2.1 From b38fc0b849b21ed4e2a83bab885b63223914edd5 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sun, 20 Sep 2015 10:00:37 -1000 Subject: fix creation of negative exemption records, #37088, from #13971 --- FS/FS/cust_tax_exempt_pkg.pm | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'FS') diff --git a/FS/FS/cust_tax_exempt_pkg.pm b/FS/FS/cust_tax_exempt_pkg.pm index b64ef515d..5057781f4 100644 --- a/FS/FS/cust_tax_exempt_pkg.pm +++ b/FS/FS/cust_tax_exempt_pkg.pm @@ -3,6 +3,7 @@ use base qw( FS::cust_main_Mixin FS::Record ); use strict; use FS::UID qw(dbh); +use FS::cust_main_county; use FS::upgrade_journal; # some kind of common ancestor with cust_bill_pkg_tax_location would make sense @@ -176,6 +177,16 @@ Otherwise returns false. =cut +# do not remove; this can't be autogenerated + +sub cust_main_county { + my $self = shift; + if ( $self->taxtype eq 'FS::cust_main_county' ) { + return FS::cust_main_county->by_key($self->taxnum); + } + ''; +} + sub _upgrade_data { my $class = shift; -- cgit v1.2.1 From 94ab54acc7f6941d9ed02f2ad5d7b63f1d2f6b60 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sun, 20 Sep 2015 10:09:53 -1000 Subject: fix total sales column, #37088 --- FS/FS/Report/Tax.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/Report/Tax.pm b/FS/FS/Report/Tax.pm index f114c1c6b..2480a45b9 100644 --- a/FS/FS/Report/Tax.pm +++ b/FS/FS/Report/Tax.pm @@ -557,6 +557,7 @@ sub table { # and calculate row totals $this_row{sales} = sprintf('%.2f', $this_row{taxable} + + $this_row{sales_credited} + $this_row{exempt_cust} + $this_row{exempt_pkg} + $this_row{exempt_monthly} -- cgit v1.2.1 From 376794a00e837317e35fefd61a29ab58c0303b35 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 21 Sep 2015 02:02:13 -0700 Subject: billing event to call web services, RT#35167 --- FS/FS/Misc/DateTime.pm | 22 ++++++++--- FS/FS/cust_pay.pm | 16 ++++++++ FS/FS/part_event.pm | 2 + FS/FS/part_event/Action/http.pm | 85 +++++++++++++++++++++++++++++++++++++++++ FS/FS/part_event/Condition.pm | 1 + FS/FS/part_event_option.pm | 3 +- 6 files changed, 123 insertions(+), 6 deletions(-) create mode 100644 FS/FS/part_event/Action/http.pm (limited to 'FS') diff --git a/FS/FS/Misc/DateTime.pm b/FS/FS/Misc/DateTime.pm index 2fff90647..56baec3ed 100644 --- a/FS/FS/Misc/DateTime.pm +++ b/FS/FS/Misc/DateTime.pm @@ -6,9 +6,10 @@ use Carp; use Time::Local; use Date::Parse; use DateTime::Format::Natural; +use Date::Format; use FS::Conf; -@EXPORT_OK = qw( parse_datetime day_end ); +@EXPORT_OK = qw( parse_datetime day_end iso8601 ); =head1 NAME @@ -65,11 +66,22 @@ same date but 23:59:59 for the time. =cut sub day_end { - my $time = shift; + my $time = shift; - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = - localtime($time); - timelocal(59,59,23,$mday,$mon,$year); + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime($time); + timelocal(59,59,23,$mday,$mon,$year); +} + +=item iso8601 TIME + +Parses time as an integer UNIX timestamp and returns the ISO 8601 formatted +date and time. + +=cut + +sub iso8601 { + time2str('%Y-%m-%dT%T', @_); } =back diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 59d77742c..cb39d4391 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -409,6 +409,22 @@ sub insert { warn "can't send payment receipt/statement: $error" if $error; } + #run payment events immediately + my $due_cust_event = $self->cust_main->due_cust_event( + 'eventtable' => 'cust_pay', + 'objects' => [ $self ], + ); + if ( !ref($due_cust_event) ) { + warn "Error searching for cust_pay billing events: $due_cust_event\n"; + } else { + foreach my $cust_event (@$due_cust_event) { + next unless $cust_event->test_conditions; + if ( my $error = $cust_event->do_event() ) { + warn "Error running cust_pay billing event: $error\n"; + } + } + } + ''; } diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm index d15f35b7d..9a1144c85 100644 --- a/FS/FS/part_event.pm +++ b/FS/FS/part_event.pm @@ -369,6 +369,7 @@ sub eventtable_labels { 'cust_pkg' => 'Package', 'cust_bill' => 'Invoice', 'cust_main' => 'Customer', + 'cust_pay' => 'Payment', 'cust_pay_batch' => 'Batch payment', 'cust_statement' => 'Statement', #too general a name here? "Invoice group"? 'svc_acct' => 'Login service', @@ -408,6 +409,7 @@ sub eventtable_pkey { 'cust_main' => 'custnum', 'cust_bill' => 'invnum', 'cust_pkg' => 'pkgnum', + 'cust_pay' => 'paynum', 'cust_pay_batch' => 'paybatchnum', 'cust_statement' => 'statementnum', 'svc_acct' => 'svcnum', diff --git a/FS/FS/part_event/Action/http.pm b/FS/FS/part_event/Action/http.pm new file mode 100644 index 000000000..b8715a714 --- /dev/null +++ b/FS/FS/part_event/Action/http.pm @@ -0,0 +1,85 @@ +package FS::part_event::Action::http; + +use strict; +use base qw( FS::part_event::Action ); +use LWP::UserAgent; +use HTTP::Request::Common; +use JSON::XS; +use FS::Misc::DateTime qw( iso8601 ); + +#sub description { 'Send an HTTP or HTTPS GET or POST request'; } +sub description { 'Send an HTTP or HTTPS POST request'; } + +sub eventtable_hashref { + { 'cust_bill' => 1, + 'cust_pay' => 1, + }, +} + +sub option_fields { + ( + 'method' => { label => 'Method', + type => 'select', + options => [qw( POST )], #GET )], + }, + 'url' => { label => 'URL', + type => 'text', + size => 120, + }, + 'ssl_no_verify' => { label => 'Skip SSL certificate validation', + type => 'checkbox', + }, + 'encoding' => { label => 'Encoding', + type => 'select', + options => [qw( JSON )], #XML, Form, etc. + }, + 'content' => { label => 'Content', #nneed better inline docs on format + type => 'textarea', + }, + #'response_error_param' => 'Response error parameter', + ); +} + +sub default_weight { 57; } + +our %content_type = ( + 'JSON' => 'application/json', +); + +sub do_action { + my( $self, $object ) = @_; + + my $cust_main = $self->cust_main($object); + + my %content = + map { + /^\s*(\S+)\s+(.*)$/ or /()()/; + my( $field, $value_expression ) = ( $1, $2 ); + my $value = eval $value_expression; + die $@ if $@; + ( $field, $value ); + } split(/\n/, $self->option('content') ); + + my $content = encode_json( \%content ); + + my @lwp_opts = (); + push @lwp_opts, 'ssl_opts'=>{ 'verify_hostname'=>0 } + if $self->option('ssl_no_verify'); + my $ua = LWP::UserAgent->new(@lwp_opts); + + my $req = HTTP::Request::Common::POST( + $self->option('url'), + Content_Type => $content_type{ $self->option('encoding') }, + Content => $content, + ); + + my $response = $ua->request($req); + + die $response->status_line if $response->is_error; + + my $response_json = decode_json( $response->content ); + die $response_json->{error} if $response_json->{error}; #XXX response_error_param + +} + +1; diff --git a/FS/FS/part_event/Condition.pm b/FS/FS/part_event/Condition.pm index 60697c196..36fbe9a0d 100644 --- a/FS/FS/part_event/Condition.pm +++ b/FS/FS/part_event/Condition.pm @@ -52,6 +52,7 @@ sub eventtable_hashref { { 'cust_main' => 1, 'cust_bill' => 1, 'cust_pkg' => 1, + 'cust_pay' => 1, 'cust_pay_batch' => 1, 'cust_statement' => 1, 'svc_acct' => 1, diff --git a/FS/FS/part_event_option.pm b/FS/FS/part_event_option.pm index 09b775609..6df9e84c1 100644 --- a/FS/FS/part_event_option.pm +++ b/FS/FS/part_event_option.pm @@ -183,7 +183,8 @@ sub check { $self->ut_numbern('optionnum') || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart' ) || $self->ut_text('optionname') - || $self->ut_textn('optionvalue') + #|| $self->ut_textn('optionvalue') + || $self->ut_anything('optionvalue') #http.pm content has \n ; return $error if $error; -- cgit v1.2.1 From ab5177ddab29e7fca9f64144a0c1ed104ead3ead Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 21 Sep 2015 18:25:57 -0700 Subject: import BWGroupNumber as charged_party when accountcode is empty, RT#27946 --- FS/FS/cdr/amcom.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cdr/amcom.pm b/FS/FS/cdr/amcom.pm index 36be8d8c3..97ab402ca 100644 --- a/FS/FS/cdr/amcom.pm +++ b/FS/FS/cdr/amcom.pm @@ -22,8 +22,12 @@ my ($tmp_mday, $tmp_mon, $tmp_year); my ($cdr, $field, $conf, $hashref) = @_; $hashref->{skiprow} = 1 unless $field eq 'DCR'; }, - '', # 2. BWGroupID (centrex group) - '', # 3. BWGroupNumber + 'accountcode',# 2. BWGroupID (centrex group) + sub { # 3. BWGroupNumber + my ($cdr, $field) = @_; #, $conf, $hashref) = @_; + $cdr->charged_party($field) + if $cdr->accountcode eq '' && $field =~ /^(1800|1300)/; + }, 'uniqueid', # 4. Record ID 'dcontext', # 5. Call Category (LOCAL, NATIONAL, FREECALL, MOBILE) sub { # 6. Start Date (DDMMYYYY -- cgit v1.2.1 From 0c759132a02d9403f391c6a997cbe754a4dba407 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 21 Sep 2015 20:40:36 -0700 Subject: import a2billing username as charged_party, RT#32909 --- FS/bin/freeside-cdr-a2billing-import | 208 +++++++++++++++++++++++++++++++++++ 1 file changed, 208 insertions(+) create mode 100755 FS/bin/freeside-cdr-a2billing-import (limited to 'FS') diff --git a/FS/bin/freeside-cdr-a2billing-import b/FS/bin/freeside-cdr-a2billing-import new file mode 100755 index 000000000..923f5fbb1 --- /dev/null +++ b/FS/bin/freeside-cdr-a2billing-import @@ -0,0 +1,208 @@ +#!/usr/bin/perl + +use strict; +use vars qw( $DEBUG ); +use Date::Parse 'str2time'; +use Date::Format 'time2str'; +use FS::UID qw(adminsuidsetup dbh); +use FS::cdr; +use DBI; +use Getopt::Std; + +my %opt; +getopts('H:U:P:D:T:s:e:c:', \%opt); +my $user = shift or die &usage; + +my $dsn = 'dbi:mysql'; +$dsn .= ":database=$opt{D}" if $opt{D}; +$dsn .= ":host=$opt{H}" if $opt{H}; + +my $mysql = DBI->connect($dsn, $opt{U}, $opt{P}) + or die $DBI::errstr; + +my ($start, $end) = ('', ''); +if ( $opt{s} ) { + $start = str2time($opt{s}) or die "can't parse start date $opt{s}\n"; + $start = time2str('%Y-%m-%d', $start); +} +if ( $opt{e} ) { + $end = str2time($opt{e}) or die "can't parse end date $opt{e}\n"; + $end = time2str('%Y-%m-%d', $end); +} + +adminsuidsetup $user; + +my $fsdbh = FS::UID::dbh; + +# check for existence of freesidestatus +my $table = $opt{T} || 'cc_call'; +my $status = $mysql->selectall_arrayref("SHOW COLUMNS FROM $table WHERE Field = 'freesidestatus'"); +if( ! @$status ) { + print "Adding freesidestatus column...\n"; + $mysql->do("ALTER TABLE $table ADD COLUMN freesidestatus varchar(32)") + or die $mysql->errstr; +} +else { + print "freesidestatus column present\n"; +} + +# Fields: +# id - primary key, sequential +# session_id - Local/- or SIP/- +# uniqueid - a decimal number, seems to be close to the unix timestamp +# card_id - probably the equipment port, 1 - 10 +# nasipaddress - we don't care +# starttime, stoptime - timestamps +# sessiontime - duration, seconds +# calledstation - dst +# sessionbill - upstream_price +# id_tariffgroup - null, 0, 1 +# id_tariffplan - null, 0, 3, 4, 5, 6, 7, 8, 9 +# id_ratecard - larger numbers +# (all of the id_* fields are foreign keys: cc_tariffgroup, cc_ratecard, etc.) +# id_trunk - we don't care +# sipiax - probably don't care +# src - src. Usually a phone number, but not always. +# id_did - always null +# buycost - wholesale price? correlated with sessionbill +# id_card_package_offer - no idea +# real_sessiontime - close to sessiontime, except when it's null +# (When sessiontime = 0, real_sessiontime is either 0 or null, and +# sessionbill is 0. When sessiontime > 0, but real_sessiontime is null, +# sessionbill is 0. So real_sessiontime seems to be the billable time, and +# is null when the call is non-billable.) +# dnid - sometimes equals calledstation, or calledstation without the leading +# "1". But not always. +# terminatecauseid - integer, 0 - 7 +# destination - seems to be the NPA or NPA+NXX sometimes, or "0". + +# terminatecauseid values: +my %disposition = ( + 0 => '', + 1 => 'ANSWER', #the only one that's billable + 2 => 'BUSY', + 3 => 'NOANSWER', + 4 => 'CANCEL', + 5 => 'CONGESTION', + 6 => 'CHANUNAVAIL', + 7 => 'DONTCALL', + 8 => 'TORTURE', #??? + 9 => 'INVALIDARGS', +); + +my @cols = ( + 'cc_call.id as id', 'cc_card.username as username', + qw( sessionid + starttime stoptime sessiontime real_sessiontime + terminatecauseid + calledstation src + id_tariffplan id_ratecard sessionbill + ) +); + +my $sql = 'SELECT '.join(',', @cols). " FROM $table". + ' WHERE freesidestatus IS NULL' . + ($start && " AND starttime >= '$start'") . + ($end && " AND starttime < '$end'") ; +my $sth = $mysql->prepare($sql); +$sth->execute; +print "Importing ".$sth->rows." records...\n"; + +my $cdr_batch = new FS::cdr_batch({ + 'cdrbatch' => 'mysql-import-'. time2str('%Y/%m/%d-%T',time), + }); +my $error = $cdr_batch->insert; +die $error if $error; +my $cdrbatchnum = $cdr_batch->cdrbatchnum; +my $imports = 0; +my $updates = 0; + +my $row; +while ( $row = $sth->fetchrow_hashref ) { + $row->{calledstation} =~ s/^1//; + $row->{src} =~ s/^1//; + my $cdr = FS::cdr->new ({ + uniqueid => $row->{sessionid}, + cdrbatchnum => $cdrbatchnum, + startdate => time2str($row->{starttime}), + enddate => time2str($row->{stoptime}), + duration => $row->{sessiontime}, + billsec => $row->{real_sessiontime}, + dst => $row->{calledstation}, + src => $row->{src}, + charged_party => $row->{username}, + upstream_rateplanid => $row->{id_tariffplan}, + upstream_rateid => $row->{id_ratecard}, # I think? + upstream_price => $row->{sessionbill}, + }); + $cdr->cdrtypenum($opt{c}) if $opt{c}; + + my $error = $cdr->insert; + if($error) { + print "failed import: $error\n"; + } else { + $imports++; + my $updated = $mysql->do( + "UPDATE $table SET freesidestatus = 'done' WHERE id = ?", + undef, + $row->{'id'} + ); + $updates += $updated; + print "failed to set status: ".$mysql->errstr."\n" unless $updated; + } +} +print "Done.\nImported $imports CDRs, marked $updates as done in source database.\n"; +$mysql->disconnect; + +sub usage { + "Usage: + freeside-cdr-a2billing-import + [ -H host ] + -D database + -U user + -P password + [ -s start ] [ -e end ] [ -c cdrtypenum ] + freesideuser +"; +} + +=head1 NAME + +freeside-cdr-a2billing-import - Download CDRs from an A2Billing MySQL database + +=head1 SYNOPSIS + + freeside-cdr-a2billing-import [ -H host ] -D database -U user -P password + [ -T tablename ] + [ -s start ] [ -e end ] [ -c cdrtypenum ] + freesideuser + +-H: database hostname + +-D: database name + +-U: database username + +-P: database password + +-T: table to import, defaults to cc_call + +-s: start date, e.g. 4/20/2015 + +-e: end date, e.g. 12/25/2015 + +-c: cdrtypenum to set, defaults to none + +freesideuser: freeside username + +=head1 DESCRIPTION + +=head1 BUGS + +=head1 SEE ALSO + +L + +=cut + +1; -- cgit v1.2.1 From 15a4e1674694b76ecc2af87de479aabe370ac03d Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Tue, 22 Sep 2015 01:08:04 -0500 Subject: RT#37908: Convert existing email-sending code to use common interface [removals and switches to FS::Log] --- FS/FS/AccessRight.pm | 2 +- FS/FS/Conf.pm | 39 ++------------------ FS/FS/Cron/agent_email.pm | 79 ---------------------------------------- FS/FS/Cron/backup.pm | 59 +++++++++++++----------------- FS/FS/Upgrade.pm | 6 +++ FS/FS/cust_credit.pm | 32 +--------------- FS/FS/log_context.pm | 2 + FS/FS/pay_batch.pm | 19 ++++------ FS/bin/freeside-daily | 4 -- FS/bin/freeside-fetch | 93 ----------------------------------------------- 10 files changed, 46 insertions(+), 289 deletions(-) delete mode 100644 FS/FS/Cron/agent_email.pm delete mode 100755 FS/bin/freeside-fetch (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 53c7cf622..3f2c0f35d 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -223,7 +223,7 @@ tie my %rights, 'Tie::IxHash', 'Void credit', #NEWER than things marked NEWNEWNEW 'Unvoid credit', #NEWER than things marked NEWNEWNEW { rightname=>'Unapply credit', desc=>'Enable "unapplication" of unclosed credits.' }, #aka unapplycredits - { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments.' }, #aka. deletecredits Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted. + { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments.' }, 'View refunds', { rightname=>'Post refund', desc=>'Enable posting of check and cash refunds.' }, 'Post check refund', diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 1714c575a..5c4774ab5 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1038,16 +1038,6 @@ my $validate_email = sub { $_[0] =~ 'per_locale' => 1, }, - { - 'key' => 'deletecredits', - #not actually deprecated yet - #'section' => 'deprecated', - #'description' => 'DEPRECATED, now controlled by ACLs. Used to enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted.', - 'section' => '', - 'description' => 'One or more comma-separated email addresses to be notified when a credit is deleted.', - 'type' => [qw( checkbox text )], - }, - { 'key' => 'deleterefunds', 'section' => 'billing', @@ -2710,14 +2700,6 @@ and customer address. Include units.', 'type' => 'text', }, - { - 'key' => 'dump-email_to', - 'section' => '', - 'description' => "Optional email address to send success/failure message for database dumps.", - 'type' => 'text', - 'validate' => $validate_email, - }, - { 'key' => 'credit_card-recurring_billing_flag', 'section' => 'billing', @@ -3778,11 +3760,12 @@ and customer address. Include units.', 'select_enum' => [ 'approve', 'decline' ], }, + # replaces batch-errors_to (sent email on error) { - 'key' => 'batch-errors_to', + 'key' => 'batch-errors_not_fatal', 'section' => 'billing', - 'description' => 'Email errors when processing batches to this address. If unspecified, batch processing will stop immediately on error.', - 'type' => 'text', + 'description' => 'If checked, when importing batches from a gateway, item errors will be recorded in the system log without aborting processing. If unchecked, batch processing will fail on error.', + 'type' => 'checkbox', }, #lists could be auto-generated from pay_batch info @@ -4647,13 +4630,6 @@ and customer address. Include units.', 'type' => 'text', }, - { - 'key' => 'email_report-subject', - 'section' => '', - 'description' => 'Subject for reports emailed by freeside-fetch. Defaults to "Freeside report".', - 'type' => 'text', - }, - { 'key' => 'selfservice-head', 'section' => 'self-service', @@ -5780,13 +5756,6 @@ and customer address. Include units.', ], }, - { - 'key' => 'agent-email_day', - 'section' => '', - 'description' => 'On this day of each month, agents with master customer records containing email addresses will be emailed a list of their customers and balances.', - 'type' => 'text', - }, - { 'key' => 'report-cust_pay-select_time', 'section' => 'UI', diff --git a/FS/FS/Cron/agent_email.pm b/FS/FS/Cron/agent_email.pm deleted file mode 100644 index 6bc1cc643..000000000 --- a/FS/FS/Cron/agent_email.pm +++ /dev/null @@ -1,79 +0,0 @@ -package FS::Cron::agent_email; -use base qw( Exporter ); - -use strict; -use vars qw( @EXPORT_OK $DEBUG ); -use Date::Simple qw(today); -use URI::Escape; -use FS::Mason qw( mason_interps ); -use FS::Conf; -use FS::Misc qw(send_email); -use FS::Record qw(qsearch);# qsearchs); -use FS::agent; - -@EXPORT_OK = qw ( agent_email ); -$DEBUG = 0; - -sub agent_email { - my %opt = @_; - - my $conf = new FS::Conf; - - my $day = $conf->config('agent-email_day') or return; - return unless $day == today->day; - - if ( 1 ) { #XXX if ( %%%RT_ENABLED%%% ) { - require RT; - RT::LoadConfig(); - RT::Init(); - RT::ConnectToDatabase(); - } - - my $from = $conf->invoice_from_full(); - - my $outbuf = '';; - my( $fs_interp, $rt_interp ) = mason_interps('standalone', 'outbuf'=>\$outbuf); - - my $comp = '/search/cust_main.html'; - my %args = ( - 'cust_fields' => 'Cust# | Cust. Status | Customer | Current Balance', - '_type' => 'html-print', - ); - my $query = join('&', map "$_=".uri_escape($args{$_}), keys %args ); - - my $extra_sql = $opt{a} ? " AND agentnum IN ( $opt{a} ) " : ''; - - foreach my $agent ( qsearch({ - 'table' => 'agent', - 'hashref' => { - 'disabled' => '', - 'agent_custnum' => { op=>'!=', value=>'' }, - }, - 'extra_sql' => $extra_sql, - }) - ) - { - - $FS::Mason::Request::QUERY_STRING = $query. '&agentnum='. $agent->agentnum; - $fs_interp->exec($comp); - - my @email = $agent->agent_cust_main->invoicing_list or next; - - warn "emailing ". join(',',@email). " for agent ". $agent->agent. "\n" - if $DEBUG; - send_email( - 'from' => $from, - 'to' => \@email, - 'subject' => 'Customer report', - 'body' => $outbuf, - 'content-type' => 'text/html', - #'content-encoding' - ); - - $outbuf = ''; - - } - -} - -1; diff --git a/FS/FS/Cron/backup.pm b/FS/FS/Cron/backup.pm index cfc8e3624..a192ca90e 100644 --- a/FS/FS/Cron/backup.pm +++ b/FS/FS/Cron/backup.pm @@ -6,7 +6,7 @@ use Exporter; use File::Copy; use Date::Format; use FS::UID qw(driver_name datasrc); -use FS::Misc qw( send_email ); +use FS::Log @ISA = qw( Exporter ); @EXPORT_OK = qw( backup ); @@ -20,7 +20,7 @@ sub backup { my $filename = time2str('%Y%m%d%H%M%S',time); datasrc =~ /dbname=([\w\.]+)$/ - or backup_email_and_die($conf,$filename,"unparsable datasrc ". datasrc); + or backup_log_and_die($filename,"unparsable datasrc ". datasrc); my $database = $1; my $ext; @@ -31,70 +31,61 @@ sub backup { system("mysqldump $database >/var/tmp/$database.sql"); $ext = 'sql'; } else { - backup_email_and_die($conf,$filename,"database dumps not yet supported for ". driver_name); + backup_log_and_die($filename,"database dumps not yet supported for ". driver_name); } chmod 0600, "/var/tmp/$database.$ext"; if ( $conf->config('dump-pgpid') ) { eval 'use GnuPG;'; - backup_email_and_die($conf,$filename,$@) if $@; + backup_log_and_die($filename,$@) if $@; my $gpg = new GnuPG; $gpg->encrypt( plaintext => "/var/tmp/$database.$ext", output => "/var/tmp/$database.gpg", recipient => $conf->config('dump-pgpid'), ); unlink "/var/tmp/$database.$ext" - or backup_email_and_die($conf,$filename,$!); + or backup_log_and_die($filename,$!); chmod 0600, "/var/tmp/$database.gpg"; $ext = 'gpg'; } if ( $localdest ) { copy("/var/tmp/$database.$ext", "$localdest/$filename.$ext") - or backup_email_and_die($conf,$filename,$!); + or backup_log_and_die($filename,$!); chmod 0600, "$localdest/$filename.$ext"; } if ( $scpdest ) { eval "use Net::SCP qw(scp);"; - backup_email_and_die($conf,$filename,$@) if $@; + backup_log_and_die($filename,$@) if $@; scp("/var/tmp/$database.$ext", "$scpdest/$filename.$ext"); } - unlink "/var/tmp/$database.$ext" or backup_email_and_die($conf,$filename,$!); #or just warn? + unlink "/var/tmp/$database.$ext" or backup_log_and_die($filename,$!); #or just warn? - backup_email($conf,$filename); + backup_log($filename); } -#runs backup_email and dies with same error message -sub backup_email_and_die { - my ($conf,$filename,$error) = @_; - backup_email($conf,$filename,$error); - warn "backup_email_and_die called without error message" unless $error; +#runs backup_log and dies with same error message +sub backup_log_and_die { + my ($filename,$error) = @_; + $error = "backup_log_and_die called without error message" unless $error; + backup_log($filename,$error); die $error; } -#checks if email should be sent, sends it -sub backup_email { - my ($conf,$filename,$error) = @_; - my $to = $conf->config('dump-email_to'); - return unless $to; - my $result = $error ? 'FAILED' : 'succeeded'; - my $email_error = send_email( - 'from' => $conf->config('invoice_from'), #or whatever, don't think it matters - 'to' => $to, - 'subject' => 'FREESIDE NOTIFICATION: Backup ' . $result, - 'body' => [ - "This is an automatic message from your Freeside installation.\n", - "Freeside backup $filename $result", - ($error ? " with the following error:\n\n" : "\n"), - ($error || ''), - "\n", - ], - 'msgtype' => 'admin', - ); - warn $email_error if $email_error; +#logs result +sub backup_log { + my ($filename,$error) = @_; + my $result = $error ? "FAILED: $error" : 'succeeded'; + my $message = "backup $filename $result\n"; + my $log = FS::Log->new('Cron::backup'); + if ($error) { + $log->error($message); + } else { + $log->info($message); + } return; } diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index ffc04bab7..263230b34 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -154,6 +154,12 @@ If you need to continue using the old Form 477 report, turn on the $conf->set('previous_balance-exclude_from_total', ''); } + # switch from specifying an email address to boolean check + if ( $conf->exists('batch-errors_to') ) { + $conf->touch('batch-errors_not_fatal'); + $conf->delete('batch-errors_to'); + } + enable_banned_pay_pad() unless length($conf->config('banned_pay-pad')); } diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 544a0e83d..31adebec1 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -9,7 +9,6 @@ use vars qw( $conf $unsuspendauto $me $DEBUG use List::Util qw( min ); use Date::Format; use FS::UID qw( dbh ); -use FS::Misc qw(send_email); use FS::Record qw( qsearch qsearchs dbdef ); use FS::CurrentUser; use FS::cust_pkg; @@ -277,35 +276,6 @@ sub delete { return $error; } - if ( !$opt{void} and $conf->config('deletecredits') ne '' ) { - - my $cust_main = $self->cust_main; - - my $error = send_email( - 'from' => $conf->invoice_from_full($self->cust_main->agentnum), - #invoice_from??? well as good as any - 'to' => $conf->config('deletecredits'), - 'subject' => 'FREESIDE NOTIFICATION: Credit deleted', - 'body' => [ - "This is an automatic message from your Freeside installation\n", - "informing you that the following credit has been deleted:\n", - "\n", - 'crednum: '. $self->crednum. "\n", - 'custnum: '. $self->custnum. - " (". $cust_main->last. ", ". $cust_main->first. ")\n", - 'amount: $'. sprintf("%.2f", $self->amount). "\n", - 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n", - 'reason: '. $self->reason. "\n", - ], - ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't send credit deletion notification: $error"; - } - - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -415,7 +385,7 @@ sub void { return $error; } - $error = $self->delete(void => 1); # suppress deletecredits warning + $error = $self->delete(); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm index 403829ac2..bd142471c 100644 --- a/FS/FS/log_context.pm +++ b/FS/FS/log_context.pm @@ -9,7 +9,9 @@ my @contexts = ( qw( bill_and_collect FS::cust_main::Billing::bill_and_collect FS::cust_main::Billing::bill + FS::pay_batch::import_from_gateway Cron::bill + Cron::backup Cron::upload spool_upload daily diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index 2a522b46e..d7dd7bbe4 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -10,10 +10,10 @@ use Time::Local; use Text::CSV_XS; use Date::Parse qw(str2time); use Business::CreditCard qw(cardtype); -use FS::Misc qw(send_email); # for error notification use FS::Record qw( dbh qsearch qsearchs ); use FS::Conf; use FS::cust_pay; +use FS::Log; =head1 NAME @@ -567,8 +567,8 @@ sub import_from_gateway { ); my @item_errors; - my $mail_on_error = $conf->config('batch-errors_to'); - if ( $mail_on_error ) { + my $errors_not_fatal = $conf->config('batch-errors_not_fatal'); + if ( $errors_not_fatal ) { # construct error trap $proc_opt{'on_parse_error'} = sub { my ($self, $line, $error) = @_; @@ -801,15 +801,10 @@ sub import_from_gateway { "Errors during batch import: ".scalar(@item_errors), @item_errors ); - if ( $mail_on_error ) { - my $subject = "Batch import errors"; #? - my $body = "Import from gateway ".$gateway->label."\n".$error_text; - send_email( - to => $mail_on_error, - from => $conf->invoice_from_full(), - subject => $subject, - body => $body, - ); + if ( $errors_not_fatal ) { + my $message = "Import from gateway ".$gateway->label." errors: ".$error_text; + my $log = FS::Log->new('FS::pay_batch::import_from_gateway'); + $log->error($message); } else { # Bail out. $dbh->rollback if $oldAutoCommit; diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index cb018d1df..6a2daf934 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -79,10 +79,6 @@ pay_batch_receive(%opt); use FS::Cron::export_batch qw(export_batch_submit); export_batch_submit(%opt); -#you can skip this by not having the config -use FS::Cron::agent_email qw(agent_email); -agent_email(%opt); - #clears out cacti imports & deletes select database cache files use FS::Cron::cleanup qw( cleanup cleanup_before_backup ); cleanup_before_backup(); diff --git a/FS/bin/freeside-fetch b/FS/bin/freeside-fetch deleted file mode 100755 index c1ab78373..000000000 --- a/FS/bin/freeside-fetch +++ /dev/null @@ -1,93 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use LWP::UserAgent; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearchs); -use FS::Misc qw(send_email); - -my $user = shift or die &usage; -my $employeelist = shift or die &usage; -my $url = shift or die &usage; -adminsuidsetup $user; - -my @employees = split ',', $employeelist; - -foreach my $employee (@employees) { - - $employee =~ /^(\w+)$/; - - my $access_user = qsearchs( 'access_user', { 'username' => $1 } ); - unless ($access_user) { - warn "Can't find employee $employee... skipping"; - next; - } - - my $email_address = $access_user->option('email_address'); - unless ($email_address) { - warn "No email address for $employee... skipping"; - next; - } - - no warnings 'redefine'; - local *LWP::UserAgent::get_basic_credentials = sub { - return ($access_user->username, $access_user->_password); - }; - - my $ua = new LWP::UserAgent; - $ua->timeout(1800); #30m, some reports can take a while - $ua->agent("FreesideFetcher/0.1 " . $ua->agent); - - my $req = new HTTP::Request GET => $url; - my $res = $ua->request($req); - - my $conf = new FS::Conf; - my $subject = $conf->config('email_report-subject') || 'Freeside report'; - - my %options = ( 'from' => $email_address, - 'to' => $email_address, - 'subject' => $subject, - 'body' => $res->content, - ); - - $options{'content-type'} = $res->content_type - if $res->content_type; - $options{'content-encoding'} = $res->content_encoding - if $res->content_encoding; - - if ($res->is_success) { - send_email %options; - }else{ - warn "fetching $url failed for $employee: " . $res->status_line; - } -} - -sub usage { - die "Usage:\n\n freeside-fetch user employee[,employee ...] url\n\n"; -} - -=head1 NAME - -freeside-fetch - Send a freeside page to a list of employees. - -=head1 SYNOPSIS - - freeside-fetch user employee[,employee ...] url - -=head1 DESCRIPTION - - Fetches a web page specified by url as if employee and emails it to - employee. Useful when run out of cron to send freeside web pages. - - user: Freeside user - - employee: the username of an employee to receive the emailed page. May be a comma separated list - - url: the web page to be received - -=head1 BUGS - - Can leak employee usernames and passwords if requested to access inappropriate urls. - -=cut - -- cgit v1.2.1 From 7427404751de534a767b44541f93915b35477116 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 23 Sep 2015 10:50:24 -0700 Subject: fix searches for cust_pay events, RT#35167 --- FS/FS/cust_event.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index f299f9377..c35e1185b 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -302,7 +302,7 @@ sub join_sql { JOIN part_event USING ( eventpart ) LEFT JOIN cust_bill ON ( eventtable = 'cust_bill' AND tablenum = invnum ) LEFT JOIN cust_pkg ON ( eventtable = 'cust_pkg' AND tablenum = pkgnum ) - + LEFT JOIN cust_pay ON ( eventtable = 'cust_pay' AND tablenum = paynum ) LEFT JOIN cust_svc ON ( eventtable = 'svc_acct' AND tablenum = svcnum ) LEFT JOIN cust_pkg AS cust_pkg_for_svc ON ( cust_svc.pkgnum = cust_pkg_for_svc.pkgnum ) LEFT JOIN cust_main ON ( ( eventtable = 'cust_main' AND tablenum = cust_main.custnum ) -- cgit v1.2.1 From 60ca6141ee3efd2479dc89615504433a0d950356 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 23 Sep 2015 10:51:29 -0700 Subject: fix searches for cust_pay events, RT#35167 --- FS/FS/cust_event.pm | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index c35e1185b..1d8af1e6e 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -9,6 +9,7 @@ use FS::Record qw( qsearch qsearchs dbdef ); use FS::cust_main; use FS::cust_pkg; use FS::cust_bill; +use FS::cust_pay; use FS::svc_acct; $DEBUG = 0; @@ -305,11 +306,13 @@ sub join_sql { LEFT JOIN cust_pay ON ( eventtable = 'cust_pay' AND tablenum = paynum ) LEFT JOIN cust_svc ON ( eventtable = 'svc_acct' AND tablenum = svcnum ) LEFT JOIN cust_pkg AS cust_pkg_for_svc ON ( cust_svc.pkgnum = cust_pkg_for_svc.pkgnum ) - LEFT JOIN cust_main ON ( ( eventtable = 'cust_main' AND tablenum = cust_main.custnum ) - OR ( eventtable = 'cust_bill' AND cust_bill.custnum = cust_main.custnum ) - OR ( eventtable = 'cust_pkg' AND cust_pkg.custnum = cust_main.custnum ) - OR ( eventtable = 'svc_acct' AND cust_pkg_for_svc.custnum = cust_main.custnum ) - ) + LEFT JOIN cust_main ON ( + ( eventtable = 'cust_main' AND tablenum = cust_main.custnum ) + OR ( eventtable = 'cust_bill' AND cust_bill.custnum = cust_main.custnum ) + OR ( eventtable = 'cust_pkg' AND cust_pkg.custnum = cust_main.custnum ) + OR ( eventtable = 'cust_pay' AND cust_pay.custnum = cust_main.custnum ) + OR ( eventtable = 'svc_acct' AND cust_pkg_for_svc.custnum = cust_main.custnum ) + ) "; } @@ -389,6 +392,11 @@ sub search_sql_where { "tablenum = '$1'"; } + if ( $param->{'paynum'} =~ /^(\d+)$/ ) { + push @search, "part_event.eventtable = 'cust_pay'", + "tablenum = '$1'"; + } + if ( $param->{'svcnum'} =~ /^(\d+)$/ ) { push @search, "part_event.eventtable = 'svc_acct'", "tablenum = '$1'"; -- cgit v1.2.1 From 1c83c4c02ba6d35ffbabe71bfd4cf6e70afbb894 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 23 Sep 2015 13:16:34 -0700 Subject: import a2billing username as charged_party, RT#32909 --- FS/bin/freeside-cdr-a2billing-import | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-cdr-a2billing-import b/FS/bin/freeside-cdr-a2billing-import index 923f5fbb1..a8469e744 100755 --- a/FS/bin/freeside-cdr-a2billing-import +++ b/FS/bin/freeside-cdr-a2billing-import @@ -91,7 +91,7 @@ my %disposition = ( ); my @cols = ( - 'cc_call.id as id', 'cc_card.username as username', + "$table.id as id", 'cc_card.username as username', qw( sessionid starttime stoptime sessiontime real_sessiontime terminatecauseid @@ -101,6 +101,7 @@ my @cols = ( ); my $sql = 'SELECT '.join(',', @cols). " FROM $table". + " LEFT JOIN cc_card ON ( $table.card_id = cc_card.id ) ". ' WHERE freesidestatus IS NULL' . ($start && " AND starttime >= '$start'") . ($end && " AND starttime < '$end'") ; -- cgit v1.2.1 From c34a48fd2107adbc7ea08cf3aae007d70ec60b61 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Wed, 23 Sep 2015 23:56:32 -0500 Subject: RT#37908: Convert existing email-sending code to use common interface [removed template confs] --- FS/FS/Conf.pm | 104 +------------------ FS/FS/Cron/notify.pm | 9 -- FS/FS/cust_main.pm | 170 +++++++++++++++---------------- FS/FS/cust_main/Billing_Realtime.pm | 27 +---- FS/FS/cust_pkg.pm | 11 -- FS/FS/msg_template.pm | 13 ++- FS/FS/svc_acct.pm | 194 ++++++------------------------------ 7 files changed, 127 insertions(+), 401 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 5c4774ab5..db7dbd04d 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -2354,13 +2354,6 @@ and customer address. Include units.', %msg_template_options, }, - { - 'key' => 'declinetemplate', - 'section' => 'deprecated', - 'description' => 'Template file for credit card and electronic check decline emails.', - 'type' => 'textarea', - }, - { 'key' => 'emaildecline', 'section' => 'notification', @@ -2384,20 +2377,6 @@ and customer address. Include units.', %msg_template_options, }, - { - 'key' => 'cancelmessage', - 'section' => 'deprecated', - 'description' => 'Template file for cancellation emails.', - 'type' => 'textarea', - }, - - { - 'key' => 'cancelsubject', - 'section' => 'deprecated', - 'description' => 'Subject line for cancellation emails.', - 'type' => 'text', - }, - { 'key' => 'emailcancel', 'section' => 'notification', @@ -2521,39 +2500,6 @@ and customer address. Include units.', 'multiple' => 1, }, - { - 'key' => 'welcome_email', - 'section' => 'deprecated', - 'description' => 'Template file for welcome email. Welcome emails are sent to the customer email invoice destination(s) each time a svc_acct record is created.', - 'type' => 'textarea', - 'per_agent' => 1, - }, - - { - 'key' => 'welcome_email-from', - 'section' => 'deprecated', - 'description' => 'From: address header for welcome email', - 'type' => 'text', - 'per_agent' => 1, - }, - - { - 'key' => 'welcome_email-subject', - 'section' => 'deprecated', - 'description' => 'Subject: header for welcome email', - 'type' => 'text', - 'per_agent' => 1, - }, - - { - 'key' => 'welcome_email-mimetype', - 'section' => 'deprecated', - 'description' => 'MIME type for welcome email', - 'type' => 'select', - 'select_enum' => [ 'text/plain', 'text/html' ], - 'per_agent' => 1, - }, - { 'key' => 'welcome_letter', 'section' => '', @@ -2561,47 +2507,11 @@ and customer address. Include units.', 'type' => 'textarea', }, -# { -# 'key' => 'warning_msgnum', -# 'section' => 'notification', -# 'description' => 'Template to use for warning messages, sent to the customer email invoice destination(s) when a svc_acct record has its usage drop below a threshold.', -# %msg_template_options, -# }, - - { - 'key' => 'warning_email', - 'section' => 'notification', - 'description' => 'Template file for warning email. Warning emails are sent to the customer email invoice destination(s) each time a svc_acct record has its usage drop below a threshold or 0. See the Text::Template documentation for details on the template substitution language. The following variables are available
  • $username
  • $password
  • $first
  • $last
  • $pkg
  • $column
  • $amount
  • $threshold
', - 'type' => 'textarea', - }, - - { - 'key' => 'warning_email-from', - 'section' => 'notification', - 'description' => 'From: address header for warning email', - 'type' => 'text', - }, - { - 'key' => 'warning_email-cc', + 'key' => 'threshold_warning_msgnum', 'section' => 'notification', - 'description' => 'Additional recipient(s) (comma separated) for warning email when remaining usage reaches zero.', - 'type' => 'text', - }, - - { - 'key' => 'warning_email-subject', - 'section' => 'notification', - 'description' => 'Subject: header for warning email', - 'type' => 'text', - }, - - { - 'key' => 'warning_email-mimetype', - 'section' => 'notification', - 'description' => 'MIME type for warning email', - 'type' => 'select', - 'select_enum' => [ 'text/plain', 'text/html' ], + 'description' => 'Template to use for warning messages sent to the customer email invoice destination(s) when a svc_acct record has its usage drop below a threshold. Extra substitutions available: $column, $amount, $threshold', + %msg_template_options, }, { @@ -4064,14 +3974,6 @@ and customer address. Include units.', %msg_template_options, }, - { - 'key' => 'impending_recur_template', - 'section' => 'deprecated', - 'description' => 'Template file for alerts about looming first time recurrant billing. See the Text::Template documentation for details on the template substitition language. Also see packages with a flat price plan The following variables are available
  • $packages allowing $packages->[0] thru $packages->[n]
  • $package the first package, same as $packages->[0]
  • $recurdates allowing $recurdates->[0] thru $recurdates->[n]
  • $recurdate the first recurdate, same as $recurdate->[0]
  • $first
  • $last
', -#
  • $payby
  • $expdate most likely only confuse - 'type' => 'textarea', - }, - { 'key' => 'logo.png', 'section' => 'UI', #'invoicing' ? diff --git a/FS/FS/Cron/notify.pm b/FS/FS/Cron/notify.pm index 6d7065429..34977c8e6 100644 --- a/FS/FS/Cron/notify.pm +++ b/FS/FS/Cron/notify.pm @@ -111,15 +111,6 @@ END $error = $msg_template->send('cust_main' => $cust_main, 'object' => $cust_main); } - else { - $error = $cust_main->notify( 'impending_recur_template', - 'extra_fields' => { 'packages' => \@packages, - 'recurdates' => \@recurdates, - 'package' => $packages[0], - 'recurdate' => $recurdates[0], - }, - ); - } #if $msgnum warn "Error notifying, custnum ". $cust_main->custnum. ": $error" if $error; unless ($error) { diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index c636408d8..6afbd1cf5 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -32,7 +32,7 @@ use Locale::Country; use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Cursor; -use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty ); +use FS::Misc qw( generate_ps do_print money_pretty ); use FS::Msgcat qw(gettext); use FS::CurrentUser; use FS::TicketSystem; @@ -4574,102 +4574,102 @@ sub search { =over 4 -=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS +#=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS -Deprecated. Use event notification and message templates -(L) instead. +#Deprecated. Use event notification and message templates +#(L) instead. -Sends a templated email notification to the customer (see L). +#Sends a templated email notification to the customer (see L). -OPTIONS is a hash and may include - -I - the email sender (default is invoice_from) +#OPTIONS is a hash and may include -I - comma-separated scalar or arrayref of recipients - (default is invoicing_list) +#I - the email sender (default is invoice_from) -I - The subject line of the sent email notification - (default is "Notice from company_name") +#I - comma-separated scalar or arrayref of recipients +# (default is invoicing_list) -I - a hashref of name/value pairs which will be substituted - into the template +#I - The subject line of the sent email notification +# (default is "Notice from company_name") -The following variables are vavailable in the template. +#I - a hashref of name/value pairs which will be substituted +# into the template -I<$first> - the customer first name -I<$last> - the customer last name -I<$company> - the customer company -I<$payby> - a description of the method of payment for the customer - # would be nice to use FS::payby::shortname -I<$payinfo> - the account information used to collect for this customer -I<$expdate> - the expiration of the customer payment in seconds from epoch - -=cut - -sub notify { - my ($self, $template, %options) = @_; +#The following variables are vavailable in the template. - return unless $conf->exists($template); +#I<$first> - the customer first name +#I<$last> - the customer last name +#I<$company> - the customer company +#I<$payby> - a description of the method of payment for the customer +# # would be nice to use FS::payby::shortname +#I<$payinfo> - the account information used to collect for this customer +#I<$expdate> - the expiration of the customer payment in seconds from epoch - my $from = $conf->invoice_from_full($self->agentnum) - if $conf->exists('invoice_from', $self->agentnum); - $from = $options{from} if exists($options{from}); - - my $to = join(',', $self->invoicing_list_emailonly); - $to = $options{to} if exists($options{to}); - - my $subject = "Notice from " . $conf->config('company_name', $self->agentnum) - if $conf->exists('company_name', $self->agentnum); - $subject = $options{subject} if exists($options{subject}); - - my $notify_template = new Text::Template (TYPE => 'ARRAY', - SOURCE => [ map "$_\n", - $conf->config($template)] - ) - or die "can't create new Text::Template object: Text::Template::ERROR"; - $notify_template->compile() - or die "can't compile template: Text::Template::ERROR"; - - $FS::notify_template::_template::company_name = - $conf->config('company_name', $self->agentnum); - $FS::notify_template::_template::company_address = - join("\n", $conf->config('company_address', $self->agentnum) ). "\n"; - - my $paydate = $self->paydate || '2037-12-31'; - $FS::notify_template::_template::first = $self->first; - $FS::notify_template::_template::last = $self->last; - $FS::notify_template::_template::company = $self->company; - $FS::notify_template::_template::payinfo = $self->mask_payinfo; - my $payby = $self->payby; - my ($payyear,$paymonth,$payday) = split (/-/,$paydate); - my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); - - #credit cards expire at the end of the month/year of their exp date - if ($payby eq 'CARD' || $payby eq 'DCRD') { - $FS::notify_template::_template::payby = 'credit card'; - ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); - $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); - $expire_time--; - }elsif ($payby eq 'COMP') { - $FS::notify_template::_template::payby = 'complimentary account'; - }else{ - $FS::notify_template::_template::payby = 'current method'; - } - $FS::notify_template::_template::expdate = $expire_time; - - for (keys %{$options{extra_fields}}){ - no strict "refs"; - ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_}; - } +#=cut - send_email(from => $from, - to => $to, - subject => $subject, - body => $notify_template->fill_in( PACKAGE => - 'FS::notify_template::_template' ), - ); +#sub notify { +# my ($self, $template, %options) = @_; + +# return unless $conf->exists($template); + +# my $from = $conf->invoice_from_full($self->agentnum) +# if $conf->exists('invoice_from', $self->agentnum); +# $from = $options{from} if exists($options{from}); + +# my $to = join(',', $self->invoicing_list_emailonly); +# $to = $options{to} if exists($options{to}); +# +# my $subject = "Notice from " . $conf->config('company_name', $self->agentnum) +# if $conf->exists('company_name', $self->agentnum); +# $subject = $options{subject} if exists($options{subject}); + +# my $notify_template = new Text::Template (TYPE => 'ARRAY', +# SOURCE => [ map "$_\n", +# $conf->config($template)] +# ) +# or die "can't create new Text::Template object: Text::Template::ERROR"; +# $notify_template->compile() +# or die "can't compile template: Text::Template::ERROR"; + +# $FS::notify_template::_template::company_name = +# $conf->config('company_name', $self->agentnum); +# $FS::notify_template::_template::company_address = +# join("\n", $conf->config('company_address', $self->agentnum) ). "\n"; + +# my $paydate = $self->paydate || '2037-12-31'; +# $FS::notify_template::_template::first = $self->first; +# $FS::notify_template::_template::last = $self->last; +# $FS::notify_template::_template::company = $self->company; +# $FS::notify_template::_template::payinfo = $self->mask_payinfo; +# my $payby = $self->payby; +# my ($payyear,$paymonth,$payday) = split (/-/,$paydate); +# my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); + +# #credit cards expire at the end of the month/year of their exp date +# if ($payby eq 'CARD' || $payby eq 'DCRD') { +# $FS::notify_template::_template::payby = 'credit card'; +# ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); +# $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); +# $expire_time--; +# }elsif ($payby eq 'COMP') { +# $FS::notify_template::_template::payby = 'complimentary account'; +# }else{ +# $FS::notify_template::_template::payby = 'current method'; +# } +# $FS::notify_template::_template::expdate = $expire_time; + +# for (keys %{$options{extra_fields}}){ +# no strict "refs"; +# ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_}; +# } + +# send_email(from => $from, +# to => $to, +# subject => $subject, +# body => $notify_template->fill_in( PACKAGE => +# 'FS::notify_template::_template' ), +# ); -} +#} =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index fda3ae040..c6b3b3180 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -8,7 +8,6 @@ use Data::Dumper; use Business::CreditCard 0.28; use FS::UID qw( dbh ); use FS::Record qw( qsearch qsearchs ); -use FS::Misc qw( send_email ); use FS::payby; use FS::cust_pay; use FS::cust_pay_pending; @@ -1121,31 +1120,7 @@ sub _realtime_bop_result { $error = $msg_template->send( 'cust_main' => $self, 'object' => $cust_pay_pending ); } - else { #!$msgnum - - my @templ = $conf->config('declinetemplate'); - my $template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @templ ], - ) or return "($perror) can't create template: $Text::Template::ERROR"; - $template->compile() - or return "($perror) can't compile template: $Text::Template::ERROR"; - - my $templ_hash = { - 'company_name' => - scalar( $conf->config('company_name', $self->agentnum ) ), - 'company_address' => - join("\n", $conf->config('company_address', $self->agentnum ) ), - 'error' => $transaction->error_message, - }; - - my $error = send_email( - 'from' => $conf->invoice_from_full( $self->agentnum ), - 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], - 'subject' => 'Your payment could not be processed', - 'body' => [ $template->fill_in(HASH => $templ_hash) ], - ); - } + $perror .= " (also received error sending decline notification: $error)" if $error; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 0ef7aa0fa..279205b19 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -13,7 +13,6 @@ use Tie::IxHash; use Time::Local qw( timelocal timelocal_nocheck ); use MIME::Entity; use FS::UID qw( dbh driver_name ); -use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs fields ); use FS::CurrentUser; use FS::cust_svc; @@ -1057,16 +1056,6 @@ sub cancel { $error = $msg_template->send( 'cust_main' => $self->cust_main, 'object' => $self ); } - else { - $error = send_email( - 'from' => $conf->invoice_from_full( $self->cust_main->agentnum ), - 'to' => \@invoicing_list, - 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), - 'body' => [ map "$_\n", $conf->config('cancelmessage') ], - 'custnum' => $self->custnum, - 'msgtype' => '', #admin? - ); - } #should this do something on errors? } diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index 4c2ac4bd4..49403889c 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -94,6 +94,7 @@ sub _rebless { my $class = 'FS::msg_template::' . $self->msgclass; eval "use $class;"; bless($self, $class) unless $@; + warn "Error loading msg_template msgclass: " . $@ if $@; #or die? # merge in the extension fields (but let fields in $self override them) # except don't ever override the extension's primary key, it's immutable @@ -657,20 +658,22 @@ sub _upgrade_data { [ 'decline_msgnum', 'declinetemplate', '', '', '' ], [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ], [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ], - [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ], - [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ], + [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '', 'welcome_email-mimetype' ], + [ 'threshold_warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', 'warning_email-cc', 'warning_email-mimetype' ], ); my @agentnums = ('', map {$_->agentnum} qsearch('agent', {})); foreach my $agentnum (@agentnums) { foreach (@fixes) { - my ($newname, $oldname, $subject, $from, $bcc) = @$_; + my ($newname, $oldname, $subject, $from, $bcc, $mimetype) = @$_; + if ($conf->exists($oldname, $agentnum)) { my $new = new FS::msg_template({ + 'msgclass' => 'email', 'msgname' => $oldname, 'agentnum' => $agentnum, 'from_addr' => ($from && $conf->config($from, $agentnum)) || '', - 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '', + 'bcc_addr' => ($bcc && $conf->config($bcc, $agentnum)) || '', 'subject' => ($subject && $conf->config($subject, $agentnum)) || '', 'mime_type' => 'text/html', 'body' => join('
    ',$conf->config($oldname, $agentnum)), @@ -681,6 +684,8 @@ sub _upgrade_data { $conf->delete($oldname, $agentnum); $conf->delete($from, $agentnum) if $from; $conf->delete($subject, $agentnum) if $subject; + $conf->delete($bcc, $agentnum) if $bcc; + $conf->delete($mimetype, $agentnum) if $mimetype; } } diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 0181b1e0e..f3070338b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -17,8 +17,7 @@ use vars qw( $DEBUG $me $conf $skip_fuzzyfiles $username_slash $username_equals $username_pound $username_exclamation $password_noampersand $password_noexclamation - $warning_template $warning_from $warning_subject $warning_mimetype - $warning_cc + $warning_msgnum $smtpmachine $radius_password $radius_ip $dirhash @@ -90,22 +89,7 @@ FS::UID->install_callback( sub { $password_noampersand = $conf->exists('password-noexclamation'); $password_noexclamation = $conf->exists('password-noexclamation'); $dirhash = $conf->config('dirhash') || 0; - if ( $conf->exists('warning_email') ) { - $warning_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", $conf->config('warning_email') ] - ) or warn "can't create warning email template: $Text::Template::ERROR"; - $warning_from = $conf->config('warning_email-from'); # || 'your-isp-is-dum' - $warning_subject = $conf->config('warning_email-subject') || 'Warning'; - $warning_mimetype = $conf->config('warning_email-mimetype') || 'text/plain'; - $warning_cc = $conf->config('warning_email-cc'); - } else { - $warning_template = ''; - $warning_from = ''; - $warning_subject = ''; - $warning_mimetype = ''; - $warning_cc = ''; - } + $warning_msgnum = $conf->config('threshold_warning_msgnum'); $smtpmachine = $conf->config('smtpmachine'); $radius_password = $conf->config('radius-password') || 'Password'; $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address'; @@ -737,83 +721,8 @@ sub insert { my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); $error = $msg_template->send('cust_main' => $cust_main, 'object' => $self); + #should this do something on error? } - else { #!$msgnum - my ($to,$welcome_template,$welcome_from,$welcome_subject,$welcome_subject_template,$welcome_mimetype) - = ('','','','','',''); - - if ( $conf->exists('welcome_email', $agentnum) ) { - $welcome_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", $conf->config('welcome_email', $agentnum) ] - ) or warn "can't create welcome email template: $Text::Template::ERROR"; - $welcome_from = $conf->config('welcome_email-from', $agentnum); - # || 'your-isp-is-dum' - $welcome_subject = $conf->config('welcome_email-subject', $agentnum) - || 'Welcome'; - $welcome_subject_template = new Text::Template ( - TYPE => 'STRING', - SOURCE => $welcome_subject, - ) or warn "can't create welcome email subject template: $Text::Template::ERROR"; - $welcome_mimetype = $conf->config('welcome_email-mimetype', $agentnum) - || 'text/plain'; - } - if ( $welcome_template ) { - my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list ); - if ( $to ) { - - my %hash = ( - 'custnum' => $self->custnum, - 'username' => $self->username, - 'password' => $self->_password, - 'first' => $cust_main->first, - 'last' => $cust_main->getfield('last'), - 'pkg' => $cust_pkg->part_pkg->pkg, - ); - my $wqueue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::send_email' - }; - my $error = $wqueue->insert( - 'to' => $to, - 'from' => $welcome_from, - 'subject' => $welcome_subject_template->fill_in( HASH => \%hash, ), - 'mimetype' => $welcome_mimetype, - 'body' => $welcome_template->fill_in( HASH => \%hash, ), - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error queuing welcome email: $error"; - } - - if ( $options{'depend_jobnum'} ) { - warn "$me depend_jobnum found; adding to welcome email dependancies" - if $DEBUG; - if ( ref($options{'depend_jobnum'}) ) { - warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ). - "to welcome email dependancies" - if $DEBUG; - push @jobnums, @{ $options{'depend_jobnum'} }; - } else { - warn "$me adding job $options{'depend_jobnum'} ". - "to welcome email dependancies" - if $DEBUG; - push @jobnums, $options{'depend_jobnum'}; - } - } - - foreach my $jobnum ( @jobnums ) { - my $error = $wqueue->depend_insert($jobnum); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error queuing welcome email job dependancy: $error"; - } - } - - } - - } # if $welcome_template - } # if !$msgnum } } # if $cust_pkg @@ -2119,23 +2028,17 @@ sub _op_usage { } } - if ($warning_template && &{$op2warncondition{$op}}($self, $column, $amount)) { + if ($warning_msgnum && &{$op2warncondition{$op}}($self, $column, $amount)) { my $wqueue = new FS::queue { 'svcnum' => $self->svcnum, 'job' => 'FS::svc_acct::reached_threshold', }; - my $to = ''; - if ($op eq '-'){ - $to = $warning_cc if &{$op2condition{$op}}($self, $column, $amount); - } - # x_threshold race my $error = $wqueue->insert( 'svcnum' => $self->svcnum, 'op' => $op, - 'column' => $column, - 'to' => $to, + 'column' => $column ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -2834,32 +2737,6 @@ sub _search_svc { =over 4 -=item send_email - -This is the FS::svc_acct job-queue-able version. It still uses -FS::Misc::send_email under-the-hood. - -=cut - -sub send_email { - my %opt = @_; - - eval "use FS::Misc qw(send_email)"; - die $@ if $@; - - $opt{mimetype} ||= 'text/plain'; - $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; - - my $error = send_email( - 'from' => $opt{from}, - 'to' => $opt{to}, - 'subject' => $opt{subject}, - 'content-type' => $opt{mimetype}, - 'body' => [ map "$_\n", split("\n", $opt{body}) ], - ); - die $error if $error; -} - =item check_and_rebuild_fuzzyfiles =cut @@ -2973,46 +2850,33 @@ sub reached_threshold { my $error = $svc_acct->replace; die $error if $error; # email next time, i guess - if ( $warning_template ) { - eval "use FS::Misc qw(send_email)"; - die $@ if $@; + if ( $warning_msgnum ) { - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - my $cust_main = $cust_pkg->cust_main; + my $msg_template = qsearchs('msg_template',{ msgnum => $warning_msgnum }); + die "Could not load template for threshold_warning_msgnum ($warning_msgnum)" unless $msg_template; - my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } - $cust_main->invoicing_list, - ($opt{'to'} ? $opt{'to'} : ()) - ); - - my $mimetype = $warning_mimetype; - $mimetype .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; - - my $body = $warning_template->fill_in( HASH => { - 'custnum' => $cust_main->custnum, - 'username' => $svc_acct->username, - 'password' => $svc_acct->_password, - 'first' => $cust_main->first, - 'last' => $cust_main->getfield('last'), - 'pkg' => $cust_pkg->part_pkg->pkg, - 'column' => $opt{'column'}, - 'amount' => $opt{'column'} =~/bytes/ - ? FS::UI::bytecount::display_bytecount($svc_acct->getfield($opt{'column'})) - : $svc_acct->getfield($opt{'column'}), - 'threshold' => $opt{'column'} =~/bytes/ - ? FS::UI::bytecount::display_bytecount($threshold) - : $threshold, - } ); - - - my $error = send_email( - 'from' => $warning_from, - 'to' => $to, - 'subject' => $warning_subject, - 'content-type' => $mimetype, - 'body' => [ map "$_\n", split("\n", $body) ], + my $cust_main = $svc_acct->cust_svc->cust_pkg->cust_main; + + my $to = join(', ', $cust_main->invoicing_list_emailonly ); + + my $error = $msg_template->send( + cust_main => $cust_main, + object => $svc_acct, + to => $to, + substitutions => { + # have to override these, because we changed threshold above + 'column' => $opt{'column'}, + 'amount' => $opt{'column'} =~/bytes/ + ? FS::UI::bytecount::display_bytecount($svc_acct->getfield($opt{'column'})) + : $svc_acct->getfield($opt{'column'}), + 'threshold' => $opt{'column'} =~/bytes/ + ? FS::UI::bytecount::display_bytecount($threshold) + : $threshold, + }, ); - die $error if $error; + + die "Error sending threshold warning email: $error" if $error; + } }else{ die "unknown op: " . $opt{'op'}; -- cgit v1.2.1 From 1cfc3ea3efb8c75388ad344ea9481f6f8df072b9 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Fri, 25 Sep 2015 17:06:44 -0500 Subject: RT#37908: Convert existing email-sending code to use common interface [switched jobs to use cust_msg::process_send, bug fix to http] --- FS/FS/Conf.pm | 7 ----- FS/FS/Misc.pm | 28 ------------------- FS/FS/contact.pm | 8 ++++-- FS/FS/cust_pay.pm | 69 ++++++++++------------------------------------ FS/FS/msg_template/http.pm | 2 +- 5 files changed, 21 insertions(+), 93 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index db7dbd04d..26dbbcd23 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1662,13 +1662,6 @@ and customer address. Include units.', 'per_agent' => 1, }, - { - 'key' => 'payment_receipt_email', - 'section' => 'deprecated', - 'description' => 'Template file for payment receipts. Payment receipts are sent to the customer email invoice destination(s) when a payment is received.', - 'type' => [qw( checkbox textarea )], - }, - { 'key' => 'payment_receipt-trigger', 'section' => 'notification', diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index e1f654c34..d06653edd 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -413,34 +413,6 @@ sub generate_email { } -=item process_send_email OPTION => VALUE ... - -Takes arguments as per generate_email() and sends the message. This -will die on any error and can be used in the job queue. - -=cut - -sub process_send_email { - my %message = @_; - my $error = send_email(generate_email(%message)); - die "$error\n" if $error; - ''; -} - -=item process_send_generated_email OPTION => VALUE ... - -Takes arguments as per send_email() and sends the message. This -will die on any error and can be used in the job queue. - -=cut - -sub process_send_generated_email { - my %args = @_; - my $error = send_email(%args); - die "$error\n" if $error; - ''; -} - =item send_fax OPTION => VALUE ... Options: diff --git a/FS/FS/contact.pm b/FS/FS/contact.pm index 38b7fd7b7..612048022 100644 --- a/FS/FS/contact.pm +++ b/FS/FS/contact.pm @@ -837,6 +837,7 @@ sub send_reset_email { #die "selfservice-password_reset_msgnum unset" unless $msgnum; return { 'error' => "selfservice-password_reset_msgnum unset" } unless $msgnum; my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } ); + return { 'error' => "selfservice-password_reset_msgnum cannot be loaded" } unless $msg_template; my %msg_template = ( 'to' => join(',', map $_->emailaddress, @contact_email ), 'cust_main' => $cust_main, @@ -846,11 +847,14 @@ sub send_reset_email { if ( $opt{'queue'} ) { #or should queueing just be the default? + my $cust_msg = $msg_template->prepare( %msg_template ); + my $error = $cust_msg->insert; + return { 'error' => $error } if $error; my $queue = new FS::queue { - 'job' => 'FS::Misc::process_send_email', + 'job' => 'FS::cust_msg::process_send', 'custnum' => $cust_main ? $cust_main->custnum : '', }; - $queue->insert( $msg_template->prepare( %msg_template ) ); + $queue->insert( $cust_msg->custmsgnum ); } else { diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index cb39d4391..89bb193d2 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -661,72 +661,31 @@ sub send_receipt { my %substitutions = (); $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill}; - my $queue = new FS::queue { - 'job' => 'FS::Misc::process_send_email', - 'paynum' => $self->paynum, - 'custnum' => $cust_main->custnum, - }; - $error = $queue->insert( - FS::msg_template->by_key($msgnum)->prepare( + my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum}); + unless ($msg_template) { + warn "send_receipt could not load msg_template"; + return; + } + + my $cust_msg = $msg_template->prepare( 'cust_main' => $cust_main, 'object' => $self, 'from_config' => 'payment_receipt_from', 'substitutions' => \%substitutions, - ), - 'msgtype' => 'receipt', # override msg_template's default - ); - - } elsif ( $conf->exists('payment_receipt_email') ) { - - my $receipt_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ], - ) or do { - warn "can't create payment receipt template: $Text::Template::ERROR"; - return ''; - }; - - my $payby = $self->payby; - my $payinfo = $self->payinfo; - $payby =~ s/^BILL$/Check/ if $payinfo; - if ( $payby eq 'CARD' || $payby eq 'CHEK' ) { - $payinfo = $self->paymask - } else { - $payinfo = $self->decrypt($payinfo); - } - $payby =~ s/^CHEK$/Electronic check/; - - my %fill_in = ( - 'date' => time2str("%a %B %o, %Y", $self->_date), - 'name' => $cust_main->name, - 'paynum' => $self->paynum, - 'paid' => sprintf("%.2f", $self->paid), - 'payby' => ucfirst(lc($payby)), - 'payinfo' => $payinfo, - 'balance' => $cust_main->balance, - 'company_name' => $conf->config('company_name', $cust_main->agentnum), + 'msgtype' => 'receipt', ); - - $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill}; - - if ( $opt->{'cust_pkg'} ) { - $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg; - #setup date, other things? + $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template'; + if ($error) { + warn "send_receipt: $error"; + return; } my $queue = new FS::queue { - 'job' => 'FS::Misc::process_send_generated_email', + 'job' => 'FS::cust_msg::process_send', 'paynum' => $self->paynum, 'custnum' => $cust_main->custnum, - 'msgtype' => 'receipt', }; - $error = $queue->insert( - 'from' => $conf->invoice_from_full( $cust_main->agentnum ), - #invoice_from??? well as good as any - 'to' => \@invoicing_list, - 'subject' => 'Payment receipt', - 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ], - ); + $error = $queue->insert( $cust_msg->custmsgnum ); } else { diff --git a/FS/FS/msg_template/http.pm b/FS/FS/msg_template/http.pm index a2b0986ea..9c4e68bd7 100644 --- a/FS/FS/msg_template/http.pm +++ b/FS/FS/msg_template/http.pm @@ -61,7 +61,7 @@ sub prepare { }; # put override content _somewhere_ so it can be used if ( $opt{'override_content'} ) { - $document{'content'} = $opt{'override_content'}; + $document->{'content'} = $opt{'override_content'}; } my $request_content = $json->encode($document); -- cgit v1.2.1 From 4c8c839f65491c9ec41e78fce02ab5c91a5f4595 Mon Sep 17 00:00:00 2001 From: Jeremy Davis Date: Mon, 28 Sep 2015 10:08:02 -0400 Subject: 37669 Additional back-office disclaimers --- FS/FS/API.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/API.pm b/FS/FS/API.pm index f848361ac..7ee080257 100644 --- a/FS/FS/API.pm +++ b/FS/FS/API.pm @@ -24,7 +24,9 @@ This module implements a backend API for advanced back-office integration. In contrast to the self-service API, which authenticates an end-user and offers functionality to that end user, the backend API performs a simple shared-secret authentication and offers full, administrator functionality, enabling -integration with other back-office systems. +integration with other back-office systems. Only ccess this API from a secure +network from other backoffice machines. DON'T use this API to create customer +portal functionality. If accessing this API remotely with XML-RPC or JSON-RPC, be careful to block the port by default, only allow access from back-office servers with the same -- cgit v1.2.1 From 727d620374a9798dd2fe630d57e707fe16a63e49 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 28 Sep 2015 20:21:12 -0700 Subject: remove payment deletion, RT#37908 --- FS/FS/AccessRight.pm | 4 ---- 1 file changed, 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 3f2c0f35d..95cf29a8b 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -209,7 +209,6 @@ tie my %rights, 'Tie::IxHash', { rightname=>'Process payment', desc=>'Process credit card or e-check payments' }, 'Process credit card payment', 'Process Echeck payment', - { rightname=>'Delete payment', desc=>'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments.' }, #aka. deletepayments Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted. ], ### @@ -223,7 +222,6 @@ tie my %rights, 'Tie::IxHash', 'Void credit', #NEWER than things marked NEWNEWNEW 'Unvoid credit', #NEWER than things marked NEWNEWNEW { rightname=>'Unapply credit', desc=>'Enable "unapplication" of unclosed credits.' }, #aka unapplycredits - { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments.' }, 'View refunds', { rightname=>'Post refund', desc=>'Enable posting of check and cash refunds.' }, 'Post check refund', @@ -441,8 +439,6 @@ Most (but not all) right names. sub default_superuser_rights { my $class = shift; my %omit = map { $_=>1 } ( - 'Delete payment', - 'Delete credit', #? 'Delete refund', #? 'Edit customer package dates', 'Time queue', -- cgit v1.2.1 From f474f79841172f506370814b14a7efe80545f472 Mon Sep 17 00:00:00 2001 From: Jeremy Davis Date: Tue, 29 Sep 2015 17:12:26 -0400 Subject: 37669 Fix typo --- FS/FS/API.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/API.pm b/FS/FS/API.pm index 7ee080257..9dbbc3c4f 100644 --- a/FS/FS/API.pm +++ b/FS/FS/API.pm @@ -24,7 +24,7 @@ This module implements a backend API for advanced back-office integration. In contrast to the self-service API, which authenticates an end-user and offers functionality to that end user, the backend API performs a simple shared-secret authentication and offers full, administrator functionality, enabling -integration with other back-office systems. Only ccess this API from a secure +integration with other back-office systems. Only access this API from a secure network from other backoffice machines. DON'T use this API to create customer portal functionality. -- cgit v1.2.1 From eb439974e7aa85bb7ee31ed1e3f432bc2a7a250b Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Tue, 29 Sep 2015 21:43:23 -0500 Subject: RT#38048: not storing credit card #s [save-first fix for selfservice] --- FS/FS/ClientAPI/MyAccount.pm | 71 ++++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 36 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 6332dd75b..98b87ad55 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -1142,37 +1142,6 @@ sub do_process_payment { my $payby = delete $validate->{'payby'}; - my $error = $cust_main->realtime_bop( $FS::payby::payby2bop{$payby}, $amount, - 'quiet' => 1, - 'manual' => 1, - 'selfservice' => 1, - 'paynum_ref' => \$paynum, - %$validate, - ); - return { 'error' => $error } if $error; - - #no error, so order the fee package if applicable... - my $conf = new FS::Conf; - my $fee_pkgpart = $conf->config('selfservice_process-pkgpart', $cust_main->agentnum); - my $fee_skip_first = $conf->exists('selfservice_process-skip_first'); - - if ( $fee_pkgpart and ! $fee_skip_first || scalar($cust_main->cust_pay) ) { - - my $cust_pkg = new FS::cust_pkg { 'pkgpart' => $fee_pkgpart }; - - $error = $cust_main->order_pkg( 'cust_pkg' => $cust_pkg ); - return { 'error' => "payment processed successfully, but error ordering fee: $error" } - if $error; - - #and generate an invoice for it now too - $error = $cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); - return { 'error' => "payment processed and fee ordered sucessfully, but error billing fee: $error" } - if $error; - - } - - $cust_main->apply_payments; - if ( $validate->{'save'} ) { my $new = new FS::cust_main { $cust_main->hash }; if ($payby eq 'CARD' || $payby eq 'DCRD') { @@ -1193,7 +1162,7 @@ sub do_process_payment { stateid stateid_state ); $new->set( 'payby' => $validate->{'auto'} ? 'CHEK' : 'DCHK' ); } - $new->set( 'payinfo' => $cust_main->card_token || $validate->{'payinfo'} ); + $new->payinfo( $validate->{'payinfo'} ); #to properly set paymask $new->set( 'paydate' => $validate->{'paydate'} ); my $error = $new->replace($cust_main); if ( $error ) { @@ -1201,18 +1170,48 @@ sub do_process_payment { #return { 'error' => $error }; #XXX just warn verosely for now so i can figure out how these happen in # the first place, eventually should redirect them to the "change - #address" page but indicate the payment did process?? + #address" page but indicate if the payment processed? delete($validate->{'payinfo'}); #don't want to log this! warn "WARNING: error changing customer info when processing payment (not returning to customer as a processing error): $error\n". "NEW: ". Dumper($new)."\n". "OLD: ". Dumper($cust_main)."\n". "PACKET: ". Dumper($validate)."\n"; - #} else { - #not needed... - #$cust_main = $new; + } else { + $cust_main = $new; } } + my $error = $cust_main->realtime_bop( $FS::payby::payby2bop{$payby}, $amount, + 'quiet' => 1, + 'manual' => 1, + 'selfservice' => 1, + 'paynum_ref' => \$paynum, + %$validate, + ); + return { 'error' => $error } if $error; + + #no error, so order the fee package if applicable... + my $conf = new FS::Conf; + my $fee_pkgpart = $conf->config('selfservice_process-pkgpart', $cust_main->agentnum); + my $fee_skip_first = $conf->exists('selfservice_process-skip_first'); + + if ( $fee_pkgpart and ! $fee_skip_first || scalar($cust_main->cust_pay) ) { + + my $cust_pkg = new FS::cust_pkg { 'pkgpart' => $fee_pkgpart }; + + $error = $cust_main->order_pkg( 'cust_pkg' => $cust_pkg ); + return { 'error' => "payment processed successfully, but error ordering fee: $error" } + if $error; + + #and generate an invoice for it now too + $error = $cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + return { 'error' => "payment processed and fee ordered sucessfully, but error billing fee: $error" } + if $error; + + } + + $cust_main->apply_payments; + my $cust_pay = ''; my $receipt_html = ''; if ($paynum) { -- cgit v1.2.1 From 8662aff8e73ac76b2c419a17a5ee0711a681e669 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Wed, 30 Sep 2015 01:43:44 -0500 Subject: RT#37547: Voice Network FS reexport --- FS/bin/freeside-reexport | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport index 54af9dd80..6b689178d 100644 --- a/FS/bin/freeside-reexport +++ b/FS/bin/freeside-reexport @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use vars qw($opt_s $opt_u $opt_p); +use vars qw($opt_s $opt_u $opt_p $opt_e); use Getopt::Std; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch qsearchs); @@ -22,7 +22,7 @@ if ( $export_x =~ /^(\d+)$/ ) { or die "no exports of type $export_x found\n"; } -getopts('s:u:p:'); +getopts('s:u:p:e:'); my @svc_x = (); if ( $opt_s ) { @@ -38,16 +38,20 @@ if ( $opt_s ) { die "no services with svcpart $opt_p found\n" unless @svc_x; } +$opt_e ||= 'insert'; +die &usage unless grep { $_ eq $opt_e } qw( insert replace delete suspend unsuspend ); +my $method = 'export_' . $opt_e; + foreach my $part_export ( @part_export ) { foreach my $svc_x ( @svc_x ) { - my $error = $part_export->export_insert($svc_x); + my $error = $part_export->$method($svc_x,$svc_x); die $error if $error; } } sub usage { - die "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]\n"; + return "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ] [ -e insert|replace|delete|suspend|unsuspend ]\n"; } =head1 NAME @@ -56,12 +60,13 @@ freeside-reexport - Command line tool to re-trigger export jobs for existing ser =head1 SYNOPSIS - freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ] + freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ] [ -e insert|replace|delete|suspend|unsuspend ] =head1 DESCRIPTION Re-queues the export job for the specified exportnum or exporttype(s) and - specified service (selected by svcnum or username). + specified service (selected by svcnum, username or svcpart). Optionally + specify the phase of export using the -e flag (default is insert.) =head1 SEE ALSO -- cgit v1.2.1 From 21b519eb5313ebe09242a2d90e1e615c56c64739 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Wed, 30 Sep 2015 20:32:20 -0500 Subject: RT#38048: not storing credit card #s [no longer setting cust_main->card_token] --- FS/FS/cust_main/Billing_Realtime.pm | 2 -- 1 file changed, 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index c6b3b3180..2a920e074 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -765,8 +765,6 @@ sub realtime_bop { if ( $transaction->can('card_token') && $transaction->card_token ) { - $self->card_token($transaction->card_token); - if ( $options{'payinfo'} eq $self->payinfo ) { $self->payinfo($transaction->card_token); my $error = $self->replace; -- cgit v1.2.1 From d07c72046444319e0811c6a00b504885da091992 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 30 Sep 2015 22:49:38 -0700 Subject: graphical selection of deployment zones and automatic block lookup, #30260 --- FS/FS/Schema.pm | 3 +- FS/FS/deploy_zone.pm | 187 ++++++++++++++++++++++++++++++++++++------- FS/FS/deploy_zone_block.pm | 5 -- FS/FS/o2m_Common.pm | 18 +++-- FS/FS/part_pkg_fcc_option.pm | 2 +- 5 files changed, 175 insertions(+), 40 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 85fbbeb8a..486860ff6 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -7038,6 +7038,7 @@ sub tables_hashref { 'zonenum', 'serial', '', '', '', '', 'description', 'char', 'NULL', $char_d, '', '', 'agentnum', 'int', '', '', '', '', + 'censusyear', 'char', 'NULL', 4, '', '', 'dbaname', 'char', 'NULL', $char_d, '', '', 'zonetype', 'char', '', 1, '', '', 'technology', 'int', '', '', '', '', @@ -7069,7 +7070,7 @@ sub tables_hashref { 'blocknum', 'serial', '', '', '', '', 'zonenum', 'int', '', '', '', '', 'censusblock', 'char', '', 15, '', '', - 'censusyear', 'char', '', 4, '', '', + 'censusyear', 'char','NULL', 4, '', '', ], 'primary_key' => 'blocknum', 'unique' => [], diff --git a/FS/FS/deploy_zone.pm b/FS/FS/deploy_zone.pm index 38dd7dc2d..71129cf44 100644 --- a/FS/FS/deploy_zone.pm +++ b/FS/FS/deploy_zone.pm @@ -6,6 +6,13 @@ use FS::Record qw( qsearch qsearchs dbh ); use Storable qw(thaw); use MIME::Base64; +use JSON qw(encode_json decode_json) ; +use LWP::UserAgent; +use HTTP::Request::Common; + +# update this in 2020, along with the URL for the TIGERweb service +our $CENSUS_YEAR = 2010; + =head1 NAME FS::deploy_zone - Object methods for deploy_zone records @@ -48,6 +55,12 @@ Optional text describing the zone. The agent that serves this zone. +=item censusyear + +The census map year for which this zone was last updated. May be null for +zones that contain no census blocks (mobile zones, or fixed zones that haven't +had their block lists filled in yet). + =item dbaname The name under which service is marketed in this zone. If null, will @@ -58,6 +71,8 @@ default to the agent name. The way the zone geography is defined: "B" for a list of census blocks (used by the FCC for fixed broadband service), "P" for a polygon (for mobile services). See L and L. +Note that block-type zones are still allowed to have a vertex list, for +use by the map editor. =item technology @@ -147,12 +162,16 @@ sub delete { local $FS::UID::AutoCommit = 0; # clean up linked records my $self = shift; - my $error = $self->process_o2m( - 'table' => $self->element_table, - 'num_col' => 'zonenum', - 'fields' => 'zonenum', - 'params' => {}, - ) || $self->SUPER::delete(@_); + my $error; + foreach (qw(deploy_zone_block deploy_zone_vertex)) { + $error ||= $self->process_o2m( + 'table' => $_, + 'num_col' => 'zonenum', + 'fields' => 'zonenum', + 'params' => {}, + ); + } + $error ||= $self->SUPER::delete(@_); if ($error) { dbh->rollback if $oldAutoCommit; @@ -185,6 +204,7 @@ sub check { $self->ut_numbern('zonenum') || $self->ut_text('description') || $self->ut_number('agentnum') + || $self->ut_numbern('censusyear') || $self->ut_foreign_key('agentnum', 'agent', 'agentnum') || $self->ut_textn('dbaname') || $self->ut_enum('zonetype', [ 'B', 'P' ]) @@ -219,24 +239,6 @@ sub check { $self->SUPER::check; } -=item element_table - -Returns the name of the table that contains the zone's elements (blocks or -vertices). - -=cut - -sub element_table { - my $self = shift; - if ($self->zonetype eq 'B') { - return 'deploy_zone_block'; - } elsif ( $self->zonetype eq 'P') { - return 'deploy_zone_vertex'; - } else { - die 'unknown zonetype'; - } -} - =item deploy_zone_block Returns the census block records in this zone, in order by census block @@ -244,8 +246,7 @@ number. Only appropriate to block-type zones. =item deploy_zone_vertex -Returns the vertex records for this zone, in order by sequence number. Only -appropriate to polygon-type zones. +Returns the vertex records for this zone, in order by sequence number. =cut @@ -267,7 +268,19 @@ sub deploy_zone_vertex { }); } -=back +=item vertices_json + +Returns the vertex list for this zone, as a JSON string of + +[ [ latitude0, longitude0 ], [ latitude1, longitude1 ] ... ] + +=cut + +sub vertices_json { + my $self = shift; + my @vertices = map { [ $_->latitude, $_->longitude ] } $self->deploy_zone_vertex; + encode_json(\@vertices); +} =head2 SUBROUTINES @@ -315,7 +328,125 @@ sub process_batch_import { FS::Record::process_batch_import( $job, $opt, $param ); } - + +=item process_block_lookup JOB, ZONENUM + +Look up all the census blocks in the zone's footprint, and insert them. +This will replace any existing block list. + +=cut + +sub process_block_lookup { + my $job = shift; + my $param = shift; + if (!ref($param)) { + $param = thaw(decode_base64($param)); + } + my $zonenum = $param->{zonenum}; + my $zone = FS::deploy_zone->by_key($zonenum) + or die "zone $zonenum not found\n"; + + # wipe the existing list of blocks + my $error = $zone->process_o2m( + 'table' => 'deploy_zone_block', + 'num_col' => 'zonenum', + 'fields' => 'zonenum', + 'params' => {}, + ); + die $error if $error; + + $job->update_statustext('0,querying census database') if $job; + + # negotiate the rugged jungle trails of the ArcGIS REST protocol: + # 1. unlike most places, longitude first. + my @zone_vertices = map { [ $_->longitude, $_->latitude ] } + $zone->deploy_zone_vertex; + + return if scalar(@zone_vertices) < 3; # then don't bother + + # 2. package this as "rings", inside a JSON geometry object + # 3. announce loudly and frequently that we are using spatial reference + # 4326, "true GPS coordinates" + my $geometry = encode_json({ + 'rings' => [ \@zone_vertices ], + 'wkid' => 4326, + }); + + my %query = ( + f => 'json', # duh + geometry => $geometry, + geometryType => 'esriGeometryPolygon', # as opposed to a bounding box + inSR => 4326, + outSR => 4326, + spatialRel => 'esriSpatialRelIntersects', # the test to perform + outFields => 'OID,GEOID', + returnGeometry => 'false', + orderByFields => 'OID', + ); + my $url = 'http://tigerweb.geo.census.gov/arcgis/rest/services/TIGERweb/Tracts_Blocks/MapServer/12/query'; + my $ua = LWP::UserAgent->new; + + # first find out how many of these we're dealing with + my $response = $ua->request( + POST $url, Content => [ + %query, + returnCountOnly => 1, + ] + ); + die $response->status_line unless $response->is_success; + my $data = decode_json($response->content); + # their error messages are mostly useless, but don't just blindly continue + die $data->{error}{message} if $data->{error}; + + my $count = $data->{count}; + my $inserted = 0; + + #warn "Census block lookup: $count\n"; + + # we have to do our own pagination on this, because the census bureau + # doesn't support resultOffset (maybe they don't have ArcGIS 10.3 yet). + # that's why we're ordering by OID, it's globally unique + my $last_oid = 0; + my $done = 0; + while (!$done) { + $response = $ua->request( + POST $url, Content => [ + %query, + where => "OID>$last_oid", + ] + ); + die $response->status_line unless $response->is_success; + $data = decode_json($response->content); + die $data->{error}{message} if $data->{error}; + + foreach my $feature (@{ $data->{features} }) { + my $geoid = $feature->{attributes}{GEOID}; # the prize + my $block = FS::deploy_zone_block->new({ + zonenum => $zonenum, + censusblock => $geoid + }); + $error = $block->insert; + die "$error (inserting census block $geoid)" if $error; + + $inserted++; + if ($job and $inserted % 100 == 0) { + my $percent = sprintf('%.0f', $inserted / $count * 100); + $job->update_statustext("$percent,creating block records"); + } + } + + #warn "Inserted $inserted records\n"; + $last_oid = $data->{features}[-1]{attributes}{OID}; + $done = 1 unless $data->{exceededTransferLimit}; + } + + $zone->set('censusyear', $CENSUS_YEAR); + $error = $zone->replace; + warn "$error (updating zone census year)" if $error; # whatever, continue + + return; +} + =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/deploy_zone_block.pm b/FS/FS/deploy_zone_block.pm index 757af7e3d..2ac18e2fe 100644 --- a/FS/FS/deploy_zone_block.pm +++ b/FS/FS/deploy_zone_block.pm @@ -43,10 +43,6 @@ L foreign key for the zone. U.S. census block number (15 digits). -=item censusyear - -The year of the census map where the block appeared or was last verified. - =back =head1 METHODS @@ -107,7 +103,6 @@ sub check { $self->ut_numbern('blocknum') || $self->ut_number('zonenum') || $self->ut_number('censusblock') - || $self->ut_number('censusyear') ; return $error if $error; diff --git a/FS/FS/o2m_Common.pm b/FS/FS/o2m_Common.pm index 4f6d2e781..430f00bbb 100644 --- a/FS/FS/o2m_Common.pm +++ b/FS/FS/o2m_Common.pm @@ -35,11 +35,19 @@ Available options: table (required) - Table into which the records are inserted. -num_col (optional) - Column in table which links to the primary key of the base table. If not specified, it is assumed this has the same name. - -params (required) - Hashref of keys and values, often passed as CVars)> from a form. - -fields (required) - Arrayref of field names for each record in table. Pulled from params as "pkeyNN_field" where pkey is table's primary key and NN is the entry's numeric identifier. +fields (required) - Arrayref of the field names in the "many" table. + +params (required) - Hashref of keys and values, often passed as +CVars)> from a form. This will be scanned for keys of the form +"pkeyNN" (where pkey is the primary key column name, and NN is an integer). +Each of these designates one record in the "many" table. The contents of +that record will be taken from other parameters with the names +"pkeyNN_myfield" (where myfield is one of the fields in the 'fields' +array). + +num_col (optional) - Name of the foreign key column in the "many" table, which +links to the primary key of the base table. If not specified, it is assumed +this has the same name as in the base table. =cut diff --git a/FS/FS/part_pkg_fcc_option.pm b/FS/FS/part_pkg_fcc_option.pm index 5c78e5f9e..3d821f502 100644 --- a/FS/FS/part_pkg_fcc_option.pm +++ b/FS/FS/part_pkg_fcc_option.pm @@ -148,7 +148,7 @@ tie our %spectrum_labels, 'Tie::IxHash', ( 95 => 'Wireless Communications Service (WCS) Band', 96 => 'Broadband Radio Service/Educational Broadband Service Band', 97 => 'Satellite (e.g. L-band, Big LEO, Little LEO)', - 98 => 'Unlicensed (including broadcast television “white spaces”) Bands', + 98 => 'Unlicensed (including broadcast television "white spaces") Bands', 99 => '600 MHz', 100 => 'H Block', 101 => 'Advanced Wireless Services (AWS) 3 Band', -- cgit v1.2.1 From 55de788f065cebc8273bcc52befb82cec9eff129 Mon Sep 17 00:00:00 2001 From: Jeremy Davis Date: Thu, 1 Oct 2015 10:25:37 -0400 Subject: 38406 Net 7 Terms --- FS/FS/Conf.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 26dbbcd23..89080ceab 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1537,7 +1537,7 @@ and customer address. Include units.', 'type' => 'select', 'per_agent' => 1, 'select_enum' => [ - '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 5', 'Net 9', 'Net 10', 'Net 14', + '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 5', 'Net 7', 'Net 9', 'Net 10', 'Net 14', 'Net 15', 'Net 18', 'Net 20', 'Net 21', 'Net 25', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ], }, -- cgit v1.2.1 From bf6c11bc520aa4e4e0fa75f0469c66a11cf11a31 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 1 Oct 2015 21:05:14 -0700 Subject: refine disable_previous_balance behavior to show new charges only, #35222, #37396 --- FS/FS/Conf.pm | 2 +- FS/FS/Template_Mixin.pm | 7 ++++++- FS/FS/cust_bill.pm | 16 +++++++++++++--- 3 files changed, 20 insertions(+), 5 deletions(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 89080ceab..1e0d99928 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -4178,7 +4178,7 @@ and customer address. Include units.', { 'key' => 'disable_previous_balance', 'section' => 'invoicing', - 'description' => 'Disable inclusion of previous balance, payment, and credit lines on invoices.', + 'description' => 'Show new charges only; do not list previous invoices, payments, or credits on the invoice.', 'type' => 'checkbox', 'per_agent' => 1, }, diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 206c03cde..1a3217c44 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -684,7 +684,12 @@ sub print_generic { my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance # my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits #my $balance_due = $self->owed + $pr_total - $cr_total; - my $balance_due = $self->owed + $pr_total; + my $balance_due = $self->owed; + if ( $self->enable_previous ) { + $balance_due += $pr_total; + } + # otherwise the previous balance is not shown, so including it in the + # balance due is just confusing # the sum of amount owed on all invoices # (this is used in the summary & on the payment coupon) diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 09424ba52..6546bfa95 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -2836,8 +2836,7 @@ sub _items_total { my ($previous_charges_desc, $new_charges_desc, $new_charges_amount); if ( $conf->exists('previous_balance-exclude_from_total') ) { - # can we do some caching on this stuff? it's going to change infrequently - # in production + # if enabled, specifically add a line for the previous balance total $previous_charges_desc = $self->mt( $conf->config('previous_balance-text') || 'Previous Balance' ); @@ -2849,6 +2848,12 @@ sub _items_total { total_amount => sprintf('%.2f',$pr_total) }; } + } + + if ( $conf->exists('previous_balance-exclude_from_total') + or !$self->enable_previous ) { + # show new charges only + $new_charges_desc = $self->mt( $conf->config('previous_balance-text-total_new_charges') || 'Total New Charges' @@ -2857,9 +2862,14 @@ sub _items_total { $new_charges_amount = $self->charged; } else { + # show new charges + previous invoice total $new_charges_desc = $self->mt('Total Charges'); - $new_charges_amount = sprintf('%.2f',$self->charged + $pr_total); + if ( $self->enable_previous ) { + $new_charges_amount = sprintf('%.2f', $self->charged + $pr_total); + } else { + $new_charges_amount = sprintf('%.2f', $self->charged); + } } -- cgit v1.2.1 From 61a0dc609fd2b7db3571f8f86672481d1e064331 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Fri, 2 Oct 2015 16:05:41 -0700 Subject: fix unit setup fee on prorate-deferred packages, #31276 --- FS/FS/cust_main/Billing.pm | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 2d7b690df..eee0958e0 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -1024,8 +1024,14 @@ sub _make_lines { return "$@ running calc_setup for $cust_pkg\n" if $@; - $unitsetup = $cust_pkg->base_setup() - || $setup; #XXX uuh + # Only increment unitsetup here if there IS a setup fee. + # prorate_defer_bill may cause calc_setup on a setup-stage package + # to return zero, and the setup fee to be charged later. (This happens + # when it's first billed on the prorate cutoff day. RT#31276.) + if ( $setup ) { + $unitsetup = $cust_pkg->base_setup() + || $setup; #XXX uuh + } if ( $setup_param{'billed_currency'} ) { $setup_billed_currency = delete $setup_param{'billed_currency'}; @@ -1196,7 +1202,7 @@ sub _make_lines { # Add an additional setup fee at the billing stage. # Used for prorate_defer_bill. $setup += $param{'setup_fee'}; - $unitsetup += $param{'setup_fee'}; + $unitsetup = $cust_pkg->base_setup(); $lineitems++; } -- cgit v1.2.1 From d942f94119fdc54dc416e309f36d385652fb5272 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 5 Oct 2015 14:42:57 -0700 Subject: fix UTF-8 in ClientAPI, RT#38254 --- FS/FS/ClientAPI_XMLRPC.pm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm index 435ee9835..dbcb565fa 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -30,6 +30,7 @@ L, L use strict; use vars qw($DEBUG $AUTOLOAD); +use Encode; use FS::XMLRPC_Lite; #XMLRPC::Lite, for XMLRPC::Data use FS::ClientAPI; @@ -67,12 +68,17 @@ sub AUTOLOAD { shift; #discard package name; + #$call = "FS::SelfService::$call"; #no strict 'refs'; #&{$call}(@_); #FS::ClientAPI->dispatch($autoload->{$call}, @_); - my $return = FS::ClientAPI->dispatch($autoload->{$call}, { @_ } ); + my %hash = @_; + #XXX doesn't handle multi-level data structs + $hash{$_} = decode(utf8=>$hash{$_}) foreach keys %hash; + + my $return = FS::ClientAPI->dispatch($autoload->{$call}, \%hash ); if ( exists($typefix{$call}) ) { my $typefix = $typefix{$call}; @@ -85,7 +91,7 @@ sub AUTOLOAD { $return; - }else{ + } else { die "No such procedure: $call"; } } -- cgit v1.2.1 From d0b3acc1efb65855d5e52d54c33bb035c9776e2d Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 5 Oct 2015 18:35:13 -0700 Subject: ticket_system-appointment-queueid config, RT#34237 --- FS/FS/Conf.pm | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 1e0d99928..fa4ff41d3 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3074,12 +3074,14 @@ and customer address. Include units.', } }, }, + { 'key' => 'ticket_system-force_default_queueid', 'section' => 'ticketing', 'description' => 'Disallow queue selection when creating new tickets from customer view.', 'type' => 'checkbox', }, + { 'key' => 'ticket_system-selfservice_queueid', 'section' => 'ticketing', @@ -3157,6 +3159,34 @@ and customer address. Include units.', 'type' => 'checkbox', }, + { + 'key' => 'ticket_system-appointment-queueid', + 'section' => 'ticketing', + 'description' => 'Custom field from the ticketing system to use as an appointment classification.', + #false laziness w/above + 'type' => 'select-sub', + 'options_sub' => sub { + my $conf = new FS::Conf; + if ( $conf->config('ticket_system') ) { + eval "use FS::TicketSystem;"; + die $@ if $@; + FS::TicketSystem->queues(); + } else { + (); + } + }, + 'option_sub' => sub { + my $conf = new FS::Conf; + if ( $conf->config('ticket_system') ) { + eval "use FS::TicketSystem;"; + die $@ if $@; + FS::TicketSystem->queue(shift); + } else { + ''; + } + }, + }, + { 'key' => 'ticket_system-escalation', 'section' => 'ticketing', -- cgit v1.2.1 From 5e6bfa1548ac370d2cf316e0db44785d83baa453 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Mon, 5 Oct 2015 19:09:33 -0700 Subject: ticket_system-appointment-custom_field, RT#34237 --- FS/FS/Conf.pm | 7 +++++++ FS/FS/TicketSystem/RT_Internal.pm | 4 +++- FS/FS/cust_main.pm | 24 ++++++++++++++++++++++++ 3 files changed, 34 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index fa4ff41d3..647ae0bdf 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3187,6 +3187,13 @@ and customer address. Include units.', }, }, + { + 'key' => 'ticket_system-appointment-custom_field', + 'section' => 'ticketing', + 'description' => 'Custom field from the ticketing system to use as an appointment classification.', + 'type' => 'text', + }, + { 'key' => 'ticket_system-escalation', 'section' => 'ticketing', diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm index 6fb2c187d..b70ac5360 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -111,7 +111,7 @@ properly. # create an RT::Tickets object for a specified custnum or svcnum sub _tickets_search { - my( $self, $type, $number, $limit, $priority, $status ) = @_; + my( $self, $type, $number, $limit, $priority, $status, $queueid ) = @_; $type =~ /^Customer|Service$/ or die "invalid type: $type"; $number =~ /^\d+$/ or die "invalid custnum/svcnum: $number"; @@ -159,6 +159,8 @@ sub _tickets_search { join(' OR ', map { "Status = '$_'" } @statuses). ' ) '; + $rtql .= " AND Queue = $queueid " if $queueid; + warn "$me _customer_tickets_search:\n$rtql\n" if $DEBUG; $Tickets->FromSQL($rtql); diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 6afbd1cf5..2d6d45907 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4053,6 +4053,30 @@ sub tickets { (@tickets); } +=item appointments [ STATUS ] + +Returns an array of hashes representing the customer's RT tickets which +are appointments. + +=cut + +sub appointments { + my $self = shift; + my $status = ( @_ && $_[0] ) ? shift : ''; + + return () unless $conf->config('ticket_system'); + + my $queueid = $conf->config('ticket_system-appointment-queueid'); + + @{ FS::TicketSystem->customer_tickets( $self->custnum, + 99, + undef, + $status, + $queueid, + ) + }; +} + # Return services representing svc_accts in customer support packages sub support_services { my $self = shift; -- cgit v1.2.1 From 755f6730e6bc4b59db2041db09403c31136c814d Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Mon, 5 Oct 2015 21:52:43 -0500 Subject: RT37465: RBC PAD error when calculating totals [W status is now approved] --- FS/FS/pay_batch/RBC.pm | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) (limited to 'FS') diff --git a/FS/FS/pay_batch/RBC.pm b/FS/FS/pay_batch/RBC.pm index 644c73c8b..b0136786b 100644 --- a/FS/FS/pay_batch/RBC.pm +++ b/FS/FS/pay_batch/RBC.pm @@ -66,7 +66,7 @@ $name = 'RBC'; }, 'approved' => sub { my $hash = shift; - $hash->{'status'} eq ' ' + ($hash->{'status'} eq ' ') || ($hash->{'status'} eq 'W'); }, 'declined' => sub { my $hash = shift; @@ -127,12 +127,6 @@ $name = 'RBC'; if $hash->{'status'} eq ' '; #false laziness with 'approved' above return 1; } - #skipping W for now (maybe it should be declined?) - if ($hash->{'status'} eq 'W') { - #file counts this as part of total, but we skip - $totaloffset += sprintf("%.2f", $hash->{'paid'} / 100 ); - return 1; - } return ($hash->{'recordtype'} eq '3') || #Account Trailer Record, concludes returned items ($hash->{'subtype'} ne '0'); #error messages, etc, too late to apply to previous entry -- cgit v1.2.1 From a267a869ad2f2c9b6ba4e306aea6103e3a6bfe4e Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Tue, 6 Oct 2015 00:35:18 -0500 Subject: RT#38314: Declined payment shows card as tokenized after first attempt --- FS/FS/cust_main/Billing_Realtime.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index 2a920e074..434815c16 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -622,6 +622,7 @@ sub realtime_bop { '_date' => '', 'payby' => $bop_method2payby{$options{method}}, 'payinfo' => $options{payinfo}, + 'paymask' => $options{paymask}, 'paydate' => $paydate, 'recurring_billing' => $content{recurring_billing}, 'pkgnum' => $options{'pkgnum'}, -- cgit v1.2.1 From cf512ab17435a0199ae13a8faefef94600a7a61b Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Tue, 6 Oct 2015 01:46:31 -0500 Subject: RT#37038 Add Card Type Name to Payment Report --- FS/FS/payinfo_Mixin.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/payinfo_Mixin.pm b/FS/FS/payinfo_Mixin.pm index c66e3bc37..6b96bbe27 100644 --- a/FS/FS/payinfo_Mixin.pm +++ b/FS/FS/payinfo_Mixin.pm @@ -239,7 +239,11 @@ sub payby_payinfo_pretty { my $locale = shift; my $lh = FS::L10N->get_handle($locale); if ( $self->payby eq 'CARD' ) { - $lh->maketext('Card #') . $self->paymask; + if ($self->paymask =~ /tokenized/) { + $lh->maketext('Tokenized Card'); + } else { + $lh->maketext('Card #') . $self->paymask; + } } elsif ( $self->payby eq 'CHEK' ) { #false laziness w/view/cust_main/payment_history.html::translate_payinfo -- cgit v1.2.1 From 2b500be7e787a54eb005caa274406957728d8b1b Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Tue, 6 Oct 2015 03:58:39 -0700 Subject: consider "quick payment entry" payments manual for payment receipt purposes, RT#33681 --- FS/FS/cust_pay.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 89bb193d2..d9ae0d39e 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -960,7 +960,7 @@ sub batch_insert { } } elsif ( !$error ) { #normal case: apply payments as usual - $cust_pay->cust_main->apply_payments; + $cust_pay->cust_main->apply_payments( 'manual'=>1 ); } } @@ -1311,7 +1311,7 @@ sub process_batch_import { my $cust_pay = shift; my $cust_main = $cust_pay->cust_main or return "can't find customer to which payments apply"; - my $error = $cust_main->apply_payments_and_credits; + my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 ); return $error ? "can't apply payments to customer ".$cust_pay->custnum."$error" : ''; -- cgit v1.2.1 From 956df0bc6383ed0513d4dd00668f3b24c42ba1e4 Mon Sep 17 00:00:00 2001 From: Jeremy Davis Date: Tue, 6 Oct 2015 13:37:15 -0400 Subject: cdr types for AMCom CDR's --- FS/FS/cdr/amcom.pm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cdr/amcom.pm b/FS/FS/cdr/amcom.pm index 97ab402ca..43e6afd60 100644 --- a/FS/FS/cdr/amcom.pm +++ b/FS/FS/cdr/amcom.pm @@ -4,6 +4,8 @@ use strict; use base qw( FS::cdr ); use vars qw( %info ); use DateTime; +use FS::Record qw( qsearchs ); +use FS::cdr_type; my ($tmp_mday, $tmp_mon, $tmp_year); @@ -29,7 +31,14 @@ my ($tmp_mday, $tmp_mon, $tmp_year); if $cdr->accountcode eq '' && $field =~ /^(1800|1300)/; }, 'uniqueid', # 4. Record ID - 'dcontext', # 5. Call Category (LOCAL, NATIONAL, FREECALL, MOBILE) + sub { # 5. Call Category (LOCAL, NATIONAL, FREECALL, MOBILE) + my ($cdr, $data) = @_; + $data ||= 'none'; + + 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 my ($cdr, $date) = @_; $date =~ /^(\d{2})(\d{2})(\d{4})$/ -- cgit v1.2.1 From fc672686f119da0b3b34fd3c73acc3fea81262e6 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 7 Oct 2015 14:18:15 -0700 Subject: #37098: convert one-shot email notices to use message templates --- FS/FS/cust_main_Mixin.pm | 22 +++++++++++++++++++++- FS/FS/msg_template.pm | 6 ++++-- 2 files changed, 25 insertions(+), 3 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index 3d05f8473..867d43e60 100644 --- a/FS/FS/cust_main_Mixin.pm +++ b/FS/FS/cust_main_Mixin.pm @@ -426,6 +426,18 @@ sub email_search_result { if ( $msgnum ) { $msg_template = qsearchs('msg_template', { msgnum => $msgnum } ) or die "msgnum $msgnum not found\n"; + } else { + $msg_template = FS::msg_template->new({ + from_addr => $from, + msgname => $subject, # maybe a timestamp also? + disabled => 'D', # 'D'raft + # msgclass, maybe + }); + $error = $msg_template->insert( + subject => $subject, + body => $html_body, + ); + return "$error (when creating draft template)" if $error; } my $sql_query = $class->search($param->{'search'}); @@ -446,7 +458,7 @@ sub email_search_result { my %sent_to = (); if ( !$msg_template ) { - # XXX create on the fly + die "email_search_result now requires a msg_template"; } #eventually order+limit magic to reduce memory use? @@ -516,6 +528,14 @@ sub email_search_result { } } # foreach $obj + # if the message template was created as "draft", change its status to + # "completed" + if ($msg_template->disabled eq 'D') { + $msg_template->set('disabled' => 'C'); + my $error = $msg_template->replace; + warn "$error (setting draft message template status)" if $error; + } + if(@retry_jobs) { # fail the job, but with a status message that makes it clear # something was sent. diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index 49403889c..d17fd41cb 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -66,7 +66,9 @@ global template. =item bcc_addr - Bcc all mail to this address. -=item disabled - disabled ('Y' or NULL). +=item disabled - disabled (NULL for not-disabled and selectable, 'D' for a +draft of a one-time message, 'C' for a completed one-time message, 'Y' for a +normal template disabled by user action). =back @@ -247,7 +249,7 @@ sub check { || $self->ut_text('msgname') || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') || $self->ut_textn('mime_type') - || $self->ut_enum('disabled', [ '', 'Y' ] ) + || $self->ut_enum('disabled', [ '', 'Y', 'D', 'S' ] ) || $self->ut_textn('from_addr') || $self->ut_textn('bcc_addr') # fine for now, but change this to some kind of dynamic check if we -- cgit v1.2.1 From 3b6d92312c10df349d91999f496ed2539b56c608 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 7 Oct 2015 16:21:39 -0700 Subject: add msgclass to initial msg_template, #38500 --- FS/FS/msg_template/InitialData.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/msg_template/InitialData.pm b/FS/FS/msg_template/InitialData.pm index a4e27fdc9..dbb9f4037 100644 --- a/FS/FS/msg_template/InitialData.pm +++ b/FS/FS/msg_template/InitialData.pm @@ -3,6 +3,7 @@ package FS::msg_template::InitialData; sub _initial_data { [ { msgname => 'Password reset', + msgclass => 'email', mime_type => 'text/html', #multipart/alternative with a text part? # cranky mutt/pine users like me are rare -- cgit v1.2.1 From 294e2ce31d6bbd2784a812d20438f9b223de0490 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 8 Oct 2015 15:31:31 -0700 Subject: more detailed tax-credit report, #37088 --- FS/FS/Report/Tax.pm | 36 ++++++++++++++++++++++++++++++------ 1 file changed, 30 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/Report/Tax.pm b/FS/FS/Report/Tax.pm index 2480a45b9..a892a6b87 100644 --- a/FS/FS/Report/Tax.pm +++ b/FS/FS/Report/Tax.pm @@ -240,6 +240,25 @@ sub report_internal { $group "; + # also include the exempt-sales credit amount, for the credit report + $sql{exempt_credited} = "$select + SUM(COALESCE(exempt_credited, 0)) + FROM cust_main_county + LEFT JOIN ($exempt_credit) AS exempt_credit USING (taxnum) + JOIN cust_bill_pkg USING (billpkgnum) + $join_cust_pkg $where AND $nottax + $group + "; + + $all_sql{exempt_credited} = "$select_all + SUM(COALESCE(exempt_credited, 0)) + FROM cust_main_county + LEFT JOIN ($exempt_credit) AS exempt_credit USING (taxnum) + JOIN cust_bill_pkg USING (billpkgnum) + $join_cust_pkg $where AND $nottax + $group + "; + # taxable sales $sql{taxable} = "$select SUM(cust_bill_pkg.setup + cust_bill_pkg.recur @@ -339,12 +358,12 @@ sub report_internal { my $istax = "cust_bill_pkg.pkgnum = 0 and cust_bill_pkg.feepart is null"; - $sql{tax} = "$select SUM(cust_bill_pkg_tax_location.amount) + $sql{tax} = "$select COALESCE(SUM(cust_bill_pkg_tax_location.amount),0) $taxfrom $where AND $istax $group"; - $all_sql{tax} = "$select_all SUM(cust_bill_pkg_tax_location.amount) + $all_sql{tax} = "$select_all COALESCE(SUM(cust_bill_pkg_tax_location.amount),0) $taxfrom $where AND $istax $group_all"; @@ -364,12 +383,12 @@ sub report_internal { $creditwhere =~ s/cust_bill._date/cust_credit_bill._date/g; } - $sql{tax_credited} = "$select SUM(cust_credit_bill_pkg.amount) + $sql{tax_credited} = "$select COALESCE(SUM(cust_credit_bill_pkg.amount),0) $creditfrom $creditwhere AND $istax $group"; - $all_sql{tax_credited} = "$select_all SUM(cust_credit_bill_pkg.amount) + $all_sql{tax_credited} = "$select_all COALESCE(SUM(cust_credit_bill_pkg.amount),0) $creditfrom $creditwhere AND $istax $group_all"; @@ -385,12 +404,12 @@ sub report_internal { ' ON (cust_bill_pay_pkg.billpkgtaxlocationnum ='. ' cust_bill_pkg_tax_location.billpkgtaxlocationnum)'; - $sql{tax_paid} = "$select SUM(cust_bill_pay_pkg.amount) + $sql{tax_paid} = "$select COALESCE(SUM(cust_bill_pay_pkg.amount),0) $paidfrom $where AND $istax $group"; - $all_sql{tax_paid} = "$select_all SUM(cust_bill_pay_pkg.amount) + $all_sql{tax_paid} = "$select_all COALESCE(SUM(cust_bill_pay_pkg.amount),0) $paidfrom $where AND $istax $group_all"; @@ -562,6 +581,11 @@ sub table { $this_row{exempt_pkg} + $this_row{exempt_monthly} ); + $this_row{credits} = sprintf('%.2f', + $this_row{sales_credited} + + $this_row{exempt_credited} + + $this_row{tax_credited} + ); # and give it a label if ( $this_row{total} ) { $this_row{label} = 'Total'; -- cgit v1.2.1 From 7032a1f192d519c9531c1fb20f766da6e38f74f1 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Sat, 10 Oct 2015 00:35:42 -0500 Subject: RT#38314: Declined payment shows card as tokenized after first attempt [same fix for approved payments] --- FS/FS/cust_main/Billing_Realtime.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'FS') diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index 434815c16..c2ce680a1 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -888,6 +888,7 @@ sub _realtime_bop_result { '_date' => '', 'payby' => $cust_pay_pending->payby, 'payinfo' => $options{'payinfo'}, + 'paymask' => $options{'paymask'}, 'paydate' => $cust_pay_pending->paydate, 'pkgnum' => $cust_pay_pending->pkgnum, 'discount_term' => $options{'discount_term'}, -- cgit v1.2.1