diff options
Diffstat (limited to 'FS')
55 files changed, 2547 insertions, 829 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 95e7aeab8..9274ad858 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -184,7 +184,6 @@ tie my %rights, 'Tie::IxHash', 'Resend invoices', #NEWNEW 'Void invoices', 'Unvoid invoices', - 'Delete invoices', 'View customer tax exemptions', #yow 'Edit customer tax exemptions', #NEWNEW 'Add customer tax adjustment', #new, but no need to phase in @@ -192,6 +191,7 @@ tie my %rights, 'Tie::IxHash', 'View customer pending payments', #NEW 'Edit customer pending payments', #NEW 'View customer billing events', #NEW + 'View legacy typeset statements', #new, but no need to phase in ], ### @@ -405,6 +405,8 @@ tie my %rights, 'Tie::IxHash', #{ rightname=>'Edit employees', global=>1, }, #{ rightname=>'Edit employee groupss', global=>1, }, + { rightname=>'Edit custom fields', 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 @@ -438,7 +440,6 @@ Most (but not all) right names. sub default_superuser_rights { my $class = shift; my %omit = map { $_=>1 } ( - 'Delete invoices', 'Delete payment', 'Delete credit', #? 'Delete refund', #? @@ -455,6 +456,7 @@ sub default_superuser_rights { 'Echeck void', 'Void invoices',#people are overusing this when credits are more appropriate 'Backdate credit', + 'View legacy typeset statments', ); no warnings 'uninitialized'; diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm index 50597e2cb..3c3bf4cb3 100644 --- a/FS/FS/ClientAPI/MasonComponent.pm +++ b/FS/FS/ClientAPI/MasonComponent.pm @@ -14,6 +14,7 @@ $DEBUG = 0; $me = '[FS::ClientAPI::MasonComponent]'; my %allowed_comps = map { $_=>1 } qw( + /elements/customer-statement.html /elements/select-did.html /misc/areacodes.cgi /misc/exchanges.cgi diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index cb6ac02d8..824ff67cb 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -23,7 +23,7 @@ use FS::Conf; #use FS::UID qw(dbh); use FS::Record qw(qsearch qsearchs dbh); use FS::Msgcat qw(gettext); -use FS::Misc qw(card_types); +use FS::Misc qw(card_types money_pretty); use FS::Misc::DateTime qw(parse_datetime); use FS::TicketSystem; use FS::ClientAPI_SessionCache; @@ -48,8 +48,11 @@ use FS::msg_template; use FS::contact; use FS::cust_contact; use FS::cust_location; +use FS::cust_payby; -use FS::ClientAPI::MyAccount::quotation; # just for code organization +# for code organization +use FS::ClientAPI::MyAccount::contact; +use FS::ClientAPI::MyAccount::quotation; $DEBUG = 0; $me = '[FS::ClientAPI::MyAccount]'; @@ -130,7 +133,7 @@ sub skin_info { ), 'menu_disable' => [ $conf->config('selfservice-menu_disable',$agentnum) ], ( map { $_ => $conf->exists("selfservice-$_", $agentnum ) } - qw( menu_skipblanks menu_skipheadings menu_nounderline no_logo ) + qw( menu_skipblanks menu_skipheadings menu_nounderline no_logo enable_payment_without_balance ) ), ( map { $_ => scalar($conf->config_binary("selfservice-$_", $agentnum)) } qw( title_left_image title_right_image @@ -242,6 +245,8 @@ sub login { return { error => 'Incorrect contact password.' } unless $contact->authenticate_password($p->{'password'}); + $session->{'contactnum'} = $contact->contactnum; + my @cust_contact = grep $_->selfservice_access, $contact->cust_contact; if ( scalar(@cust_contact) == 1 ) { $session->{'custnum'} = $cust_contact[0]->custnum; @@ -260,16 +265,39 @@ sub login { my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } ) or return { error => 'Domain '. $p->{'domain'}. ' not found' }; - my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{'username'}, - 'domsvc' => $svc_domain->svcnum, } - ); - return { error => 'User not found.' } unless $svc_acct; + my @svc_acct = qsearch( 'svc_acct', { 'username' => $p->{'username'}, + 'domsvc' => $svc_domain->svcnum, } + ); + + if ( $conf->exists('selfservice_server-login_svcpart') ) { + my @svcpart = $conf->config('selfservice_server-login_svcpart'); + @svc_acct = grep { my $svcpart = $_->cust_svc->svcpart; + scalar( grep( $_ eq $svcpart, @svcpart ) ); + } + @svc_acct; + } + + if ( $conf->exists('selfservice_server-primary_only') ) { + @svc_acct = + grep { + my $cust_svc = $_->cust_svc; + $cust_svc->cust_pkg->part_pkg->svcpart([qw( svc_acct svc_phone )]) + == $cust_svc->svcpart + } + @svc_acct; + } + + return { error => 'User not found.' } unless @svc_acct; + + return { error => 'Multiple users.' } if scalar(@svc_acct) > 1; + + my $svc_acct = $svc_acct[0]; - if($conf->exists('selfservice_server-login_svcpart')) { - my @svcpart = $conf->config('selfservice_server-login_svcpart'); - my $svcpart = $svc_acct->cust_svc->svcpart; - return { error => 'Invalid user.' } - unless grep($_ eq $svcpart, @svcpart); + if ( $conf->exists('selfservice_server-login_svcpart') ) { + my @svcpart = $conf->config('selfservice_server-login_svcpart'); + my $svcpart = $svc_acct->cust_svc->svcpart; + return { error => 'Invalid user.' } + unless grep($_ eq $svcpart, @svcpart); } return { error => 'Incorrect password.' } @@ -585,6 +613,7 @@ sub customer_info_short { $return{next_bill_date} ? time2str('%m/%d/%Y', $return{next_bill_date} ) : '(none)'; } + $return{balance_pretty} = money_pretty($return{balance}); $return{countrydefault} = scalar($conf->config('countrydefault')); @@ -668,78 +697,21 @@ sub billing_history { } $return{balance} = $cust_main->balance; + $return{balance_pretty} = money_pretty($return{balance}); $return{next_bill_date} = $cust_main->next_bill_date; $return{next_bill_date_pretty} = $return{next_bill_date} ? time2str('%m/%d/%Y', $return{next_bill_date} ) : '(none)'; - my @history = (); - my $conf = new FS::Conf; - if ( $conf->exists('selfservice-billing_history-line_items') ) { - - foreach my $cust_bill ( $cust_main->cust_bill ) { - - push @history, { - 'type' => 'Line item', - 'description' => $_->desc( $cust_main->locale ). - ( $_->sdate && $_->edate - ? ' '. time2str('%d-%b-%Y', $_->sdate). - ' To '. time2str('%d-%b-%Y', $_->edate) - : '' - ), - 'amount' => sprintf('%.2f', $_->setup + $_->recur ), - 'date' => $cust_bill->_date, - 'date_pretty' => time2str('%m/%d/%Y', $cust_bill->_date ), - } - foreach $cust_bill->cust_bill_pkg; - - } - - } else { + $return{'history'} = [ + $cust_main->payment_history( + 'line_items' => $conf->exists('selfservice-billing_history-line_items'), + 'reverse_sort' => 1, + ) + ]; - push @history, { - 'type' => 'Invoice', - 'description' => 'Invoice #'. $_->display_invnum, - 'amount' => sprintf('%.2f', $_->charged ), - 'date' => $_->_date, - 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), - } - foreach $cust_main->cust_bill; - - } - - push @history, { - 'type' => 'Payment', - 'description' => 'Payment', #XXX type - 'amount' => sprintf('%.2f', 0 - $_->paid ), - 'date' => $_->_date, - 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), - } - foreach $cust_main->cust_pay; - - push @history, { - 'type' => 'Credit', - 'description' => 'Credit', #more info? - 'amount' => sprintf('%.2f', 0 -$_->amount ), - 'date' => $_->_date, - 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), - } - foreach $cust_main->cust_credit; - - push @history, { - 'type' => 'Refund', - 'description' => 'Refund', #more info? type, like payment? - 'amount' => $_->refund, - 'date' => $_->_date, - 'date_pretty' => time2str('%m/%d/%Y', $_->_date ), - } - foreach $cust_main->cust_refund; - - @history = sort { $b->{'date'} <=> $a->{'date'} } @history; - - $return{'history'} = \@history; $return{'money_char'} = $conf->config("money_char") || '$', return \%return; @@ -799,16 +771,16 @@ sub edit_info { if ( $new->payinfo eq $cust_main->paymask ) { $new->payinfo($cust_main->payinfo); + $new->paycvv( $p->{'paycvv'} || $cust_main->paycvv ); } else { $new->payinfo($p->{'payinfo'}); + return { 'error' => 'CVV2 is required' } + if ! $p->{'paycvv'} && $conf->exists('selfservice-onfile_require_cvv'); + $new->paycvv( $p->{'paycvv'} ) } $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' ); - if ( $conf->exists('selfservice-onfile_require_cvv') ){ - return { 'error' => 'CVV2 is required' } unless $p->{'paycvv'}; - } - } elsif ( $payby =~ /^(CHEK|DCHK)$/ ) { my $payinfo; @@ -889,7 +861,7 @@ sub payment_info { 'require_cvv' => $conf->exists('selfservice-require_cvv'), 'onfile_require_cvv' => $conf->exists('selfservice-onfile_require_cvv'), - 'paytypes' => [ @FS::cust_main::paytypes ], + 'paytypes' => [ FS::cust_payby::paytypes ], 'paybys' => [ $conf->config('signup_server-payby') ], 'cust_paybys' => \@cust_paybys, @@ -3034,53 +3006,6 @@ sub myaccount_passwd { } -# sub contact_passwd { -# my $p = shift; -# my($context, $session, $custnum) = _custoragent_session_custnum($p); -# return { 'error' => $session } if $context eq 'error'; -# -# return { 'error' => 'Not logged in as a contact.' } -# unless $session->{'contactnum'}; -# -# return { 'error' => "New passwords don't match." } -# if $p->{'new_password'} ne $p->{'new_password2'}; -# -# return { 'error' => 'Enter new password' } -# unless length($p->{'new_password'}); -# -# #my $search = { 'custnum' => $custnum }; -# #$search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; -# $custnum =~ /^(\d+)$/ or die "illegal custnum"; -# my $search = " AND selfservice_access IS NOT NULL ". -# " AND selfservice_access = 'Y' ". -# " AND ( disabled IS NULL OR disabled = '' )". -# " AND custnum IS NOT NULL AND custnum = $1"; -# $search .= " AND agentnum = ". $session->{'agentnum'} if $context eq 'agent'; -# -# my $contact = qsearchs( { -# 'table' => 'contact', -# 'addl_from' => 'LEFT JOIN cust_main USING ( custnum ) ', -# 'hashref' => { 'contactnum' => $session->{'contactnum'}, }, -# 'extra_sql' => $search, #important -# } ) -# or return { 'error' => "Email not found" }; #? how did we get logged in? -# # deleted since then? -# -# my $error = ''; -# -# # use these svc_acct length restrictions?? -# my $conf = new FS::Conf; -# $error = 'Password too short.' -# if length($p->{'new_password'}) < ($conf->config('passwordmin') || 6); -# $error = 'Password too long.' -# if length($p->{'new_password'}) > ($conf->config('passwordmax') || 8); -# -# $error ||= $contact->change_password($p->{'new_password'}); -# -# return { 'error' => $error, }; -# -# } - sub reset_passwd { my $p = shift; diff --git a/FS/FS/ClientAPI/MyAccount/contact.pm b/FS/FS/ClientAPI/MyAccount/contact.pm new file mode 100644 index 000000000..ff29079c7 --- /dev/null +++ b/FS/FS/ClientAPI/MyAccount/contact.pm @@ -0,0 +1,172 @@ +package FS::ClientAPI::MyAccount::contact; + +use strict; +use FS::Record qw( qsearchs ); +use FS::cust_main; +use FS::cust_contact; +use FS::contact; + +sub _custoragent_session_custnum { + FS::ClientAPI::MyAccount::_custoragent_session_custnum(@_); +} + +sub contact_passwd { + my $p = shift; + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + return { 'error' => 'Not logged in as a contact.' } + unless $session->{'contactnum'}; + + return { 'error' => 'Enter new password' } + unless length($p->{'new_password'}); + + my $contact = _contact( $session->{'contactnum'}, $custnum ) + or return { 'error' => "Email not found" }; + + my $error = ''; + + # use these svc_acct length restrictions?? + my $conf = new FS::Conf; + $error = 'Password too short.' + if length($p->{'new_password'}) < ($conf->config('passwordmin') || 6); + $error = 'Password too long.' + if length($p->{'new_password'}) > ($conf->config('passwordmax') || 8); + + $error ||= $contact->change_password($p->{'new_password'}); + + return { 'error' => $error }; + +} + +sub _contact { + my( $contactnum, $custnum ) = @_; + + #my $search = { 'custnum' => $custnum }; + #$search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; + $custnum =~ /^(\d+)$/ or die "illegal custnum"; + my $search = " AND cust_contact.selfservice_access IS NOT NULL ". + " AND cust_contact.selfservice_access = 'Y' ". + " AND ( disabled IS NULL OR disabled = '' )". + " AND cust_contact.custnum IS NOT NULL AND cust_contact.custnum = $1"; +# $search .= " AND agentnum = ". $session->{'agentnum'} if $context eq 'agent'; + + qsearchs( { + 'table' => 'contact', + #'addl_from' => 'LEFT JOIN cust_main USING ( custnum ) ', + 'addl_from' => ' LEFT JOIN cust_contact USING ( contactnum ) '. + ' LEFT JOIN cust_main ON ( cust_contact.custnum = cust_main.custnum ) ', + 'hashref' => { 'contactnum' => $contactnum, }, + 'extra_sql' => $search, #important + } ); + +} + +sub list_contacts { + my $p = shift; + + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + my $cust_main = qsearchs('cust_main', { custnum=>$custnum } ); + + my @contacts = ( map { + my $contact = $_->contact; + my @contact_email = $contact->contact_email; + { 'contactnum' => $contact->contactnum, + 'class' => $_->contact_classname, + 'first' => $contact->first, + 'last' => $contact->get('last'), + 'title' => $contact->title, + 'emailaddress' => join(',', map $_->emailaddress, @contact_email), + #TODO: contact phone numbers + 'comment' => $_->comment, + 'selfservice_access' => $_->selfservice_access, + #'disabled' => $contact->disabled, + }; + } $cust_main->cust_contact ); + + return { 'error' => '', + 'contacts' => \@contacts, + }; +} + +sub edit_contact { + my $p = shift; + + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + #shortcut: logged in as a contact? that must be the one you want to edit + my $contactnum = $p->{contactnum} || $session->{'contactnum'}; + + my $contact = _contact( $contactnum, $custnum ) + or return { 'error' => "Email not found" }; + + return { error => "Can't edit a multi-customer contact unless logged in as that contact" } + if $contactnum != $session->{'contactnum'} + && scalar( $contact->cust_contact ) > 1; + + #my $cust_contact = qsearchs('cust_contact', { contactnum => $contactnum, + # custnum => $custnum, } ) + # or die "guru meditation #4200"; + + #TODO: change more fields besides just these + + foreach (qw( first last title emailaddress )) { + $contact->$_( $p->{$_} ) if length( $p->{$_} ); + } + + my $error = $contact->replace; + + return { 'error' => $error, }; + +} + +sub delete_contact { + my $p = shift; + + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + return { 'error' => 'Cannot delete the currently-logged in contact.' } + if $p->{contactnum} == $session->{contactnum}; + + my $cust_contact = qsearchs('cust_contact', { contactnum => $p->{contactnum}, + custnum => $custnum, }) + or return { 'error' => 'Unknown contactnum' }; + + my $contact = $cust_contact->contact; + + my $error = $cust_contact->delete; + return { 'error' => $error } if $error; + + unless ( $contact->cust_contact || $contact->prospect_contact ) { + $contact->delete; + } + + return { 'error' => '', }; +} + +sub new_contact { + my $p = shift; + + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + #TODO: add phone numbers too + #TODO: specify a classnum by name and/or list_contact_classes method + + my $contact = new FS::contact { + 'custnum' => $custnum, + map { $_ => $p->{$_} } + qw( first last emailaddress classnum comment selfservice_access ) + }; + + $contact->change_password_fields($p->{_password}) if length($p->{_password}); + + my $error = $contact->insert; + return { 'error' => $error, }; +} + +1; diff --git a/FS/FS/ClientAPI/MyAccount/quotation.pm b/FS/FS/ClientAPI/MyAccount/quotation.pm index df2b37ed6..667f37d78 100644 --- a/FS/FS/ClientAPI/MyAccount/quotation.pm +++ b/FS/FS/ClientAPI/MyAccount/quotation.pm @@ -5,7 +5,7 @@ use FS::Record qw(qsearch qsearchs); use FS::quotation; use FS::quotation_pkg; -our $DEBUG = 1; +our $DEBUG = 0; sub _custoragent_session_custnum { FS::ClientAPI::MyAccount::_custoragent_session_custnum(@_); diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 8272b2085..c0a9d98ce 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -539,6 +539,8 @@ sub new_customer { paystart_month paystart_year payissue payip + locale + referral_custnum comments ) ), @@ -946,6 +948,8 @@ sub new_customer_minimal { payinfo paycvv paydate payname paystate paytype paystart_month paystart_year payissue payip + + locale ), } ); diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm index 04aee290b..435ee9835 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -106,6 +106,13 @@ sub ss2clientapi { 'switch_cust' => 'MyAccount/switch_cust', 'customer_info' => 'MyAccount/customer_info', 'customer_info_short' => 'MyAccount/customer_info_short', + + 'contact_passwd' => 'MyAccount/contact/contact_passwd', + 'list_contacts' => 'MyAccount/contact/list_contacts', + 'edit_contact' => 'MyAccount/contact/edit_contact', + 'delete_contact' => 'MyAccount/contact/delete_contact', + 'new_contact' => 'MyAccount/contact/new_contact', + 'billing_history' => 'MyAccount/billing_history', 'edit_info' => 'MyAccount/edit_info', #add to ss cgi! 'invoice' => 'MyAccount/invoice', diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 9255284a3..c93608266 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -605,10 +605,12 @@ invoice_latexfooter invoice_latexsmallfooter invoice_latexnotes invoice_latexcoupon +invoice_latexwatermark invoice_html invoice_htmlreturnaddress invoice_htmlfooter invoice_htmlnotes +invoice_htmlwatermark logo.png logo.eps ); @@ -703,6 +705,11 @@ sub reason_type_options { } } +my $validate_email = sub { $_[0] =~ + /^[^@]+\@[[:alnum:]-]+(\.[[:alnum:]-]+)+$/ + ? '' : 'Invalid email address'; + }; + #Billing (81 items) #Invoicing (50 items) #UI (69 items) @@ -713,13 +720,6 @@ sub reason_type_options { @config_items = map { new FS::ConfItem $_ } ( { - 'key' => 'address', - 'section' => 'deprecated', - 'description' => 'This configuration option is no longer used. See <a href="#invoice_template">invoice_template</a> instead.', - 'type' => 'text', - }, - - { 'key' => 'event_log_level', 'section' => 'notification', 'description' => 'Store events in the internal log if they are at least this severe. "info" is the default, "debug" is very detailed and noisy.', @@ -1039,13 +1039,6 @@ sub reason_type_options { }, { - 'key' => 'deleteinvoices', - 'section' => 'UI', - 'description' => 'Enable invoices deletions. Be very careful! Deleting an invoice will remove all traces that the invoice ever existed! Normally, you would void or apply a credit against the invoice instead.', - 'type' => 'checkbox', - }, - - { 'key' => 'deletecredits', #not actually deprecated yet #'section' => 'deprecated', @@ -1063,20 +1056,6 @@ sub reason_type_options { }, { - 'key' => 'unapplypayments', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable "unapplication" of unclosed payments.', - 'type' => 'checkbox', - }, - - { - 'key' => 'unapplycredits', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable "unapplication" of unclosed credits.', - 'type' => 'checkbox', - }, - - { 'key' => 'dirhash', 'section' => 'shell', 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples: <ul><li>1: user -> <a href="#home">/home</a>/u/user<li>2: user -> <a href="#home">/home</a>/u/s/user<li>-1: user -> <a href="#home">/home</a>/r/user<li>-2: user -> <a href="#home">home</a>/r/e/user</ul>', @@ -1194,10 +1173,7 @@ sub reason_type_options { 'description' => 'Return address on email invoices (address only, see invoice_from_name)', 'type' => 'text', 'per_agent' => 1, - 'validate' => sub { $_[0] =~ - /^[^@]+\@[[:alnum:]-]+(\.[[:alnum:]-]+)+$/ - ? '' : 'Invalid email address'; - } + 'validate' => $validate_email, }, { @@ -1304,6 +1280,15 @@ sub reason_type_options { }, { + 'key' => 'invoice_htmlwatermark', + 'section' => 'invoicing', + 'description' => 'Watermark for HTML invoices. Appears in a semitransparent positioned DIV overlaid on the main invoice container.', + 'type' => 'textarea', + 'per_agent' => 1, + 'per_locale' => 1, + }, + + { 'key' => 'invoice_latex', 'section' => 'invoicing', 'description' => 'Optional LaTeX template for typeset PostScript invoices. See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:2.1:Documentation:Administration#Typeset_.28LaTeX.29_invoice_templates">billing documentation</a> for details.', @@ -1491,6 +1476,15 @@ and customer address. Include units.', }, { + 'key' => 'invoice_latexwatermark', + 'section' => 'invoicing', + 'description' => 'Watermark for LaTeX invoices. See "texdoc background" for information on what this can contain. The content itself should be enclosed in braces, optionally followed by a comma and any formatting options.', + 'type' => 'textarea', + 'per_agent' => 1, + 'per_locale' => 1, + }, + + { 'key' => 'invoice_email_pdf', 'section' => 'invoicing', 'description' => 'Send PDF invoice as an attachment to emailed invoices. By default, includes the HTML invoice as the email body, unless invoice_email_pdf_note is set.', @@ -1648,13 +1642,6 @@ and customer address. Include units.', }, { - 'key' => 'invoice_send_receipts', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, this used to send an invoice copy on payments and credits. See the payment_receipt_email and XXXX instead.', - 'type' => 'checkbox', - }, - - { 'key' => 'payment_receipt', 'section' => 'notification', 'description' => 'Send payment receipts.', @@ -1852,13 +1839,6 @@ and customer address. Include units.', # }, { - 'key' => 'report_template', - 'section' => 'deprecated', - 'description' => 'Deprecated template file for reports.', - 'type' => 'textarea', - }, - - { 'key' => 'maxsearchrecordsperpage', 'section' => 'UI', 'description' => 'If set, number of search records to return per page.', @@ -2665,13 +2645,6 @@ and customer address. Include units.', }, { - 'key' => 'paymentforcedtobatch', - 'section' => 'deprecated', - 'description' => 'See batch-enable_payby and realtime-disable_payby. Used to (for CHEK): Cause per customer payment entry to be forced to a batch processor rather than performed realtime.', - 'type' => 'checkbox', - }, - - { 'key' => 'svc_acct-notes', 'section' => 'deprecated', 'description' => 'Extra HTML to be displayed on the Account View screen.', @@ -2738,10 +2711,11 @@ and customer address. Include units.', }, { - 'key' => 'users-allow_comp', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, enable the <i>Complimentary customer</i> access right instead. Was: Usernames (Freeside users, created with <a href="../docs/man/bin/freeside-adduser.html">freeside-adduser</a>) which can create complimentary customers, one per line. If no usernames are entered, all users can create complimentary accounts.', - 'type' => 'textarea', + 'key' => 'dump-email_to', + 'section' => '', + 'description' => "Optional email address to send success/failure message for database dumps.", + 'type' => 'text', + 'validate' => $validate_email, }, { @@ -3353,35 +3327,6 @@ and customer address. Include units.', }, { - 'key' => 'city_not_required', - 'section' => 'required', - 'description' => 'Turn off requirement for a City to be entered for billing & shipping addresses', - 'type' => 'checkbox', - 'per_agent' => 1, - }, - - { - 'key' => 'echeck-void', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of echeck payments in addition to refunds against the payment gateway', - 'type' => 'checkbox', - }, - - { - 'key' => 'cc-void', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of credit card payments in addition to refunds against the payment gateway', - 'type' => 'checkbox', - }, - - { - 'key' => 'unvoid', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable unvoiding of voided payments', - 'type' => 'checkbox', - }, - - { 'key' => 'address1-search', 'section' => 'UI', 'description' => 'Enable the ability to search the address1 field from the quick customer search. Not recommended in most cases as it tends to bring up too many search results - use explicit address searching from the advanced customer search instead.', @@ -3410,12 +3355,6 @@ and customer address. Include units.', 'per_agent' => 1, }, - { 'key' => 'referral_credit', - 'section' => 'deprecated', - 'description' => "Used to enable one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency). Replace with a billing event on appropriate packages.", - 'type' => 'checkbox', - }, - { 'key' => 'selfservice_server-cache_module', 'section' => 'self-service', 'description' => 'Module used to store self-service session information. All modules handle any number of self-service servers. Cache::SharedMemoryCache is appropriate for a single database / single Freeside server. Cache::FileCache is useful for multiple databases on a single server, or when IPC::ShareLite is not available (i.e. FreeBSD).', # _Database stores session information in the database and is appropriate for multiple Freeside servers, but may be slower.', @@ -3917,6 +3856,13 @@ and customer address. Include units.', }, { + 'key' => 'batchconfig-RBC-login', + 'section' => 'billing', + 'description' => 'FTPS login for uploading Royal Bank of Canada batches. Two lines: 1. username, 2. password. If not supplied, batches can still be created but not automatically uploaded.', + 'type' => 'textarea', + }, + + { 'key' => 'batchconfig-td_eft1464', 'section' => 'billing', 'description' => 'Configuration for TD Bank EFT1464 batching, seven lines: 1. Originator ID, 2. Datacenter Code, 3. Short name, 4. Long name, 5. Returned payment branch number, 6. Returned payment account, 7. Transaction code.', @@ -3953,6 +3899,13 @@ and customer address. Include units.', }, { + 'key' => 'batchconfig-nacha-origin_name', + 'section' => 'billing', + 'description' => 'Configuration for NACHA batching, Origin name (defaults to company name, but sometimes bank name is needed instead.)', + 'type' => 'text', + }, + + { 'key' => 'batch-manual_approval', 'section' => 'billing', 'description' => 'Allow manual batch closure, which will approve all payments that do not yet have a status. This is not advised unless needed for specific payment processors that provide a report of rejected rather than approved payments.', @@ -4495,6 +4448,13 @@ and customer address. Include units.', }, { + 'key' => 'cust_main-no_city_in_address', + 'section' => 'UI', + 'description' => 'Turn off City for billing & shipping addresses', + 'type' => 'checkbox', + }, + + { 'key' => 'census_year', 'section' => 'UI', 'description' => 'The year to use in census tract lookups. NOTE: you need to select 2012 or 2013 for Year 2010 Census tract codes. A selection of 2011 provides Year 2000 Census tract codes. Use the freeside-censustract-update tool if exisitng customers need to be changed.', @@ -5796,6 +5756,13 @@ and customer address. Include units.', }, { + 'key' => 'selfservice-enable_payment_without_balance', + 'section' => 'self-service', + 'description' => 'Allow selfservice customers to make payments even if balance is zero or below (resulting in an unapplied payment and negative balance.)', + 'type' => 'checkbox', + }, + + { 'key' => 'logout-timeout', 'section' => 'UI', 'description' => 'If set, automatically log users out of the backoffice after this many minutes.', @@ -5955,48 +5922,6 @@ and customer address. Include units.', 'type' => 'text', }, - { 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" }, - { key => "bindprimary", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "bindsecondaries", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "bsdshellmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "cyrus", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "cp_app", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "erpcdmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "icradiusmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "icradius_mysqldest", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "icradius_mysqlsource", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "icradius_secrets", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "maildisablecatchall", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "mxmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "nsmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "arecords", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "cnamerecords", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "nismachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "qmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "radiusmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "sendmailconfigpath", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "sendmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "sendmailrestart", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "shellmachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "shellmachine-useradd", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "shellmachine-userdel", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "shellmachine-usermod", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "shellmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "radiusprepend", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "textradiusprepend", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "username_policy", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "vpopmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "vpopmailrestart", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "safe-part_pkg", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "selfservice_server-quiet", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "signup_server-quiet", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "signup_server-email", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "vonage-username", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "vonage-password", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - { key => "vonage-fromnumber", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, - ); 1; diff --git a/FS/FS/ConfDefaults.pm b/FS/FS/ConfDefaults.pm index de08f7d68..b24a300f9 100644 --- a/FS/FS/ConfDefaults.pm +++ b/FS/FS/ConfDefaults.pm @@ -71,6 +71,9 @@ sub cust_fields_avail { ( 'Cust# | Cust. Status | Name | Company | (bill) Address 1 | (bill) Address 2 | (bill) City | (bill) State | (bill) Zip | (bill) Country | Day phone | Night phone | Mobile phone | Fax number | (service) Address 1 | (service) Address 2 | (service) City | (service) State | (service) Zip | (service) Country | Invoicing email(s) | Payment Type | Current Balance' => 'custnum | Status | Last, First | Company | (address) | (all phones) | (service address) | Invoicing email(s) | Payment Type | Current Balance', + 'Cust# | Agent Cust# | Cust. Status | Name | Company | (bill) Address 1 | (bill) Address 2 | (bill) City | (bill) State | (bill) Zip | (bill) Country | Day phone | Night phone | Mobile phone | Fax number | (service) Address 1 | (service) Address 2 | (service) City | (service) State | (service) Zip | (service) Country | Invoicing email(s) | Payment Type | Current Balance' => + 'custnum | Agent Cust# | Status | Last, First | Company | (address) | (all phones) | (service address) | Invoicing email(s) | Payment Type | Current Balance', + 'Cust# | Cust. Status | Name | Company | (bill) Address 1 | (bill) Address 2 | (bill) City | (bill) State | (bill) Zip | (bill) Country | (bill) Latitude | (bill) Longitude | Day phone | Night phone | Mobile phone | Fax number | (service) Address 1 | (service) Address 2 | (service) City | (service) State | (service) Zip | (service) Country | (service) Latitude | (service) Longitude | Invoicing email(s) | Payment Type | Current Balance' => 'custnum | Status | Last, First | Company | (address+coord) | (all phones) | (service address+coord) | Invoicing email(s) | Payment Type | Current Balance', diff --git a/FS/FS/Cron/backup.pm b/FS/FS/Cron/backup.pm index 5feca2636..cfc8e3624 100644 --- a/FS/FS/Cron/backup.pm +++ b/FS/FS/Cron/backup.pm @@ -6,6 +6,7 @@ use Exporter; use File::Copy; use Date::Format; use FS::UID qw(driver_name datasrc); +use FS::Misc qw( send_email ); @ISA = qw( Exporter ); @EXPORT_OK = qw( backup ); @@ -18,7 +19,8 @@ sub backup { my $filename = time2str('%Y%m%d%H%M%S',time); - datasrc =~ /dbname=([\w\.]+)$/ or die "unparsable datasrc ". datasrc; + datasrc =~ /dbname=([\w\.]+)$/ + or backup_email_and_die($conf,$filename,"unparsable datasrc ". datasrc); my $database = $1; my $ext; @@ -29,36 +31,71 @@ sub backup { system("mysqldump $database >/var/tmp/$database.sql"); $ext = 'sql'; } else { - die "database dumps not yet supported for ". driver_name; + backup_email_and_die($conf,$filename,"database dumps not yet supported for ". driver_name); } chmod 0600, "/var/tmp/$database.$ext"; if ( $conf->config('dump-pgpid') ) { eval 'use GnuPG;'; - die $@ if $@; + backup_email_and_die($conf,$filename,$@) if $@; my $gpg = new GnuPG; $gpg->encrypt( plaintext => "/var/tmp/$database.$ext", output => "/var/tmp/$database.gpg", recipient => $conf->config('dump-pgpid'), ); - unlink "/var/tmp/$database.$ext" or die $!; + unlink "/var/tmp/$database.$ext" + or backup_email_and_die($conf,$filename,$!); chmod 0600, "/var/tmp/$database.gpg"; $ext = 'gpg'; } if ( $localdest ) { - copy("/var/tmp/$database.$ext", "$localdest/$filename.$ext") or die $!; + copy("/var/tmp/$database.$ext", "$localdest/$filename.$ext") + or backup_email_and_die($conf,$filename,$!); chmod 0600, "$localdest/$filename.$ext"; } if ( $scpdest ) { eval "use Net::SCP qw(scp);"; - die $@ if $@; + backup_email_and_die($conf,$filename,$@) if $@; scp("/var/tmp/$database.$ext", "$scpdest/$filename.$ext"); } - unlink "/var/tmp/$database.$ext" or die $!; + unlink "/var/tmp/$database.$ext" or backup_email_and_die($conf,$filename,$!); #or just warn? + backup_email($conf,$filename); + +} + +#runs backup_email and dies with same error message +sub backup_email_and_die { + my ($conf,$filename,$error) = @_; + backup_email($conf,$filename,$error); + warn "backup_email_and_die called without error message" unless $error; + die $error; +} + +#checks if email should be sent, sends it +sub backup_email { + my ($conf,$filename,$error) = @_; + my $to = $conf->config('dump-email_to'); + return unless $to; + my $result = $error ? 'FAILED' : 'succeeded'; + my $email_error = send_email( + 'from' => $conf->config('invoice_from'), #or whatever, don't think it matters + 'to' => $to, + 'subject' => 'FREESIDE NOTIFICATION: Backup ' . $result, + 'body' => [ + "This is an automatic message from your Freeside installation.\n", + "Freeside backup $filename $result", + ($error ? " with the following error:\n\n" : "\n"), + ($error || ''), + "\n", + ], + 'msgtype' => 'admin', + ); + warn $email_error if $email_error; + return; } 1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 78779d78a..3d577f6d2 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -57,7 +57,7 @@ if ( -e $addl_handler_use_file ) { use CGI::Cookie; use List::Util qw( max min sum ); use List::MoreUtils qw( first_index uniq ); - use Scalar::Util qw( blessed ); + use Scalar::Util qw( blessed looks_like_number ); use Data::Dumper; use Date::Format; use Time::Local; @@ -156,6 +156,8 @@ if ( -e $addl_handler_use_file ) { use FS::Locales; use FS::Maketext qw( mt emt js_mt ); + use FS::Query; + use FS::agent; use FS::agent_type; use FS::domain_record; @@ -402,6 +404,7 @@ if ( -e $addl_handler_use_file ) { use FS::quotation_pkg_tax; use FS::cust_pkg_reason_fee; use FS::part_svc_link; + use FS::access_user_log; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { @@ -430,21 +433,13 @@ if ( -e $addl_handler_use_file ) { use RT::CustomFieldValues; use RT::ObjectCustomFieldValues; - #blah. manually updated from RT::Interface::Web::Handler - use RT::Interface::Web; - use MIME::Entity; - use Text::Wrapper; - use Time::ParseDate; - use Time::HiRes; - use HTML::Scrubber; + use RT::Interface::Web::Handler; #blah. not even in RT::Interface::Web::Handler, just in #html/NoAuth/css/dhandler and rt-test-dependencies. ask for it here #to throw a real error instead of just a mysterious unstyled RT use CSS::Squish 0.06; - use RT::Interface::Web::Request; - #another undeclared web UI dep (for ticket links graph) use IPC::Run::SafeHandles; @@ -460,6 +455,7 @@ if ( -e $addl_handler_use_file ) { die $@ if $@; } + no warnings 'redefine'; *CGI::redirect = sub { my $self = shift; my $cookie = ''; @@ -513,7 +509,7 @@ if ( -e $addl_handler_use_file ) { sub include { use vars qw($m); - #carp #should just switch to <& &> syntax + #warn 'include deprecated; use an HTML::Mason <& &> style include (or $m->scomp) at '. $m->callers(0)->path. "\n"; $m->scomp(@_); } @@ -650,7 +646,8 @@ sub mason_interps { [ 'rt' => '%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ], [ 'freeside' => '%%%FREESIDE_DOCUMENT_ROOT%%%' ], ], - escape_flags => { 'h' => \&RT::Interface::Web::EscapeUTF8, + escape_flags => { 'h' => \&RT::Interface::Web::EscapeHTML, + #u and j aren't used anymore? :/ 'u' => \&RT::Interface::Web::EscapeURI, 'j' => \&RT::Interface::Web::EscapeJS, 'js_string' => $js_string_sub, diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm index 5d6fc4cd4..2cf1ed9e0 100644 --- a/FS/FS/Mason/Request.pm +++ b/FS/FS/Mason/Request.pm @@ -5,6 +5,7 @@ use warnings; use vars qw( $FSURL $QUERY_STRING ); use base 'HTML::Mason::Request'; use FS::Trace; +use FS::access_user_log; $FSURL = 'http://Set/FS_Mason_Request_FSURL/in_standalone_mode/'; $QUERY_STRING = ''; @@ -110,6 +111,10 @@ sub freeside_setup { FS::Trace->log(' UTF-8-decoding form data'); # foreach my $param ( $cgi->param ) { + + #we can't switch to multi_param until we're done supporting deb 7 + local($CGI::LIST_CONTEXT_WARN) = 0; + my @values = $cgi->param($param); next if $cgi->uploadInfo($values[0]); #warn $param; @@ -119,6 +124,8 @@ sub freeside_setup { } + FS::access_user_log->insert_new_path( $filename ); + FS::Trace->log(' done'); } diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 9aeff93a6..e1f654c34 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -23,6 +23,7 @@ use Encode; csv_from_fixed ocr_image bytes_substr + money_pretty ); $DEBUG = 0; @@ -828,7 +829,7 @@ sub _pslatex { } return if -e "$file.dvi" && -s "$file.dvi"; - die "pslatex $file.tex failed; see $file.log for details?\n"; + die "pslatex $file.tex failed, see $file.log for details?\n"; } @@ -982,6 +983,22 @@ sub bytes_substr { return Encode::decode('utf8', $bytes, $chk); } +=item money_pretty + +Accepts a postive or negative numerical value. +Returns amount formatted for display, +including money character. + +=cut + +sub money_pretty { + my $amount = shift; + my $money_char = $conf->{'money_char'} || '$'; + $amount = sprintf("%0.2f",$amount); + $amount =~ s/^(-?)/$1$money_char/; + return $amount; +} + =back =head1 BUGS diff --git a/FS/FS/Query.pm b/FS/FS/Query.pm new file mode 100644 index 000000000..8ecf1c49c --- /dev/null +++ b/FS/FS/Query.pm @@ -0,0 +1,118 @@ +package FS::Query; + +use strict; +use FS::Record; # don't import qsearch +use Storable 'dclone'; + +=head1 NAME + +FS::Query - A thin wrapper around qsearch argument hashes. + +=head1 DESCRIPTION + +This module exists because we pass qsearch argument lists around a lot, +and add new joins or WHERE expressions in several stages, and I got tired +of doing this: + + my $andwhere = "mycolumn IN('perl','python','javascript')"; + if ( ($search->{hashref} and keys( %{$search->{hashref}} )) + or $search->{extra_sql} =~ /^\s*WHERE/ ) { + $search->{extra_sql} .= " AND $andwhere"; + } else { + $search->{extra_sql} = " WHERE $andwhere "; + } + +and then having it fail under some conditions if it's done wrong (as the above +example is, obviously). + +We may eventually switch over to SQL::Abstract or something for this, but for +now it's a couple of crude manipulations and a wrapper to qsearch. + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Turns HASHREF (a qsearch argument list) into an FS::Query object. None of +the params are really required, but you should at least supply C<table>. + +In the Future this may do a lot more stuff. + +=cut + +sub new { + my ($class, $hashref) = @_; + + my $self = bless { + table => '', + select => '*', + hashref => {}, + addl_from => '', + extra_sql => '', + order_by => '', + %$hashref, + }; + # load FS::$table? validate anything? + $self; +} + +=item clone + +Returns another object that's a copy of this one. + +=cut + +sub clone { + my $self = shift; + $self->new( dclone($self) ); +} + +=item and_where EXPR + +Adds a constraint to the WHERE clause of the query. All other constraints in +the WHERE clause should be joined with AND already; if not, they should be +grouped with parentheses. + +=cut + +sub and_where { + my $self = shift; + my $where = shift; + + if ($self->{extra_sql} =~ /^\s*(?:WHERE|AND)\s+(.*)/is) { + $where = "($where) AND $1"; + } + if (keys %{ $self->{hashref} }) { + $where = " AND $where"; + } else { + $where = " WHERE $where"; + } + $self->{extra_sql} = $where; + + return $self; +} + +=item qsearch + +Runs the query and returns all results. + +=cut + +sub qsearch { + my $self = shift; + FS::Record::qsearch({ %$self }); +} + +=item qsearchs + +Runs the query and returns only one result. + +=cut + +sub qsearchs { + my $self = shift; + FS::Record::qsearchs({ %$self }); +} + +1; diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 479747307..63e5318c3 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -229,7 +229,8 @@ sub receipts { #net payments my $sql = 'SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay'; if ( $opt{'setuprecur'} ) { $sql = 'SELECT SUM('. - FS::cust_bill_pkg->paid_sql($speriod, $eperiod, %opt). + #in practice, but not appearance, paid_sql accepts end before start + FS::cust_bill_pkg->paid_sql($eperiod, $speriod, %opt). ') FROM cust_bill_pkg'; } @@ -266,6 +267,81 @@ sub netrefunds { ); } +=item discounted: The sum of discounts on invoices in the period. + +=cut + +sub discounted { + my( $self, $speriod, $eperiod, $agentnum, %opt) = @_; + + my $sql = 'SELECT SUM('; + if ($opt{'setuprecur'}) { + # (This isn't exact but it works in most cases.) + # When splitting into setup/recur values, + # if the discount is allowed to apply to setup fees (discount.setup = 'Y') + # then split it between the "setup" and "recurring" rows in proportion to + # the "unitsetup" and "unitrecur" fields of the line item. + $sql .= <<EOF; +CASE + WHEN discount.setup = 'Y' + AND ((COALESCE(cust_bill_pkg.unitsetup,0) > 0) + OR (COALESCE(cust_bill_pkg.unitrecur,0) > 0)) + THEN +EOF + if ($opt{'setuprecur'} eq 'setup') { + $sql .= ' (COALESCE(cust_bill_pkg.unitsetup,0)'; + } elsif ($opt{'setuprecur'} eq 'recur') { + $sql .= ' (COALESCE(cust_bill_pkg.unitrecur,0)'; + } else { + die 'Unrecognized value for setuprecur'; + } + $sql .= ' / (COALESCE(cust_bill_pkg.unitsetup,0) + COALESCE(cust_bill_pkg.unitrecur,0)))'; + $sql .= " * cust_bill_pkg_discount.amount\n"; + # Otherwise, show it all as "recurring" + if ($opt{'setuprecur'} eq 'setup') { + $sql .= " ELSE 0\n"; + } elsif ($opt{'setuprecur'} eq 'recur') { + $sql .= " ELSE cust_bill_pkg_discount.amount\n"; + } + $sql .= "END\n"; + } else { + # simple case, no setuprecur + $sql .= "cust_bill_pkg_discount.amount\n"; + } + $sql .= <<EOF; +) FROM cust_bill_pkg_discount + JOIN cust_bill_pkg USING ( billpkgnum ) + JOIN cust_bill USING ( invnum ) + JOIN cust_main USING ( custnum ) +EOF + if ($opt{'setuprecur'}) { + $sql .= <<EOF; + JOIN cust_pkg_discount USING ( pkgdiscountnum ) + LEFT JOIN discount USING ( discountnum ) +EOF + } + $self->scalar_sql( + $sql + . 'WHERE ' + . $self->in_time_period_and_agent( $speriod, + $eperiod, + $agentnum, + 'cust_bill._date' + ) + . $self->for_opts(%opt) + ); +} + +=item gross: invoiced + discounted + +=cut + +sub gross { + my( $self, $speriod, $eperiod, $agentnum, %opt) = @_; + $self->invoiced( $speriod, $eperiod, $agentnum, %opt) + + $self->discounted( $speriod, $eperiod, $agentnum, %opt); +} + #XXX docs #these should be auto-generated or $AUTOLOADed or something @@ -409,8 +485,8 @@ sub cust_pkg_recur_cost { =item cust_bill_pkg: the total package charges on invoice line items. -'charges': limit the type of charges included (setup, recur, usage). -Should be a string containing one or more of 'S', 'R', or 'U'; if +'charges': limit the type of charges included (setup, recur, usage, discount). +Should be a string containing one or more of 'S', 'R', 'U', or 'D'; if unspecified, defaults to all three. 'classnum': limit to this package class. @@ -440,6 +516,7 @@ sub cust_bill_pkg { $sum += $self->cust_bill_pkg_setup(@_) if $charges{S}; $sum += $self->cust_bill_pkg_recur(@_) if $charges{R}; $sum += $self->cust_bill_pkg_detail(@_) if $charges{U}; + $sum += $self->cust_bill_pkg_discount(@_) if $charges{D}; if ($opt{'average_per_cust_pkg'}) { my $count = $self->cust_bill_pkg_count_pkgnum(@_); @@ -626,47 +703,28 @@ sub cust_bill_pkg_detail { } sub cust_bill_pkg_discount { - my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; - - #need to do this the new multi-classnum way if it gets re-enabled - #my $where = ''; - #my $comparison = ''; - #if ( $opt{'classnum'} =~ /^(\d+)$/ ) { - # if ( $1 == 0 ) { - # $comparison = "IS NULL"; - # } else { - # $comparison = "= $1"; - # } - # - # if ( $opt{'use_override'} ) { - # $where = "( - # part_pkg.classnum $comparison AND pkgpart_override IS NULL OR - # override.classnum $comparison AND pkgpart_override IS NOT NULL - # )"; - # } else { - # $where = "part_pkg.classnum $comparison"; - # } - #} + my $self = shift; + my ($speriod, $eperiod, $agentnum, %opt) = @_; + # apply all the same constraints here as for setup/recur $agentnum ||= $opt{'agentnum'}; - my $total_sql = - " SELECT COALESCE( SUM( cust_bill_pkg_discount.amount ), 0 ) "; + my @where = ( + '(pkgnum != 0 OR feepart IS NOT NULL)', + $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), + $self->with_report_option(%opt), + $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), + $self->with_refnum(%opt), + $self->with_cust_classnum(%opt) + ); - $total_sql .= - " FROM cust_bill_pkg_discount - LEFT JOIN cust_bill_pkg USING ( billpkgnum ) - LEFT JOIN cust_bill USING ( invnum ) - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum); - # LEFT JOIN cust_pkg_discount USING ( pkgdiscountnum ) - # LEFT JOIN discount USING ( discountnum ) - # LEFT JOIN cust_pkg USING ( pkgnum ) - # LEFT JOIN part_pkg USING ( pkgpart ) - # LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart - - return $self->scalar_sql($total_sql); + my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg_discount.amount), 0) + FROM cust_bill_pkg_discount + JOIN cust_bill_pkg USING (billpkgnum) + $cust_bill_pkg_join + WHERE " . join(' AND ', grep $_, @where); + $self->scalar_sql($total_sql); } ##### package churn report ##### @@ -889,6 +947,7 @@ sub with_classnum { $classnum = [ $classnum ] if !ref($classnum); @$classnum = grep /^\d+$/, @$classnum; + return '' if !@$classnum; my $in = 'IN ('. join(',', @$classnum). ')'; if ( $use_override ) { diff --git a/FS/FS/Report/Table/Daily.pm b/FS/FS/Report/Table/Daily.pm index 66739379d..8d623e766 100644 --- a/FS/FS/Report/Table/Daily.pm +++ b/FS/FS/Report/Table/Daily.pm @@ -121,16 +121,20 @@ sub data { my @newdata = (); my @newcolors = (); my @newlinks = (); + my @indices = (); foreach my $item ( @{$self->{'items'}} ) { - if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) { - push @newitems, $data{'items'}->[$col]; - push @newlabels, $data{'item_labels'}->[$col]; - push @newdata, $data{'data'}->[$col]; - push @newcolors, $data{'colors'}->[$col]; - push @newlinks, $data{'links'}->[$col]; - } - + my $is_nonzero = scalar( grep { $_ != 0 } @{ $data{'data'}->[$col] }); + next if ($self->{'remove_empty'} and $is_nonzero == 0); + # no daily reports can normalize yet + push @newitems, $data{'items'}->[$col]; + push @newlabels, $data{'item_labels'}->[$col]; + push @newdata, $data{'data'}->[$col]; + push @newcolors, $data{'colors'}->[$col]; + push @newlinks, $data{'links'}->[$col]; + push @indices, $col; + + } continue { $col++; } @@ -139,7 +143,10 @@ sub data { $data{'data'} = \@newdata; $data{'colors'} = \@newcolors; $data{'links'} = \@newlinks; + $data{'indices'} = \@indices; + } else { # not doing remove_empty; report back that all columns are included + $data{'indices'} = [ 0 .. scalar( @{$self->{'items'}} ) - 1 ]; } \%data; diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm index 0ff7efd16..f4ba02008 100644 --- a/FS/FS/Report/Table/Monthly.pm +++ b/FS/FS/Report/Table/Monthly.pm @@ -182,9 +182,15 @@ sub data { push @{$data{label}}, "$smonth/$syear"; # sprintf? my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); - push @{$data{speriod}}, $speriod; if ( ++$smonth == 13 ) { $syear++; $smonth=1; } my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear); + # 12-month mode: show results in a sliding window ending at $eperiod, + # but starting 12 months before. + if ( $self->{'12mo'}) { + $speriod = timelocal(0,0,0,1,$smonth-1,$syear-1); + } + + push @{$data{speriod}}, $speriod; push @{$data{eperiod}}, $eperiod; my $col = 0; # a "column" here is the data corresponding to an item diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 2d98963a8..c8b9b631d 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2009,7 +2009,7 @@ sub tables_hashref { 'locationname', 'varchar', 'NULL', $char_d, '', '', 'address1', 'varchar', '', $char_d, '', '', 'address2', 'varchar', 'NULL', $char_d, '', '', - 'city', 'varchar', '', $char_d, '', '', + 'city', 'varchar', 'NULL', $char_d, '', '', 'county', 'varchar', 'NULL', $char_d, '', '', 'state', 'varchar', 'NULL', $char_d, '', '', 'zip', 'varchar', 'NULL', 10, '', '', @@ -2431,6 +2431,7 @@ sub tables_hashref { 'payunique', 'varchar', 'NULL', $char_d, '', '',#separate paybatch "unique" functions from current usage 'closed', 'char', 'NULL', 1, '', '', 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances + 'no_auto_apply', 'char', 'NULL', 1, '', '', # cash/check deposit info fields 'bank', 'varchar', 'NULL', $char_d, '', '', @@ -2639,7 +2640,7 @@ sub tables_hashref { 'first', 'varchar', '', $char_d, '', '', 'address1', 'varchar', '', $char_d, '', '', 'address2', 'varchar', 'NULL', $char_d, '', '', - 'city', 'varchar', '', $char_d, '', '', + 'city', 'varchar', 'NULL', $char_d, '', '', 'state', 'varchar', 'NULL', $char_d, '', '', 'zip', 'varchar', 'NULL', 10, '', '', 'country', 'char', '', 2, '', '', @@ -3197,6 +3198,10 @@ sub tables_hashref { 'delay_start', 'int', 'NULL', '', '', '', 'start_on_hold', 'char', 'NULL', 1, '', '', 'agent_pkgpartid', 'varchar', 'NULL', 20, '', '', + 'expire_months', 'int', 'NULL', '', '', '', + 'adjourn_months', 'int', 'NULL', '', '', '', + 'contract_end_months','int','NULL', '', '', '', + 'change_to_pkgpart', 'int', 'NULL', '', '', '', ], 'primary_key' => 'pkgpart', 'unique' => [], @@ -3225,6 +3230,10 @@ sub tables_hashref { table => 'part_pkg', references => [ 'pkgpart' ], }, + { columns => [ 'change_to_pkgpart' ], + table => 'part_pkg', + references => [ 'pkgpart' ], + }, ], }, @@ -5734,6 +5743,18 @@ sub tables_hashref { 'index' => [], }, + 'access_user_log' => { + 'columns' => [ + 'lognum', 'serial', '', '', '', '', + 'usernum', 'int', '', '', '', '', + 'path', 'varchar', '', 2*$char_d, '', '', + '_date', @date_type, '', '', + ], + 'primary_key' => 'lognum', + 'unique' => [], + 'index' => [ ['usernum'], ['path'], ['_date'] ], + }, + 'sched_item' => { 'columns' => [ 'itemnum', 'serial', '', '', '', '', @@ -6902,6 +6923,8 @@ sub tables_hashref { 'latexsmallfooter', 'text', 'NULL', '', '', '', 'latexreturnaddress', 'text', 'NULL', '', '', '', 'with_latexcoupon', 'char', 'NULL', '1', '', '', + 'htmlwatermark', 'text', 'NULL', '', '', '', + 'latexwatermark', 'text', 'NULL', '', '', '', 'lpr', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'confnum', diff --git a/FS/FS/TaxEngine/cch.pm b/FS/FS/TaxEngine/cch.pm index fb3410365..ccfb846fe 100644 --- a/FS/FS/TaxEngine/cch.pm +++ b/FS/FS/TaxEngine/cch.pm @@ -123,7 +123,7 @@ sub make_taxlines { my @raw_taxlines; my %taxable_location; # taxable billpkgnum => cust_location - my %item_has_tax; # taxable billpkgnum => taxnum + my %item_has_tax; # taxable billpkgnum => charge class => taxnum foreach my $taxnum ( keys %{ $self->{taxes} } ) { my $tax_rate = FS::tax_rate->by_key($taxnum); my $taxables = $self->{taxes}{$taxnum}; @@ -141,8 +141,8 @@ sub make_taxlines { # store this tax fragment, indexed by taxable item, then by taxnum my $billpkgnum = $link->taxable_billpkgnum; - $item_has_tax{$billpkgnum} ||= {}; - my $fragments = $item_has_tax{$billpkgnum}{$taxnum} ||= []; + my $fragments = $item_has_tax{$billpkgnum}{$link->taxclass}{$taxnum} + ||= []; push @raw_taxlines, $link; # this will go into final consolidation push @$fragments, $link; # this will go into a temporary cust_bill_pkg @@ -156,48 +156,58 @@ sub make_taxlines { # taxes that apply to this item my $this_has_tax = $item_has_tax{$billpkgnum}; my $location = $taxable_location{$billpkgnum}; - foreach my $taxnum (keys %$this_has_tax) { - # $this_has_tax->{$taxnum} = an arrayref of the tax links for taxdef - # $taxnum on taxable item $billpkgnum - - my $tax_rate = FS::tax_rate->by_key($taxnum); - # find all taxes that apply to it in this location - my @tot = $tax_rate->tax_on_tax( $location ); - next if !@tot; - - warn "found possible taxed taxnum $taxnum\n" - if $DEBUG > 2; - # Calculate ToT separately for each taxable item, and only if _that - # item_ is already taxed under the ToT. This is counterintuitive. - # See RT#5243. - my $temp_lineitem; - foreach my $tot (@tot) { - my $totnum = $tot->taxnum; - warn "checking taxnum ".$tot->taxnum. - " which we call ". $tot->taxname ."\n" + + foreach my $charge_class (keys %$this_has_tax) { + # taxes that apply to this item and charge class + my $this_class_has_tax = $this_has_tax->{$charge_class}; + foreach my $taxnum (keys %$this_class_has_tax) { + + my $tax_rate = FS::tax_rate->by_key($taxnum); + # find all taxes that apply to it in this location + my @tot = $tax_rate->tax_on_tax( $location ); + next if !@tot; + + warn "found possible taxed taxnum $taxnum\n" if $DEBUG > 2; - if ( exists $this_has_tax->{ $totnum } ) { - warn "calculating tax on tax: taxnum ".$tot->taxnum." on $taxnum\n" - if $DEBUG; - # construct a line item to calculate tax on - $temp_lineitem ||= FS::cust_bill_pkg->new({ - 'pkgnum' => 0, - 'invnum' => $cust_bill->invnum, - 'setup' => sum(map $_->amount, @{ $this_has_tax->{$taxnum} }), - 'recur' => 0, - 'itemdesc' => $tax_rate->taxname, - 'cust_bill_pkg_tax_rate_location' => $this_has_tax->{$taxnum}, - }); - my @new_taxlines = $tot->taxline_cch( [ $temp_lineitem ] ); - next if (!@new_taxlines); # it didn't apply after all - if (!ref($new_taxlines[0])) { - die "error evaluating TOT ($totnum on $taxnum): $new_taxlines[0]\n"; - } - # add these to the taxline queue - push @raw_taxlines, @new_taxlines; - } # if $this_has_tax->{$totnum} - } # foreach my $tot (tax-on-tax rate definition) - } # foreach $taxnum (first-tier rate definition) + # Calculate ToT separately for each taxable item and class, and only + # if _that class on the item_ is already taxed under the ToT. This is + # counterintuitive. + # See RT#5243 and RT#36380. + my $temp_lineitem; + foreach my $tot (@tot) { + my $totnum = $tot->taxnum; + warn "checking taxnum ".$tot->taxnum. + " which we call ". $tot->taxname ."\n" + if $DEBUG > 2; + # note: if the _null class_ on this item is taxed under the ToT, + # then this specific class is taxed also (because null class + # includes all classes) and so ToT is applicable. + if ( + exists $this_class_has_tax->{ $totnum } + or exists $this_has_tax->{''}{ $totnum } + ) { + warn "calculating tax on tax: taxnum ".$tot->taxnum." on $taxnum\n" + if $DEBUG; + # construct a line item to calculate tax on + $temp_lineitem ||= FS::cust_bill_pkg->new({ + 'pkgnum' => 0, + 'invnum' => $cust_bill->invnum, + 'setup' => sum(map $_->amount, @{ $this_class_has_tax->{$taxnum} }), + 'recur' => 0, + 'itemdesc' => $tax_rate->taxname, + 'cust_bill_pkg_tax_rate_location' => $this_class_has_tax->{$taxnum}, + }); + my @new_taxlines = $tot->taxline_cch( [ $temp_lineitem ] ); + next if (!@new_taxlines); # it didn't apply after all + if (!ref($new_taxlines[0])) { + die "error evaluating TOT ($totnum on $taxnum): $new_taxlines[0]\n"; + } + # add these to the taxline queue + push @raw_taxlines, @new_taxlines; + } # if $this_has_tax->{$totnum} + } # foreach my $tot (tax-on-tax rate definition) + } # foreach $taxnum (first-tier rate definition) + } # foreach $charge_class } # foreach $taxable_item return @raw_taxlines; diff --git a/FS/FS/TaxEngine/suretax.pm b/FS/FS/TaxEngine/suretax.pm index 8139b1dff..4e7edd575 100644 --- a/FS/FS/TaxEngine/suretax.pm +++ b/FS/FS/TaxEngine/suretax.pm @@ -85,6 +85,8 @@ sub build_request { my @lines = map { $self->build_item($_) } $cust_bill->cust_bill_pkg; + return if !@lines; + my $ClientNumber = $conf->config('suretax-client_number') or die "suretax-client_number config required.\n"; my $ValidationKey = $conf->config('suretax-validation_key') @@ -306,6 +308,10 @@ sub make_taxlines { # assemble the request hash my $request = $self->build_request; + if (!$request) { + warn "no taxable items in invoice; skipping SureTax request\n" if $DEBUG; + return; + } warn "sending SureTax request\n" if $DEBUG; my $request_json = $json->encode($request); diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 32e300776..37dcf2a5e 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -817,35 +817,36 @@ sub print_generic { my @include = ( [ $tc, 'notes' ], [ 'invoice_', 'footer' ], [ 'invoice_', 'smallfooter', ], + [ 'invoice_', 'watermark' ], ); push @include, [ $tc, 'coupon', ] unless $params{'no_coupon'}; foreach my $i (@include) { + # load the configuration for this sub-template + my($base, $include) = @$i; my $inc_file = $conf->key_orbase("$base$format$include", $template); - my @inc_src; - - if ( $conf->exists($inc_file, $agentnum) - && length( $conf->config($inc_file, $agentnum) ) ) { - - @inc_src = $conf->config($inc_file, $agentnum); - - } else { - - $inc_file = $conf->key_orbase("${base}latex$include", $template); - - my $convert_map = $convert_maps{$format}{$include}; - @inc_src = map { s/\[\@--/$delimiters{$format}[0]/g; - s/--\@\]/$delimiters{$format}[1]/g; - $_; - } - &$convert_map( $conf->config($inc_file, $agentnum) ); + my @inc_src = $conf->config($inc_file, $agentnum); + if (!@inc_src) { + my $converter = $convert_maps{$format}{$include}; + if ( $converter ) { + # then attempt to convert LaTeX to the requested format + $inc_file = $conf->key_orbase($base.'latex'.$include, $template); + @inc_src = &$converter( $conf->config($inc_file, $agentnum) ); + foreach (@inc_src) { + # this isn't included in the convert_maps + my ($open, $close) = @{ $delimiters{$format} }; + s/\[\@--/$open/g; + s/--\@\]/$close/g; + } + } + } # else @inc_src is empty and that's fine - } + # make a Text::Template out of it my $inc_tt = new Text::Template ( TYPE => 'ARRAY', @@ -859,6 +860,8 @@ sub print_generic { die $error; } + # fill in variables + $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data ); $invoice_data{$include} =~ s/\n+$// diff --git a/FS/FS/TicketSystem.pm b/FS/FS/TicketSystem.pm index e81d89328..8f3d7af03 100644 --- a/FS/FS/TicketSystem.pm +++ b/FS/FS/TicketSystem.pm @@ -159,22 +159,29 @@ sub _upgrade_data { my $search = $class->new($CurrentUser); $search->UnLimit; while ( my $item = $search->Next ) { - my $ids = $hash->{lc($item->Name)} ||= []; - if ( $item->Creator == 1 ) { # RT::SystemUser - unshift @$ids, $item->Id; - } - else { - push @$ids, $item->Id; + if ( $class =~ /Template/ ) { + # template names can be duplicated in different queues, and they are. + my $queue = $item->QueueObj->Name || '0'; + my $subhash = $hash->{$queue} ||= {}; + $subhash->{lc($item->Name)} = $item->Id; + } else { + # then duplicate names are allowed; they just have different ids + my $ids = $hash->{lc($item->Name)} ||= []; + if ( $item->Creator == 1 ) { # RT::SystemUser + unshift @$ids, $item->Id; + } + else { + push @$ids, $item->Id; + } } } }; my (%condition, %action, %template); - &$cachify('RT::ScripConditions', \%condition); - &$cachify('RT::ScripActions', \%action); - &$cachify('RT::Templates', \%template); - # $condition{name} = [ ids... ] + &$cachify('RT::ScripConditions', \%condition); # condition name -> [ ids ] # with the id of the system-created object first, if there is one + &$cachify('RT::ScripActions', \%action); # action name -> [ ids ] + &$cachify('RT::Templates', \%template); # queue name -> tmpl name -> id # ScripConditions my $ScripCondition = RT::ScripCondition->new($CurrentUser); @@ -196,40 +203,50 @@ sub _upgrade_data { $action{ lc($ScripAction->Name) } = [ $ScripAction->Id ]; } + $DB::single = 1; # Templates my $Template = RT::Template->new($CurrentUser); foreach my $t (@Templates) { # $t: Queue, Name, Description, Content - next if exists( $template{ lc($t->{Name}) } ); + next if exists( $template{ $t->{Queue} }->{ lc($t->{Name}) } ); my ($val, $msg) = $Template->Create( %$t ); die $msg if !$val; - $template{ lc($Template->Name) } = [ $Template->Id ]; + $template{ $t->{Queue} }->{ lc($Template->Name) } = [ $Template->Id ]; } # Scrips + # Scrips can no longer be deleted, so we'll count them as existing + # if they're applied to the global queue, or if they're not applied to + # _any_ queue. + my %scrip; # $scrips{condition}{action}{template} = id - my $search = RT::Scrips->new($CurrentUser); - $search->Limit(FIELD => 'Queue', VALUE => 0); - while (my $item = $search->Next) { - my ($c, $a, $t) = map {lc $item->$_->Name} - ('ScripConditionObj', 'ScripActionObj', 'TemplateObj'); - if ( exists $scrip{$c}{$a} and $item->Creator == 1 ) { - warn "Deleting duplicate scrip $c $a [$t]\n"; - my ($val, $msg) = $item->Delete; - warn "error deleting scrip: $msg\n" if !$val; - } - elsif ( exists $Delete_Scrips{$c}{$a}{$t} and $item->Creator == 1 ) { - warn "Deleting obsolete scrip $c $a [$t]\n"; - my ($val, $msg) = $item->Delete; - warn "error deleting scrip: $msg\n" if !$val; - } - else { - $scrip{$c}{$a} = $item->id; + foreach my $criterion ('LimitToGlobal', 'LimitToNotAdded') { + my $search = RT::Scrips->new($CurrentUser); + $search->$criterion; + + while (my $item = $search->Next) { + my ($c, $a, $t) = map {lc $item->$_->Name} + ('ScripConditionObj', 'ScripActionObj', 'TemplateObj'); + if ( exists $scrip{$c}{$a} and $item->Creator == 1 ) { + warn "Deleting duplicate scrip $c $a [$t]\n"; + my ($val, $msg) = $item->Delete; + warn "error deleting scrip: $msg\n" if !$val; + } + elsif ( exists $Delete_Scrips{$c}{$a}{$t} and $item->Creator == 1 ) { + warn "Deleting obsolete scrip $c $a [$t]\n"; + my ($val, $msg) = $item->Delete; + warn "error deleting scrip: $msg\n" if !$val; + } + else { + $scrip{$c}{$a} = $item->id; + } } } + my $Scrip = RT::Scrip->new($CurrentUser); foreach my $s ( @Scrips ) { my $desc = $s->{'Description'}; + # the condition, action, and template _names_ my ($c, $a, $t) = map lc, @{ $s }{'ScripCondition', 'ScripAction', 'Template'}; @@ -245,14 +262,15 @@ sub _upgrade_data { warn "ScripAction '$a' not found.\n"; next; } - if ( !exists($template{$t}) ) { + if ( !exists($template{'0'}{$t}) ) { + # a global template with this name has to exist, at least warn "Template '$t' not found.\n"; next; } my %new_param = ( ScripCondition => $condition{$c}->[0], ScripAction => $action{$a}->[0], - Template => $template{$t}->[0], + Template => $t, # scrips.template is now the name, not the id Queue => 0, Description => $desc, ); @@ -262,11 +280,13 @@ sub _upgrade_data { } #if $scrip{...} # set the Immutable attribute on them if needed - if ( !$Scrip->FirstAttribute('Immutable') ) { - my ($val, $msg) = - $Scrip->SetAttribute(Name => 'Immutable', Content => '1'); - die $msg if !$val; - } + # no longer needed; you can't delete scrips through the UI anyway, only + # disable them + #if ( !$Scrip->FirstAttribute('Immutable') ) { + # my ($val, $msg) = + # $Scrip->SetAttribute(Name => 'Immutable', Content => '1'); + # die $msg if !$val; + #} } #foreach (@Scrips) diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm index d0913d84d..6fb2c187d 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -454,23 +454,21 @@ sub get_ticket_object { my $self = shift; my ($session, %opt) = @_; $session = $self->session(shift); - my $Ticket = RT::Ticket->new($session->{CurrentUser}); - $Ticket->Load($opt{'ticket_id'}); - return if ( !$Ticket->id ); - my $custnum = $opt{'custnum'}; - if ( defined($custnum) && $custnum =~ /^\d+$/ ) { - # probably the most efficient way to check ticket ownership - my $Link = RT::Link->new($session->{CurrentUser}); - $Link->LoadByCols( LocalBase => $opt{'ticket_id'}, - Type => 'MemberOf', - Target => "freeside://freeside/cust_main/$custnum", - ); - return if ( !$Link->id ); + # use a small search here so we can check ticket ownership + my $query; + if ( $opt{'ticket_id'} =~ /^(\d+)$/ ) { + $query = "id = $1"; + } else { + return; + } + if ( $opt{'custnum'} =~ /^(\d+)$/ ) { + $query .= " AND Customer.number = $1"; # also checks ownership via services } - return $Ticket; + my $Tickets = RT::Tickets->new($session->{CurrentUser}); + $Tickets->FromSQL($query); + return $Tickets->First; } - =item correspond_ticket SESSION_HASHREF, OPTION => VALUE ... Class method. Correspond on a ticket. If there is an error, returns the scalar diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index ca50b278e..6655f270f 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -273,6 +273,7 @@ sub cust_header { 'Invoicing email(s)' => 'invoicing_list_emailonly_scalar', 'Payment Type' => 'payby', 'Current Balance' => 'current_balance', + 'Agent Cust#' => 'agent_custid', ); $header2method{'Cust#'} = 'display_custnum' if $conf->exists('cust_main-default_agent_custid'); diff --git a/FS/FS/UI/Web/small_custview.pm b/FS/FS/UI/Web/small_custview.pm index 72af03ea4..e82e3326f 100644 --- a/FS/FS/UI/Web/small_custview.pm +++ b/FS/FS/UI/Web/small_custview.pm @@ -95,8 +95,12 @@ sub small_custview { $html = qq!<A HREF="$url?! . $cust_main->custnum . '">' if $url; + if ( $FS::CurrentUser::CurrentUser->num_agents ) { + $html .= encode_entities($cust_main->agent->agent). ' '; + } + $html .= 'Customer #<B>'. $cust_main->display_custnum. - ': '. encode_entities($cust_main->name). '</B></A>'; + '</B>: <B>'. encode_entities($cust_main->name). '</B></A>'. ' - <B><FONT COLOR="#'. $cust_main->statuscolor. '">'. $cust_main->status_label. '</FONT></B>'; @@ -129,9 +133,10 @@ sub small_custview { $html .= encode_entities($cust_main->address1). '<BR>'; $html .= encode_entities($cust_main->address2). '<BR>' if $cust_main->address2; - $html .= encode_entities($cust_main->city). ', '. $cust_main->state. ' '. - $cust_main->zip. '<BR>'; - $html .= $cust_main->country. '<BR>' + $html .= encode_entities($cust_main->city) . ', ' if $cust_main->city; + $html .= encode_entities($cust_main->state). ' '. + encode_entities($cust_main->zip). '<BR>'; + $html .= encode_entities($cust_main->country). '<BR>' if $cust_main->country && $cust_main->country ne $countrydefault; } @@ -162,7 +167,7 @@ sub small_custview { $cust_main->ship_company, $ship->address1, $ship->address2, - ($ship->city . ', ' . $ship->state . ' ' . $ship->zip), + (($ship->city ? $ship->city . ', ' : '') . $ship->state . ' ' . $ship->zip), ($ship->country eq $countrydefault ? '' : $ship->country ), ); diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index 68d2deaba..a3f55bc76 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -283,6 +283,22 @@ sub report_sales { Returns links to the the groups this user is a part of, as FS::access_usergroup objects (see L<FS::access_usergroup>). +=item num_agents + +Returns the number of agents this user can view (via group membership). + +=cut + +sub num_agents { + my $self = shift; + $self->scalar_sql( + 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup + JOIN access_groupagent USING ( groupnum ) + WHERE usernum = ?', + $self->usernum, + ); +} + =item agentnums Returns a list of agentnums this user can view (via group membership). diff --git a/FS/FS/access_user_log.pm b/FS/FS/access_user_log.pm new file mode 100644 index 000000000..9e7f7a00e --- /dev/null +++ b/FS/FS/access_user_log.pm @@ -0,0 +1,138 @@ +package FS::access_user_log; +use base qw( FS::Record ); + +use strict; +#use FS::Record qw( qsearch qsearchs ); +use FS::CurrentUser; + +=head1 NAME + +FS::access_user_log - Object methods for access_user_log records + +=head1 SYNOPSIS + + use FS::access_user_log; + + $record = new FS::access_user_log \%hash; + $record = new FS::access_user_log { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::access_user_log object represents a backoffice web server log entry. + FS::access_user_log inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item lognum + +primary key + +=item usernum + +usernum + +=item path + +path + +=item _date + +_date + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new log entry. To add the log entry 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 + +sub table { 'access_user_log'; } + +=item insert_new_path PATH + +Adds a log entry for PATH for the current user and timestamp. + +=cut + +sub insert_new_path { + my( $class, $path ) = @_; + + return '' unless defined $FS::CurrentUser::CurrentUser; + + my $self = $class->new( { + 'usernum' => $FS::CurrentUser::CurrentUser->usernum, + 'path' => $path, + '_date' => time, + } ); + + my $error = $self->insert; + die $error if $error; + +} + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid log entry. 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('lognum') + || $self->ut_foreign_key('usernum', 'access_user', 'usernum') + || $self->ut_text('path') + || $self->ut_number('_date') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/cdr/broadsoft.pm b/FS/FS/cdr/broadsoft.pm index b5d75f13f..a6f4d01c0 100644 --- a/FS/FS/cdr/broadsoft.pm +++ b/FS/FS/cdr/broadsoft.pm @@ -39,7 +39,8 @@ use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); skip(17), sub { my($cdr, $accountcode) = @_; if ($cdr->is_tollfree){ - $cdr->set('accountcode', $cdr->dst); + my $dst = substr($cdr->dst,0,32); + $cdr->set('accountcode', $dst); } else { $cdr->set('accountcode', $accountcode); }}, diff --git a/FS/FS/cdr/enswitch_calling_name.pm b/FS/FS/cdr/enswitch_calling_name.pm new file mode 100644 index 000000000..c5564d3a6 --- /dev/null +++ b/FS/FS/cdr/enswitch_calling_name.pm @@ -0,0 +1,62 @@ +package FS::cdr::enswitch_calling_name; +use base qw( FS::cdr ); + +use strict; +use vars qw( %info $tmp_mon $tmp_mday $tmp_year ); +use FS::Record qw( qsearchs ); +use FS::cdr_type; + +%info = ( + 'name' => 'Enswitch with calling name', + 'weight' => 515, + 'header' => 2, + 'type' => 'csv', + 'import_fields' => [ + 'dcontext', #Status + 'startdate', #Start, already a unix timestamp + skip(2), #Start date, Start time + 'enddate', #End + skip(6), #End date, End time + #Calling customer, Calling type + 'src', #Calling number + skip(1), #Called type + + sub { my ($cdr, $dst) = @_; + $dst =~ s/\*//g; + $cdr->set('dst', $dst); + }, #Called number + + skip(14), #Destination customer, Destination type + #Destination number + #Destination group ID, Destination group name, + #Inbound calling type, + #Inbound calling number, + #Inbound called type, + #Inbound called number, + #Inbound destination type, Inbound destination number, + sub { my ($cdr, $data) = @_; + $data ||= 'none'; + + my $cdr_type = qsearchs('cdr_type', { 'cdrtypename' => $data } ); + $cdr->set('cdrtypenum', $cdr_type->cdrtypenum) if $cdr_type; + } , #Outbound calling type, + + skip(11), #Outbound calling number, + #Outbound called type, Outbound called number, + #Outbound destination type, Outbound destination number, + #Internal calling type, Internal calling number, + #Internal called type, Internal called number, + #Internal destination type, Internal destination number + 'duration', #Total seconds + skip(1), #Ring seconds + 'billsec', #Billable seconds + skip(2), #Cost + #Cost including taxes + 'accountcode', #Billing customer + skip(3), #Billing customer name, Billing type, Billing reference + ], +); + +sub skip { map {''} (1..$_[0]) } + +1; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index db909309f..7ea586a90 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -253,7 +253,7 @@ sub void { } } - $error = $self->delete; + $error = $self->_delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -265,20 +265,22 @@ sub void { } -=item delete - -This method now works but you probably shouldn't use it. Instead, apply a -credit against the invoice, or use the new void method. - -Using this method to delete invoices outright is really, really bad. There -would be no record you ever posted this invoice, and there are no check to -make sure charged = 0 or that there are no associated cust_bill_pkg records. - -Really, don't use it. - -=cut - -sub delete { +# removed docs entirely and renamed method to _delete to further indicate it is +# internal-only and discourage use +# +# =item delete +# +# DO NOT USE THIS METHOD. Instead, apply a credit against the invoice, or use +# the B<void> method. +# +# This is only for internal use by V<void>, which is what you should be using. +# +# DO NOT USE THIS METHOD. Whatever reason you think you have is almost certainly +# wrong. Use B<void>, that's what it is for. Really. This means you. +# +# =cut + +sub _delete { my $self = shift; return "Can't delete closed invoice" if $self->closed =~ /^Y/i; @@ -888,6 +890,7 @@ sub hide { =item apply_payments_and_credits [ OPTION => VALUE ... ] Applies unapplied payments and credits to this invoice. +Payments with the no_auto_apply flag set will not be applied. A hash of optional arguments may be passed. Currently "manual" is supported. If true, a payment receipt is sent instead of a statement when @@ -914,7 +917,9 @@ sub apply_payments_and_credits { $self->select_for_update; #mutex - my @payments = grep { $_->unapplied > 0 } $self->cust_main->cust_pay; + my @payments = grep { $_->unapplied > 0 } + grep { !$_->no_auto_apply } + $self->cust_main->cust_pay; my @credits = grep { $_->credited > 0 } $self->cust_main->cust_credit; if ( $conf->exists('pkg-balances') ) { @@ -2971,6 +2976,9 @@ sub process_re_X { } +# this is called from search/cust_bill.html and given all its search +# parameters, so it needs to perform the same search. + sub re_X { # spool_invoice ftp_invoice fax_invoice print_invoice my($method, $job, %param ) = @_; @@ -2980,22 +2988,15 @@ sub re_X { } #some false laziness w/search/cust_bill.html - my $distinct = ''; - my $orderby = 'ORDER BY cust_bill._date'; - - my $extra_sql = ' WHERE '. FS::cust_bill->search_sql_where(\%param); - - my $addl_from = 'LEFT JOIN cust_main USING ( custnum )'; - - my @cust_bill = qsearch( { - #'select' => "cust_bill.*", - 'table' => 'cust_bill', - 'addl_from' => $addl_from, - 'hashref' => {}, - 'extra_sql' => $extra_sql, - 'order_by' => $orderby, - 'debug' => 1, - } ); + $param{'order_by'} = 'cust_bill._date'; + + my $query = FS::cust_bill->search(\%param); + delete $query->{'count_query'}; + delete $query->{'count_addl'}; + + $query->{debug} = 1; # was in here before, is obviously useful + + my @cust_bill = qsearch( $query ); $method .= '_invoice' unless $method eq 'email' || $method eq 'print'; diff --git a/FS/FS/cust_bill/Search.pm b/FS/FS/cust_bill/Search.pm index 2a67529c1..ee5da3be8 100644 --- a/FS/FS/cust_bill/Search.pm +++ b/FS/FS/cust_bill/Search.pm @@ -6,18 +6,22 @@ use FS::UI::Web; use FS::Record qw( qsearchs dbh ); use FS::cust_main; use FS::access_user; +use FS::Conf; +use charnames ':full'; =item search HASHREF (Class method) -Returns a qsearch hash expression to search for parameters specified in HASHREF. -In addition to all parameters accepted by search_sql_where, the following -additional parameters valid: +Returns a qsearch hash expression to search for parameters specified in +HASHREF. In addition to all parameters accepted by search_sql_where, the +following additional parameters valid: =over 4 -=item newest_percust +=item newest_percust - only show the most recent invoice for each customer + +=item invoiced - show the invoiced amount (excluding discounts) instead of gross sales =back @@ -26,7 +30,8 @@ additional parameters valid: sub search { my( $class, $params ) = @_; - my( $count_query, $count_addl ) = ( '', '' ); + my $count_query = ''; + my @count_addl; #some false laziness w/cust_bill::re_X @@ -38,41 +43,92 @@ sub search { my $join_cust_main = FS::UI::Web::join_cust_main('cust_bill'); + # get discounted, credited, and paid amounts here, for use in report + # + # Testing shows that this is by far the most efficient way to do the + # joins. In particular it's almost 100x faster to join to an aggregate + # query than to put the subquery in a select expression. It also makes + # it more convenient to do arithmetic between columns, use them as sort + # keys, etc. + # + # Each ends with a RIGHT JOIN cust_bill so that it includes all invnums, + # even if they have no discounts/credits/payments; the total amount is then + # coalesced to zero. + my $join = "$join_cust_main + JOIN ( + SELECT COALESCE(SUM(cust_bill_pkg_discount.amount), 0) AS discounted, + invnum + FROM cust_bill_pkg_discount + JOIN cust_bill_pkg USING (billpkgnum) + RIGHT JOIN cust_bill USING (invnum) + GROUP BY invnum + ) AS _discount USING (invnum) + JOIN ( + SELECT COALESCE(SUM(cust_credit_bill.amount), 0) AS credited, invnum + FROM cust_credit_bill + RIGHT JOIN cust_bill USING (invnum) + GROUP BY invnum + ) AS _credit USING (invnum) + JOIN ( + SELECT COALESCE(SUM(cust_bill_pay.amount), 0) AS paid, invnum + FROM cust_bill_pay + RIGHT JOIN cust_bill USING (invnum) + GROUP BY invnum + ) AS _pay USING (invnum) + "; + unless ( $count_query ) { - $count_query = 'SELECT COUNT(*), '. join(', ', - map "SUM($_)", - ( 'charged', - FS::cust_bill->net_sql, - FS::cust_bill->owed_sql, - ) - ); - $count_addl = [ '$%.2f invoiced (gross)', - '$%.2f invoiced (net)', - '$%.2f outstanding balance', - ]; + + my $money = (FS::Conf->new->config('money_char') || '$') . '%.2f'; + + my @sums = ( 'credited', # credits + 'charged - credited', # net sales + 'charged - credited - paid', # balance due + ); + + @count_addl = ( "\N{MINUS SIGN} $money credited", + "= $money net sales", + "$money outstanding balance", + ); + + if ( $params->{'invoiced'} ) { + + unshift @sums, 'charged'; + unshift @count_addl, "$money invoiced"; + + } else { + + unshift @sums, 'charged + discounted', 'discounted'; + unshift @count_addl, "$money gross sales", + "\N{MINUS SIGN} $money discounted"; + + } + + $count_query = 'SELECT COUNT(*), '. join(', ', map "SUM($_)", @sums); } - $count_query .= " FROM cust_bill $join_cust_main $extra_sql"; + $count_query .= " FROM cust_bill $join $extra_sql"; #$sql_query = +{ 'table' => 'cust_bill', - 'addl_from' => $join_cust_main, + 'addl_from' => $join, 'hashref' => {}, 'select' => join(', ', 'cust_bill.*', #( map "cust_main.$_", qw(custnum last first company) ), 'cust_main.custnum as cust_main_custnum', FS::UI::Web::cust_sql_fields(), - #$class->owed_sql. ' AS owed', - #$class->net_sql. ' AS net', - FS::cust_bill->owed_sql. ' AS owed', - FS::cust_bill->net_sql. ' AS net', + '(charged + discounted) as gross', + 'discounted', + 'credited', + '(charged - credited) as net', + '(charged - credited - paid) as owed', ), 'extra_sql' => $extra_sql, 'order_by' => 'ORDER BY '. ( $params->{'order_by'} || 'cust_bill._date' ), 'count_query' => $count_query, - 'count_addl' => $count_addl, + 'count_addl' => \@count_addl, }; } @@ -176,16 +232,10 @@ sub search_sql_where { ? @{ $param->{'cust_classnum'} } : ( $param->{'cust_classnum'} ); - @classnum = grep /^(\d*)$/, @classnum; + @classnum = grep /^(\d+)$/, @classnum; if ( @classnum ) { - push @search, '( '. join(' OR ', map { - $_ ? "cust_main.classnum = $_" - : "cust_main.classnum IS NULL" - } - @classnum - ). - ' )'; + push @search, 'COALESCE(cust_main.classnum, 0) IN ('.join(',', @classnum).')'; } } @@ -206,6 +256,7 @@ sub search_sql_where { push @search, "cust_bill.invnum <= $1"; } + # these are from parse_lt_gt, and should already be sanitized #charged if ( $param->{charged} ) { my @charged = ref($param->{charged}) @@ -216,21 +267,22 @@ sub search_sql_where { @charged; } - my $owed_sql = FS::cust_bill->owed_sql; + #my $owed_sql = FS::cust_bill->owed_sql; + my $owed_sql = '(cust_bill.charged - credited - paid)'; + my $net_sql = '(cust_bill.charged - credited)'; #owed if ( $param->{owed} ) { my @owed = ref($param->{owed}) ? @{ $param->{owed} } : ($param->{owed}); - push @search, map { s/^owed/$owed_sql/; $_; } - @owed; + push @search, map { s/^owed/$owed_sql/; $_ } @owed; } #open/net flags push @search, "0 != $owed_sql" if $param->{'open'}; - push @search, '0 != '. FS::cust_bill->net_sql + push @search, "0 != $net_sql" if $param->{'net'}; #days diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index f63d86f99..544a0e83d 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -705,6 +705,102 @@ sub credited_sql { unapplied_sql(); } +=item calculate_tax_adjustment PARAMS + +Calculate the amount of tax that needs to be credited as part of a lineitem +credit. + +PARAMS must include: + +- billpkgnums: arrayref identifying the line items to credit +- setuprecurs: arrayref of 'setup' or 'recur', indicating which part of + the lineitem charge is being credited +- amounts: arrayref of the amounts to credit on each line item +- custnum: the customer all of these invoices belong to, for error checking + +Returns a hash containing: +- subtotal: the total non-tax amount to be credited (the sum of the 'amounts') +- taxtotal: the total tax amount to be credited +- taxlines: an arrayref of hashrefs for each tax line to be credited, each with: + - table: "cust_bill_pkg_tax_location" or "cust_bill_pkg_tax_rate_location" + - num: the key within that table + - credit: the credit amount to apply to that line + +=cut + +sub calculate_tax_adjustment { + my ($class, %arg) = @_; + + my $error; + my @taxlines; + my $subtotal = 0; + my $taxtotal = 0; + + my (%cust_bill_pkg, %cust_bill); + + for (my $i = 0; ; $i++) { + my $billpkgnum = $arg{billpkgnums}[$i] + or last; + my $setuprecur = $arg{setuprecurs}[$i]; + my $amount = $arg{amounts}[$i]; + next if $amount == 0; + $subtotal += $amount; + my $cust_bill_pkg = $cust_bill_pkg{$billpkgnum} + ||= FS::cust_bill_pkg->by_key($billpkgnum) + or die "lineitem #$billpkgnum not found\n"; + + my $invnum = $cust_bill_pkg->invnum; + $cust_bill{ $invnum } ||= FS::cust_bill->by_key($invnum); + $cust_bill{ $invnum}->custnum == $arg{custnum} + or die "lineitem #$billpkgnum not found\n"; + + # calculate credit ratio. + # (First deduct any existing credits applied to this line item, to avoid + # rounding errors.) + my $charged = $cust_bill_pkg->get($setuprecur); + my $previously_credited = + $cust_bill_pkg->credited( '', '', setuprecur => $setuprecur) || 0; + + $charged -= $previously_credited; + if ($charged < $amount) { + $error = "invoice #$invnum: tried to credit $amount, but only $charged was charged"; + last; + } + my $ratio = $amount / $charged; + + # gather taxes that apply to the selected item + foreach my $table ( + qw(cust_bill_pkg_tax_location cust_bill_pkg_tax_rate_location) + ) { + foreach my $tax_link ( + qsearch($table, { taxable_billpkgnum => $billpkgnum }) + ) { + my $tax_amount = $tax_link->amount; + # deduct existing credits applied to the tax, for the same reason as + # above + foreach ($tax_link->cust_credit_bill_pkg) { + $tax_amount -= $_->amount; + } + my $tax_credit = sprintf('%.2f', $tax_amount * $ratio); + my $pkey = $tax_link->get($tax_link->primary_key); + push @taxlines, { + table => $table, + num => $pkey, + credit => $tax_credit, + }; + $taxtotal += $tax_credit; + + } #foreach cust_bill_pkg_tax_(rate_)?location + } + } # foreach $billpkgnum + + return ( + subtotal => sprintf('%.2f', $subtotal), + taxtotal => sprintf('%.2f', $taxtotal), + taxlines => \@taxlines, + ); +} + =item credit_lineitems Example: @@ -784,8 +880,11 @@ sub credit_lineitems { my %cust_credit_bill = (); my %cust_bill_pkg = (); my %cust_credit_bill_pkg = (); - my %taxlisthash = (); my %unapplied_payments = (); #invoice numbers, and then billpaynums + + # determine the tax adjustments + my %tax_adjust = $class->calculate_tax_adjustment(%arg); + foreach my $billpkgnum ( @{$arg{billpkgnums}} ) { my $setuprecur = shift @{$arg{setuprecurs}}; my $amount = shift @{$arg{amounts}}; @@ -799,22 +898,21 @@ sub credit_lineitems { my $invnum = $cust_bill_pkg->invnum; - if ( $setuprecur eq 'setup' ) { - $cust_bill_pkg->setup($amount); - $cust_bill_pkg->recur(0); - $cust_bill_pkg->unitrecur(0); - $cust_bill_pkg->type(''); - } else { - $setuprecur = 'recur'; #in case its a usage classnum? - $cust_bill_pkg->recur($amount); - $cust_bill_pkg->setup(0); - $cust_bill_pkg->unitsetup(0); - } - push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg; - #unapply any payments applied to this line item (other credits too?) - foreach my $cust_bill_pay_pkg ( $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) ) { + $cust_credit_bill{$invnum} += $amount; + push @{ $cust_credit_bill_pkg{$invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $billpkgnum, + 'amount' => sprintf('%.2f',$amount), + 'setuprecur' => $setuprecur, + 'sdate' => $cust_bill_pkg->sdate, + 'edate' => $cust_bill_pkg->edate, + }; + # unapply payments (but not other credits) from this line item + foreach my $cust_bill_pay_pkg ( + $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) + ) { $error = $cust_bill_pay_pkg->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -823,24 +921,49 @@ sub credit_lineitems { $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} += $cust_bill_pay_pkg->amount; } + } + + # do the same for taxes + foreach my $tax_credit ( @{ $tax_adjust{taxlines} } ) { + my $table = $tax_credit->{table}; + my $tax_link = "FS::$table"->by_key( $tax_credit->{num} ) + or die "tried to credit $table #$tax_credit->{num} but it doesn't exist"; - #$subtotal += $amount; + my $billpkgnum = $tax_link->billpkgnum; + my $cust_bill_pkg = qsearchs({ + 'table' => 'cust_bill_pkg', + 'hashref' => { 'billpkgnum' => $billpkgnum }, + 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)', + 'extra_sql' => 'AND custnum = '. $cust_main->custnum, + }) or die "unknown billpkgnum $billpkgnum"; + + my $invnum = $cust_bill_pkg->invnum; + push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg; + + my $amount = $tax_credit->{credit}; $cust_credit_bill{$invnum} += $amount; + + # create a credit application record to the tax line item, earmarked + # to the specific cust_bill_pkg_Xlocation push @{ $cust_credit_bill_pkg{$invnum} }, new FS::cust_credit_bill_pkg { - 'billpkgnum' => $cust_bill_pkg->billpkgnum, - 'amount' => sprintf('%.2f',$amount), - 'setuprecur' => $setuprecur, - 'sdate' => $cust_bill_pkg->sdate, - 'edate' => $cust_bill_pkg->edate, + 'billpkgnum' => $billpkgnum, + 'amount' => sprintf('%.2f', $amount), + 'setuprecur' => 'setup', + $tax_link->primary_key, $tax_credit->{num} }; - - # recalculate taxes with new amounts - $taxlisthash{$invnum} ||= {}; - if ( $cust_bill_pkg->pkgnum or $cust_bill_pkg->feepart ) { - $cust_main->_handle_taxes( $taxlisthash{$invnum}, $cust_bill_pkg ); - } # otherwise the item itself is a tax, and assume the caller knows - # what they're doing + # unapply any payments from the tax + foreach my $cust_bill_pay_pkg ( + $cust_bill_pkg->cust_bill_pay_pkg('setup') + ) { + $error = $cust_bill_pay_pkg->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error unapplying payment: $error"; + } + $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} + += $cust_bill_pay_pkg->amount; + } } ### @@ -852,115 +975,6 @@ sub credit_lineitems { foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) { - local $@; - my $arrayref_or_error = eval { $cust_main->calculate_taxes( - $cust_bill_pkg{$invnum}, # list of taxable items that we're crediting - $taxlisthash{$invnum}, # list of tax-item bindings - $cust_bill_pkg{$invnum}->[0]->cust_bill->_date, # invoice time - ) }; - - if ( $@ ) { - $dbh->rollback if $oldAutoCommit; - return "Error calculating taxes: $@"; - } - - my %tax_links; # {tax billpkgnum}{nontax billpkgnum} - - #taxes - foreach my $cust_bill_pkg ( @{ $cust_bill_pkg{$invnum} } ) { - my $billpkgnum = $cust_bill_pkg->billpkgnum; - my %hash = ( 'taxable_billpkgnum' => $billpkgnum ); - # gather up existing tax links (we need their billpkgtaxlocationnums) - my @tax_links = qsearch('cust_bill_pkg_tax_location', \%hash), - qsearch('cust_bill_pkg_tax_rate_location', \%hash); - - foreach ( @tax_links ) { - $tax_links{$_->billpkgnum} ||= {}; - $tax_links{$_->billpkgnum}{$_->taxable_billpkgnum} = $_; - } - } - - foreach my $taxline ( @$arrayref_or_error ) { - - my $amount = $taxline->setup; - - # find equivalent tax line item on the existing invoice - my $tax_item = qsearchs('cust_bill_pkg', { - 'invnum' => $invnum, - 'pkgnum' => 0, - 'itemdesc' => $taxline->desc, - }); - if (!$tax_item) { - # or should we just exit if this happens? - $cust_credit->set('amount', - sprintf('%.2f', $cust_credit->get('amount') - $amount) - ); - my $error = $cust_credit->replace; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error correcting credit for missing tax line: $error"; - } - } - - # but in the new era, we no longer have the problem of uniquely - # identifying the tax_Xlocation record. The billpkgnums of the - # tax and the taxed item are known. - foreach my $new_loc - ( @{ $taxline->get('cust_bill_pkg_tax_location') }, - @{ $taxline->get('cust_bill_pkg_tax_rate_location') } ) - { - # the existing tax_Xlocation object - my $old_loc = - $tax_links{$tax_item->billpkgnum}{$new_loc->taxable_cust_bill_pkg->billpkgnum}; - - next if !$old_loc; # apply the leftover amount nonspecifically - - #support partial credits: use $amount if smaller - # (so just distribute to the first location? perhaps should - # do so evenly...) - my $loc_amount = min( $amount, $new_loc->amount); - - $amount -= $loc_amount; - - $cust_credit_bill{$invnum} += $loc_amount; - push @{ $cust_credit_bill_pkg{$invnum} }, - new FS::cust_credit_bill_pkg { - 'billpkgnum' => $tax_item->billpkgnum, - 'amount' => $loc_amount, - 'setuprecur' => 'setup', - 'billpkgtaxlocationnum' => $old_loc->billpkgtaxlocationnum, - 'billpkgtaxratelocationnum' => $old_loc->billpkgtaxratelocationnum, - }; - - } #foreach my $new_loc - - # we still have to deal with the possibility that the tax links don't - # cover the whole amount of tax because of an incomplete upgrade... - if ($amount > 0.005) { - $cust_credit_bill{$invnum} += $amount; - push @{ $cust_credit_bill_pkg{$invnum} }, - new FS::cust_credit_bill_pkg { - 'billpkgnum' => $tax_item->billpkgnum, - 'amount' => sprintf('%.2f', $amount), - 'setuprecur' => 'setup', - }; - - } # if $amount > 0 - - #unapply any payments applied to the tax - foreach my $cust_bill_pay_pkg - ( $tax_item->cust_bill_pay_pkg('setup') ) - { - $error = $cust_bill_pay_pkg->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error unapplying payment: $error"; - } - $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} - += $cust_bill_pay_pkg->amount; - } - } #foreach $taxline - # if we unapplied any payments from line items, also unapply that # amount from the invoice foreach my $billpaynum (keys %{$unapplied_payments{$invnum}}) { diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm index a863e5df7..7f4aa9a79 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -68,7 +68,7 @@ Address line two (optional) =item city -City +City (if cust_main-no_city_in_address config is set when inserting, this will be forced blank) =item county @@ -152,6 +152,12 @@ sub find_or_insert { my @essential = (qw(custnum address1 address2 city county state zip country location_number location_type location_kind disabled)); + if ($conf->exists('cust_main-no_city_in_address')) { + warn "Warning: passed city to find_or_insert when cust_main-no_city_in_address is configured, ignoring it" + if $self->get('city'); + $self->set('city',''); + } + # I don't think this is necessary #if ( !$self->coord_auto and $self->latitude and $self->longitude ) { # push @essential, qw(latitude longitude); @@ -207,6 +213,12 @@ otherwise returns false. sub insert { my $self = shift; + if ($conf->exists('cust_main-no_city_in_address')) { + warn "Warning: passed city to insert when cust_main-no_city_in_address is configured, ignoring it" + if $self->get('city'); + $self->set('city',''); + } + if ( $self->censustract ) { $self->set('censusyear' => $conf->config('census_year') || 2012); } @@ -271,6 +283,10 @@ sub replace { my $self = shift; my $old = shift; $old ||= $self->replace_old; + + warn "Warning: passed city to replace when cust_main-no_city_in_address is configured" + if $conf->exists('cust_main-no_city_in_address') && $self->get('city'); + # the following fields are immutable foreach (qw(address1 address2 city state zip country)) { if ( $self->$_ ne $old->$_ ) { @@ -330,7 +346,9 @@ sub check { || $self->ut_textn('locationname') || $self->ut_text('address1') || $self->ut_textn('address2') - || $self->ut_text('city') + || ($conf->exists('cust_main-no_city_in_address') + ? $self->ut_textn('city') + : $self->ut_text('city')) || $self->ut_textn('county') || $self->ut_textn('state') || $self->ut_country('country') @@ -715,58 +733,6 @@ sub county_state_country { =back -=head1 CLASS METHODS - -=item in_county_sql OPTIONS - -Returns an SQL expression to test membership in a cust_main_county -geographic area. By default, this requires district, city, county, -state, and country to match exactly. Pass "ornull => 1" to allow -partial matches where some fields are NULL in the cust_main_county -record but not in the location. - -Pass "param => 1" to receive a parameterized expression (rather than -one that requires a join to cust_main_county) and a list of parameter -names in order. - -=cut - -sub in_county_sql { - # replaces FS::cust_pkg::location_sql - my ($class, %opt) = @_; - my $ornull = $opt{ornull} ? ' OR ? IS NULL' : ''; - my $x = $ornull ? 3 : 2; - my @fields = (('district') x 3, - ('city') x 3, - ('county') x $x, - ('state') x $x, - 'country'); - - my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text'; - - my @where = ( - "cust_location.district = ? OR ? = '' OR CAST(? AS $text) IS NULL", - "cust_location.city = ? OR ? = '' OR CAST(? AS $text) IS NULL", - "cust_location.county = ? OR (? = '' AND cust_location.county IS NULL) $ornull", - "cust_location.state = ? OR (? = '' AND cust_location.state IS NULL ) $ornull", - "cust_location.country = ?" - ); - my $sql = join(' AND ', map "($_)\n", @where); - if ( $opt{param} ) { - return $sql, @fields; - } - else { - # do the substitution here - foreach (@fields) { - $sql =~ s/\?/cust_main_county.$_/; - $sql =~ s/cust_main_county.$_ = ''/cust_main_county.$_ IS NULL/; - } - return $sql; - } -} - -=back - =head2 SUBROUTINES =over 4 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index f102d97ee..c636408d8 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -32,7 +32,7 @@ use Locale::Country; use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Cursor; -use FS::Misc qw( generate_email send_email generate_ps do_print ); +use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty ); use FS::Msgcat qw(gettext); use FS::CurrentUser; use FS::TicketSystem; @@ -4095,6 +4095,180 @@ my ($self,$field) = @_; } +=item payment_history + +Returns an array of hashrefs standardizing information from cust_bill, cust_pay, +cust_credit and cust_refund objects. Each hashref has the following fields: + +I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous' + +I<date> - value of _date field, unix timestamp + +I<date_pretty> - user-friendly date + +I<description> - user-friendly description of item + +I<amount> - impact of item on user's balance +(positive for Invoice/Refund/Line item, negative for Payment/Credit.) +Not to be confused with the native 'amount' field in cust_credit, see below. + +I<amount_pretty> - includes money char + +I<balance> - customer balance, chronologically as of this item + +I<balance_pretty> - includes money char + +I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types + +I<paid> - amount paid for cust_pay records, undef for other types + +I<credit> - amount credited for cust_credit records, undef for other types. +Literally the 'amount' field from cust_credit, renamed here to avoid confusion. + +I<refund> - amount refunded for cust_refund records, undef for other types + +The four table-specific keys always have positive values, whether they reflect charges or payments. + +The following options may be passed to this method: + +I<line_items> - if true, returns charges ('Line item') rather than invoices + +I<start_date> - unix timestamp, only include records on or after. +If specified, an item of type 'Previous' will also be included. +It does not have table-specific fields. + +I<end_date> - unix timestamp, only include records before + +I<reverse_sort> - order from newest to oldest (default is oldest to newest) + +I<conf> - optional already-loaded FS::Conf object. + +=cut + +# Caution: this gets used by FS::ClientAPI::MyAccount::billing_history, +# and also for sending customer statements, which should both be kept customer-friendly. +# If you add anything that shouldn't be passed on through the API or exposed +# to customers, add a new option to include it, don't include it by default +sub payment_history { + my $self = shift; + my $opt = ref($_[0]) ? $_[0] : { @_ }; + + my $conf = $$opt{'conf'} || new FS::Conf; + my $money_char = $conf->config("money_char") || '$', + + #first load entire history, + #need previous to calculate previous balance + #loading after end_date shouldn't hurt too much? + my @history = (); + if ( $$opt{'line_items'} ) { + + foreach my $cust_bill ( $self->cust_bill ) { + + push @history, { + 'type' => 'Line item', + 'description' => $_->desc( $self->locale ). + ( $_->sdate && $_->edate + ? ' '. time2str('%d-%b-%Y', $_->sdate). + ' To '. time2str('%d-%b-%Y', $_->edate) + : '' + ), + 'amount' => sprintf('%.2f', $_->setup + $_->recur ), + 'charged' => sprintf('%.2f', $_->setup + $_->recur ), + 'date' => $cust_bill->_date, + 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ), + } + foreach $cust_bill->cust_bill_pkg; + + } + + } else { + + push @history, { + 'type' => 'Invoice', + 'description' => 'Invoice #'. $_->display_invnum, + 'amount' => sprintf('%.2f', $_->charged ), + 'charged' => sprintf('%.2f', $_->charged ), + 'date' => $_->_date, + 'date_pretty' => $self->time2str_local('short', $_->_date ), + } + foreach $self->cust_bill; + + } + + push @history, { + 'type' => 'Payment', + 'description' => 'Payment', #XXX type + 'amount' => sprintf('%.2f', 0 - $_->paid ), + 'paid' => sprintf('%.2f', $_->paid ), + 'date' => $_->_date, + 'date_pretty' => $self->time2str_local('short', $_->_date ), + } + foreach $self->cust_pay; + + push @history, { + 'type' => 'Credit', + 'description' => 'Credit', #more info? + 'amount' => sprintf('%.2f', 0 -$_->amount ), + 'credit' => sprintf('%.2f', $_->amount ), + 'date' => $_->_date, + 'date_pretty' => $self->time2str_local('short', $_->_date ), + } + foreach $self->cust_credit; + + push @history, { + 'type' => 'Refund', + 'description' => 'Refund', #more info? type, like payment? + 'amount' => $_->refund, + 'refund' => $_->refund, + 'date' => $_->_date, + 'date_pretty' => $self->time2str_local('short', $_->_date ), + } + foreach $self->cust_refund; + + #put it all in chronological order + @history = sort { $a->{'date'} <=> $b->{'date'} } @history; + + #calculate balance, filter items outside date range + my $previous = 0; + my $balance = 0; + my @out = (); + foreach my $item (@history) { + last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'}); + $balance += $$item{'amount'}; + if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) { + $previous += $$item{'amount'}; + next; + } + $$item{'balance'} = sprintf("%.2f",$balance); + foreach my $key ( qw(amount balance) ) { + $$item{$key.'_pretty'} = money_pretty($$item{$key}); + } + push(@out,$item); + } + + # start with previous balance, if there was one + if ($previous) { + my $item = { + 'type' => 'Previous', + 'description' => 'Previous balance', + 'amount' => sprintf("%.2f",$previous), + 'balance' => sprintf("%.2f",$previous), + 'date' => $$opt{'start_date'}, + 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ), + }; + #false laziness with above + foreach my $key ( qw(amount balance) ) { + $$item{$key.'_pretty'} = $$item{$key}; + $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/; + } + unshift(@out,$item); + } + + @out = reverse @history if $$opt{'reverse_sort'}; + + return @out; +} + =back =head1 CLASS METHODS @@ -4507,6 +4681,8 @@ I<extra_fields> - a hashref of name/value pairs which will be substituted into the template. These values may override values mentioned below and those from the customer record. +I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text + The following variables are available in the template instead of or in addition to the fields of the customer record. @@ -4522,11 +4698,16 @@ I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or sub generate_letter { my ($self, $template, %options) = @_; - return unless $conf->exists($template); + warn "Template $template does not exist" && return + unless $conf->exists($template) || $options{'template_text'}; + + my $template_source = $options{'template_text'} + ? [ $options{'template_text'} ] + : [ map "$_\n", $conf->config($template) ]; my $letter_template = new Text::Template ( TYPE => 'ARRAY', - SOURCE => [ map "$_\n", $conf->config($template)], + SOURCE => $template_source, DELIMITERS => [ '[@--', '--@]' ], ) or die "can't create new Text::Template object: Text::Template::ERROR"; @@ -4641,7 +4822,9 @@ sub queueable_print { my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } ) or die "invalid customer number: " . $opt{custnum}; - my $error = $self->print( { 'template' => $opt{template} } ); +#do not backport this change to 3.x +# my $error = $self->print( { 'template' => $opt{template} } ); + my $error = $self->print( $opt{'template'} ); die $error if $error; } diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index f4c804568..0bc0fbd39 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -1107,6 +1107,14 @@ sub _make_lines { return "$@ running $method for $cust_pkg\n" if ( $@ ); + if ($recur eq 'NOTHING') { + # then calc_cancel (or calc_recur but that's not used) has declined to + # generate a recurring lineitem at all. treat this as zero, but also + # try not to generate a lineitem. + $recur = 0; + $lineitems--; + } + #base_cancel??? $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better @@ -1125,19 +1133,39 @@ sub _make_lines { # its frequency my $main_pkg_freq = $main_pkg->part_pkg->freq; my $supp_pkg_freq = $part_pkg->freq; - my $ratio = $supp_pkg_freq / $main_pkg_freq; - if ( $ratio != int($ratio) ) { + if ( $supp_pkg_freq == 0 or $main_pkg_freq == 0 ) { # the UI should prevent setting up packages like this, but just # in case - return "supplemental package period is not an integer multiple of main package period"; + return "unable to calculate supplemental package period ratio"; } - $next_bill = $sdate; - for (1..$ratio) { - $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq ); + my $ratio = $supp_pkg_freq / $main_pkg_freq; + if ( $ratio == int($ratio) ) { + # simple case: main package is X months, supp package is X*A months, + # advance supp package to where the main package will be in A cycles. + $next_bill = $sdate; + for (1..$ratio) { + $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq ); + } + } else { + # harder case: main package is X months, supp package is Y months. + # advance supp package by Y months. then if they're within half a + # month of each other, resync them. this may result in the period + # not being exactly Y months. + $next_bill = $part_pkg->add_freq( $sdate, $supp_pkg_freq ); + my $main_next_bill = $main_pkg->bill; + if ( $main_pkg->bill <= $time ) { + # then the main package has not yet been billed on this cycle; + # predict what its bill date will be. + $main_next_bill = + $part_pkg->add_freq( $main_next_bill, $main_pkg_freq ); + } + if ( abs($main_next_bill - $next_bill) < 86400*15 ) { + $next_bill = $main_next_bill; + } } } else { - # the normal case + # the normal case, not a supplemental package $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0); return "unparsable frequency: ". $part_pkg->freq if $next_bill == -1; @@ -2169,6 +2197,7 @@ sub due_cust_event { =item apply_payments_and_credits [ OPTION => VALUE ... ] Applies unapplied payments and credits. +Payments with the no_auto_apply flag set will not be applied. In most cases, this new method should be used in place of sequential apply_payments and apply_credits methods. @@ -2311,6 +2340,7 @@ sub apply_credits { Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>) to outstanding invoice balances in chronological order. +Payments with the no_auto_apply flag set will not be applied. #and returns the value of any remaining unapplied payments. @@ -2340,7 +2370,7 @@ sub apply_payments { #return 0 unless - my @payments = $self->unapplied_cust_pay; + my @payments = grep { !$_->no_auto_apply } $self->unapplied_cust_pay; my @invoices = $self->open_cust_bill; diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 8b4c98ad6..d135599a3 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -116,6 +116,10 @@ books closed flag, empty or `Y' Desired pkgnum when using experimental package balances. +=item no_auto_apply + +Flag to only allow manual application of payment, empty or 'Y' + =item bank The bank where the payment was deposited. @@ -539,6 +543,7 @@ sub check { || $self->ut_textn('paybatch') || $self->ut_textn('payunique') || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->ut_flag('no_auto_apply') || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') || $self->ut_textn('bank') || $self->ut_alphan('depositor') diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index 13b2eefe5..8f31e4dda 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -129,6 +129,8 @@ and replace methods. sub check { my $self = shift; + my $conf = new FS::Conf; + my $error = $self->ut_numbern('paybatchnum') || $self->ut_numbern('trancode') #deprecated @@ -137,7 +139,9 @@ sub check { || $self->ut_number('custnum') || $self->ut_text('address1') || $self->ut_textn('address2') - || $self->ut_text('city') + || ($conf->exists('cust_main-no_city_in_address') + ? $self->ut_textn('city') + : $self->ut_text('city')) || $self->ut_textn('state') ; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 91a5677f2..fbecd8d69 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -251,19 +251,53 @@ or contract_end timers to some number of months after the start date a delayed setup fee after a period of "free days", will also set the start date to the end of that period. +If the package has an automatic transfer rule (C<change_to_pkgnum>), then +this will also order the package and set its start date. + =cut sub set_initial_timers { my $self = shift; my $part_pkg = $self->part_pkg; + my $start = $self->start_date || $self->setup || time; + foreach my $action ( qw(expire adjourn contract_end) ) { - my $months = $part_pkg->option("${action}_months",1); + my $months = $part_pkg->get("${action}_months"); if($months and !$self->get($action)) { - my $start = $self->start_date || $self->setup || time; $self->set($action, $part_pkg->add_freq($start, $months) ); } } + # if this package has an expire date and a change_to_pkgpart, set automatic + # package transfer + # (but don't call change_later, as that would call $self->replace, and we're + # probably in the middle of $self->insert right now) + if ( $part_pkg->expire_months and $part_pkg->change_to_pkgpart ) { + if ( $self->change_to_pkgnum ) { + # this can happen if a package is ordered on hold, scheduled for a + # future change _while on hold_, and then released from hold, causing + # the automatic transfer to schedule. + # + # what's correct behavior in that case? I think it's to disallow + # future-changing an on-hold package that has an automatic transfer. + # but if we DO get into this situation, let the manual package change + # win. + warn "pkgnum ".$self->pkgnum.": manual future package change blocks ". + "automatic transfer.\n"; + } else { + my $change_to = FS::cust_pkg->new( { + start_date => $self->get('expire'), + pkgpart => $part_pkg->change_to_pkgpart, + map { $_ => $self->get($_) } + qw( custnum locationnum quantity refnum salesnum contract_end ) + } ); + my $error = $change_to->insert; + + return $error if $error; + $self->set('change_to_pkgnum', $change_to->pkgnum); + } + } + # if this package has "free days" and delayed setup fee, then # set start date that many days in the future. # (this should have been set in the UI, but enforce it here) @@ -273,6 +307,7 @@ sub set_initial_timers { { $self->start_date( $part_pkg->default_start_date ); } + ''; } @@ -332,9 +367,12 @@ a location change). sub insert { my( $self, %options ) = @_; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $error; $error = $self->check_pkgpart unless $options{'allow_pkgpart'}; - return $error if $error; my $part_pkg = $self->part_pkg; @@ -359,15 +397,12 @@ sub insert { $self->set('start_date', ''); } else { # set expire/adjourn/contract_end timers, and free days, if appropriate - $self->set_initial_timers; + # and automatic package transfer, which can fail, so capture the result + $error = $self->set_initial_timers; } } # else this is a package change, and shouldn't have "new package" behavior - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ()); + $error ||= $self->SUPER::insert($options{options} ? %{$options{options}} : ()); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -461,9 +496,26 @@ hide cancelled packages. =cut +# this is still used internally to abort future package changes, so it +# does need to work + sub delete { my $self = shift; + # The following foreign keys to cust_pkg are not cleaned up here, and will + # cause package deletion to fail: + # + # cust_credit.pkgnum and commission_pkgnum (and cust_credit_void) + # cust_credit_bill.pkgnum + # cust_pay_pending.pkgnum + # cust_pay.pkgnum (and cust_pay_void) + # cust_bill_pay.pkgnum (wtf, shouldn't reference pkgnum) + # cust_pkg_usage.pkgnum + # cust_pkg.uncancel_pkgnum, change_pkgnum, main_pkgnum, and change_to_pkgnum + + # cust_svc is handled by canceling the package before deleting it + # cust_pkg_option is handled via option_Common + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -499,7 +551,13 @@ sub delete { } } - #pkg_referral? + foreach my $pkg_referral ( $self->pkg_referral ) { + my $error = $pkg_referral->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } my $error = $self->SUPER::delete(@_); if ( $error ) { @@ -807,12 +865,15 @@ sub cancel { my( $self, %options ) = @_; my $error; - # pass all suspend/cancel actions to the main package - # (unless the pkglinknum has been removed, then the link is defunct and - # this package can be canceled on its own) - if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) { - return $self->main_pkg->cancel(%options); - } + # supplemental packages can now be separately canceled, though the UI + # shouldn't permit it + # + ## pass all suspend/cancel actions to the main package + ## (unless the pkglinknum has been removed, then the link is defunct and + ## this package can be canceled on its own) + #if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) { + # return $self->main_pkg->cancel(%options); + #} my $conf = new FS::Conf; @@ -936,8 +997,14 @@ sub cancel { $hash{main_pkgnum} = ''; } + # if there is a future package change scheduled, unlink from it (like + # abort_change) first, then delete it. + $hash{'change_to_pkgnum'} = ''; + + # save the package state my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); + if ( $self->change_to_pkgnum ) { my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum); $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete; @@ -1285,9 +1352,13 @@ sub suspend { my( $self, %options ) = @_; my $error; - # pass all suspend/cancel actions to the main package + # supplemental packages still can't be separately suspended, but silently + # exit instead of failing or passing the action to the main package (so + # that the "Suspend customer" action doesn't trip over the supplemental + # packages and die) + if ( $self->main_pkgnum and !$options{'from_main'} ) { - return $self->main_pkg->suspend(%options); + return; } my $oldAutoCommit = $FS::UID::AutoCommit; @@ -1659,7 +1730,11 @@ sub unsuspend { if (!$self->setup) { # then this package is being released from on-hold status - $self->set_initial_timers; + $error = $self->set_initial_timers; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } my @labels = (); @@ -1943,6 +2018,13 @@ can't be transferred (also see the I<cust_pkg-change_svcpart> config option). If unprotect_svcs is true, this method will transfer as many services as it can and then unconditionally cancel the old package. +=item contract_end + +If specified, sets this value for the contract_end date on the new package +(without regard for keep_dates or the usual date-preservation behavior.) +Will throw an error if defined but false; the UI doesn't allow editing +this unless it already exists, making removal impossible to undo. + =back At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or @@ -1956,6 +2038,33 @@ For example: =cut +#used by change and change_later +#didn't put with documented check methods because it depends on change-specific opts +#and it also possibly edits the value of opts +sub _check_change { + my $self = shift; + my $opt = shift; + if ( defined($opt->{'contract_end'}) ) { + my $current_contract_end = $self->get('contract_end'); + unless ($opt->{'contract_end'}) { + if ($current_contract_end) { + return "Cannot remove contract end date when changing packages"; + } else { + #shouldn't even pass this option if there's not a current value + #but can be handled gracefully if the option is empty + warn "Contract end date passed unexpectedly"; + delete $opt->{'contract_end'}; + return ''; + } + } + unless ($current_contract_end) { + #option shouldn't be passed, throw error if it's non-empty + return "Cannot add contract end date when changing packages " . $self->pkgnum; + } + } + return ''; +} + #some false laziness w/order sub change { my $self = shift; @@ -1963,13 +2072,21 @@ sub change { my $conf = new FS::Conf; + # handle contract_end on cust_pkg same as passed option + if ( $opt->{'cust_pkg'} ) { + $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end; + delete $opt->{'contract_end'} unless $opt->{'contract_end'}; + } + + # check contract_end, prevent adding/removing + my $error = $self->_check_change($opt); + return $error if $error; + # Transactionize this whole mess my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error; - if ( $opt->{'cust_location'} ) { $error = $opt->{'cust_location'}->find_or_insert; if ( $error ) { @@ -1992,9 +2109,12 @@ sub change { # almost. if the new pkgpart specifies start/adjourn/expire timers, # apply those. if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) { - $self->set_initial_timers; + $error ||= $self->set_initial_timers; } - $error = $self->replace; + # but if contract_end was explicitly specified, that overrides all else + $self->set('contract_end', $opt->{'contract_end'}) + if $opt->{'contract_end'}; + $error ||= $self->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "modifying package: $error"; @@ -2051,6 +2171,9 @@ sub change { start_date contract_end)) { $hash{$date} = $self->getfield($date); } + # but if contract_end was explicitly specified, that overrides all else + $hash{'contract_end'} = $opt->{'contract_end'} + if $opt->{'contract_end'}; # allow $opt->{'locationnum'} = '' to specifically set it to null # (i.e. customer default location) @@ -2339,8 +2462,10 @@ The date for the package change. Required, and must be in the future. =item quantity -The pkgpart. locationnum, and quantity of the new package, with the same -meaning as in C<change>. +=item contract_end + +The pkgpart, locationnum, quantity and optional contract_end of the new +package, with the same meaning as in C<change>. =back @@ -2350,6 +2475,10 @@ sub change_later { my $self = shift; my $opt = ref($_[0]) ? shift : { @_ }; + # check contract_end, prevent adding/removing + my $error = $self->_check_change($opt); + return $error if $error; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -2363,8 +2492,6 @@ sub change_later { return "start_date $date is in the past"; } - my $error; - if ( $self->change_to_pkgnum ) { my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum); my $new_pkgpart = $opt->{'pkgpart'} @@ -2373,7 +2500,9 @@ sub change_later { if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum; my $new_quantity = $opt->{'quantity'} if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity; - if ( $new_pkgpart or $new_locationnum or $new_quantity ) { + my $new_contract_end = $opt->{'contract_end'} + if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end; + if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) { # it hasn't been billed yet, so in principle we could just edit # it in place (w/o a package change), but that's bad form. # So change the package according to the new options... @@ -2388,8 +2517,10 @@ sub change_later { $error = $self->replace || $err_or_pkg->replace || - $change_to->cancel('no_delay_cancel' => 1) || - $change_to->delete; + #because change() might've edited existing scheduled change in place + (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' : + $change_to->cancel('no_delay_cancel' => 1) || + $change_to->delete); } else { $error = $err_or_pkg; } @@ -2413,8 +2544,10 @@ sub change_later { if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum; my $new_quantity = $opt->{'quantity'} if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity; + my $new_contract_end = $opt->{'contract_end'} + if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end; - return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything + return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything # allow $opt->{'locationnum'} = '' to specifically set it to null # (i.e. customer default location) @@ -2425,7 +2558,7 @@ sub change_later { locationnum => $opt->{'locationnum'}, start_date => $date, map { $_ => ( $opt->{$_} || $self->$_() ) } - qw( pkgpart quantity refnum salesnum ) + qw( pkgpart quantity refnum salesnum contract_end ) } ); $error = $new->insert('change' => 1, 'allow_pkgpart' => ($new_pkgpart ? 0 : 1)); @@ -2451,16 +2584,28 @@ Cancels a future package change scheduled by C<change_later>. sub abort_change { my $self = shift; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $pkgnum = $self->change_to_pkgnum; my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum; my $error; - if ( $change_to ) { - $error = $change_to->cancel || $change_to->delete; - return $error if $error; - } $self->set('change_to_pkgnum', ''); $self->set('expire', ''); - $self->replace; + $error = $self->replace; + if ( $change_to ) { + $error ||= $change_to->cancel || $change_to->delete; + } + + if ( $oldAutoCommit ) { + if ( $error ) { + dbh->rollback; + } else { + dbh->commit; + } + } + + return $error; } =item set_quantity QUANTITY diff --git a/FS/FS/invoice_conf.pm b/FS/FS/invoice_conf.pm index da448b816..d88c89a7c 100644 --- a/FS/FS/invoice_conf.pm +++ b/FS/FS/invoice_conf.pm @@ -49,6 +49,8 @@ and supports the FS::Conf interface. The following fields are supported: =item htmlreturnaddress - return address (HTML) +=item htmlwatermark - watermark to show in background (HTML) + =item latexnotes - "notes" section (LaTeX) =item latexfooter - footer (LaTeX) @@ -59,6 +61,8 @@ and supports the FS::Conf interface. The following fields are supported: =item latexsmallfooter - footer for pages after the first (LaTeX) +=item latexwatermark - watermark to show in background (LaTeX) + =item with_latexcoupon - 'Y' to print the payment coupon (LaTeX) =item lpr - command to print the invoice (passed on stdin as a PDF) @@ -185,11 +189,13 @@ sub check { || $self->ut_anything('htmlfooter') || $self->ut_anything('htmlsummary') || $self->ut_anything('htmlreturnaddress') + || $self->ut_anything('htmlwatermark') || $self->ut_anything('latexnotes') || $self->ut_anything('latexfooter') || $self->ut_anything('latexsummary') || $self->ut_anything('latexsmallfooter') || $self->ut_anything('latexreturnaddress') + || $self->ut_anything('latexwatermark') # flags || $self->ut_flag('with_latexcoupon') ; diff --git a/FS/FS/part_export/broadworks.pm b/FS/FS/part_export/broadworks.pm index 59668672c..a04a70e9b 100644 --- a/FS/FS/part_export/broadworks.pm +++ b/FS/FS/part_export/broadworks.pm @@ -41,7 +41,8 @@ number, this requires a svc_phone definition and a part_device. The "title" field ("external name") of the part_device must be one of the access device type names recognized by BroadWorks, such as "Polycom Soundpoint IP 550", "SNOM 320", or "Generic SIP Phone".</P> -<P> +<P>Each phone service must have a device linked before it will be functional. +Until then, authentication will be denied.</P> END ); @@ -85,6 +86,11 @@ sub export_replace { newUserId => $newUserId ); return $message if !$success; + + if ( my $device = qsearchs('phone_device', { svcnum => $svc_new->svcnum }) ) { + # there's a Line/Port configured for the device, and it also needs to be renamed. + $error ||= $self->set_endpoint( $newUserId, $self->deviceName($device) ); + } } if ( $svc_old->phonenum ne $svc_new->phonenum ) { diff --git a/FS/FS/part_export/cacti.pm b/FS/FS/part_export/cacti.pm index eff6c5220..7de97946c 100644 --- a/FS/FS/part_export/cacti.pm +++ b/FS/FS/part_export/cacti.pm @@ -217,7 +217,7 @@ sub ssh_insert { # $desc =~ s/'/'\\''/g; $desc =~ s/'//g; my $cmd = $php - . $opt{'script_path'} + . trailslash($opt{'script_path'}) . q(add_device.php --description=') . $desc . q(' --ip=') @@ -233,7 +233,7 @@ sub ssh_insert { # Add host to tree if ($opt{'tree_id'}) { $cmd = $php - . $opt{'script_path'} + . trailslash($opt{'script_path'}) . q(add_tree.php --type=node --node-type=host --tree-id=) . $opt{'tree_id'} . q( --host-id=) @@ -246,7 +246,7 @@ sub ssh_insert { # Get list of graph templates for new id $cmd = $php - . $opt{'script_path'} + . trailslash($opt{'script_path'}) . q(freeside_cacti.php --get-graph-templates --host-template=) . $opt{'template_id'}; my $ginfo = { map { $_ ? ($_ => undef) : () } split(/\n/,ssh_cmd(%opt, 'command' => $cmd)) }; @@ -301,7 +301,7 @@ sub ssh_insert { # create the graph $cmd = $php - . $opt{'script_path'} + . trailslash($opt{'script_path'}) . q(add_graphs.php --graph-type=) . ($isds ? 'ds' : 'cg') . q( --graph-template-id=) @@ -335,7 +335,7 @@ sub ssh_insert { sub ssh_delete { my %opt = @_; my $cmd = $php - . $opt{'script_path'} + . trailslash($opt{'script_path'}) . q(freeside_cacti.php --drop-device --ip=') . $opt{'hostname'} . q('); @@ -367,7 +367,7 @@ sub process_graphs { my ($job,$param) = @_; $job->update_statustext(10); - my $cachedir = $FS::UID::cache_dir . '/cacti-graphs/'; + my $cachedir = trailslash($FS::UID::cache_dir,'cache.'.$FS::UID::datasrc,'cacti-graphs'); # load the service my $svcnum = $param->{'svcnum'} || die "No svcnum specified"; @@ -413,7 +413,7 @@ sub process_graphs { # get list of graphs for this svc from cacti server my $cmd = $php - . $self->option('script_path') + . trailslash($self->option('script_path')) . q(freeside_cacti.php --get-graphs --ip=') . $svc->ip_addr . q('); @@ -432,7 +432,9 @@ sub process_graphs { 'rsh' => 'ssh', 'verbose' => 1, 'recursive' => 1, - 'source' => $self->option('graphs_path'), + 'quote-src' => 1, + 'quote-dst' => 1, + 'source' => trailslash($self->option('graphs_path')), 'dest' => $cachedir, 'include' => [ (map { q('**graph_).${$_}[0].q(*.png') } @graphs), @@ -442,8 +444,9 @@ sub process_graphs { ], }); #don't know why a regular $rsync->exec isn't doing includes right, but this does - my $error = system(join(' ',@{$rsync->getcmd()})); - die "rsync failed with exit status $error" if $error; + my $rscmd = join(' ',@{$rsync->getcmd()}); + my $error = system($rscmd); + die "rsync ($rscmd) failed with exit status $error" if $error; $job->update_statustext(50); @@ -490,8 +493,12 @@ sub process_graphs { $dbh->rollback if $oldAutoCommit; die $error; } + } else { + $svchtml .= qq(<P STYLE="color: #FF0000">File $thumbfile is too large, skipping</P>); } unlink($thumbfile); + } else { + $svchtml .= qq(<P STYLE="color: #FF0000">File $thumbfile does not exist, skipping</P>); } $job->update_statustext(49 + int($i / @graphs) * 50); } @@ -547,6 +554,19 @@ sub ssh_cmd { return $output; } +#there's probably a better place to put this? +#makes sure there's a trailing slash between/after input +#doesn't add leading slashes +sub trailslash { + my @paths = @_; + my $out = ''; + foreach my $path (@paths) { + $out .= $path; + $out .= '/' unless $out =~ /\/$/; + } + return $out; +} + =head1 METHODS =over 4 diff --git a/FS/FS/part_export/print_template.pm b/FS/FS/part_export/print_template.pm new file mode 100644 index 000000000..b299ab493 --- /dev/null +++ b/FS/FS/part_export/print_template.pm @@ -0,0 +1,199 @@ +package FS::part_export::print_template; + +use strict; + +use base qw( FS::part_export ); + +use FS::Record qw(qsearchs); +use FS::Misc; +use FS::queue; + +=pod + +=head1 NAME + +FS::part_export::print_template + +=head1 SYNOPSIS + +Print a document of a template. + +=head1 DESCRIPTION + +See the L<Text::Template> documentation and the billing documentation for details on the template substitution language. + +Currently does not support printing during replace. + +=cut + +use vars qw( %info ); + +tie my %options, 'Tie::IxHash', + 'phase' => { label => 'Print during', + type => 'select', + options => [qw(insert delete suspend unsuspend)] }, + 'template_text' => { label => 'Template text', + type => 'textarea' }, +; + +%info = ( + #unfortunately, FS::part_svc->svc_tables fails at this point, not sure why + 'svc' => [ qw( svc_acct svc_domain svc_cert svc_forward svc_mailinglist svc_www + svc_broadband svc_cable svc_dsl svc_conferencing svc_video svc_dish + svc_hardware svc_phone svc_pbx svc_circuit svc_port svc_alarm svc_external ) + ], + 'desc' => 'Print document during service change, for all services', + 'options' => \%options, + 'no_machine' => 1, + 'notes' => <<'EOF', +Will use the print command configured by the lpr setting. +See the <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation and the billing documentation for details on the template substitution language. +Fields from the customer and service records are available for substitution, as well as the following fields: + +<ul> +<li>$payby - a friendler represenation of the field</li> +<li>$payinfo - the masked payment information</li> +<li>$expdate - the time at which the payment method expires (a UNIX timestamp)</li> +<li>$returnaddress - the invoice return address for this customer's agent</li> +<li>$logo_file - the image stored in the logo.eps setting +</ul> +EOF +); + +=head1 Hook Methods + +Each of these simply invoke this module's L<print_template> method, +passing the appropriate phase. + +=cut + +=head2 _export_insert + +Hook that is called when service is initially provisioned. +To avoid confusion, don't use for anything else. + +=cut + +sub _export_insert { + my $self = shift; + return $self->print_template('insert',@_); +} + +=head2 _export_delete + +Hook that is called when service is unprovisioned. +To avoid confusion, don't use for anything else. + +=cut + +sub _export_delete { + my $self = shift; + return $self->print_template('delete',@_); +} + +=head2 _export_replace + +Hook that is called when provisioned service is edited. +To avoid confusion, don't use for anything else. + +Currently not supported for this export. + +=cut + +sub _export_replace { + return ''; +} + +=head2 _export_suspend + +Hook that is called when service is suspended. +To avoid confusion, don't use for anything else. + +=cut + +sub _export_suspend { + my $self = shift; + return $self->print_template('suspend',@_); +} + +=head2 _export_unsuspend + +Hook that is called when service is unsuspended. +To avoid confusion, don't use for anything else. + +=cut + +sub _export_unsuspend { + my $self = shift; + return $self->print_template('unsuspend',@_); +} + +=head1 Core Methods + +=head2 print_template + +Accepts $phase and $svc_x. +If phase matches the configured option, starts a L</process_print_template> +job in the queue. + +=cut + +sub print_template { + my ($self, $phase, $svc_x) = @_; + if ($self->option('phase') eq $phase) { + my $queue = new FS::queue { + 'svcnum' => $svc_x->svcnum, + 'job' => 'FS::part_export::print_template::process_print_template', + }; + my $error = $queue->insert( + 'svcnum' => $svc_x->svcnum, + 'table' => $svc_x->table, + 'template_text' => $self->option('template_text'), + ); + return "can't start print job: $error" if $error; + } + return ''; +} + +=head2 process_print_template + +For use as an FS::queue job. Requires opts svcnum, table and template_text. +Constructs page from template and sends to printer. + +=cut + +sub process_print_template { + my %opt = @_; + + my $svc_x = qsearchs($opt{'table'}, { 'svcnum' => $opt{'svcnum'} } ) + or die "invalid " . $opt{'table'} . " svcnum " . $opt{'svcnum'}; + my $cust_main = $svc_x->cust_svc->cust_pkg->cust_main + or die "could not find customer for service"; + + my $ps = $cust_main->print_ps(undef, + 'template_text' => $opt{'template_text'}, + 'extra_fields' => { + map { $_ => $svc_x->$_ } $svc_x->fields, + }, + ); + my $error = FS::Misc::do_print( + [ $ps ], + 'agentnum' => $cust_main->agentnum, + ); + die $error if $error; +} + +=head1 SEE ALSO + +L<FS::part_export> + +=head1 AUTHOR + +Jonathan Prykop +jonathan@freeside.biz + +=cut + +1; + + diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index d1387d636..048a24485 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -10,6 +10,7 @@ use FS::svc_acct; use FS::export_svc; use Carp qw( cluck ); use NEXT; +use Net::OpenSSH; @ISA = qw(FS::part_export); @EXPORT_OK = qw( sqlradius_connect ); @@ -73,6 +74,16 @@ tie %options, 'Tie::IxHash', type => 'checkbox', label => 'Export RADIUS group attributes to this database', }, + 'disconnect_ssh' => { + label => 'To send a disconnection request to each RADIUS client when modifying, suspending or deleting an account, enter a ssh connection string (username@host) with access to the radclient program', + }, + 'disconnect_port' => { + label => 'Port to send disconnection requests to, default 1700', + }, + 'disconnect_ignore_error' => { + label => 'Ignore disconnection request errors', + type => 'checkbox', + }, ; $notes1 = <<'END'; @@ -241,7 +252,7 @@ sub _export_replace { my $error; my (@oldgroups) = $old->radius_groups('hashref'); my (@newgroups) = $new->radius_groups('hashref'); - $error = $self->sqlreplace_usergroups( $new->svcnum, + ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum, $self->export_username($new), $jobnum ? $jobnum : '', \@oldgroups, @@ -252,6 +263,28 @@ sub _export_replace { return $error; } + # radius database is used for authorization, so to avoid users reauthorizing + # before the database changes, disconnect users after changing database + if ($self->option('disconnect_ssh')) { + my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect', + 'disconnect_ssh' => $self->option('disconnect_ssh'), + 'svc_acct_username' => $old->username, + 'disconnect_port' => $self->option('disconnect_port'), + 'ignore_error' => $self->option('disconnect_ignore_error'), + ); + 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; ''; @@ -274,6 +307,8 @@ sub _export_suspend { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $jobnum = ''; + my @newgroups = $self->suspended_usergroups($svc_acct); unless (@newgroups) { #don't change password if assigning to a suspended group @@ -284,10 +319,11 @@ sub _export_suspend { $dbh->rollback if $oldAutoCommit; return $err_or_queue; } - + $jobnum = $err_or_queue->jobnum; } - my $error = + my $error; + ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum, $self->export_username($new), @@ -299,6 +335,28 @@ sub _export_suspend { $dbh->rollback if $oldAutoCommit; return $error; } + + # radius database is used for authorization, so to avoid users reauthorizing + # before the database changes, disconnect users after changing database + if ($self->option('disconnect_ssh')) { + my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect', + 'disconnect_ssh' => $self->option('disconnect_ssh'), + 'svc_acct_username' => $svc_acct->username, + 'disconnect_port' => $self->option('disconnect_port'), + ); + 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; ''; @@ -345,9 +403,30 @@ sub _export_unsuspend { sub _export_delete { my( $self, $svc_x ) = (shift, shift); + + my $jobnum = ''; + my $usergroup = $self->option('usergroup') || 'usergroup'; my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete', $self->export_username($svc_x), $usergroup ); + $jobnum = $err_or_queue->jobnum; + + # radius database is used for authorization, so to avoid users reauthorizing + # before the database changes, disconnect users after changing database + if ($self->option('disconnect_ssh')) { + my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'user_disconnect', + 'disconnect_ssh' => $self->option('disconnect_ssh'), + 'svc_acct_username' => $svc_x->username, + 'disconnect_port' => $self->option('disconnect_port'), + 'ignore_error' => $self->option('disconnect_ignore_error'), + ); + return $err_or_queue unless ref($err_or_queue); + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + return $error if $error; + } + } + ref($err_or_queue) ? '' : $err_or_queue; } @@ -540,6 +619,8 @@ sub sqlradius_connect { DBI->connect(@_) or die $DBI::errstr; } +# on success, returns '' in scalar context, ('',$jobnum) in list context +# on error, always just returns error sub sqlreplace_usergroups { my ($self, $svcnum, $username, $jobnum, $old, $new) = @_; @@ -581,8 +662,9 @@ sub sqlreplace_usergroups { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } - ''; + wantarray ? ('',$jobnum) : ''; } @@ -1164,6 +1246,58 @@ sub sqlradius_group_replace { or die $dbh->errstr; } +=item sqlradius_user_disconnect + +For a specified user, sends a disconnect request to all nas in the server database. + +Accepts L</sqlradius_connect> connection input and the following named parameters: + +I<disconnect_ssh> - user@host with access to radclient program (required) + +I<svc_acct_username> - the user to be disconnected (required) + +I<disconnect_port> - the port (on the nas) to send disconnect requests to (defaults to 1700) + +I<ignore_error> - do not die on error with the disconnect request + +Note this is NOT the opposite of sqlradius_connect. + +=cut + +sub sqlradius_user_disconnect { + my $dbh = sqlradius_connect(shift, shift, shift); + my %opt = @_; + # get list of nas + my $sth = $dbh->prepare('select nasname, secret from nas') or die $dbh->errstr; + $sth->execute() or die $dbh->errstr; + my $nas = $sth->fetchall_arrayref({}); + $sth->finish(); + $dbh->disconnect(); + die "No nas found in radius db" unless @$nas; + # set up ssh connection + my $ssh = Net::OpenSSH->new($opt{'disconnect_ssh'}); + die "Couldn't establish SSH connection: " . $ssh->error + if $ssh->error; + # send individual disconnect requests + my $user = $opt{'svc_acct_username'}; #svc_acct username + my $port = $opt{'disconnect_port'} || 1700; #or should we pull this from the db? + my $error = ''; + foreach my $nas (@$nas) { + my $nasname = $nas->{'nasname'}; + my $secret = $nas->{'secret'}; + my $command = qq(echo "User-Name=$user" | radclient -r 1 $nasname:$port disconnect '$secret'); + my ($output, $errput) = $ssh->capture2($command); + $error .= "Error running $command: $errput " . $ssh->error . " " + if $errput || $ssh->error; + } + $error .= "Some clients may have successfully disconnected" + if $error && (@$nas > 1); + $error = "No clients found" + unless @$nas; + die $error if $error && !$opt{'ignore_error'}; + return ''; +} + ### # class method to fetch groups/attributes from the sqlradius install on upgrade ### diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 4407ec6dd..498da8a2b 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -127,6 +127,18 @@ part_pkg, will be equal to pkgpart. ordered. The package will not start billing or have a setup fee charged until it is manually unsuspended. +=item change_to_pkgpart - When this package is ordered, schedule a future +package change. The 'expire_months' field will determine when the package +change occurs. + +=item expire_months - Number of months until this package expires (or changes +to another package). + +=item adjourn_months - Number of months until this package becomes suspended. + +=item contract_end_months - Number of months until the package's contract +ends. + =back =head1 METHODS @@ -722,6 +734,11 @@ sub check { || $self->ut_numbern('delay_start') || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart') || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart') + || $self->ut_numbern('expire_months') + || $self->ut_numbern('adjourn_months') + || $self->ut_numbern('contract_end_months') + || $self->ut_numbern('change_to_pkgpart') + || $self->ut_foreign_keyn('change_to_pkgpart', 'part_pkg', 'pkgpart') || $self->ut_alphan('agent_pkgpartid') || $self->SUPER::check ; @@ -1392,6 +1409,11 @@ sub option { my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); } split("\n", $self->get('plandata') ); return $plandata{$opt} if exists $plandata{$opt}; + + # check whether the option is defined in plan info (if so, don't warn) + if (exists $plans{ $self->plan }->{fields}->{$opt}) { + return ''; + } cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ". "not found in options or plandata!\n" unless $ornull; @@ -1691,6 +1713,19 @@ for this package. Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for this package. +=item change_to_pkg + +Returns the automatic transfer target for this package, or an empty string +if there isn't one. + +=cut + +sub change_to_pkg { + my $self = shift; + my $pkgpart = $self->change_to_pkgpart or return ''; + FS::part_pkg->by_key($pkgpart); +} + =item _rebless Reblesses the object into the FS::part_pkg::PLAN class (if available), where @@ -2197,6 +2232,19 @@ sub queueable_upgrade { FS::upgrade_journal->set_done($upgrade); } + # migrate adjourn_months, expire_months, and contract_end_months to + # real fields + foreach my $field (qw(adjourn_months expire_months contract_end_months)) { + foreach my $option (qsearch('part_pkg_option', { optionname => $field })) { + my $part_pkg = $option->part_pkg; + my $error = $option->delete; + if ( $option->optionvalue and $part_pkg->get($field) eq '' ) { + $part_pkg->set($field, $option->optionvalue); + $error ||= $part_pkg->replace; + } + die $error if $error; + } + } } =item curuser_pkgs_sql diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm index 930966a94..d11b99b1a 100644 --- a/FS/FS/part_pkg/flat.pm +++ b/FS/FS/part_pkg/flat.pm @@ -34,16 +34,6 @@ tie my %contract_years, 'Tie::IxHash', ( 'select_options' => \%temporalities, }, - #used in cust_pkg.pm so could add to any price plan - 'expire_months' => { 'name' => 'Auto-add an expiration date this number of months out', - }, - 'adjourn_months'=> { 'name' => 'Auto-add a suspension date this number of months out', - }, - 'contract_end_months'=> { - 'name' => 'Auto-add a contract end date this number of years out', - 'type' => 'select', - 'select_options' => \%contract_years, - }, #used in cust_pkg.pm so could add to any price plan where it made sense 'start_1st' => { 'name' => 'Auto-add a start date to the 1st, ignoring the current month.', 'type' => 'checkbox', @@ -85,8 +75,6 @@ tie my %contract_years, 'Tie::IxHash', ( }, }, 'fieldorder' => [ qw( recur_temporality - expire_months adjourn_months - contract_end_months start_1st sync_bill_date prorate_defer_bill prorate_round_day suspend_bill unsuspend_adjust_bill @@ -220,13 +208,13 @@ sub calc_cancel { and $self->option('bill_recur_on_cancel', 1) ) { # run another recurring cycle return $self->calc_recur(@_); - } - elsif ( $conf->exists('bill_usage_on_cancel') # should be a package option? + } elsif ( $conf->exists('bill_usage_on_cancel') # should be a package option? and $self->can('calc_usage') ) { # bill for outstanding usage return $self->calc_usage(@_); + } else { + return 'NOTHING'; # numerically zero, but has special meaning } - 0; } sub calc_remain { diff --git a/FS/FS/part_pkg_link.pm b/FS/FS/part_pkg_link.pm index ce071ef17..5fe6f2f01 100644 --- a/FS/FS/part_pkg_link.pm +++ b/FS/FS/part_pkg_link.pm @@ -250,12 +250,10 @@ sub check { my $dst_pkg = $self->dst_pkg; if ( $src_pkg->freq eq '0' and $dst_pkg->freq ne '0' ) { return "One-time charges can't have supplemental packages." - } elsif ( $dst_pkg->freq ne '0' ) { - my $ratio = $dst_pkg->freq / $src_pkg->freq; - if ($ratio != int($ratio)) { - return "Supplemental package period (pkgpart ".$dst_pkg->pkgpart. - ") must be an integer multiple of main package period."; - } + } elsif ( $dst_pkg->freq == 0 ) { + return "The billing period of a supplemental package must be a whole number of months."; + } elsif ( $src_pkg->freq == 0 ) { + return "To have supplemental packages, the billing period of a package must be a whole number of months."; } } diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index a7628f6e0..df969a00f 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -209,7 +209,9 @@ foreach my $INC (@INC) { =item import_results OPTION => VALUE, ... -Import batch results. +Import batch results. Can be called as an instance method, if you want to +automatically adjust status on a specific batch, or a class method, if you +don't know which batch(es) the results apply to. Options are: @@ -280,6 +282,8 @@ sub import_results { my $declined_condition = $info->{'declined'}; my $close_condition = $info->{'close_condition'}; + my %target_batches; # batches that had at least one payment updated + my $csv = new Text::CSV_XS; local $SIG{HUP} = 'IGNORE'; @@ -293,13 +297,17 @@ sub import_results { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $reself = $self->select_for_update; + if ( ref($self) ) { + # if called on a specific pay_batch, check the status of that batch + # before continuing + my $reself = $self->select_for_update; - if ( $reself->status ne 'I' - and !$conf->exists('batch-manual_approval') ) { - $dbh->rollback if $oldAutoCommit; - return "batchnum ". $self->batchnum. "no longer in transit"; - } + if ( $reself->status ne 'I' + and !$conf->exists('batch-manual_approval') ) { + $dbh->rollback if $oldAutoCommit; + return "batchnum ". $self->batchnum. "no longer in transit"; + } + } # otherwise we can't enforce this constraint. sorry. my $total = 0; my $line; @@ -345,6 +353,7 @@ sub import_results { push @all_values, \@values; } elsif ($filetype eq 'variable') { + # no longer used my @values = ( eval { $parse->($self, $line) } ); if( $@ ) { $dbh->rollback if $oldAutoCommit; @@ -404,6 +413,9 @@ sub import_results { unless ( $cust_pay_batch ) { return "unknown paybatchnum $hash{'paybatchnum'}\n"; } + # remember that we've touched this batch + $target_batches{ $cust_pay_batch->batchnum } = 1; + my $custnum = $cust_pay_batch->custnum, my $payby = $cust_pay_batch->payby, @@ -443,21 +455,25 @@ sub import_results { } # foreach (@all_values) - my $close = 1; - if ( defined($close_condition) ) { - # Allow the module to decide whether to close the batch. - # $close_condition can also die() to abort the whole import. - $close = eval { $close_condition->($self) }; - if ( $@ ) { - $dbh->rollback; - die $@; + # decide whether to close batches that had payments posted + foreach my $batchnum (keys %target_batches) { + my $pay_batch = FS::pay_batch->by_key($batchnum); + my $close = 1; + if ( defined($close_condition) ) { + # Allow the module to decide whether to close the batch. + # $close_condition can also die() to abort the whole import. + $close = eval { $close_condition->($pay_batch) }; + if ( $@ ) { + $dbh->rollback; + die $@; + } } - } - if ( $close ) { - my $error = $self->set_status('R'); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + if ( $close ) { + my $error = $pay_batch->set_status('R'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } } diff --git a/FS/FS/pay_batch/nacha.pm b/FS/FS/pay_batch/nacha.pm index c8d784d70..befba09a2 100644 --- a/FS/FS/pay_batch/nacha.pm +++ b/FS/FS/pay_batch/nacha.pm @@ -47,7 +47,12 @@ $DEBUG = 0; my $origin = $1; my $company = $conf->config('company_name', $pay_batch->agentnum); - $company = substr(uc($company). (' 'x23), 0, 23); + + my $origin_name = $conf->config('batchconfig-nacha-origin_name') + || $company; + $origin_name = substr(uc($origin_name). (' 'x23), 0, 23); + + $company = substr(uc($company). (' 'x16), 0, 16); my $now = time; @@ -78,7 +83,7 @@ $DEBUG = 0; '10'. #Blocking Factor '1'. #Format code $dest_name. #Immediate Destination Name / 23 char bank name - $company. #Immediate Origin Name / 23 char company name + $origin_name. #Immediate Origin Name / 23 char company name $refcode. "\n". #Reference Code (internal/optional) ### @@ -88,7 +93,7 @@ $DEBUG = 0; '5'. #Record Type Code '225'. #Service Class Code (220 credits only, # 200 mixed debits & credits) - substr($company, 0, 16). #on cust. statements + $company. #on cust. statements (' 'x20 ). #20 char "company internal use if desired" $origin. #Company Identification (Immediate Origin) 'PPD'. #others? @@ -174,6 +179,15 @@ $DEBUG = 0; my $batchnum = substr( ('0'x7). $pay_batch->batchnum, -7); + my $lines = $batchcount + 4; + my $blocks = int($lines/10); + my $fill = ''; + + if ( my $remainder = $lines % 10 ) { + $blocks++; + $fill = ("\n".('9'x94))x( 10 - $remainder ); + } + warn "building Batch & File Control Records\n" if $DEBUG; ### @@ -199,12 +213,18 @@ $DEBUG = 0; '9'. #Record Type Code '000001'. #Batch Counter (# of batch header recs) - sprintf('%06d', $batchcount + 4). #num of physical blocks on the file..? + sprintf('%06d', $blocks). #num of physical blocks on the file sprintf('%08d', $batchcount). #total # of entry detail and addenda $entry_hash. sprintf('%012.0f', $batchtotal * 100). #Debit total '000000000000'. #Credit total - ( ' 'x39 ) #Reserved / blank + ( ' 'x39 ). #Reserved / blank + + ### + # Pad with 9999 records to blocks of 10 + ### + + $fill }, diff --git a/FS/FS/quotation.pm b/FS/FS/quotation.pm index 8843a8709..f82051066 100644 --- a/FS/FS/quotation.pm +++ b/FS/FS/quotation.pm @@ -260,15 +260,32 @@ sub _items_sections { my %opt = @_; my $escape = $opt{escape}; # the only one we care about - my %subtotals; # package frequency => subtotal + my %subtotals = (); # package frequency => subtotal + my $disable_total = 0; foreach my $pkg ($self->quotation_pkg) { - my $recur_freq = $pkg->part_pkg->freq; + + my $part_pkg = $pkg->part_pkg; + + my $recur_freq = $part_pkg->freq; ($subtotals{0} ||= 0) += $pkg->setup + $pkg->setup_tax; ($subtotals{$recur_freq} ||= 0) += $pkg->recur + $pkg->recur_tax; + + #this is a shitty hack based on what's in part_pkg/ at the moment + # but its good enough for the 99% common case of preventing totals from + # displaying for prorate packages + $disable_total = 1 + if $part_pkg->plan =~ /^(prorate|torrus|agent$)/ + || $part_pkg->option('recur_method') eq 'prorate' + || ( $part_pkg->option('sync_bill_date') + && $self->custnum + && $self->cust_main->billing_pkgs #num_billing_pkgs when we have it + ); + } my @pkg_freq_order = keys %{ FS::Misc->pkg_freqs }; my @sections; + my $no_recurring = 0; foreach my $freq (keys %subtotals) { next if $subtotals{$freq} == 0; @@ -279,6 +296,7 @@ sub _items_sections { if ( $freq eq '0' ) { if ( scalar(keys(%subtotals)) == 1 ) { # there are no recurring packages + $no_recurring = 1; $desc = $self->mt('Charges'); } else { $desc = $self->mt('Setup Charges'); @@ -295,6 +313,18 @@ sub _items_sections { 'subtotal' => sprintf('%.2f',$subtotals{$freq}), }; } + + unless ( $disable_total || $no_recurring ) { + my $total = 0; + $total += $_ for values %subtotals; + push @sections, { + 'description' => 'First payment', + 'sort_weight' => 0, + 'category' => 'Total category', #required but what's it used for? + 'subtotal' => sprintf('%.2f',$total) + }; + } + return \@sections, []; } diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index a3826bff2..8ee9a83be 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -347,7 +347,7 @@ sub dest_detail { }); } - return '' unless $rate_prefix; + return $self->default_detail unless $rate_prefix; $regionnum = $rate_prefix->regionnum; diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 67dd40e83..1094968c6 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -398,9 +398,6 @@ method together, and NO items from any other invoice should be included. =cut -# future optimization: it would probably suffice to return only the link -# records, and let the consolidation routine build the cust_bill_pkgs - sub taxline_cch { my $self = shift; # this used to accept a hash of options but none of them did anything @@ -581,8 +578,10 @@ sub taxline_cch { 'taxtype' => ref($self), 'cents' => $this_tax_cents, 'locationtaxid' => $self->location, + 'taxable_billpkgnum' => $cust_bill_pkg->billpkgnum, 'taxable_cust_bill_pkg' => $cust_bill_pkg, 'taxratelocationnum' => $taxratelocationnum, + 'taxclass' => $class, }); push @tax_links, $tax_link; diff --git a/FS/MANIFEST b/FS/MANIFEST index 422f69c0e..5b73b728c 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -39,6 +39,8 @@ FS/ClientAPI/passwd.pm FS/ClientAPI/Agent.pm FS/ClientAPI/MasonComponent.pm FS/ClientAPI/MyAccount.pm +FS/ClientAPI/MyAccount/contact.pm +FS/ClientAPI/MyAccount/quotation.pm FS/ClientAPI/PrepaidPhone.pm FS/ClientAPI/Signup.pm FS/Conf.pm @@ -846,3 +848,5 @@ FS/cust_pkg_reason_fee.pm t/cust_pkg_reason_fee.t FS/part_svc_link.pm t/part_svc_link.t +FS/access_user_log.pm +t/access_user_log.t diff --git a/FS/bin/freeside-rbc-download b/FS/bin/freeside-rbc-download new file mode 100755 index 000000000..376b839e1 --- /dev/null +++ b/FS/bin/freeside-rbc-download @@ -0,0 +1,160 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Date::Format qw(time2str); +use File::Temp qw(tempdir); #0.19 for ->newdir() interface, not in 5.10.0 +use Net::FTPSSL; +use FS::UID qw(adminsuidsetup dbh); +use FS::Record qw(qsearch qsearchs); +use FS::pay_batch; +use FS::Conf; + +use vars qw( $opt_v $opt_a $opt_f ); +getopts('va:f:'); + +#$Net::SFTP::Foreign::debug = -1; +sub usage { " + Usage: + freeside-rbc-download [ -v ] [ -a archivedir ] [ -f filename ] user\n +" } + +sub debug { + print STDERR $_[0] if $opt_v; +} + +my $user = shift or die &usage; +adminsuidsetup $user; + +$FS::UID::AutoCommit = 0; +my $dbh = dbh; + +if ( $opt_a ) { + die "no such directory: $opt_a\n" + unless -d $opt_a; + die "archive directory $opt_a is not writable by the freeside user\n" + unless -w $opt_a; +} + +my $tmpdir = tempdir( CLEANUP => 1 ); #DIR=>somewhere? + +my $conf = new FS::Conf; +my ($username, $password) = $conf->config('batchconfig-RBC-login'); +$username and $password + or die "RBC FTP login not configured. Enter your username and password in 'batchconfig-rbc-login'.\n"; + +my $host = 'ftpssl.rbc.com'; +debug "Connecting to $username\@$host...\n"; + +my $ftp = Net::FTPSSL->new($host, + Timeout => 30, + Debug => ($opt_v ? 1 : 0), + Croak => 1, # rely on auto-rollback when dbh closes + ); +$ftp->login($username, $password); + +# directory layout: +# ~/ # upload to here +# ~/inbound +# ~/inbound/valid # batches move here while being processed +# ~/outbound +# ~/outbound/XXXX # string of four characters; results arrive here + +$ftp->cwd('outbound'); +for my $dir ( $ftp->nlst ) { + debug "Entering outbound/$dir\n"; + $ftp->cwd($dir); + FILE: for my $filename ( $ftp->nlst ) { + debug "$filename..."; + # filenames look like "RPT9999X.111". + # 9999 is the four-digit report type + # X is "P" for production or "T" for test + # 111 is the sequential file number + if ( $opt_f ) { + if ( $filename ne $opt_f ) { + debug "is not the requested file.\n"; + next FILE; + } + # -f can be used to download/process any file, even one that doesn't fit + # the naming rule (e.g. those that are already downloaded). + } elsif ( $filename =~ /^RPT(\d{4})[PT]\.\d{3}$/ ) { + # fallthrough; don't currently reject files based on RPT type, because + # our parser should be able to figure it out + } else { + debug "skipped.\n"; + next FILE; + } + + debug "downloading.\n"; + $ftp->get($filename, "$tmpdir/$filename"); + + #copy to archive dir + if ( $opt_a ) { + debug "Copying to archive dir $opt_a\n"; + system 'cp', "$tmpdir/$filename", $opt_a; + warn "failed to copy $tmpdir/$filename to $opt_a: $!\n" if $!; + } + + debug "Processing batch..."; + open(my $fh, '<', "$tmpdir/$filename") + or die "couldn't read temp file: $!\n"; + + my $error = FS::pay_batch->import_results( + filehandle => $fh, + format => 'RBC', + ); + + if ( $error ) { + die "Processing $filename failed:\n$error\n\n"; + } + + debug "done.\n"; + } # FILE + $ftp->cdup(); +} # $dir + +debug "Finished.\n"; +dbh->commit; +exit(0); + +=head1 NAME + +freeside-rbc-download - Retrieve payment batch responses from RBC. + +=head1 SYNOPSIS + + freeside-rbc-download [ -v ] [ -f filename ] [ -a archivedir ] user + +=head1 DESCRIPTION + +Command line tool to download payment batch responses from the Royal Bank of +Canada ACH service. These files are fixed-width data files containing some +combination of valid, returned, or reversed payment records. + +By default, the script will download any files with names like "RPT9999X.111" +where 9999 is a four-digit document type code (like "0900", all records), X is +the letter "P" for production or "T" for test mode, and 111 is a counter +incremented with each new response file. After the files are downloaded, RBC's +server will automatically rename them with the suffix '.downloaded%FTPS' to +avoid double-processing them. + + +-v: Be verbose. + +-f filename: Download a file with a specific name, instead of all files +matching the pattern. This can be used to reprocess a specific file. + +-a directory: Archive the files in the specified directory. + +user: freeside username + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::pay_batch> + +=cut + +1; + diff --git a/FS/bin/freeside-rbc-upload b/FS/bin/freeside-rbc-upload new file mode 100755 index 000000000..52501028c --- /dev/null +++ b/FS/bin/freeside-rbc-upload @@ -0,0 +1,115 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use DateTime; +use Net::FTPSSL; +use File::Temp qw(tempdir); +use File::Slurp 'write_file'; +use FS::UID qw(adminsuidsetup dbh); +use FS::Record qw(qsearch qsearchs); +use FS::pay_batch; +use FS::Conf; + +use vars qw( $opt_a $opt_v $opt_p ); +getopts('avp:'); + +sub usage { " + Usage: + freeside-rbc-upload [ -v ] user batchnum + freeside-rbc-upload -a [ -p payby ] [ -v ] user\n +" } + +sub debug { + print STDERR $_[0] if $opt_v; +} + +my $user = shift or die &usage; +adminsuidsetup $user; + +my @batches; + +# copied from freeside-paymentech-upload, obviously +if($opt_a) { + my %criteria = (status => 'O'); + $criteria{'payby'} = uc($opt_p) if $opt_p; + @batches = qsearch('pay_batch', \%criteria); + die "No open batches found".($opt_p ? " of type '$opt_p'" : '').".\n" + if !@batches; +} +else { + my $batchnum = shift; + die &usage if !$batchnum; + @batches = qsearchs('pay_batch', { batchnum => $batchnum } ); + die "Can't find payment batch '$batchnum'\n" if !@batches; +} + +my $conf = new FS::Conf; +my ($username, $password) = $conf->config('batchconfig-RBC-login'); + +$username and $password + or die "RBC FTP login not configured. Enter your username and password in 'batchconfig-rbc-login'.\n"; + +my $host = 'ftpssl.rbc.com'; +debug "Connecting to $username\@$host...\n"; + +my $date = DateTime->now->strftime('%Y%m%d'); + +my $ftp = Net::FTPSSL->new($host, + Timeout => 30, + Debug => ($opt_v ? 1 : 0), + Croak => 1, # rely on auto-rollback when dbh closes + ); +$ftp->login($username, $password); + +my $tmpdir = tempdir( CLEANUP => 1 ); + +foreach my $pay_batch (@batches) { + my $batchnum = $pay_batch->batchnum; + my $filename = $date . '.' . sprintf('%06d', $batchnum); + debug "Exporting batch $batchnum to $filename\n"; + + my $text = $pay_batch->export_batch(format => 'RBC'); + write_file("$tmpdir/$filename", $text); + + debug "Uploading $filename..."; + $ftp->put("$tmpdir/$filename", $filename); + debug "done.\n"; +} + +debug "Finished.\n"; + +=head1 NAME + +freeside-rbc-upload - Transmit a payment batch to RBC via FTP/TLS. + +=head1 SYNOPSIS + + freeside-rbc-upload [ -a [ -p PAYBY ] ] [ -v ] user batchnum + +=head1 DESCRIPTION + +Command line tool to upload a payment batch to the Royal Bank of Canada +ACH service. Use L<freeside-rbc-download> to retrieve the response file. +Options: + +-a: Send all open batches, instead of specifying a batchnum. + +-p PAYBY: With -a, limit to batches of that payment type, e.g. -p CARD. + +-v: Be verbose. + +user: freeside username + +batchnum: pay_batch primary key + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::pay_batch> + +=cut + +1; + diff --git a/FS/t/access_user_log.t b/FS/t/access_user_log.t new file mode 100644 index 000000000..582b32ca1 --- /dev/null +++ b/FS/t/access_user_log.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_user_log; +$loaded=1; +print "ok 1\n"; |