diff options
Diffstat (limited to 'FS')
76 files changed, 3297 insertions, 1427 deletions
diff --git a/FS/FS/API.pm b/FS/FS/API.pm index f848361ac..9dbbc3c4f 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 access 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 diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 9274ad858..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.' }, #aka. deletecredits Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted. 'View refunds', { rightname=>'Post refund', desc=>'Enable posting of check and cash refunds.' }, 'Post check refund', @@ -288,6 +286,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' }, @@ -440,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', diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 824ff67cb..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) { @@ -3032,7 +3031,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 +3119,7 @@ sub reset_passwd { my $reset_session = { 'svcnum' => $svc_acct->svcnum, - 'agentnum' => + 'agentnum' => $svc_acct->cust_main->agentnum, }; my $timeout = '1 hour'; #? 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<FS::SelfService::XMLRPC>, L<FS::SelfService> 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"; } } diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index a22e236a2..647ae0bdf 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1039,16 +1039,6 @@ my $validate_email = sub { $_[0] =~ }, { - 'key' => 'deletecredits', - #not actually deprecated yet - #'section' => 'deprecated', - #'description' => '<B>DEPRECATED</B>, 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', 'description' => 'Enable deletion of unclosed refunds. Be very careful! Only delete refunds that were data-entry errors, not adjustments.', @@ -1547,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' ], }, @@ -1673,13 +1663,6 @@ and customer address. Include units.', }, { - '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', 'description' => 'When payment receipts are triggered. Defaults to when payment is made.', @@ -2365,13 +2348,6 @@ and customer address. Include units.', }, { - 'key' => 'declinetemplate', - 'section' => 'deprecated', - 'description' => 'Template file for credit card and electronic check decline emails.', - 'type' => 'textarea', - }, - - { 'key' => 'emaildecline', 'section' => 'notification', 'description' => 'Enable emailing of credit card and electronic check decline notices.', @@ -2395,20 +2371,6 @@ and customer address. Include units.', }, { - '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', 'description' => 'Enable emailing of cancellation notices. Make sure to select the template in the cancel_msgnum option.', @@ -2532,86 +2494,17 @@ and customer address. Include units.', }, { - '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' => '', 'description' => 'Optional LaTex template file for a printed welcome letter. A welcome letter is printed the first time a cust_pkg record is created. See the <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation and the billing documentation for details on the template substitution language. A variable exists for each fieldname in the customer record (<code>$first, $last, etc</code>). The following additional variables are available<ul><li><code>$payby</code> - a friendler represenation of the field<li><code>$payinfo</code> - the masked payment information<li><code>$expdate</code> - the time at which the payment method expires (a UNIX timestamp)<li><code>$returnaddress</code> - the invoice return address for this customer\'s agent</ul>', '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 <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available<ul><li><code>$username</code> <li><code>$password</code> <li><code>$first</code> <li><code>$last</code> <li><code>$pkg</code> <li><code>$column</code> <li><code>$amount</code> <li><code>$threshold</code></ul>', - 'type' => 'textarea', - }, - - { - 'key' => 'warning_email-from', - 'section' => 'notification', - 'description' => 'From: address header for warning email', - 'type' => 'text', - }, - - { - 'key' => 'warning_email-cc', - 'section' => 'notification', - 'description' => 'Additional recipient(s) (comma separated) for warning email when remaining usage reaches zero.', - 'type' => 'text', - }, - { - 'key' => 'warning_email-subject', + 'key' => 'threshold_warning_msgnum', '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, }, { @@ -2619,7 +2512,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) ], }, { @@ -2711,14 +2604,6 @@ and customer address. Include units.', }, { - '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', 'description' => 'This controls when the system passes the "recurring_billing" flag on credit card transactions. If supported by your processor (and the Business::OnlinePayment processor module), passing the flag indicates this is a recurring transaction and may turn off the CVV requirement. ', @@ -3189,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', @@ -3273,6 +3160,41 @@ and customer address. Include units.', }, { + '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-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', 'description' => 'Enable priority escalation of tickets as part of daily batch processing.', @@ -3778,11 +3700,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 @@ -4082,14 +4005,6 @@ and customer address. Include units.', }, { - 'key' => 'impending_recur_template', - 'section' => 'deprecated', - 'description' => 'Template file for alerts about looming first time recurrant billing. See the <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitition language. Also see packages with a <a href="../browse/part_pkg.cgi">flat price plan</a> The following variables are available<ul><li><code>$packages</code> allowing <code>$packages->[0]</code> thru <code>$packages->[n]</code> <li><code>$package</code> the first package, same as <code>$packages->[0]</code> <li><code>$recurdates</code> allowing <code>$recurdates->[0]</code> thru <code>$recurdates->[n]</code> <li><code>$recurdate</code> the first recurdate, same as <code>$recurdate->[0]</code> <li><code>$first</code> <li><code>$last</code></ul>', -# <li><code>$payby</code> <li><code>$expdate</code> most likely only confuse - 'type' => 'textarea', - }, - - { 'key' => 'logo.png', 'section' => 'UI', #'invoicing' ? 'description' => 'Company logo for HTML invoices and the backoffice interface, in PNG format. Suggested size somewhere near 92x62.', @@ -4300,7 +4215,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, }, @@ -4648,13 +4563,6 @@ and customer address. Include units.', }, { - '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', 'description' => 'HTML for the HEAD section of the self-service interface, typically used for LINK stylesheet tags', @@ -5781,13 +5689,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', 'description' => 'Enable time selection on payment and refund reports.', 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/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/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/Misc.pm b/FS/FS/Misc.pm index cbf449520..18cb275bf 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -414,34 +414,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/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/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' diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 63e5318c3..eeb99bac5 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,58 @@ 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); +} + +#all credits applied to matching pkg line items (ie not taxes) + +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 diff --git a/FS/FS/Report/Tax.pm b/FS/FS/Report/Tax.pm index 23c16452e..a892a6b87 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 "; @@ -180,26 +182,111 @@ 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 + "; + + # 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 - 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"; @@ -209,27 +296,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"; @@ -239,7 +334,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,28 +347,30 @@ 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) + $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"; # 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)'; @@ -286,16 +383,37 @@ 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 COALESCE(SUM(cust_credit_bill_pkg.amount),0) $creditfrom $creditwhere AND $istax $group"; - $all_sql{credit} = "$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"; + # 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 COALESCE(SUM(cust_bill_pay_pkg.amount),0) + $paidfrom + $where AND $istax + $group"; + + $all_sql{tax_paid} = "$select_all COALESCE(SUM(cust_bill_pay_pkg.amount),0) + $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 +421,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 +440,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; @@ -458,10 +576,16 @@ 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} ); + $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'; diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 184c6c951..486860ff6 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 ) { @@ -4332,6 +4333,7 @@ sub tables_hashref { 'custnum', 'int', 'NULL', '', '', '', 'secure', 'char', 'NULL', 1, '', '', 'priority', 'int', 'NULL', '', '', '', + 'usernum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'jobnum', 'unique' => [], @@ -4345,6 +4347,9 @@ sub tables_hashref { { columns => [ 'custnum' ], table => 'cust_main', }, + { columns => [ 'usernum' ], + table => 'access_user', + }, ], }, @@ -6315,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' => [ ], @@ -6328,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', '', '', '', '', @@ -6346,6 +6374,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', '', '', '', '', @@ -6359,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' => [ ], @@ -6996,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', '', '', '', '', @@ -7027,7 +7070,7 @@ sub tables_hashref { 'blocknum', 'serial', '', '', '', '', 'zonenum', 'int', '', '', '', '', 'censusblock', 'char', '', 15, '', '', - 'censusyear', 'char', '', 4, '', '', + 'censusyear', 'char','NULL', 4, '', '', ], 'primary_key' => 'blocknum', 'unique' => [], @@ -7082,6 +7125,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/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 757701aa8..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) @@ -1519,7 +1524,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; @@ -3010,7 +3015,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 +3057,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 +3190,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 +3198,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 +3267,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 +3520,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 +3531,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} ) } } 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/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/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/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/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</access_right> for any L</refund_rights> +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/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 diff --git a/FS/FS/cdr/aapt.pm b/FS/FS/cdr/aapt.pm index 600a1920f..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) { + if ($data !~ /^(1|50)$/) { warn "AAPT: service ID type is not telephone number.\n"; $param->{skiprow} = 1; } diff --git a/FS/FS/cdr/amcom.pm b/FS/FS/cdr/amcom.pm index 36be8d8c3..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); @@ -22,10 +24,21 @@ 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 { # 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})$/ 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; 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_bill.pm b/FS/FS/cust_bill.pm index 7ea586a90..6546bfa95 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; @@ -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; } @@ -2830,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' ); @@ -2843,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' @@ -2851,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); + } } @@ -2913,6 +2929,18 @@ sub call_details { ( $header, grep { $_ ne $header } @details ); } +=item cust_pay_batch + +Returns all L<FS::cust_pay_batch> 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_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_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/cust_event.pm b/FS/FS/cust_event.pm index f299f9377..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; @@ -302,14 +303,16 @@ 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 ) - 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'"; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index c636408d8..2d6d45907 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; @@ -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; @@ -4574,102 +4598,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<FS::msg_template>) instead. +#Deprecated. Use event notification and message templates +#(L<FS::msg_template>) instead. -Sends a templated email notification to the customer (see L<Text::Template>). +#Sends a templated email notification to the customer (see L<Text::Template>). -OPTIONS is a hash and may include - -I<from> - the email sender (default is invoice_from) +#OPTIONS is a hash and may include -I<to> - comma-separated scalar or arrayref of recipients - (default is invoicing_list) +#I<from> - the email sender (default is invoice_from) -I<subject> - The subject line of the sent email notification - (default is "Notice from company_name") +#I<to> - comma-separated scalar or arrayref of recipients +# (default is invoicing_list) -I<extra_fields> - a hashref of name/value pairs which will be substituted - into the template +#I<subject> - The subject line of the sent email notification +# (default is "Notice from company_name") -The following variables are vavailable in the template. +#I<extra_fields> - 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 +#The following variables are vavailable in the template. -=cut +#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 -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}->{$_}; - } +#=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.pm b/FS/FS/cust_main/Billing.pm index 0bc0fbd39..eee0958e0 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -880,56 +880,66 @@ sub bill { } #discard bundled packages of 0 value +# XXX we should reconsider whether we even need this 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; + + # 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 ) { - $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 { @@ -1014,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'}; @@ -1186,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++; } diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index d973896c8..c2ce680a1 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; @@ -623,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'}, @@ -766,8 +766,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; @@ -890,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'}, @@ -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; @@ -1649,6 +1624,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_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index bdad511fa..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'}); @@ -445,6 +457,10 @@ sub email_search_result { my $success = 0; my %sent_to = (); + if ( !$msg_template ) { + die "email_search_result now requires a msg_template"; + } + #eventually order+limit magic to reduce memory use? foreach my $obj ( qsearch($sql_query) ) { @@ -459,36 +475,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 +496,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 { @@ -527,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/cust_msg.pm b/FS/FS/cust_msg.pm index 72f64b9c5..27272b8a3 100644 --- a/FS/FS/cust_msg.pm +++ b/FS/FS/cust_msg.pm @@ -45,10 +45,14 @@ 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 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,12 +141,14 @@ 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', [ '', 'invoice', 'receipt', 'admin', + 'report', ]) ; return $error if $error; @@ -150,10 +156,28 @@ sub check { $self->SUPER::check; } +=item send + +Sends the message through its parent L<FS::msg_template>. Returns an error +message on error, or an empty string. + +=cut + +sub send { + my $self = shift; + # 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); +} + =item entity Returns the complete message as a L<MIME::Entity>. +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<MIME::Entity> @@ -182,6 +206,25 @@ sub parts { =back +=head1 SUBROUTINES + +=over 4 + +=item process_send CUSTMSGNUM + +Given a C<cust_msg.custmsgnum> value, sends the message. It must already +have been prepared (via L<FS::msg_template/prepare>). + +=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<FS::msg_template>, L<FS::cust_main>, L<FS::Record>. diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 5d4f67fe7..d9ae0d39e 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"; + } + } + } + ''; } @@ -645,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 + 'msgtype' => 'receipt', ); - - } 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), - ); - - $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 { @@ -821,6 +796,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</cust_bill_pay>.) + +=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 @@ -889,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 ); } } @@ -1240,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" : ''; 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 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c5a3d2e58..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? } @@ -2296,9 +2285,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/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; 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<FS::deploy_zone_block> and L<FS::deploy_zone_vertex>. +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<FS::deploy_zone> 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/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; 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/msg_template.pm b/FS/FS/msg_template.pm index c52b6336e..d17fd41cb 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -4,25 +4,14 @@ 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::Record qw( qsearch qsearchs dbh ); -use FS::cust_main; use FS::cust_msg; use FS::template_content; +use Date::Format qw(time2str); + FS::UID->install_callback( sub { $conf = new FS::Conf; } ); $DEBUG=0; @@ -46,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. @@ -59,6 +54,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<FS::msg_template> subclass that this should belong to. +Defaults to 'email'. + =item agentnum - Agent associated with this template. Can be NULL for a global template. @@ -66,7 +64,11 @@ global template. =item from_addr - Source email address. -=item disabled - disabled ('Y' or NULL). +=item bcc_addr - Bcc all mail to this address. + +=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 @@ -87,40 +89,71 @@ points to. You can ask the object for a copy with the I<hash> 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 $@; + 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 + if ( $self->msgnum and $self->extension_table ) { + my $extension = $self->_extension; + if ( $extension ) { + my $ext_key = $extension->get($extension->primary_key); + $self->{Hash} = { $extension->hash, + $self->hash, + $extension->primary_key => $ext_key + }; + } + } + + $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. -A default (no locale) L<FS::template_content> object will be created. CONTENT -is an optional hash containing 'subject' and 'body' for this object. - =cut sub insert { my $self = shift; - my %content = @_; + $self->_rebless; 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; + # 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; - return $error; + dbh->rollback if $oldAutoCommit; + } else { + dbh->commit if $oldAutoCommit; } - - $dbh->commit if $oldAutoCommit; - return; + $error; } =item delete @@ -129,61 +162,73 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record +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. -CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If -supplied, an L<FS::template_content> 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 $new = shift; + my $old = shift || $new->replace_old; + 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 $error = $new->SUPER::replace($old, @_); + + my $extension = $new->_extension; + if ( $extension ) { + # merge changes into the extension record and replace it + $extension->{Hash} = { $extension->hash, $new->hash }; + $error ||= $extension->replace; } if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + dbh->rollback if $oldAutoCommit; + } else { + dbh->commit if $oldAutoCommit; } - - warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit; - $dbh->commit if $oldAutoCommit; - return; + $error; } - +sub replace_check { + my $self = shift; + 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); + } elsif ( $old->msgclass ne $self->msgclass ) { + return "Can't change message template class from ".$old->msgclass. + " to ".$self->msgclass."."; + } + } + ''; +} =item check @@ -204,8 +249,12 @@ 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 + # ever have more than two msgclasses + || $self->ut_enum('msgclass', [ qw(email http) ]), ; return $error if $error; @@ -214,25 +263,10 @@ sub check { $self->SUPER::check; } -=item content_locales - -Returns a hashref of the L<FS::template_content> 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<FS::cust_msg> 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 +310,23 @@ A hash reference of additional substitutions =cut sub prepare { + die "unimplemented"; +} + +=item prepare_substitutions OPTION => VALUE ... + +Takes the same arguments as L</prepare>, 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 +379,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/<br[^>]*>/\n/gsi; # and <br /> tags - s/<p>/\n/gsi; # and <p> - s/<\/p>//gsi; # and </p> - 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</prepare> (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 +403,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 +458,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 +635,11 @@ sub substitutions { =item content LOCALE -Returns the L<FS::template_content> 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 @@ -719,20 +660,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('<BR>',$conf->config($oldname, $agentnum)), @@ -743,6 +686,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; } } @@ -827,10 +772,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 +814,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/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 diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm new file mode 100644 index 000000000..377dbb17b --- /dev/null +++ b/FS/FS/msg_template/email.pm @@ -0,0 +1,592 @@ +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 ); + +# needed to manage prepared messages +use FS::cust_msg; + +FS::UID->install_callback( sub { $conf = new FS::Conf; } ); + +our $DEBUG = 0; +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<Text::Template> strings for the message subject line and body, and the +message is delivered by email. + +Currently the C<from_addr> and C<bcc_addr> 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<FS::template_content> 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<FS::template_content> 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<FS::template_content> 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<FS::cust_msg> 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<from_addr> 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. + +=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<FS::report_batch> and may +go away in the future. + +=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/<br[^>]*>/\n/gsi; # and <br /> tags + s/<p>/\n/gsi; # and <p> + s/<\/p>//gsi; # and </p> + 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 ); + + # override $body if requested + if ( $opt{'override_content'} ) { + warn "$me overriding template body with requested content" if $DEBUG; + $body = $opt{'override_content'}; + } + + ### + # 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'} || ''), + 'preview' => $body, # html content only + }); + + return $cust_msg; +} + +=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 ['', '', '']; +}; + +=item content LOCALE + +Returns the L<FS::template_content> 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' => '' }); +} + +=cut + +=item send_prepared CUST_MSG + +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 + +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", $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; +} + +=back + +=cut + +# internal use only + +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); +} + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/msg_template/http.pm b/FS/FS/msg_template/http.pm new file mode 100644 index 000000000..9c4e68bd7 --- /dev/null +++ b/FS/FS/msg_template/http.pm @@ -0,0 +1,159 @@ +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 + }; + # 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; + 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<FS::Record>, schema.html from the base documentation. + +=cut + +1; 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 C<scalar($cgi->Vars)> 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 +C<scalar($cgi->Vars)> 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_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; diff --git a/FS/FS/part_pkg/discount_Mixin.pm b/FS/FS/part_pkg/discount_Mixin.pm index 31802758c..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,9 @@ 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 = $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 @@ -80,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 / 100 ); - 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); @@ -133,63 +210,22 @@ sub calc_discount { }; } - $amount = min($amount, $br); - $amount *= $months; } $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 - $amount; - if ( $discount_left < 0 ) { - $amount = $br; - $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 ); - } sprintf('%.2f', $tot_discount); 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 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_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', 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; diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index df969a00f..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 @@ -222,6 +222,8 @@ I<format> - an L<FS::pay_batch> module I<gateway> - an L<FS::payment_gateway> object for a batch gateway. This takes precedence over I<format>. +I<no_close> - do not try to close batches + Supported format keys (defined in the specified FS::pay_batch module) are: I<filetype> - 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; ''; @@ -563,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) = @_; @@ -797,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/FS/pay_batch/RBC.pm b/FS/FS/pay_batch/RBC.pm index 53f810852..b0136786b 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,15 +45,28 @@ $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; - $hash->{'status'} eq ' ' + ($hash->{'status'} eq ' ') || ($hash->{'status'} eq 'W'); }, 'declined' => sub { my $hash = shift; @@ -112,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 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 diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 1b52ac4fc..67d124d02 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -97,6 +97,10 @@ Optional link to customer (see L<FS::cust_main>). 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,21 @@ sub update_statustext { #''; } +# 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 =head1 SUBROUTINES diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index 8ee9a83be..d26d11697 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -469,8 +469,8 @@ 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'}; + + $rate->default_detailnum($old->default_detailnum); $error = $rate->replace( $old, @param ); 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<FS::msg_template> 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<not> 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<style>\n$stylesheet\n</style>\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<FS::Record> + +=cut + +1; + 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+)$/ ) { 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'}; 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 "<a href=$reporturl>view</a>\n"; } 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<hash> 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; + '<IMG SRC="' + . $self->src + . '">'; +} + +=item process_image_delete + +Process for deleting an image. Run as a job using L<FS::queue>. + +=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<FS::queue>. + +=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<FS::Record> + +=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/bin/freeside-cdr-a2billing-import b/FS/bin/freeside-cdr-a2billing-import new file mode 100755 index 000000000..a8469e744 --- /dev/null +++ b/FS/bin/freeside-cdr-a2billing-import @@ -0,0 +1,209 @@ +#!/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/<digits>-<digits> or SIP/<digits>-<digits> +# 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 = ( + "$table.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". + " LEFT JOIN cc_card ON ( $table.card_id = cc_card.id ) ". + ' 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<FS::cdr> + +=cut + +1; 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 - diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 7c4cf1b64..36871b295 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -219,7 +219,11 @@ while (1) { $log->info('starting job ('.$ljob->job.')'); warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; local $FS::UID::AutoCommit = 0; # so that we can clean up failures - eval $eval; #throw away return value? suppose so + 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; 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 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 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"; |