diff options
Diffstat (limited to 'FS')
43 files changed, 1277 insertions, 308 deletions
diff --git a/FS/FS/API.pm b/FS/FS/API.pm index 629463c37..dd172c143 100644 --- a/FS/FS/API.pm +++ b/FS/FS/API.pm @@ -36,9 +36,10 @@ in plaintext. =over 4 -=item insert_payment +=item insert_payment OPTION => VALUE, ... -Adds a new payment to a customers account. Takes a hash reference as parameter with the following keys: +Adds a new payment to a customers account. Takes a list of keys and values as +paramters with the following keys: =over 5 @@ -60,9 +61,10 @@ Amount paid =item _date - Option date for payment +=back + Example: my $result = FS::API->insert_payment( @@ -82,8 +84,6 @@ Example: print "paynum ". $result->{'paynum'}; } -=back - =cut #enter cash payment @@ -133,9 +133,10 @@ sub _by_phonenum { } -=item insert_credit +=item insert_credit OPTION => VALUE, ... -Adds a a credit to a customers account. Takes a hash reference as parameter with the following keys +Adds a a credit to a customers account. Takes a list of keys and values as +parameters with the following keys =over @@ -155,6 +156,8 @@ Amount of the credit The date the credit will be posted +=back + Example: my $result = FS::API->insert_credit( @@ -173,8 +176,6 @@ Example: print "crednum ". $result->{'crednum'}; } -=back - =cut #Enter credit @@ -206,9 +207,10 @@ sub insert_credit_phonenum { } -=item insert_refund +=item insert_refund OPTION => VALUE, ... -Adds a a credit to a customers account. Takes a hash reference as parameter with the following keys: custnum,payby,refund +Adds a a credit to a customers account. Takes a list of keys and values as +parmeters with the following keys: custnum, payby, refund Example: @@ -270,9 +272,10 @@ sub insert_refund_phonenum { # long-term: package changes? -=item new_customer +=item new_customer OPTION => VALUE, ... -Creates a new customer. Takes a hash reference as parameter with the following keys: +Creates a new customer. Takes a list of keys and values as parameters with the +following keys: =over 4 @@ -402,6 +405,7 @@ Agent specific customer number Referring customer number +=back =cut @@ -425,35 +429,39 @@ sub new_customer { $class->API_insert( %opt ); } -=back - =item update_customer -Updates an existing customer. Takes a hash reference as parameter with the foll$ +Updates an existing customer. Passing an empty value clears that field, while +NOT passing that key/value at all leaves it alone. Takes a list of keys and +values as parameters with the following keys: =over 4 =item secret -API Secret +API Secret (required) + +=item custnum + +Customer number (required) =item first -first name (required) +first name =item last -last name (required) +last name =item company Company name -=item address1 (required) +=item address1 Address line one -=item city (required) +=item city City @@ -461,11 +469,11 @@ City County -=item state (required) +=item state State -=item zip (required) +=item zip Zip or postal code @@ -491,7 +499,9 @@ Mobile number =item invoicing_list -comma-separated list of email addresses for email invoices. The special value '$ +Comma-separated list of email addresses for email invoices. The special value +'POST' is used to designate postal invoicing (it may be specified alone or in +addition to email addresses), postal_invoicing Set to 1 to enable postal invoicing @@ -501,7 +511,8 @@ CARD, DCRD, CHEK, DCHK, LECB, BILL, COMP or PREPAY =item payinfo -Card number for CARD/DCRD, account_number@aba_number for CHEK/DCHK, prepaid "pi$ +Card number for CARD/DCRD, account_number@aba_number for CHEK/DCHK, prepaid +"pin" for PREPAY, purchase order number for BILL =item paycvv @@ -520,13 +531,17 @@ Exact name on credit card for CARD/DCRD, bank name for CHEK/DCHK Referring customer number =item salesnum + Sales person number =item agentnum Agent number +=back + =cut + sub update_customer { my( $class, %opt ) = @_; @@ -537,12 +552,10 @@ sub update_customer { FS::cust_main->API_update( %opt ); } -=back - +=item customer_info OPTION => VALUE, ... -=item customer_info - -Returns general customer information. Takes a hash reference as parameter with the following keys: custnum and API secret +Returns general customer information. Takes a list of keys and values as +parameters with the following keys: custnum, secret =cut @@ -560,9 +573,8 @@ sub customer_info { =item location_info -Returns location specific information for the customer. Takes a hash reference as parameter with the following keys: custnum,secret - -=back +Returns location specific information for the customer. Takes a list of keys +and values as paramters with the following keys: custnum, secret =cut @@ -586,6 +598,36 @@ sub location_info { return \%return; } +=item bill_now OPTION => VALUE, ... + +Bills a single customer now, in the same fashion as the "Bill now" link in the +UI. + +Returns a hash reference with a single key, 'error'. If there is an error, +the value contains the error, otherwise it is empty. + +=cut + +sub bill_now { + my( $class, %opt ) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} }) + or return { 'error' => 'Unknown custnum' }; + + my $error = $cust_main->bill_and_collect( 'fatal' => 'return', + 'retry' => 1, + 'check_freq' =>'1d', + ); + + return { 'error' => $error, + }; + +} + + #Advertising sources? diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 8276d7e4b..86c7ac324 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -46,6 +46,7 @@ use FS::payby; use FS::acct_rt_transaction; use FS::msg_template; use FS::contact; +use FS::cust_contact; $DEBUG = 1; $me = '[FS::ClientAPI::MyAccount]'; @@ -82,7 +83,7 @@ sub skin_info { #return { 'error' => $session } if $context eq 'error'; my $agentnum = ''; - if ( $context eq 'customer' ) { + if ( $context eq 'customer' && $custnum ) { my $sth = dbh->prepare('SELECT agentnum FROM cust_main WHERE custnum = ?') or die dbh->errstr; @@ -237,7 +238,16 @@ sub login { return { error => 'Incorrect contact password.' } unless $contact->authenticate_password($p->{'password'}); - $session->{'custnum'} = $contact->custnum; + my @cust_contact = grep $_->selfservice_access, $contact->cust_contact; + if ( scalar(@cust_contact) == 1 ) { + $session->{'custnum'} = $cust_contact[0]->custnum; + } elsif ( scalar(@cust_contact) ) { + $session->{'customers'} = { map { $_->custnum => $_->cust_main->name } + @cust_contact + }; + } else { + return { error => 'No customer self-service access for contact' }; #?? + } } else { @@ -303,6 +313,7 @@ sub login { return { 'error' => '', 'session_id' => $session_id, + %$session, }; } @@ -336,6 +347,23 @@ sub switch_acct { } +sub switch_cust { + my $p = shift; + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + $session->{'custnum'} = $p->{'custnum'} + if exists $session->{'customers'}{ $p->{'custnum'} }; + + my $conf = new FS::Conf; + my $timeout = $conf->config('selfservice-session_timeout') || '1 hour'; + _cache->set( $p->{'session_id'}, $session, $timeout ); + + return { 'error' => '', + %{ customer_info( { session_id=>$p->{'session_id'} } ) }, + }; +} + sub payment_gateway { # internal use only # takes a cust_main and a cust_payby entry, returns the payment_gateway @@ -380,22 +408,23 @@ sub access_info { my($context, $session, $custnum) = _custoragent_session_custnum($p); return { 'error' => $session } if $context eq 'error'; - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ); $info->{'hide_payment_fields'} = [ map { - my $pg = payment_gateway($cust_main, $_); + my $pg = $cust_main && payment_gateway($cust_main, $_); $pg && $pg->gateway_namespace eq 'Business::OnlineThirdPartyPayment'; } @{ $info->{cust_paybys} } ]; $info->{'self_suspend_reason'} = - $conf->config('selfservice-self_suspend_reason', $cust_main->agentnum); + $conf->config('selfservice-self_suspend_reason', + $cust_main ? $cust_main->agentnum : '' + ); $info->{'edit_ticket_subject'} = $conf->exists('ticket_system-selfservice_edit_subject') && - $cust_main->edit_subject; + $cust_main && $cust_main->edit_subject; $info->{'timeout'} = $conf->config('selfservice-timeout') || 3600; @@ -432,7 +461,7 @@ sub customer_info { my $search = { 'custnum' => $custnum }; $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; my $cust_main = qsearchs('cust_main', $search ) - or return { 'error' => "unknown custnum $custnum" }; + or return { 'error' => "customer_info: unknown custnum $custnum" }; my $list_tickets = list_tickets($p); $return{'tickets'} = $list_tickets->{'tickets'}; @@ -536,7 +565,7 @@ sub customer_info_short { my $search = { 'custnum' => $custnum }; $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; my $cust_main = qsearchs('cust_main', $search ) - or return { 'error' => "unknown custnum $custnum" }; + or return { 'error' => "customer_info_short: unknown custnum $custnum" }; $return{display_custnum} = $cust_main->display_custnum; @@ -2916,7 +2945,12 @@ sub myaccount_passwd { #need to support the "ISP provides email that's used as a contact email" case #as well as we can. my $contact = FS::contact->by_selfservice_email($svc_acct->email); - if ( $contact && $contact->custnum == $custnum ) { + if ( $contact && qsearchs('cust_contact', { contactnum=> $contact->contactnum, + custnum => $custnum, + selfservice_access => 'Y', + } + ) + ) { #svc_acct was successful but this one returns an error? "shouldn't happen" $error ||= $contact->change_password($p->{'new_password'}); } @@ -2993,7 +3027,10 @@ sub reset_passwd { $contact = FS::contact->by_selfservice_email($p->{'email'}); - $cust_main = $contact->cust_main if $contact; + if ( $contact ) { + my @cust_contact = grep $_->selfservice_access, $contact->cust_contact; + $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1; + } #also look for an svc_acct, otherwise it would be super confusing @@ -3035,6 +3072,9 @@ sub reset_passwd { } + return { %$info, 'error' => 'Multi-customer contacts incompatible with customer-based verification' } + if ! $cust_main && $verification ne 'email'; + my %verify = ( 'email' => sub { 1; }, 'paymask' => sub { @@ -3157,7 +3197,9 @@ sub check_reset_passwd { my @contact_email = $contact->contact_email; return { 'error' => 'No contact email' } unless @contact_email; - $p->{'agentnum'} = $contact->cust_main->agentnum; + my @cust_contact = grep $_->selfservice_access, $contact->cust_contact; + $p->{'agentnum'} = $cust_contact[0]->cust_main->agentnum + if scalar(@cust_contact) == 1; my $info = skin_info($p); return { %$info, @@ -3207,7 +3249,9 @@ sub process_reset_passwd { $contact = qsearchs('contact', { 'contactnum' => $contactnum } ) or return { 'error' => "Contact not found" }; - $p->{'agentnum'} ||= $contact->cust_main->agentnum; + my @cust_contact = grep $_->selfservice_access, $contact->cust_contact; + $p->{'agentnum'} = $cust_contact[0]->cust_main->agentnum + if scalar(@cust_contact) == 1; $info ||= skin_info($p); } diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm index 62f61d6e5..952b19940 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -102,6 +102,7 @@ sub ss2clientapi { 'login' => 'MyAccount/login', 'logout' => 'MyAccount/logout', 'switch_acct' => 'MyAccount/switch_acct', + 'switch_cust' => 'MyAccount/switch_cust', 'customer_info' => 'MyAccount/customer_info', 'customer_info_short' => 'MyAccount/customer_info_short', 'billing_history' => 'MyAccount/billing_history', diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 9ba3f0983..a1faecf4a 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -2996,7 +2996,7 @@ and customer address. Include units.', 'type' => 'select', 'select_hash' => [ '' => 'Password reset disabled', 'email' => 'Click on a link in email', - 'paymask,amount,zip' => 'Click on a link in email, and also verify with credit card (or bank account) last 4 digits, payment amount and zip code', + 'paymask,amount,zip' => 'Click on a link in email, and also verify with credit card (or bank account) last 4 digits, payment amount and zip code. Note: Do not use if you have multi-customer contacts, as they will be unable to reset their passwords.', ], }, diff --git a/FS/FS/Daemon/Preforking.pm b/FS/FS/Daemon/Preforking.pm index 98b4fa68c..f3a39a6ed 100644 --- a/FS/FS/Daemon/Preforking.pm +++ b/FS/FS/Daemon/Preforking.pm @@ -96,6 +96,7 @@ sub daemon_run { #parent doesn't need to hold a DB connection open dbh->disconnect; undef $FS::UID::dbh; + undef $RT::Handle; server_spawn(MAX_PROCESSES); POE::Kernel->run(); diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index d3e45dfee..37e3ad243 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -396,6 +396,9 @@ if ( -e $addl_handler_use_file ) { use FS::circuit_provider; use FS::circuit_termination; use FS::svc_circuit; + use FS::cust_credit_source_bill_pkg; + use FS::prospect_contact; + use FS::cust_contact; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index f8282c031..92fb89665 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -876,6 +876,7 @@ sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash); my $table = $_[0]; my(@result) = qsearch(@_); cluck "warning: Multiple records in scalar search ($table)" + #.join(' / ', map "$_=>".$_[1]->{$_}, keys %{ $_[1] } ) if scalar(@result) > 1; #should warn more vehemently if the search was on a primary key? scalar(@result) ? ($result[0]) : (); diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index d5ed1b718..133b6d81a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1740,20 +1740,69 @@ sub tables_hashref { 'index' => [ ['disabled'] ], }, + 'cust_contact' => { + 'columns' => [ + 'custcontactnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + 'contactnum', 'int', '', '', '', '', + 'classnum', 'int', 'NULL', '', '', '', + 'comment', 'varchar', 'NULL', 255, '', '', + 'selfservice_access', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'custcontactnum', + 'unique' => [ [ 'custnum', 'contactnum' ], ], + 'index' => [ [ 'custnum' ], [ 'contactnum' ], ], + 'foreign_keys' => [ + { columns => [ 'custnum' ], + table => 'cust_main', + }, + { columns => [ 'contactnum' ], + table => 'contact', + }, + { columns => [ 'classnum' ], + table => 'contact_class', + }, + ], + }, + + 'prospect_contact' => { + 'columns' => [ + 'prospectcontactnum', 'serial', '', '', '', '', + 'prospectnum', 'int', '', '', '', '', + 'contactnum', 'int', '', '', '', '', + 'classnum', 'int', 'NULL', '', '', '', + 'comment', 'varchar', 'NULL', 255, '', '', + ], + 'primary_key' => 'prospectcontactnum', + 'unique' => [ [ 'prospectnum', 'contactnum' ], ], + 'index' => [ [ 'prospectnum' ], [ 'contactnum' ], ], + 'foreign_keys' => [ + { columns => [ 'prospectnum' ], + table => 'prospect_main', + }, + { columns => [ 'contactnum' ], + table => 'contact', + }, + { columns => [ 'classnum' ], + table => 'contact_class', + }, + ], + }, + 'contact' => { 'columns' => [ 'contactnum', 'serial', '', '', '', '', - 'prospectnum', 'int', 'NULL', '', '', '', - 'custnum', 'int', 'NULL', '', '', '', + 'prospectnum', 'int', 'NULL', '', '', '', #deprecated, now prospect_contact table + 'custnum', 'int', 'NULL', '', '', '', #deprecated, now cust_contact table 'locationnum', 'int', 'NULL', '', '', '', #not yet - 'classnum', 'int', 'NULL', '', '', '', + 'classnum', 'int', 'NULL', '', '', '', #deprecated, now prospect_contact or cust_contact # 'titlenum', 'int', 'NULL', '', '', '', #eg Mr. Mrs. Dr. Rev. 'last', 'varchar', '', $char_d, '', '', # 'middle', 'varchar', 'NULL', $char_d, '', '', 'first', 'varchar', '', $char_d, '', '', 'title', 'varchar', 'NULL', $char_d, '', '', #eg Head Bottle Washer - 'comment', 'varchar', 'NULL', 255, '', '', - 'selfservice_access', 'char', 'NULL', 1, '', '', + 'comment', 'varchar', 'NULL', 255, '', '', #depredated, now prospect_contact or cust_contact + 'selfservice_access', 'char', 'NULL', 1, '', '', #deprecated, now cust_contact '_password', 'varchar', 'NULL', $char_d, '', '', '_password_encoding', 'varchar', 'NULL', $char_d, '', '', 'disabled', 'char', 'NULL', 1, '', '', diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index e26592cee..95d001e83 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -7,7 +7,7 @@ use vars qw( $DEBUG $me ); # but NOT $conf use vars qw( $invoice_lines @buf ); #yuck -use List::Util qw(sum); +use List::Util qw(sum first); use Date::Format; use Date::Language; use Text::Template 1.20; @@ -908,29 +908,6 @@ sub print_generic { warn "$me generating sections\n" if $DEBUG > 1; - my $taxtotal = 0; - my $tax_section = { 'description' => $self->mt('Taxes, Surcharges, and Fees'), - 'subtotal' => $taxtotal, # adjusted below - 'tax_section' => 1, - }; - my $tax_weight = _pkg_category($tax_section->{description}) - ? _pkg_category($tax_section->{description})->weight - : 0; - $tax_section->{'summarized'} = ''; #why? $summarypage && !$tax_weight ? 'Y' : ''; - $tax_section->{'sort_weight'} = $tax_weight; - - my $adjusttotal = 0; - my $adjust_section = { - 'description' => $self->mt('Credits, Payments, and Adjustments'), - 'adjust_section' => 1, - 'subtotal' => 0, # adjusted below - }; - my $adjust_weight = _pkg_category($adjust_section->{description}) - ? _pkg_category($adjust_section->{description})->weight - : 0; - $adjust_section->{'summarized'} = ''; #why? $summarypage && !$adjust_weight ? 'Y' : ''; - $adjust_section->{'sort_weight'} = $adjust_weight; - my $unsquelched = $params{unsquelch_cdr} || $cust_main->squelch_cdr ne 'Y'; my $multisection = $conf->exists($tc.'sections', $cust_main->agentnum) || $conf->exists($tc.'sections_by_location', $cust_main->agentnum); @@ -971,6 +948,21 @@ sub print_generic { $previous_section = $default_section; } + my $adjust_section = { + 'description' => $self->mt('Credits, Payments, and Adjustments'), + 'adjust_section' => 1, + 'subtotal' => 0, # adjusted below + }; + my $adjust_weight = _pkg_category($adjust_section->{description}) + ? _pkg_category($adjust_section->{description})->weight + : 0; + $adjust_section->{'summarized'} = ''; #why? $summarypage && !$adjust_weight ? 'Y' : ''; + # Note: 'sort_weight' here is actually a flag telling whether there is an + # explicit package category for the adjust section. If so, certain behavior + # happens. + $adjust_section->{'sort_weight'} = $adjust_weight; + + if ( $multisection ) { ($extra_sections, $extra_lines) = $self->_items_extra_usage_sections($escape_function_nonbsp, $format) @@ -1220,6 +1212,26 @@ sub print_generic { warn "$me adding taxes\n" if $DEBUG > 1; + # create a tax section if we don't yet have one + my $tax_description = 'Taxes, Surcharges, and Fees'; + my $tax_section = first { $_->{description} eq $tax_description } @sections; + if (!$tax_section) { + $tax_section = { 'description' => $tax_description }; + push @sections, $tax_section if $multisection; + } + $tax_section->{tax_section} = 1; # mark this section as containing taxes + # if this is an existing tax section, we're merging the tax items into it. + # grab the taxtotal that's already there, strip the money symbol if any + my $taxtotal = $tax_section->{'subtotal'} || 0; + $taxtotal =~ s/^\Q$other_money_char\E//; + + # this does nothing + #my $tax_weight = _pkg_category($tax_section->{description}) + # ? _pkg_category($tax_section->{description})->weight + # : 0; + #$tax_section->{'summarized'} = ''; #why? $summarypage && !$tax_weight ? 'Y' : ''; + #$tax_section->{'sort_weight'} = $tax_weight; + my @items_tax = $self->_items_tax; foreach my $tax ( @items_tax ) { @@ -1262,14 +1274,20 @@ sub print_generic { $other_money_char. sprintf('%.2f', $self->charged - $taxtotal ); if ( $multisection ) { - $tax_section->{'subtotal'} = $other_money_char. - sprintf('%.2f', $taxtotal); - $tax_section->{'pretotal'} = 'New charges sub-total '. - $total->{'total_amount'}; - if ( $taxtotal ) { - push @sections, $tax_section; - push @summary_subtotals, $tax_section; + if ( $taxtotal > 0 ) { + $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); + + # append it if it's not already there + if ( !grep $tax_section, @sections ) { + push @sections, $tax_section; + push @summary_subtotals, $tax_section; + } } + } else { unshift @total_items, $total; } @@ -1285,7 +1303,6 @@ sub print_generic { $money_char. sprintf("%10.2f",$self->charged) ]; push @buf,['','']; - ### # Totals ### @@ -1361,7 +1378,6 @@ sub print_generic { $total->{'total_item'} = &$escape_function($credit->{'description'}); $credittotal += $credit->{'amount'}; $total->{'total_amount'} = $minus.$other_money_char.$credit->{'amount'}; - $adjusttotal += $credit->{'amount'}; if ( $multisection ) { push @detail_items, { ext_description => [], @@ -1395,7 +1411,6 @@ sub print_generic { $total->{'total_item'} = &$escape_function($payment->{'description'}); $paymenttotal += $payment->{'amount'}; $total->{'total_amount'} = $minus.$other_money_char.$payment->{'amount'}; - $adjusttotal += $payment->{'amount'}; if ( $multisection ) { push @detail_items, { ext_description => [], @@ -1417,7 +1432,10 @@ sub print_generic { if ( $multisection ) { $adjust_section->{'subtotal'} = $other_money_char. - sprintf('%.2f', $adjusttotal); + sprintf('%.2f', $credittotal + $paymenttotal); + + #why this? because {sort_weight} forces the adjust_section to appear + #in @extra_sections instead of @sections. obviously. push @sections, $adjust_section unless $adjust_section->{sort_weight}; # do not summarize; adjustments there are shown according to @@ -2794,11 +2812,16 @@ equivalent to $self->_items_cust_bill_pkg([ $self->cust_bill_pkg ]) -The only OPTIONS accepted is 'section', which may point to a hashref -with a key named 'condensed', which may have a true value. If it -does, this method tries to merge identical items into items with -'quantity' equal to the number of items (not the sum of their -separate quantities, for some reason). +OPTIONS are passed through to _items_cust_bill_pkg, and should include +'format' and 'escape_function' at minimum. + +To produce items for a specific invoice section, OPTIONS should include +'section', a hashref containing 'category' and/or 'locationnum' keys. + +'section' may also contain a key named 'condensed'. If this is present +and has a true value, _items_pkg will try to merge identical items into items +with 'quantity' equal to the number of items (not the sum of their separate +quantities, for some reason). =cut @@ -2830,6 +2853,8 @@ sub _items_fee { my $self = shift; my %options = @_; my @cust_bill_pkg = grep { $_->feepart } $self->cust_bill_pkg; + my $escape_function = $options{escape_function}; + my @items; foreach my $cust_bill_pkg (@cust_bill_pkg) { # cache this, so we don't look it up again in every section @@ -2864,13 +2889,19 @@ sub _items_fee { } foreach (sort keys(%base_invnums)) { next if $_ == $self->invnum; + # per convention, we must escape ext_description lines push @ext_desc, - $self->mt('from invoice \\#[_1] on [_2]', $_, $base_invnums{$_}); + &{$escape_function}( + $self->mt('from invoice #[_1] on [_2]', $_, $base_invnums{$_}) + ); } + my $desc = $part_fee->itemdesc_locale($self->cust_main->locale); + # but not escape the base description line + push @items, { feepart => $cust_bill_pkg->feepart, amount => sprintf('%.2f', $cust_bill_pkg->setup + $cust_bill_pkg->recur), - description => $part_fee->itemdesc_locale($self->cust_main->locale), + description => $desc, ext_description => \@ext_desc # sdate/edate? }; diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index 4719caa22..d05b309c7 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -312,6 +312,9 @@ sub upgrade_data { #cust_main (remove paycvv from history) 'cust_main' => [], + #contact -> cust_contact / prospect_contact + 'contact' => [], + #msgcat 'msgcat' => [], diff --git a/FS/FS/contact.pm b/FS/FS/contact.pm index 3205df106..89bfb745b 100644 --- a/FS/FS/contact.pm +++ b/FS/FS/contact.pm @@ -3,12 +3,15 @@ use base qw( FS::Record ); use strict; use vars qw( $skip_fuzzyfiles ); +use Carp; use Scalar::Util qw( blessed ); use FS::Record qw( qsearch qsearchs dbh ); use FS::contact_phone; use FS::contact_email; use FS::queue; use FS::phone_type; #for cgi_contact_fields +use FS::cust_contact; +use FS::prospect_contact; $skip_fuzzyfiles = 0; @@ -123,10 +126,88 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + #save off and blank values that move to cust_contact / prospect_contact now + my $prospectnum = $self->prospectnum; + $self->prospectnum(''); + my $custnum = $self->custnum; + $self->custnum(''); + + my %link_hash = (); + for (qw( classnum comment selfservice_access )) { + $link_hash{$_} = $self->get($_); + $self->$_(''); + } + + #look for an existing contact with this email address + my $existing_contact = ''; + if ( $self->get('emailaddress') =~ /\S/ ) { + + my %existing_contact = (); + + foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) { + + my $contact_email = qsearchs('contact_email', { emailaddress=>$email } ) + or next; + + my $contact = $contact_email->contact; + $existing_contact{ $contact->contactnum } = $contact; + + } + + if ( scalar( keys %existing_contact ) > 1 ) { + $dbh->rollback if $oldAutoCommit; + return 'Multiple email addresses specified '. + ' that already belong to separate contacts'; + } elsif ( scalar( keys %existing_contact ) ) { + ($existing_contact) = values %existing_contact; + } + + } + + if ( $existing_contact ) { + + $self->$_($existing_contact->$_()) + for qw( contactnum _password _password_encoding ); + $self->SUPER::replace($existing_contact); + + } else { + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + my $cust_contact = ''; + if ( $custnum ) { + my %hash = ( 'contactnum' => $self->contactnum, + 'custnum' => $custnum, + ); + $cust_contact = qsearchs('cust_contact', \%hash ) + || new FS::cust_contact { %hash, %link_hash }; + my $error = $cust_contact->custcontactnum ? $cust_contact->replace + : $cust_contact->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( $prospectnum ) { + my %hash = ( 'contactnum' => $self->contactnum, + 'prospectnum' => $prospectnum, + ); + my $prospect_contact = qsearchs('prospect_contact', \%hash ) + || new FS::prospect_contact { %hash, %link_hash }; + my $error = + $prospect_contact->prospectcontactnum ? $prospect_contact->replace + : $prospect_contact->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ } @@ -134,12 +215,14 @@ sub insert { $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)"; my $phonetypenum = $1; - my $contact_phone = new FS::contact_phone { - 'contactnum' => $self->contactnum, - 'phonetypenum' => $phonetypenum, - _parse_phonestring( $self->get($pf) ), - }; - $error = $contact_phone->insert; + my %hash = ( 'contactnum' => $self->contactnum, + 'phonetypenum' => $phonetypenum, + ); + my $contact_phone = + qsearchs('contact_phone', \%hash) + || new FS::contact_phone { %hash, _parse_phonestring($self->get($pf)) }; + my $error = $contact_phone->contactphonenum ? $contact_phone->replace + : $contact_phone->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -149,17 +232,18 @@ sub insert { if ( $self->get('emailaddress') =~ /\S/ ) { foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) { - - my $contact_email = new FS::contact_email { + my %hash = ( 'contactnum' => $self->contactnum, 'emailaddress' => $email, - }; - $error = $contact_email->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + ); + unless ( qsearchs('contact_email', \%hash) ) { + my $contact_email = new FS::contact_email \%hash; + my $error = $contact_email->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } - } } @@ -167,14 +251,17 @@ sub insert { unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) { #warn " queueing fuzzyfiles update\n" # if $DEBUG > 1; - $error = $self->queue_fuzzyfiles_update; + my $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "updating fuzzy search cache: $error"; } } - if ( $self->selfservice_access ) { + if ( $link_hash{'selfservice_access'} eq 'R' + or ( $link_hash{'selfservice_access'} && $cust_contact ) + ) + { my $error = $self->send_reset_email( queue=>1 ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -208,6 +295,44 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + #got a prospetnum or custnum? delete the prospect_contact or cust_contact link + + if ( $self->prospectnum ) { + my $prospect_contact = qsearchs('prospect_contact', { + 'contactnum' => $self->contactnum, + 'prospectnum' => $self->prospectnum, + }); + my $error = $prospect_contact->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( $self->custnum ) { + my $cust_contact = qsearchs('cust_contact', { + 'contactnum' => $self->contactnum, + 'custnum' => $self->custnum, + }); + my $error = $cust_contact->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + # then, proceed with deletion only if the contact isn't attached to any other + # prospects or customers + + #inefficient, but how many prospects/customers can a single contact be + # attached too? (and is removing them from one a common operation?) + if ( $self->prospect_contact || $self->cust_contact ) { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; + } + + #proceed with deletion + foreach my $cust_pkg ( $self->cust_pkg ) { $cust_pkg->contactnum(''); my $error = $cust_pkg->replace; @@ -262,13 +387,62 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + #save off and blank values that move to cust_contact / prospect_contact now + my $prospectnum = $self->prospectnum; + $self->prospectnum(''); + my $custnum = $self->custnum; + $self->custnum(''); + + my %link_hash = (); + for (qw( classnum comment selfservice_access )) { + $link_hash{$_} = $self->get($_); + $self->$_(''); + } + my $error = $self->SUPER::replace($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) } + my $cust_contact = ''; + if ( $custnum ) { + my %hash = ( 'contactnum' => $self->contactnum, + 'custnum' => $custnum, + ); + my $error; + if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) { + $cust_contact->$_($link_hash{$_}) for keys %link_hash; + $error = $cust_contact->replace; + } else { + $cust_contact = new FS::cust_contact { %hash, %link_hash }; + $error = $cust_contact->insert; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( $prospectnum ) { + my %hash = ( 'contactnum' => $self->contactnum, + 'prospectnum' => $prospectnum, + ); + my $error; + if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) { + $prospect_contact->$_($link_hash{$_}) for keys %link_hash; + $error = $prospect_contact->replace; + } else { + my $prospect_contact = new FS::prospect_contact { %hash, %link_hash }; + $error = $prospect_contact->insert; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + foreach my $pf ( grep { /^phonetypenum(\d+)$/ } keys %{ $self->hashref } ) { $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)"; my $phonetypenum = $1; @@ -276,10 +450,26 @@ sub replace { my %cp = ( 'contactnum' => $self->contactnum, 'phonetypenum' => $phonetypenum, ); - my $contact_phone = qsearchs('contact_phone', \%cp) - || new FS::contact_phone \%cp; + my $contact_phone = qsearchs('contact_phone', \%cp); + + my $pv = $self->get($pf); + $pv =~ s/\s//g; + + #if new value is empty, delete old entry + if (!$pv) { + if ($contact_phone) { + $error = $contact_phone->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + next; + } - my %cpd = _parse_phonestring( $self->get($pf) ); + $contact_phone ||= new FS::contact_phone \%cp; + + my %cpd = _parse_phonestring( $pv ); $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd; my $method = $contact_phone->contactphonenum ? 'replace' : 'insert'; @@ -329,11 +519,14 @@ sub replace { } } - if ( ( $old->selfservice_access eq '' && $self->selfservice_access - && ! $self->_password - ) - || $self->_resend() - ) + if ( $cust_contact and ( + ( $cust_contact->selfservice_access eq '' + && $link_hash{selfservice_access} + && ! length($self->_password) + ) + || $cust_contact->_resend() + ) + ) { my $error = $self->send_reset_email( queue=>1 ); if ( $error ) { @@ -450,7 +643,6 @@ sub check { ; return $error if $error; - return "No prospect or customer!" unless $self->prospectnum || $self->custnum; return "Prospect and customer!" if $self->prospectnum && $self->custnum; return "One of first name, last name, or title must have a value" @@ -487,17 +679,35 @@ sub firstlast { $self->first . ' ' . $self->last; } -=item contact_classname - -Returns the name of this contact's class (see L<FS::contact_class>). - -=cut - -sub contact_classname { - my $self = shift; - my $contact_class = $self->contact_class or return ''; - $contact_class->classname; -} +#=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ +# +#Returns the name of this contact's class for the specified prospect or +#customer (see L<FS::prospect_contact>, L<FS::cust_contact> and +#L<FS::contact_class>). +# +#=cut +# +#sub contact_classname { +# my( $self, $prospect_or_cust ) = @_; +# +# my $link = ''; +# if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) { +# $link = qsearchs('prospect_contact', { +# 'contactnum' => $self->contactnum, +# 'prospectnum' => $prospect_or_cust->prospectnum, +# }); +# } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) { +# $link = qsearchs('cust_contact', { +# 'contactnum' => $self->contactnum, +# 'custnum' => $prospect_or_cust->custnum, +# }); +# } else { +# croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object"; +# } +# +# my $contact_class = $link->contact_class or return ''; +# $contact_class->classname; +#} =item by_selfservice_email EMAILADDRESS @@ -514,8 +724,7 @@ sub by_selfservice_email { 'table' => 'contact_email', 'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ', 'hashref' => { 'emailaddress' => $email, }, - 'extra_sql' => " AND selfservice_access = 'Y' ". - " AND ( disabled IS NULL OR disabled = '' )", + 'extra_sql' => " AND ( disabled IS NULL OR disabled = '' )", }) or return ''; $contact_email->contact; @@ -616,10 +825,12 @@ sub send_reset_email { my $conf = new FS::Conf; - my $cust_main = $self->cust_main - or die "no customer"; #reset a password for a prospect contact? someday + my $cust_main = ''; + my @cust_contact = grep $_->selfservice_access, $self->cust_contact; + $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1; - my $msgnum = $conf->config('selfservice-password_reset_msgnum', $cust_main->agentnum); + my $agentnum = $cust_main ? $cust_main->agentnum : ''; + my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum); #die "selfservice-password_reset_msgnum unset" unless $msgnum; return { 'error' => "selfservice-password_reset_msgnum unset" } unless $msgnum; my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } ); @@ -634,7 +845,7 @@ sub send_reset_email { my $queue = new FS::queue { 'job' => 'FS::Misc::process_send_email', - 'custnum' => $cust_main->custnum, + 'custnum' => $cust_main ? $cust_main->custnum : '', }; $queue->insert( $msg_template->prepare( %msg_template ) ); @@ -677,7 +888,21 @@ sub cgi_contact_fields { } -use FS::phone_type; +use FS::upgrade_journal; +sub _upgrade_data { #class method + my ($class, %opts) = @_; + + unless ( FS::upgrade_journal->is_done('contact__DUPEMAIL') ) { + + foreach my $contact (qsearch('contact', {})) { + my $error = $contact->replace; + die $error if $error; + } + + FS::upgrade_journal->set_done('contact__DUPEMAIL'); + } + +} =back diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 888e88bb8..068d0d1d3 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1900,7 +1900,14 @@ sub print_csv { if ( lc($opt{'format'}) eq 'billco' ) { my $lineseq = 0; - foreach my $item ( $self->_items_pkg ) { + my %items_opt = ( format => 'template', + escape_function => sub { shift } ); + # I don't know what characters billco actually tolerates in spool entries. + # Text::CSV will take care of delimiters, though. + + my @items = ( $self->_items_pkg(%items_opt), + $self->_items_fee(%items_opt) ); + foreach my $item (@items) { my $description = $item->{'description'}; if ( $item->{'_is_discount'} and exists($item->{ext_description}[0]) ) { diff --git a/FS/FS/cust_bill_pkg_tax_location.pm b/FS/FS/cust_bill_pkg_tax_location.pm index 468e6ae99..2ffc27357 100644 --- a/FS/FS/cust_bill_pkg_tax_location.pm +++ b/FS/FS/cust_bill_pkg_tax_location.pm @@ -122,7 +122,7 @@ sub check { || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' ) || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype || $self->ut_enum('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] ) - || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum' ) + || $self->ut_number('pkgnum', 'cust_pkg', 'pkgnum' ) || $self->ut_foreign_key('locationnum', 'cust_location', 'locationnum' ) || $self->ut_money('amount') || $self->ut_foreign_key('taxable_billpkgnum', 'cust_bill_pkg', 'billpkgnum') diff --git a/FS/FS/cust_contact.pm b/FS/FS/cust_contact.pm new file mode 100644 index 000000000..6f899d83f --- /dev/null +++ b/FS/FS/cust_contact.pm @@ -0,0 +1,146 @@ +package FS::cust_contact; +use base qw( FS::Record ); + +use strict; +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::cust_contact - Object methods for cust_contact records + +=head1 SYNOPSIS + + use FS::cust_contact; + + $record = new FS::cust_contact \%hash; + $record = new FS::cust_contact { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_contact object represents a contact's attachment to a specific +customer. FS::cust_contact inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item custcontactnum + +primary key + +=item custnum + +custnum + +=item contactnum + +contactnum + +=item classnum + +classnum + +=item comment + +comment + +=item selfservice_access + +empty or Y + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cust_contact'; } + +=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 record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + if ( $self->selfservice_access eq 'R' ) { + $self->selfservice_access('Y'); + $self->_resend('Y'); + } + + my $error = + $self->ut_numbern('custcontactnum') + || $self->ut_number('custnum') + || $self->ut_number('contactnum') + || $self->ut_numbern('classnum') + || $self->ut_textn('comment') + || $self->ut_enum('selfservice_access', [ '', 'Y' ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=item contact_classname + +Returns the name of this contact's class (see L<FS::contact_class>). + +=cut + +sub contact_classname { + my $self = shift; + my $contact_class = $self->contact_class or return ''; + $contact_class->classname; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::contact>, L<FS::cust_main>, L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index d6f1a3176..cd675f9d4 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -71,7 +71,7 @@ use FS::agent_payment_gateway; use FS::banned_pay; use FS::cust_main_note; use FS::cust_attachment; -use FS::contact; +use FS::cust_contact; use FS::Locales; use FS::upgrade_journal; use FS::sales; @@ -529,11 +529,23 @@ sub insert { return $error; } - my @contact = $prospect_main->contact; + foreach my $prospect_contact ( $prospect_main->prospect_contact ) { + my $cust_contact = new FS::cust_contact { + 'custnum' => $self->custnum, + map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment ) + }; + my $error = $cust_contact->insert + || $prospect_contact->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my @cust_location = $prospect_main->cust_location; my @qual = $prospect_main->qual; - foreach my $r ( @contact, @cust_location, @qual ) { + foreach my $r ( @cust_location, @qual ) { $r->prospectnum(''); $r->custnum($self->custnum); my $error = $r->replace; @@ -1915,14 +1927,13 @@ sub cust_location { =item cust_contact -Returns all contacts (see L<FS::contact>) for this customer. +Returns all contact associations (see L<FS::cust_contact>) for this customer. =cut -#already used :/ sub contact { sub cust_contact { my $self = shift; - qsearch('contact', { 'custnum' => $self->custnum } ); + qsearch('cust_contact', { 'custnum' => $self->custnum } ); } =item cust_payby @@ -3656,9 +3667,11 @@ sub service_contact { my $classnum = $self->scalar_sql( 'SELECT classnum FROM contact_class WHERE classname = \'Service\'' ) || 0; #if it's zero, qsearchs will return nothing - $self->{service_contact} = qsearchs('contact', { - 'classnum' => $classnum, 'custnum' => $self->custnum - }) || undef; + my $cust_contact = qsearchs('cust_contact', { + 'classnum' => $classnum, + 'custnum' => $self->custnum, + }); + $self->{service_contact} = $cust_contact->contact if $cust_contact; } $self->{service_contact}; } @@ -4614,6 +4627,42 @@ sub _agent_plandata { } +sub process_o2m_qsearch { + my $self = shift; + my $table = shift; + return qsearch($table, @_) unless $table eq 'contact'; + + my $hashref = shift; + my %hash = %$hashref; + ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/ + or die 'guru meditation #4343'; + + qsearch({ 'table' => 'contact', + 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )', + 'hashref' => \%hash, + 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ). + " cust_contact.custnum = $custnum " + }); +} + +sub process_o2m_qsearchs { + my $self = shift; + my $table = shift; + return qsearchs($table, @_) unless $table eq 'contact'; + + my $hashref = shift; + my %hash = %$hashref; + ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/ + or die 'guru meditation #2121'; + + qsearchs({ 'table' => 'contact', + 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )', + 'hashref' => \%hash, + 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ). + " cust_contact.custnum = $custnum " + }); +} + =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ] Subroutine (not a method), designed to be called from the queue. diff --git a/FS/FS/cust_main/API.pm b/FS/FS/cust_main/API.pm index 4a09b936a..158b5cf58 100644 --- a/FS/FS/cust_main/API.pm +++ b/FS/FS/cust_main/API.pm @@ -159,11 +159,10 @@ sub API_insert { sub API_update { - my( $class, %opt ) = @_; + my( $class, %opt ) = @_; my $conf = new FS::Conf; - my $custnum = $opt{'custnum'} or return { 'error' => "no customer record" }; @@ -180,43 +179,47 @@ sub API_update { payby payinfo paydate paycvv payname ), - - my @invoicing_list = $opt{'invoicing_list'} - ? split( /\s*\,\s*/, $opt{'invoicing_list'} ) - : (); - push @invoicing_list, 'POST' if $opt{'postal_invoicing'}; - - my ($bill_hash, $ship_hash); - foreach my $f (FS::cust_main->location_fields) { - # avoid having to change this in front-end code - $bill_hash->{$f} = $opt{"bill_$f"} || $opt{$f}; - $ship_hash->{$f} = $opt{"ship_$f"}; + my @invoicing_list; + if ( exists $opt{'invoicing_list'} || exists $opt{'postal_invoicing'} ) { + @invoicing_list = split( /\s*\,\s*/, $opt{'invoicing_list'} ); + push @invoicing_list, 'POST' if $opt{'postal_invoicing'}; + } else { + @invoicing_list = $cust_main->invoicing_list; } - my $bill_location = FS::cust_location->new($bill_hash); - my $ship_location; - # we don't have an equivalent of the "same" checkbox in selfservice^Wthis API - # so is there a ship address, and if so, is it different from the billing - # address? - if ( length($ship_hash->{address1}) > 0 and - grep { $bill_hash->{$_} ne $ship_hash->{$_} } keys(%$ship_hash) - ) { + if ( exists( $opt{'address1'} ) ) { + my $bill_location = FS::cust_location->new({ + map { $_ => $opt{$_} } @location_editable_fields + }); + $bill_location->set('custnum' => $custnum); + my $error = $bill_location->find_or_insert; + die $error if $error; - $ship_location = FS::cust_location->new( $ship_hash ); - - } else { - $ship_location = $bill_location; + # if this is unchanged from before, cust_main::replace will ignore it + $new->set('bill_location' => $bill_location); } - $new->set('bill_location' => $bill_location); - $new->set('ship_location' => $ship_location); + if ( exists($opt{'ship_address1'}) && length($opt{"ship_address1"}) > 0 ) { + my $ship_location = FS::cust_location->new({ + map { $_ => $opt{"ship_$_"} } @location_editable_fields + }); + + $ship_location->set('custnum' => $custnum); + my $error = $ship_location->find_or_insert; + die $error if $error; + + $new->set('ship_location' => $ship_location); + + } elsif (exists($opt{'ship_address1'} ) && !grep { length($opt{"ship_$_"}) } @location_editable_fields ) { + my $ship_location = $new->bill_location; + $new->set('ship_location' => $ship_location); + } my $error = $new->replace( $cust_main, \@invoicing_list ); return { 'error' => $error } if $error; - + return { 'error' => '', - }; - + }; } 1; diff --git a/FS/FS/cust_pkg_discount.pm b/FS/FS/cust_pkg_discount.pm index b74a23111..5d0f85b5e 100644 --- a/FS/FS/cust_pkg_discount.pm +++ b/FS/FS/cust_pkg_discount.pm @@ -1,5 +1,8 @@ package FS::cust_pkg_discount; -use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record ); +use base qw( FS::otaker_Mixin + FS::cust_main_Mixin + FS::pkg_discount_Mixin + FS::Record ); use strict; use FS::Record qw( dbh ); # qsearch qsearchs dbh ); @@ -82,52 +85,6 @@ sub table { 'cust_pkg_discount'; } Adds this record to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - #my( $self, %options ) = @_; - 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; - - if ( $self->discountnum == -1 ) { - my $discount = new FS::discount { - '_type' => $self->_type, - 'amount' => $self->amount, - 'percent' => $self->percent, - 'months' => $self->months, - 'setup' => $self->setup, - #'linked' => $self->linked, - 'disabled' => 'Y', - }; - my $error = $discount->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $self->discountnum($discount->discountnum); - } - - my $error = $self->SUPER::insert; #(@_); #(%options); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - =item delete Delete this record from the database. diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index f45fb2aef..94d478f6f 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -278,16 +278,17 @@ A hash reference of additional substitutions sub prepare { my( $self, %opt ) = @_; - my $cust_main = $opt{'cust_main'} or die 'cust_main required'; + my $cust_main = $opt{'cust_main'}; # or die 'cust_main required'; my $object = $opt{'object'} or die 'object required'; # localization - my $locale = $cust_main->locale || ''; + my $locale = $cust_main && $cust_main->locale || ''; warn "no locale for cust#".$cust_main->custnum."; using default content\n" - if $DEBUG and !$locale; - my $content = $self->content($cust_main->locale); - warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n" - if($DEBUG); + if $DEBUG and $cust_main && !$locale; + my $content = $self->content($locale); + + warn "preparing template '".$self->msgname."\n" + if $DEBUG; my $subs = $self->substitutions; @@ -295,7 +296,8 @@ sub prepare { # create substitution table ### my %hash; - my @objects = ($cust_main); + my @objects = (); + push @objects, $cust_main if $cust_main; my @prefixes = (''); my $svc; if( ref $object ) { @@ -385,20 +387,22 @@ sub prepare { my @to; if ( exists($opt{'to'}) ) { @to = split(/\s*,\s*/, $opt{'to'}); - } - else { + } elsif ( $cust_main ) { @to = $cust_main->invoicing_list_emailonly; + } else { + die 'no To: address or cust_main object specified'; } - # no warning when preparing with no destination my $from_addr = $self->from_addr; if ( !$from_addr ) { + + my $agentnum = $cust_main ? $cust_main->agentnum : ''; + if ( $opt{'from_config'} ) { - $from_addr = scalar( $conf->config($opt{'from_config'}, - $cust_main->agentnum) ); + $from_addr = $conf->config($opt{'from_config'}, $agentnum); } - $from_addr ||= $conf->invoice_from_full($cust_main->agentnum); + $from_addr ||= $conf->invoice_from_full($agentnum); } # my @cust_msg = (); # if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) { @@ -416,11 +420,11 @@ sub prepare { ->format( HTML::TreeBuilder->new_from_content($body) ) ); ( - 'custnum' => $cust_main->custnum, - 'msgnum' => $self->msgnum, - 'from' => $from_addr, - 'to' => \@to, - 'bcc' => $self->bcc_addr || undef, + 'custnum' => ( $cust_main ? $cust_main->custnum : ''), + 'msgnum' => $self->msgnum, + 'from' => $from_addr, + 'to' => \@to, + 'bcc' => $self->bcc_addr || undef, 'subject' => $subject, 'html_body' => $body, 'text_body' => $text_body diff --git a/FS/FS/o2m_Common.pm b/FS/FS/o2m_Common.pm index 0e03b52ee..d237befa6 100644 --- a/FS/FS/o2m_Common.pm +++ b/FS/FS/o2m_Common.pm @@ -87,7 +87,7 @@ sub process_o2m { foreach my $del_obj ( grep { ! $edits{$_->$table_pkey()} } - qsearch( $table, $hashref ) + $self->process_o2m_qsearch( $table, $hashref ) ) { my $error = $del_obj->delete; if ( $error ) { @@ -97,7 +97,7 @@ sub process_o2m { } foreach my $pkey_value ( keys %edits ) { - my $old_obj = qsearchs( $table, { %$hashref, $table_pkey => $pkey_value } ), + my $old_obj = $self->process_o2m_qsearchs( $table, { %$hashref, $table_pkey => $pkey_value } ); my $add_param = $edits{$pkey_value}; my %hash = ( $table_pkey => $pkey_value, map { $_ => $opt{'params'}->{$add_param."_$_"} } @@ -131,6 +131,9 @@ sub process_o2m { ''; } +sub process_o2m_qsearch { my $self = shift; qsearch( @_ ); } +sub process_o2m_qsearchs { my $self = shift; qsearchs( @_ ); } + sub _load_table { my( $self, $table ) = @_; eval "use FS::$table"; diff --git a/FS/FS/part_event/Action/pkg_discount.pm b/FS/FS/part_event/Action/pkg_discount.pm new file mode 100644 index 000000000..04a3a0f40 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_discount.pm @@ -0,0 +1,97 @@ +package FS::part_event::Action::pkg_discount; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { "Discount active customer packages"; } + +sub eventtable_hashref { + { 'cust_main' => 1 }; +} + +sub event_stage { 'pre-bill'; } + +sub option_fields { + ( + 'if_pkgpart' => { 'label' => 'Only packages', + 'type' => 'select-table', + 'table' => 'part_pkg', + 'name_col' => 'pkg', + #can tweak after fixing discount bug with non-monthly recurring pkgs + 'extra_sql' => q(AND freq NOT LIKE '0%' AND freq NOT LIKE '%d' AND freq NOT LIKE '%h' AND freq NOT LIKE '%w'), + 'multiple' => 1, + }, + 'discountnum' => { 'label' => 'Discount', + 'type' => 'select-table', #we don't handle the select-discount create a discount case + 'table' => 'discount', + 'name_col' => 'description', #well, method + 'order_by' => 'ORDER BY discountnum', #requied because name_col is a method + 'hashref' => { 'disabled' => '', + 'months' => { op=>'!=', value=>'0' }, + }, + 'disable_empty' => 1, + }, + ); +} + +#lots of false laziness with referral_pkg_discount +#but also lots of doing it differently...and better??? +sub do_action { + my( $self, $object, $cust_event ) = @_; + + my $cust_main = $self->cust_main($object); + my %if_pkgpart = map { $_=>1 } split(/\s*,\s*/, $self->option('if_pkgpart') ); + my @cust_pkg = grep { $if_pkgpart{ $_->pkgpart } && $_->part_pkg->freq + #can remove after fixing discount bug with non-monthly pkgs + && ( $_->part_pkg->freq =~ /^\d+$/) } + $cust_main->active_pkgs; + return 'No qualifying packages' unless @cust_pkg; + + my $gotit = 0; + foreach my $cust_pkg (@cust_pkg) { + + my @cust_pkg_discount = $cust_pkg->cust_pkg_discount_active; + + #our logic here only makes sense insomuch as you can't have multiple discounts + die "Unexpected multiple discounts, contact developers" + if scalar(@cust_pkg_discount) > 1; + + my @my_cust_pkg_discount = + grep { $_->discountnum == $self->option('discountnum') } @cust_pkg_discount; + + if ( @my_cust_pkg_discount ) { #reset the existing one instead + + $gotit = 1; + + #it's already got this discount and discount never expires--great, move on + next unless $cust_pkg_discount[0]->discount->months; + + #reset the discount + my $error = $cust_pkg_discount[0]->decrement_months_used( $cust_pkg_discount[0]->months_used ); + die "Error extending discount: $error\n" if $error; + + } elsif ( @cust_pkg_discount ) { + + #can't currently discount an already discounted package, + #but maybe we can discount a different package + next; + + } else { #normal case, create a new one + + $gotit = 1; + my $cust_pkg_discount = new FS::cust_pkg_discount { + 'pkgnum' => $cust_pkg->pkgnum, + 'discountnum' => $self->option('discountnum'), + 'months_used' => 0 + }; + my $error = $cust_pkg_discount->insert; + die "Error discounting package: $error\n" if $error; + + } + } + + return $gotit ? '' : 'Discount not applied due to existing discounts'; + +} + +1; diff --git a/FS/FS/part_event/Condition/cust_bill_has_service.pm b/FS/FS/part_event/Condition/cust_bill_has_service.pm index 6e981ee03..898b08d10 100644 --- a/FS/FS/part_event/Condition/cust_bill_has_service.pm +++ b/FS/FS/part_event/Condition/cust_bill_has_service.pm @@ -44,13 +44,13 @@ sub condition_sql { my $servicenums = $class->condition_sql_option_option_integer('has_service'); - my $sql = qq| 0 < ( SELECT COUNT(cs.svcpart) + my $sql = " 0 < ( SELECT COUNT(cs.svcpart) FROM cust_bill_pkg cbp, cust_svc cs WHERE cbp.invnum = cust_bill.invnum AND cs.pkgnum = cbp.pkgnum AND cs.svcpart IN $servicenums ) - |; + "; return $sql; } diff --git a/FS/FS/part_event/Condition/has_cust_tag.pm b/FS/FS/part_event/Condition/has_cust_tag.pm index cde933881..79bf2d303 100644 --- a/FS/FS/part_event/Condition/has_cust_tag.pm +++ b/FS/FS/part_event/Condition/has_cust_tag.pm @@ -16,7 +16,6 @@ sub eventtable_hashref { }; } -#something like this sub option_fields { ( 'tagnum' => { 'label' => 'Customer tag', diff --git a/FS/FS/part_event/Condition/has_referral_custnum.pm b/FS/FS/part_event/Condition/has_referral_custnum.pm index c50579411..f8a2b82ee 100644 --- a/FS/FS/part_event/Condition/has_referral_custnum.pm +++ b/FS/FS/part_event/Condition/has_referral_custnum.pm @@ -31,19 +31,22 @@ sub condition { my($self, $object, %opt) = @_; my $cust_main = $self->cust_main($object); + return 0 unless $cust_main; #sanity check + return 0 unless $cust_main->referral_custnum; + + my $referring_cust_main = $cust_main->referral_custnum_cust_main; + return 0 unless $referring_cust_main; #sanity check; + + #referring customer must sign up before referred customer + return 0 unless $cust_main->signupdate > $referring_cust_main->signupdate; if ( $self->option('active') ) { - return 0 unless $cust_main->referral_custnum; #check for no cust_main for referral_custnum? (deleted?) - return 0 unless $cust_main->referral_custnum_cust_main->status eq 'active'; - } else { - return 0 unless $cust_main->referral_custnum; # ? 1 : 0; + return 0 unless $referring_cust_main->status eq 'active'; } return 1 unless $self->option('check_bal'); - my $referring_cust_main = $cust_main->referral_custnum_cust_main; - #false laziness w/ balance_age_under my $under = $self->option('balance'); $under = 0 unless length($under); diff --git a/FS/FS/part_event/Condition/has_referral_pkgpart.pm b/FS/FS/part_event/Condition/has_referral_pkgpart.pm index 60ba7ccd5..7062f6c2e 100644 --- a/FS/FS/part_event/Condition/has_referral_pkgpart.pm +++ b/FS/FS/part_event/Condition/has_referral_pkgpart.pm @@ -1,6 +1,7 @@ package FS::part_event::Condition::has_referral_pkgpart; use base qw( FS::part_event::Condition ); +use FS::part_event::Condition::has_referral_custnum; #maybe i should be incorporated in has_referral_custnum use strict; @@ -19,10 +20,10 @@ sub option_fields { sub condition { my($self, $object, %opt) = @_; + return 0 unless FS::part_event::Condition::has_referral_custnum::condition($self, $object, %opt); + my $cust_main = $self->cust_main($object); - return 0 unless $cust_main->referral_custnum; - my $if_pkgpart = $self->option('if_pkgpart') || {}; grep $if_pkgpart->{ $_->pkgpart }, $cust_main->referral_custnum_cust_main->ncancelled_pkgs; diff --git a/FS/FS/part_event/Condition/nopostal.pm b/FS/FS/part_event/Condition/nopostal.pm new file mode 100644 index 000000000..b95cd5c85 --- /dev/null +++ b/FS/FS/part_event/Condition/nopostal.pm @@ -0,0 +1,26 @@ +package FS::part_event::Condition::nopostal; +use base qw( FS::part_event::Condition ); +use strict; + +sub description { + 'Customer does not receive a postal mail invoice'; +} + +sub condition { + my( $self, $object ) = @_; + my $cust_main = $self->cust_main($object); + + scalar( grep { $_ eq 'POST' } $cust_main->invoicing_list ) ? 0 : 1; +} + +sub condition_sql { + my( $self, $table ) = @_; + + " NOT EXISTS( SELECT 1 FROM cust_main_invoice + WHERE cust_main_invoice.custnum = cust_main.custnum + AND cust_main_invoice.dest = 'POST' + ) + "; +} + +1; diff --git a/FS/FS/part_export/amazon_ec2.pm b/FS/FS/part_export/amazon_ec2.pm index 06e2c238e..c1082a8aa 100644 --- a/FS/FS/part_export/amazon_ec2.pm +++ b/FS/FS/part_export/amazon_ec2.pm @@ -8,10 +8,12 @@ use FS::Record qw( qsearchs ); use FS::svc_external; tie my %options, 'Tie::IxHash', - 'access_key' => { label => 'AWS access key', }, - 'secret_key' => { label => 'AWS secret key', }, - 'ami' => { label => 'AMI', 'default' => 'ami-ff46a796', }, - 'keyname' => { label => 'Keypair name', }, + 'access_key' => { label => 'AWS access key', }, + 'secret_key' => { label => 'AWS secret key', }, + 'ami' => { label => 'AMI', 'default' => 'ami-ff46a796', }, + 'keyname' => { label => 'Keypair name', }, + 'region' => { label => 'Region', }, + 'InstanceType' => { label => 'Instance Type', }, #option to turn off (or on) ip address allocation ; @@ -38,6 +40,7 @@ sub _export_insert { $svc_external->svcnum, $self->option('ami'), $self->option('keyname'), + $self->option('InstanceType'), ); ref($err_or_queue) ? '' : $err_or_queue; } @@ -96,31 +99,35 @@ sub amazon_ec2_queue { }; $queue->insert( $self->option('access_key'), $self->option('secret_key'), + $self->option('region'), @_ ) or $queue; } sub amazon_ec2_new { - my( $access_key, $secret_key, @rest ) = @_; + my( $access_key, $secret_key, $region, @rest ) = @_; eval 'use Net::Amazon::EC2;'; die $@ if $@; my $ec2 = new Net::Amazon::EC2 'AWSAccessKeyId' => $access_key, - 'SecretAccessKey' => $secret_key; - + 'SecretAccessKey' => $secret_key, + 'region' => $region || 'us-east-1', + ; ( $ec2, @rest ); } sub amazon_ec2_insert { #subroutine, not method - my( $ec2, $svcnum, $ami, $keyname ) = amazon_ec2_new(@_); - - my $reservation_info = $ec2->run_instances( 'ImageId' => $ami, - 'KeyName' => $keyname, - 'MinCount' => 1, - 'MaxCount' => 1, - ); + my( $ec2, $svcnum, $ami, $keyname, $InstanceType ) = amazon_ec2_new(@_); + + my $reservation_info = $ec2->run_instances( + 'ImageId' => $ami, + 'KeyName' => $keyname, + 'InstanceType' => $InstanceType || 'm1.small', + 'MinCount' => 1, + 'MaxCount' => 1, + ); my $instance_id = $reservation_info->instances_set->[0]->instance_id; diff --git a/FS/FS/part_export/cardfortress.pm b/FS/FS/part_export/cardfortress.pm index 7ff728081..154f979b0 100644 --- a/FS/FS/part_export/cardfortress.pm +++ b/FS/FS/part_export/cardfortress.pm @@ -28,6 +28,7 @@ sub _export_insert { my $ssh = Net::OpenSSH->new( $self->machine, default_stdin_fh => $def_in ); + #capture2 and return STDERR, its probably useful if there's a problem my $private_key = $ssh->capture( { 'stdin_data' => $svc_acct->_password. "\n" }, '/usr/local/bin/merchant_create', map $svc_acct->$_, qw( username finger ) @@ -67,6 +68,7 @@ sub _export_delete { my $ssh = Net::OpenSSH->new( $self->machine, default_stdin_fh => $def_in ); + #capture2 and return STDERR, its probably useful if there's a problem my $unused_output = $ssh->capture( '/usr/local/bin/merchant_disable', map $svc_acct->$_, qw( username ) ); diff --git a/FS/FS/part_fee.pm b/FS/FS/part_fee.pm index 370005c15..ef14b4f08 100644 --- a/FS/FS/part_fee.pm +++ b/FS/FS/part_fee.pm @@ -2,11 +2,11 @@ package FS::part_fee; use strict; use base qw( FS::o2m_Common FS::Record ); -use vars qw( $DEBUG ); use FS::Record qw( qsearch qsearchs ); use FS::cust_bill_pkg_display; -$DEBUG = 0; +our $DEBUG = 0; +our $default_class; =head1 NAME @@ -50,6 +50,9 @@ the invoice =item disabled - 'Y' if the fee is disabled =item classnum - the L<FS::pkg_class> that the fee belongs to, for reporting +and placement on multisection invoices. Unlike packages, fees I<must> be +assigned to a class; they will default to class named "Fees", which belongs +to the same invoice section that normally contains taxes. =item taxable - 'Y' if this fee should be considered a taxable sale. Currently, taxable fees will be treated like they exist at the customer's @@ -130,6 +133,13 @@ sub check { $self->set('amount', 0) unless $self->amount; $self->set('percent', 0) unless $self->percent; + $default_class ||= qsearchs('pkg_class', { classname => 'Fees' }) + or die "default package fee class not found; run freeside-upgrade to continue.\n"; + + if (!$self->get('classnum')) { + $self->set('classnum', $default_class->classnum); + } + my $error = $self->ut_numbern('feepart') || $self->ut_textn('comment') diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 2748686cc..f56878acf 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -697,6 +697,8 @@ some components specified by "select-.*.html", and a bunch more... =item select_label - Used with select_table, this is the field name of labels +=item select_allow_empty - Used with select_table, adds an empty option + =back =cut diff --git a/FS/FS/phone_avail.pm b/FS/FS/phone_avail.pm index 52bbdeb10..ae8526c3d 100644 --- a/FS/FS/phone_avail.pm +++ b/FS/FS/phone_avail.pm @@ -283,8 +283,8 @@ sub _upgrade_data { my $sth = dbh->prepare( 'UPDATE phone_avail SET svcnum = NULL WHERE svcnum IS NOT NULL - AND 0 = ( SELECT COUNT(*) FROM svc_phone - WHERE phone_avail.svcnum = svc_phone.svcnum )' + AND NOT EXISTS ( SELECT 1 FROM svc_phone + WHERE phone_avail.svcnum = svc_phone.svcnum )' ) or die dbh->errstr; $sth->execute or die $sth->errstr; diff --git a/FS/FS/pkg_category.pm b/FS/FS/pkg_category.pm index adfadd772..c2361cc2b 100644 --- a/FS/FS/pkg_category.pm +++ b/FS/FS/pkg_category.pm @@ -3,7 +3,7 @@ use base qw( FS::category_Common ); use strict; use vars qw( @ISA $me $DEBUG ); -use FS::Record qw( qsearch ); +use FS::Record qw( qsearch qsearchs ); use FS::pkg_class; use FS::part_pkg; @@ -145,6 +145,40 @@ sub _upgrade_data { $weight += 10; } } + + # create default category for package fees + my $tax_category_name = 'Taxes, Surcharges, and Fees'; + my $tax_category = qsearchs('pkg_category', + { categoryname => $tax_category_name } + ); + if (!$tax_category) { + $tax_category = FS::pkg_category->new({ + categoryname => $tax_category_name, + weight => 1000, # doesn't really matter + }); + my $error = $tax_category->insert; + die "error creating tax category: $error\n" if $error; + } + + my $fee_class_name = 'Fees'; # does not appear on invoice + my $fee_class = qsearchs('pkg_class', { classname => $fee_class_name }); + if (!$fee_class) { + $fee_class = FS::pkg_class->new({ + classname => $fee_class_name, + categorynum => $tax_category->categorynum, + }); + my $error = $fee_class->insert; + die "error creating fee class: $error\n" if $error; + } + + # assign it to all fee defs that don't otherwise have a class + foreach my $part_fee (qsearch('part_fee', { classnum => '' })) { + $part_fee->set('classnum', $fee_class->classnum); + my $error = $part_fee->replace; + die "error assigning default class to fee def#".$part_fee->feepart . + ":$error\n" if $error; + } + ''; } diff --git a/FS/FS/pkg_discount_Mixin.pm b/FS/FS/pkg_discount_Mixin.pm new file mode 100644 index 000000000..c6fe00845 --- /dev/null +++ b/FS/FS/pkg_discount_Mixin.pm @@ -0,0 +1,69 @@ +package FS::pkg_discount_Mixin; + +use strict; +use NEXT; +use FS::Record qw(dbh); + +=head1 NAME + +FS::pkg_discount_Mixin - mixin class for package-discount link objects. + +=head1 DESCRIPTION + +Implements some behavior that's common to cust_pkg_discount and +quotation_pkg_discount objects. The only required field is "discountnum", +a foreign key to L<FS::discount>. + +=head1 METHODS + +=over 4 + +=item insert + +Inserts the record. If the 'discountnum' field is -1, this will first create +a discount using the contents of the '_type', 'amount', 'percent', 'months', +and 'setup' field. The new discount will be disabled, since it's a one-off +discount. + +=cut + +sub insert { + my $self = shift; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + if ( $self->discountnum == -1 ) { + my $discount = new FS::discount { + '_type' => $self->_type, + 'amount' => $self->amount, + 'percent' => $self->percent, + 'months' => $self->months, + 'setup' => $self->setup, + #'linked' => $self->linked, + 'disabled' => 'Y', + }; + my $error = $discount->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->set('discountnum', $discount->discountnum); + } + + my $error = $self->NEXT::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=back + +=cut + +1; diff --git a/FS/FS/prospect_contact.pm b/FS/FS/prospect_contact.pm new file mode 100644 index 000000000..6626132dd --- /dev/null +++ b/FS/FS/prospect_contact.pm @@ -0,0 +1,125 @@ +package FS::prospect_contact; +use base qw( FS::Record ); + +use strict; +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::prospect_contact - Object methods for prospect_contact records + +=head1 SYNOPSIS + + use FS::prospect_contact; + + $record = new FS::prospect_contact \%hash; + $record = new FS::prospect_contact { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::prospect_contact object represents a contact's attachment to a specific +prospect. FS::prospect_contact inherits from FS::Record. The following fields +are currently supported: + +=over 4 + +=item prospectcontactnum + +primary key + +=item prospectnum + +prospectnum + +=item contactnum + +contactnum + +=item classnum + +classnum + +=item comment + +comment + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'prospect_contact'; } + +=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 record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('prospectcontactnum') + || $self->ut_number('prospectnum') + || $self->ut_number('contactnum') + || $self->ut_numbern('classnum') + || $self->ut_textn('comment') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::contact>, L<FS::prospect_main>, L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/prospect_main.pm b/FS/FS/prospect_main.pm index b160343de..81f71a996 100644 --- a/FS/FS/prospect_main.pm +++ b/FS/FS/prospect_main.pm @@ -269,7 +269,7 @@ sub name { my $self = shift; return $self->company if $self->company; - my $contact = ($self->contact)[0]; #first contact? good enough for now + my $contact = ($self->prospect_contact)[0]->contact; #first contact? good enough for now return $contact->line if $contact; 'Prospect #'. $self->prospectnum; @@ -314,7 +314,7 @@ sub convert_cust_main { my @cust_location = $self->cust_location; #the interface only allows one, so we're just gonna go with that for now - my @contact = $self->contact; + my @contact = map $_->contact, $self->prospect_contact; #XXX define one contact type as "billing", then we could pick just that one my @invoicing_list = map $_->emailaddress, map $_->contact_email, @contact; diff --git a/FS/FS/quotation.pm b/FS/FS/quotation.pm index 38e731889..9cef3c191 100644 --- a/FS/FS/quotation.pm +++ b/FS/FS/quotation.pm @@ -341,15 +341,23 @@ If there is an error, returns an error message, otherwise returns false. sub order { my $self = shift; - tie my %cust_pkg, 'Tie::RefHash', - map { FS::cust_pkg->new({ pkgpart => $_->pkgpart, - quantity => $_->quantity, - }) - => [] #services - } - $self->quotation_pkg ; - - $self->cust_main->order_pkgs( \%cust_pkg ); + tie my %all_cust_pkg, 'Tie::RefHash'; + foreach my $quotation_pkg ($self->quotation_pkg) { + my $cust_pkg = FS::cust_pkg->new; + foreach (qw(pkgpart locationnum start_date contract_end quantity waive_setup)) { + $cust_pkg->set( $_, $quotation_pkg->get($_) ); + } + + # currently only one discount each + my ($pkg_discount) = $quotation_pkg->quotation_pkg_discount; + if ( $pkg_discount ) { + $cust_pkg->set('discountnum', $pkg_discount->discountnum); + } + + $all_cust_pkg{$cust_pkg} = []; # no services + } + + $self->cust_main->order_pkgs( \%all_cust_pkg ); } diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm index 3813fb22c..ea8f4e0c8 100644 --- a/FS/FS/quotation_pkg.pm +++ b/FS/FS/quotation_pkg.pm @@ -103,8 +103,11 @@ otherwise returns false. =cut +use Data::Dumper; #XXX DEBUG sub insert { my ($self, %options) = @_; + warn Dumper($self); + warn Dumper(\%options); my $dbh = dbh; my $oldAutoCommit = $FS::UID::AutoCommit; @@ -251,6 +254,9 @@ sub estimate { # XXX the order of applying discounts is ill-defined, which matters # if there are percentage and amount discounts on the same package. + # + # but right now there can only be one discount on any package, so + # it doesn't matter foreach my $pkg_discount ($self->quotation_pkg_discount) { my $discount = $pkg_discount->discount; diff --git a/FS/FS/quotation_pkg_discount.pm b/FS/FS/quotation_pkg_discount.pm index 633308cff..9fdae3efb 100644 --- a/FS/FS/quotation_pkg_discount.pm +++ b/FS/FS/quotation_pkg_discount.pm @@ -1,5 +1,6 @@ package FS::quotation_pkg_discount; -use base qw( FS::Record ); + +use base qw( FS::pkg_discount_Mixin FS::Record ); use FS::Maketext 'mt'; # XXX not really correct use strict; @@ -78,27 +79,15 @@ sub table { 'quotation_pkg_discount'; } Adds this record to the database. If there is an error, returns the error, otherwise returns false. -=cut - -# the insert method can be inherited from FS::Record - =item delete Delete this record from the database. -=cut - -# the delete method can be inherited from FS::Record - =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -=cut - -# the replace method can be inherited from FS::Record - =item check Checks all fields to make sure this is a valid quotation package discount. diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm index 06ce94848..71a61ad16 100644 --- a/FS/FS/svc_phone.pm +++ b/FS/FS/svc_phone.pm @@ -196,6 +196,7 @@ sub table_info { select_table => 'svc_domain', select_key => 'svcnum', select_label => 'domain', + select_allow_empty => 1, disable_inventory => 1, }, 'circuit_svcnum' => { label => 'Circuit', diff --git a/FS/MANIFEST b/FS/MANIFEST index 6e36c3344..b7d347b98 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -834,3 +834,9 @@ FS/svc_circuit.pm t/svc_circuit.t FS/cust_credit_source_bill_pkg.pm t/cust_credit_source_bill_pkg.t +FS/prospect_contact.pm +t/prospect_contact.t +FS/cust_contact.pm +t/cust_contact.t +FS/pkg_discount_Mixin.pm +t/pkg_discount_Mixin.t diff --git a/FS/bin/freeside-cdrd b/FS/bin/freeside-cdrd index 45d58789d..a3c67f919 100644 --- a/FS/bin/freeside-cdrd +++ b/FS/bin/freeside-cdrd @@ -120,10 +120,10 @@ while (1) { sub _shouldrun { my $extra_sql = - ' AND 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.pkgpart = part_pkg.pkgpart - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) + ' AND EXISTS ( SELECT 1 FROM cust_pkg + WHERE cust_pkg.pkgpart = part_pkg.pkgpart + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + ) '; my @part_pkg = diff --git a/FS/t/cust_contact.t b/FS/t/cust_contact.t new file mode 100644 index 000000000..0e9ea7100 --- /dev/null +++ b/FS/t/cust_contact.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_contact; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/pkg_discount_Mixin.t b/FS/t/pkg_discount_Mixin.t new file mode 100644 index 000000000..d811a9253 --- /dev/null +++ b/FS/t/pkg_discount_Mixin.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::pkg_discount_Mixin; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/prospect_contact.t b/FS/t/prospect_contact.t new file mode 100644 index 000000000..dbb12e510 --- /dev/null +++ b/FS/t/prospect_contact.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::prospect_contact; +$loaded=1; +print "ok 1\n"; |