diff options
| author | Ivan Kohler <ivan@freeside.biz> | 2015-08-07 22:01:31 -0700 |
|---|---|---|
| committer | Ivan Kohler <ivan@freeside.biz> | 2015-08-07 22:01:31 -0700 |
| commit | 0c76afbb717e1716e6126bc4a120b8d9471614a0 (patch) | |
| tree | 9a398e455a7767372588077470685d25ef8d82b3 /FS | |
| parent | 7beec7068e00be5ae1b2599fdf2b494bc19e31d0 (diff) | |
| parent | 3e2c2ad8aff1bd361ca07495b2255538c8231079 (diff) | |
Merge branch 'FREESIDE_3_BRANCH' of git.freeside.biz:/home/git/freeside into FREESIDE_3_BRANCH
Diffstat (limited to 'FS')
60 files changed, 3194 insertions, 498 deletions
@@ -3,7 +3,7 @@ package FS; use strict; use vars qw($VERSION); -$VERSION = '3.7git'; +$VERSION = '3.8git'; #find missing entries in this file with: # for a in `ls *pm | cut -d. -f1`; do grep 'L<FS::'$a'>' ../FS.pm >/dev/null || echo "missing $a" ; done diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 71db3f2ed..d40c45ad1 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -194,6 +194,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 ], ### @@ -404,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 @@ -455,6 +458,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 11523013c..92c7c1cd8 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,7 +48,9 @@ use FS::msg_template; use FS::contact; use FS::cust_location; -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]'; @@ -129,7 +131,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 @@ -241,6 +243,8 @@ sub login { return { error => 'Incorrect contact password.' } unless $contact->authenticate_password($p->{'password'}); + $session->{'contactnum'} = $contact->contactnum; + $session->{'custnum'} = $contact->custnum; } else { @@ -250,16 +254,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.' } @@ -555,6 +582,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')); @@ -634,78 +662,22 @@ 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; @@ -764,16 +736,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; @@ -2994,53 +2966,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..009658d07 --- /dev/null +++ b/FS/FS/ClientAPI/MyAccount/contact.pm @@ -0,0 +1,155 @@ +package FS::ClientAPI::MyAccount::contact; + +use strict; +use FS::Record qw( qsearchs ); +use FS::cust_main; +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 contact.selfservice_access IS NOT NULL ". + " AND contact.selfservice_access = 'Y' ". + " AND ( disabled IS NULL OR disabled = '' )". + " AND custnum = $1"; +# $search .= " AND agentnum = ". $session->{'agentnum'} if $context eq 'agent'; + + qsearchs( { + 'table' => 'contact', + 'addl_from' => 'LEFT JOIN cust_main USING ( 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_email; + { 'contactnum' => $_->contactnum, + 'class' => $_->contact_classname, + 'first' => $_->first, + 'last' => $_->get('last'), + 'title' => $_->title, + 'emailaddress' => join(',', map $_->emailaddress, @contact_email), + #TODO: contact phone numbers + 'comment' => $_->comment, + 'selfservice_access' => $_->selfservice_access, + #'disabled' => $_->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" }; + + #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 $contact = qsearchs('contact', { contactnum =>$ p->{contactnum}, + custnum => $custnum, } ) + or return { 'error' => 'Unknown contactnum' }; + + my $error = $contact->delete; + return { 'error' => $error } if $error; + + 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/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 547f230c8..c778e59d9 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 ) ), @@ -957,6 +959,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 74d685479..593440232 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -105,6 +105,13 @@ sub ss2clientapi { 'switch_acct' => 'MyAccount/switch_acct', '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 d2113616c..fde5bd22f 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -679,10 +679,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 ); @@ -777,6 +779,11 @@ sub reason_type_options { } } +my $validate_email = sub { $_[0] =~ + /^[^@]+\@[[:alnum:]-]+(\.[[:alnum:]-]+)+$/ + ? '' : 'Invalid email address'; + }; + #Billing (81 items) #Invoicing (50 items) #UI (69 items) @@ -1269,10 +1276,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, }, { @@ -1379,6 +1383,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.', @@ -1566,6 +1579,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.', @@ -2762,6 +2784,14 @@ and customer address. Include units.', }, { + 'key' => 'dump-email_to', + 'section' => '', + 'description' => "Optional email address to send success/failure message for database dumps.", + 'type' => 'text', + 'validate' => $validate_email, + }, + + { 'key' => '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.', @@ -3940,6 +3970,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.', @@ -3976,6 +4013,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.', @@ -4533,6 +4577,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.', @@ -5720,7 +5771,6 @@ and customer address. Include units.', 'multiple' => 1, 'options_sub' => sub { map { $_ => FS::Locales->description($_) } - grep { $_ ne 'en_US' } FS::Locales->locales; }, 'option_sub' => sub { FS::Locales->description(shift) }, @@ -5835,6 +5885,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.', @@ -6014,6 +6071,15 @@ and customer address. Include units.', { key => "vonage-password", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "vonage-fromnumber", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + # for internal use only; test databases should declare this option and + # everyone else should pretend it doesn't exist + #{ + # 'key' => 'no_random_ids', + # 'section' => '', + # 'description' => 'Replace random identifiers in UI code with a static string, for repeatable testing. Don\'t use in production.', + # 'type' => 'checkbox', + #}, + ); 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 d0a530e9a..467eb6ab1 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; @@ -136,7 +136,7 @@ if ( -e $addl_handler_use_file ) { use FS::Conf; use FS::CGI qw(header menubar table itable ntable idiot eidiot myexit http_header); - use FS::UI::Web qw(svc_url); + use FS::UI::Web qw(svc_url random_id); use FS::UI::Web::small_custview qw(small_custview); use FS::UI::bytecount; use FS::Msgcat qw(gettext geterror); @@ -155,6 +155,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; @@ -377,6 +379,7 @@ if ( -e $addl_handler_use_file ) { use FS::legacy_cust_history; use FS::quotation_pkg_tax; use FS::cust_pkg_reason_fee; + use FS::access_user_log; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { @@ -435,6 +438,7 @@ if ( -e $addl_handler_use_file ) { die $@ if $@; } + no warnings 'redefine'; *CGI::redirect = sub { my $self = shift; my $cookie = ''; diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm index 36c46dc41..022ff8e8a 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 = ''; @@ -109,6 +110,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; @@ -118,6 +123,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 f7a8bcedd..8049fdece 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; @@ -825,7 +826,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"; } @@ -979,6 +980,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/Record.pm b/FS/FS/Record.pm index 72745fe13..ef0d88d80 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -519,6 +519,7 @@ sub qsearch { # Check for encrypted fields and decrypt them. ## only in the local copy, not the cached object + no warnings 'deprecated'; # XXX silence the warning for now if ( $conf_encryption && eval 'defined(@FS::'. $table . '::encrypted_fields)' ) { foreach my $record (@return) { diff --git a/FS/FS/Report/FCC_477.pm b/FS/FS/Report/FCC_477.pm index e8f27f84c..75ddee0d7 100644 --- a/FS/FS/Report/FCC_477.pm +++ b/FS/FS/Report/FCC_477.pm @@ -322,7 +322,7 @@ sub report { if ( $class->can($check_method) ) { # they don't all have these my $eh = $class->$check_method( $row ); $num_errors++ if keys(%$eh); - push $error, $eh + push @$error, $eh } push @$detail, pop @$row; # this comes from the query } 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 3a27b741b..e06fce65c 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -189,9 +189,9 @@ sub dbdef_dist { my $tables_hashref_torrus = tables_hashref_torrus(); - #create history tables (false laziness w/create-history-tables) + #create history tables foreach my $table ( - grep { ! /^clientapi_session/ + grep { ! /^(clientapi|access_user)_session/ && ! /^h_/ && ! /^log(_context)?$/ && ! /^legacy_cust_history$/ @@ -1420,7 +1420,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, '', '', @@ -1739,6 +1739,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, '', '', 'depositor', 'varchar', 'NULL', $char_d, '', '', @@ -1868,7 +1869,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, '', '', @@ -2404,6 +2405,7 @@ sub tables_hashref { 'quantity', 'int', '', '', '', '', 'primary_svc','char', 'NULL', 1, '', '', 'hidden', 'char', 'NULL', 1, '', '', + 'provision_hold', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'pkgsvcnum', 'unique' => [ ['pkgpart', 'svcpart'] ], @@ -3943,6 +3945,19 @@ sub tables_hashref { 'index' => [], }, + 'access_user_session' => { + 'columns' => [ + 'sessionnum', 'serial', '', '', '', '', + 'sessionkey', 'varchar', '', $char_d, '', '', + 'usernum', 'int', '', '', '', '', + 'start_date', @date_type, '', '', + 'last_date', @date_type, '', '', + ], + 'primary_key' => 'sessionnum', + 'unique' => [ [ 'sessionkey' ] ], + 'index' => [], + }, + 'access_user' => { 'columns' => [ 'usernum', 'serial', '', '', '', '', @@ -4016,6 +4031,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', '', '', '', '', @@ -4098,6 +4125,7 @@ sub tables_hashref { 'devicepart', 'serial', '', '', '', '', 'devicename', 'varchar', '', $char_d, '', '', 'inventory_classnum', 'int', 'NULL', '', '', '', + 'title', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'devicepart', 'unique' => [ [ 'devicename' ] ], #? @@ -4712,6 +4740,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/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 44d44e185..6d272dd42 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -818,35 +818,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', @@ -860,6 +861,8 @@ sub print_generic { die $error; } + # fill in variables + $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data ); $invoice_data{$include} =~ s/\n+$// @@ -1274,11 +1277,17 @@ sub print_generic { if ( $multisection ) { if ( $taxtotal > 0 ) { + # there are taxes, so prepare the section to be displayed. + # $taxtotal already includes any line items that were already in the + # section (fees, taxes that are charged as packages for some reason). + # also set 'summarized' to false so that this isn't a summary-only + # section. $tax_section->{'subtotal'} = $other_money_char. sprintf('%.2f', $taxtotal); $tax_section->{'pretotal'} = 'New charges sub-total '. $total->{'total_amount'}; $tax_section->{'description'} = $self->mt($tax_description); + $tax_section->{'summarized'} = ''; # append it if it's not already there if ( !grep $tax_section, @sections ) { @@ -2489,7 +2498,6 @@ sub _items_sections { foreach my $sectionname (keys %{ $s->{$locationnum} }) { my $section = { 'subtotal' => $s->{$locationnum}{$sectionname}, - 'post_total' => $post_total, 'sort_weight' => 0, }; if ( $locationnum ) { 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 28ba869ce..69de5e157 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -15,11 +15,13 @@ use FS::cust_main; # are sql_balance and sql_date_balance in the right module? #@ISA = qw( FS::UI ); @ISA = qw( Exporter ); -@EXPORT_OK = qw( svc_url ); +@EXPORT_OK = qw( svc_url random_id ); $DEBUG = 0; $me = '[FS::UID::Web]'; +our $NO_RANDOM_IDS; + ### # date parsing ### @@ -273,6 +275,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'); @@ -607,6 +610,35 @@ sub is_mobile { return 0; } +=item random_id [ DIGITS ] + +Returns a random number of length DIGITS, or if unspecified, a long random +identifier consisting of the timestamp, process ID, and a random number. +Anything in the UI that needs a random identifier should use this. + +=cut + +sub random_id { + my $digits = shift; + if (!defined $NO_RANDOM_IDS) { + my $conf = FS::Conf->new; + $NO_RANDOM_IDS = $conf->exists('no_random_ids') ? 1 : 0; + } + if ( $NO_RANDOM_IDS ) { + if ( $digits > 0 ) { + return 0; + } else { + return '0000000000-0000-000000000.000000'; + } + } else { + if ($digits > 0) { + return int(rand(10 ** $digits)); + } else { + return time . "-$$-" . rand() * 2**32; + } + } +} + =back =cut diff --git a/FS/FS/UI/Web/small_custview.pm b/FS/FS/UI/Web/small_custview.pm index b98bca072..b48714c6a 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. '">'. ucfirst($cust_main->status). '</FONT></B>'; @@ -127,9 +131,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; $html .= '</TD></TR><TR><TD></TD><TD BGCOLOR="#ffffff">'; @@ -156,7 +161,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 4b5a701ba..605eaeef1 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -329,6 +329,22 @@ sub 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/amcom.pm b/FS/FS/cdr/amcom.pm index 774d1e617..36be8d8c3 100644 --- a/FS/FS/cdr/amcom.pm +++ b/FS/FS/cdr/amcom.pm @@ -43,6 +43,7 @@ my ($tmp_mday, $tmp_mon, $tmp_year); hour => $1, minute => $2, second => $3, + time_zone => 'local', ); $cdr->set('startdate', $dt->epoch); }, diff --git a/FS/FS/cdr/broadsoft.pm b/FS/FS/cdr/broadsoft.pm index 9477351ae..eb68ae39e 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/earthlink.pm b/FS/FS/cdr/earthlink.pm index 213a025c2..5042f6fa5 100644 --- a/FS/FS/cdr/earthlink.pm +++ b/FS/FS/cdr/earthlink.pm @@ -14,8 +14,7 @@ use Date::Parse; 'header' => 1, 'import_fields' => [ - 'accountcode', #Account number - skip(2), #SERVICE LOC / BILL NUMBER + skip(3), #Account number/ SERVICE LOC / BILL NUMBER sub { my($cdr, $date) = @_; $date; }, #date @@ -38,6 +37,8 @@ use Date::Parse; _cdr_min_parser_maker, #MINUTES skip(1), #AMOUNT 'disposition', #Call Type + skip(1), #Seq + 'accountcode', #AcctCode ], ); 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 a195e5de8..7e068abe8 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -913,6 +913,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 @@ -939,7 +940,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') ) { @@ -3013,6 +3016,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 ) = @_; @@ -3022,22 +3028,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 1fc818d35..58c75e38a 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, }; } @@ -180,16 +236,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).')'; } } @@ -218,6 +268,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}) @@ -228,21 +279,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_location.pm b/FS/FS/cust_location.pm index ad6d706bb..09baff3ce 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 @@ -147,6 +147,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); @@ -202,6 +208,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); } @@ -266,6 +278,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->$_ ) { @@ -325,7 +341,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') @@ -719,58 +737,6 @@ sub cust_main { =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 6aaeac64b..c7f40f2c4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -36,7 +36,7 @@ use Business::CreditCard 0.28; use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); -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; @@ -4437,6 +4437,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 @@ -4964,6 +5138,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. @@ -4979,11 +5155,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"; diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index b7deeddcf..908f48697 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -914,6 +914,7 @@ sub calculate_taxes { #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n" if $DEBUG > 2; + my $custnum = $self->custnum; # The main tax accumulator. One bin for each tax name (itemdesc). # For each subdivision of tax under this name, push a cust_bill_pkg item # for the calculated tax into the arrayref. @@ -929,10 +930,15 @@ sub calculate_taxes { # values are arrayrefs of cust_tax_exempt_pkg objects my %tax_exemption; + # For tax on tax calculation, we need to remember which taxable items + # (and charge classes) had which taxes applied to them. + # # keys are cust_bill_pkg objects (taxable items) # values are hashrefs - # keys are taxlisthash keys - # values are the taxlines generated for those taxes + # keys are charge classes + # values are hashrefs + # keys are taxnums (in tax_rate only; cust_main_county doesn't use this) + # values are the taxlines generated for those taxes tie my %item_has_tax, 'Tie::RefHash', map { $_ => {} } @$cust_bill_pkg; @@ -941,6 +947,7 @@ sub calculate_taxes { my $taxables = $taxlisthash->{$tax_id}; my $tax_object = shift @$taxables; + my $taxnum = $tax_object->taxnum; # $tax_object is a cust_main_county or tax_rate # (with billpkgnum, pkgnum, locationnum set) # the rest of @{ $taxlisthash->{$tax_id} } is cust_bill_pkg objects, @@ -957,34 +964,35 @@ sub calculate_taxes { if ( $tax_object->isa('FS::tax_rate') ) { # EXTERNAL TAXES # STILL have tax_rate-specific crap in here... my @taxlines = $tax_object->taxline( $taxables, - 'custnum' => $self->custnum, + 'custnum' => $custnum, 'invoice_time' => $invoice_time, 'exemptions' => $exemptions, ); next if !@taxlines; if (!ref $taxlines[0]) { # it's an error string - warn "error evaluating $tax_id on custnum ".$self->custnum."\n"; + warn "error evaluating $tax_id on custnum $custnum\n"; return $taxlines[0]; } foreach my $taxline (@taxlines) { push @{ $taxname{ $taxline->itemdesc } }, $taxline; my $link = $taxline->get('cust_bill_pkg_tax_rate_location')->[0]; my $taxable_item = $link->taxable_cust_bill_pkg; - $item_has_tax{$taxable_item}->{$tax_id} = $taxline; + $item_has_tax{$taxable_item}{$taxline->_class}{$taxnum} = $taxline; } + } else { # INTERNAL TAXES # we can do this in a single taxline, because it's not stupid my $taxline = $tax_object->taxline( $taxables, - 'custnum' => $self->custnum, + 'custnum' => $custnum, 'invoice_time' => $invoice_time, 'exemptions' => $exemptions, ); next if !$taxline; if (!ref $taxline) { # it's an error string - warn "error evaluating $tax_id on custnum ".$self->custnum."\n"; + warn "error evaluating $tax_id on custnum $custnum\n"; return $taxline; } # if the calculated tax is zero, don't even keep it @@ -1001,48 +1009,55 @@ sub calculate_taxes { my $this_has_tax = $item_has_tax{$taxable_item}; my $location = $taxable_item->tax_location; - foreach my $tax_id (keys %$this_has_tax) { - my ($class, $taxnum) = split(' ', $tax_id); - # internal taxes don't support tax_on_tax, so we don't bother with - # them here. - next unless $class eq 'FS::tax_rate'; - - # for each tax item that was calculated in phase 1, get the - # tax definition - my $tax_object = FS::tax_rate->by_key($taxnum); - # and find all taxes that apply to it in this location - my @tot = $tax_object->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. - foreach my $tot (@tot) { - my $tot_id = ref($tot) . ' ' . $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) { + + # for each tax item that was calculated in phase 1, get the + # tax definition + my $tax_object = FS::tax_rate->by_key($taxnum); + # and find all taxes that apply to it in this location + my @tot = $tax_object->tax_on_tax( $location ); + next if !@tot; + warn "found possible taxed taxnum $taxnum\n" if $DEBUG > 2; - if ( exists $this_has_tax->{ $tot_id } ) { - warn "calculating tax on tax: taxnum ".$tot->taxnum." on $taxnum\n" - if $DEBUG; - my @taxlines = $tot->taxline( - $this_has_tax->{ $tax_id }, # the first-stage tax - 'custnum' => $self->custnum, - 'invoice_time' => $invoice_time, - ); - next if (!@taxlines); # it didn't apply after all - if (!ref($taxlines[0])) { - warn "error evaluating $tot_id TOT on custnum ". - $self->custnum."\n"; - return $taxlines[0]; - } - foreach my $taxline (@taxlines) { - push @{ $taxname{ $taxline->itemdesc } }, $taxline; - } - } # if $has_tax - } # 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. + foreach my $tot (@tot) { + my $totnum = $tot->taxnum; + warn "checking taxnum $totnum 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 $totnum on $taxnum\n" + if $DEBUG; + my @taxlines = $tot->taxline( + $this_class_has_tax->{ $taxnum }, # the first-stage tax + 'custnum' => $custnum, + 'invoice_time' => $invoice_time, + ); + next if (!@taxlines); # it didn't apply after all + if (!ref($taxlines[0])) { + warn "error evaluating taxnum $totnum TOT on custnum $custnum\n"; + return $taxlines[0]; + } + foreach my $taxline (@taxlines) { + push @{ $taxname{ $taxline->itemdesc } }, $taxline; + } + } # if $has_tax + } # foreach my $tot (tax-on-tax rate definition) + } # foreach $taxnum (first-tier rate definition) + } # foreach $charge_class } # foreach $taxable_item #consolidate and create tax line items @@ -1290,6 +1305,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 @@ -2340,6 +2363,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. @@ -2482,6 +2506,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. @@ -2511,7 +2536,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 d2de5f80a..b402ed373 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -117,6 +117,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. @@ -558,6 +562,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') @@ -1230,23 +1235,26 @@ sub process_batch_import { return %hash; }; - my $opt = { 'table' => 'cust_pay', - 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ], - #agent_custid isn't a cust_pay field, see hash callback - 'formats' => { 'simple' => [ qw(custnum agent_custid paid payinfo invnum) ] }, - 'format_types' => { 'simple' => '' }, #force infer from file extension - 'default_csv' => 1, #if it's not .xls, it'll read as csv, regardless of extension - 'format_hash_callbacks' => { 'simple' => $hashcb }, - 'postinsert_callback' => sub { - my $cust_pay = shift; - my $cust_main = $cust_pay->cust_main || - return "can't find customer to which payments apply"; - my $error = $cust_main->apply_payments_and_credits; - return $error - ? "can't apply payments to customer ".$cust_pay->custnum."$error" - : ''; - }, - }; + my $opt = { + 'table' => 'cust_pay', + 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ], + #agent_custid isn't a cust_pay field, see hash callback + 'formats' => { 'simple' => + [ qw(custnum agent_custid paid payinfo invnum) ] }, + 'format_types' => { 'simple' => '' }, #force infer from file extension + 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension + 'format_hash_callbacks' => { 'simple' => $hashcb }, + 'insert_args_callback' => sub { ( 'manual'=>1 ) }, + 'postinsert_callback' => sub { + my $cust_pay = shift; + my $cust_main = $cust_pay->cust_main + or return "can't find customer to which payments apply"; + my $error = $cust_main->apply_payments_and_credits; + return $error + ? "can't apply payments to customer ".$cust_pay->custnum."$error" + : ''; + }, + }; FS::Record::process_batch_import( $job, $opt, @_ ); diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index 2ab76d5b5..774ea2961 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -8,6 +8,9 @@ use FS::Record qw(dbh qsearch qsearchs); use FS::payinfo_Mixin; use FS::cust_main; use FS::cust_bill; +use Storable qw( thaw ); +use MIME::Base64 qw( decode_base64 ); + @ISA = qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record ); @@ -130,6 +133,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 @@ -138,7 +143,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') ; @@ -470,6 +477,76 @@ sub request_item { ); } +=item process_unbatch_and_delete + +L</unbatch_and_delete> run as a queued job, accepts I<$job> and I<$param>. + +=cut + +sub process_unbatch_and_delete { + my ($job, $param) = @_; + $param = thaw(decode_base64($param)); + my $self = qsearchs('cust_pay_batch',{ 'paybatchnum' => scalar($param->{'paybatchnum'}) }) + or die 'Could not find paybatchnum ' . $param->{'paybatchnum'}; + my $error = $self->unbatch_and_delete; + die $error if $error; + return ''; +} + +=item unbatch_and_delete + +May only be called on a record with an empty status and an associated +L<pay_batch> with a status of 'O' (not yet in transit.) Deletes all associated +records from L<cust_bill_pay_batch> and then deletes this record. +If there is an error, returns the error, otherwise returns false. + +=cut + +sub unbatch_and_delete { + my $self = shift; + + return 'Cannot unbatch a cust_pay_batch with status ' . $self->status + if $self->status; + + my $pay_batch = qsearchs('pay_batch',{ 'batchnum' => $self->batchnum }) + or return 'Cannot find associated pay_batch record'; + + return 'Cannot unbatch from a pay_batch with status ' . $pay_batch->status + if $pay_batch->status ne 'O'; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + # have not generated actual payments yet, so should be safe to delete + foreach my $cust_bill_pay_batch ( + qsearch('cust_bill_pay_batch',{ 'paybatchnum' => $self->paybatchnum }) + ) { + my $error = $cust_bill_pay_batch->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =back =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 14555dd67..1d660ee02 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1979,6 +1979,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 @@ -1992,6 +1999,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; @@ -1999,6 +2033,16 @@ 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 local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -2011,8 +2055,6 @@ sub change { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error; - if ( $opt->{'cust_location'} ) { $error = $opt->{'cust_location'}->find_or_insert; if ( $error ) { @@ -2037,6 +2079,9 @@ sub change { if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) { $self->set_initial_timers; } + # 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; @@ -2094,6 +2139,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) @@ -2366,8 +2414,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 @@ -2377,6 +2427,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; @@ -2390,8 +2444,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'} @@ -2400,7 +2452,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... @@ -2415,8 +2469,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; } @@ -2440,8 +2496,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) @@ -2452,7 +2510,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)); @@ -3250,28 +3308,33 @@ Returns a list of FS::part_svc objects representing services included in this package but not yet provisioned. Each FS::part_svc object also has an extra field, I<num_avail>, which specifies the number of available services. +Accepts option I<provision_hold>; if true, only returns part_svc for which the +associated pkg_svc has the provision_hold flag set. + =cut sub available_part_svc { my $self = shift; + my %opt = @_; my $pkg_quantity = $self->quantity || 1; grep { $_->num_avail > 0 } - map { - my $part_svc = $_->part_svc; - $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking - $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); - - # more evil encapsulation breakage - if($part_svc->{'Hash'}{'num_avail'} > 0) { - my @exports = $part_svc->part_export_did; - $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports); - } - - $part_svc; - } - $self->part_pkg->pkg_svc; + map { + my $part_svc = $_->part_svc; + $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking + $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart); + + # more evil encapsulation breakage + if ($part_svc->{'Hash'}{'num_avail'} > 0) { + my @exports = $part_svc->part_export_did; + $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports); + } + + $part_svc; + } + grep { $opt{'provision_hold'} ? $_->provision_hold : 1 } + $self->part_pkg->pkg_svc; } =item part_svc [ OPTION => VALUE ... ] diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 12e2c788e..ff05fb966 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -102,6 +102,37 @@ sub table { 'cust_svc'; } Adds this service to the database. If there is an error, returns the error, otherwise returns false. +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + + #check if this releases a hold (see FS::pkg_svc provision_hold) + $error ||= $self->_check_provision_hold; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error + +} + =item delete Deletes this service from the database. If there is an error, returns the @@ -360,6 +391,9 @@ sub replace { } # if ($svc_x->locationnum) } # if this is a location change + #check if this releases a hold (see FS::pkg_svc provision_hold) + $error ||= $new->_check_provision_hold; + if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error if $error @@ -1073,6 +1107,35 @@ sub smart_search_param { ); } +# If the associated cust_pkg is 'on hold' +# and the associated pkg_svc has the provision_hold flag +# and there are no more available_part_svcs on the cust_pkg similarly flagged, +# then removes hold from pkg +# returns $error or '' on success, +# does not indicate if pkg status was changed +sub _check_provision_hold { + my $self = shift; + + # check status of cust_pkg + my $cust_pkg = $self->cust_pkg; + return '' unless $cust_pkg->status eq 'on hold'; + + # check flag on this svc + # small false laziness with $self->pkg_svc + # to avoid looking up cust_pkg twice + my $pkg_svc = qsearchs( 'pkg_svc', { + 'svcpart' => $self->svcpart, + 'pkgpart' => $cust_pkg->pkgpart, + }); + return '' unless $pkg_svc->provision_hold; + + # check for any others available with that flag + return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 ); + + # conditions met, remove hold + return $cust_pkg->unsuspend; +} + sub _upgrade_data { my $class = shift; 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_device.pm b/FS/FS/part_device.pm index 0f840a7bc..ac987400a 100644 --- a/FS/FS/part_device.pm +++ b/FS/FS/part_device.pm @@ -38,10 +38,16 @@ primary key =item devicename -devicename +device name (used in Freeside) =item inventory_classnum +L<FS::inventory_class> used to track inventory of these devices. + +=item title + +external device name (for export) + =back =head1 METHODS @@ -105,6 +111,7 @@ sub check { $self->ut_numbern('devicepart') || $self->ut_text('devicename') || $self->ut_foreign_keyn('inventory_classnum', 'inventory_class', 'classnum') + || $self->ut_textn('title') ; return $error if $error; diff --git a/FS/FS/part_export/broadworks.pm b/FS/FS/part_export/broadworks.pm new file mode 100644 index 000000000..a04a70e9b --- /dev/null +++ b/FS/FS/part_export/broadworks.pm @@ -0,0 +1,828 @@ +package FS::part_export::broadworks; + +use base qw( FS::part_export ); +use strict; + +use Tie::IxHash; +use FS::Record qw(dbh qsearch qsearchs); +use Locale::SubCountry; + +our $me = '[broadworks]'; +our %client; # exportnum => client object +our %expire; # exportnum => timestamp on which to refresh the client + +tie my %options, 'Tie::IxHash', + 'service_provider'=> { label => 'Service Provider ID' }, + 'admin_user' => { label => 'Administrative user ID' }, + 'admin_pass' => { label => 'Administrative password' }, + 'domain' => { label => 'Domain' }, + 'user_limit' => { label => 'Maximum users per customer', + default => 100 }, + 'debug' => { label => 'Enable debugging', + type => 'checkbox', + }, +; + +# do we need roles for this? +# no. cust_main -> group, svc_phone -> pilot/single user, +# phone_device -> access device +# +# phase 2: svc_pbx -> trunk group, pbx_extension -> trunk user + +our %info = ( + 'svc' => [qw( svc_phone svc_pbx )], # part_device? + 'desc' => + 'Provision phone and PBX services to a Broadworks Application Server', + 'options' => \%options, + 'notes' => <<'END' +<P>Export to <b>BroadWorks Application Server</b>.</P> +<P>In the simple case where one IP phone corresponds to one public phone +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>Each phone service must have a device linked before it will be functional. +Until then, authentication will be denied.</P> +END +); + +sub export_insert { + my($self, $svc_x) = (shift, shift); + + my $cust_main = $svc_x->cust_main; + my ($groupId, $error) = $self->set_cust_main_Group($cust_main); + return $error if $error; + + if ( $svc_x->isa('FS::svc_phone') ) { + my $userId; + ($userId, $error) = $self->set_svc_phone_User($svc_x, $groupId); + + $error ||= $self->set_sip_authentication($userId, $userId, $svc_x->sip_password); + + return $error if $error; + + } elsif ( $svc_x->isa('FS::svc_pbx') ) { + # noop + } + + ''; +} + +sub export_replace { + my($self, $svc_new, $svc_old) = @_; + + my $cust_main = $svc_new->cust_main; + my ($groupId, $error) = $self->set_cust_main_Group($cust_main); + return $error if $error; + + if ( $svc_new->isa('FS::svc_phone') ) { + my $oldUserId = $self->userId($svc_old); + my $newUserId = $self->userId($svc_new); + + if ( $oldUserId ne $newUserId ) { + my ($success, $message) = $self->request( + User => 'UserModifyUserIdRequest', + userId => $oldUserId, + 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 ) { + $error ||= $self->release_number($svc_old->phonenum, $groupId); + } + + my $userId; + ($userId, $error) = $self->set_svc_phone_User($svc_new, $groupId); + $error ||= $self->set_sip_authentication($userId, $userId, $svc_new->sip_password); + + if ($error and $oldUserId ne $newUserId) { + # rename it back, then + my ($success, $message) = $self->request( + User => 'UserModifyUserIdRequest', + userId => $newUserId, + newUserId => $oldUserId + ); + # if it fails, we can't really fix it + return "$error; unable to reverse user ID change: $message" if !$success; + } + + return $error if $error; + + } elsif ( $svc_new->isa('FS::svc_pbx') ) { + # noop + } + + ''; +} + +sub export_delete { + my ($self, $svc_x) = @_; + + my $cust_main = $svc_x->cust_main; + my $groupId = $self->groupId($cust_main); + + if ( $svc_x->isa('FS::svc_phone') ) { + my $userId = $self->userId($svc_x); + my $error = $self->delete_User($userId) + || $self->release_number($svc_x->phonenum, $groupId); + return $error if $error; + } elsif ( $svc_x->isa('FS::svc_pbx') ) { + # noop + } + + # find whether the customer still has any services on this platform + # (other than the one being deleted) + my %svcparts = map { $_->svcpart => 1 } $self->export_svc; + my $svcparts = join(',', keys %svcparts); + my $num_svcs = FS::cust_svc->count( + '(select custnum from cust_pkg where cust_pkg.pkgnum = cust_svc.pkgnum) '. + ' = ? '. + ' AND svcnum != ?'. + " AND svcpart IN ($svcparts)", + $cust_main->custnum, + $svc_x->svcnum + ); + + if ( $num_svcs == 0 ) { + warn "$me removed last service for group $groupId; deleting group.\n"; + my $error = $self->delete_Group($groupId); + warn "$me error deleting group: $error\n" if $error; + return "$error (removing customer group)" if $error; + } + + ''; +} + +sub export_device_insert { + my ($self, $svc_x, $device) = @_; + + if ( $device->count('svcnum = ?', $svc_x->svcnum) > 1 ) { + return "This service already has a device."; + } + + my $cust_main = $svc_x->cust_main; + my $groupId = $self->groupId($cust_main); + + my ($deviceName, $error) = $self->set_device_AccessDevice($device, $groupId); + return $error if $error; + + if ( $device->isa('FS::phone_device') ) { + return $self->set_endpoint( $self->userId($svc_x), $deviceName); + } # else pbx_device, extension_device + + ''; +} + +sub export_device_replace { + my ($self, $svc_x, $new_device, $old_device) = @_; + my $cust_main = $svc_x->cust_main; + my $groupId = $self->groupId($cust_main); + + my $new_deviceName = $self->deviceName($new_device); + my $old_deviceName = $self->deviceName($old_device); + + if ($new_deviceName ne $old_deviceName) { + + # do it in this order to switch the service endpoint over to the new + # device. + return $self->export_device_insert($svc_x, $new_device) + || $self->delete_Device($old_deviceName, $groupId); + + } else { # update in place + + my ($deviceName, $error) = $self->set_device_AccessDevice($new_device, $groupId); + return $error if $error; + + } +} + +sub export_device_delete { + my ($self, $svc_x, $device) = @_; + + if ( $device->isa('FS::phone_device') ) { + my $error = $self->set_endpoint( $self->userId($svc_x), '' ); + return $error if $error; + } # else... + + return $self->delete_Device($self->deviceName($device)); +} + + +=head2 CREATE-OR-UPDATE METHODS + +These take a Freeside object that can be exported to the Broadworks system, +determine if it already has been exported, and if so, update it to match the +Freeside object. If it's not already there, they create it. They return a list +of two objects: +- that object's identifying string or hashref or whatever in Broadworks, and +- an error message, if creating the object failed. + +=over 4 + +=item set_cust_main_Group CUST_MAIN + +Takes a L<FS::cust_main>, creates a Group for the customer, and returns a +GroupId. If the Group exists, it will be updated with the current customer +and export settings. + +=cut + +sub set_cust_main_Group { + my $self = shift; + my $cust_main = shift; + my $location = $cust_main->ship_location; + + my $LSC = Locale::SubCountry->new($location->country) + or return(0, "Invalid country code ".$location->country); + my $state_name; + if ( $LSC->has_sub_countries ) { + $state_name = $LSC->full_name( $location->state ); + } + + my $groupId = $self->groupId($cust_main); + my %group_info = ( + $self->SPID, + groupId => $groupId, + defaultDomain => $self->option('domain'), + userLimit => $self->option('user_limit'), + groupName => $cust_main->name_short, + callingLineIdName => $cust_main->name_short, + contact => { + contactName => $cust_main->contact_firstlast, + contactNumber => ( $cust_main->daytime + || $cust_main->night + || $cust_main->mobile + || undef + ), + contactEmail => ( ($cust_main->all_emails)[0] || undef ), + }, + address => { + addressLine1 => $location->address1, + addressLine2 => ($location->address2 || undef), + city => $location->city, + stateOrProvince => $state_name, + zipOrPostalCode => $location->zip, + country => $location->country, + }, + ); + + my ($success, $message) = $self->request('Group' => 'GroupGetRequest14sp7', + $self->SPID, + groupId => $groupId + ); + + if ($success) { # update it with the curent params + + ($success, $message) = + $self->request('Group' => 'GroupModifyRequest', %group_info); + + } elsif ($message =~ /Group not found/) { + + # create a new group + ($success, $message) = + $self->request('Group' => 'GroupAddRequest', %group_info); + + if ($success) { + # tell the group that its users in general are allowed to use + # Authentication + ($success, $message) = $self->request( + 'Group' => 'GroupServiceModifyAuthorizationListRequest', + $self->SPID, + groupId => $groupId, + userServiceAuthorization => { + serviceName => 'Authentication', + authorizedQuantity => { unlimited => 'true' }, + }, + ); + } + + if ($success) { + # tell the group that each new user, specifically, is allowed to + # use Authentication + ($success, $message) = $self->request( + 'Group' => 'GroupNewUserTemplateAssignUserServiceListRequest', + $self->SPID, + groupId => $groupId, + serviceName => 'Authentication', + ); + } + + } # else we somehow failed to fetch the group; throw an error + + if ($success) { + return ($groupId, ''); + } else { + return ('', $message); + } +} + +=item set_svc_phone_User SVC_PHONE, GROUPID + +Creates a User object corresponding to this svc_phone, in the specified +group. If the User already exists, updates the record with the current +customer name (or phone name), phone number, and access device. + +=cut + +sub set_svc_phone_User { + my ($self, $svc_phone, $groupId) = @_; + + my $error; + + # make sure the phone number is available + $error = $self->assign_number( $svc_phone->phonenum, $groupId ); + + my $userId = $self->userId($svc_phone); + my $cust_main = $svc_phone->cust_main; + + my ($first, $last); + if ($svc_phone->phone_name =~ /,/) { + ($last, $first) = split(/,\s*/, $svc_phone->phone_name); + } elsif ($svc_phone->phone_name =~ / /) { + ($first, $last) = split(/ +/, $svc_phone->phone_name, 2); + } else { + $first = $cust_main->first; + $last = $cust_main->last; + } + + my %new_user = ( + $self->SPID, + groupId => $groupId, + userId => $userId, + lastName => $last, + firstName => $first, + callingLineIdLastName => $last, + callingLineIdFirstName => $first, + password => $svc_phone->sip_password, + # not supported: nameDialingName; Hiragana names + phoneNumber => $svc_phone->phonenum, + callingLinePhoneNumber => $svc_phone->phonenum, + ); + + # does the user exist? + my ($success, $message) = $self->request( + 'User' => 'UserGetRequest21', + userId => $userId + ); + + if ( $success ) { # modify in place + + ($success, $message) = $self->request( + 'User' => 'UserModifyRequest17sp4', + %new_user + ); + + } elsif ( $message =~ /User not found/ ) { # create new + + ($success, $message) = $self->request( + 'User' => 'UserAddRequest17sp4', + %new_user + ); + + } + + if ($success) { + return ($userId, ''); + } else { + return ('', $message); + } +} + +=item set_device_AccessDevice DEVICE, [ GROUPID ] + +Creates/updates an Access Device Profile. This is a record for a +I<specific physical device> that can send/receive calls. (Not to be confused +with an "Access Device Endpoint", which is a I<port> on such a device.) DEVICE +can be any record with a foreign key to L<FS::part_device>. + +If GROUPID is specified, this device profile will be created at the Group +level in that group; otherwise it will be a ServiceProvider level record. + +=cut + +sub set_device_AccessDevice { + my $self = shift; + my $device = shift; + my $groupId = shift; + + my $deviceName = $self->deviceName($device); + + my $svc_x; + if ($device->svcnum) { + $svc_x = FS::cust_svc->by_key($device->svcnum)->svc_x; + } else { + $svc_x = FS::svc_phone->new({}); # returns empty for all fields + } + + my $part_device = $device->part_device + or return ('', "devicepart ".$device->part_device." not defined" ); + + # required fields + my %new_device = ( + $self->SPID, + deviceName => $deviceName, + deviceType => $part_device->title, + description => ($svc_x->title # svc_pbx + || $part_device->devicename), # others + ); + + # optional fields + $new_device{netAddress} = $svc_x->ip_addr if $svc_x->ip_addr; # svc_pbx only + $new_device{macAddress} = $device->mac_addr if $device->mac_addr; + + my %find_device = ( + $self->SPID, + deviceName => $deviceName + ); + my $level = 'ServiceProvider'; + + if ( $groupId ) { + $level = 'Group'; + $find_device{groupId} = $new_device{groupId} = $groupId; + } else { + # shouldn't be used in our current design + warn "$me creating access device $deviceName at Service Provider level\n"; + } + + my ($success, $message) = $self->request( + $level, $level.'AccessDeviceGetRequest18sp1', + %find_device + ); + + if ( $success ) { # modify in place + + ($success, $message) = $self->request( + $level => $level.'AccessDeviceModifyRequest14', + %new_device + ); + + } elsif ( $message =~ /Access Device not found/ ) { # create new + + ($success, $message) = $self->request( + $level => $level.'AccessDeviceAddRequest14', + %new_device + ); + + } + + if ($success) { + return ($deviceName, ''); + } else { + return ('', $message); + } +} + +=back + +=head2 PROVISIONING METHODS + +These return an error string on failure, and an empty string on success. + +=over 4 + +=item assign_number NUMBER, GROUPID + +Assigns a phone number to a group. If it's assigned to a different group or +doesn't belong to the service provider, this will fail. If it's already +assigned to I<this> group, it will do nothing and return success. + +=cut + +sub assign_number { + my ($self, $number, $groupId) = @_; + # see if it's already assigned + my ($success, $message) = $self->request( + Group => 'GroupDnGetAssignmentListRequest18', + $self->SPID, + groupId => $groupId, + searchCriteriaDn => { + mode => 'Equal To', + value => $number, + isCaseInsensitive => 'false', + }, + ); + return "$message (checking phone number status)" if !$success; + my $result = $self->oci_table( $message->{dnTable} ); + return '' if @$result > 0; + + ($success, $message) = $self->request( + Group => 'GroupDnAssignListRequest', + $self->SPID, + groupId => $groupId, + phoneNumber => $number, + ); + + $success ? '' : $message; +} + +=item release_number NUMBER, GROUPID + +Unassigns a phone number from a group. If it's assigned to a user in the +group then this will fail. If it's not assigned to the group at all, this +does nothing. + +=cut + +sub release_number { + my ($self, $number, $groupId) = @_; + # see if it's already assigned + my ($success, $message) = $self->request( + Group => 'GroupDnGetAssignmentListRequest18', + $self->SPID, + groupId => $groupId, + searchCriteriaDn => { + mode => 'Equal To', + value => $number, + isCaseInsensitive => 'false', + }, + ); + return "$message (checking phone number status)" if !$success; + my $result = $self->oci_table( $message->{dnTable} ); + return '' if @$result == 0; + + ($success, $message) = $self->request( + Group => 'GroupDnUnassignListRequest', + $self->SPID, + groupId => $groupId, + phoneNumber => $number, + ); + + $success ? '' : $message; +} + +=item set_endpoint USERID [, DEVICENAME ] + +Sets the endpoint for communicating with USERID to DEVICENAME. For now, this +assumes that all devices are defined at Group level. + +If DEVICENAME is null, the user will be set to have no endpoint. + +=cut + +# we only support linePort = userId, and no numbered ports + +sub set_endpoint { + my ($self, $userId, $deviceName) = @_; + + my $endpoint; + if ( length($deviceName) > 0 ) { + $endpoint = { + accessDeviceEndpoint => { + linePort => $userId, + accessDevice => { + deviceLevel => 'Group', + deviceName => $deviceName, + }, + } + }; + } else { + $endpoint = undef; + } + my ($success, $message) = $self->request( + User => 'UserModifyRequest17sp4', + userId => $userId, + endpoint => $endpoint, + ); + + $success ? '' : $message; +} + +=item set_sip_authentication USERID, NAME, PASSWORD + +Sets the SIP authentication credentials for USERID to (NAME, PASSWORD). + +=cut + +sub set_sip_authentication { + my ($self, $userId, $userName, $password) = @_; + + my ($success, $message) = $self->request( + 'Services/ServiceAuthentication' => 'UserAuthenticationModifyRequest', + userId => $userId, + userName => $userName, + newPassword => $password, + ); + + $success ? '' : $message; +} + +=item delete_group GROUPID + +Deletes the group GROUPID. + +=cut + +sub delete_Group { + my ($self, $groupId) = @_; + + my ($success, $message) = $self->request( + Group => 'GroupDeleteRequest', + $self->SPID, + groupId => $groupId + ); + if ( $success or $message =~ /Group not found/ ) { + return ''; + } else { + return $message; + } +} + +=item delete_User USERID + +Deletes the user USERID, and releases its phone number if it has one. + +=cut + +sub delete_User { + my ($self, $userId) = @_; + + my ($success, $message) = $self->request( + User => 'UserDeleteRequest', + userId => $userId + ); + if ($success or $message =~ /User not found/) { + return ''; + } else { + return $message; + } +} + +=item delete_Device DEVICENAME[, GROUPID ] + +Deletes the access device DEVICENAME (from group GROUPID, or from the service +provider if there is no GROUPID). + +=cut + +sub delete_Device { + my ($self, $deviceName, $groupId) = @_; + + my ($success, $message); + if ( $groupId ) { + ($success, $message) = $self->request( + Group => 'GroupAccessDeviceDeleteRequest', + $self->SPID, + groupId => $groupId, + deviceName => $deviceName, + ); + } else { + ($success, $message) = $self->request( + ServiceProvider => 'ServiceProviderAccessDeviceDeleteRequest', + $self->SPID, + deviceName => $deviceName, + ); + } + if ( $success or $message =~ /Access Device not found/ ) { + return ''; + } else { + return $message; + } +} + +=back + +=head2 CONVENIENCE METHODS + +=over 4 + +=item SPID + +Returns 'serviceProviderId' => the service_provider option. This is commonly +needed in request parameters. + +=item groupId CUST_MAIN + +Returns the groupID that goes with the specified customer. + +=item userId SVC_X + +Returns the userId (including domain) that should go with the specified +service. + +=item deviceName DEVICE + +Returns the access device name that should go with the specified phone_device +or pbx_device. + +=cut + +sub SPID { + my $self = shift; + my $id = $self->option('service_provider') or die 'service provider not set'; + 'serviceProviderId' => $id +} + +sub groupId { + my $self = shift; + my $cust_main = shift; + 'cust_main#'.$cust_main->custnum; +} + +sub userId { + my $self = shift; + my $svc = shift; + my $userId; + if ($svc->phonenum) { + $userId = $svc->phonenum; + } else { # pbx_extension needs one of these + die "can't determine userId for non-svc_phone service"; + } + my $domain = $self->option('domain'); # domsvc? + $userId .= '@' . $domain if $domain; + + return $userId; +} + +sub deviceName { + my $self = shift; + my $device = shift; + $device->mac_addr || ($device->table . '#' . $device->devicenum); +} + +=item oci_table HASHREF + +Converts the base OCITable type into an arrayref of hashrefs. + +=cut + +sub oci_table { + my $self = shift; + my $oci_table = shift; + my @colnames = $oci_table->{colHeading}; + my @data; + foreach my $row (@{ $oci_table->{row} }) { + my %hash; + @hash{@colnames} = @{ $row->{col} }; + push @data, \%hash; + } + + \@data; +} + +################# +# DID SELECTION # +################# + + + +################ +# CALL DETAILS # +################ + +=item import_cdrs START, END + +Retrieves CDRs for calls in the date range from START to END and inserts them +as a new CDR batch. On success, returns a new cdr_batch object. On failure, +returns an error message. If there are no new CDRs, returns nothing. + +=cut + +############## +# API ACCESS # +############## + +=item request SCOPE, COMMAND, [ ARGUMENTS... ] + +Wrapper for L<BroadWorks::OCI/request>. The client object will be cached. +Returns two values: a flag, true or false, indicating success of the request, +and the decoded response message as a hashref. + +On failure of the request (or failure to authenticate), the response message +will be a simple scalar containing the error message. + +=cut + +sub request { + my $self = shift; + + delete $client{$self->exportnum} if $expire{$self->exportnum} < time; + my $client = $client{$self->exportnum}; + if (!$client) { + local $@; + eval "use BroadWorks::OCI"; + die "$me $@" if $@; + + Log::Report::dispatcher('PERL', 'default', + mode => ($self->option('debug') ? 'DEBUG' : 'NORMAL') + ); + + $client = BroadWorks::OCI->new( + userId => $self->option('admin_user'), + password => $self->option('admin_pass'), + ); + my ($success, $message) = $client->login; + return ('', $message) if !$success; + + $client{$self->exportnum} = $client; # if login succeeded + $expire{$self->exportnum} = time + 120; # hardcoded, yeah + } + return $client->request(@_); +} + +1; diff --git a/FS/FS/part_export/cacti.pm b/FS/FS/part_export/cacti.pm index cbb50af79..a1447ac7b 100644 --- a/FS/FS/part_export/cacti.pm +++ b/FS/FS/part_export/cacti.pm @@ -219,7 +219,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=') @@ -235,7 +235,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=) @@ -248,7 +248,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)) }; @@ -303,7 +303,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=) @@ -337,7 +337,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('); @@ -370,7 +370,7 @@ sub process_graphs { my $param = thaw(decode_base64(shift)); $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"; @@ -416,7 +416,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('); @@ -435,7 +435,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), @@ -445,8 +447,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); @@ -493,8 +496,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); } @@ -550,6 +557,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 5a8da7bdb..67f0c5c91 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,12 @@ 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', + }, ; $notes1 = <<'END'; @@ -241,7 +248,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 +259,27 @@ 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'), + ); + 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 +302,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 +314,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 +330,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 +398,29 @@ 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'), + ); + 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 +613,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 +656,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) : ''; } @@ -1161,6 +1237,56 @@ 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) + +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; + 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 18a065da1..c9568c57d 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -168,7 +168,8 @@ I<custnum_ref> and I<options>. If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as values, appropriate FS::pkg_svc records will be inserted. I<hidden_svc> can be set to a hashref of svcparts and flag values ('Y' or '') to set the -'hidden' field in these records. +'hidden' field in these records, and I<provision_hold> can be set similarly +for the 'provision_hold' field in these records. If I<primary_svc> is set to the svcpart of the primary service, the appropriate FS::pkg_svc record will be updated. @@ -248,6 +249,7 @@ sub insert { warn " inserting pkg_svc records" if $DEBUG; my $pkg_svc = $options{'pkg_svc'} || {}; my $hidden_svc = $options{'hidden_svc'} || {}; + my $provision_hold = $options{'provision_hold'} || {}; foreach my $part_svc ( qsearch('part_svc', {} ) ) { my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; my $primary_svc = @@ -261,6 +263,7 @@ sub insert { 'quantity' => $quantity, 'primary_svc' => $primary_svc, 'hidden' => $hidden_svc->{$part_svc->svcpart}, + 'provision_hold' => $provision_hold->{$part_svc->svcpart}, } ); my $error = $pkg_svc->insert; if ( $error ) { @@ -335,13 +338,15 @@ sub delete { Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc> -and I<options> +Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>, +I<provision_hold> and I<options> If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as values, the appropriate FS::pkg_svc records will be replaced. I<hidden_svc> can be set to a hashref of svcparts and flag values ('Y' or '') to set the -'hidden' field in these records. +'hidden' field in these records. I<provision_hold> can be set +to a hashref of svcparts and flag values ('Y' or '') to set the field +in those records. If I<primary_svc> is set to the svcpart of the primary service, the appropriate FS::pkg_svc record will be updated. @@ -447,10 +452,12 @@ sub replace { warn " replacing pkg_svc records" if $DEBUG; my $pkg_svc = $options->{'pkg_svc'}; my $hidden_svc = $options->{'hidden_svc'} || {}; + my $provision_hold = $options->{'provision_hold'} || {}; if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs foreach my $part_svc ( qsearch('part_svc', {} ) ) { my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; my $hidden = $hidden_svc->{$part_svc->svcpart} || ''; + my $provision_hold = $provision_hold->{$part_svc->svcpart} || ''; my $primary_svc = ( defined($options->{'primary_svc'}) && $options->{'primary_svc'} && $options->{'primary_svc'} == $part_svc->svcpart @@ -466,16 +473,19 @@ sub replace { my $old_quantity = 0; my $old_primary_svc = ''; my $old_hidden = ''; + my $old_provision_hold = ''; if ( $old_pkg_svc ) { $old_quantity = $old_pkg_svc->quantity; $old_primary_svc = $old_pkg_svc->primary_svc if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed? $old_hidden = $old_pkg_svc->hidden; + $old_provision_hold = $old_pkg_svc->provision_hold; } next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc || - $old_hidden ne $hidden; + $old_hidden ne $hidden || + $old_provision_hold ne $provision_hold; my $new_pkg_svc = new FS::pkg_svc( { 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ), @@ -484,6 +494,7 @@ sub replace { 'quantity' => $quantity, 'primary_svc' => $primary_svc, 'hidden' => $hidden, + 'provision_hold' => $provision_hold, } ); my $error = $old_pkg_svc ? $new_pkg_svc->replace($old_pkg_svc) diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm index 2201384e8..3192f2f16 100644 --- a/FS/FS/part_pkg/flat.pm +++ b/FS/FS/part_pkg/flat.pm @@ -203,13 +203,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/pay_batch.pm b/FS/FS/pay_batch.pm index 364e7f63e..31bca2b89 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -223,7 +223,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: @@ -294,6 +296,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'; @@ -307,13 +311,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; @@ -359,6 +367,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; @@ -418,6 +427,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, @@ -457,21 +469,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/RBC.pm b/FS/FS/pay_batch/RBC.pm index 47fc8d49d..53f810852 100644 --- a/FS/FS/pay_batch/RBC.pm +++ b/FS/FS/pay_batch/RBC.pm @@ -90,7 +90,6 @@ $name = 'RBC'; my( $hash, $total, $line ) = @_; return "Can't process Credit Detail Record, aborting import" if ($hash->{'recordtype'} eq '2'); - $totaloffset = sprintf("%.2f", $totaloffset / 100 ); $total += $totaloffset; $total = sprintf("%.2f", $total); # We assume here that this is an 'All Records' or 'Input Records' report. @@ -109,10 +108,16 @@ $name = 'RBC'; #we already declined it this run, no takebacks if ($declined->{$hash->{'paybatchnum'}}) { #file counts this as part of total, but we skip - $totaloffset += $hash->{'paid'} + $totaloffset += sprintf("%.2f", $hash->{'paid'} / 100 ) if $hash->{'status'} eq ' '; #false laziness with 'approved' above return 1; } + #skipping W for now (maybe it should be declined?) + if ($hash->{'status'} eq 'W') { + #file counts this as part of total, but we skip + $totaloffset += sprintf("%.2f", $hash->{'paid'} / 100 ); + return 1; + } return ($hash->{'recordtype'} eq '3') || #Account Trailer Record, concludes returned items ($hash->{'subtype'} ne '0'); #error messages, etc, too late to apply to previous entry diff --git a/FS/FS/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/phone_device.pm b/FS/FS/phone_device.pm index ba765e026..9cc00dead 100644 --- a/FS/FS/phone_device.pm +++ b/FS/FS/phone_device.pm @@ -92,12 +92,12 @@ sub insert { my $dbh = dbh; my $error = $self->SUPER::insert; + $error ||= $self->export('device_insert'); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - $self->export('device_insert'); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -124,9 +124,8 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $self->export('device_delete'); - my $error = $self->SUPER::delete; + my $error = $self->export('device_delete') || $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -161,13 +160,13 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $new->SUPER::replace($old); + my $error = $new->SUPER::replace($old) + || $new->export('device_replace', $old); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - $new->export('device_replace', $old); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm index f79bb5e2d..fa82ec05b 100644 --- a/FS/FS/pkg_svc.pm +++ b/FS/FS/pkg_svc.pm @@ -52,6 +52,8 @@ definition includes =item hidden - 'Y' to hide this service on invoices, null otherwise. +=item provision_hold - 'Y' to release package hold when all services marked with this are provisioned + =back =head1 METHODS @@ -112,6 +114,7 @@ sub check { || $self->ut_number('svcpart') || $self->ut_number('quantity') || $self->ut_enum('hidden', [ '', 'Y' ] ) + || $self->ut_flag('provision_hold') ; return $error if $error; diff --git a/FS/FS/quotation.pm b/FS/FS/quotation.pm index fef69ed63..669a25417 100644 --- a/FS/FS/quotation.pm +++ b/FS/FS/quotation.pm @@ -342,6 +342,29 @@ sub _items_total { 'total_amount' => sprintf('%.2f',$total_recur), 'break_after' => 1, }; + # show 'first payment' line (setup + recur) if there are no prorated + # packages included + my $disable_total = 0; + foreach my $quotation_pkg ($self->quotation_pkg) { + my $part_pkg = $quotation_pkg->part_pkg; + 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 + ) + ) { + $disable_total = 1; + last; + } + } + if (!$disable_total) { + push @items, { + 'total_item' => $self->mt('First payment'), + 'total_amount' => sprintf('%.2f', $total_setup + $total_recur), + 'break_after' => 1, + }; + } } return @items; diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index 9505cea86..d30517051 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -348,7 +348,7 @@ sub dest_detail { }); } - return '' unless $rate_prefix; + return $self->default_detail unless $rate_prefix; $regionnum = $rate_prefix->regionnum; diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm index 2638abaaa..319126276 100644 --- a/FS/FS/svc_phone.pm +++ b/FS/FS/svc_phone.pm @@ -273,6 +273,8 @@ sub table { 'svc_phone'; } sub table_dupcheck_fields { ( 'countrycode', 'phonenum' ); } +sub device_table { 'phone_device'; } + =item search_sql STRING Class method which returns an SQL fragment to search for the given string. diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 12a3e987f..de60cff30 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -596,6 +596,7 @@ sub taxline { 'locationtaxid' => $self->location, 'taxable_cust_bill_pkg' => $cust_bill_pkg, 'taxratelocationnum' => $taxratelocationnum, + 'taxclass' => $class, }); push @tax_locations, $tax_location; @@ -647,6 +648,9 @@ sub taxline { 'edate' => '', 'itemdesc' => $name, 'cust_bill_pkg_tax_rate_location' => [ $_ ], + # Make the charge class easily accessible; we need it for tax-on-tax + # applicability. RT#36830. + '_class' => $_->taxclass, }); $_->set('tax_cust_bill_pkg' => $tax_item); push @tax_items, $tax_item; diff --git a/FS/MANIFEST b/FS/MANIFEST index baf11356e..5698bf4a2 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -36,6 +36,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 @@ -776,7 +778,6 @@ FS/deploy_zone_block.pm t/deploy_zone_block.t FS/deploy_zone_vertex.pm t/deploy_zone_vertex.t - FS/circuit_type.pm t/circuit_type.t FS/circuit_provider.pm @@ -792,7 +793,6 @@ t/legacy_cust_history.t FS/quotation_pkg_tax.pm t/quotation_pkg_tax.t FS/h_svc_circuit.pm -FS/h_svc_circuit.t FS/FeeOrigin_Mixin.pm FS/cust_pkg_reason_fee.pm t/cust_pkg_reason_fee.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"; |