diff options
Diffstat (limited to 'FS/FS')
67 files changed, 1184 insertions, 4663 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 92c4d22..08d31d2 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -108,7 +108,6 @@ tie my %rights, 'Tie::IxHash', 'View customer', #'View Customer | View tickets', 'Edit customer', - 'Edit customer tags', 'Edit referring customer', 'View customer history', 'Cancel customer', @@ -116,7 +115,6 @@ tie my %rights, 'Tie::IxHash', { rightname=>'Delete customer', desc=>"Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customer's packages if they cancel service." }, #aka. deletecustomers 'Bill customer now', #NEW 'Bulk send customer notices', #NEW - { rightname=>'View customers of all agents', global=>1 }, ], ### @@ -251,8 +249,6 @@ tie my %rights, 'Tie::IxHash', 'Billing event reports', 'Receivables report', 'Financial reports', - - #{ rightname => 'List customers of all agents', global=>1 }, ], ### @@ -289,9 +285,6 @@ tie my %rights, 'Tie::IxHash', 'Edit billing events', { rightname=>'Edit global billing events', global=>1 }, - 'Edit templates', - { rightname=>'Edit global templates', global=>1 }, - 'Edit inventory', { rightname=>'Edit global inventory', global=>1 }, @@ -301,9 +294,6 @@ tie my %rights, 'Tie::IxHash', { rightname=>'Broadband configuration' }, { rightname=>'Broadband global configuration', global=>1 }, - #{ rightname=>'Edit employees', global=>1, }, - #{ rightname=>'Edit employee groupss', global=>1, }, - { rightname=>'Configuration', global=>1 }, #most of the rest of the configuraiton is not agent-virtualized { rightname=>'Configuration download', }, #description of how it affects diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 9454784..f33a718 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -227,15 +227,9 @@ sub popurl { =cut sub rooturl { - my $url_string; - if ( scalar(@_) ) { - $url_string = shift; - } else { - # better to start with the client-provided URL - my $cgi = &FS::UID::cgi; - $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url; - } - + # better to start with the client-provided URL + my $cgi = &FS::UID::cgi; + my $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url; $url_string =~ s/\?.*//; #even though this is kludgy diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 8003613..71fe752 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -632,7 +632,7 @@ sub process_payment { validate($payinfo) or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo return { 'error' => gettext('unknown_card_type') } - if $payinfo !~ /^99\d{14}$/ && cardtype($payinfo) eq "Unknown"; + if cardtype($payinfo) eq "Unknown"; if ( length($p->{'paycvv'}) && $p->{'paycvv'} !~ /^\s*$/ ) { if ( cardtype($payinfo) eq 'American Express card' ) { @@ -683,7 +683,7 @@ sub process_payment { stateid stateid_state ); $new->set( 'payby' => $p->{'auto'} ? 'CHEK' : 'DCHK' ); } - $new->set( 'payinfo' => $cust_main->card_token || $payinfo ); + $new->set( 'payinfo' => $payinfo ); $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' ); my $error = $new->replace($cust_main); if ( $error ) { @@ -1344,7 +1344,7 @@ sub _do_bop_realtime { my $bill_error = $cust_main->bill || $cust_main->apply_payments_and_credits - || $cust_main->realtime_collect; + || $cust_main->collect('realtime' => 1); if ( $cust_main->balance > $old_balance && $cust_main->balance > 0 diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 5d70325..b9cd6c6 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -649,10 +649,14 @@ sub new_customer { # " new customer: $bill_error" # if $bill_error; - $bill_error = $cust_main->realtime_collect( - method => FS::payby->payby2bop( $packet->{payby} ), - depend_jobnum => $placeholder->jobnum, - ); + if ($cust_main->_new_bop_required()) { + $bill_error = $cust_main->realtime_collect( + method => FS::payby->payby2bop( $packet->{payby} ), + depend_jobnum => $placeholder->jobnum, + ); + } else { + $bill_error = $cust_main->collect('realtime' => 1); + } #warn "[fs_signup_server] error collecting from new customer: $bill_error" # if $bill_error; diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm deleted file mode 100644 index 138ad06..0000000 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ /dev/null @@ -1,146 +0,0 @@ -package FS::ClientAPI_XMLRPC; - -=head1 NAME - -FS::ClientAPI_XMLRPC - Freeside XMLRPC accessible self-service API, on the backend - -=head1 SYNOPSIS - -This module implements the self-service API offered by xmlrpc.cgi and friends, -but on a backend machine. - -=head1 DESCRIPTION - -Use this API to implement your own client "self-service" module vi XMLRPC. - -Each routine described in L<FS::SelfService> is available vi XMLRPC as the -method FS.SelfService.XMLRPC.B<method>. All values are passed to the -selfservice-server in a struct of strings. The return values are in a -struct as strings, arrays, or structs as appropriate for the values -described in L<FS::SelfService>. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::SelfService::XMLRPC>, L<FS::SelfService> - -=cut - -use strict; - -use vars qw($DEBUG $AUTOLOAD); -use FS::ClientAPI; - -$DEBUG = 0; -$FS::ClientAPI::DEBUG = $DEBUG; - -sub AUTOLOAD { - my $call = $AUTOLOAD; - $call =~ s/^FS::(SelfService::|ClientAPI_)XMLRPC:://; - - warn "FS::ClientAPI_XMLRPC::AUTOLOAD $call\n" if $DEBUG; - - my $autoload = &ss2clientapi; - - if (exists($autoload->{$call})) { - shift; #discard package name; - #$call = "FS::SelfService::$call"; - #no strict 'refs'; - #&{$call}(@_); - #FS::ClientAPI->dispatch($autoload->{$call}, @_); - FS::ClientAPI->dispatch($autoload->{$call}, { @_ } ); - }else{ - die "No such procedure: $call"; - } -} - -#terrible false laziness w/SelfService.pm -# - fix at build time, by including some file in both selfserv and backend libs? -# - or fix at runtime, by having selfservice client ask server for the list? -sub ss2clientapi { - { - 'passwd' => 'passwd/passwd', - 'chfn' => 'passwd/passwd', - 'chsh' => 'passwd/passwd', - 'login_info' => 'MyAccount/login_info', - 'login' => 'MyAccount/login', - 'logout' => 'MyAccount/logout', - 'customer_info' => 'MyAccount/customer_info', - 'edit_info' => 'MyAccount/edit_info', #add to ss cgi! - 'invoice' => 'MyAccount/invoice', - 'invoice_logo' => 'MyAccount/invoice_logo', - 'list_invoices' => 'MyAccount/list_invoices', #? - 'cancel' => 'MyAccount/cancel', #add to ss cgi! - 'payment_info' => 'MyAccount/payment_info', - 'payment_info_renew_info' => 'MyAccount/payment_info_renew_info', - 'process_payment' => 'MyAccount/process_payment', - 'process_payment_order_pkg' => 'MyAccount/process_payment_order_pkg', - 'process_payment_change_pkg' => 'MyAccount/process_payment_change_pkg', - 'process_payment_order_renew' => 'MyAccount/process_payment_order_renew', - 'process_prepay' => 'MyAccount/process_prepay', - 'realtime_collect' => 'MyAccount/realtime_collect', - 'list_pkgs' => 'MyAccount/list_pkgs', #add to ss (added?) - 'list_svcs' => 'MyAccount/list_svcs', #add to ss (added?) - 'list_svc_usage' => 'MyAccount/list_svc_usage', - 'list_cdr_usage' => 'MyAccount/list_cdr_usage', - 'list_support_usage' => 'MyAccount/list_support_usage', - 'order_pkg' => 'MyAccount/order_pkg', #add to ss cgi! - 'change_pkg' => 'MyAccount/change_pkg', - 'order_recharge' => 'MyAccount/order_recharge', - 'renew_info' => 'MyAccount/renew_info', - 'order_renew' => 'MyAccount/order_renew', - 'cancel_pkg' => 'MyAccount/cancel_pkg', #add to ss cgi! - 'charge' => 'MyAccount/charge', #? - 'part_svc_info' => 'MyAccount/part_svc_info', - 'provision_acct' => 'MyAccount/provision_acct', - 'provision_external' => 'MyAccount/provision_external', - 'unprovision_svc' => 'MyAccount/unprovision_svc', - 'myaccount_passwd' => 'MyAccount/myaccount_passwd', - 'create_ticket' => 'MyAccount/create_ticket', - 'signup_info' => 'Signup/signup_info', - 'skin_info' => 'MyAccount/skin_info', - 'access_info' => 'MyAccount/access_info', - 'domain_select_hash' => 'Signup/domain_select_hash', # expose? - 'new_customer' => 'Signup/new_customer', - 'capture_payment' => 'Signup/capture_payment', - 'agent_login' => 'Agent/agent_login', - 'agent_logout' => 'Agent/agent_logout', - 'agent_info' => 'Agent/agent_info', - 'agent_list_customers' => 'Agent/agent_list_customers', - 'mason_comp' => 'MasonComponent/mason_comp', - 'call_time' => 'PrepaidPhone/call_time', - 'call_time_nanpa' => 'PrepaidPhone/call_time_nanpa', - 'phonenum_balance' => 'PrepaidPhone/phonenum_balance', - 'bulk_processrow' => 'Bulk/processrow', - 'check_username' => 'Bulk/check_username', - #sg - 'ping' => 'SGNG/ping', - 'decompify_pkgs' => 'SGNG/decompify_pkgs', - 'previous_payment_info' => 'SGNG/previous_payment_info', - 'previous_payment_info_renew_info' - => 'SGNG/previous_payment_info_renew_info', - 'previous_process_payment' => 'SGNG/previous_process_payment', - 'previous_process_payment_order_pkg' - => 'SGNG/previous_process_payment_order_pkg', - 'previous_process_payment_change_pkg' - => 'SGNG/previous_process_payment_change_pkg', - 'previous_process_payment_order_renew' - => 'SGNG/previous_process_payment_order_renew', - }; -} - - -#XXX submit patch to SOAP::Lite - -use XMLRPC::Transport::HTTP; - -package XMLRPC::Transport::HTTP::Server; - -@XMLRPC::Transport::HTTP::Server::ISA = qw(SOAP::Transport::HTTP::Server); - -sub initialize; *initialize = \&XMLRPC::Server::initialize; -sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault; -sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response; - -1; diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index ce8bd29..a1ee23c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -549,36 +549,21 @@ worry that config_items is freeside-specific and icky. "Solo", ); -@base_items = qw( -invoice_template -invoice_latex -invoice_latexreturnaddress -invoice_latexfooter -invoice_latexsmallfooter -invoice_latexnotes -invoice_latexcoupon -invoice_html -invoice_htmlreturnaddress -invoice_htmlfooter -invoice_htmlnotes -logo.png -logo.eps -); - -my %msg_template_options = ( - 'type' => 'select-sub', - 'options_sub' => sub { require FS::Record; - require FS::agent; - require FS::msg_template; - map { $_->msgnum, $_->msgname } - qsearch('msg_template', { disabled => '' }); - }, - 'option_sub' => sub { require FS::msg_template; - my $msg_template = FS::msg_template->by_key(shift); - $msg_template ? $msg_template->msgname : '' - }, -); - +@base_items = qw ( + invoice_template + invoice_latex + invoice_latexreturnaddress + invoice_latexfooter + invoice_latexsmallfooter + invoice_latexnotes + invoice_latexcoupon + invoice_html + invoice_htmlreturnaddress + invoice_htmlfooter + invoice_htmlnotes + logo.png + logo.eps + ); #Billing (81 items) #Invoicing (50 items) @@ -587,6 +572,7 @@ my %msg_template_options = ( #... #Unclassified (77 items) + @config_items = map { new FS::ConfItem $_ } ( { @@ -598,7 +584,7 @@ my %msg_template_options = ( { 'key' => 'alert_expiration', - 'section' => 'notification', + 'section' => 'billing', 'description' => 'Enable alerts about billing method expiration (i.e. expiring credit cards).', 'type' => 'checkbox', 'per_agent' => 1, @@ -606,18 +592,11 @@ my %msg_template_options = ( { 'key' => 'alerter_template', - 'section' => 'deprecated', - 'description' => 'Template file for billing method expiration alerts (i.e. expiring credit cards).', + 'section' => 'billing', + 'description' => 'Template file for billing method expiration alerts (i.e. expiring credit cards). See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#Credit_cards_and_Electronic_checks">billing documentation</a> for details.', 'type' => 'textarea', 'per_agent' => 1, }, - - { - 'key' => 'alerter_msgnum', - 'section' => 'notification', - 'description' => 'Template to use for credit card expiration alerts.', - %msg_template_options, - }, { 'key' => 'apacheip', @@ -738,13 +717,6 @@ my %msg_template_options = ( }, { - 'key' => 'business-onlinepayment-test_transaction', - 'section' => 'billing', - 'description' => 'Turns on the Business::OnlinePayment test_transaction flag. Note that not all gateway modules support this flag; if yours does not, transactions will still be sent live.', - 'type' => 'checkbox', - }, - - { 'key' => 'countrydefault', 'section' => 'UI', 'description' => 'Default two-letter country code (if not supplied, the default is `US\')', @@ -997,55 +969,6 @@ my %msg_template_options = ( }, { - 'key' => 'invoice_latextopmargin', - 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice topmargin setting. Include units.', - 'type' => 'text', - 'per_agent' => 1, - 'validate' => sub { shift =~ - /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/ - ? '' : 'Invalid LaTex length'; - }, - }, - - { - 'key' => 'invoice_latexheadsep', - 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice headsep setting. Include units.', - 'type' => 'text', - 'per_agent' => 1, - 'validate' => sub { shift =~ - /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/ - ? '' : 'Invalid LaTex length'; - }, - }, - - { - 'key' => 'invoice_latexaddresssep', - 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice separation between invoice header -and customer address. Include units.', - 'type' => 'text', - 'per_agent' => 1, - 'validate' => sub { shift =~ - /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/ - ? '' : 'Invalid LaTex length'; - }, - }, - - { - 'key' => 'invoice_latextextheight', - 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice textheight setting. Include units.', - 'type' => 'text', - 'per_agent' => 1, - 'validate' => sub { shift =~ - /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/ - ? '' : 'Invalid LaTex length'; - }, - }, - - { 'key' => 'invoice_latexnotes', 'section' => 'invoicing', 'description' => 'Notes section for LaTeX typeset PostScript invoices.', @@ -1078,53 +1001,6 @@ and customer address. Include units.', }, { - 'key' => 'invoice_latexextracouponspace', - 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice textheight space to reserve for a tear off coupon. Include units.', - 'type' => 'text', - 'per_agent' => 1, - 'validate' => sub { shift =~ - /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/ - ? '' : 'Invalid LaTex length'; - }, - }, - - { - 'key' => 'invoice_latexcouponfootsep', - 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice separation between tear off coupon and footer. Include units.', - 'type' => 'text', - 'per_agent' => 1, - 'validate' => sub { shift =~ - /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/ - ? '' : 'Invalid LaTex length'; - }, - }, - - { - 'key' => 'invoice_latexcouponamountenclosedsep', - 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice separation between total due and amount enclosed line. Include units.', - 'type' => 'text', - 'per_agent' => 1, - 'validate' => sub { shift =~ - /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/ - ? '' : 'Invalid LaTex length'; - }, - }, - { - 'key' => 'invoice_latexcoupontoaddresssep', - 'section' => 'invoicing', - 'description' => 'Optional LaTeX invoice separation between invoice data and the to address (usually invoice_latexreturnaddress). Include units.', - 'type' => 'text', - 'per_agent' => 1, - 'validate' => sub { shift =~ - /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/ - ? '' : 'Invalid LaTex length'; - }, - }, - - { 'key' => 'invoice_latexreturnaddress', 'section' => 'invoicing', 'description' => 'Return address for LaTeX typeset PostScript invoices.', @@ -1132,22 +1008,6 @@ and customer address. Include units.', }, { - 'key' => 'invoice_latexverticalreturnaddress', - 'section' => 'invoicing', - 'description' => 'Place the return address under the company logo rather than beside it.', - 'type' => 'checkbox', - 'per_agent' => 1, - }, - - { - 'key' => 'invoice_latexcouponaddcompanytoaddress', - 'section' => 'invoicing', - 'description' => 'Add the company name to the To address on the remittance coupon because the return address does not contain it.', - 'type' => 'checkbox', - 'per_agent' => 1, - }, - - { 'key' => 'invoice_latexsmallfooter', 'section' => 'invoicing', 'description' => 'Optional small footer for multi-page LaTeX typeset PostScript invoices.', @@ -1169,12 +1029,6 @@ and customer address. Include units.', 'type' => 'textarea' }, - { - 'key' => 'invoice_print_pdf', - 'section' => 'invoicing', - 'description' => 'Store postal invoices for download in PDF format rather than printing them directly.', - 'type' => 'checkbox', - }, { 'key' => 'invoice_default_terms', @@ -1241,22 +1095,15 @@ and customer address. Include units.', }, { - 'key' => 'payment_receipt_msgnum', - 'section' => 'notification', - 'description' => 'Template to use for payment receipts.', - %msg_template_options, - }, - - { '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.', + 'section' => 'billing', + 'description' => 'Template file for payment receipts. Payment receipts are sent to the customer email invoice destination(s) when a payment is received. 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>$date</code> <li><code>$name</code> <li><code>$paynum</code> - Freeside payment number <li><code>$paid</code> - Amount of payment <li><code>$payby</code> - Payment type (Card, Check, Electronic check, etc.) <li><code>$payinfo</code> - Masked credit card number or check number <li><code>$balance</code> - New balance<li><code>$pkg</code> - Package (requires payment_receipt-trigger set to "when payment is applied".)</ul>', 'type' => [qw( checkbox textarea )], }, { 'key' => 'payment_receipt-trigger', - 'section' => 'notification', + 'section' => 'billing', 'description' => 'When payment receipts are triggered. Defaults to when payment is made.', 'type' => 'select', 'select_hash' => [ @@ -1785,7 +1632,6 @@ and customer address. Include units.', 'description' => 'Run billing for signup server signups immediately, and do not provision accounts which subsequently have a balance.', 'type' => 'checkbox', }, - { 'key' => 'signup_server-classnum2', 'section' => 'self-service', @@ -1801,13 +1647,6 @@ and customer address. Include units.', }, { - 'key' => 'selfservice-xmlrpc', - 'section' => 'self-service', - 'description' => 'Run a standalone self-service XML-RPC server on the backend (on port 8080).', - 'type' => 'checkbox', - }, - - { 'key' => 'backend-realtime', 'section' => 'billing', 'description' => 'Run billing for backend signups immediately.', @@ -1815,58 +1654,44 @@ and customer address. Include units.', }, { - 'key' => 'decline_msgnum', - 'section' => 'notification', - 'description' => 'Template to use for credit card and electronic check decline messages.', - %msg_template_options, - }, - - { 'key' => 'declinetemplate', - 'section' => 'deprecated', + 'section' => 'billing', 'description' => 'Template file for credit card and electronic check decline emails.', 'type' => 'textarea', }, { 'key' => 'emaildecline', - 'section' => 'notification', + 'section' => 'billing', 'description' => 'Enable emailing of credit card and electronic check decline notices.', 'type' => 'checkbox', }, { 'key' => 'emaildecline-exclude', - 'section' => 'notification', + 'section' => 'billing', 'description' => 'List of error messages that should not trigger email decline notices, one per line.', 'type' => 'textarea', }, { - 'key' => 'cancel_msgnum', - 'section' => 'notification', - 'description' => 'Template to use for cancellation emails.', - %msg_template_options, - }, - - { 'key' => 'cancelmessage', - 'section' => 'deprecated', + 'section' => 'billing', 'description' => 'Template file for cancellation emails.', 'type' => 'textarea', }, { 'key' => 'cancelsubject', - 'section' => 'deprecated', + 'section' => 'billing', '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.', + 'section' => 'billing', + 'description' => 'Enable emailing of cancellation notices. Make sure to fill in the cancelmessage and cancelsubject configuration values as well.', 'type' => 'checkbox', }, @@ -1920,23 +1745,16 @@ and customer address. Include units.', }, { - 'key' => 'welcome_msgnum', - 'section' => 'notification', - 'description' => 'Template to use for welcome messages when a svc_acct record is created.', - %msg_template_options, - }, - - { '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.', + 'section' => '', + '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. 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></ul>', 'type' => 'textarea', 'per_agent' => 1, }, { 'key' => 'welcome_email-from', - 'section' => 'deprecated', + 'section' => '', 'description' => 'From: address header for welcome email', 'type' => 'text', 'per_agent' => 1, @@ -1944,7 +1762,7 @@ and customer address. Include units.', { 'key' => 'welcome_email-subject', - 'section' => 'deprecated', + 'section' => '', 'description' => 'Subject: header for welcome email', 'type' => 'text', 'per_agent' => 1, @@ -1952,7 +1770,7 @@ and customer address. Include units.', { 'key' => 'welcome_email-mimetype', - 'section' => 'deprecated', + 'section' => '', 'description' => 'MIME type for welcome email', 'type' => 'select', 'select_enum' => [ 'text/plain', 'text/html' ], @@ -1966,44 +1784,37 @@ and customer address. Include units.', 'type' => 'textarea', }, -# { -# 'key' => 'warning_msgnum', -# 'section' => 'notification', -# 'description' => 'Template to use for warning messages, sent to the customer email invoice destination(s) when a svc_acct record has its usage drop below a threshold.', -# %msg_template_options, -# }, - { 'key' => 'warning_email', - 'section' => 'notification', + 'section' => '', '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', + 'section' => '', 'description' => 'From: address header for warning email', 'type' => 'text', }, { 'key' => 'warning_email-cc', - 'section' => 'notification', + 'section' => '', 'description' => 'Additional recipient(s) (comma separated) for warning email when remaining usage reaches zero.', 'type' => 'text', }, { 'key' => 'warning_email-subject', - 'section' => 'notification', + 'section' => '', 'description' => 'Subject: header for warning email', 'type' => 'text', }, { 'key' => 'warning_email-mimetype', - 'section' => 'notification', + 'section' => '', 'description' => 'MIME type for warning email', 'type' => 'select', 'select_enum' => [ 'text/plain', 'text/html' ], @@ -2250,14 +2061,6 @@ and customer address. Include units.', }, { - 'key' => 'global_unique-pbx_title', - 'section' => '', - 'description' => 'Global phone number uniqueness control: enabled (usual setting - svc_pbx.title must be unique), or disabled turns off duplicate checking for this field.', - 'type' => 'select', - 'select_enum' => [ 'enabled', 'disabled' ], - }, - - { 'key' => 'svc_external-skip_manual', 'section' => 'UI', 'description' => 'When provisioning svc_external services, skip manual entry of id and title fields in the UI. Usually used in conjunction with an export that populates these fields (i.e. artera_turbo).', @@ -2307,12 +2110,7 @@ and customer address. Include units.', } }, }, - { - 'key' => 'ticket_system-force_default_queueid', - 'section' => '', - 'description' => 'Disallow queue selection when creating new tickets from customer view.', - 'type' => 'checkbox', - }, + { 'key' => 'ticket_system-selfservice_queueid', 'section' => '', @@ -2635,13 +2433,6 @@ and customer address. Include units.', }, { - 'key' => 'cgp_rule-domain_templates', - 'section' => '', - 'description' => 'Communigate Pro rule templates for domains, one per line, "svcnum Name"', - 'type' => 'textarea', - }, - - { 'key' => 'svc_forward-no_srcsvc', 'section' => '', 'description' => "Don't allow forwards from existing accounts, only arbitrary addresses. Useful when exporting to systems such as Communigate Pro which treat forwards in this fashion.", @@ -2936,15 +2727,8 @@ and customer address. Include units.', }, { - 'key' => 'impending_recur_msgnum', - 'section' => 'notification', - 'description' => 'Template to use for alerts about first-time recurring billing.', - %msg_template_options, - }, - - { 'key' => 'impending_recur_template', - 'section' => 'deprecated', + 'section' => 'billing', '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', @@ -3224,13 +3008,6 @@ and customer address. Include units.', }, { - 'key' => 'disable_settings_changes', - 'section' => '', - 'description' => 'Disable all settings changes, for demos, except for the usernames given in the comma-separated list.', - 'type' => [qw( checkbox text )], - }, - - { 'key' => 'cust_main-edit_agent_custid', 'section' => 'UI', 'description' => 'Enable editing of the agent_custid field.', @@ -3570,22 +3347,6 @@ and customer address. Include units.', }, { - 'key' => 'cdr-charged_party-field', - 'section' => '', - 'description' => 'Set the charged_party field of CDRs to this field.', - 'type' => 'select-sub', - 'options_sub' => sub { my $fields = FS::cdr->table_info->{'fields'}; - map { $_ => $fields->{$_}||$_ } - grep { $_ !~ /^(acctid|charged_party)$/ } - FS::Schema::dbdef->table('cdr')->columns; - }, - 'option_sub' => sub { my $f = shift; - FS::cdr->table_info->{'fields'}{$f} || $f; - }, - }, - - #probably deprecate in favor of cdr-charged_party-field above - { 'key' => 'cdr-charged_party-accountcode', 'section' => '', 'description' => 'Set the charged_party field of CDRs to the accountcode.', @@ -3670,14 +3431,6 @@ and customer address. Include units.', }, { - 'key' => 'mc-outbound_packages', - 'section' => '', - 'description' => "Don't use this.", - 'type' => 'select-part_pkg', - 'multiple' => 1, - }, - - { 'key' => 'disable-cust-pkg_class', 'section' => 'UI', 'description' => 'Disable the two-step dropdown for selecting package class and package, and return to the classic single dropdown.', @@ -3850,48 +3603,6 @@ and customer address. Include units.', 'type' => 'checkbox', }, - { - 'key' => 'cust_main-exports', - 'section' => '', - 'description' => 'Export(s) to call on cust_main insert, modification and deletion.', - 'type' => 'select-sub', - 'multiple' => 1, - 'options_sub' => sub { - require FS::Record; - require FS::part_export; - my @part_export = - map { qsearch( 'part_export', {exporttype => $_ } ) } - keys %{FS::part_export::export_info('cust_main')}; - map { $_->exportnum => $_->exporttype.' to '.$_->machine } @part_export; - }, - 'option_sub' => sub { - require FS::Record; - require FS::part_export; - my $part_export = FS::Record::qsearchs( - 'part_export', { 'exportnum' => shift } - ); - $part_export - ? $part_export->exporttype.' to '.$part_export->machine - : ''; - }, - }, - - { - 'key' => 'cust_tag-location', - 'section' => 'UI', - 'description' => 'Location where customer tags are displayed.', - 'type' => 'select', - 'select_enum' => [ 'misc_info', 'top' ], - }, - - { - 'key' => 'maestro-status_test', - 'section' => 'UI', - 'description' => 'Display a link to the maestro status test page on the customer view page', - 'type' => 'checkbox', - }, - - { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, diff --git a/FS/FS/Cron/alert_expiration.pm b/FS/FS/Cron/alert_expiration.pm index 364fc60..a9b9da9 100644 --- a/FS/FS/Cron/alert_expiration.pm +++ b/FS/FS/Cron/alert_expiration.pm @@ -2,7 +2,7 @@ package FS::Cron::alert_expiration; use vars qw( @ISA @EXPORT_OK); use Exporter; -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch); use FS::Conf; use FS::cust_main; use FS::Misc; @@ -58,7 +58,6 @@ sub alert_expiration { } return if(!@customers); foreach my $customer (@customers) { - next if !($customer->ncancelled_pkgs); # skip inactive customers my $paydate = $customer->paydate; next if $paydate =~ /^\s*$/; # skip empty expiration dates @@ -92,32 +91,25 @@ sub alert_expiration { if (grep { $expire_time < $_date + $_ && $expire_time > $_date + $_ - $window_time } ($warning_time, $urgent_time, $panic_time) ) { - # Send an expiration notice. my $agentnum = $customer->agentnum; - my $error = ''; - - my $msgnum = $conf->config('alerter_msgnum', $agentnum); - if ( $msgnum ) { # new hotness - my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } ); - $error = $msg_template->send('cust_main' => $customer); - } - else { #!$msgnum, the hard way - $mail_sender = $conf->config('invoice_from', $agentnum); - $failure_recipient = $conf->config('invoice_from', $agentnum) - || 'postmaster'; - - my @alerter_template = $conf->config('alerter_template', $agentnum) - or die 'cannot load config file alerter_template'; - - my $alerter = new Text::Template(TYPE => 'ARRAY', - SOURCE => [ - map "$_\n", @alerter_template - ]) - or die "can't create Text::Template object: $Text::Template::ERROR"; - - $alerter->compile() - or die "can't compile template: $Text::Template::ERROR"; - + $mail_sender = $conf->config('invoice_from', $agentnum); + $failure_recipient = $conf->config('invoice_from', $agentnum) + || 'postmaster'; + + my @alerter_template = $conf->config('alerter_template', $agentnum) + or die 'cannot load config file alerter_template'; + + my $alerter = new Text::Template(TYPE => 'ARRAY', + SOURCE => [ + map "$_\n", @alerter_template + ]) + or die "can't create Text::Template object: $Text::Template::ERROR"; + + $alerter->compile() + or die "can't compile template: $Text::Template::ERROR"; + + my @packages = $customer->ncancelled_pkgs; + if(@packages) { my @invoicing_list = $customer->invoicing_list; my @to_addrs = grep { $_ ne 'POST' } @invoicing_list; if(@to_addrs) { @@ -141,29 +133,26 @@ sub alert_expiration { $fill_in{'payby'} = 'current method'; } # Send it already! - $error = FS::Misc::send_email ( + my $error = FS::Misc::send_email ( from => $mail_sender, to => [ @to_addrs ], subject => 'Billing Arrangement Expiration', body => [ $alerter->fill_in( HASH => \%fill_in ) ], ); - } - else { # if(@to_addrs) - push @{$agent_failure_body{$customer->agentnum}}, - sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, - $custnum, - $first . " " . $last . " " . $company, - $payby, - $paydate, - $daytime, - $night ); - } - } # if($msgnum) - -# should we die here rather than report failure as below? - die "can't send expiration alert: $error" - if $error; - + die "can't send expiration alert: $error" + if $error; + } + else { # if(@to_addrs) + push @{$agent_failure_body{$customer->agentnum}}, + sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, + $custnum, + $first . " " . $last . " " . $company, + $payby, + $paydate, + $daytime, + $night ); + } + } # if(@packages) } # if(expired) } # foreach(@customers) diff --git a/FS/FS/Cron/notify.pm b/FS/FS/Cron/notify.pm index ece96fc..5b0e186 100644 --- a/FS/FS/Cron/notify.pm +++ b/FS/FS/Cron/notify.pm @@ -21,8 +21,6 @@ sub notify_flat_delay { #we're at now now (and later). my($time) = $^T; - my $conf = new FS::Conf; - my $error = ''; my $integer = driver_name =~ /^mysql/ ? 'SIGNED' : 'INTEGER'; @@ -103,20 +101,14 @@ END push @cust_pkgs, $cust_pkg[0]; shift @cust_pkg; } - my $msgnum = $conf->config('impending_recur_msgnum',$cust_main->agentnum); - if ( $msgnum ) { - my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); - $error = $msg_template->send('cust_main' => $cust_main); - } - else { - $error = $cust_main->notify( 'impending_recur_template', + my $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/Daemon.pm b/FS/FS/Daemon.pm index b58cde4..ca18134 100644 --- a/FS/FS/Daemon.pm +++ b/FS/FS/Daemon.pm @@ -1,13 +1,11 @@ package FS::Daemon; use vars qw( @ISA @EXPORT_OK ); -use vars qw( $pid_dir $me $pid_file $sigint $sigterm $NOSIG $logfile ); +use vars qw( $pid_dir $me $pid_file $sigint $sigterm $logfile ); use Exporter; use Fcntl qw(:flock); use POSIX qw(setsid); use IO::File; -use File::Basename; -use File::Slurp qw(slurp); use Date::Format; #this is a simple refactoring of the stuff from freeside-queued, just to @@ -21,19 +19,10 @@ use Date::Format; $pid_dir = '/var/run'; -$NOSIG = 0; -$PID_NEWSTYLE = 0; - sub daemonize1 { $me = shift; - $pid_file = $pid_dir; - if ( $PID_NEWSTYLE ) { - $pid_file .= '/freeside'; - mkdir $pid_file unless -d $pid_file; - chown $FS::UID::freeside_uid, -1, $pid_file; - } - $pid_file .= "/$me"; + $pid_file = "$pid_dir/$me"; $pid_file .= '.'.shift if scalar(@_); $pid_file .= '.pid'; @@ -44,7 +33,6 @@ sub daemonize1 { print "$me started with pid $pid\n"; #logging to $log_file\n"; exit unless $pid_file; my $pidfh = new IO::File ">$pid_file" or exit; - chown $FS::UID::freeside_uid, -1, $pid_file; print $pidfh "$pid\n"; exit; } @@ -53,10 +41,8 @@ sub daemonize1 { #$SIG{CHLD} = \&REAPER; $sigterm = 0; $sigint = 0; - unless ( $NOSIG ) { - $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; - $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; - } + $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; + $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; } sub drop_root { @@ -92,18 +78,13 @@ sub sigterm { $sigterm; } sub logfile { $logfile = shift; } #_logmsg('test'); } sub myexit { - chomp( my $pid = slurp($pid_file) ); - unlink $pid_file if -e $pid_file && $$ == $pid; + unlink $pid_file if -e $pid_file; exit; } sub _die { - die @_ if $^S; # $^S = 1 during an eval(), don't break exception handling my $msg = shift; - - chomp( my $pid = slurp($pid_file) ); - unlink $pid_file if -e $pid_file && $$ == $pid; - + unlink $pid_file if -e $pid_file; _logmsg($msg); } @@ -117,4 +98,3 @@ sub _logmsg { close $log; } -1; diff --git a/FS/FS/Maestro.pm b/FS/FS/Maestro.pm deleted file mode 100644 index 0569368..0000000 --- a/FS/FS/Maestro.pm +++ /dev/null @@ -1,139 +0,0 @@ -package FS::Maestro; - -use Date::Format; -use FS::Conf; -use FS::Record qw( qsearchs ); -use FS::cust_main; - -sub customer_status { - my( $custnum ) = shift; #@_; - my $svcnum = @_ ? shift : ''; - - my $curuser = $FS::CurrentUser::CurrentUser; - - my $cust_main = qsearchs({ - 'table' => 'cust_main', - 'hashref' => { 'custnum' => $custnum }, - 'extra_sql' => ' AND '. $curuser->agentnums_sql, - }) - or return { 'status' => 'E', - 'error' => "custnum $custnum not found" }; - - my( $svc_pbx, $good_till, $outbound_service ) = ( '', '', '' ); - my %result = (); - if ( $svcnum ) { - - ### - # reseller scenario to maestro (customer w/ multiple packages) - ### - - # find $svc_pbx - - $svc_pbx = qsearchs({ - 'table' => 'svc_pbx', - 'addl_from' => ' LEFT JOIN cust_svc USING ( svcnum ) '. - ' LEFT JOIN cust_pkg USING ( pkgnum ) ', - 'hashref' => { 'svcnum' => $svcnum }, - 'extra_sql' => " AND custnum = $custnum", - }) - or return { 'status' => 'E', - 'error' => "svcnum $svcnum not found" }; - - #status in the reseller scenario - - my $cust_pkg = $svc_pbx->cust_svc->cust_pkg; - - $result{'status'} = substr($cust_pkg->ucfirst_status,0,1); - - # find "outbound service" y/n - - #XXX outbound service per-reseller ? - #my @cust_pkg = $cust_main->cust_pkg; - # - #my $conf = new FS::Conf; - #my %outbound_pkgs = map { $_=>1 } $conf->config('mc-outbound_packages'); - #my $outbound_service = - # scalar( grep { $outbound_pkgs{ $_->pkgpart } - # && !$_->get('cancel') - # } - # @cust_pkg - # ) - # ? 1 : 0; - - # find "good till" date/time stamp (this package) - - $good_till = time2str('%c', $cust_pkg->bill || time ); - - } else { - - ### - # regular customer to maestro (single package) - ### - - my @cust_pkg = $cust_main->cust_pkg; - - #things specific to the non-reseller scenario - - $result{'status'} = substr($cust_main->ucfirst_status,0,1); - - $result{'products'} = - [ map $_->pkgpart, grep !$_->get('cancel'), @cust_pkg ]; - - #find svc_pbx - - my @cust_svc = map $_->cust_svc, @cust_pkg; - - my @cust_svc_pbx = - grep { my($n,$l,$t) = $_->label; $t eq 'svc_pbx' } - @cust_svc; - - if ( ! @cust_svc_pbx ) { - return { 'status' => 'E', - 'error' => "customer $custnum has no conference service" }; - } elsif ( scalar(@cust_svc_pbx) > 1 ) { - return { 'status' => 'E', - 'error' => - "customer $custnum has more than one conference". - " service (reseller?); specify a svcnum as a second argument", - }; - } - - my $cust_svc_pbx = $cust_svc_pbx[0]; - - $svc_pbx = $cust_svc_pbx->svc_x; - - # find "outbound service" y/n - - my $conf = new FS::Conf; - my %outbound_pkgs = map { $_=>1 } $conf->config('mc-outbound_packages'); - $outbound_service = - scalar( grep { $outbound_pkgs{ $_->pkgpart } - && !$_->get('cancel') - } - @cust_pkg - ) - ? 1 : 0; - - # find "good till" date/time stamp - - my @active_cust_pkg = - sort { $a->bill <=> $b->bill } - grep { !$_->get('cancel') && $_->part_pkg->freq ne '0' } - @cust_pkg; - $good_till = time2str('%c', $active_cust_pkg[0]->bill || time ); - - } - - return { - 'name' => $cust_main->name, - 'email' => $cust_main->invoicing_list_emailonly_scalar, - 'max_lines' => $svc_pbx ? $svc_pbx->max_extensions : '', - 'max_simultaneous' => $svc_pbx ? $svc_pbx->max_simultaneous : '', - 'outbound_service' => $outbound_service, - 'good_till' => $good_till, - %result, - }; - -} - -1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 0f14150..10edd6d 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -73,8 +73,6 @@ if ( -e $addl_handler_use_file ) { use HTML::FormatText; use HTML::Defang; use JSON; -# use XMLRPC::Transport::HTTP; -# use XMLRPC::Lite; # for XMLRPC::Serializer use MIME::Base64; use IO::Handle; use IO::File; @@ -219,7 +217,6 @@ if ( -e $addl_handler_use_file ) { use FS::part_pkg_report_option; use FS::cust_attachment; use FS::h_cust_pkg; - use FS::h_inventory_item; use FS::h_svc_acct; use FS::h_svc_broadband; use FS::h_svc_domain; @@ -242,12 +239,6 @@ if ( -e $addl_handler_use_file ) { use FS::cgp_rule; use FS::cgp_rule_condition; use FS::cgp_rule_action; - use FS::bill_batch; - use FS::cust_bill_batch; - use FS::rate_time; - use FS::rate_time_interval; - use FS::msg_template; - use FS::part_tag; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { @@ -260,7 +251,6 @@ if ( -e $addl_handler_use_file ) { use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); use vars qw($Nobody $SystemUser); use RT; - use RT::Util; use RT::Tickets; use RT::Transactions; use RT::Users; @@ -291,9 +281,6 @@ if ( -e $addl_handler_use_file ) { use RT::Interface::Web::Request; - #nother undeclared web UI dep (for ticket links graph) - use IPC::Run::SafeHandles; - #slow, unreliable, segfaults and is optional #see rt/html/Ticket/Elements/ShowTransactionAttachments #use Text::Quoted; @@ -367,11 +354,6 @@ if ( -e $addl_handler_use_file ) { $m->comp('/elements/errorpage.html', @_); } - sub errorpage_popup { - use vars qw($m); - $m->comp('/elements/errorpage-popup.html', @_); - } - sub redirect { my( $location ) = @_; use vars qw($m); @@ -480,17 +462,14 @@ sub mason_interps { my $html_defang = new HTML::Defang (%defang_opts); - my $js_string_sub = sub { - #${$_[0]} =~ s/(['\\\n])/'\\'.($1 eq "\n" ? 'n' : $1)/ge; - ${$_[0]} =~ s/(['\\])/\\$1/g; - ${$_[0]} =~ s/\r/\\r/g; - ${$_[0]} =~ s/\n/\\n/g; - ${$_[0]} = "'". ${$_[0]}. "'"; - }; - my $fs_interp = new HTML::Mason::Interp ( %interp, - escape_flags => { 'js_string' => $js_string_sub, + escape_flags => { 'js_string' => sub { + #${$_[0]} =~ s/(['\\\n])/'\\'.($1 eq "\n" ? 'n' : $1)/ge; + ${$_[0]} =~ s/(['\\])/\\$1/g; + ${$_[0]} =~ s/\n/\\n/g; + ${$_[0]} = "'". ${$_[0]}. "'"; + }, 'defang' => sub { ${$_[0]} = $html_defang->defang(${$_[0]}); }, @@ -502,9 +481,7 @@ sub mason_interps { my $rt_interp = new HTML::Mason::Interp ( %interp, - escape_flags => { 'h' => \&RT::Interface::Web::EscapeUTF8, - 'js_string' => $js_string_sub, - }, + escape_flags => { 'h' => \&RT::Interface::Web::EscapeUTF8 }, compiler => HTML::Mason::Compiler::ToObject->new( default_escape_flags => 'h', allow_globals => [qw(%session)], diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 3b0616a..b275c9d 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -8,16 +8,14 @@ use Data::Dumper; use IPC::Run qw( run timeout ); # for _pslatex use IPC::Run3; # for do_print... should just use IPC::Run i guess use File::Temp; -use Tie::IxHash; #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable #until on client machine) dependancy loops. put them in FS::Misc::Something #instead @ISA = qw( Exporter ); -@EXPORT_OK = qw( send_email generate_email send_fax +@EXPORT_OK = qw( generate_email send_email send_fax states_hash counties cities state_label card_types - pkg_freqs generate_ps generate_pdf do_print csv_from_fixed ); @@ -38,12 +36,136 @@ FS::Misc - Miscellaneous subroutines Miscellaneous subroutines. This module contains miscellaneous subroutines called from multiple other modules. These are not OO or necessarily related, -but are collected here to eliminate code duplication. +but are collected here to elimiate code duplication. =head1 SUBROUTINES =over 4 +=item generate_email OPTION => VALUE ... + +Options: + +=over 4 + +=item from + +Sender address, required + +=item to + +Recipient address, required + +=item subject + +email subject, required + +=item html_body + +Email body (HTML alternative). Arrayref of lines, or scalar. + +Will be placed inside an HTML <BODY> tag. + +=item text_body + +Email body (Text alternative). Arrayref of lines, or scalar. + +=back + +Returns an argument list to be passsed to L<send_email>. + +=cut + +#false laziness w/FS::cust_bill::generate_email + +use MIME::Entity; +use HTML::Entities; + +sub generate_email { + my %args = @_; + + my $me = '[FS::Misc::generate_email]'; + + my %return = ( + 'from' => $args{'from'}, + 'to' => $args{'to'}, + 'subject' => $args{'subject'}, + ); + + #if (ref($args{'to'}) eq 'ARRAY') { + # $return{'to'} = $args{'to'}; + #} else { + # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ } + # $self->cust_main->invoicing_list + # ]; + #} + + warn "$me creating HTML/text multipart message" + if $DEBUG; + + $return{'nobody'} = 1; + + my $alternative = build MIME::Entity + 'Type' => 'multipart/alternative', + 'Encoding' => '7bit', + 'Disposition' => 'inline' + ; + + my $data; + if ( ref($args{'text_body'}) eq 'ARRAY' ) { + $data = $args{'text_body'}; + } else { + $data = [ split(/\n/, $args{'text_body'}) ]; + } + + $alternative->attach( + 'Type' => 'text/plain', + #'Encoding' => 'quoted-printable', + 'Encoding' => '7bit', + 'Data' => $data, + 'Disposition' => 'inline', + ); + + my @html_data; + if ( ref($args{'html_body'}) eq 'ARRAY' ) { + @html_data = @{ $args{'html_body'} }; + } else { + @html_data = split(/\n/, $args{'html_body'}); + } + + $alternative->attach( + 'Type' => 'text/html', + 'Encoding' => 'quoted-printable', + 'Data' => [ '<html>', + ' <head>', + ' <title>', + ' '. encode_entities($return{'subject'}), + ' </title>', + ' </head>', + ' <body bgcolor="#e8e8e8">', + @html_data, + ' </body>', + '</html>', + ], + 'Disposition' => 'inline', + #'Filename' => 'invoice.pdf', + ); + + #no other attachment: + # multipart/related + # multipart/alternative + # text/plain + # text/html + + $return{'content-type'} = 'multipart/related'; + $return{'mimeparts'} = [ $alternative ]; + $return{'type'} = 'multipart/alternative'; #Content-Type of first part... + #$return{'disposition'} = 'inline'; + + %return; + +} + =item send_email OPTION => VALUE ... Options: @@ -231,154 +353,12 @@ sub send_email { $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); } - - local $@; # just in case - eval { sendmail($message, { transport => $transport }) }; - - if(ref($@) and $@->isa('Email::Sender::Failure')) { - return ($@->code ? $@->code.' ' : '').$@->message - } - else { - return $@; - } -} - -=item generate_email OPTION => VALUE ... - -Options: - -=over 4 - -=item from - -Sender address, required - -=item to - -Recipient address, required - -=item subject - -email subject, required - -=item html_body - -Email body (HTML alternative). Arrayref of lines, or scalar. - -Will be placed inside an HTML <BODY> tag. - -=item text_body - -Email body (Text alternative). Arrayref of lines, or scalar. - -=back - -Constructs a multipart message from text_body and html_body. - -=cut - -#false laziness w/FS::cust_bill::generate_email - -use MIME::Entity; -use HTML::Entities; - -sub generate_email { - my %args = @_; - - my $me = '[FS::Misc::generate_email]'; - - my %return = ( - 'from' => $args{'from'}, - 'to' => $args{'to'}, - 'subject' => $args{'subject'}, - ); - - #if (ref($args{'to'}) eq 'ARRAY') { - # $return{'to'} = $args{'to'}; - #} else { - # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ } - # $self->cust_main->invoicing_list - # ]; - #} - - warn "$me creating HTML/text multipart message" - if $DEBUG; - - $return{'nobody'} = 1; - - my $alternative = build MIME::Entity - 'Type' => 'multipart/alternative', - 'Encoding' => '7bit', - 'Disposition' => 'inline' - ; - - my $data; - if ( ref($args{'text_body'}) eq 'ARRAY' ) { - $data = $args{'text_body'}; - } else { - $data = [ split(/\n/, $args{'text_body'}) ]; - } - $alternative->attach( - 'Type' => 'text/plain', - #'Encoding' => 'quoted-printable', - 'Encoding' => '7bit', - 'Data' => $data, - 'Disposition' => 'inline', - ); + eval { sendmail($message, { transport => $transport }); }; + ref($@) eq 'Email::Sender::Failure' + ? ( $@->code ? $@->code.' ' : '' ). $@->message + : $@; - my @html_data; - if ( ref($args{'html_body'}) eq 'ARRAY' ) { - @html_data = @{ $args{'html_body'} }; - } else { - @html_data = split(/\n/, $args{'html_body'}); - } - - $alternative->attach( - 'Type' => 'text/html', - 'Encoding' => 'quoted-printable', - 'Data' => [ '<html>', - ' <head>', - ' <title>', - ' '. encode_entities($return{'subject'}), - ' </title>', - ' </head>', - ' <body bgcolor="#e8e8e8">', - @html_data, - ' </body>', - '</html>', - ], - 'Disposition' => 'inline', - #'Filename' => 'invoice.pdf', - ); - - #no other attachment: - # multipart/related - # multipart/alternative - # text/plain - # text/html - - $return{'content-type'} = 'multipart/related'; - $return{'mimeparts'} = [ $alternative ]; - $return{'type'} = 'multipart/alternative'; #Content-Type of first part... - #$return{'disposition'} = 'inline'; - - %return; - -} - -=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 send_fax OPTION => VALUE ... @@ -610,39 +590,6 @@ sub card_types { \%card_types; } -=item pkg_freqs - -Returns a hash reference of allowed package billing frequencies. - -=cut - -sub pkg_freqs { - tie my %freq, 'Tie::IxHash', ( - '0' => '(no recurring fee)', - '1h' => 'hourly', - '1d' => 'daily', - '2d' => 'every two days', - '3d' => 'every three days', - '1w' => 'weekly', - '2w' => 'biweekly (every 2 weeks)', - '1' => 'monthly', - '45d' => 'every 45 days', - '2' => 'bimonthly (every 2 months)', - '3' => 'quarterly (every 3 months)', - '4' => 'every 4 months', - '137d' => 'every 4 1/2 months (137 days)', - '6' => 'semiannually (every 6 months)', - '12' => 'annually', - '13' => 'every 13 months (annually +1 month)', - '24' => 'biannually (every 2 years)', - '36' => 'triannually (every 3 years)', - '48' => '(every 4 years)', - '60' => '(every 5 years)', - '120' => '(every 10 years)', - ) ; - \%freq; -} - =item generate_ps FILENAME Returns an postscript rendition of the LaTex file, as a scalar. diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index cd5e2d4..0845cc6 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -795,17 +795,6 @@ sub setfield { $self->set(@_); } -=item exists COLUMN - -Returns true if the column/field/key COLUMN exists. - -=cut - -sub exists { - my($self,$field) = @_; - exists($self->{Hash}->{$field}); -} - =item AUTLOADED METHODS $record->column is a synonym for $record->get('column'); @@ -1580,7 +1569,6 @@ sub process_batch_import { format_headers => $opt->{format_headers}, format_sep_chars => $opt->{format_sep_chars}, format_fixedlength_formats => $opt->{format_fixedlength_formats}, - format_row_callbacks => $opt->{format_row_callbacks}, #per-import job => $job, file => $file, @@ -1621,8 +1609,6 @@ Class method for batch imports. Available params: =item format_fixedlength_formats -=item format_row_callbacks - =item params =item job @@ -1647,7 +1633,7 @@ sub batch_import { my $param = shift; warn "$me batch_import call with params: \n". Dumper($param) - ;# if $DEBUG; + if $DEBUG; my $table = $param->{table}; my $formats = $param->{formats}; @@ -1688,11 +1674,6 @@ sub batch_import { ? $param->{'format_fixedlength_formats'}{ $param->{'format'} } : ''; - my $row_callback = - $param->{'format_row_callbacks'} - ? $param->{'format_row_callbacks'}{ $param->{'format'} } - : ''; - my @fields = @{ $formats->{ $format } }; my $row = 0; @@ -1788,8 +1769,6 @@ sub batch_import { next if $line =~ /^\s*$/; #skip empty lines - $line = &{$row_callback}($line) if $row_callback; - $parser->parse($line) or do { $dbh->rollback if $oldAutoCommit; return "can't parse: ". $parser->error_input(); diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 60d2bce..0b54282 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -960,30 +960,6 @@ sub tables_hashref { 'unique' => [], 'index' => [ ['disabled'] ], }, - - 'cust_tag' => { - 'columns' => [ - 'custtagnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'tagnum', 'int', '', '', '', '', - ], - 'primary_key' => 'custtagnum', - 'unique' => [ [ 'custnum', 'tagnum' ] ], - 'index' => [ [ 'custnum' ] ], - }, - - 'part_tag' => { - 'columns' => [ - 'tagnum', 'serial', '', '', '', '', - 'tagname', 'varchar', '', $char_d, '', '', - 'tagdesc', 'varchar', 'NULL', $char_d, '', '', - 'tagcolor', 'varchar', 'NULL', 6, '', '', - 'disabled', 'char', 'NULL', 1, '', '', - ], - 'primary_key' => 'tagnum', - 'unique' => [], #[ [ 'tagname' ] ], #? - 'index' => [ [ 'disabled' ] ], - }, 'cust_main_exemption' => { 'columns' => [ @@ -1827,7 +1803,7 @@ sub tables_hashref { 'cgp_rule_condition' => { 'columns' => [ 'ruleconditionnum', 'serial', '', '', '', '', - 'conditionname', 'varchar', '', $char_d, '', '', + 'condition', 'varchar', '', $char_d, '', '', 'op', 'varchar', 'NULL', $char_d, '', '', 'params', 'varchar', 'NULL', 255, '', '', 'rulenum', 'int', '', '', '', '', @@ -2253,7 +2229,6 @@ sub tables_hashref { 'conn_sec', 'int', '', '', '0', '', 'min_charge', 'decimal', '', '10,5', '', '', #@money_type, '', '', 'sec_granularity', 'int', '', '', '', '', - 'ratetimenum', 'int', 'NULL', '', '', '', #time period (link to table of periods)? 'classnum', 'int', 'NULL', '', '', '', ], @@ -2285,28 +2260,6 @@ sub tables_hashref { 'index' => [ [ 'countrycode' ], [ 'npa' ], [ 'regionnum' ] ], }, - 'rate_time' => { - 'columns' => [ - 'ratetimenum', 'serial', '', '', '', '', - 'ratetimename', 'varchar', '', $char_d, '', '', - ], - 'primary_key' => 'ratetimenum', - 'unique' => [], - 'index' => [], - }, - - 'rate_time_interval' => { - 'columns' => [ - 'intervalnum', 'serial', '', '', '', '', - 'stime', 'int', '', '', '', '', - 'etime', 'int', '', '', '', '', - 'ratetimenum', 'int', '', '', '', '', - ], - 'primary_key' => 'intervalnum', - 'unique' => [], - 'index' => [], - }, - 'usage_class' => { 'columns' => [ 'classnum', 'serial', '', '', '', '', @@ -2846,11 +2799,10 @@ sub tables_hashref { 'svc_pbx' => { 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'id', 'int', 'NULL', '', '', '', - 'title', 'varchar', 'NULL', $char_d, '', '', - 'max_extensions', 'int', 'NULL', '', '', '', - 'max_simultaneous', 'int', 'NULL', '', '', '', + 'svcnum', 'int', '', '', '', '', + 'id', 'int', 'NULL', '', '', '', + 'title', 'varchar', 'NULL', $char_d, '', '', + 'max_extensions', 'int', 'NULL', '', '', '', ], 'primary_key' => 'svcnum', 'unique' => [], @@ -2896,57 +2848,6 @@ sub tables_hashref { 'index' => [['listnum'],['svcnum'],['contactemailnum'],['email']], }, - 'bill_batch' => { - 'columns' => [ - 'batchnum', 'serial', '', '', '', '', - 'status', 'char', 'NULL','1', '', '', - 'pdf', 'blob', 'NULL', '', '', '', - ], - 'primary_key' => 'batchnum', - 'unique' => [], - 'index' => [], - }, - - 'cust_bill_batch' => { - 'columns' => [ - 'billbatchnum', 'serial', '', '', '', '', - 'batchnum', 'int', '', '', '', '', - 'invnum', 'int', '', '', '', '', - ], - 'primary_key' => 'billbatchnum', - 'unique' => [], - 'index' => [ [ 'batchnum' ], [ 'invnum' ] ], - }, - - 'cust_bill_batch_option' => { - 'columns' => [ - 'optionnum', 'serial', '', '', '', '', - 'billbatchnum', 'int', '', '', '', '', - 'optionname', 'varchar', '', $char_d, '', '', - 'optionvalue', 'text', 'NULL', '', '', '', - ], - 'primary_key' => 'optionnum', - 'unique' => [], - 'index' => [ [ 'billbatchnum' ], [ 'optionname' ] ], - }, - - 'msg_template' => { - 'columns' => [ - 'msgnum', 'serial', '', '', '', '', - 'msgname', 'varchar', '', $char_d, '', '', - 'agentnum', 'int', 'NULL', '', '', '', - 'subject', 'varchar', 'NULL', 512, '', '', - 'mime_type', 'varchar', '', $char_d, '', '', - 'body', 'blob', 'NULL', '', '', '', - 'disabled', 'char', 'NULL', 1, '', '', - 'from_addr', 'varchar', 'NULL', 255, '', '', - ], - 'primary_key' => 'msgnum', - 'unique' => [ ['msgname', 'mime_type'] ], - 'index' => [ ['agentnum'], ] - }, - - # name type nullability length default local diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 2d00d2c..821b191 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -494,7 +494,6 @@ use JSON; use FS::UID qw(getotaker); use FS::Record qw(qsearchs); use FS::queue; -use FS::CGI qw(rooturl); $DEBUG = 0; @@ -566,7 +565,6 @@ sub start_job { } } $param{CurrentUser} = getotaker(); - $param{RootURL} = rooturl($self->{cgi}->self_url); warn "FS::UI::Web::start_job\n". join('', map { if ( ref($param{$_}) ) { @@ -622,15 +620,13 @@ sub job_status { } my @return; - if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) { + if ( $job && $job->status ne 'failed' ) { my ($progress, $action) = split ',', $job->statustext, 2; $action ||= 'Server processing job'; @return = ( 'progress', $progress, $action ); } elsif ( !$job ) { #handle job gone case : job successful # so close popup, redirect parent window... @return = ( 'complete' ); - } elsif ( $job->status eq 'done' ) { - @return = ( 'done', $job->statustext, '' ); } else { @return = ( 'error', $job ? $job->statustext : $jobnum ); } diff --git a/FS/FS/UI/Web/small_custview.pm b/FS/FS/UI/Web/small_custview.pm index 36dd30c..f8e2020 100644 --- a/FS/FS/UI/Web/small_custview.pm +++ b/FS/FS/UI/Web/small_custview.pm @@ -3,7 +3,6 @@ package FS::UI::Web::small_custview; use strict; use vars qw(@EXPORT_OK @ISA); use Exporter; -use HTML::Entities; use FS::Msgcat; use FS::Record qw(qsearchs); use FS::cust_main; @@ -36,26 +35,7 @@ sub small_custview { $html .= 'Customer #<B>'. $cust_main->display_custnum. '</B></A>'. ' - <B><FONT COLOR="#'. $cust_main->statuscolor. '">'. - ucfirst($cust_main->status). '</FONT></B>'; - - my @part_tag = $cust_main->part_tag; - if ( @part_tag ) { - $html .= '<TABLE>'; - foreach my $part_tag ( @part_tag ) { - $html .= '<TR><TD>'. - '<FONT '. ( length($part_tag->tagcolor) - ? 'STYLE="background-color:#'.$part_tag->tagcolor.'"' - : '' - ). - '>'. - encode_entities($part_tag->tagname.': '. $part_tag->tagdesc). - '</FONT>'. - '</TD></TR>'; - } - $html .= '</TABLE>'; - } - - $html .= + ucfirst($cust_main->status). '</FONT></B>'. ntable('#e8e8e8'). '<TR><TD VALIGN="top">'. ntable("#cccccc",2). '<TR><TD ALIGN="right" VALIGN="top">Billing<BR>Address</TD><TD BGCOLOR="#ffffff">'. $cust_main->getfield('last'). ', '. $cust_main->first. '<BR>'; diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index b7a1c66..576676f 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -42,10 +42,6 @@ sub upgrade { my $data = upgrade_data(%opt); - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - local $FS::UID::AutoCommit = 0; - foreach my $table ( keys %$data ) { my $class = "FS::$table"; @@ -57,10 +53,13 @@ sub upgrade { my $start = time; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + $FS::UID::AutoCommit = 0; + $class->_upgrade_data(%opt); if ( $oldAutoCommit ) { - warn " committing\n"; dbh->commit or die dbh->errstr; } @@ -154,12 +153,6 @@ sub upgrade_data { 'cust_refund' => [], 'banned_pay' => [], - #default namespace - 'payment_gateway' => [], - - #migrate to templates - 'msg_template' => [], - ; \%hash; @@ -189,8 +182,7 @@ sub upgrade_sqlradius { my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); my $group = "UserName"; $group .= ",Realm" - if ref($part_export) =~ /withdomain/ - || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm + if ( ref($part_export) =~ /withdomain/ ); my $sth_alter = $dbh->prepare( "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL" @@ -203,10 +195,7 @@ sub upgrade_sqlradius { $sth_update->execute or die $errmsg.$sth_update->errstr; } else { my $error = $sth_alter->errstr; - warn $errmsg.$error - unless $error =~ /Duplicate column name/i #mysql - || $error =~ /already exists/i; #Pg -; + warn $errmsg.$error unless $error =~ /Duplicate column name/i; } } else { my $error = $dbh->errstr; @@ -219,26 +208,21 @@ sub upgrade_sqlradius { if ( $sth_index ) { unless ( $sth_index->execute ) { my $error = $sth_index->errstr; - warn $errmsg.$error - unless $error =~ /Duplicate key name/i #mysql - || $error =~ /already exists/i; #Pg + warn $errmsg.$error unless $error =~ /Duplicate key name/i; } } else { my $error = $dbh->errstr; - warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i; + warn $errmsg.$error; #unless $error =~ /exists/i; } - my $times = ($dbh->{Driver}->{Name} =~ /^mysql/) - ? ' AcctStartTime != 0 AND AcctStopTime != 0 ' - : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL '; - my $sth = $dbh->prepare("SELECT UserName, Realm, $str2time max(AcctStartTime)), $str2time max(AcctStopTime)) FROM radacct WHERE FreesideStatus = 'done' - AND $times + AND AcctStartTime != 0 + AND AcctStopTime != 0 GROUP BY $group ") or die $errmsg.$dbh->errstr; diff --git a/FS/FS/XMLRPC.pm b/FS/FS/XMLRPC.pm index 73ce13f..fb0e5ac 100644 --- a/FS/FS/XMLRPC.pm +++ b/FS/FS/XMLRPC.pm @@ -1,7 +1,7 @@ - package FS::XMLRPC; +package FS::XMLRPC; use strict; -use vars qw( $DEBUG ); +use vars qw( @ISA $DEBUG ); use Frontier::RPC2; # Instead of 'use'ing freeside modules on the fly below, just preload them now. @@ -11,10 +11,10 @@ use FS::Conf; use FS::Record; use FS::cust_main; -use FS::Maestro; - use Data::Dumper; +@ISA = qw( ); + $DEBUG = 0; =head1 NAME @@ -131,9 +131,9 @@ sub _serve { #Subroutine, not method } - if ( scalar(@result) == 1 && ref($result[0]) eq 'HASH' ) { - return $result[0]; - } elsif (grep { UNIVERSAL::can($_, 'hashref') ? 0 : 1 } @result) { + warn Dumper(@result) if $DEBUG; + + if (grep { UNIVERSAL::can($_, 'hashref') ? 0 : 1 } @result) { #warn "FS::XMLRPC: One or more objects returned from '${fssub}' doesn't " . # "support the 'hashref' method."; @@ -147,8 +147,8 @@ sub _serve { #Subroutine, not method return [ $FS::VERSION ]; } # else... - warn "Unhandled XMLRPC request '${method_name}'"; - return {}; + warn "Unhandle XMLRPC request '${method_name}'"; + return []; } diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index 8c8ba8b..1bf6e93 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -1,16 +1,20 @@ package FS::access_user; use strict; -use base qw( FS::m2m_Common FS::option_Common ); -use vars qw( $DEBUG $me $conf $htpasswd_file ); +use vars qw( @ISA $DEBUG $me $conf $htpasswd_file ); use FS::UID; use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); +use FS::m2m_Common; +use FS::option_Common; use FS::access_user_pref; use FS::access_usergroup; use FS::agent; use FS::cust_main; +@ISA = qw( FS::m2m_Common FS::option_Common FS::Record ); +#@ISA = qw( FS::m2m_Common FS::option_Common ); + $DEBUG = 0; $me = '[FS::access_user]'; @@ -363,11 +367,6 @@ user has the provided access right Optional table name in which agentnum is being checked. Sometimes required to resolve 'column reference "agentnum" is ambiguous' errors. -=item viewall_right - -All agents will be viewable if the current user has the provided access right. -Defaults to 'View customers of all agents'. - =back =cut @@ -378,21 +377,16 @@ sub agentnums_sql { my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum'; - my @or = (); - - my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents'; - if ( $self->access_right($viewall_right) ) { - push @or, "$agentnum IS NOT NULL"; - } else { - push @or, "$agentnum IN (". join(',', $self->agentnums). ')'; - } +# my @agentnums = map { "$agentnum = $_" } $self->agentnums; + my @agentnums = (); + push @agentnums, "$agentnum IN (". join(',', $self->agentnums). ')'; - push @or, "$agentnum IS NULL" + push @agentnums, "$agentnum IS NULL" if $opt{'null'} || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) ); - return ' 1 = 0 ' unless scalar(@or); - '( '. join( ' OR ', @or ). ' )'; + return ' 1 = 0 ' unless scalar(@agentnums); + '( '. join( ' OR ', @agentnums ). ' )'; } @@ -413,10 +407,10 @@ sub agentnum { $sth->fetchrow_arrayref->[0]; } -=item agents [ HASHREF | OPTION => VALUE ... ] +=item agents Returns the list of agents this user can view (via group membership), as -FS::agent objects. Accepts the same options as the agentnums_sql method. +FS::agent objects. =cut @@ -425,7 +419,7 @@ sub agents { qsearch({ 'table' => 'agent', 'hashref' => { disabled=>'' }, - 'extra_sql' => ' AND '. $self->agentnums_sql(@_), + 'extra_sql' => ' AND '. $self->agentnums_sql, }); } diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index d291ca0..f174275 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -269,20 +269,16 @@ sub payment_gateway { cardtype => '', taxclass => '', } ); - my $payment_gateway; - my $conf = new FS::Conf; + my $payment_gateway = new FS::payment_gateway; if ( $override ) { #use a payment gateway override $payment_gateway = $override->payment_gateway; - $payment_gateway->gateway_namespace('Business::OnlinePayment') - unless $payment_gateway->gateway_name; - } else { #use the standard settings from the config - # the standard settings from the config could be moved to a null agent # agent_payment_gateway referenced payment_gateway + my $conf = new FS::Conf; unless ( $conf->exists('business-onlinepayment') ) { if ( $options{'nofatal'} ) { return ''; @@ -306,8 +302,6 @@ sub payment_gateway { "did you set the business-onlinepayment configuration value?\n" unless $processor; - $payment_gateway = new FS::payment_gateway; - $payment_gateway->gateway_namespace( $conf->config('business-onlinepayment-namespace') || 'Business::OnlinePayment'); $payment_gateway->gateway_module($processor); @@ -318,13 +312,6 @@ sub payment_gateway { } - unless ( $payment_gateway->gateway_namespace ) { - $payment_gateway->gateway_namespace( - scalar($conf->config('business-onlinepayment-namespace')) - || 'Business::OnlinePayment' - ); - } - $payment_gateway; } diff --git a/FS/FS/bill_batch.pm b/FS/FS/bill_batch.pm deleted file mode 100644 index 136db0d..0000000 --- a/FS/FS/bill_batch.pm +++ /dev/null @@ -1,151 +0,0 @@ -package FS::bill_batch; - -use strict; -use vars qw( @ISA $me $DEBUG ); -use FS::Record qw( qsearch qsearchs dbh ); -use FS::cust_bill_batch; - -@ISA = qw( FS::Record ); -$me = '[ FS::bill_batch ]'; -$DEBUG=0; - -sub table { 'bill_batch' } - -sub nohistory_fields { 'pdf' } - -=head1 NAME - -FS::bill_batch - Object methods for bill_batch records - -=head1 SYNOPSIS - - use FS::bill_batch; - - $open_batch = FS::bill_batch->get_open_batch; - - my $pdf = $open_batch->print_pdf; - - $error = $open_batch->close; - -=head1 DESCRIPTION - -An FS::bill_batch object represents a batch of invoices. FS::bill_batch -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item batchnum - primary key - -=item status - either 'O' (open) or 'R' (resolved/closed). - -=item pdf - blob field for temporarily storing the invoice as a PDF. - -=back - -=head1 METHODS - -=over 4 - -=item print_pdf - -Typeset the entire batch as a PDF file. Returns the PDF as a string. - -=cut - -sub print_pdf { - eval 'use CAM::PDF'; - warn "Failed to load CAM::PDF: '$@'\n" if $@; - - my $self = shift; - my $job = shift; - $job->update_statustext(0) if $job; - my @invoices = sort { $a->invnum <=> $b->invnum } - qsearch('cust_bill_batch', { batchnum => $self->batchnum }); - return "No invoices in batch ".$self->batchnum.'.' if !@invoices; - - my $pdf_out; - my $num = 0; - foreach my $invoice (@invoices) { - my $part = $invoice->cust_bill->print_pdf({$invoice->options}); - die 'Failed creating PDF from invoice '.$invoice->invnum.'\n' if !$part; - - if($pdf_out) { - $pdf_out->appendPDF(CAM::PDF->new($part)); - } - else { - $pdf_out = CAM::PDF->new($part); - } - if($job) { - # update progressbar - $num++; - my $error = $job->update_statustext(int(100 * $num/scalar(@invoices))); - die $error if $error; - } - } - - return $pdf_out->toPDF; -} - -=item close - -Set the status of the batch to 'R' (resolved). - -=cut - -sub close { - my $self = shift; - $self->status('R'); - return $self->replace; -} - -=back - -=head1 CLASS METHODS - -=item get_open_batch - -Returns the currently open batch. There should only be one at a time. - -=cut - -sub get_open_batch { - my $class = shift; - my $batch = qsearchs('bill_batch', { status => 'O' }); - return $batch if $batch; - $batch = FS::bill_batch->new({status => 'O'}); - my $error = $batch->insert; - die $error if $error; - return $batch; -} - -use Storable 'thaw'; -use Data::Dumper; -use MIME::Base64; - -sub process_print_pdf { - my $job = shift; - my $param = thaw(decode_base64(shift)); - warn Dumper($param) if $DEBUG; - die "no batchnum specified!\n" if ! exists($param->{batchnum}); - my $batch = FS::bill_batch->by_key($param->{batchnum}); - die "batch '$param->{batchnum}' not found!\n" if !$batch; - - my $pdf = $batch->print_pdf($job); - $batch->pdf($pdf); - my $error = $batch->replace; - die $error if $error; -} - - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm index e8be080..2426f41 100644 --- a/FS/FS/cdr.pm +++ b/FS/FS/cdr.pm @@ -285,10 +285,6 @@ sub check { # ; # return $error if $error; - for my $f ( grep { $self->$_ =~ /[a-z ]/i } qw( startdate enddate ) ) { - $self->$f( str2time($self->$f) ); - } - $self->calldate( $self->startdate_sql ) if !$self->calldate && $self->startdate; @@ -324,19 +320,15 @@ sub check { $self->SUPER::check; } -=item is_tollfree [ COLUMN ] - -Returns true when the cdr represents a toll free number and false otherwise. +=item is_tollfree -By default, inspects the dst field, but an optional column name can be passed -to inspect other field. + Returns true when the cdr represents a toll free number and false otherwise. =cut sub is_tollfree { my $self = shift; - my $field = scalar(@_) ? shift : 'dst'; - ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0; + ( $self->dst =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0; } =item set_charged_party @@ -365,11 +357,6 @@ sub set_charged_party { if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s'); $self->charged_party( $charged_party ); - } elsif ( $conf->exists('cdr-charged_party-field') ) { - - my $field = $conf->config('cdr-charged_party-field'); - $self->charged_party( $self->$field() ); - } else { if ( $self->is_tollfree ) { @@ -539,86 +526,73 @@ my %export_names = ( }, ); -my %export_formats = (); -sub export_formats { - #my $self = shift; - - return %export_formats if keys %export_formats; - - my $conf = new FS::Conf; - my $date_format = $conf->config('date_format') || '%m/%d/%Y'; - - my $duration_sub = sub { - my($cdr, %opt) = @_; - if ( $opt{minutes} ) { - $opt{minutes}. ( $opt{granularity} ? 'm' : ' call' ); - } else { - #config if anyone really wants decimal minutes back - #sprintf('%.2fm', $cdr->billsec / 60 ); - int($cdr->billsec / 60).'m '. ($cdr->billsec % 60).'s'; - } - }; - - %export_formats = ( - 'simple' => [ - sub { time2str($date_format, shift->calldate_unix ) }, #DATE - sub { time2str('%r', shift->calldate_unix ) }, #TIME - 'userfield', #USER - 'dst', #NUMBER_DIALED - $duration_sub, #DURATION - #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE - sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE - ], - 'simple2' => [ - sub { time2str($date_format, shift->calldate_unix ) }, #DATE - sub { time2str('%r', shift->calldate_unix ) }, #TIME - #'userfield', #USER - 'src', #called from - 'dst', #NUMBER_DIALED - $duration_sub, #DURATION - #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE - sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE - ], - 'default' => [ - - #DATE - sub { time2str($date_format, shift->calldate_unix ) }, - # #time2str("%Y %b %d - %r", $cdr->calldate_unix ), - - #TIME - sub { time2str('%r', shift->calldate_unix ) }, - # time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot - - #DEST ("Number") - sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; }, - - #REGIONNAME ("Destination") - sub { my($cdr, %opt) = @_; $opt{dst_regionname}; }, - - #DURATION - $duration_sub, - - #PRICE - sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, - - ], - ); - $export_formats{'source_default'} = [ 'src', @{ $export_formats{'default'} }, ]; - $export_formats{'accountcode_default'} = - [ @{ $export_formats{'default'} }[0,1], - 'accountcode', - @{ $export_formats{'default'} }[2..5], - ]; - - %export_formats -} +my $duration_sub = sub { + my($cdr, %opt) = @_; + if ( $opt{minutes} ) { + $opt{minutes}. ( $opt{granularity} ? 'm' : ' call' ); + } else { + #config if anyone really wants decimal minutes back + #sprintf('%.2fm', $cdr->billsec / 60 ); + int($cdr->billsec / 60).'m '. ($cdr->billsec % 60).'s'; + } +}; + +my %export_formats = ( + 'simple' => [ + sub { time2str('%D', shift->calldate_unix ) }, #DATE + sub { time2str('%r', shift->calldate_unix ) }, #TIME + 'userfield', #USER + 'dst', #NUMBER_DIALED + $duration_sub, #DURATION + #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE + sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE + ], + 'simple2' => [ + sub { time2str('%D', shift->calldate_unix ) }, #DATE + sub { time2str('%r', shift->calldate_unix ) }, #TIME + #'userfield', #USER + 'src', #called from + 'dst', #NUMBER_DIALED + $duration_sub, #DURATION + #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE + sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE + ], + 'default' => [ + + #DATE + sub { time2str('%D', shift->calldate_unix ) }, + # #time2str("%Y %b %d - %r", $cdr->calldate_unix ), + + #TIME + sub { time2str('%r', shift->calldate_unix ) }, + # time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot + + #DEST ("Number") + sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; }, + + #REGIONNAME ("Destination") + sub { my($cdr, %opt) = @_; $opt{dst_regionname}; }, + + #DURATION + $duration_sub, + + #PRICE + sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, + + ], +); +$export_formats{'source_default'} = [ 'src', @{ $export_formats{'default'} }, ]; +$export_formats{'accountcode_default'} = + [ @{ $export_formats{'default'} }[0,1], + 'accountcode', + @{ $export_formats{'default'} }[2..5], + ]; sub downstream_csv { my( $self, %opt ) = @_; my $format = $opt{'format'}; - my %formats = $self->export_formats; - return "Unknown format $format" unless exists $formats{$format}; + return "Unknown format $format" unless exists $export_formats{$format}; #my $conf = new FS::Conf; #$opt{'money_char'} ||= $conf->config('money_char') || '$'; @@ -632,7 +606,7 @@ sub downstream_csv { map { ref($_) ? &{$_}($self, %opt) : $self->$_(); } - @{ $formats{$format} }; + @{ $export_formats{$format} }; my $status = $csv->combine(@columns); die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV" @@ -773,9 +747,6 @@ sub _cdr_date_parse { } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d+\.\d+)(\D|$)/ ) { # broadsoft: 20081223201938.314 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 ); - } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) { - # Taqua OM: 20050422203450943 - ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 ); } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) { # WIP: 20100329121420 ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 ); @@ -845,10 +816,6 @@ my %import_options = ( { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; } keys %cdr_info }, - - 'format_row_callbacks' => { map { $_ => $cdr_info{$_}->{'row_callback'}; } - keys %cdr_info - }, ); sub _import_options { @@ -899,14 +866,9 @@ sub _upgrade_data { my %cdrbatchnum = (); while (my $row = $sth->fetchrow_arrayref) { - - my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } ); - unless ( $cdr_batch ) { - $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] }; - my $error = $cdr_batch->insert; - die $error if $error; - } - + my $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] }; + my $error = $cdr_batch->insert; + die $error if $error; $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum; } diff --git a/FS/FS/cdr/taqua_om.pm b/FS/FS/cdr/taqua_om.pm deleted file mode 100644 index c94ea59..0000000 --- a/FS/FS/cdr/taqua_om.pm +++ /dev/null @@ -1,19 +0,0 @@ -package FS::cdr::taqua_om; - -use strict; -use vars qw( %info ); -use base qw( FS::cdr::taqua ); - -%info = ( - %FS::cdr::taqua::info, - 'name' => 'Taqua OM', - 'weight' => 132, - 'header' => 0, - 'sep_char' => ';', - 'row_callback' => sub { my $row = shift; - $row =~ s/^<\d+>\|[\da-f\|]+\|(\d+;)/$1/; - $row; - }, -); - -1; diff --git a/FS/FS/cdr/wip.pm b/FS/FS/cdr/wip.pm index 19c45c6..070e253 100644 --- a/FS/FS/cdr/wip.pm +++ b/FS/FS/cdr/wip.pm @@ -17,10 +17,7 @@ use FS::cdr qw(_cdr_date_parser_maker); # except that we assume that before all the fields mentioned in the # spec, there's a counter field. skip(4), # counter, id, APCSJursID, RecordType - sub { my($cdr, $data, $conf, $param) = @_; - $param->{skiprow} = 1 if $data == 1; - $cdr->uniqueid($data); - }, # CDRID; is 1 for line charge records + 'unique_id', # CDRID skip(1), # AccountNumber; empty 'charged_party', # ServiceNumber skip(1), # ServiceNumberType @@ -40,6 +37,10 @@ use FS::cdr qw(_cdr_date_parser_maker); 'upstream_price', # ISPBuy skip(2), # EUBuy, CDRFromCarrier ], +# Need clarification on: +# Values for RecordType, Jurisdiction, CompletionStatus, and ProviderClass +# Do we care about the following: +# AccountNumber, ServiceNumberType, CDRStatus ); diff --git a/FS/FS/cgp_rule.pm b/FS/FS/cgp_rule.pm index e9c5090..ad5ab1e 100644 --- a/FS/FS/cgp_rule.pm +++ b/FS/FS/cgp_rule.pm @@ -100,12 +100,11 @@ sub insert { return $error; } - #conditions and actions not in yet - #$error = $self->svc_export; - #if ( $error ) { - # $dbh->rollback if $oldAutoCommit; - # return $error; - #} + $error = $self->svc_export; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -189,12 +188,11 @@ sub replace { return $error; } - #conditions and actions not in yet - #$error = $new->svc_export; - #if ( $error ) { - # $dbh->rollback if $oldAutoCommit; - # return $error; - #} + $error = $new->svc_export; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -248,47 +246,6 @@ sub check { $self->SUPER::check; } -=item clone NEW_SVCNUM - -Clones this rule into an identical rule for the specified new service. - -If there is an error, returns the error, otherwise returns false. - -=cut - -#should return the newly inserted rule instead? used in misc/clone-cgp_rule.html - -#i should probably be transactionalized so i'm all-or-nothing -sub clone { - my( $self, $svcnum ) = @_; - - my $new = $self->new( { $self->hash } ); - $new->rulenum(''); - $new->svcnum( $svcnum ); - my $error = $new->insert; - return $error if $error; - - my @dup = $self->cgp_rule_condition; - push @dup, $self->cgp_rule_action; - - foreach my $dup (@dup) { - my $new_dup = $dup->new( { $dup->hash } ); - my $pk = $new_dup->primary_key; - $new_dup->$pk(''); - $new_dup->rulenum( $new->rulenum ); - - $error = $new_dup->insert; - return $error if $error; - - } - - $error = $new->svc_export; - return $error if $error; - - ''; - -} - =item cust_svc =cut diff --git a/FS/FS/cgp_rule_condition.pm b/FS/FS/cgp_rule_condition.pm index 772e189..02ea172 100644 --- a/FS/FS/cgp_rule_condition.pm +++ b/FS/FS/cgp_rule_condition.pm @@ -36,7 +36,7 @@ currently supported: primary key -=item conditionname +=item condition condition @@ -113,7 +113,7 @@ sub check { my $error = $self->ut_numbern('ruleconditionnum') - || $self->ut_text('conditionname') + || $self->ut_text('condition') || $self->ut_textn('op') || $self->ut_textn('params') || $self->ut_foreign_key('rulenum', 'cgp_rule', 'rulenum') @@ -125,13 +125,13 @@ sub check { =item arrayref -Returns an array reference of the conditionname, op and params fields. +Returns an array reference of the condition, op and params fields. =cut sub arrayref { my $self = shift; - [ map $self->$_, qw( conditionname op params ) ]; + [ map $self->$_, qw( condition op params ) ]; } =back diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 4bd9aa1..1270530 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -34,8 +34,6 @@ use FS::cust_bill_pay; use FS::cust_bill_pay_batch; use FS::part_bill_event; use FS::payby; -use FS::bill_batch; -use FS::cust_bill_batch; @ISA = qw( FS::cust_main_Mixin FS::Record ); @@ -1302,13 +1300,7 @@ sub print { 'notice_name' => $notice_name, ); - if($conf->exists('invoice_print_pdf')) { - # Add the invoice to the current batch. - $self->batch_invoice(\%opt); - } - else { - do_print $self->lpr_data(\%opt); - } + do_print $self->lpr_data(\%opt); } =item fax_invoice HASHREF | [ TEMPLATE ] @@ -1354,23 +1346,6 @@ sub fax_invoice { } -=item batch_invoice [ HASHREF ] - -Place this invoice into the open batch (see C<FS::bill_batch>). If there -isn't an open batch, one will be created. - -=cut - -sub batch_invoice { - my ($self, $opt) = @_; - my $batch = FS::bill_batch->get_open_batch; - my $cust_bill_batch = FS::cust_bill_batch->new({ - batchnum => $batch->batchnum, - invnum => $self->invnum, - }); - return $cust_bill_batch->insert($opt); -} - =item ftp_invoice [ TEMPLATENAME ] Sends this invoice data via FTP. @@ -2324,13 +2299,11 @@ sub print_generic { } - my $agentnum = $self->cust_main->agentnum; - my %invoice_data = ( #invoice from info - 'company_name' => scalar( $conf->config('company_name', $agentnum) ), - 'company_address' => join("\n", $conf->config('company_address', $agentnum) ). "\n", + 'company_name' => scalar( $conf->config('company_name', $self->cust_main->agentnum) ), + 'company_address' => join("\n", $conf->config('company_address', $self->cust_main->agentnum) ). "\n", 'returnaddress' => $returnaddress, 'agent' => &$escape_function($cust_main->agent->agent), @@ -2358,19 +2331,6 @@ sub print_generic { 'smallerfooter' => $conf->exists('invoice-smallerfooter'), 'balance_due_below_line' => $conf->exists('balance_due_below_line'), - #layout info -- would be fancy to calc some of this and bury the template - # here in the code - 'topmargin' => scalar($conf->config('invoice_latextopmargin', $agentnum)), - 'headsep' => scalar($conf->config('invoice_latexheadsep', $agentnum)), - 'textheight' => scalar($conf->config('invoice_latextextheight', $agentnum)), - 'extracouponspace' => scalar($conf->config('invoice_latexextracouponspace', $agentnum)), - 'couponfootsep' => scalar($conf->config('invoice_latexcouponfootsep', $agentnum)), - 'verticalreturnaddress' => $conf->exists('invoice_latexverticalreturnaddress', $agentnum), - 'addresssep' => scalar($conf->config('invoice_latexaddresssep', $agentnum)), - 'amountenclosedsep' => scalar($conf->config('invoice_latexcouponamountenclosedsep', $agentnum)), - 'coupontoaddresssep' => scalar($conf->config('invoice_latexcoupontoaddresssep', $agentnum)), - 'addcompanytoaddress' => $conf->exists('invoice_latexcouponaddcompanytoaddress', $agentnum), - # better hang on to conf_dir for a while (for old templates) 'conf_dir' => "$FS::UID::conf_dir/conf.$FS::UID::datasrc", @@ -2439,6 +2399,8 @@ sub print_generic { $invoice_data{'previous_balance'} = sprintf("%.2f", $pr_total); $invoice_data{'balance'} = sprintf("%.2f", $balance_due); + my $agentnum = $self->cust_main->agentnum; + my $summarypage = ''; if ( $conf->exists('invoice_usesummary', $agentnum) ) { $summarypage = 1; @@ -2621,12 +2583,6 @@ sub print_generic { foreach my $section (@sections, @$late_sections) { - # begin some normalization - $section->{'subtotal'} = $section->{'amount'} - if $multisection - && !exists($section->{subtotal}) - && exists($section->{amount}); - $invoice_data{finance_amount} = sprintf('%.2f', $section->{'subtotal'} ) if ( $invoice_data{finance_section} && $section->{'description'} eq $invoice_data{finance_section} ); @@ -2635,7 +2591,7 @@ sub print_generic { sprintf('%.2f', $section->{'subtotal'}) if $multisection; - # continue some normalization + # begin some normalization $section->{'amount'} = $section->{'subtotal'} if $multisection; @@ -3397,9 +3353,7 @@ my %condensed_format = ( 'fields' => [ sub { shift->{description} }, sub { shift->{quantity} }, - sub { my($href, %opt) = @_; - ($opt{dollar} || ''). $href->{amount}; - }, + sub { shift->{amount} }, ], 'align' => [ qw( l r r ) ], 'span' => [ qw( 5 1 1 ) ], # unitprices? @@ -3473,7 +3427,6 @@ sub _condensed_description_generator { my ( $f, $prefix, $suffix, $separator, $column ) = _condensed_generator_defaults($format); - my $money_char = '$'; if ($format eq 'latex') { $prefix = "\\hline\n\\multicolumn{1}{c}{\\rule{0pt}{2.5ex}~} &\n"; $suffix = '\\\\'; @@ -3482,7 +3435,6 @@ sub _condensed_description_generator { sub { my ($d,$a,$s,$w) = @_; return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}"; }; - $money_char = '\\dollar'; }elsif ( $format eq 'html' ) { $prefix = '"><td align="center"></td>'; $suffix = ''; @@ -3491,22 +3443,16 @@ sub _condensed_description_generator { sub { my ($d,$a,$s,$w) = @_; return qq!<td align="$html_align{$a}">$d</td>!; }; - #$money_char = $conf->config('money_char') || '$'; - $money_char = ''; # this is madness } sub { - #my @args = @_; - my $href = shift; + my @args = @_; my @result = (); foreach (my $i = 0; $f->{label}->[$i]; $i++) { - my $dollar = ''; - $dollar = $money_char if $i == scalar(@{$f->{label}})-1; - push @result, - &{$column}( &{$f->{fields}->[$i]}($href, 'dollar' => $dollar), - map { $f->{$_}->[$i] } qw(align span width) - ); + push @result, &{$column}( &{$f->{fields}->[$i]}(@args), + map { $f->{$_}->[$i] } qw(align span width) + ); } $prefix. join( $separator, @result ). $suffix; @@ -3751,9 +3697,6 @@ sub _items_svc_phone_sections { foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { next unless $cust_bill_pkg->pkgnum > 0; - my @header = $cust_bill_pkg->details_header; - next unless scalar(@header); - foreach my $detail ( $cust_bill_pkg->cust_bill_pkg_detail ) { my $phonenum = $detail->phonenum; @@ -3802,7 +3745,6 @@ sub _items_svc_phone_sections { 'duration' => 0, 'sort_weight' => $usage_class{$detail->classnum}->weight, 'phonenum' => $phonenum, - 'header' => [ @header ], }; $sections{"$phonenum $line"}{amount} += $amount; #subtotal $sections{"$phonenum $line"}{calls}++; @@ -3833,17 +3775,11 @@ sub _items_svc_phone_sections { my %sectionmap = (); my $simple = new FS::usage_class { format => 'simple' }; #bleh + my $usage_simple = new FS::usage_class { format => 'usage_simple' }; #bleh foreach ( keys %sections ) { - my @header = @{ $sections{$_}{header} || [] }; - my $usage_simple = - new FS::usage_class { format => 'usage_'. (scalar(@header) || 6). 'col' }; my $summary = $sections{$_}{sort_weight} < 0 ? 1 : 0; my $usage_class = $summary ? $simple : $usage_simple; my $ending = $summary ? ' usage charges' : ''; - my %gen_opt = (); - unless ($summary) { - $gen_opt{label} = [ map{ &{$escape}($_) } @header ]; - } $sectionmap{$_} = { 'description' => &{$escape}($_. $ending), 'amount' => $sections{$_}{amount}, #subtotal 'calls' => $sections{$_}{calls}, @@ -3854,7 +3790,7 @@ sub _items_svc_phone_sections { 'sort_weight' => $sections{$_}{sort_weight}, 'post_total' => $summary, #inspire pagebreak ( - ( map { $_ => $usage_class->$_($format, %gen_opt) } + ( map { $_ => $usage_class->$_($format) } qw( description_generator header_generator total_generator @@ -3963,12 +3899,12 @@ sub _items_pkg { } sub _taxsort { - return 0 unless $a->itemdesc cmp $b->itemdesc; - return -1 if $b->itemdesc eq 'Tax'; - return 1 if $a->itemdesc eq 'Tax'; - return -1 if $b->itemdesc eq 'Other surcharges'; - return 1 if $a->itemdesc eq 'Other surcharges'; - $a->itemdesc cmp $b->itemdesc; + return 0 unless $a cmp $b; + return -1 if $b eq 'Tax'; + return 1 if $a eq 'Tax'; + return -1 if $b eq 'Other surcharges'; + return 1 if $a eq 'Other surcharges'; + $a cmp $b; } sub _items_tax { diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index afb90f4..322728f 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -418,10 +418,10 @@ sub apply_to_lineitems { foreach my $cust_svc ( $cust_pkg->cust_svc ) { my $svc_x = $cust_svc->svc_x; - my @part_export = grep { $_->can('_export_insert_on_payment') } + my @part_export = grep { $_->can('export_insert_on_payment') } $cust_svc->part_svc->part_export; - foreach my $part_export ( @part_export ) { + foreach my $part_export ( $cust_svc->part_svc->part_export ) { $error = $part_export->_export_insert_on_payment($svc_x); if ( $error ) { $dbh->rollback if $oldAutoCommit; diff --git a/FS/FS/cust_bill_batch.pm b/FS/FS/cust_bill_batch.pm deleted file mode 100644 index 4569e6b..0000000 --- a/FS/FS/cust_bill_batch.pm +++ /dev/null @@ -1,70 +0,0 @@ -package FS::cust_bill_batch; - -use strict; -use vars qw( @ISA $me $DEBUG ); -use FS::Record qw( qsearch qsearchs dbh ); - -@ISA = qw( FS::option_Common ); -$me = '[ FS::cust_bill_batch ]'; -$DEBUG=0; - -sub table { 'cust_bill_batch' } - -=head1 NAME - -FS::cust_bill_batch - Object methods for cust_bill_batch records - -=head1 DESCRIPTION - -An FS::cust_bill_batch object represents the inclusion of an invoice in a -processing batch. FS::cust_bill_batch inherits from FS::option_Common. The -following fields are currently supported: - -=over 4 - -=item billbatchnum - primary key - -=item invnum - invoice number (see C<FS::cust_bill>) - -=item batchnum - batchn number (see C<FS::bill_batch>) - -=back - -=head1 METHODS - -=over 4 - -=item bill_batch - -Returns the C<FS::bill_batch> object. - -=cut - -sub bill_batch { - my $self = shift; - FS::bill_batch->by_key($self->batchnum); -} - -=item cust_bill - -Returns the C<FS::cust_bill> object. - -=cut - -sub cust_bill { - my $self = shift; - FS::cust_bill->by_key($self->invnum); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_bill_batch_option.pm b/FS/FS/cust_bill_batch_option.pm deleted file mode 100644 index 9bba830..0000000 --- a/FS/FS/cust_bill_batch_option.pm +++ /dev/null @@ -1,126 +0,0 @@ -package FS::cust_bill_batch_option; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cust_bill_batch_option - Object methods for cust_bill_batch_option records - -=head1 SYNOPSIS - - use FS::cust_bill_batch_option; - - $record = new FS::cust_bill_batch_option \%hash; - $record = new FS::cust_bill_batch_option { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_bill_batch_option object represents an option key and value for -an invoice batch entry. FS::cust_bill_batch_option inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item optionnum - primary key - -=item billbatchnum - - -=item optionname - - -=item optionvalue - - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new option. To add the option 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 { 'cust_bill_batch_option'; } - -=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 option. 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('optionnum') - || $self->ut_foreign_key('billbatchnum', 'cust_bill_batch', 'billbatchnum') - || $self->ut_text('optionname') - || $self->ut_textn('optionvalue') - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index d396f82..c825c15 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -480,35 +480,6 @@ sub details { #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum }); } -=item details_header [ OPTION => VALUE ... ] - -Returns a list representing an invoice line item detail header, if any. -This relies on the behavior of voip_cdr in that it expects the header -to be the first CSV formatted detail (as is expected by invoice generation -routines). Returns the empty list otherwise. - -=cut - -sub details_header { - my $self = shift; - return '' unless defined dbdef->table('cust_bill_pkg_detail'); - - eval "use Text::CSV_XS;"; - die $@ if $@; - my $csv = new Text::CSV_XS; - - my @detail = - qsearch ({ 'table' => 'cust_bill_pkg_detail', - 'hashref' => { 'billpkgnum' => $self->billpkgnum, - 'format' => 'C', - }, - 'order_by' => 'ORDER BY detailnum LIMIT 1', - }); - return() unless scalar(@detail); - $csv->parse($detail[0]->detail) or return (); - $csv->fields; -} - =item desc Returns a description for this line item. For typical line items, this is the diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 1ddcb8b..674bc10 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -2,7 +2,7 @@ package FS::cust_credit; use strict; use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record ); -use vars qw( $conf $unsuspendauto $me $DEBUG $otaker_upgrade_kludge ); +use vars qw( $conf $unsuspendauto $me $DEBUG ); use Date::Format; use FS::UID qw( dbh getotaker ); use FS::Misc qw(send_email); @@ -19,8 +19,6 @@ use FS::cust_event; $me = '[ FS::cust_credit ]'; $DEBUG = 0; -$otaker_upgrade_kludge = 0; - #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_credit'} = sub { @@ -310,7 +308,7 @@ sub check { return "amount must be > 0 " if $self->amount <= 0; return "amount must be greater or equal to amount applied" - if $self->unapplied < 0 && ! $otaker_upgrade_kludge; + if $self->unapplied < 0; return "Unknown customer" unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); @@ -550,7 +548,6 @@ sub _upgrade_data { # class method } } - local($otaker_upgrade_kludge) = 1; $class->_upgrade_otaker(%opts); } diff --git a/FS/FS/cust_credit_bill_pkg.pm b/FS/FS/cust_credit_bill_pkg.pm index 019a1a8..158fc73 100644 --- a/FS/FS/cust_credit_bill_pkg.pm +++ b/FS/FS/cust_credit_bill_pkg.pm @@ -131,7 +131,7 @@ sub insert { my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg { 'billpkgnum' => $self->billpkgnum, 'creditbillpkgnum' => $self->creditbillpkgnum, - 'amount' => sprintf('%.2f', 0-$amount), + 'amount' => 0-$amount, map { $_ => $exemption->$_ } split(',', $groupby) }; my $error = $cust_tax_exempt_pkg->insert; diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index 1407f43..52b5911 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -222,6 +222,9 @@ sub do_event { " (". $part_event->action. ") $for\n" if $DEBUG; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $error; { local $SIG{__DIE__}; # don't want Mason __DIE__ handler active diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 002b0c1..c1a8aaf 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -16,8 +16,6 @@ use Exporter; use Scalar::Util qw( blessed ); use List::Util qw( min ); use Time::Local qw(timelocal); -use Storable qw(thaw); -use MIME::Base64; use Data::Dumper; use Tie::IxHash; use Digest::MD5 qw(md5_base64); @@ -57,7 +55,6 @@ use FS::cust_tax_location; use FS::part_pkg_taxrate; use FS::agent; use FS::cust_main_invoice; -use FS::cust_tag; use FS::cust_credit_bill; use FS::cust_bill_pay; use FS::prepay_credit; @@ -65,7 +62,6 @@ use FS::queue; use FS::part_pkg; use FS::part_event; use FS::part_event_condition; -use FS::part_export; #use FS::cust_event; use FS::type_pkgs; use FS::payment_gateway; @@ -90,7 +86,7 @@ $skip_fuzzyfiles = 0; @fuzzyfields = ( 'first', 'last', 'company', 'address1' ); @encrypted_fields = ('payinfo', 'paycvv'); -sub nohistory_fields { ('payinfo', 'paycvv'); } +sub nohistory_fields { ('paycvv'); } @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); @@ -474,30 +470,6 @@ sub insert { $self->invoicing_list( $invoicing_list ); } - warn " setting customer tags\n" - if $DEBUG > 1; - - foreach my $tagnum ( @{ $self->tagnum || [] } ) { - my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, - 'custnum' => $self->custnum }; - my $error = $cust_tag->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - if ( $invoicing_list ) { - $error = $self->check_invoicing_list( $invoicing_list ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "checking invoicing_list (transaction rolled back): $error"; - return $error; - } - $self->invoicing_list( $invoicing_list ); - } - - warn " setting cust_main_exemption\n" if $DEBUG > 1; @@ -574,45 +546,6 @@ sub insert { } } - # cust_main exports! - warn " exporting\n" if $DEBUG > 1; - - my $export_args = $options{'export_args'} || []; - - my @part_export = - map qsearch( 'part_export', {exportnum=>$_} ), - $conf->config('cust_main-exports'); #, $agentnum - - foreach my $part_export ( @part_export ) { - my $error = $part_export->export_insert($self, @$export_args); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - - #foreach my $depend_jobnum ( @$depend_jobnums ) { - # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n" - # if $DEBUG; - # foreach my $jobnum ( @jobnums ) { - # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } ); - # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n" - # if $DEBUG; - # my $error = $queue->depend_insert($depend_jobnum); - # if ( $error ) { - # $dbh->rollback if $oldAutoCommit; - # return "error queuing job dependancy: $error"; - # } - # } - # } - # - #} - # - #if ( exists $options{'jobnums'} ) { - # push @{ $options{'jobnums'} }, @jobnums; - #} - warn " insert complete; committing transaction\n" if $DEBUG > 1; @@ -1381,13 +1314,23 @@ sub delete { } } - foreach my $table (qw( cust_main_invoice cust_main_exemption cust_tag )) { - foreach my $record ( qsearch( 'table', { 'custnum' => $self->custnum } ) ) { - my $error = $record->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } + foreach my $cust_main_invoice ( #(email invoice destinations, not invoices) + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) + ) { + my $error = $cust_main_invoice->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + foreach my $cust_main_exemption ( + qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ) + ) { + my $error = $cust_main_exemption->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } } @@ -1397,23 +1340,6 @@ sub delete { return $error; } - # cust_main exports! - - #my $export_args = $options{'export_args'} || []; - - my @part_export = - map qsearch( 'part_export', {exportnum=>$_} ), - $conf->config('cust_main-exports'); #, $agentnum - - foreach my $part_export ( @part_export ) { - my $error = $part_export->export_delete( $self ); #, @$export_args); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1493,28 +1419,6 @@ sub replace { $self->invoicing_list( $invoicing_list ); } - if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident - - #this could be more efficient than deleting and re-inserting, if it matters - foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) { - my $error = $cust_tag->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - foreach my $tagnum ( @{ $self->tagnum || [] } ) { - my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, - 'custnum' => $self->custnum }; - my $error = $cust_tag->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - } - my %options = @param; my $tax_exemption = delete $options{'tax_exemption'}; @@ -1549,15 +1453,8 @@ sub replace { } - if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ - && ( ( $self->get('payinfo') ne $old->get('payinfo') - && $self->get('payinfo') !~ /^99\d{14}$/ - ) - || grep { $self->get($_) ne $old->get($_) } qw(paydate payname) - ) - ) - { - + if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && + grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { # card/check/lec info has changed, want to retry realtime_ invoice events my $error = $self->retry_realtime; if ( $error ) { @@ -1574,23 +1471,6 @@ sub replace { } } - # cust_main exports! - - my $export_args = $options{'export_args'} || []; - - my @part_export = - map qsearch( 'part_export', {exportnum=>$_} ), - $conf->config('cust_main-exports'); #, $agentnum - - foreach my $part_export ( @part_export ) { - my $error = $part_export->export_replace( $self, $old, @$export_args); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1828,7 +1708,12 @@ sub check { # If it is encrypted and the private key is not availaible then we can't # check the credit card. - my $check_payinfo = ! $self->is_encrypted($self->payinfo); + + my $check_payinfo = 1; + + if ($self->is_encrypted($self->payinfo)) { + $check_payinfo = 0; + } if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { @@ -1842,8 +1727,7 @@ sub check { or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') - if $self->payinfo !~ /^99\d{14}$/ #token - && cardtype($self->payinfo) eq "Unknown"; + if cardtype($self->payinfo) eq "Unknown"; my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); if ( $ban ) { @@ -2220,9 +2104,6 @@ sub sort_packages { return 1 if !$a_num_cust_svc && $b_num_cust_svc; my @a_cust_svc = $a->cust_svc; my @b_cust_svc = $b->cust_svc; - return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc); - return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc); - return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc); $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; } @@ -2501,42 +2382,6 @@ sub agent { qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } -=item agent_name - -Returns the agent name (see L<FS::agent>) for this customer. - -=cut - -sub agent_name { - my $self = shift; - $self->agent->agent; -} - -=item cust_tag - -Returns any tags associated with this customer, as FS::cust_tag objects, -or an empty list if there are no tags. - -=cut - -sub cust_tag { - my $self = shift; - qsearch('cust_tag', { 'custnum' => $self->custnum } ); -} - -=item part_tag - -Returns any tags associated with this customer, as FS::part_tag objects, -or an empty list if there are no tags. - -=cut - -sub part_tag { - my $self = shift; - map $_->part_tag, $self->cust_tag; -} - - =item cust_class Returns the customer class, as an FS::cust_class object, or the empty string @@ -2627,10 +2472,6 @@ Any other true value causes errors to die. Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) -=item job - -Optional FS::queue entry to receive status updates. - =back Options are passed to the B<bill> and B<collect> methods verbatim, so all @@ -2647,9 +2488,7 @@ sub bill_and_collect { #pre-printing invoices $options{'actual_time'} ||= time; - my $job = $options{'job'}; - $job->update_statustext('0,cleaning expired packages') if $job; $error = $self->cancel_expired_pkgs( $options{actual_time} ); if ( $error ) { $error = "Error expiring custnum ". $self->custnum. ": $error"; @@ -2666,7 +2505,6 @@ sub bill_and_collect { else { warn $error; } } - $job->update_statustext('20,billing packages') if $job; $error = $self->bill( %options ); if ( $error ) { $error = "Error billing custnum ". $self->custnum. ": $error"; @@ -2675,7 +2513,6 @@ sub bill_and_collect { else { warn $error; } } - $job->update_statustext('50,applying payments and credits') if $job; $error = $self->apply_payments_and_credits; if ( $error ) { $error = "Error applying custnum ". $self->custnum. ": $error"; @@ -2684,7 +2521,6 @@ sub bill_and_collect { else { warn $error; } } - $job->update_statustext('70,running collection events') if $job; unless ( $conf->exists('cancelled_cust-noevents') && ! $self->num_ncancelled_pkgs ) { @@ -2696,7 +2532,6 @@ sub bill_and_collect { else { warn $error; } } } - $job->update_statustext('100,finished') if $job; ''; @@ -2846,14 +2681,8 @@ sub bill { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - warn "$me acquiring lock on customer ". $self->custnum. "\n" - if $DEBUG; - $self->select_for_update; #mutex - warn "$me running pre-bill events for customer ". $self->custnum. "\n" - if $DEBUG; - my $error = $self->do_cust_event( 'debug' => ( $options{'debug'} || 0 ), 'time' => $invoice_time, @@ -2865,9 +2694,6 @@ sub bill { return $error; } - warn "$me done running pre-bill events for customer ". $self->custnum. "\n" - if $DEBUG; - #keep auto-charge and non-auto-charge line items separate my @passes = ( '', 'no_auto' ); @@ -3793,17 +3619,19 @@ sub collect { } } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - #never want to roll back an event just because it returned an error - local $FS::UID::AutoCommit = 1; #$oldAutoCommit; - - $self->do_cust_event( + my $error = $self->do_cust_event( 'debug' => ( $options{'debug'} || 0 ), 'time' => $invoice_time, 'check_freq' => $options{'check_freq'}, 'stage' => 'collect', ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } @@ -3898,11 +3726,6 @@ sub do_cust_event { return $due_cust_event; } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #never want to roll back an event just because it or a different one - # returned an error - local $FS::UID::AutoCommit = 1; #$oldAutoCommit; - foreach my $cust_event ( @$due_cust_event ) { #XXX lock event @@ -3911,7 +3734,11 @@ sub do_cust_event { unless ( $cust_event->test_conditions( 'time' => $time ) ) { #don't leave stray "new/locked" records around my $error = $cust_event->delete; - return $error if $error; + if ( $error ) { + #gah, even with transactions + $dbh->commit if $oldAutoCommit; #well. + return $error; + } next; } @@ -3920,16 +3747,20 @@ sub do_cust_event { warn " running cust_event ". $cust_event->eventnum. "\n" if $DEBUG > 1; + #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options? if ( my $error = $cust_event->do_event() ) { #XXX wtf is this? figure out a proper dealio with return value #from do_event - return $error; - } + # gah, even with transactions. + $dbh->commit if $oldAutoCommit; #well. + return $error; + } } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -4408,7 +4239,6 @@ sub _bop_options { $options->{payment_gateway}->gatewaynum ? $options->{payment_gateway}->options : @{ $options->{payment_gateway}->get('options') }; - } sub _bop_defaults { @@ -4435,6 +4265,14 @@ sub _bop_content { my ($self, $options) = @_; my %content = (); + $content{address} = exists($options->{'address1'}) + ? $options->{'address1'} + : $self->address1; + my $address2 = exists($options->{'address2'}) + ? $options->{'address2'} + : $self->address2; + $content{address} .= ", ". $address2 if length($address2); + my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip; $content{customer_ip} = $payip if length($payip); @@ -4445,30 +4283,14 @@ sub _bop_content { ( $conf->exists('business-onlinepayment-email_customer') || $conf->exists('business-onlinepayment-email-override') ); - my ($payname, $payfirst, $paylast); - if ( $options->{payname} && $options->{method} ne 'ECHECK' ) { - ($payname = $options->{payname}) =~ - /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or return "Illegal payname $payname"; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('last'); - $payname = "$payfirst $paylast"; - } + $content{payfirst} = $self->getfield('first'); + $content{paylast} = $self->getfield('last'); - $content{last_name} = $paylast; - $content{first_name} = $payfirst; + $content{account_name} = "$content{payfirst} $content{paylast}" + if $options->{method} eq 'ECHECK'; - $content{name} = $payname; - - $content{address} = exists($options->{'address1'}) - ? $options->{'address1'} - : $self->address1; - my $address2 = exists($options->{'address2'}) - ? $options->{'address2'} - : $self->address2; - $content{address} .= ", ". $address2 if length($address2); + $content{name} = $options->{payname}; + $content{name} = $content{account_name} if exists($content{account_name}); $content{city} = exists($options->{city}) ? $options->{city} @@ -4482,11 +4304,10 @@ sub _bop_content { $content{country} = exists($options->{country}) ? $options->{country} : $self->country; - $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/ $content{phone} = $self->daytime || $self->night; - \%content; + (%content); } my %bop_method2payby = ( @@ -4562,8 +4383,13 @@ sub realtime_bop { # massage data ### - my $bop_content = $self->_bop_content(\%options); - return $bop_content unless ref($bop_content); + my (%bop_content) = $self->_bop_content(\%options); + + if ( $options{method} ne 'ECHECK' ) { + $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $options{payname}"; + ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2); + } my @invoicing_list = $self->invoicing_list_emailonly; if ( $conf->exists('emailinvoiceautoalways') @@ -4629,9 +4455,6 @@ sub realtime_bop { $content{account_type} = exists($options{'paytype'}) ? uc($options{'paytype'}) || 'CHECKING' : uc($self->getfield('paytype')) || 'CHECKING'; - $content{account_name} = $self->getfield('first'). ' '. - $self->getfield('last'); - $content{customer_org} = $self->company ? 'B' : 'I'; $content{state_id} = exists($options{'stateid'}) ? $options{'stateid'} @@ -4716,7 +4539,7 @@ sub realtime_bop { 'amount' => $options{amount}, #'invoice_number' => $options{'invnum'}, 'customer_id' => $self->custnum, - %$bop_content, + %bop_content, 'reference' => $cust_pay_pending->paypendingnum, #for now 'email' => $email, %content, #after @@ -4731,8 +4554,6 @@ sub realtime_bop { my $BOP_TESTING_SUCCESS = 1; unless ( $BOP_TESTING ) { - $transaction->test_transaction(1) - if $conf->exists('business-onlinepayment-test_transaction'); $transaction->submit(); } else { if ( $BOP_TESTING_SUCCESS ) { @@ -4785,8 +4606,6 @@ sub realtime_bop { $capture->content( %capture ); - $capture->test_transaction(1) - if $conf->exists('business-onlinepayment-test_transaction'); $capture->submit(); unless ( $capture->is_success ) { @@ -4816,25 +4635,6 @@ sub realtime_bop { } ### - # Tokenize - ### - - - 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; - if ( $error ) { - warn "WARNING: error storing token: $error, but proceeding anyway\n"; - } - } - - } - - ### # result handling ### @@ -4957,7 +4757,7 @@ sub _realtime_bop_result { 'paid' => $cust_pay_pending->paid, '_date' => '', 'payby' => $cust_pay_pending->payby, - 'payinfo' => $options{'payinfo'}, + #'payinfo' => $payinfo, 'paybatch' => $paybatch, 'paydate' => $cust_pay_pending->paydate, 'pkgnum' => $cust_pay_pending->pkgnum, @@ -5111,39 +4911,28 @@ sub _realtime_bop_result { && ! grep { $transaction->error_message =~ /$_/ } $conf->config('emaildecline-exclude') ) { + 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, + }; - # Send a decline alert to the customer. - my $msgnum = $conf->config('decline_msgnum', $self->agentnum); - my $error = ''; - if ( $msgnum ) { - my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); - $error = $msg_template->send( 'cust_main' => $self ); - } - 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->config('invoice_from', $self->agentnum ), - 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], - 'subject' => 'Your payment could not be processed', - 'body' => [ $template->fill_in(HASH => $templ_hash) ], - ); - } + my $error = send_email( + 'from' => $conf->config('invoice_from', $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; @@ -5372,7 +5161,7 @@ sub realtime_refund_bop { my $self = shift; my %options = (); - if (ref($_[0]) eq 'HASH') { + if (ref($_[0]) ne 'HASH') { %options = %{$_[0]}; } else { my $method = shift; @@ -5504,8 +5293,6 @@ sub realtime_refund_bop { } } $void->content( 'action' => 'void', %content ); - $void->test_transaction(1) - if $conf->exists('business-onlinepayment-test_transaction'); $void->submit(); if ( $void->is_success ) { my $error = $cust_pay->void($options{'reason'}); @@ -5608,8 +5395,6 @@ sub realtime_refund_bop { ); warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content ) if $DEBUG > 1; - $refund->test_transaction(1) - if $conf->exists('business-onlinepayment-test_transaction'); $refund->submit(); return "$processor error: ". $refund->error_message @@ -6048,17 +5833,29 @@ sub total_owed_date { my $self = shift; my $time = shift; - my $custnum = $self->custnum; - - my $owed_sql = FS::cust_bill->owed_sql; - - my $sql = " - SELECT SUM($owed_sql) FROM cust_bill - WHERE custnum = $custnum - AND _date <= $time - "; +# my $custnum = $self->custnum; +# +# my $owed_sql = FS::cust_bill->owed_sql; +# +# my $sql = " +# SELECT SUM($owed_sql) FROM cust_bill +# WHERE custnum = $custnum +# AND _date <= $time +# "; +# +# my $sth = dbh->prepare($sql) or die dbh->errstr; +# $sth->execute() or die $sth->errstr; +# +# return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] ); - sprintf( "%.2f", $self->scalar_sql($sql) ); + my $total_bill = 0; + foreach my $cust_bill ( + grep { $_->_date <= $time } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { + $total_bill += $cust_bill->owed; + } + sprintf( "%.2f", $total_bill ); } @@ -6128,18 +5925,9 @@ sub total_credited { sub total_unapplied_credits { my $self = shift; - - my $custnum = $self->custnum; - - my $unapplied_sql = FS::cust_credit->unapplied_sql; - - my $sql = " - SELECT SUM($unapplied_sql) FROM cust_credit - WHERE custnum = $custnum - "; - - sprintf( "%.2f", $self->scalar_sql($sql) ); - + my $total_credit = 0; + $total_credit += $_->credited foreach $self->cust_credit; + sprintf( "%.2f", $total_credit ); } =item total_unapplied_credits_pkgnum PKGNUM @@ -6166,18 +5954,9 @@ See L<FS::cust_pay/unapplied>. sub total_unapplied_payments { my $self = shift; - - my $custnum = $self->custnum; - - my $unapplied_sql = FS::cust_pay->unapplied_sql; - - my $sql = " - SELECT SUM($unapplied_sql) FROM cust_pay - WHERE custnum = $custnum - "; - - sprintf( "%.2f", $self->scalar_sql($sql) ); - + my $total_unapplied = 0; + $total_unapplied += $_->unapplied foreach $self->cust_pay; + sprintf( "%.2f", $total_unapplied ); } =item total_unapplied_payments_pkgnum PKGNUM @@ -6205,17 +5984,9 @@ customer. See L<FS::cust_refund/unapplied>. sub total_unapplied_refunds { my $self = shift; - my $custnum = $self->custnum; - - my $unapplied_sql = FS::cust_refund->unapplied_sql; - - my $sql = " - SELECT SUM($unapplied_sql) FROM cust_refund - WHERE custnum = $custnum - "; - - sprintf( "%.2f", $self->scalar_sql($sql) ); - + my $total_unapplied = 0; + $total_unapplied += $_->unapplied foreach $self->cust_refund; + sprintf( "%.2f", $total_unapplied ); } =item balance @@ -6227,7 +5998,12 @@ total_unapplied_credits minus total_unapplied_payments). sub balance { my $self = shift; - $self->balance_date_range; + sprintf( "%.2f", + $self->total_owed + + $self->total_unapplied_refunds + - $self->total_unapplied_credits + - $self->total_unapplied_payments + ); } =item balance_date TIME @@ -6242,13 +6018,19 @@ functions. sub balance_date { my $self = shift; - $self->balance_date_range(shift); + my $time = shift; + sprintf( "%.2f", + $self->total_owed_date($time) + + $self->total_unapplied_refunds + - $self->total_unapplied_credits + - $self->total_unapplied_payments + ); } -=item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] +=item balance_date_range START_TIME [ END_TIME [ OPTION => VALUE ... ] ] -Returns the balance for this customer, optionally considering invoices with -date earlier than START_TIME, and not later than END_TIME +Returns the balance for this customer, only considering invoices with date +earlier than START_TIME, and optionally not later than END_TIME (total_owed_date minus total_unapplied_credits minus total_unapplied_payments). Times are specified as SQL fragments or numeric @@ -7312,8 +7094,6 @@ Returns a status string for this customer, currently: =item prospect - No packages have ever been ordered -=item ordered - Recurring packages all are new (not yet billed). - =item active - One or more recurring packages is active =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) @@ -7330,8 +7110,7 @@ sub status { shift->cust_status(@_); } sub cust_status { my $self = shift; - # prospect ordered active inactive suspended cancelled - for my $status ( FS::cust_main->statuses() ) { + for my $status (qw( prospect active inactive suspended cancelled )) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; @@ -7366,7 +7145,6 @@ use vars qw(%statuscolor); tie %statuscolor, 'Tie::IxHash', 'prospect' => '7e0079', #'000000', #black? naw, purple 'active' => '00CC00', #green - 'ordered' => '009999', #teal? cyan? 'inactive' => '0000CC', #blue 'suspended' => 'FF9900', #yellow 'cancelled' => 'FF0000', #red @@ -7476,20 +7254,9 @@ sub select_count_pkgs_sql { $select_count_pkgs; } -sub prospect_sql { - " 0 = ( $select_count_pkgs ) "; -} - -=item ordered_sql - -Returns an SQL expression identifying ordered cust_main records (customers with -recurring packages not yet setup). - -=cut - -sub ordered_sql { - " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) "; -} +sub prospect_sql { " + 0 = ( $select_count_pkgs ) +"; } =item active_sql @@ -7498,9 +7265,10 @@ active recurring packages). =cut -sub active_sql { - " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; -} +sub active_sql { " + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " + ) +"; } =item inactive_sql @@ -7589,10 +7357,10 @@ sub balance_sql { " WHERE cust_refund.custnum = cust_main.custnum ) "; } -=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] +=item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ] -Returns an SQL fragment to retreive the balance for this customer, optionally -considering invoices with date earlier than START_TIME, and not +Returns an SQL fragment to retreive the balance for this customer, only +considering invoices with date earlier than START_TIME, and optionally not later than END_TIME (total_owed_date minus total_unapplied_credits minus total_unapplied_payments). @@ -7675,11 +7443,9 @@ Available options are: =cut sub unapplied_payments_date_sql { - my( $class, $start, $end, %opt ) = @_; + my( $class, $start, $end, ) = @_; - my $cutoff = $opt{'cutoff'}; - - my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); + my $unapp_pay = FS::cust_pay->unapplied_sql; my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end, 'unapplied_date'=>1 ); @@ -7790,7 +7556,7 @@ sub search { # parse status ## - #prospect ordered active inactive suspended cancelled + #prospect active inactive suspended cancelled if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) { my $method = $params->{'status'}. '_sql'; #push @where, $class->$method(); @@ -8058,10 +7824,8 @@ sub email_search_result { my $subject = delete $params->{subject}; my $html_body = delete $params->{html_body}; my $text_body = delete $params->{text_body}; - my $error = ''; - my $job = delete $params->{'job'} - or die "email_search_result must run from the job queue.\n"; + my $job = delete $params->{'job'}; $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ] unless ref($params->{'payby'}); @@ -8081,73 +7845,43 @@ sub email_search_result { my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo - my @retry_jobs = (); - my $success = 0; #eventually order+limit magic to reduce memory use? foreach my $cust_main ( qsearch($sql_query) ) { - #progressbar first, so that the count is right - $num++; - if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( - int( 100 * $num / $num_cust ) - ); - die $error if $error; - $last = time; - } - my $to = $cust_main->invoicing_list_emailonly_scalar; + next unless $to; - if( $to ) { - my @message = ( + my $error = send_email( + generate_email( 'from' => $from, 'to' => $to, 'subject' => $subject, 'html_body' => $html_body, 'text_body' => $text_body, - ); - - $error = send_email( generate_email( @message ) ); + ) + ); + return $error if $error; - if($error) { - # queue the sending of this message so that the user can see what we - # tried to do, and retry if desired - my $queue = new FS::queue { - 'job' => 'FS::Misc::process_send_email', - 'custnum' => $cust_main->custnum, - 'status' => 'failed', - 'statustext' => $error, - }; - $queue->insert(@message); - push @retry_jobs, $queue; - } - else { - $success++; + if ( $job ) { #progressbar foo + $num++; + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $num / $num_cust ) + ); + die $error if $error; + $last = time; } } - if($success == 0 and - (scalar(@retry_jobs) > 10 or $num == $num_cust) - ) { - # 10 is arbitrary, but if we have enough failures, that's - # probably a configuration or network problem, and we - # abort the batch and run away screaming. - # We NEVER do this if anything was successfully sent. - $_->delete foreach (@retry_jobs); - return "multiple failures: '$error'\n"; - } - } - - if(@retry_jobs) { - # fail the job, but with a status message that makes it clear - # something was sent. - return "Sent $success, failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n"; } return ''; } +use Storable qw(thaw); +use Data::Dumper; +use MIME::Base64; sub process_email_search_result { my $job = shift; #warn "$me process_re_X $method for job $job\n" if $DEBUG; @@ -8770,9 +8504,6 @@ sub batch_charge { =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS -Deprecated. Use event notification and message templates -(L<FS::msg_template>) instead. - Sends a templated email notification to the customer (see L<Text::Template>). OPTIONS is a hash and may include @@ -9067,35 +8798,14 @@ sub _agent_plandata { } -=item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ] - -Subroutine (not a method), designed to be called from the queue. - -Takes a list of options and values. - -Pulls up the customer record via the custnum option and calls bill_and_collect. - -=cut - sub queued_bill { + ## actual sub, not a method, designed to be called from the queue. + ## sets up the customer, and calls the bill_and_collect my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_; - my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } ); - warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid - - $cust_main->bill_and_collect( %args ); -} - -sub process_bill_and_collect { - my $job = shift; - my $param = thaw(decode_base64(shift)); - my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } ) - or die "custnum '$param->{custnum}' not found!\n"; - $param->{'job'} = $job; - $param->{'fatal'} = 1; # runs from job queue, will be caught - $param->{'retry'} = 1; - - $cust_main->bill_and_collect( %$param ); + $cust_main->bill_and_collect( + %args, + ); } sub _upgrade_data { #class method @@ -9106,7 +8816,6 @@ sub _upgrade_data { #class method $sth->execute or die $sth->errstr; local($ignore_expired_card) = 1; - local($skip_fuzzyfiles) = 1; $class->_upgrade_otaker(%opts); } diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index eee263a..ff8226c 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -179,7 +179,7 @@ sub insert { $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "error inserting cust_pay: $error"; + return "error inserting $self: $error"; } if ( $self->invnum ) { @@ -192,11 +192,11 @@ sub insert { $error = $cust_bill_pay->insert(%options); if ( $error ) { if ( $ignore_noapply ) { - warn "warning: error inserting cust_bill_pay: $error ". + warn "warning: error inserting $cust_bill_pay: $error ". "(ignore_noapply flag set; inserting cust_pay record anyway)\n"; } else { $dbh->rollback if $oldAutoCommit; - return "error inserting cust_bill_pay: $error"; + return "error inserting $cust_bill_pay: $error"; } } } @@ -446,82 +446,76 @@ sub send_receipt { my $conf = new FS::Conf; - my @invoicing_list = $cust_main->invoicing_list_emailonly; - return '' unless @invoicing_list; + return '' + unless $conf->exists('payment_receipt_email') + && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list; $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though? if ( ( exists($opt->{'manual'}) && $opt->{'manual'} ) - || ! $conf->exists('invoice_html_statement') # XXX msg_template + || ! $conf->exists('invoice_html_statement') || ! $cust_bill ) { - my $error = ''; + 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 @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } + $cust_main->invoicing_list; - if( $conf->exists('payment_receipt_msgnum') ) { - my $msg_template = - FS::msg_template->by_key($conf->config('payment_receipt_msgnum')); - $error = $msg_template->send('cust_main'=> $cust_main, 'object'=> $self); + 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); } - 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 ''; - }; + $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), + ); - 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), - ); - - if ( $opt->{'cust_pkg'} ) { - $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg; - #setup date, other things? - } + if ( $opt->{'cust_pkg'} ) { + $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg; + #setup date, other things? + } - $error = send_email( - 'from' => $conf->config('invoice_from', $cust_main->agentnum), - #invoice_from??? well as good as any - 'to' => \@invoicing_list, - 'subject' => 'Payment receipt', - 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ], - ); + send_email( + 'from' => $conf->config('invoice_from', $cust_main->agentnum), + #invoice_from??? well as good as any + 'to' => \@invoicing_list, + 'subject' => 'Payment receipt', + 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ], + ); - } - else { # no payment_receipt_msgnum or payment_receipt_email + } else { - my $queue = new FS::queue { - 'paynum' => $self->paynum, - 'job' => 'FS::cust_bill::queueable_email', - }; + my $queue = new FS::queue { + 'paynum' => $self->paynum, + 'job' => 'FS::cust_bill::queueable_email', + }; + + $queue->insert( + 'invnum' => $cust_bill->invnum, + 'template' => 'statement', + ); + + } - $queue->insert( - 'invnum' => $cust_bill->invnum, - 'template' => 'statement', - ); - } - - warn "send_receipt: $error\n" if $error; - } #$opt{manual} || no invoice_html_statement || customer has no invoices } =item cust_bill_pay @@ -665,7 +659,7 @@ Returns an SQL fragment to retreive the unapplied amount. =cut sub unapplied_sql { - my ($class, $start, $end) = @_; + my ($class, $start, $end) = shift; my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : ''; my $bill_end = $end ? "AND cust_bill_pay._date > $end" : ''; my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : ''; @@ -699,10 +693,6 @@ sub _upgrade_data { #class method warn "$me upgrading $class\n" if $DEBUG; - ## - # otaker/ivan upgrade - ## - #not the most efficient, but hey, it only has to run once my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ". @@ -758,43 +748,6 @@ sub _upgrade_data { #class method } - ### - # payinfo N/A upgrade - ### - - #XXX remove the 'N/A (tokenized)' part (or just this entire thing) - - my @na_cust_pay = qsearch( { - 'table' => 'cust_pay', - 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' }, - 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )", - } ); - - foreach my $na ( @na_cust_pay ) { - - next unless $na->payinfo eq 'N/A'; - - my $cust_pay_pending = - qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } ); - unless ( $cust_pay_pending ) { - warn " *** WARNING: not-yet recoverable N/A card for payment ". - $na->paynum. " (no cust_pay_pending)\n"; - next; - } - $na->$_($cust_pay_pending->$_) for qw( payinfo paymask ); - my $error = $na->replace; - if ( $error ) { - warn " *** WARNING: Error updating payinfo for payment paynum ". - $na->paynun. ": $error\n"; - next; - } - - } - - ### - # otaker->usernum upgrade - ### - $class->_upgrade_otaker(%opts); } diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 0f9a611..b851ac7 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,7 +2,7 @@ package FS::cust_pkg; use strict; use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin - FS::m2m_Common FS::option_Common ); + FS::m2m_Common FS::option_Common FS::Record ); use vars qw($disable_agentcheck $DEBUG $me); use Carp qw(cluck); use Scalar::Util qw( blessed ); @@ -708,21 +708,12 @@ sub cancel { my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { - my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum); - my $error = ''; - if ( $msgnum ) { - my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); - $error = $msg_template->send( 'cust_main' => $self->cust_main, - 'object' => $self ); - } - else { - $error = send_email( - 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), - 'to' => \@invoicing_list, - 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), - 'body' => [ map "$_\n", $conf->config('cancelmessage') ], - ); - } + my $error = send_email( + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + 'to' => \@invoicing_list, + 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), + 'body' => [ map "$_\n", $conf->config('cancelmessage') ], + ); #should this do something on errors? } @@ -1774,16 +1765,6 @@ sub status { return 'active'; } -=item ucfirst_status - -Returns the status with the first character capitalized. - -=cut - -sub ucfirst_status { - ucfirst(shift->status); -} - =item statuses Class method that returns the list of possible status strings for packages @@ -1939,7 +1920,7 @@ sub _labels_short { my %labels; #tie %labels, 'Tie::IxHash'; push @{ $labels{$_->[0]} }, $_->[1] - foreach $self->$method(@_); + foreach $self->h_labels(@_); my @labels; foreach my $label ( keys %labels ) { my %seen = (); @@ -2445,25 +2426,14 @@ sub onetime_sql { " where cust_pkg.pkgpart = part_pkg.pkgpart ) "; } -=item ordered_sql - -Returns an SQL expression identifying ordered packages (recurring packages not -yet billed). - -=cut - -sub ordered_sql { - $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql; -} - =item active_sql Returns an SQL expression identifying active packages. =cut -sub active_sql { - $_[0]->recurring_sql. " +sub active_sql { " + ". $_[0]->recurring_sql(). " AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 3960370..6d08c86 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -343,7 +343,7 @@ Returns an SQL fragment to retreive the unapplied amount. =cut sub unapplied_sql { - my ($class, $start, $end) = @_; + my ($class, $start, $end) = shift; my $credit_start = $start ? "AND cust_credit_refund._date <= $start" : ''; my $credit_end = $end ? "AND cust_credit_refund._date > $end" : ''; my $pay_start = $start ? "AND cust_pay_refund._date <= $start" : ''; diff --git a/FS/FS/cust_tag.pm b/FS/FS/cust_tag.pm deleted file mode 100644 index 5dfd156..0000000 --- a/FS/FS/cust_tag.pm +++ /dev/null @@ -1,147 +0,0 @@ -package FS::cust_tag; - -use strict; -use base qw( FS::Record ); -use FS::Record qw( qsearchs ); -use FS::cust_main; -use FS::part_tag; - -=head1 NAME - -FS::cust_tag - Object methods for cust_tag records - -=head1 SYNOPSIS - - use FS::cust_tag; - - $record = new FS::cust_tag \%hash; - $record = new FS::cust_tag { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_tag object represents a customer tag. FS::cust_tag inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item custtagnum - -primary key - -=item custnum - -custnum - -=item tagnum - -tagnum - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new customer tag. To add the tag 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 { 'cust_tag'; } - -=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 customer tag. 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('custtagnum') - || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') - || $self->ut_foreign_key('tagnum', 'part_tag', 'tagnum' ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=item cust_main - -=cut - -sub cust_main { - my $self = shift; - qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); -} - -=item part_tag - -=cut - -sub part_tag { - my $self = shift; - qsearchs( 'part_tag', { 'tagnum' => $self->tagnum } ); -} - - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/h_inventory_item.pm b/FS/FS/h_inventory_item.pm deleted file mode 100644 index b4f0161..0000000 --- a/FS/FS/h_inventory_item.pm +++ /dev/null @@ -1,33 +0,0 @@ -package FS::h_inventory_item; - -use strict; -use vars qw( @ISA ); -use FS::h_Common; -use FS::inventory_item; - -@ISA = qw( FS::h_Common FS::inventory_item ); - -sub table { 'h_inventory_item' }; - -=head1 NAME - -FS::h_inventory_item - Historical record of inventory item activity - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -An FS::h_inventory_item object represents a change in the state of an -inventory item. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::inventory_item>, L<FS::h_Common>, L<FS::Record>, schema.html from the -base documentation. - -=cut - -1; - diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm deleted file mode 100644 index 7d507f4..0000000 --- a/FS/FS/msg_template.pm +++ /dev/null @@ -1,476 +0,0 @@ -package FS::msg_template; - -use strict; -use base qw( FS::Record ); -use Text::Template; -use FS::Misc qw( generate_email send_email ); -use FS::Conf; -use FS::Record qw( qsearch qsearchs ); - -use Date::Format qw( time2str ); -use HTML::Entities qw( decode_entities encode_entities ) ; -use HTML::FormatText; -use HTML::TreeBuilder; -use vars '$DEBUG'; - -$DEBUG=0; - -=head1 NAME - -FS::msg_template - Object methods for msg_template records - -=head1 SYNOPSIS - - use FS::msg_template; - - $record = new FS::msg_template \%hash; - $record = new FS::msg_template { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::msg_template object represents a customer message template. -FS::msg_template inherits from FS::Record. The following fields are currently -supported: - -=over 4 - -=item msgnum - -primary key - -=item msgname - -Template name. - -=item agentnum - -Agent associated with this template. Can be NULL for a global template. - -=item mime_type - -MIME type. Defaults to text/html. - -=item from_addr - -Source email address. - -=item subject - -The message subject line, in L<Text::Template> format. - -=item body - -The message body, as plain text or HTML, in L<Text::Template> format. - -=item disabled - -disabled - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new template. To add the template 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 { 'msg_template'; } - -=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 template. 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('msgnum') - || $self->ut_text('msgname') - || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') - || $self->ut_textn('mime_type') - || $self->ut_anything('subject') - || $self->ut_anything('body') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - || $self->ut_textn('from_addr') - ; - return $error if $error; - - $self->mime_type('text/html') unless $self->mime_type; - - $self->SUPER::check; -} - -=item prepare OPTION => VALUE - -Fills in the template and returns a hash of the 'from' address, 'to' -addresses, subject line, and body. - -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, svc_acct, or cust_pay object). - -=back - -=cut - -sub prepare { - my( $self, %opt ) = @_; - - my $cust_main = $opt{'cust_main'}; - my $object = $opt{'object'}; - warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n" - if($DEBUG); - - my $subs = $self->substitutions; - - ### - # create substitution table - ### - my %hash; - foreach my $obj ($cust_main, $object || ()) { - foreach my $name (@{ $subs->{$obj->table} }) { - if(!ref($name)) { - # simple case - $hash{$name} = $obj->$name(); - } - elsif( ref($name) eq 'ARRAY' ) { - # [ foo => sub { ... } ] - $hash{$name->[0]} = $name->[1]->($obj); - } - else { - warn "bad msg_template substitution: '$name'\n"; - #skip it? - } - } - } - $_ = encode_entities($_) foreach values(%hash); - - - ### - # clean up template - ### - my $subject_tmpl = new Text::Template ( - TYPE => 'STRING', - SOURCE => $self->subject, - ); - my $subject = $subject_tmpl->fill_in( HASH => \%hash ); - - my $body = $self->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 = ''; - 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 = $cust_main->invoicing_list_emailonly; - warn "prepared msg_template with no email destination (custnum ". - $cust_main->custnum.")\n" - if !@to; - - my $conf = new FS::Conf; - - ( - 'from' => $self->from || - scalar( $conf->config('invoice_from', $cust_main->agentnum) ), - 'to' => \@to, - 'subject' => $subject, - 'html_body' => $body, - 'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70 - )->format( HTML::TreeBuilder->new_from_content($body) ), - ); - -} - -=item send OPTION => VALUE - -Fills in the template and sends it to the customer. Options are as for -'prepare'. - -=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(@_))); -} - -# helper sub for package dates -my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' }; - -# needed for some things -my $conf = new FS::Conf; - -#return contexts and fill-in values -# If you add anything, be sure to add a description in -# httemplate/edit/msg_template.html. -sub substitutions { - { 'cust_main' => [qw( - display_custnum agentnum agent_name - - last first company - name name_short contact contact_firstlast - address1 address2 city county state zip - country - daytime night fax - - has_ship_address - ship_last ship_first ship_company - ship_name ship_name_short ship_contact ship_contact_firstlast - ship_address1 ship_address2 ship_city ship_county ship_state ship_zip - ship_country - ship_daytime ship_night ship_fax - - paymask payname paytype payip - num_cancelled_pkgs num_ncancelled_pkgs num_pkgs - classname categoryname - balance - invoicing_list_emailonly - cust_status ucfirst_cust_status cust_statuscolor - - signupdate dundate - ), - [ signupdate_ymd => sub { time2str('%Y-%m-%d', shift->signupdate) } ], - [ dundate_ymd => sub { time2str('%Y-%m-%d', shift->dundate) } ], - [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ], - [ otaker_first => sub { shift->access_user->first } ], - [ otaker_last => sub { shift->access_user->last } ], - [ payby => sub { FS::payby->shortname(shift->payby) } ], - [ company_name => sub { - $conf->config('company_name', shift->agentnum) - } ], - ], - # next_bill_date - 'cust_pkg' => [qw( - pkgnum pkg_label pkg_label_long - location_label - status statuscolor - - start_date setup bill last_bill - adjourn susp expire - labels_short - ), - [ cancel => sub { shift->getfield('cancel') } ], # grrr... - [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ], - [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ], - [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ], - [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ], - [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ], - [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ], - [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ], - [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ], - ], - 'cust_bill' => [qw( - invnum - _date - )], - #XXX not really thinking about cust_bill substitutions quite yet - - 'svc_acct' => [qw( - username - ), - [ password => sub { shift->getfield('_password') } ], - ], # for welcome messages - 'cust_pay' => [qw( - paynum - _date - ), - [ paid => sub { sprintf("%.2f", shift->paid) } ], - # overrides the one in cust_main in cases where a cust_pay is passed - [ payby => sub { FS::payby->shortname(shift->payby) } ], - [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ], - [ payinfo => sub { - my $cust_pay = shift; - ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ? - $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo) - } ], - ], - }; -} - -sub _upgrade_data { - my ($self, %opts) = @_; - - my @fixes = ( - [ 'alerter_msgnum', 'alerter_template', '', '' ], - [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '' ], - [ 'decline_msgnum', 'declinetemplate', '', '' ], - [ 'impending_recur_msgnum', 'impending_recur_template', '', '' ], - [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '' ], - [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from' ], - [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from' ], - ); - - my $conf = new FS::Conf; - my @agentnums = ('', map {$_->agentnum} qsearch('agent', {})); - foreach my $agentnum (@agentnums) { - foreach (@fixes) { - my ($newname, $oldname, $subject, $from) = @$_; - if ($conf->exists($oldname, $agentnum)) { - my $new = new FS::msg_template({ - 'msgname' => $oldname, - 'agentnum' => $agentnum, - 'from_addr' => ($from && $conf->config($from, $agentnum)) || - $conf->config('invoice_from', $agentnum), - 'subject' => ($subject && $conf->config($subject, $agentnum)) || '', - 'mime_type' => 'text/html', - 'body' => join('<BR>',$conf->config($oldname, $agentnum)), - }); - my $error = $new->insert; - die $error if $error; - $conf->set($newname, $new->msgnum, $agentnum); - $conf->delete($oldname, $agentnum); - $conf->delete($from, $agentnum) if $from; - $conf->delete($subject, $agentnum) if $subject; - } - } - } -} - -sub eviscerate { - # Every bit as pleasant as it sounds. - # - # We do this because Text::Template::Preprocess doesn't - # actually work. It runs the entire template through - # the preprocessor, instead of the code segments. Which - # is a shame, because Text::Template already contains - # the code to do this operation. - my $body = shift; - my (@outside, @inside); - my $depth = 0; - my $chunk = ''; - while($body || $chunk) { - my ($first, $delim, $rest); - # put all leading non-delimiters into $first - ($first, $rest) = - ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s); - $chunk .= $first; - # put a leading delimiter into $delim if there is one - ($delim, $rest) = - ($rest =~ /^([{}]?)(.*)$/s); - - if( $delim eq '{' ) { - $chunk .= '{'; - if( $depth == 0 ) { - push @outside, $chunk; - $chunk = ''; - } - $depth++; - } - elsif( $delim eq '}' ) { - $depth--; - if( $depth == 0 ) { - push @inside, $chunk; - $chunk = ''; - } - $chunk .= '}'; - } - else { - # no more delimiters - if( $depth == 0 ) { - push @outside, $chunk . $rest; - } # else ? something wrong - last; - } - $body = $rest; - } - (\@outside, \@inside); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/otaker_Mixin.pm b/FS/FS/otaker_Mixin.pm index 0da9aee..071958c 100644 --- a/FS/FS/otaker_Mixin.pm +++ b/FS/FS/otaker_Mixin.pm @@ -9,15 +9,8 @@ sub otaker { my $self = shift; if ( scalar(@_) ) { #set my $otaker = shift; - my $access_user = qsearchs('access_user', { 'username' => $otaker } ); - if ( !$access_user && $otaker =~ /^(.+), (.+)$/ ) { #same as below.. - my($lastname, $firstname) = ($1, $2); - $otaker = lc($firstname.$lastname); - $access_user = qsearchs('access_user', { 'first' => $firstname, - 'last' => $lastname } ) - || qsearchs('access_user', { 'username' => $otaker } ); - } - croak "can't set otaker: $otaker not found!" unless $access_user; #confess? + my $access_user = qsearchs('access_user', { 'username' => $otaker } ) + or croak "can't set otaker: $otaker not found!"; #confess? $self->usernum( $access_user->usernum ); $otaker; #not sure return is used anywhere, but just in case } else { #get @@ -40,30 +33,22 @@ sub _upgrade_otaker { my $class = shift; my $table = $class->table; - my $limit = ( $table eq 'cust_attachment' ? 10 : 1000 ); - while ( 1 ) { my @records = qsearch({ 'table' => $table, 'hashref' => {}, - 'extra_sql' => "WHERE otaker IS NOT NULL LIMIT $limit", + 'extra_sql' => 'WHERE otaker IS NOT NULL LIMIT 1000', }); last unless @records; foreach my $record (@records) { eval { $record->otaker($record->otaker) }; if ( $@ ) { - my $username = $record->otaker; - my($lastname, $firstname) = ( 'User', 'Legacy' ); - if ( $username =~ /^(.+), (.+)$/ ) { - ($lastname, $firstname) = ($1, $2); - $username = lc($firstname.$lastname); - } my $access_user = new FS::access_user { - 'username' => $username, + 'username' => $record->otaker, '_password' => 'CHANGEME', - 'first' => $firstname, - 'last' => $lastname, + 'first' => 'Legacy', + 'last' => 'User', 'disabled' => 'Y', }; my $error = $access_user->insert; diff --git a/FS/FS/part_event/Action/notice.pm b/FS/FS/part_event/Action/notice.pm deleted file mode 100644 index 1269653..0000000 --- a/FS/FS/part_event/Action/notice.pm +++ /dev/null @@ -1,47 +0,0 @@ -package FS::part_event::Action::notice; - -use strict; -use base qw( FS::part_event::Action ); -use FS::Record qw( qsearchs ); -use FS::msg_template; - -sub description { 'Send a notice from a message template'; } - -#sub eventtable_hashref { -# { 'cust_main' => 1, -# 'cust_bill' => 1, -# 'cust_pkg' => 1, -# }; -#} - -sub option_fields { - ( - 'msgnum' => { 'label' => 'Template', - 'type' => 'select-table', - 'table' => 'msg_template', - 'name_col' => 'msgname', - 'disable_empty' => 1, - }, - ); -} - -sub default_weight { 55; } #? - -sub do_action { - my( $self, $object ) = @_; - - my $cust_main = $self->cust_main($object); - - my $msgnum = $self->option('msgnum'); - - my $msg_template = qsearchs('msg_template', { 'msgnum' => $msgnum } ) - or die "Template $msgnum not found"; - - $msg_template->send( - 'cust_main' => $cust_main, - 'object' => $object, - ); - -} - -1; diff --git a/FS/FS/part_event/Condition/pkg_freq.pm b/FS/FS/part_event/Condition/pkg_freq.pm deleted file mode 100644 index 1fb8484..0000000 --- a/FS/FS/part_event/Condition/pkg_freq.pm +++ /dev/null @@ -1,36 +0,0 @@ -package FS::part_event::Condition::pkg_freq; - -use strict; -use FS::Misc; -use FS::cust_pkg; - -use base qw( FS::part_event::Condition ); - -sub description { 'Package billing frequency'; } - -sub option_fields { - my $freqs = FS::Misc::pkg_freqs(); - ( - 'freq' => { 'label' => 'Frequency', - 'type' => 'select', - 'labels' => $freqs, - 'options' => [ keys(%$freqs) ], - }, - ); -} - -sub eventtable_hashref { - { 'cust_main' => 0, - 'cust_bill' => 0, - 'cust_pkg' => 1, - }; -} - -sub condition { - my($self, $cust_pkg) = @_; - - $cust_pkg->part_pkg->freq eq $self->option('freq') -} - -1; - diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm index 3ac0dfd..edfd4b1 100644 --- a/FS/FS/part_export/communigate_pro.pm +++ b/FS/FS/part_export/communigate_pro.pm @@ -383,16 +383,12 @@ sub _export_replace_svc_acct { sub _export_replace_svc_domain { my( $self, $new, $old ) = (shift, shift, shift); - #let's just do the rename part realtime rather than trying to queue - #w/dependencies. we don't want FS winding up out-of-sync with the wrong - #username and a queued job anyway. right?? if ( $old->domain ne $new->domain ) { - eval { $self->communigate_pro_runcommand( - 'RenameDomain', $old->domain, $new->domain, - ) }; - return $@ if $@; + my $error = $self->communigate_pro_queue( $new->svcnum, 'RenameDomain', + $old->domain, $new->domain, + ); + return $error if $error; } - my %settings = (); $settings{'AccountsLimit'} = $new->max_accounts if $old->max_accounts ne $new->max_accounts; @@ -835,23 +831,6 @@ sub export_getsettings_svc_acct { } -sub export_getsettings_svc_forward { - my($self, $svc_forward, $settingsref, $defaultref ) = @_; - - my $dest = eval { $self->communigate_pro_runcommand( - 'GetForwarder', - ($svc_forward->src || $svc_forward->srcsvc_acct->email), - ) }; - return $@ if $@; - - my $settings = { 'Destination' => $dest }; - - %{$settingsref} = %$settings; - %{$defaultref} = (); - - ''; -} - sub _rule2string { my $rule = shift; my($priority, $name, $conditions, $actions, $comment) = @$rule; diff --git a/FS/FS/part_export/cust_http.pm b/FS/FS/part_export/cust_http.pm deleted file mode 100644 index 59503e8..0000000 --- a/FS/FS/part_export/cust_http.pm +++ /dev/null @@ -1,45 +0,0 @@ -package FS::part_export::cust_http; - -use vars qw( @ISA %info ); -use FS::part_export::http; -use Tie::IxHash; - -@ISA = qw( FS::part_export::http ); - -tie my %options, 'Tie::IxHash', %FS::part_export::http::options; - -$options{'insert_data'}->{'default'} = join("\n", - "action 'insert'", - "custnum \$cust_main->custnum", - "first \$cust_main->first", - "last \$cust_main->get('last')", - ( map "$_ \$cust_main->$_", qw( company address1 address2 city county state zip country daytime night fax last ) ), - "email \$cust_main->invoicing_list_emailonly_scalar", -); -$options{'delete_data'}->{'default'} = join("\n", - "action 'delete'", - "custnum \$cust_main->custnum", -); -$options{'replace_data'}->{'default'} = join("\n", - "action 'replace'", - "custnum \$new_cust_main->custnum", - "first \$new_cust_main->first", - "last \$new_cust_main->get('last')", - ( map "$_ \$cust_main->$_", qw( company address1 address2 city county state zip country daytime night fax last ) ), - "email \$new_cust_main->invoicing_list_emailonly_scalar", -); - -%info = ( - 'svc' => 'cust_main', - 'desc' => 'Send an HTTP or HTTPS GET or POST request, for customers.', - 'options' => \%options, - 'notes' => <<'END' -Send an HTTP or HTTPS GET or POST to the specified URL on customer addition, -modification and deletion. For HTTPS support, -<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> -or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> -is required. -END -); - -1; diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm index 6554991..4d6ea8f 100644 --- a/FS/FS/part_export/domreg_opensrs.pm +++ b/FS/FS/part_export/domreg_opensrs.pm @@ -259,6 +259,8 @@ sub _export_insert_on_payment { 'job' => 'FS::part_export::domreg_opensrs::renew_through', }; $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action? + + return ''; } ## Domain registration exports do nothing on replace. Mainly because we haven't decided what they should do. @@ -480,8 +482,7 @@ sub renew { Attempts to renew the domain through the specified date. If no date is provided it is gleaned from the associated cust_pkg bill date -Like some export functions, dies on failure or returns undef on success. -It is always called from the queue. +Like most export functions, returns an error message on failure or undef on success. =cut @@ -490,24 +491,24 @@ sub renew_through { warn "$me: renew_through called\n" if $DEBUG; eval "use Net::OpenSRS;"; - die $@ if $@; + return $@ if $@; unless ( $date ) { my $cust_pkg = $svc_domain->cust_svc->cust_pkg; - die "Can't renew: no date specified and domain is not in a package." + return "Can't renew: no date specified and domain is not in a package." unless $cust_pkg; $date = $cust_pkg->bill; } my $err = $self->is_supported_domain( $svc_domain ); - die $err if $err; + return $err if $err; warn "$me: checking status\n" if $DEBUG; my $rv = $self->get_status($svc_domain); - die "Domain ". $svc_domain->domain. " is not renewable" + return "Domain ". $svc_domain->domain. " is not renewable" unless $rv->{expdate}; - die "Can't parse expiration date for ". $svc_domain->domain + return "Can't parse expiration date for ". $svc_domain->domain unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/; my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6); @@ -530,13 +531,11 @@ sub renew_through { $years++; $exp->add( 'years' => 1 ); - die "Can't renew ". $svc_domain->domain. " for more than 10 years." + return "Can't renew ". $svc_domain->domain. " for more than 10 years." if $years > 10; #no infinite loop } - return '' unless $years; - - warn "$me: renewing ". $svc_domain->domain. " for $years years\n" if $DEBUG; + warn "$me: renewing ". $svc_domain->domain. "for $years years\n" if $DEBUG; my $srs = $self->get_srs; $rv = $srs->make_request( { @@ -551,7 +550,7 @@ sub renew_through { } } ); - die $rv->{response_text} unless $rv->{is_success}; + return $rv->{response_text} unless $rv->{is_success}; return ''; # Should only get here if renewal succeeded } diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm index e5e5a5c..55d8329 100644 --- a/FS/FS/part_export/http.pm +++ b/FS/FS/part_export/http.pm @@ -1,10 +1,12 @@ package FS::part_export::http; -use base qw( FS::part_export ); -use vars qw( %options %info ); +use vars qw(@ISA %info); use Tie::IxHash; +use FS::part_export; -tie %options, 'Tie::IxHash', +@ISA = qw(FS::part_export); + +tie my %options, 'Tie::IxHash', 'method' => { label =>'Method', type =>'select', #options =>[qw(POST GET)], @@ -64,10 +66,6 @@ sub _export_command { return unless $self->option("${action}_data"); - my $cust_main = $svc_x->table eq 'cust_main' - ? $svc_x - : $svc_x->cust_svc->cust_pkg->cust_main; - $self->http_queue( $svc_x->svcnum, $self->option('method'), $self->option('url'), @@ -87,18 +85,12 @@ sub _export_replace { return unless $self->option('replace_data'); - my $new_cust_main = $new->table eq 'cust_main' - ? $new - : $new->cust_svc->cust_pkg->cust_main; - my $cust_main = $new_cust_main; #so folks can use $new_cust_main or $cust_main - - $self->http_queue( $new->svcnum, + $self->http_queue( $svc_x->svcnum, $self->option('method'), $self->option('url'), map { /^\s*(\S+)\s+(.*)$/ or /()()/; my( $field, $value_expression ) = ( $1, $2 ); - my $value = eval $value_expression; die $@ if $@; ( $field, $value ); } split(/\n/, $self->option('replace_data') ) @@ -108,8 +100,10 @@ sub _export_replace { sub http_queue { my($self, $svcnum) = (shift, shift); - my $queue = new FS::queue { 'job' => "FS::part_export::http::http" }; - $queue->svcnum($svcnum) if $svcnum; + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::http::http", + }; $queue->insert( @_ ); } diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 8385320..823d99d 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -11,8 +11,6 @@ tie my %options, 'Tie::IxHash', 'dn' => { label=>'Root DN' }, 'password' => { label=>'Root DN password' }, 'userdn' => { label=>'User DN' }, - 'key_attrib' => { label=>'Key attribute name', - default=>'uid' }, 'attributes' => { label=>'Attributes', type=>'textarea', default=>join("\n", @@ -51,50 +49,31 @@ END sub rebless { shift; } -sub svc_context_eval { - # This should possibly be in svc_Common? - # Except the only places we use it are here and in shellcommands, - # and it's not even the same version. - my $svc_acct = shift; - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - ${$_} = $svc_acct->$_() foreach qw( domain ldap_password ); - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - if ( $cust_pkg ) { - my $cust_main = $cust_pkg->cust_main; - ${$_} = $cust_main->getfield($_) foreach qw(first last); +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + + #false laziness w/shellcommands.pm + { + no strict 'refs'; + ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + ${$_} = $svc_acct->$_() foreach qw( domain ); + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + ${$_} = $cust_main->getfield($_) foreach qw(first last); + } } - # DEPRECATED, probably fails for non-plain password encoding $crypt_password = ''; #surpress "used only once" warnings $crypt_password = '{crypt}'. crypt( $svc_acct->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] ); - return map { eval(qq("$_")) } @_ ; -} - -sub key_attrib { - my $self = shift; - return $self->option('key_attrib') if $self->option('key_attrib'); - # otherwise, guess that it's the one that's set to $username - foreach ( split("\n",$self->option('attributes')) ) { - /^\s*(\w+)\s+\$username\s*$/ && return $1; - } - # can't recover from that, but we can fail in a more obvious way - # than the old code did... - die "no key_attrib set in LDAP export\n"; -} - -sub ldap_attrib { - # Convert the svc_acct to its LDAP attribute set. - my($self, $svc_acct) = (shift, shift); + my $username_attrib; my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; - ( $1 => $2 ); } + $username_attrib = $1 if $2 eq '$username'; + ( $1 => eval(qq("$2")) ); } grep { /^\s*(\w+)\s+(.*\S)\s*$/ } split("\n", $self->option('attributes')); - my @vals = svc_context_eval($svc_acct, values(%attrib)); - @attrib{keys(%attrib)} = @vals; - if ( $self->option('radius') ) { foreach my $table (qw(reply check)) { my $method = "radius_$table"; @@ -105,20 +84,22 @@ sub ldap_attrib { } } } - return %attrib; -} - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - my $err_or_queue = $self->ldap_queue( - $svc_acct->svcnum, - 'insert', - $self->key_attrib, - $self->ldap_attrib($svc_acct), - ); + my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert', + #$svc_acct->username, + $username_attrib, + %attrib ); return $err_or_queue unless ref($err_or_queue); + #groups with LDAP? + #my @groups = $svc_acct->radius_groups; + #if ( @groups ) { + # my $err_or_queue = $self->ldap_queue( + # $svc_acct->svcnum, 'usergroup_insert', + # $svc_acct->username, @groups ); + # return $err_or_queue unless ref($err_or_queue); + #} + ''; } @@ -132,42 +113,109 @@ sub _export_replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + return "can't (yet?) change username with ldap" + if $old->username ne $new->username; + + return "ldap replace unimplemented"; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; my $jobnum = ''; + #if ( $old->username ne $new->username ) { + # my $err_or_queue = $self->ldap_queue( $new->svcnum, 'rename', + # $new->username, $old->username ); + # unless ( ref($err_or_queue) ) { + # $dbh->rollback if $oldAutoCommit; + # return $err_or_queue; + # } + # $jobnum = $err_or_queue->jobnum; + #} + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %new = $new->$method(); + my %old = $old->$method(); + if ( grep { !exists $old{$_} #new attributes + || $new{$_} ne $old{$_} #changed + } keys %new + ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'insert', + $table, $new->username, %new ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } - # the Lazy way: nuke the entry and recreate it. - # any reason this shouldn't work? Freeside _has_ to have - # write access to these entries and their parent DN. - my $key = $self->key_attrib; - my %attrib = $self->ldap_attrib($old); - my $err_or_queue = $self->ldap_queue( - $old->svcnum, - 'delete', - $key, - $attrib{$key} - ); - if( !ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; + my @del = grep { !exists $new{$_} } keys %old; + if ( @del ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'attrib_delete', + $table, $new->username, @del ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } } - $jobnum = $err_or_queue->jobnum; - $err_or_queue = $self->ldap_queue( - $new->svcnum, - 'insert', - $key, - $self->ldap_attrib($new) - ); - if( !ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; + + # (sorta) false laziness with FS::svc_acct::replace + my @oldgroups = @{$old->usergroup}; #uuuh + my @newgroups = $new->radius_groups; + my @delgroups = (); + foreach my $oldgroup ( @oldgroups ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + push @delgroups, $oldgroup; } - $err_or_queue = $err_or_queue->depend_insert($jobnum); - if( $err_or_queue ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; + + if ( @delgroups ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_delete', + $new->username, @delgroups ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + if ( @newgroups ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_insert', + $new->username, @newgroups ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -177,13 +225,9 @@ sub _export_replace { sub _export_delete { my( $self, $svc_acct ) = (shift, shift); - - my $key = $self->key_attrib; - my ( $val ) = map { /^\s*$key\s+(.*\S)\s*$/ ? $1 : () } - split("\n", $self->option('attributes')); - ( $val ) = svc_context_eval($svc_acct, $val); + return "ldap delete unimplemented"; my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete', - $key, $val ); + $svc_acct->username ); ref($err_or_queue) ? '' : $err_or_queue; } @@ -204,9 +248,10 @@ sub ldap_queue { sub ldap_insert { #subroutine, not method my $ldap = ldap_connect(shift, shift, shift); - my( $userdn, $key_attrib, %attrib ) = @_; + my( $userdn, $username_attrib, %attrib ) = @_; - $userdn = "$key_attrib=$attrib{$key_attrib}, $userdn"; + $userdn = "$username_attrib=$attrib{$username_attrib}, $userdn" + if $username_attrib; #icky hack, but should be unsurprising to the LDAPers foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) { $attrib{$key} = [ split(/,/, $attrib{$key}) ]; @@ -218,32 +263,17 @@ sub ldap_insert { #subroutine, not method $ldap->unbind; } -sub ldap_delete { - my $ldap = ldap_connect(shift, shift, shift); - - my $entry = ldap_fetch($ldap, @_); - if($entry) { - my $status = $ldap->delete($entry); - die 'LDAP error: '.$status->error."\n" if $status->is_error; - } - $ldap->unbind; - # should failing to find the entry be fatal? - # if it is, it will block unprovisioning the service, which is a pain. -} - -sub ldap_fetch { - # avoid needless duplication in delete and modify - my( $ldap, $userdn, %key_data ) = @_; - my $filter = join('', map { "($_=$key_data{$_})" } keys(%key_data)); - - my $status = $ldap->search( base => $userdn, - scope => 'one', - filter => $filter ); - die 'LDAP error: '.$status->error."\n" if $status->is_error; - my ($entry) = $status->entries; - warn "Entry '$filter' not found in LDAP\n" if !$entry; - return $entry; -} +#sub ldap_delete { #subroutine, not method +# my $dbh = ldap_connect(shift, shift, shift); +# my $username = shift; +# +# foreach my $table (qw( radcheck radreply usergroup )) { +# my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); +# $sth->execute($username) +# or die "can't delete from $table table: ". $sth->errstr; +# } +# $dbh->disconnect; +#} sub ldap_connect { my( $machine, $dn, $password ) = @_; diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index f278d5e..ef7f557 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -774,9 +774,34 @@ sub is_free { sub can_discount { 0; } sub freqs_href { - # moved to FS::Misc to make this accessible to other packages - # at initialization - FS::Misc::pkg_freqs(); + #method, class method or sub? #my $self = shift; + + tie my %freq, 'Tie::IxHash', + '0' => '(no recurring fee)', + '1h' => 'hourly', + '1d' => 'daily', + '2d' => 'every two days', + '3d' => 'every three days', + '1w' => 'weekly', + '2w' => 'biweekly (every 2 weeks)', + '1' => 'monthly', + '45d' => 'every 45 days', + '2' => 'bimonthly (every 2 months)', + '3' => 'quarterly (every 3 months)', + '4' => 'every 4 months', + '137d' => 'every 4 1/2 months (137 days)', + '6' => 'semiannually (every 6 months)', + '12' => 'annually', + '13' => 'every 13 months (annually +1 month)', + '24' => 'biannually (every 2 years)', + '36' => 'triannually (every 3 years)', + '48' => '(every 4 years)', + '60' => '(every 5 years)', + '120' => '(every 10 years)', + ; + + \%freq; + } =item freq_pretty diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm index 1d2f673..77b9af5 100644 --- a/FS/FS/part_pkg/voip_cdr.pm +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -13,16 +13,9 @@ use FS::rate_prefix; use FS::rate_detail; use FS::part_pkg::recur_Common; -use List::Util qw(first min); - @ISA = qw(FS::part_pkg::recur_Common); -$DEBUG = 1; - -tie my %cdr_svc_method, 'Tie::IxHash', - 'svc_phone.phonenum' => 'Phone numbers (svc_phone.phonenum)', - 'svc_pbx.title' => 'PBX name (svc_pbx.title)', -; +$DEBUG = 0; tie my %rating_method, 'Tie::IxHash', 'prefix' => 'Rate calls by using destination prefix to look up a region and rate according to the internal prefix and rate tables', @@ -78,11 +71,6 @@ tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities(); 'select_options' => \%FS::part_pkg::recur_Common::recur_method, }, - 'cdr_svc_method' => { 'name' => 'CDR service matching method', - 'type' => 'radio', - 'options' => \%cdr_svc_method, - }, - 'rating_method' => { 'name' => 'Rating method', 'type' => 'radio', 'options' => \%rating_method, @@ -149,32 +137,12 @@ tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities(); 'use_cdrtypenum' => { 'name' => 'Do not charge for CDRs where the CDR Type is not set to: ', }, - 'skip_dst_prefix' => { 'name' => 'Do not charge for CDRs where the destination number starts with any of these values:', - }, - 'skip_dcontext' => { 'name' => 'Do not charge for CDRs where the dcontext is set to any of these (comma-separated) values:', }, 'skip_dstchannel_prefix' => { 'name' => 'Do not charge for CDRs where the dstchannel starts with:', }, - 'skip_src_length_more' => { 'name' => 'Do not charge for CDRs where the source is more than this many digits:', - }, - - 'noskip_src_length_accountcode_tollfree' => { 'name' => 'Do charge for CDRs where source is equal or greater than the specified digits and accountcode is toll free', - 'type' => 'checkbox', - }, - - 'accountcode_tollfree_ratenum' => { - 'name' => 'Optional alternate rate plan when accountcode is toll free', - 'type' => 'select', - 'select_table' => 'rate', - 'select_key' => 'ratenum', - 'select_label' => 'ratename', - 'disable_empty' => 0, - 'empty_label' => '', - }, - 'skip_dst_length_less' => { 'name' => 'Do not charge for CDRs where the destination is less than this many digits:', }, @@ -242,7 +210,6 @@ tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities(); 'fieldorder' => [qw( setup_fee recur_fee recur_temporality unused_credit recur_method cutoff_day - cdr_svc_method rating_method ratenum min_charge sec_granularity ignore_unrateable default_prefix @@ -251,10 +218,7 @@ tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities(); disable_tollfree use_amaflags use_disposition use_disposition_taqua use_carrierid use_cdrtypenum - skip_dcontext skip_dst_prefix - skip_dstchannel_prefix skip_src_length_more - noskip_src_length_accountcode_tollfree - accountcode_tollfree_ratenum + skip_dcontext skip_dstchannel_prefix skip_dst_length_less skip_lastapp use_duration 411_rewrite @@ -314,7 +278,6 @@ sub calc_usage { # my $downstream_cdr = ''; - my $cdr_svc_method = $self->option('cdr_svc_method')||'svc_phone.phonenum'; my $rating_method = $self->option('rating_method') || 'prefix'; my $intl = $self->option('international_prefix') || '011'; my $domestic_prefix = $self->option('domestic_prefix'); @@ -335,8 +298,6 @@ sub calc_usage { @dirass = split(',', $dirass); } - my %interval_cache = (); # for timed rates - #for check_chargable, so we don't keep looking up options inside the loop my %opt_cache = (); @@ -344,15 +305,13 @@ sub calc_usage { die $@ if $@; my $csv = new Text::CSV_XS; - my($svc_table, $svc_field) = split('\.', $cdr_svc_method); - foreach my $cust_svc ( - grep { $_->part_svc->svcdb eq $svc_table } $cust_pkg->cust_svc + grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc ) { - my $svc_x = $cust_svc->svc_x; + my $svc_phone = $cust_svc->svc_x; foreach my $cdr ( - $svc_x->get_cdrs( + $svc_phone->get_cdrs( 'disable_src' => $self->option('disable_src'), 'default_prefix' => $self->option('default_prefix'), 'status' => '', @@ -366,16 +325,11 @@ sub calc_usage { my $rate_detail; my( $rate_region, $regionnum ); - my $rate; my $pretty_destnum; my $charge = ''; my $seconds = ''; - my $weektime = ''; my $regionname = ''; my $classnum = ''; - my $countrycode; - my $number; - my @call_details = (); if ( $rating_method eq 'prefix' ) { @@ -402,7 +356,7 @@ sub calc_usage { # (or calling station id for toll free calls) ### - my( $to_or_from ); + my( $to_or_from, $number ); if ( $cdr->is_tollfree && ! $disable_tollfree ) { #tollfree call $to_or_from = 'from'; @@ -422,7 +376,7 @@ sub calc_usage { # $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com #determine the country code - $countrycode = ''; + my $countrycode; if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/ || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/ ) @@ -451,24 +405,11 @@ sub calc_usage { #asterisks here causes inserting the detail to barf, so: $pretty_destnum =~ s/\*//g; - my $eff_ratenum = $cdr->is_tollfree('accountcode') - ? $cust_pkg->part_pkg->option('accountcode_tollfree_ratenum') - : ''; - $eff_ratenum ||= $ratenum; - $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum }) - or die "ratenum $eff_ratenum not found!"; - - my @ltime = localtime($cdr->startdate); - $weektime = $ltime[0] + - $ltime[1]*60 + #minutes - $ltime[2]*3600 + #hours - $ltime[6]*86400; #days since sunday - # if there's no timed rate_detail for this time/region combination, - # dest_detail returns the default. There may still be a timed rate - # that applies after the starttime of the call, so be careful... + my $rate = qsearchs('rate', { 'ratenum' => $ratenum }) + or die "ratenum $ratenum not found!"; + $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode, 'phonenum' => $number, - 'weektime' => $weektime, }); if ( $rate_detail ) { @@ -480,17 +421,6 @@ sub calc_usage { "and rate detail $rate_detail\n" if $DEBUG; - if ( !exists($interval_cache{$regionnum}) ) { - my @intervals = ( - sort { $a->stime <=> $b->stime } - map { my $r = $_->rate_time; $r ? $r->intervals : () } - $rate->rate_detail - ); - $interval_cache{$regionnum} = \@intervals; - warn " cached ".scalar(@intervals)." interval(s)\n" - if $DEBUG; - } - } elsif ( $ignore_unrateable ) { $rate_region = ''; @@ -525,7 +455,6 @@ sub calc_usage { # } else { #pass upstream price through # # $charge = sprintf('%.2f', $cdr->upstream_price); -# warn "Incrementing \$charges by $charge. Now $charges\n" if $DEBUG; # $charges += $charge; # # @call_details = ( @@ -544,7 +473,6 @@ sub calc_usage { #XXX $charge = sprintf('%.2f', $cdr->upstream_price); $charge = sprintf('%.3f', $cdr->upstream_price); $charges += $charge; - warn "Incrementing \$charges by $charge. Now $charges\n" if $DEBUG; @call_details = ($cdr->downstream_csv( 'format' => $output_format, 'charge' => $charge, @@ -575,7 +503,6 @@ sub calc_usage { $charge = sprintf('%.4f', ( $self->option('min_charge') * $minutes ) + 0.0000000001 ); #so 1.00005 rounds to 1.0001 - warn "Incrementing \$charges by $charge. Now $charges\n" if $DEBUG; $charges += $charge; @call_details = ($cdr->downstream_csv( 'format' => $output_format, @@ -605,121 +532,59 @@ sub calc_usage { unless ( @call_details || ( $charge ne '' && $charge == 0 ) ) { - my $seconds_left = $use_duration ? $cdr->duration : $cdr->billsec; - # charge for the first (conn_sec) seconds - $seconds = min($seconds_left, $rate_detail->conn_sec); - $seconds_left -= $seconds; - $weektime += $seconds; - $charge = sprintf("%.02f", $rate_detail->conn_charge); - - my $total_minutes = 0; - my $whole_minutes = 1; - my $etime; - while($seconds_left) { - my $ratetimenum = $rate_detail->ratetimenum; # may be empty - - # find the end of the current rate interval - if(@{ $interval_cache{$regionnum} } == 0) { - # There are no timed rates in this group, so just stay - # in the default rate_detail for the entire duration. - # Set an "end" of 1 past the end of the current call. - $etime = $weektime + $seconds_left + 1; - } - elsif($ratetimenum) { - # This is a timed rate, so go to the etime of this interval. - # If it's followed by another timed rate, the stime of that - # interval should match the etime of this one. - my $interval = $rate_detail->rate_time->contains($weektime); - $etime = $interval->etime; - } - else { - # This is a default rate, so use the stime of the next - # interval in the sequence. - my $next_int = first { $_->stime > $weektime } - @{ $interval_cache{$regionnum} }; - if ($next_int) { - $etime = $next_int->stime; - } - else { - # weektime is near the end of the week, so decrement - # it by a full week and use the stime of the first - # interval. - $weektime -= (3600*24*7); - $etime = $interval_cache{$regionnum}->[0]->stime; - } - } - - my $charge_sec = min($seconds_left, $etime - $weektime); + $included_min{$regionnum} = $rate_detail->min_included + unless exists $included_min{$regionnum}; - $seconds_left -= $charge_sec; + my $granularity = $rate_detail->sec_granularity; - $included_min{$regionnum}{$ratetimenum} = $rate_detail->min_included - unless exists $included_min{$regionnum}{$ratetimenum}; + # length($cdr->billsec) ? $cdr->billsec : $cdr->duration; + $seconds = $use_duration ? $cdr->duration : $cdr->billsec; - my $granularity = $rate_detail->sec_granularity; - $whole_minutes = 0 if $granularity; + $seconds -= $rate_detail->conn_sec; + $seconds = 0 if $seconds < 0; - # should this be done in every rate interval? - $charge_sec += $granularity - ( $charge_sec % $granularity ) - if $charge_sec # don't granular-ize 0 billsec calls (bills them) - && $granularity; # 0 is per call - my $minutes = sprintf("%.1f", $charge_sec / 60); - $minutes =~ s/\.0$// if $granularity == 60; + $seconds += $granularity - ( $seconds % $granularity ) + if $seconds # don't granular-ize 0 billsec calls (bills them) + && $granularity; # 0 is per call + my $minutes = sprintf("%.1f", $seconds / 60); + $minutes =~ s/\.0$// if $granularity == 60; - $seconds += $charge_sec; + # per call rather than per minute + $minutes = 1 unless $granularity; - # per call rather than per minute - $minutes = 1 unless $granularity; - $seconds_left = 0 unless $granularity; + $included_min{$regionnum} -= $minutes; - $included_min{$regionnum}{$ratetimenum} -= $minutes; - - if ( $included_min{$regionnum}{$ratetimenum} <= 0 ) { - my $charge_min = 0 - $included_min{$regionnum}{$ratetimenum}; #XXX should preserve - #(display?) this - $included_min{$regionnum}{$ratetimenum} = 0; - $charge += sprintf('%.2f', ($rate_detail->min_charge * $charge_min) - + 0.00000001 ); #so 1.005 rounds to 1.01 - } + $charge = sprintf('%.2f', $rate_detail->conn_charge); - # choose next rate_detail - $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode, - 'phonenum' => $number, - 'weektime' => $etime }) - if($seconds_left); - # we have now moved forward to $etime - $weektime = $etime; + if ( $included_min{$regionnum} < 0 ) { + my $charge_min = 0 - $included_min{$regionnum}; #XXX should preserve + #(display?) this + $included_min{$regionnum} = 0; + $charge += sprintf('%.2f', ($rate_detail->min_charge * $charge_min) + + 0.00000001 ); #so 1.005 rounds to 1.01 + $charge = sprintf('%.2f', $charge); + $charges += $charge; + } - } #while $seconds_left # this is why we need regionnum/rate_region.... warn " (rate region $rate_region)\n" if $DEBUG; - $total_minutes = sprintf("%.1f", $seconds / 60); - $total_minutes =~ s/\.0$// if $whole_minutes; + @call_details = ( + $cdr->downstream_csv( 'format' => $output_format, + 'granularity' => $granularity, + 'minutes' => $minutes, + 'charge' => $charge, + 'pretty_dst' => $pretty_destnum, + 'dst_regionname' => $regionname, + ) + ); $classnum = $rate_detail->classnum; - $charge = sprintf('%.2f', $charge); - @call_details = ( - $cdr->downstream_csv( 'format' => $output_format, - 'granularity' => $rate_detail->sec_granularity, - 'minutes' => $total_minutes, - # why do we go through this hocus-pocus? - # the cdr *will* show duration here - # if we forego the 'minutes' key - # duration vs billsec? - 'charge' => $charge, - 'pretty_dst' => $pretty_destnum, - 'dst_regionname' => $regionname, - ) - ); - } #if(there is a rate_detail) - + } if ( $charge > 0 ) { #just use FS::cust_bill_pkg_detail objects? - warn "Incrementing \$charges by $charge. Now $charges\n" if $DEBUG; - $charges += $charge; my $call_details; my $phonenum = $cust_svc->svc_x->phonenum; @@ -823,10 +688,8 @@ sub check_chargable { use_disposition_taqua use_carrierid use_cdrtypenum - skip_dst_prefix skip_dcontext skip_dstchannel_prefix - skip_src_length_more noskip_src_length_accountcode_tollfree skip_dst_length_less skip_lastapp ); @@ -853,11 +716,6 @@ sub check_chargable { if length($opt{'use_cdrtypenum'}) && $cdr->cdrtypenum ne $opt{'use_cdrtypenum'}; #ne otherwise 0 matches '' - foreach(split(',',$opt{'skip_dst_prefix'})) { - return "dst starts with '$_'" - if length($_) && substr($cdr->dst,0,length($_)) eq $_; - } - return "dcontext IN ( $opt{'skip_dcontext'} )" if $opt{'skip_dcontext'} =~ /\S/ && grep { $cdr->dcontext eq $_ } split(/\s*,\s*/, $opt{'skip_dcontext'}); @@ -874,26 +732,6 @@ sub check_chargable { return "lastapp is $opt{'skip_lastapp'}" if length($opt{'skip_lastapp'}) && $cdr->lastapp eq $opt{'skip_lastapp'}; - my $src_length = $opt{'skip_src_length_more'}; - if ( $src_length ) { - - if ( $opt{'noskip_src_length_accountcode_tollfree'} ) { - - if ( $cdr->is_tollfree('accountcode') ) { - return "source less than or equal to $src_length digits" - if length($cdr->src) <= $src_length; - } else { - return "source more than $src_length digits" - if length($cdr->src) > $src_length; - } - - } else { - return "source more than $src_length digits" - if length($cdr->src) > $src_length; - } - - } - #all right then, rate it ''; } diff --git a/FS/FS/part_pkg_taxrate.pm b/FS/FS/part_pkg_taxrate.pm index fb1afce..5a1e7ba 100644 --- a/FS/FS/part_pkg_taxrate.pm +++ b/FS/FS/part_pkg_taxrate.pm @@ -296,7 +296,7 @@ sub batch_import { $hash->{'country'} = 'US'; # CA is available - $hash->{'taxable'} = '' if ($hash->{'taxable'} eq 'N'); + delete($hash->{'taxable'}) if ($hash->{'taxable'} eq 'N'); if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') { delete($hash->{actionflag}); diff --git a/FS/FS/part_tag.pm b/FS/FS/part_tag.pm deleted file mode 100644 index 0229e3a..0000000 --- a/FS/FS/part_tag.pm +++ /dev/null @@ -1,132 +0,0 @@ -package FS::part_tag; - -use strict; -use base qw( FS::Record ); -use FS::Record qw( qsearch qsearchs ); - -=head1 NAME - -FS::part_tag - Object methods for part_tag records - -=head1 SYNOPSIS - - use FS::part_tag; - - $record = new FS::part_tag \%hash; - $record = new FS::part_tag { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_tag object represents a tag. FS::part_tag inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item tagnum - -primary key - -=item tagname - -tagname - -=item tagdesc - -tagdesc - -=item tagcolor - -tagcolor - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new tag. To add the tag 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 { 'part_tag'; } - -=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 tag. 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('tagnum') - || $self->ut_text('tagname') - || $self->ut_textn('tagdesc') - || $self->ut_textn('tagcolor') - || $self->ut_enum('disabled', [ '', 'Y' ] ) - ; - return $error if $error; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index 3abb06d..6a27554 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -195,9 +195,6 @@ sub import_results { my $info = $import_info{$format} or die "unknown format $format"; - my $job = $param->{'job'}; - $job->update_statustext(0) if $job; - my $filetype = $info->{'filetype'}; # CSV or fixed my @fields = @{ $info->{'fields'}}; my $formatre = $info->{'formatre'}; # for fixed @@ -289,12 +286,7 @@ sub import_results { } } - my $num = 0; foreach (@all_values) { - if($job) { - $num++; - $job->update_statustext(int(100 * $num/scalar(@all_values))); - } my @values = @$_; my %hash; @@ -362,8 +354,7 @@ sub import_results { 'custnum' => $custnum, 'payby' => $payby, 'paybatch' => $self->batchnum, - 'payinfo' => ( $hash{'payinfo'} || $cust_pay_batch->payinfo ), - map { $_ => $hash{$_} } (qw( paid _date )), + map { $_ => $hash{$_} } (qw( paid _date payinfo )), } ); $error = $cust_pay->insert; if ( $error ) { @@ -413,29 +404,6 @@ sub import_results { } -use MIME::Base64; -use Storable 'thaw'; -use Data::Dumper; -sub process_import_results { - my $job = shift; - my $param = thaw(decode_base64(shift)); - $param->{'job'} = $job; - warn Dumper($param) if $DEBUG; - my $batchnum = delete $param->{'batchnum'} or die "no batchnum specified\n"; - my $batch = FS::pay_batch->by_key($batchnum) or die "batchnum '$batchnum' not found\n"; - - my $file = $param->{'uploaded_files'} or die "no files provided\n"; - $file =~ s/^(\w+):([\.\w]+)$/$2/; - my $dir = '%%%FREESIDE_CACHE%%%/cache.' . $FS::UID::datasrc; - open( $param->{'filehandle'}, - '<', - "$dir/$file" ) - or die "unable to open '$file'.\n"; - my $error = $batch->import_results($param); - unlink $file; - die $error if $error; -} - # Formerly httemplate/misc/download-batch.cgi sub export_batch { my $self = shift; diff --git a/FS/FS/payinfo_Mixin.pm b/FS/FS/payinfo_Mixin.pm index 9995183..99cca6a 100644 --- a/FS/FS/payinfo_Mixin.pm +++ b/FS/FS/payinfo_Mixin.pm @@ -18,6 +18,12 @@ use vars qw(@ISA); This is a mixin class for records that contain payinfo. +This class handles the following functions for payinfo... + +Payment Mask (Generation and Storage) +Data Validation (parent checks need to be sure to call this) +Pretty printing + =head1 FIELDS =over 4 @@ -66,12 +72,12 @@ Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or sub payinfo { my($self,$payinfo) = @_; - if ( defined($payinfo) ) { - $self->setfield('payinfo', $payinfo); - $self->paymask($self->mask_payinfo) unless $payinfo =~ /^99\d{14}$/; #token + $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter' + $self->paymask($self->mask_payinfo()); } else { - $self->getfield('payinfo'); + $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter' + return $payinfo; } } @@ -104,11 +110,25 @@ sub paycvv { sub paymask { my($self, $paymask) = @_; - if ( defined($paymask) ) { - $self->setfield('paymask', $paymask); + if ( defined($paymask) && $paymask ne '' ) { + # I hate this little bit of magic... I don't expect it to cause a problem, + # but who knows... If the payinfo is passed in masked then ignore it and + # set it based on the payinfo. The only guy that should call this in this + # way is... $self->payinfo + $self->setfield('paymask', $self->mask_payinfo()); + } else { - $self->getfield('paymask') || $self->mask_payinfo; + + $paymask=$self->getfield('paymask'); + if (!defined($paymask) || $paymask eq '') { + # Generate it if it's blank - Note that we're not going to set it - just + # generate + $paymask = $self->mask_payinfo(); + } + } + + return $paymask; } =back @@ -135,8 +155,6 @@ sub mask_payinfo { my $paymask; if ( $self->is_encrypted($payinfo) ) { $paymask = 'N/A'; - } elsif ( $payinfo =~ /^99\d{14}$/ || $payinfo eq 'N/A' ) { #token - $paymask = 'N/A (tokenized)'; #? } else { # if not, mask it... if ($payby eq 'CARD' || $payby eq 'DCRD' || $payby eq 'MCRD') { @@ -159,7 +177,7 @@ sub mask_payinfo { $paymask = $payinfo; } } - $paymask; + return $paymask; } =item payinfo_check @@ -200,8 +218,7 @@ sub payinfo_check { or return "Illegal (mistyped?) credit card number (payinfo)"; $self->payinfo($1); validate($self->payinfo) or return "Illegal credit card number"; - return "Unknown card type" if $self->payinfo !~ /^99\d{14}$/ #token - && cardtype($self->payinfo) eq "Unknown"; + return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; } else { $self->payinfo('N/A'); #??? } @@ -258,6 +275,11 @@ sub payby_payinfo_pretty { =head1 BUGS +Future items? + Encryption - In the Future (Pull from Record.pm) + Bad Card Stuff - In the Future (Integrate Banned Pay) + Currency - In the Future + =head1 SEE ALSO L<FS::payby>, L<FS::Record> diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 3f8763d..99e349c 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -12,7 +12,7 @@ use FS::Record qw( qsearch qsearchs dbh ); use FS::queue_arg; use FS::queue_depend; use FS::cust_svc; -use FS::CGI qw(rooturl); +use FS::CGI qw (rooturl); @ISA = qw(FS::Record); @EXPORT_OK = qw( joblisting ); @@ -67,20 +67,6 @@ Job status (new, locked, or failed) Freeform text status message -=cut - -sub statustext { - my $self = shift; - if ( defined ( $_[0] ) ) { - $self->SUPER::statustext(@_); - } else { - my $value = $self->SUPER::statustext(); - my $rooturl = rooturl(); - $value =~ s/%%%ROOTURL%%%/$rooturl/g; - $value; - } -} - =item _date UNIX timestamp @@ -377,7 +363,7 @@ If there is an error, returns the error, otherwise returns false. use vars qw($_update_statustext_dbh); sub update_statustext { my( $self, $statustext ) = @_; - return '' if $statustext eq $self->get('statustext'); #avoid rooturl expansion + return '' if $statustext eq $self->statustext; warn "updating statustext for $self to $statustext" if $DEBUG; $_update_statustext_dbh ||= myconnect; @@ -388,7 +374,7 @@ sub update_statustext { $sth->execute($statustext, $self->jobnum) or return $sth->errstr; $_update_statustext_dbh->commit or die $_update_statustext_dbh->errstr; - $self->set('statustext', $statustext); #avoid rooturl expansion + $self->statustext($statustext); ''; #my $new = new FS::queue { $self->hash }; diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index f30e4c7..793846a 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -279,22 +279,16 @@ Destination can be specified as an FS::rate_detail object or regionnum (see L<FS::rate_detail>), or as a hashref with two keys: I<countrycode> and I<phonenum>. -An optional third key, I<weektime>, will return a timed rate (one with -a non-null I<ratetimenum>) if one exists for a call at that time. If -no matching timed rate exists, the non-timed rate will be returned. - =cut sub dest_detail { my $self = shift; my $regionnum; - my $weektime; if ( ref($_[0]) eq 'HASH' ) { my $countrycode = $_[0]->{'countrycode'}; my $phonenum = $_[0]->{'phonenum'}; - $weektime = $_[0]->{'weektime'}; #find a rate prefix, first look at most specific, then fewer digits, # finally trying the country code only @@ -320,31 +314,9 @@ sub dest_detail { } else { $regionnum = ref($_[0]) ? shift->regionnum : shift; } - - if(!defined($weektime)) { - return qsearchs( 'rate_detail', - { 'ratenum' => $self->ratenum, - 'dest_regionnum' => $regionnum, - 'ratetimenum' => '', - } ); - } - else { - my @details = grep { my $rate_time = $_->rate_time; - $rate_time && $rate_time->contains($weektime) } - qsearch( 'rate_detail', - { 'ratenum' => $self->ratenum, - 'dest_regionnum' => $regionnum, } ); - if(!@details) { - # this may change at some point - return $self->dest_detail($regionnum); - } - elsif(@details == 1) { - return $details[0]; - } - else { - die "overlapping rate_detail times (region $regionnum, time $weektime)\n"; - } - } + + qsearchs( 'rate_detail', { 'ratenum' => $self->ratenum, + 'dest_regionnum' => $regionnum, } ); } =item rate_detail diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm index 7b90452..f6cdedf 100644 --- a/FS/FS/rate_detail.pm +++ b/FS/FS/rate_detail.pm @@ -5,7 +5,6 @@ use vars qw( @ISA $DEBUG $me ); use FS::Record qw( qsearch qsearchs dbh ); use FS::rate; use FS::rate_region; -use FS::rate_time; use Tie::IxHash; @ISA = qw(FS::Record); @@ -55,8 +54,6 @@ inherits from FS::Record. The following fields are currently supported: =item classnum - usage class (see L<FS::usage_class>) if any for this rate -=item ratetimenum - rating time period (see L<FS::rate_time) if any - =back =head1 METHODS @@ -197,30 +194,6 @@ sub dest_prefixes_short { $self->dest_region->prefixes_short; } -=item rate_time - -Returns the L<FS::rate_time> object associated with this call -plan rate, if there is one. - -=cut - -sub rate_time { - my $self = shift; - $self->ratetimenum ? FS::rate_time->by_key($self->ratetimenum) : (); -} - -=item rate_time_name - -Returns the I<ratetimename> field of the L<FS::rate_time> object -associated with this rate plan. - -=cut - -sub rate_time_name { - my $self = shift; - $self->ratetimenum ? $self->rate_time->ratetimename : '(default)'; -} - =item classname Returns the name of the usage class (see L<FS::usage_class>) associated with diff --git a/FS/FS/rate_time.pm b/FS/FS/rate_time.pm deleted file mode 100644 index 40cd23e..0000000 --- a/FS/FS/rate_time.pm +++ /dev/null @@ -1,168 +0,0 @@ -package FS::rate_time; - -use strict; -use base qw( FS::Record ); -use FS::Record qw( qsearch qsearchs ); -use FS::rate_time_interval; - -=head1 NAME - -FS::rate_time - Object methods for rate_time records - -=head1 SYNOPSIS - - use FS::rate_time; - - $record = new FS::rate_time \%hash; - $record = new FS::rate_time { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::rate_time object represents a time period for selection of CDR billing -rates. FS::rate_time inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item ratetimenum - -primary key - -=item ratetimename - -A label (like "Daytime" or "Weekend"). - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new example. To add the example 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 { 'rate_time'; } - -=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 - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('ratetimenum') - || $self->ut_text('ratetimename') - ; - return $error if $error; - - $self->SUPER::check; -} - -=item intervals - -Return the L<FS::rate_time_interval> objects included in this rating period. - -=cut - -sub intervals { - my $self = shift; - return qsearch({ table => 'rate_time_interval', - hashref => { ratetimenum => $self->ratetimenum }, - order_by => 'ORDER BY stime ASC', - }); -} - -=item contains TIME - -Return the L<FS::rate_time_interval> object that contains the specified -time-of-week (in seconds from the start of Sunday). The primary use of -this is to test whether that time falls within this rating period. - -=cut - -sub contains { - my $self = shift; - my $weektime = shift; - return qsearchs('rate_time_interval', { ratetimenum => $self->ratetimenum, - stime => { op => '<=', - value => $weektime }, - etime => { op => '>', - value => $weektime }, - } ); -} - -=item description - -Returns a list of arrayrefs containing the starting and -ending times of each interval in this period, in a readable -format. - -=cut - -sub description { - my $self = shift; - return map { [ $_->description ] } $self->intervals; -} - - -=back - -=head1 BUGS - -To be seen. - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/rate_time_interval.pm b/FS/FS/rate_time_interval.pm deleted file mode 100644 index 1a82edb..0000000 --- a/FS/FS/rate_time_interval.pm +++ /dev/null @@ -1,178 +0,0 @@ -package FS::rate_time_interval; - -use strict; -use base qw( FS::Record ); -use FS::Record qw( qsearch qsearchs ); -use List::Util 'first'; - -=head1 NAME - -FS::rate_time_interval - Object methods for rate_time_interval records - -=head1 SYNOPSIS - - use FS::rate_time_interval; - - $record = new FS::rate_time_interval \%hash; - $record = new FS::rate_time_interval { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::rate_time_interval object represents an interval of clock time during -the week, such as "Monday, 7 AM to 8 PM". FS::rate_time_interval inherits -from FS::Record. The following fields are currently supported: - -=over 4 - -=item intervalnum - -primary key - -=item stime - -Start of the interval, in seconds from midnight on Sunday. - -=item etime - -End of the interval. - -=item ratetimenum - -A foreign key to an L<FS::rate_time> object representing the set of intervals -to which this belongs. - - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new example. To add the example 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 { 'rate_time_interval'; } - -=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 interval. 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('intervalnum') - || $self->ut_number('stime') - || $self->ut_number('etime') - || $self->ut_number('ratetimenum') - ; - return $error if $error; - # Disallow backward intervals. As a special case, an etime of 0 - # should roll to the last second of the week. - $self->etime(7*24*60*60) if $self->etime == 0; - return "end of interval is before start" if ($self->etime < $self->stime); - - # Detect overlap between intervals within the same rate_time. - # Since intervals are added one at a time, we only need to look - # for an existing interval that contains one of the endpoints of - # this one or that is completely inside this one. - my $overlap = $self->rate_time->contains($self->stime + 1) || - $self->rate_time->contains($self->etime - 1) || - first { $self->stime <= $_->stime && $self->etime >= $_->etime } - ( $self->rate_time->intervals ); - return "interval overlap: (".join('-',$self->description).') with ('. - join('-',$overlap->description).')' if $overlap; - - $self->SUPER::check; -} - -=item rate_time - -Returns the L<FS::rate_time> comprising this interval. - -=cut - -sub rate_time { - my $self = shift; - FS::rate_time->by_key($self->ratetimenum); -} - -=item description - -Returns two strings containing stime and etime, formatted -"Day HH:MM AM/PM". Example: "Mon 5:00 AM". Seconds are -not displayed, so be careful. - -=cut - -my @days = qw(Sun Mon Tue Wed Thu Fri Sat); - -sub description { - my $self = shift; - return map { - sprintf('%s %02d:%02d %s', - $days[int($_/86400) % 7], - int($_/3600) % 12, - int($_/60) % 60, - (($_/3600) % 24 < 12) ? 'AM' : 'PM' ) - } ( $self->stime, $self->etime ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::rate_time>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_CGPRule_Mixin.pm b/FS/FS/svc_CGPRule_Mixin.pm index cf2eca7..4501580 100644 --- a/FS/FS/svc_CGPRule_Mixin.pm +++ b/FS/FS/svc_CGPRule_Mixin.pm @@ -22,7 +22,7 @@ This is a mixin class for svc_ classes that can have Communigate Pro rules =over 4 -=item cgp_rule +=item Returns the rules associated with this service, as FS::cgp_rule objects. diff --git a/FS/FS/svc_CGP_Mixin.pm b/FS/FS/svc_CGP_Mixin.pm deleted file mode 100644 index 489e979..0000000 --- a/FS/FS/svc_CGP_Mixin.pm +++ /dev/null @@ -1,142 +0,0 @@ -package FS::svc_CGP_Mixin; - -use strict; - -=head1 NAME - -FS::svc_CGP_Mixin - Mixin class for svc_classes which can be related to cgp_rule - -=head1 SYNOPSIS - -package FS::svc_table; -use base qw( FS::svc_CGP_Mixin FS::svc_Common ); - -=head1 DESCRIPTION - -This is a mixin class for svc_ classes that are exported to Communigate Pro. - -It currently contains timezone data for domains and accounts. - -=head1 METHODS - -=over 4 - -=item cgp_timezone - -Returns an arrayref of Communigate time zones. - -=cut - -#http://www.communigate.com/pub/client/TimeZones.data -#http://www.communigate.com/cgatepro/WebMail.html#Settings - -sub cgp_timezone_values { - #my $self = shift; #i'm used as a class and object method but just return data - - [ '', - 'HostOS', - '(+0100) Algeria/Congo', - '(+0200) Egypt/South Africa', - '(+0300) Saudi Arabia', - '(+0400) Oman', - '(+0500) Pakistan', - '(+0600) Bangladesh', - '(+0700) Thailand/Vietnam', - '(+0800) China/Malaysia', - '(+0900) Japan/Korea', - '(+1000) Queensland', - '(+1100) Micronesia', - '(+1200) Fiji', - '(+1300) Tonga/Kiribati', - '(+1400) Christmas Islands', - '(-0100) Azores/Cape Verde', - '(-0200) Fernando de Noronha', - '(-0300) Argentina/Uruguay', - '(-0400) Venezuela/Guyana', - '(-0500) Haiti/Peru', - '(-0600) Central America', - '(-0700) Arisona', #Arizona? - '(-0800) Adamstown', - '(-0900) Marquesas Islands', - '(-1000) Hawaii/Tahiti', - '(-1100) Samoa', - 'Asia/Afghanistan', - 'Asia/India', - 'Asia/Iran', - 'Asia/Iraq', - 'Asia/Israel', - 'Asia/Jordan', - 'Asia/Lebanon', - 'Asia/Syria', - 'Australia/Adelaide', - 'Australia/East', - 'Australia/NorthernTerritory', - 'Europe/Central', - 'Europe/Eastern', - 'Europe/Moscow', - 'Europe/Western', - 'GMT (+0000)', - 'Newfoundland', - 'NewZealand/Auckland', - 'NorthAmerica/Alaska', - 'NorthAmerica/Atlantic', - 'NorthAmerica/Central', - 'NorthAmerica/Eastern', - 'NorthAmerica/Mountain', - 'NorthAmerica/Pacific', - 'Russia/Ekaterinburg', - 'Russia/Irkutsk', - 'Russia/Kamchatka', - 'Russia/Krasnoyarsk', - 'Russia/Magadan', - 'Russia/Novosibirsk', - 'Russia/Vladivostok', - 'Russia/Yakutsk', - 'SouthAmerica/Brasil', - 'SouthAmerica/Chile', - 'SouthAmerica/Paraguay', - ]; -} - -=item cgp_emptytrash_values - -Returns an arrayref of possible EmptyTrash values. - -=cut - -#http://www.communigate.com/cgatepro/WebMail.html#Trash - -sub cgp_emptytrash_values { - #my $self = shift; #i'm used as a class and object method but just return data - - [ '', #<option value="-1">default(92 days) - '0 seconds', - '60 minutes', - '2 hours', - '3 hours', - '6 hours', - '12 hours', - '24 hours', - '2 days', - '3 days', - '7 days', - '10 days', - '2 weeks', - '3 weeks', - '30 days', - '60 days', - '90 days', - '180 days', - '360 days', - ]; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -=cut - -1; diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3b26688..9236067 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,8 +1,7 @@ package FS::svc_acct; use strict; -use base qw( FS::svc_Domain_Mixin FS::svc_CGP_Mixin FS::svc_CGPRule_Mixin - FS::svc_Common ); +use base qw( FS::svc_Domain_Mixin FS::svc_CGPRule_Mixin FS::svc_Common ); use vars qw( $DEBUG $me $conf $skip_fuzzyfiles $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax @@ -451,9 +450,8 @@ sub table_info { disable_select => 1, }, 'cgp_emptytrash' => { - label => 'Communigate on logout remove trash', - type => 'select', - select_list => __PACKAGE__->cgp_emptytrash_values, + label => 'Communigate on logout remove trash', + type => 'text', disable_inventory => 1, disable_select => 1, }, @@ -465,9 +463,71 @@ sub table_info { disable_select => 1, }, 'cgp_timezone' => { - label => 'Communigate time zone', - type => 'select', - select_list => __PACKAGE__->cgp_timezone_values, + label => 'Communigate time zone', + type => 'select', + select_list => [ '', + 'HostOS', + '(+0100) Algeria/Congo', + '(+0200) Egypt/South Africa', + '(+0300) Saudi Arabia', + '(+0400) Oman', + '(+0500) Pakistan', + '(+0600) Bangladesh', + '(+0700) Thailand/Vietnam', + '(+0800) China/Malaysia', + '(+0900) Japan/Korea', + '(+1000) Queensland', + '(+1100) Micronesia', + '(+1200) Fiji', + '(+1300) Tonga/Kiribati', + '(+1400) Christmas Islands', + '(-0100) Azores/Cape Verde', + '(-0200) Fernando de Noronha', + '(-0300) Argentina/Uruguay', + '(-0400) Venezuela/Guyana', + '(-0500) Haiti/Peru', + '(-0600) Central America', + '(-0700) Arisona', + '(-0800) Adamstown', + '(-0900) Marquesas Islands', + '(-1000) Hawaii/Tahiti', + '(-1100) Samoa', + 'Asia/Afghanistan', + 'Asia/India', + 'Asia/Iran', + 'Asia/Iraq', + 'Asia/Israel', + 'Asia/Jordan', + 'Asia/Lebanon', + 'Asia/Syria', + 'Australia/Adelaide', + 'Australia/East', + 'Australia/NorthernTerritory', + 'Europe/Central', + 'Europe/Eastern', + 'Europe/Moscow', + 'Europe/Western', + 'GMT (+0000)', + 'Newfoundland', + 'NewZealand/Auckland', + 'NorthAmerica/Alaska', + 'NorthAmerica/Atlantic', + 'NorthAmerica/Central', + 'NorthAmerica/Eastern', + 'NorthAmerica/Mountain', + 'NorthAmerica/Pacific', + 'Russia/Ekaterinburg', + 'Russia/Irkutsk', + 'Russia/Kamchatka', + 'Russia/Krasnoyarsk', + 'Russia/Magadan', + 'Russia/Novosibirsk', + 'Russia/Vladivostok', + 'Russia/Yakutsk', + 'SouthAmerica/Brasil', + 'SouthAmerica/Chile', + 'SouthAmerica/Paraguay', + ], disable_inventory => 1, disable_select => 1, }, @@ -721,89 +781,82 @@ sub insert { } #welcome email - my $error = ''; - my $msgnum = $conf->config('welcome_msgnum', $agentnum); - if ( $msgnum ) { - my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); - $error = $msg_template->send('cust_main' => $cust_main); + 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'; } - 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 ( $welcome_template && $cust_pkg ) { + 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 ( $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; - 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'}; - } + 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"; - } + 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 + } + + } + + } # if ( $cust_pkg ) $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -1175,10 +1228,6 @@ sub check { || $self->ut_snumbern('upbytes') || $self->ut_snumbern('downbytes') || $self->ut_snumbern('totalbytes') - || $self->ut_snumbern('seconds_threshold') - || $self->ut_snumbern('upbytes_threshold') - || $self->ut_snumbern('downbytes_threshold') - || $self->ut_snumbern('totalbytes_threshold') || $self->ut_enum('_password_encoding', ['',qw(plain crypt ldap)]) || $self->ut_enum('password_selfchange', [ '', 'Y' ]) || $self->ut_enum('password_recover', [ '', 'Y' ]) @@ -1192,7 +1241,7 @@ sub check { || $self->ut_enum('cgp_addmailtrailer', [ '', 'Y' ]) #preferences || $self->ut_alphasn('cgp_deletemode') - || $self->ut_enum('cgp_emptytrash', $self->cgp_emptytrash_values) + || $self->ut_alphan('cgp_emptytrash') || $self->ut_alphan('cgp_language') || $self->ut_textn('cgp_timezone') || $self->ut_textn('cgp_skinname') @@ -2234,7 +2283,7 @@ sub set_usage { my $reset = 0; my %handyhash = (); if ( $options{null} ) { - %handyhash = ( map { ( $_ => undef, $_."_threshold" => undef ) } + %handyhash = ( map { ( $_ => 'NULL', $_."_threshold" => 'NULL' ) } qw( seconds upbytes downbytes totalbytes ) ); } @@ -2256,7 +2305,7 @@ sub set_usage { #die $error if $error; #services not explicity changed via the UI my $sql = "UPDATE svc_acct SET " . - join (',', map { "$_ = ?" } (keys %handyhash) ). + join (',', map { "$_ = $handyhash{$_}" } (keys %handyhash) ). " WHERE svcnum = ". $self->svcnum; warn "$me $sql\n" @@ -2265,7 +2314,7 @@ sub set_usage { if (scalar(keys %handyhash)) { my $sth = $dbh->prepare( $sql ) or die "Error preparing $sql: ". $dbh->errstr; - my $rv = $sth->execute(values %handyhash); + my $rv = $sth->execute(); die "Error executing $sql: ". $sth->errstr unless defined($rv); die "Can't update usage for svcnum ". $self->svcnum diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 4d85060..8823c77 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -1,8 +1,7 @@ package FS::svc_domain; use strict; -use base qw( FS::svc_Parent_Mixin FS::svc_CGP_Mixin FS::svc_CGPRule_Mixin - FS::svc_Common ); +use base qw( FS::svc_Parent_Mixin FS::svc_CGPRule_Mixin FS::svc_Common ); use vars qw( $whois_hack $conf @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine $soarefresh $soaretry @@ -159,8 +158,7 @@ sub table_info { }, 'acct_def_cgp_emptytrash' => { label => 'Acct. default Communigate on logout remove trash', - type => 'select', - select_list => __PACKAGE__->cgp_emptytrash_values, + type => 'text', disable_inventory => 1, disable_select => 1, }, @@ -221,9 +219,71 @@ sub table_info { disable_select => 1, }, 'acct_def_cgp_timezone' => { - label => 'Acct. default time zone', - type => 'select', - select_list => __PACKAGE__->cgp_timezone_values, + label => 'Acct. default time zone', + type => 'select', + select_list => [ '', + 'HostOS', + '(+0100) Algeria/Congo', + '(+0200) Egypt/South Africa', + '(+0300) Saudi Arabia', + '(+0400) Oman', + '(+0500) Pakistan', + '(+0600) Bangladesh', + '(+0700) Thailand/Vietnam', + '(+0800) China/Malaysia', + '(+0900) Japan/Korea', + '(+1000) Queensland', + '(+1100) Micronesia', + '(+1200) Fiji', + '(+1300) Tonga/Kiribati', + '(+1400) Christmas Islands', + '(-0100) Azores/Cape Verde', + '(-0200) Fernando de Noronha', + '(-0300) Argentina/Uruguay', + '(-0400) Venezuela/Guyana', + '(-0500) Haiti/Peru', + '(-0600) Central America', + '(-0700) Arisona', + '(-0800) Adamstown', + '(-0900) Marquesas Islands', + '(-1000) Hawaii/Tahiti', + '(-1100) Samoa', + 'Asia/Afghanistan', + 'Asia/India', + 'Asia/Iran', + 'Asia/Iraq', + 'Asia/Israel', + 'Asia/Jordan', + 'Asia/Lebanon', + 'Asia/Syria', + 'Australia/Adelaide', + 'Australia/East', + 'Australia/NorthernTerritory', + 'Europe/Central', + 'Europe/Eastern', + 'Europe/Moscow', + 'Europe/Western', + 'GMT (+0000)', + 'Newfoundland', + 'NewZealand/Auckland', + 'NorthAmerica/Alaska', + 'NorthAmerica/Atlantic', + 'NorthAmerica/Central', + 'NorthAmerica/Eastern', + 'NorthAmerica/Mountain', + 'NorthAmerica/Pacific', + 'Russia/Ekaterinburg', + 'Russia/Irkutsk', + 'Russia/Kamchatka', + 'Russia/Krasnoyarsk', + 'Russia/Magadan', + 'Russia/Novosibirsk', + 'Russia/Vladivostok', + 'Russia/Yakutsk', + 'SouthAmerica/Brasil', + 'SouthAmerica/Chile', + 'SouthAmerica/Paraguay', + ], disable_inventory => 1, disable_select => 1, }, @@ -493,8 +553,7 @@ sub check { #XXX archive messages #preferences || $self->ut_alphasn('acct_def_cgp_deletemode') - || $self->ut_enum('acct_def_cgp_emptytrash', - $self->cgp_emptytrash_values ) + || $self->ut_alphan('acct_def_cgp_emptytrash') || $self->ut_alphan('acct_def_cgp_language') || $self->ut_textn('acct_def_cgp_timezone') || $self->ut_textn('acct_def_cgp_skinname') diff --git a/FS/FS/svc_pbx.pm b/FS/FS/svc_pbx.pm index d2760a5..6ae0418 100644 --- a/FS/FS/svc_pbx.pm +++ b/FS/FS/svc_pbx.pm @@ -3,7 +3,6 @@ package FS::svc_pbx; use strict; use base qw( FS::svc_External_Common ); use FS::Record qw( qsearch qsearchs dbh ); -use FS::Conf; use FS::cust_svc; use FS::svc_phone; use FS::svc_acct; @@ -56,10 +55,6 @@ PBX name Maximum number of extensions -=item max_simultaneous - -Maximum number of simultaneous users - =back =head1 METHODS @@ -90,7 +85,6 @@ sub table_info { 'id' => 'ID', 'title' => 'Name', 'max_extensions' => 'Maximum number of User Extensions', - 'max_simultaneous' => 'Maximum number of simultaneous users', # 'field' => 'Description', # 'another_field' => { # 'label' => 'Description', @@ -212,15 +206,15 @@ returns the error, otherwise returns false. =cut -#sub replace { -# my ( $new, $old ) = ( shift, shift ); -# my $error; -# -# $error = $new->SUPER::replace($old); -# return $error if $error; -# -# ''; -#} +sub replace { + my ( $new, $old ) = ( shift, shift ); + my $error; + + $error = $new->SUPER::replace($old); + return $error if $error; + + ''; +} =item suspend @@ -259,9 +253,6 @@ sub check { sub _check_duplicate { my $self = shift; - my $conf = new FS::Conf; - return '' if $conf->config('global_unique-pbx_title') eq 'disabled'; - $self->lock_table; if ( qsearchs( 'svc_pbx', { 'title' => $self->title } ) ) { @@ -271,75 +262,6 @@ sub _check_duplicate { } } -=item get_cdrs - -Returns a set of Call Detail Records (see L<FS::cdr>) associated with this -service. By default, "associated with" means that the "charged_party" field of -the CDR matches the "title" field of the service. - -=over 2 - -Accepts the following options: - -=item for_update => 1: SELECT the CDRs "FOR UPDATE". - -=item status => "" (or "done"): Return only CDRs with that processing status. - -=item inbound => 1: No-op for svc_pbx CDR processing. - -=item default_prefix => "XXX": Also accept the phone number of the service prepended -with the chosen prefix. - -=item disable_src => 1: No-op for svc_pbx CDR processing. - -=back - -=cut - -sub get_cdrs { - my($self, %options) = @_; - my %hash = (); - my @where = (); - - my @fields = ( 'charged_party' ); - $hash{'freesidestatus'} = $options{'status'} - if exists($options{'status'}); - - my $for_update = $options{'for_update'} ? 'FOR UPDATE' : ''; - - my $title = $self->title; - - my $prefix = $options{'default_prefix'}; - - my @orwhere = map " $_ = '$title' ", @fields; - push @orwhere, map " $_ = '$prefix$title' ", @fields - if length($prefix); - if ( $prefix =~ /^\+(\d+)$/ ) { - push @orwhere, map " $_ = '$1$title' ", @fields - } - - push @where, ' ( '. join(' OR ', @orwhere ). ' ) '; - - if ( $options{'begin'} ) { - push @where, 'startdate >= '. $options{'begin'}; - } - if ( $options{'end'} ) { - push @where, 'startdate < '. $options{'end'}; - } - - my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where ); - - my @cdrs = - qsearch( { - 'table' => 'cdr', - 'hashref' => \%hash, - 'extra_sql' => $extra_sql, - 'order_by' => "ORDER BY startdate $for_update", - } ); - - @cdrs; -} - =back =head1 BUGS diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index b518a37..87f2014 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -27,6 +27,8 @@ use FS::part_pkg_taxproduct; use FS::cust_main; use FS::Misc qw( csv_from_fixed ); +#i'd like to dump these +use FS::CGI qw(rooturl popurl); use URI::Escape; @ISA = qw( FS::Record ); @@ -1316,7 +1318,7 @@ sub _restore_remembered_tax_products { unless ( $part_pkg_taxproduct ) { return "failed to find part_pkg_taxproduct (". - $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n"; + $taxproduct->{pkgpart}->{$class}. ") for pkgpart $pkgpart\n"; } if ( $class eq '' ) { @@ -1765,21 +1767,17 @@ Launches a tax liability report. =cut sub queue_liability_report { - my $job = shift; - my $param = thaw(decode_base64(shift)); - - my $cgi = new CGI; - $cgi->param('beginning', $param->{beginning}); - $cgi->param('ending', $param->{ending}); + my $cgi = shift; my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi); - my $agentnum = $param->{agentnum}; - if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; }; - generate_liability_report( + my $agentnum = $cgi->param('agentnum'); + $agentnum =~ /^(\d+)$/ ? $agentnum = $1 : $agentnum = ''; + my $job = new FS::queue { job => 'FS::tax_rate::generate_liability_report' }; + $job->insert( 'beginning' => $beginning, 'ending' => $ending, 'agentnum' => $agentnum, - 'p' => $param->{RootURL}, - 'job' => $job, + 'p' => popurl(2), + 'rooturl' => rooturl, ); } @@ -1793,8 +1791,6 @@ agentnum, beginning, and ending sub generate_liability_report { my %args = @_; - my ( $count, $last, $min_sec ) = _progressbar_foo(); - #let us open the temp file early my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc; my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX', @@ -1849,25 +1845,14 @@ sub generate_liability_report { my $credit = 0; my %taxes = (); my %basetaxes = (); - my $calculated = 0; - my @tax_and_location = qsearch({ table => 'cust_bill_pkg', - select => $select, - hashref => { pkgpart => 0 }, - addl_from => $addl_from, - extra_sql => $where, - }); - $count = scalar(@tax_and_location); - foreach my $t ( @tax_and_location ) { - - if ( $args{job} ) { - if ( time - $min_sec > $last ) { - $args{job}->update_statustext( int( 100 * $calculated / $count ). - ",Calculated" - ); - $last = time; - } - } - + foreach my $t (qsearch({ table => 'cust_bill_pkg', + select => $select, + hashref => { pkgpart => 0 }, + addl_from => $addl_from, + extra_sql => $where, + }) + ) + { my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam; my $label = join('~', map { $t->$_ } @params); $label = 'Tax'. $label if $label =~ /^~/; @@ -1922,12 +1907,6 @@ sub generate_liability_report { #ordering - - if ( $args{job} ) { - $args{job}->update_statustext( "0,Sorted" ); - $last = time; - } - my @taxes = (); foreach my $tax ( sort { $a cmp $b } keys %taxes ) { @@ -1989,19 +1968,8 @@ EOF my $bgcolor2 = '#ffffff'; my $bgcolor = ''; - $count = scalar(@taxes); - $calculated = 0; foreach my $tax ( @taxes ) { - if ( $args{job} ) { - if ( time - $min_sec > $last ) { - $args{job}->update_statustext( int( 100 * $calculated / $count ). - ",Generated" - ); - $last = time; - } - } - if ( $bgcolor eq $bgcolor1 ) { $bgcolor = $bgcolor2; } else { @@ -2016,13 +1984,13 @@ EOF print $report <<EOF; <TR> <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD> - <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %> + <% $tax->{base} ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %> <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right"> <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A> </TD> <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %> <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD> - <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %> + <% $tax->{base} ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %> <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right"> <A HREF="<% '$baselink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A> </TD> @@ -2044,7 +2012,7 @@ EOF my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.'; $reportname =~ s/^$dropstring//; - my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname"; + my $reporturl = $args{rooturl}. "/misc/queued_report?report=$reportname"; die "<a href=$reporturl>view</a>\n"; } diff --git a/FS/FS/usage_class.pm b/FS/FS/usage_class.pm index 7b73c61..b64d26a 100644 --- a/FS/FS/usage_class.pm +++ b/FS/FS/usage_class.pm @@ -3,9 +3,6 @@ package FS::usage_class; use strict; use vars qw( @ISA ); use FS::Record qw( qsearch qsearchs ); -use FS::Conf; - -my $conf = new FS::Conf; @ISA = qw(FS::Record); @@ -125,28 +122,22 @@ my %summary_formats = ( sub { shift->{description} }, sub { shift->{calls} }, sub { sprintf( '%.1f', shift->{duration}/60 ) }, - sub { my($href, %opt) = @_; - ($opt{dollar} || ''). $href->{amount}; - }, + sub { shift->{amount} }, ], 'align' => [ qw( l r r r ) ], 'span' => [ qw( 4 1 1 1 ) ], # unitprices? 'width' => [ qw( 8.2cm 2.5cm 1.4cm 1.6cm ) ], # don't like this - 'show' => 1, }, 'simpler' => { 'label' => [ qw( Description Calls Amount ) ], 'fields' => [ sub { shift->{description} }, sub { shift->{calls} }, - sub { my($href, %opt) = @_; - ($opt{dollar} || ''). $href->{amount}; - }, + sub { shift->{amount} }, ], 'align' => [ qw( l r r ) ], 'span' => [ qw( 5 1 1 ) ], 'width' => [ qw( 10.7cm 1.4cm 1.6cm ) ], # don't like this - 'show' => 1, }, 'usage_simple' => { 'label' => [ qw( Date Time Number Destination Duration Amount ) ], @@ -156,56 +147,16 @@ my %summary_formats = ( sub { ' ' }, sub { ' ' }, sub { ' ' }, - sub { my $href = shift; #ugh! making bunk of 'normalization' - $href->{subtotal} ? $href->{subtotal} : ' ' - }, - ], - 'align' => [ qw( l l l l r r ) ], - 'span' => [ qw( 1 1 1 1 1 2 ) ], # unitprices? - 'width' => [ qw( 4.3cm 1.4cm 2.5cm 2.5cm 1.4cm 1.6cm ) ],# don't like this - 'show' => 0, - }, - 'usage_6col' => { - 'label' => [ qw( col1 col2 col3 col4 col5 col6 ) ], - 'fields' => [ - sub { ' ' }, - sub { ' ' }, - sub { ' ' }, - sub { ' ' }, sub { ' ' }, - sub { my $href = shift; #ugh! making bunk of 'normalization' - $href->{subtotal} ? $href->{subtotal} : ' ' - }, ], 'align' => [ qw( l l l l r r ) ], - 'span' => [ qw( 1 1 1 1 1 2 ) ], # unitprices? + 'span' => [ qw( 2 1 1 1 1 1 ) ], # unitprices? 'width' => [ qw( 4.3cm 1.4cm 2.5cm 2.5cm 1.4cm 1.6cm ) ],# don't like this - 'show' => 0, - }, - 'usage_7col' => { - 'label' => [ qw( col1 col2 col3 col4 col5 col6 col7 ) ], - 'fields' => [ - sub { ' ' }, - sub { ' ' }, - sub { ' ' }, - sub { ' ' }, - sub { ' ' }, - sub { ' ' }, - sub { my $href = shift; #ugh! making bunk of 'normalization' - $href->{subtotal} ? $href->{subtotal} : ' ' - }, - ], - 'align' => [ qw( l l l l l r r ) ], - 'span' => [ qw( 1 1 1 1 1 1 1 ) ], # unitprices? - 'width' => [ qw( 2.9cm 1.4cm 1.4cm 2.5cm 2.5cm 1.4cm 1.6cm ) ],# don't like this - 'show' => 0, }, ); sub summary_formats_labelhash { - map { $_ => join(',', @{$summary_formats{$_}{label}}) } - grep { $summary_formats{$_}{show} } - keys %summary_formats; + map { $_ => join(',', @{$summary_formats{$_}{label}}) } keys %summary_formats; } =item header_generator FORMAT @@ -222,16 +173,15 @@ my %html_align = ( ); sub _generator_defaults { - my ( $self, $format, %opt ) = @_; - my %format = ( %{ $summary_formats{$self->format} }, %opt ); - return ( \%format, ' ', ' ', ' ', sub { shift } ); + my ( $self, $format ) = ( shift, shift ); + return ( $summary_formats{$self->format}, ' ', ' ', ' ', sub { shift } ); } sub header_generator { - my ( $self, $format, %opt ) = @_; + my ( $self, $format ) = ( shift, shift ); my ( $f, $prefix, $suffix, $separator, $column ) = - $self->_generator_defaults($format, %opt); + $self->_generator_defaults($format); if ($format eq 'latex') { $prefix = "\\hline\n\\rule{0pt}{2.5ex}\n\\makebox[1.4cm]{}&\n"; @@ -255,7 +205,7 @@ sub header_generator { my @args = @_; my @result = (); - foreach (my $i = 0; exists($f->{label}->[$i]); $i++) { + foreach (my $i = 0; $f->{label}->[$i]; $i++) { push @result, &{$column}( map { $f->{$_}->[$i] } qw(label align span width) ); } @@ -273,12 +223,11 @@ usage_class. FORMAT is either html or latex =cut sub description_generator { - my ( $self, $format, %opt ) = @_; + my ( $self, $format ) = ( shift, shift ); my ( $f, $prefix, $suffix, $separator, $column ) = - $self->_generator_defaults($format, %opt); + $self->_generator_defaults($format); - my $money_char = '$'; if ($format eq 'latex') { $prefix = "\\hline\n\\multicolumn{1}{c}{\\rule{0pt}{2.5ex}~} &\n"; $suffix = '\\\\'; @@ -287,7 +236,6 @@ sub description_generator { sub { my ($d,$a,$s,$w) = @_; return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}"; }; - $money_char = '\\dollar'; }elsif ( $format eq 'html' ) { $prefix = '"><td align="center"></td>'; $suffix = ''; @@ -296,21 +244,16 @@ sub description_generator { sub { my ($d,$a,$s,$w) = @_; return qq!<td align="$html_align{$a}">$d</td>!; }; - $money_char = $conf->config('money_char') || '$'; } sub { - #my @args = @_; - my ($href) = shift; + my @args = @_; my @result = (); foreach (my $i = 0; $f->{label}->[$i]; $i++) { - my $dollar = ''; - $dollar = $money_char if $i == scalar(@{$f->{label}})-1; - push @result, - &{$column}( &{$f->{fields}->[$i]}($href, 'dollar' => $dollar), - map { $f->{$_}->[$i] } qw(align span width) - ); + push @result, &{$column}( &{$f->{fields}->[$i]}(@args), + map { $f->{$_}->[$i] } qw(align span width) + ); } $prefix. join( $separator, @result ). $suffix; @@ -326,13 +269,13 @@ usage_class. FORMAT is either html or latex =cut sub total_generator { - my ( $self, $format, %opt ) = @_; + my ( $self, $format ) = ( shift, shift ); # $OUT .= '\FStotaldesc{' . $section->{'description'} . ' Total}' . # '{' . $section->{'subtotal'} . '}' . "\n"; my ( $f, $prefix, $suffix, $separator, $column ) = - $self->_generator_defaults($format, %opt); + $self->_generator_defaults($format); my $style = ''; if ($format eq 'latex') { @@ -385,13 +328,13 @@ usage_class. FORMAT is either html or latex # total_item and amount vs total_amount -- another array of functions? sub total_line_generator { - my ( $self, $format, %opt ) = @_; + my ( $self, $format ) = ( shift, shift ); # $OUT .= '\FStotaldesc{' . $line->{'total_item'} . '}' . # '{' . $line->{'total_amount'} . '}' . "\n"; my ( $f, $prefix, $suffix, $separator, $column ) = - $self->_generator_defaults($format, %opt); + $self->_generator_defaults($format); my $style = ''; if ($format eq 'latex') { |