X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=4ea4a6b9de7af51781f776d5a073d474c434d14c;hb=5becafa6dfc3ee7c0f07543904f0f3e25aa64949;hp=21f66b92ed8a6564203e142011f5cbd936ed99c9;hpb=5a52da30588e8811338845ce2edaf0631acad479;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 21f66b92e..a9d7ac7bd 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,43 +1,47 @@ package FS::cust_main; - -require 5.006; -use strict; -use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime +use base qw( FS::cust_main::Packages + FS::cust_main::Status + FS::cust_main::NationalID + FS::cust_main::Billing + FS::cust_main::Billing_Realtime + FS::cust_main::Billing_Batch + FS::cust_main::Billing_Discount + FS::cust_main::Billing_ThirdParty + FS::cust_main::Location + FS::cust_main::Credit_Limit + FS::cust_main::Merge + FS::cust_main::API FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin + FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin + FS::o2m_Common FS::Record ); -use vars qw( @EXPORT_OK $DEBUG $me $conf - @encrypted_fields - $import $ignore_expired_card - $skip_fuzzyfiles @fuzzyfields - @paytypes - ); -use vars qw( $realtime_bop_decline_quiet ); #ugh + +require 5.006; +use strict; use Carp; -use Exporter; use Scalar::Util qw( blessed ); -use List::Util qw( min ); use Time::Local qw(timelocal); -use Storable qw(thaw); -use MIME::Base64; use Data::Dumper; use Tie::IxHash; -use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; -use File::Temp qw( tempfile ); -use String::Approx qw(amatch); +use File::Temp; #qw( tempfile ); use Business::CreditCard 0.28; use Locale::Country; -use FS::UID qw( getotaker dbh driver_name ); +use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); +use FS::Cursor; use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); use FS::CurrentUser; +use FS::TicketSystem; use FS::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; +use FS::cust_bill_void; +use FS::legacy_cust_bill; use FS::cust_pay; use FS::cust_pay_pending; use FS::cust_pay_void; @@ -48,51 +52,58 @@ use FS::part_referral; use FS::cust_main_county; use FS::cust_location; use FS::cust_class; +use FS::tax_status; use FS::cust_main_exemption; use FS::cust_tax_adjustment; use FS::cust_tax_location; -use FS::agent; +use FS::agent_currency; use FS::cust_main_invoice; use FS::cust_tag; use FS::prepay_credit; use FS::queue; use FS::part_pkg; -use FS::part_event; -use FS::part_event_condition; use FS::part_export; #use FS::cust_event; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; use FS::banned_pay; -use FS::TicketSystem; - -@EXPORT_OK = qw( smart_search ); - -$realtime_bop_decline_quiet = 0; #move to Billing_Realtime +use FS::cust_main_note; +use FS::cust_attachment; +use FS::cust_contact; +use FS::Locales; +use FS::upgrade_journal; +use FS::sales; +use FS::cust_payby; +use FS::contact; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations # 3 is even more information including possibly sensitive data -$DEBUG = 0; -$me = '[FS::cust_main]'; +our $DEBUG = 0; +our $me = '[FS::cust_main]'; -$import = 0; -$ignore_expired_card = 0; +our $import = 0; +our $ignore_expired_card = 0; +our $ignore_banned_card = 0; +our $ignore_invalid_card = 0; -$skip_fuzzyfiles = 0; -@fuzzyfields = ( 'first', 'last', 'company', 'address1' ); +our $skip_fuzzyfiles = 0; -@encrypted_fields = ('payinfo', 'paycvv'); -sub nohistory_fields { ('payinfo', 'paycvv'); } +our $ucfirst_nowarn = 0; -@paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); +#this info is in cust_payby as of 4.x +#this and the fields themselves can be removed in 5.x +our @encrypted_fields = ('payinfo', 'paycvv'); +sub nohistory_fields { ('payinfo', 'paycvv'); } +our $conf; #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { install_callback FS::UID sub { $conf = new FS::Conf; #yes, need it for stuff below (prolly should be cached) + $ignore_invalid_card = $conf->exists('allow_invalid_cards'); }; sub _cache { @@ -176,28 +187,6 @@ Cocial security number (optional) (optional) -=item address1 - -=item address2 - -(optional) - -=item city - -=item county - -(optional, see L) - -=item state - -(see L) - -=item zip - -=item country - -(see L) - =item daytime phone (optional) @@ -210,49 +199,7 @@ phone (optional) phone (optional) -=item ship_first - -Shipping first name - -=item ship_last - -Shipping last name - -=item ship_company - -(optional) - -=item ship_address1 - -=item ship_address2 - -(optional) - -=item ship_city - -=item ship_county - -(optional, see L) - -=item ship_state - -(see L) - -=item ship_zip - -=item ship_country - -(see L) - -=item ship_daytime - -phone (optional) - -=item ship_night - -phone (optional) - -=item ship_fax +=item mobile phone (optional) @@ -324,6 +271,18 @@ A suggestion to events (see L) to delay until this unix ti Discourage individual CDR printing, empty or `Y' +=item edit_subject + +Allow self-service editing of ticket subjects, empty or 'Y' + +=item calling_list_exempt + +Do not call, empty or 'Y' + +=item invoice_ship_address + +Display ship_address ("Service address") on invoices for this customer, empty or 'Y' + =back =head1 METHODS @@ -346,6 +305,12 @@ sub table { 'cust_main'; } Adds this customer to the database. If there is an error, returns the error, otherwise returns false. +Usually the customer's location will not yet exist in the database, and +the C and C pseudo-fields must be set to +uninserted L objects. These will be inserted and linked +(in both directions) to the new customer record. If they're references +to the same object, they will become the same location. + CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert method containing FS::cust_pkg and FS::svc_I objects, all records are inserted atomicly, or the transaction is rolled back. Passing an empty @@ -369,7 +334,8 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I, I and I. +Currently available options are: I, I, +I, I, I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). @@ -380,8 +346,22 @@ The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with the B method.) -The I option can be set to an arrayref of tax names. -FS::cust_main_exemption records will be created and inserted. +The I option can be set to an arrayref of tax names or a hashref +of tax names and exemption numbers. FS::cust_main_exemption records will be +created and inserted. + +If I is set, moves contacts and locations from that prospect. + +If I is set to an arrayref of FS::contact objects, inserts those +new contacts with this new customer. + +If I is set to a hashref of CGI parameters (and I is +unset), inserts those new contacts with this new customer. Handles CGI +paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi + +If I is set to a hashref o fCGI parameters, inserts those +new stored payment records with this new customer. Handles CGI parameters +for an "m2" multiple entry field as passed by edit/cust_main.cgi =cut @@ -410,7 +390,7 @@ sub insert { my $payby = ''; if ( $self->payby eq 'PREPAY' ) { - $self->payby('BILL'); + $self->payby(''); #'BILL'); $prepay_identifier = $self->payinfo; $self->payinfo(''); @@ -432,14 +412,58 @@ sub insert { $payby = 'PREP' if $amount; - } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { + } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) { $payby = $1; - $self->payby('BILL'); + $self->payby(''); #'BILL'); $amount = $self->paid; } + # insert locations + foreach my $l (qw(bill_location ship_location)) { + + my $loc = delete $self->hashref->{$l} or next; + + if ( !$loc->locationnum ) { + # warn the location that we're going to insert it with no custnum + $loc->set(custnum_pending => 1); + warn " inserting $l\n" + if $DEBUG > 1; + my $error = $loc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + my $label = $l eq 'ship_location' ? 'service' : 'billing'; + return "$error (in $label location)"; + } + + } elsif ( $loc->prospectnum ) { + + $loc->prospectnum(''); + $loc->set(custnum_pending => 1); + my $error = $loc->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + my $label = $l eq 'ship_location' ? 'service' : 'billing'; + return "$error (moving $label location)"; + } + + } elsif ( ($loc->custnum || 0) > 0 ) { + # then it somehow belongs to another customer--shouldn't happen + $dbh->rollback if $oldAutoCommit; + return "$l belongs to customer ".$loc->custnum; + } + # else it already belongs to this customer + # (happens when ship_location is identical to bill_location) + + $self->set($l.'num', $loc->locationnum); + + if ( $self->get($l.'num') eq '' ) { + $dbh->rollback if $oldAutoCommit; + return "$l not set"; + } + } + warn " inserting $self\n" if $DEBUG > 1; @@ -455,6 +479,22 @@ sub insert { return $error; } + # now set cust_location.custnum + foreach my $l (qw(bill_location ship_location)) { + warn " setting $l.custnum\n" + if $DEBUG > 1; + my $loc = $self->$l or next; + unless ( $loc->custnum ) { + $loc->set(custnum => $self->custnum); + $error ||= $loc->replace; + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error setting $l custnum: $error"; + } + } + warn " setting invoicing list\n" if $DEBUG > 1; @@ -481,42 +521,92 @@ sub insert { } } - if ( $invoicing_list ) { - $error = $self->check_invoicing_list( $invoicing_list ); + my $prospectnum = delete $options{'prospectnum'}; + if ( $prospectnum ) { + + warn " moving contacts and locations from prospect $prospectnum\n" + if $DEBUG > 1; + + my $prospect_main = + qsearchs('prospect_main', { 'prospectnum' => $prospectnum } ); + unless ( $prospect_main ) { + $dbh->rollback if $oldAutoCommit; + return "Unknown prospectnum $prospectnum"; + } + $prospect_main->custnum($self->custnum); + $prospect_main->disabled('Y'); + my $error = $prospect_main->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; - #return "checking invoicing_list (transaction rolled back): $error"; return $error; } - $self->invoicing_list( $invoicing_list ); - } + 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; - warn " setting cust_main_exemption\n" + foreach my $r ( @cust_location, @qual ) { + $r->prospectnum(''); + $r->custnum($self->custnum); + my $error = $r->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + warn " setting contacts\n" if $DEBUG > 1; - my $tax_exemption = delete $options{'tax_exemption'}; - if ( $tax_exemption ) { - foreach my $taxname ( @$tax_exemption ) { - my $cust_main_exemption = new FS::cust_main_exemption { - 'custnum' => $self->custnum, - 'taxname' => $taxname, - }; - my $error = $cust_main_exemption->insert; + if ( my $contact = delete $options{'contact'} ) { + + foreach my $c ( @$contact ) { + $c->custnum($self->custnum); + my $error = $c->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting cust_main_exemption (transaction rolled back): $error"; + return $error; } + + } + + } elsif ( my $contact_params = delete $options{'contact_params'} ) { + + my $error = $self->process_o2m( 'table' => 'contact', + 'fields' => FS::contact->cgi_contact_fields, + 'params' => $contact_params, + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } } - if ( $conf->config('cust_main-skeleton_tables') - && $conf->config('cust_main-skeleton_custnum') ) { + warn " setting cust_payby\n" + if $DEBUG > 1; - warn " inserting skeleton records\n" - if $DEBUG > 1; + if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) { - my $error = $self->start_copy_skel; + my $error = $self->process_o2m( + 'table' => 'cust_payby', + 'fields' => FS::cust_payby->cgi_cust_payby_fields, + 'params' => $cust_payby_params, + 'hash_callback' => \&FS::cust_payby::cgi_hash_callback, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -524,6 +614,29 @@ sub insert { } + warn " setting cust_main_exemption\n" + if $DEBUG > 1; + + my $tax_exemption = delete $options{'tax_exemption'}; + if ( $tax_exemption ) { + + $tax_exemption = { map { $_ => '' } @$tax_exemption } + if ref($tax_exemption) eq 'ARRAY'; + + foreach my $taxname ( keys %$tax_exemption ) { + my $cust_main_exemption = new FS::cust_main_exemption { + 'custnum' => $self->custnum, + 'taxname' => $taxname, + 'exempt_number' => $tax_exemption->{$taxname}, + }; + my $error = $cust_main_exemption->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } + } + warn " ordering packages\n" if $DEBUG > 1; @@ -568,6 +681,20 @@ sub insert { } } + # FS::geocode_Mixin::after_insert or something? + if ( $conf->config('tax_district_method') and !$import ) { + # if anything non-empty, try to look it up + my $queue = new FS::queue { + 'job' => 'FS::geocode_Mixin::process_district_update', + 'custnum' => $self->custnum, + }; + my $error = $queue->insert( ref($self), $self->custnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing tax district update: $error"; + } + } + # cust_main exports! warn " exporting\n" if $DEBUG > 1; @@ -644,438 +771,116 @@ sub auto_agent_custid { } -sub start_copy_skel { - my $self = shift; - - #'mg_user_preference' => {}, - #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, }, - #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' }, - #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' }, - #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } }, - my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables'))); - die $@ if $@; - - _copy_skel( 'cust_main', #tablename - $conf->config('cust_main-skeleton_custnum'), #sourceid - $self->custnum, #destid - @tables, #child tables - ); -} - -#recursive subroutine, not a method -sub _copy_skel { - my( $table, $sourceid, $destid, %child_tables ) = @_; +=item PACKAGE METHODS - my $primary_key; - if ( $table =~ /^(\w+)\.(\w+)$/ ) { - ( $table, $primary_key ) = ( $1, $2 ); - } else { - my $dbdef_table = dbdef->table($table); - $primary_key = $dbdef_table->primary_key - or return "$table has no primary key". - " (or do you need to run dbdef-create?)"; - } +Documentation on customer package methods has been moved to +L. - warn " _copy_skel: $table.$primary_key $sourceid to $destid for ". - join (', ', keys %child_tables). "\n" - if $DEBUG > 2; +=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] - foreach my $child_table_def ( keys %child_tables ) { +Recharges this (existing) customer with the specified prepaid card (see +L), specified either by I or as an +FS::prepay_credit object. If there is an error, returns the error, otherwise +returns false. - my $child_table; - my $child_pkey = ''; - if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) { - ( $child_table, $child_pkey ) = ( $1, $2 ); - } else { - $child_table = $child_table_def; +Optionally, five scalar references can be passed as well. They will have their +values filled in with the amount, number of seconds, and number of upload, +download, and total bytes applied by this prepaid card. - $child_pkey = dbdef->table($child_table)->primary_key; - # or return "$table has no primary key". - # " (or do you need to run dbdef-create?)\n"; - } +=cut - my $sequence = ''; - if ( keys %{ $child_tables{$child_table_def} } ) { +#the ref bullshit here should be refactored like get_prepay. MyAccount.pm is +#the only place that uses these args +sub recharge_prepay { + my( $self, $prepay_credit, $amountref, $secondsref, + $upbytesref, $downbytesref, $totalbytesref ) = @_; - return "$child_table has no primary key". - " (run dbdef-create or try specifying it?)\n" - unless $child_pkey; + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; - #false laziness w/Record::insert and only works on Pg - #refactor the proper last-inserted-id stuff out of Record::insert if this - # ever gets use for anything besides a quick kludge for one customer - my $default = dbdef->table($child_table)->column($child_pkey)->default; - $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i - or return "can't parse $child_table.$child_pkey default value ". - " for sequence name: $default"; - $sequence = $1; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; - } - - my @sel_columns = grep { $_ ne $primary_key } - dbdef->table($child_table)->columns; - my $sel_columns = join(', ', @sel_columns ); - - my @ins_columns = grep { $_ ne $child_pkey } @sel_columns; - my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) '; - my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) '; - - my $sel_st = "SELECT $sel_columns FROM $child_table". - " WHERE $primary_key = $sourceid"; - warn " $sel_st\n" - if $DEBUG > 2; - my $sel_sth = dbh->prepare( $sel_st ) - or return dbh->errstr; - - $sel_sth->execute or return $sel_sth->errstr; - - while ( my $row = $sel_sth->fetchrow_hashref ) { - - warn " selected row: ". - join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n" - if $DEBUG > 2; - - my $statement = - "INSERT INTO $child_table $ins_columns VALUES $placeholders"; - my $ins_sth =dbh->prepare($statement) - or return dbh->errstr; - my @param = ( $destid, map $row->{$_}, @ins_columns ); - warn " $statement: [ ". join(', ', @param). " ]\n" - if $DEBUG > 2; - $ins_sth->execute( @param ) - or return $ins_sth->errstr; - - #next unless keys %{ $child_tables{$child_table} }; - next unless $sequence; - - #another section of that laziness - my $seq_sql = "SELECT currval('$sequence')"; - my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr; - $seq_sth->execute or return $seq_sth->errstr; - my $insertid = $seq_sth->fetchrow_arrayref->[0]; - - # don't drink soap! recurse! recurse! okay! - my $error = - _copy_skel( $child_table_def, - $row->{$child_pkey}, #sourceid - $insertid, #destid - %{ $child_tables{$child_table_def} }, - ); - return $error if $error; + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); - } + my $error = $self->get_prepay( $prepay_credit, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ) + || $self->increment_seconds($seconds) + || $self->increment_upbytes($upbytes) + || $self->increment_downbytes($downbytes) + || $self->increment_totalbytes($totalbytes) + || $self->insert_cust_pay_prepay( $amount, + ref($prepay_credit) + ? $prepay_credit->identifier + : $prepay_credit + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - return ''; + if ( defined($amountref) ) { $$amountref = $amount; } + if ( defined($secondsref) ) { $$secondsref = $seconds; } + if ( defined($upbytesref) ) { $$upbytesref = $upbytes; } + if ( defined($downbytesref) ) { $$downbytesref = $downbytes; } + if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; } -} + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; -=item order_pkg HASHREF | OPTION => VALUE ... +} -Orders a single package. +=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ] -Options may be passed as a list of key/value pairs or as a hash reference. -Options are: +Looks up and deletes a prepaid card (see L), +specified either by I or as an FS::prepay_credit object. -=over 4 +Available options are: I, I, I, I, and I. The scalars (provided by references) will be +incremented by the values of the prepaid card. -=item cust_pkg +If the prepaid card specifies an I (see L), it is used to +check or set this customer's I. -FS::cust_pkg object +If there is an error, returns the error, otherwise returns false. -=item cust_location +=cut -Optional FS::cust_location object -=item svcs +sub get_prepay { + my( $self, $prepay_credit, %opt ) = @_; -Optional arryaref of FS::svc_* service objects. + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; -=item depend_jobnum + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; -If this option is set to a job queue jobnum (see L), all provisioning -jobs will have a dependancy on the supplied job (they will not run until the -specific job completes). This can be used to defer provisioning until some -action completes (such as running the customer's credit card successfully). + unless ( ref($prepay_credit) ) { -=item ticket_subject + my $identifier = $prepay_credit; -Optional subject for a ticket created and attached to this customer - -=item ticket_subject - -Optional queue name for ticket additions - -=back - -=cut - -sub order_pkg { - my $self = shift; - my $opt = ref($_[0]) ? shift : { @_ }; - - warn "$me order_pkg called with options ". - join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n" - if $DEBUG; - - my $cust_pkg = $opt->{'cust_pkg'}; - my $svcs = $opt->{'svcs'} || []; - - my %svc_options = (); - $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'} - if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'}; - - my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () } - qw( ticket_subject ticket_queue ); - - 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 ( $opt->{'cust_location'} && - ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) { - my $error = $opt->{'cust_location'}->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_location (transaction rolled back): $error"; - } - $cust_pkg->locationnum($opt->{'cust_location'}->locationnum); - } - - $cust_pkg->custnum( $self->custnum ); - - my $error = $cust_pkg->insert( %insert_params ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - - foreach my $svc_something ( @{ $opt->{'svcs'} } ) { - if ( $svc_something->svcnum ) { - my $old_cust_svc = $svc_something->cust_svc; - my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; - $new_cust_svc->pkgnum( $cust_pkg->pkgnum); - $error = $new_cust_svc->replace($old_cust_svc); - } else { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $svc_something->isa('FS::svc_acct') ) { - foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } } - qw( seconds upbytes downbytes totalbytes ) ) { - $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } ); - ${ $opt->{$_.'_ref'} } = 0; - } - } - $error = $svc_something->insert(%svc_options); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting svc_ (transaction rolled back): $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error - -} - -#deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ] -=item order_pkgs HASHREF [ , OPTION => VALUE ... ] - -Like the insert method on an existing record, this method orders multiple -packages and included services atomicaly. Pass a Tie::RefHash data structure -to this method containing FS::cust_pkg and FS::svc_I objects. -There should be a better explanation of this, but until then, here's an -example: - - use Tie::RefHash; - tie %hash, 'Tie::RefHash'; #this part is important - %hash = ( - $cust_pkg => [ $svc_acct ], - ... - ); - $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); - -Services can be new, in which case they are inserted, or existing unaudited -services, in which case they are linked to the newly-created package. - -Currently available options are: I, I, I, -I, I, and I. - -If I is set, all provisioning jobs will have a dependancy -on the supplied jobnum (they will not run until the specific job completes). -This can be used to defer provisioning until some action completes (such -as running the customer's credit card successfully). - -The I option is deprecated. If I is set true, no -provisioning jobs (exports) are scheduled. (You can schedule them later with -the B method for each cust_pkg object. Using the B method -on the cust_main object is not recommended, as existing services will also be -reexported.) - -If I, I, I, or I is -provided, the scalars (provided by references) will be incremented by the -values of the prepaid card.` - -=cut - -sub order_pkgs { - my $self = shift; - my $cust_pkgs = shift; - my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated - my %options = @_; - $seconds_ref ||= $options{'seconds_ref'}; - - warn "$me order_pkgs called with options ". - join(', ', map { "$_: $options{$_}" } keys %options ). "\n" - if $DEBUG; - - 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; - - local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; - - foreach my $cust_pkg ( keys %$cust_pkgs ) { - - my $error = $self->order_pkg( - 'cust_pkg' => $cust_pkg, - 'svcs' => $cust_pkgs->{$cust_pkg}, - 'seconds_ref' => $seconds_ref, - map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref - depend_jobnum - ) - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] - -Recharges this (existing) customer with the specified prepaid card (see -L), specified either by I or as an -FS::prepay_credit object. If there is an error, returns the error, otherwise -returns false. - -Optionally, five scalar references can be passed as well. They will have their -values filled in with the amount, number of seconds, and number of upload, -download, and total bytes applied by this prepaid card. - -=cut - -#the ref bullshit here should be refactored like get_prepay. MyAccount.pm is -#the only place that uses these args -sub recharge_prepay { - my( $self, $prepay_credit, $amountref, $secondsref, - $upbytesref, $downbytesref, $totalbytesref ) = @_; - - 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( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); - - my $error = $self->get_prepay( $prepay_credit, - 'amount_ref' => \$amount, - 'seconds_ref' => \$seconds, - 'upbytes_ref' => \$upbytes, - 'downbytes_ref' => \$downbytes, - 'totalbytes_ref' => \$totalbytes, - ) - || $self->increment_seconds($seconds) - || $self->increment_upbytes($upbytes) - || $self->increment_downbytes($downbytes) - || $self->increment_totalbytes($totalbytes) - || $self->insert_cust_pay_prepay( $amount, - ref($prepay_credit) - ? $prepay_credit->identifier - : $prepay_credit - ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - if ( defined($amountref) ) { $$amountref = $amount; } - if ( defined($secondsref) ) { $$secondsref = $seconds; } - if ( defined($upbytesref) ) { $$upbytesref = $upbytes; } - if ( defined($downbytesref) ) { $$downbytesref = $downbytes; } - if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ] - -Looks up and deletes a prepaid card (see L), -specified either by I or as an FS::prepay_credit object. - -Available options are: I, I, I, I, and I. The scalars (provided by references) will be -incremented by the values of the prepaid card. - -If the prepaid card specifies an I (see L), it is used to -check or set this customer's I. - -If there is an error, returns the error, otherwise returns false. - -=cut - - -sub get_prepay { - my( $self, $prepay_credit, %opt ) = @_; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - unless ( ref($prepay_credit) ) { - - my $identifier = $prepay_credit; - - $prepay_credit = qsearchs( - 'prepay_credit', - { 'identifier' => $prepay_credit }, - '', - 'FOR UPDATE' - ); + $prepay_credit = qsearchs( + 'prepay_credit', + { 'identifier' => $identifier }, + '', + 'FOR UPDATE' + ); unless ( $prepay_credit ) { $dbh->rollback if $oldAutoCommit; @@ -1254,47 +1059,6 @@ sub insert_cust_pay { } -=item reexport - -This method is deprecated. See the I option to the insert and -order_pkgs methods for a better way to defer provisioning. - -Re-schedules all exports by calling the B method of all associated -packages (see L). If there is an error, returns the error; -otherwise returns false. - -=cut - -sub reexport { - my $self = shift; - - carp "WARNING: FS::cust_main::reexport is deprectated; ". - "use the depend_jobnum option to insert or order_pkgs to delay export"; - - 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; - - foreach my $cust_pkg ( $self->ncancelled_pkgs ) { - my $error = $cust_pkg->reexport; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - =item delete [ OPTION => VALUE ... ] This deletes the customer. If there is an error, returns the error, otherwise @@ -1400,10 +1164,9 @@ sub delete { #cust_tax_adjustment in financials? #cust_pay_pending? ouch - #cust_recon? foreach my $table (qw( cust_main_invoice cust_main_exemption cust_tag cust_attachment contact - cust_location cust_main_note cust_tax_adjustment + cust_payby cust_location cust_main_note cust_tax_adjustment cust_pay_void cust_pay_batch queue cust_tax_exempt )) { foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { @@ -1493,10 +1256,13 @@ sub delete { =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] - Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +To change the customer's address, set the pseudo-fields C and +C. The address will still only change if at least one of the +address fields differs from the existing values. + INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will be set as the invoicing list (see L<"invoicing_list">). Errors return as expected and rollback the entire transaction; it is not necessary to call @@ -1506,8 +1272,9 @@ check_invoicing_list first. Here's an example: Currently available options are: I. -The I option can be set to an arrayref of tax names. -FS::cust_main_exemption records will be deleted and inserted as appropriate. +The I option can be set to an arrayref of tax names or a hashref +of tax names and exemption numbers. FS::cust_main_exemption records will be +deleted and inserted as appropriate. =cut @@ -1524,19 +1291,26 @@ sub replace { if $DEBUG; my $curuser = $FS::CurrentUser::CurrentUser; - if ( $self->payby eq 'COMP' - && $self->payby ne $old->payby - && ! $curuser->access_right('Complimentary customer') - ) - { - return "You are not permitted to create complimentary accounts."; - } + return "You are not permitted to create complimentary accounts." + if $self->complimentary eq 'Y' + && $self->complimentary ne $old->complimentary + && ! $curuser->access_right('Complimentary customer'); local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); + local($ignore_banned_card) = 1 + if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ + || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ ) + && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); + + return "Invoicing locale is required" + if $old->locale + && ! $self->locale + && $conf->exists('cust_main-require_locale'); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1548,6 +1322,21 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + for my $l (qw(bill_location ship_location)) { + #my $old_loc = $old->$l; + my $new_loc = $self->$l or next; + + # find the existing location if there is one + $new_loc->set('custnum' => $self->custnum); + my $error = $new_loc->find_or_insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->set($l.'num', $new_loc->locationnum); + } #for $l + + # replace the customer record my $error = $self->SUPER::replace($old); if ( $error ) { @@ -1555,18 +1344,39 @@ sub replace { return $error; } - if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF - my $invoicing_list = shift @param; - $error = $self->check_invoicing_list( $invoicing_list ); + # now move packages to the new service location + $self->set('ship_location', ''); #flush cache + if ( $old->ship_locationnum and # should only be null during upgrade... + $old->ship_locationnum != $self->ship_locationnum ) { + $error = $old->ship_location->move_to($self->ship_location); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - $self->invoicing_list( $invoicing_list ); } - - if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident - + # don't move packages based on the billing location, but + # disable it if it's no longer in use + if ( $old->bill_locationnum and + $old->bill_locationnum != $self->bill_locationnum ) { + $error = $old->bill_location->disable_if_unused; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF + my $invoicing_list = shift @param; + $error = $self->check_invoicing_list( $invoicing_list ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->invoicing_list( $invoicing_list ); + } + + if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident + #this could be more efficient than deleting and re-inserting, if it matters foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) { my $error = $cust_tag->delete; @@ -1592,17 +1402,27 @@ sub replace { my $tax_exemption = delete $options{'tax_exemption'}; if ( $tax_exemption ) { + $tax_exemption = { map { $_ => '' } @$tax_exemption } + if ref($tax_exemption) eq 'ARRAY'; + my %cust_main_exemption = map { $_->taxname => $_ } qsearch('cust_main_exemption', { 'custnum' => $old->custnum } ); - foreach my $taxname ( @$tax_exemption ) { + foreach my $taxname ( keys %$tax_exemption ) { - next if delete $cust_main_exemption{$taxname}; + if ( $cust_main_exemption{$taxname} && + $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname} + ) + { + delete $cust_main_exemption{$taxname}; + next; + } my $cust_main_exemption = new FS::cust_main_exemption { - 'custnum' => $self->custnum, - 'taxname' => $taxname, + 'custnum' => $self->custnum, + 'taxname' => $taxname, + 'exempt_number' => $tax_exemption->{$taxname}, }; my $error = $cust_main_exemption->insert; if ( $error ) { @@ -1621,21 +1441,19 @@ sub replace { } - if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ - && ( ( $self->get('payinfo') ne $old->get('payinfo') - && $self->get('payinfo') !~ /^99\d{14}$/ - ) - || grep { $self->get($_) ne $old->get($_) } qw(paydate payname) - ) - ) - { + if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) { - # card/check/lec info has changed, want to retry realtime_ invoice events - my $error = $self->retry_realtime; + my $error = $self->process_o2m( + 'table' => 'cust_payby', + 'fields' => FS::cust_payby->cgi_cust_payby_fields, + 'params' => $cust_payby_params, + 'hash_callback' => \&FS::cust_payby::cgi_hash_callback, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + } unless ( $import || $skip_fuzzyfiles ) { @@ -1646,6 +1464,8 @@ sub replace { } } + # tax district update in cust_location + # cust_main exports! my $export_args = $options{'export_args'} || []; @@ -1674,6 +1494,7 @@ Used by insert & replace to update the fuzzy search cache =cut +use FS::cust_main::Search; sub queue_fuzzyfiles_update { my $self = shift; @@ -1688,16 +1509,27 @@ sub queue_fuzzyfiles_update { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), @fuzzyfields ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + foreach my $field ( 'first', 'last', 'company', 'ship_company' ) { + my $queue = new FS::queue { + 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield' + }; + my @args = "cust_main.$field", $self->get($field); + my $error = $queue->insert( @args ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } - if ( $self->ship_last ) { - $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields ); + my @locations = (); + push @locations, $self->bill_location if $self->bill_locationnum; + push @locations, $self->ship_location if @locations && $self->has_ship_address; + foreach my $location (@locations) { + my $queue = new FS::queue { + 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield' + }; + my @args = 'cust_location.address1', $location->address1; + my $error = $queue->insert( @args ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1728,35 +1560,66 @@ sub check { || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum') + || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum') || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum') + || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum') + || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum') || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') - || $self->ut_snumbern('birthdate') || $self->ut_snumbern('signupdate') + || $self->ut_snumbern('birthdate') + || $self->ut_namen('spouse_last') + || $self->ut_namen('spouse_first') + || $self->ut_snumbern('spouse_birthdate') + || $self->ut_snumbern('anniversary_date') || $self->ut_textn('company') - || $self->ut_text('address1') - || $self->ut_textn('address2') - || $self->ut_text('city') - || $self->ut_textn('county') - || $self->ut_textn('state') - || $self->ut_country('country') + || $self->ut_textn('ship_company') || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') || $self->ut_textn('stateid') || $self->ut_textn('stateid_state') || $self->ut_textn('invoice_terms') - || $self->ut_alphan('geocode') || $self->ut_floatn('cdr_termination_percentage') + || $self->ut_floatn('credit_limit') + || $self->ut_numbern('billday') + || $self->ut_numbern('prorate_day') + || $self->ut_flag('edit_subject') + || $self->ut_flag('calling_list_exempt') + || $self->ut_flag('invoice_noemail') + || $self->ut_flag('message_noemail') + || $self->ut_enum('locale', [ '', FS::Locales->locales ]) + || $self->ut_currencyn('currency') + || $self->ut_alphan('po_number') + || $self->ut_enum('complimentary', [ '', 'Y' ]) + || $self->ut_flag('invoice_ship_address') ; + foreach (qw(company ship_company)) { + my $company = $self->get($_); + $company =~ s/^\s+//; + $company =~ s/\s+$//; + $company =~ s/\s+/ /g; + $self->set($_, $company); + } + #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; return $error if $error; - return "Unknown agent" - unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); + my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } ) + or return "Unknown agent"; + + if ( $self->currency ) { + my $agent_currency = qsearchs( 'agent_currency', { + 'agentnum' => $agent->agentnum, + 'currency' => $self->currency, + }) + or return "Agent ". $agent->agent. + " not permitted to offer ". $self->currency. " invoicing"; + } return "Unknown refnum" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); @@ -1765,13 +1628,6 @@ sub check { unless ! $self->referral_custnum || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); - if ( $self->censustract ne '' ) { - $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/ - or return "Illegal census tract: ". $self->censustract; - - $self->censustract("$1.$2"); - } - if ( $self->ss eq '' ) { $self->ss(''); } else { @@ -1782,34 +1638,24 @@ sub check { $self->ss("$1-$2-$3"); } - -# bad idea to disable, causes billing to fail because of no tax rates later -# except we don't fail any more - unless ( $import ) { - unless ( qsearch('cust_main_county', { - 'country' => $self->country, - 'state' => '', - } ) ) { - return "Unknown state/county/country: ". - $self->state. "/". $self->county. "/". $self->country - unless qsearch('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - } ); - } + #turn off invoice_ship_address if ship & bill are the same + if ($self->bill_locationnum eq $self->ship_locationnum) { + $self->invoice_ship_address(''); } + # cust_main_county verification now handled by cust_location check + $error = - $self->ut_phonen('daytime', $self->country) - || $self->ut_phonen('night', $self->country) - || $self->ut_phonen('fax', $self->country) - || $self->ut_zip('zip', $self->country) + $self->ut_phonen('daytime', $self->country) + || $self->ut_phonen('night', $self->country) + || $self->ut_phonen('fax', $self->country) + || $self->ut_phonen('mobile', $self->country) ; return $error if $error; - if ( $conf->exists('cust_main-require_phone') - && ! length($self->daytime) && ! length($self->night) + if ( $conf->exists('cust_main-require_phone', $self->agentnum) + && ! $import + && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile) ) { my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/ @@ -1818,73 +1664,26 @@ sub check { my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/ ? 'Night Phone' : FS::Msgcat::_gettext('night'); - - return "$daytime_label or $night_label is required" - - } - if ( $self->has_ship_address - && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } - $self->addr_fields ) - ) - { - my $error = - $self->ut_name('ship_last') - || $self->ut_name('ship_first') - || $self->ut_textn('ship_company') - || $self->ut_text('ship_address1') - || $self->ut_textn('ship_address2') - || $self->ut_text('ship_city') - || $self->ut_textn('ship_county') - || $self->ut_textn('ship_state') - || $self->ut_country('ship_country') - ; - return $error if $error; - - #false laziness with above - unless ( qsearchs('cust_main_county', { - 'country' => $self->ship_country, - 'state' => '', - } ) ) { - return "Unknown ship_state/ship_county/ship_country: ". - $self->ship_state. "/". $self->ship_county. "/". $self->ship_country - unless qsearch('cust_main_county',{ - 'state' => $self->ship_state, - 'county' => $self->ship_county, - 'country' => $self->ship_country, - } ); - } - #eofalse - - $error = - $self->ut_phonen('ship_daytime', $self->ship_country) - || $self->ut_phonen('ship_night', $self->ship_country) - || $self->ut_phonen('ship_fax', $self->ship_country) - || $self->ut_zip('ship_zip', $self->ship_country) - ; - return $error if $error; + my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/ + ? 'Mobile Phone' + : FS::Msgcat::_gettext('mobile'); - return "Unit # is required." - if $self->ship_address2 =~ /^\s*$/ - && $conf->exists('cust_main-require_address2'); - - } else { # ship_ info eq billing info, so don't store dup info in database - - $self->setfield("ship_$_", '') - foreach $self->addr_fields; + return "$daytime_label, $night_label or $mobile_label is required" + + } - return "Unit # is required." - if $self->address2 =~ /^\s*$/ - && $conf->exists('cust_main-require_address2'); + ### start of stuff moved to cust_payby + # then mostly kept here to support upgrades (can remove in 5.x) + # but modified to allow everything to be empty + if ( $self->payby ) { + FS::payby->can_payby($self->table, $self->payby) + or return "Illegal payby: ". $self->payby; + } else { + $self->payby(''); } - #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ - # or return "Illegal payby: ". $self->payby; - #$self->payby($1); - FS::payby->can_payby($self->table, $self->payby) - or return "Illegal payby: ". $self->payby; - $error = $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') @@ -1903,11 +1702,14 @@ sub check { # check the credit card. my $check_payinfo = ! $self->is_encrypted($self->payinfo); - if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { + # Need some kind of global flag to accept invalid cards, for testing + # on scrubbed data. + if ( !$import && !$ignore_invalid_card && $check_payinfo && + $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; - $payinfo =~ /^(\d{13,16})$/ + $payinfo =~ /^(\d{13,16}|\d{8,9})$/ or return gettext('invalid_card'); # . ": ". $self->payinfo; $payinfo = $1; $self->payinfo($payinfo); @@ -1918,12 +1720,23 @@ sub check { if $self->payinfo !~ /^99\d{14}$/ #token && cardtype($self->payinfo) eq "Unknown"; - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned credit card: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; + unless ( $ignore_banned_card ) { + my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); + if ( $ban ) { + if ( $ban->bantype eq 'warn' ) { + #or others depending on value of $ban->reason ? + return '_duplicate_card'. + ': disabled from'. time2str('%a %h %o at %r', $ban->_date). + ' until '. time2str('%a %h %o at %r', $ban->_end_date). + ' (ban# '. $ban->bannum. ')' + unless $self->override_ban_warn; + } else { + return 'Banned credit card: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } + } } if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { @@ -1964,26 +1777,38 @@ sub check { $self->payissue(''); } - } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) { + } elsif ( !$ignore_invalid_card && $check_payinfo && + $self->payby =~ /^(CHEK|DCHK)$/ ) { my $payinfo = $self->payinfo; - $payinfo =~ s/[^\d\@]//g; - if ( $conf->exists('echeck-nonus') ) { - $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; + $payinfo =~ s/[^\d\@\.]//g; + if ( $conf->config('echeck-country') eq 'CA' ) { + $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/ + or return 'invalid echeck account@branch.bank'; + $payinfo = "$1\@$2.$3"; + } elsif ( $conf->config('echeck-country') eq 'US' ) { + $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; $payinfo = "$1\@$2"; } else { - $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing'; $payinfo = "$1\@$2"; } $self->payinfo($payinfo); $self->paycvv(''); - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned ACH account: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; + unless ( $ignore_banned_card ) { + my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); + if ( $ban ) { + if ( $ban->bantype eq 'warn' ) { + #or others depending on value of $ban->reason ? + return '_duplicate_ach' unless $self->override_ban_warn; + } else { + return 'Banned ACH account: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } + } } } elsif ( $self->payby eq 'LECB' ) { @@ -2028,9 +1853,16 @@ sub check { } + return "You are not permitted to create complimentary accounts." + if ! $self->custnum + && $self->complimentary eq 'Y' + && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer'); + if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expiration date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; + # shouldn't payinfo_check do this? + unless ! $self->payby + || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/; $self->paydate(''); } else { my( $m, $y ); @@ -2043,6 +1875,7 @@ sub check { } else { return "Illegal expiration date: ". $self->paydate; } + $m = sprintf('%02d',$m); $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') @@ -2057,11 +1890,26 @@ sub check { ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { - $self->payname =~ /^([\w \,\.\-\'\&]+)$/ - or return gettext('illegal_name'). " payname: ". $self->payname; - $self->payname($1); + + if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { + $self->payname =~ /^([\w \,\.\-\']*)$/ + or return gettext('illegal_name'). " payname: ". $self->payname; + $self->payname($1); + } else { + $self->payname =~ /^([\w \,\.\-\'\&]*)$/ + or return gettext('illegal_name'). " payname: ". $self->payname; + $self->payname($1); + } + } + ### end of stuff moved to cust_payby + + return "Please select an invoicing locale" + if ! $self->locale + && ! $self->custnum + && $conf->exists('cust_main-require_locale'); + foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) { $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); $self->$flag($1); @@ -2075,6 +1923,21 @@ sub check { $self->SUPER::check; } +=item replace_check + +Additional checks for replace only. + +=cut + +sub replace_check { + my ($new,$old) = @_; + #preserve old value if global config is set + if ($old && $conf->exists('invoice-ship_address')) { + $new->invoice_ship_address($old->invoice_ship_address); + } + return ''; +} + =item addr_fields Returns a list of fields which have ship_ duplicates. @@ -2083,8 +1946,10 @@ Returns a list of fields which have ship_ duplicates. sub addr_fields { qw( last first company + locationname address1 address2 city county state zip country - daytime night fax + latitude longitude + daytime night fax mobile ); } @@ -2096,58 +1961,20 @@ Returns true if this customer record has a separate shipping address. sub has_ship_address { my $self = shift; - scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); + $self->bill_locationnum != $self->ship_locationnum; } =item location_hash -Returns a list of key/value pairs, with the following keys: address1, adddress2, -city, county, state, zip, country. The shipping address is used if present. +Returns a list of key/value pairs, with the following keys: address1, +adddress2, city, county, state, zip, country, district, and geocode. The +shipping address is used if present. =cut -#geocode? dependent on tax-ship_address config, not available in cust_location -#mostly. not yet then. - sub location_hash { my $self = shift; - my $prefix = $self->has_ship_address ? 'ship_' : ''; - - map { $_ => $self->get($prefix.$_) } - qw( address1 address2 city county state zip country geocode ); - #fields that cust_location has -} - -=item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] - -Returns all packages (see L) for this customer. - -=cut - -sub all_pkgs { - my $self = shift; - my $extra_qsearch = ref($_[0]) ? shift : {}; - - return $self->num_pkgs unless wantarray || keys(%$extra_qsearch); - - my @cust_pkg = (); - if ( $self->{'_pkgnum'} ) { - @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; - } else { - @cust_pkg = $self->_cust_pkg($extra_qsearch); - } - - sort sort_packages @cust_pkg; -} - -=item cust_pkg - -Synonym for B. - -=cut - -sub cust_pkg { - shift->all_pkgs(@_); + $self->ship_location->location_hash; } =item cust_location @@ -2158,235 +1985,60 @@ Returns all locations (see L) for this customer. sub cust_location { my $self = shift; - qsearch('cust_location', { 'custnum' => $self->custnum } ); + qsearch('cust_location', { 'custnum' => $self->custnum, + 'prospectnum' => '' } ); } -=item location_label [ OPTION => VALUE ... ] - -Returns the label of the service location (see analog in L) for this customer. +=item cust_contact -Options are - -=over 4 - -=item join_string - -used to separate the address elements (defaults to ', ') - -=item escape_function - -a callback used for escaping the text of the address elements - -=back +Returns all contact associations (see L) for this customer. =cut -# false laziness with FS::cust_location::line - -sub location_label { +sub cust_contact { my $self = shift; - my %opt = @_; - - my $separator = $opt{join_string} || ', '; - my $escape = $opt{escape_function} || sub{ shift }; - my $line = ''; - my $cydefault = FS::conf->new->config('countrydefault') || 'US'; - my $prefix = length($self->ship_last) ? 'ship_' : ''; - - my $notfirst = 0; - foreach (qw ( address1 address2 ) ) { - my $method = "$prefix$_"; - $line .= ($notfirst ? $separator : ''). &$escape($self->$method) - if $self->$method; - $notfirst++; - } - $notfirst = 0; - foreach (qw ( city county state zip ) ) { - my $method = "$prefix$_"; - if ( $self->$method ) { - $line .= ' (' if $method eq 'county'; - $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method); - $line .= ' )' if $method eq 'county'; - $notfirst++; - } - } - $line .= $separator. &$escape(code2country($self->country)) - if $self->country ne $cydefault; - - $line; + qsearch('cust_contact', { 'custnum' => $self->custnum } ); } -=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] +=item cust_payby -Returns all non-cancelled packages (see L) for this customer. +Returns all payment methods (see L) for this customer. =cut -sub ncancelled_pkgs { - my $self = shift; - my $extra_qsearch = ref($_[0]) ? shift : {}; - - return $self->num_ncancelled_pkgs unless wantarray; - - my @cust_pkg = (); - if ( $self->{'_pkgnum'} ) { - - warn "$me ncancelled_pkgs: returning cached objects" - if $DEBUG > 1; - - @cust_pkg = grep { ! $_->getfield('cancel') } - values %{ $self->{'_pkgnum'}->cache }; - - } else { - - warn "$me ncancelled_pkgs: searching for packages with custnum ". - $self->custnum. "\n" - if $DEBUG > 1; - - $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) '; - - @cust_pkg = $self->_cust_pkg($extra_qsearch); - - } - - sort sort_packages @cust_pkg; - -} - -sub _cust_pkg { +sub cust_payby { my $self = shift; - my $extra_qsearch = ref($_[0]) ? shift : {}; - - $extra_qsearch->{'select'} ||= '*'; - $extra_qsearch->{'select'} .= - ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum ) - AS _num_cust_svc'; - - map { - $_->{'_num_cust_svc'} = $_->get('_num_cust_svc'); - $_; - } qsearch({ - %$extra_qsearch, - 'table' => 'cust_pkg', - 'hashref' => { 'custnum' => $self->custnum }, + 'table' => 'cust_payby', + 'hashref' => { 'custnum' => $self->custnum }, + 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC", }); - -} - -# This should be generalized to use config options to determine order. -sub sort_packages { - - my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 ); - return $locationsort if $locationsort; - - if ( $a->get('cancel') xor $b->get('cancel') ) { - return -1 if $b->get('cancel'); - return 1 if $a->get('cancel'); - #shouldn't get here... - return 0; - } else { - my $a_num_cust_svc = $a->num_cust_svc; - my $b_num_cust_svc = $b->num_cust_svc; - return 0 if !$a_num_cust_svc && !$b_num_cust_svc; - return -1 if $a_num_cust_svc && !$b_num_cust_svc; - return 1 if !$a_num_cust_svc && $b_num_cust_svc; - my @a_cust_svc = $a->cust_svc; - my @b_cust_svc = $b->cust_svc; - return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc); - return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc); - return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc); - $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; - } - -} - -=item suspended_pkgs - -Returns all suspended packages (see L) for this customer. - -=cut - -sub suspended_pkgs { - my $self = shift; - grep { $_->susp } $self->ncancelled_pkgs; -} - -=item unflagged_suspended_pkgs - -Returns all unflagged suspended packages (see L) for this -customer (thouse packages without the `manual_flag' set). - -=cut - -sub unflagged_suspended_pkgs { - my $self = shift; - return $self->suspended_pkgs - unless dbdef->table('cust_pkg')->column('manual_flag'); - grep { ! $_->manual_flag } $self->suspended_pkgs; } -=item unsuspended_pkgs - -Returns all unsuspended (and uncancelled) packages (see L) for -this customer. - -=cut - -sub unsuspended_pkgs { - my $self = shift; - grep { ! $_->susp } $self->ncancelled_pkgs; -} +=item unsuspend -=item next_bill_date +Unsuspends all unflagged suspended packages (see L +and L) for this customer, except those on hold. -Returns the next date this customer will be billed, as a UNIX timestamp, or -undef if no active package has a next bill date. +Returns a list: an empty list on success or a list of errors. =cut -sub next_bill_date { +sub unsuspend { my $self = shift; - min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs ); -} - -=item num_cancelled_pkgs - -Returns the number of cancelled packages (see L) for this -customer. - -=cut - -sub num_cancelled_pkgs { - shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"); -} - -sub num_ncancelled_pkgs { - shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )"); -} - -sub num_pkgs { - my( $self ) = shift; - my $sql = scalar(@_) ? shift : ''; - $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i; - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql" - ) or die dbh->errstr; - $sth->execute($self->custnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; + grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs; } -=item unsuspend +=item release_hold -Unsuspends all unflagged suspended packages (see L -and L) for this customer. Always returns a list: an empty list -on success or a list of errors. +Unsuspends all suspended packages in the on-hold state (those without setup +dates) for this customer. =cut -sub unsuspend { +sub release_hold { my $self = shift; - grep { $_->unsuspend } $self->suspended_pkgs; + grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs; } =item suspend @@ -2501,16 +2153,21 @@ sub cancel { return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); - if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { + if ( $opt{'ban'} ) { + + foreach my $cust_payby ( $self->cust_payby ) { - #should try decryption (we might have the private key) - # and if not maybe queue a job for the server that does? - return ( "Can't (yet) ban encrypted credit cards" ) - if $self->is_encrypted($self->payinfo); + #well, if they didn't get decrypted on search, then we don't have to + # try again... queue a job for the server that does have decryption + # capability if we're in a paranoid multi-server implementation? + return ( "Can't (yet) ban encrypted credit cards" ) + if $cust_payby->is_encrypted($cust_payby->payinfo); - my $ban = new FS::banned_pay $self->_banned_pay_hashref; - my $error = $ban->insert; - return ( $error ) if $error; + my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref; + my $error = $ban->insert; + return ( $error ) if $error; + + } } @@ -2542,7 +2199,7 @@ sub _banned_pay_hashref { { 'payby' => $payby2ban{$self->payby}, - 'payinfo' => md5_base64($self->payinfo), + 'payinfo' => $self->payinfo, #don't ever *search* on reason! #'reason' => }; } @@ -2554,26 +2211,20 @@ Returns all notes (see L) for this customer. =cut sub notes { - my $self = shift; - #order by? + my($self,$orderby_classnum) = (shift,shift); + my $orderby = "sticky DESC, _date DESC"; + $orderby = "classnum ASC, $orderby" if $orderby_classnum; qsearch( 'cust_main_note', { 'custnum' => $self->custnum }, - '', - 'ORDER BY _DATE DESC' - ); + '', + "ORDER BY $orderby", + ); } =item agent Returns the agent (see L) for this customer. -=cut - -sub agent { - my $self = shift; - qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); -} - =item agent_name Returns the agent name (see L) for this customer. @@ -2590,13 +2241,6 @@ sub agent_name { Returns any tags associated with this customer, as FS::cust_tag objects, or an empty list if there are no tags. -=cut - -sub cust_tag { - my $self = shift; - qsearch('cust_tag', { 'custnum' => $self->custnum } ); -} - =item part_tag Returns any tags associated with this customer, as FS::part_tag objects, @@ -2615,17 +2259,6 @@ sub part_tag { Returns the customer class, as an FS::cust_class object, or the empty string if there is no customer class. -=cut - -sub cust_class { - my $self = shift; - if ( $self->classnum ) { - qsearchs('cust_class', { 'classnum' => $self->classnum } ); - } else { - return ''; - } -} - =item categoryname Returns the customer category name, or the empty string if there is no customer @@ -2656,617 +2289,70 @@ sub classname { : ''; } -=item BILLING METHODS - -Documentation on billing methods has been moved to -L. - -=item do_cust_event [ HASHREF | OPTION => VALUE ... ] +=item tax_status -Runs billing events; see L and the billing events web -interface. +Returns the external tax status, as an FS::tax_status object, or the empty +string if there is no tax status. -If there is an error, returns the error, otherwise returns false. +=cut -Options are passed as name-value pairs. +sub tax_status { + my $self = shift; + if ( $self->taxstatusnum ) { + qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } ); + } else { + return ''; + } +} -Currently available options are: +=item taxstatus -=over 4 +Returns the tax status code if there is one. -=item time +=cut -Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L). Also see L and L for conversion functions. +sub taxstatus { + my $self = shift; + my $tax_status = $self->tax_status; + $tax_status + ? $tax_status->taxstatus + : ''; +} -=item check_freq +=item BILLING METHODS -"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) +Documentation on billing methods has been moved to +L. -=item stage +=item REALTIME BILLING METHODS -"collect" (the default) or "pre-bill" +Documentation on realtime billing methods has been moved to +L. -=item quiet - -set true to surpress email card/ACH decline notices. +=item remove_cvv -=item debug +Removes the I field from the database directly. -Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) +If there is an error, returns the error, otherwise returns false. =cut -# =item payby -# -# allows for one time override of normal customer billing method +sub remove_cvv { + my $self = shift; + my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") + or return dbh->errstr; + $sth->execute($self->custnum) + or return $sth->errstr; + $self->paycvv(''); + ''; +} -# =item retry -# -# Retry card/echeck/LEC transactions even when not scheduled by invoice events. +=item total_owed -sub do_cust_event { - my( $self, %options ) = @_; - my $time = $options{'time'} || time; +Returns the total owed for this customer on all invoices +(see L). - #put below somehow? - 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; - - $self->select_for_update; #mutex - - if ( $DEBUG ) { - my $balance = $self->balance; - warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n" - } - -# if ( exists($options{'retry_card'}) ) { -# carp 'retry_card option passed to collect is deprecated; use retry'; -# $options{'retry'} ||= $options{'retry_card'}; -# } -# if ( exists($options{'retry'}) && $options{'retry'} ) { -# my $error = $self->retry_realtime; -# if ( $error ) { -# $dbh->rollback if $oldAutoCommit; -# return $error; -# } -# } - - # false laziness w/pay_batch::import_results - - my $due_cust_event = $self->due_cust_event( - 'debug' => ( $options{'debug'} || 0 ), - 'time' => $time, - 'check_freq' => $options{'check_freq'}, - 'stage' => ( $options{'stage'} || 'collect' ), - ); - unless( ref($due_cust_event) ) { - $dbh->rollback if $oldAutoCommit; - return $due_cust_event; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #never want to roll back an event just because it or a different one - # returned an error - local $FS::UID::AutoCommit = 1; #$oldAutoCommit; - - foreach my $cust_event ( @$due_cust_event ) { - - #XXX lock event - - #re-eval event conditions (a previous event could have changed things) - unless ( $cust_event->test_conditions( 'time' => $time ) ) { - #don't leave stray "new/locked" records around - my $error = $cust_event->delete; - return $error if $error; - next; - } - - { - local $realtime_bop_decline_quiet = 1 if $options{'quiet'}; - warn " running cust_event ". $cust_event->eventnum. "\n" - if $DEBUG > 1; - - #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options? - if ( my $error = $cust_event->do_event() ) { - #XXX wtf is this? figure out a proper dealio with return value - #from do_event - return $error; - } - } - - } - - ''; - -} - -=item due_cust_event [ HASHREF | OPTION => VALUE ... ] - -Inserts database records for and returns an ordered listref of new events due -for this customer, as FS::cust_event objects (see L). If no -events are due, an empty listref is returned. If there is an error, returns a -scalar error message. - -To actually run the events, call each event's test_condition method, and if -still true, call the event's do_event method. - -Options are passed as a hashref or as a list of name-value pairs. Available -options are: - -=over 4 - -=item check_freq - -Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized. - -=item stage - -"collect" (the default) or "pre-bill" - -=item time - -"Current time" for the events. - -=item debug - -Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) - -=item eventtable - -Only return events for the specified eventtable (by default, events of all eventtables are returned) - -=item objects - -Explicitly pass the objects to be tested (typically used with eventtable). - -=item testonly - -Set to true to return the objects, but not actually insert them into the -database. - -=back - -=cut - -sub due_cust_event { - my $self = shift; - my %opt = ref($_[0]) ? %{ $_[0] } : @_; - - #??? - #my $DEBUG = $opt{'debug'} - local($DEBUG) = $opt{'debug'} - if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG; - - warn "$me due_cust_event called with options ". - join(', ', map { "$_: $opt{$_}" } keys %opt). "\n" - if $DEBUG; - - $opt{'time'} ||= time; - - 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; - - $self->select_for_update #mutex - unless $opt{testonly}; - - ### - # find possible events (initial search) - ### - - my @cust_event = (); - - my @eventtable = $opt{'eventtable'} - ? ( $opt{'eventtable'} ) - : FS::part_event->eventtables_runorder; - - foreach my $eventtable ( @eventtable ) { - - my @objects; - if ( $opt{'objects'} ) { - - @objects = @{ $opt{'objects'} }; - - } else { - - #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; } - @objects = ( $eventtable eq 'cust_main' ) - ? ( $self ) - : ( $self->$eventtable() ); - - } - - my @e_cust_event = (); - - my $cross = "CROSS JOIN $eventtable"; - $cross .= ' LEFT JOIN cust_main USING ( custnum )' - unless $eventtable eq 'cust_main'; - - foreach my $object ( @objects ) { - - #this first search uses the condition_sql magic for optimization. - #the more possible events we can eliminate in this step the better - - my $cross_where = ''; - my $pkey = $object->primary_key; - $cross_where = "$eventtable.$pkey = ". $object->$pkey(); - - my $join = FS::part_event_condition->join_conditions_sql( $eventtable ); - my $extra_sql = - FS::part_event_condition->where_conditions_sql( $eventtable, - 'time'=>$opt{'time'} - ); - my $order = FS::part_event_condition->order_conditions_sql( $eventtable ); - - $extra_sql = "AND $extra_sql" if $extra_sql; - - #here is the agent virtualization - $extra_sql .= " AND ( part_event.agentnum IS NULL - OR part_event.agentnum = ". $self->agentnum. ' )'; - - $extra_sql .= " $order"; - - warn "searching for events for $eventtable ". $object->$pkey. "\n" - if $opt{'debug'} > 2; - my @part_event = qsearch( { - 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ), - 'select' => 'part_event.*', - 'table' => 'part_event', - 'addl_from' => "$cross $join", - 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ), - 'eventtable' => $eventtable, - 'disabled' => '', - }, - 'extra_sql' => "AND $cross_where $extra_sql", - } ); - - if ( $DEBUG > 2 ) { - my $pkey = $object->primary_key; - warn " ". scalar(@part_event). - " possible events found for $eventtable ". $object->$pkey(). "\n"; - } - - push @e_cust_event, map { $_->new_cust_event($object) } @part_event; - - } - - warn " ". scalar(@e_cust_event). - " subtotal possible cust events found for $eventtable\n" - if $DEBUG > 1; - - push @cust_event, @e_cust_event; - - } - - warn " ". scalar(@cust_event). - " total possible cust events found in initial search\n" - if $DEBUG; # > 1; - - - ## - # test stage - ## - - $opt{stage} ||= 'collect'; - @cust_event = - grep { my $stage = $_->part_event->event_stage; - $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' ) - } - @cust_event; - - ## - # test conditions - ## - - my %unsat = (); - - @cust_event = grep $_->test_conditions( 'time' => $opt{'time'}, - 'stats_hashref' => \%unsat ), - @cust_event; - - warn " ". scalar(@cust_event). " cust events left satisfying conditions\n" - if $DEBUG; # > 1; - - warn " invalid conditions not eliminated with condition_sql:\n". - join('', map " $_: ".$unsat{$_}."\n", keys %unsat ) - if keys %unsat && $DEBUG; # > 1; - - ## - # insert - ## - - unless( $opt{testonly} ) { - foreach my $cust_event ( @cust_event ) { - - my $error = $cust_event->insert(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ## - # return - ## - - warn " returning events: ". Dumper(@cust_event). "\n" - if $DEBUG > 2; - - \@cust_event; - -} - -=item retry_realtime - -Schedules realtime / batch credit card / electronic check / LEC billing -events for for retry. Useful if card information has changed or manual -retry is desired. The 'collect' method must be called to actually retry -the transaction. - -Implementation details: For either this customer, or for each of this -customer's open invoices, changes the status of the first "done" (with -statustext error) realtime processing event to "failed". - -=cut - -sub retry_realtime { - 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; - - #a little false laziness w/due_cust_event (not too bad, really) - - my $join = FS::part_event_condition->join_conditions_sql; - my $order = FS::part_event_condition->order_conditions_sql; - my $mine = - '( ' - . join ( ' OR ' , map { - "( part_event.eventtable = " . dbh->quote($_) - . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ; - } FS::part_event->eventtables) - . ') '; - - #here is the agent virtualization - my $agent_virt = " ( part_event.agentnum IS NULL - OR part_event.agentnum = ". $self->agentnum. ' )'; - - #XXX this shouldn't be hardcoded, actions should declare it... - my @realtime_events = qw( - cust_bill_realtime_card - cust_bill_realtime_check - cust_bill_realtime_lec - cust_bill_batch - ); - - my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'", - @realtime_events - ). - ' ) '; - - my @cust_event = qsearchs({ - 'table' => 'cust_event', - 'select' => 'cust_event.*', - 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join", - 'hashref' => { 'status' => 'done' }, - 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ". - " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1" - }); - - my %seen_invnum = (); - foreach my $cust_event (@cust_event) { - - #max one for the customer, one for each open invoice - my $cust_X = $cust_event->cust_X; - next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill' - ? $cust_X->invnum - : 0 - }++ - or $cust_event->part_event->eventtable eq 'cust_bill' - && ! $cust_X->owed; - - my $error = $cust_event->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling event for retry: $error"; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - - -=cut - -=item REALTIME BILLING METHODS - -Documentation on realtime billing methods has been moved to -L. - -=item remove_cvv - -Removes the I field from the database directly. - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub remove_cvv { - my $self = shift; - my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") - or return dbh->errstr; - $sth->execute($self->custnum) - or return $sth->errstr; - $self->paycvv(''); - ''; -} - -=item batch_card OPTION => VALUE... - -Adds a payment for this invoice to the pending credit card batch (see -L), or, if the B option is set to a true value, -runs the payment using a realtime gateway. - -=cut - -sub batch_card { - my ($self, %options) = @_; - - my $amount; - if (exists($options{amount})) { - $amount = $options{amount}; - }else{ - $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments); - } - return '' unless $amount > 0; - - my $invnum = delete $options{invnum}; - my $payby = $options{invnum} || $self->payby; #dubious - - if ($options{'realtime'}) { - return $self->realtime_bop( FS::payby->payby2bop($self->payby), - $amount, - %options, - ); - } - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #this needs to handle mysql as well as Pg, like svc_acct.pm - #(make it into a common function if folks need to do batching with mysql) - $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE") - or return "Cannot lock pay_batch: " . $dbh->errstr; - - my %pay_batch = ( - 'status' => 'O', - 'payby' => FS::payby->payby2payment($payby), - ); - - my $pay_batch = qsearchs( 'pay_batch', \%pay_batch ); - - unless ( $pay_batch ) { - $pay_batch = new FS::pay_batch \%pay_batch; - my $error = $pay_batch->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die "error creating new batch: $error\n"; - } - } - - my $old_cust_pay_batch = qsearchs('cust_pay_batch', { - 'batchnum' => $pay_batch->batchnum, - 'custnum' => $self->custnum, - } ); - - foreach (qw( address1 address2 city state zip country payby payinfo paydate - payname )) { - $options{$_} = '' unless exists($options{$_}); - } - - my $cust_pay_batch = new FS::cust_pay_batch ( { - 'batchnum' => $pay_batch->batchnum, - 'invnum' => $invnum || 0, # is there a better value? - # this field should be - # removed... - # cust_bill_pay_batch now - 'custnum' => $self->custnum, - 'last' => $self->getfield('last'), - 'first' => $self->getfield('first'), - 'address1' => $options{address1} || $self->address1, - 'address2' => $options{address2} || $self->address2, - 'city' => $options{city} || $self->city, - 'state' => $options{state} || $self->state, - 'zip' => $options{zip} || $self->zip, - 'country' => $options{country} || $self->country, - 'payby' => $options{payby} || $self->payby, - 'payinfo' => $options{payinfo} || $self->payinfo, - 'exp' => $options{paydate} || $self->paydate, - 'payname' => $options{payname} || $self->payname, - 'amount' => $amount, # consolidating - } ); - - $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum) - if $old_cust_pay_batch; - - my $error; - if ($old_cust_pay_batch) { - $error = $cust_pay_batch->replace($old_cust_pay_batch) - } else { - $error = $cust_pay_batch->insert; - } - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die $error; - } - - my $unapplied = $self->total_unapplied_credits - + $self->total_unapplied_payments - + $self->in_transit_payments; - foreach my $cust_bill ($self->open_cust_bill) { - #$dbh->commit or die $dbh->errstr if $oldAutoCommit; - my $cust_bill_pay_batch = new FS::cust_bill_pay_batch { - 'invnum' => $cust_bill->invnum, - 'paybatchnum' => $cust_pay_batch->paybatchnum, - 'amount' => $cust_bill->owed, - '_date' => time, - }; - if ($unapplied >= $cust_bill_pay_batch->amount){ - $unapplied -= $cust_bill_pay_batch->amount; - next; - }else{ - $cust_bill_pay_batch->amount(sprintf ( "%.2f", - $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0; - } - $error = $cust_bill_pay_batch->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} - -=item total_owed - -Returns the total owed for this customer on all invoices -(see L). - -=cut +=cut sub total_owed { my $self = shift; @@ -3295,7 +2381,7 @@ sub total_owed_date { AND _date <= $time "; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } @@ -3375,7 +2461,7 @@ sub total_unapplied_credits { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } @@ -3413,7 +2499,7 @@ sub total_unapplied_payments { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } @@ -3451,7 +2537,7 @@ sub total_unapplied_refunds { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } @@ -3493,7 +2579,7 @@ UNIX timestamps; see L). Also see L and L for conversion functions. The empty string can be passed to disable that time constraint completely. -Available options are: +Accepts the same options as L: =over 4 @@ -3501,6 +2587,12 @@ Available options are: set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) +=item cutoff + +An absolute cutoff time. Payments, credits, and refunds I after this +time will be ignored. Note that START_TIME and END_TIME only limit the date +range for invoices and I payments, credits, and refunds. + =back =cut @@ -3509,7 +2601,7 @@ sub balance_date_range { my $self = shift; my $sql = 'SELECT SUM('. $self->balance_date_sql(@_). ') FROM cust_main WHERE custnum='. $self->custnum; - sprintf( '%.2f', $self->scalar_sql($sql) ); + sprintf( '%.2f', $self->scalar_sql($sql) || 0 ); } =item balance_pkgnum PKGNUM @@ -3532,32 +2624,9 @@ sub balance_pkgnum { ); } -=item in_transit_payments +=item payment_info -Returns the total of requests for payments for this customer pending in -batches in transit to the bank. See L and L - -=cut - -sub in_transit_payments { - my $self = shift; - my $in_transit_payments = 0; - foreach my $pay_batch ( qsearch('pay_batch', { - 'status' => 'I', - } ) ) { - foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { - 'batchnum' => $pay_batch->batchnum, - 'custnum' => $self->custnum, - } ) ) { - $in_transit_payments += $cust_pay_batch->amount; - } - } - sprintf( "%.2f", $in_transit_payments ); -} - -=item payment_info - -Returns a hash of useful information for making a payment. +Returns a hash of useful information for making a payment. =over 4 @@ -3605,7 +2674,8 @@ sub payment_info { $return{payname} = $self->payname || ( $self->first. ' '. $self->get('last') ); - $return{$_} = $self->get($_) for qw(address1 address2 city state zip); + $return{$_} = $self->bill_location->$_ + for qw(address1 address2 city state zip); $return{payby} = $self->payby; $return{stateid_state} = $self->stateid_state; @@ -3653,6 +2723,60 @@ sub paydate_monthyear { } } +=item paydate_epoch + +Returns the exact time in seconds corresponding to the payment method +expiration date. For CARD/DCRD customers this is the end of the month; +for others (COMP is the only other payby that uses paydate) it's the start. +Returns 0 if the paydate is empty or set to the far future. + +=cut + +sub paydate_epoch { + my $self = shift; + my ($month, $year) = $self->paydate_monthyear; + return 0 if !$year or $year >= 2037; + if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) { + $month++; + if ( $month == 13 ) { + $month = 1; + $year++; + } + return timelocal(0,0,0,1,$month-1,$year) - 1; + } + else { + return timelocal(0,0,0,1,$month-1,$year); + } +} + +=item paydate_epoch_sql + +Class method. Returns an SQL expression to obtain the payment expiration date +as a number of seconds. + +=cut + +# Special expiration date behavior for non-CARD/DCRD customers has been +# carefully preserved. Do we really use that? +sub paydate_epoch_sql { + my $class = shift; + my $table = shift || 'cust_main'; + my ($case1, $case2); + if ( driver_name eq 'Pg' ) { + $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1"; + $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )"; + } + elsif ( lc(driver_name) eq 'mysql' ) { + $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1"; + $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )"; + } + else { return '' } + return "CASE WHEN $table.payby IN('CARD','DCRD') + THEN ($case1) + ELSE ($case2) + END" +} + =item tax_exemption TAXNAME =cut @@ -3668,13 +2792,6 @@ sub tax_exemption { =item cust_main_exemption -=cut - -sub cust_main_exemption { - my $self = shift; - qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ); -} - =item invoicing_list [ ARRAYREF ] If an arguement is given, sets these email addresses as invoice recipients @@ -3766,7 +2883,7 @@ sub check_invoicing_list { } return "Email address required" - if $conf->exists('cust_main-require_invoicing_list_email') + if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum) && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref; ''; @@ -3951,6 +3068,8 @@ reason, and a 'reason_type' option must be passed to indicate the FS::reason_type for the new reason. An I option may be passed to set the credit's I field. +Likewise for I, I, I and +I. Any other options are passed to FS::cust_credit::insert. @@ -3976,10 +3095,10 @@ sub credit { $cust_credit->set('reason', $reason) } - for (qw( addlinfo eventnum )) { - $cust_credit->$_( delete $options{$_} ) - if exists($options{$_}); - } + $cust_credit->$_( delete $options{$_} ) + foreach grep exists($options{$_}), + qw( addlinfo eventnum ), + map "commission_$_", qw( agentnum salesnum pkgnum ); $cust_credit->insert(%options); @@ -4004,6 +3123,8 @@ New-style, with a hashref of options: 'setuptax' => '', # or 'Y' for tax exempt + 'locationnum'=> 1234, # optional + #internal taxation 'taxclass' => 'Tax class', @@ -4026,17 +3147,21 @@ Old-style: =cut +#super false laziness w/quotation::charge sub charge { my $self = shift; - my ( $amount, $quantity, $start_date, $classnum ); + my ( $amount, $setup_cost, $quantity, $start_date, $classnum ); my ( $pkg, $comment, $additional ); my ( $setuptax, $taxclass ); #internal taxes my ( $taxproduct, $override ); #vendor (CCH) taxes my $no_auto = ''; + my $separate_bill = ''; my $cust_pkg_ref = ''; my ( $bill_now, $invoice_terms ) = ( 0, '' ); + my $locationnum; if ( ref( $_[0] ) ) { $amount = $_[0]->{amount}; + $setup_cost = $_[0]->{setup_cost}; $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1; $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : ''; $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : ''; @@ -4052,8 +3177,11 @@ sub charge { $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : ''; $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : ''; $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : ''; - } else { + $locationnum = $_[0]->{locationnum} || $self->ship_locationnum; + $separate_bill = $_[0]->{separate_bill} || ''; + } else { # yuck $amount = shift; + $setup_cost = ''; $quantity = 1; $start_date = ''; $pkg = @_ ? shift : 'One-time charge'; @@ -4084,6 +3212,7 @@ sub charge { 'setuptax' => $setuptax, 'taxclass' => $taxclass, 'taxproductnum' => $taxproduct, + 'setup_cost' => $setup_cost, } ); my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) } @@ -4118,6 +3247,8 @@ sub charge { 'quantity' => $quantity, 'start_date' => $start_date, 'no_auto' => $no_auto, + 'separate_bill' => $separate_bill, + 'locationnum'=> $locationnum, } ); $error = $cust_pkg->insert; @@ -4157,7 +3288,7 @@ sub charge { sub charge_postal_fee { my $self = shift; - my $pkgpart = $conf->config('postal_invoice-fee_pkgpart'); + my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum); return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list); my $cust_pkg = new FS::cust_pkg ( { @@ -4170,17 +3301,29 @@ sub charge_postal_fee { $error ? $error : $cust_pkg; } -=item cust_bill +=item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all the invoices (see L) for this customer. +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. + =cut sub cust_bill { my $self = shift; - map { $_ } #return $self->num_cust_bill unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + my $opt = ref($_[0]) ? shift : { @_ }; + + #return $self->num_cust_bill unless wantarray || keys %$opt; + + $opt->{'table'} = 'cust_bill'; + $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway... + $opt->{'hashref'}{'custnum'} = $self->custnum; + $opt->{'order_by'} ||= 'ORDER BY _date ASC'; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch($opt); } =item open_cust_bill @@ -4193,26 +3336,119 @@ customer. sub open_cust_bill { my $self = shift; - qsearch({ - 'table' => 'cust_bill', - 'hashref' => { 'custnum' => $self->custnum, }, + $self->cust_bill( 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0', - 'order_by' => 'ORDER BY _date ASC', - }); + #@_ + ); + +} + +=item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] + +Returns all the legacy invoices (see L) for this customer. + +=cut + +sub legacy_cust_bill { + my $self = shift; + + #return $self->num_legacy_cust_bill unless wantarray; + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch({ 'table' => 'legacy_cust_bill', + 'hashref' => { 'custnum' => $self->custnum, }, + 'order_by' => 'ORDER BY _date ASC', + }); } -=item cust_statements +=item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all the statements (see L) for this customer. +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. + =cut -sub cust_statement { +=item cust_bill_void + +Returns all the voided invoices (see L) for this customer. + +=cut + +sub cust_bill_void { my $self = shift; - map { $_ } #return $self->num_cust_statement unless wantarray; + + map { $_ } #return $self->num_cust_bill_void unless wantarray; sort { $a->_date <=> $b->_date } - qsearch('cust_statement', { 'custnum' => $self->custnum, } ) + qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } ) +} + +sub cust_statement { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + + #return $self->num_cust_statement unless wantarray || keys %$opt; + + $opt->{'table'} = 'cust_statement'; + $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway... + $opt->{'hashref'}{'custnum'} = $self->custnum; + $opt->{'order_by'} ||= 'ORDER BY _date ASC'; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch($opt); +} + +=item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ] + +Returns all services of type SVCDB (such as 'svc_acct') for this customer. + +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed following the SVCDB. + +=cut + +sub svc_x { + my $self = shift; + my $svcdb = shift; + if ( ! $svcdb =~ /^svc_\w+$/ ) { + warn "$me svc_x requires a svcdb"; + return; + } + my $opt = ref($_[0]) ? shift : { @_ }; + + $opt->{'table'} = $svcdb; + $opt->{'addl_from'} = + 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '. + ($opt->{'addl_from'} || ''); + + my $custnum = $self->custnum; + $custnum =~ /^\d+$/ or die "bad custnum '$custnum'"; + my $where = "cust_pkg.custnum = $custnum"; + + my $extra_sql = $opt->{'extra_sql'} || ''; + if ( keys %{ $opt->{'hashref'} } ) { + $extra_sql = " AND $where $extra_sql"; + } + else { + if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) { + $extra_sql = "WHERE $where AND $1"; + } + else { + $extra_sql = "WHERE $where $extra_sql"; + } + } + $opt->{'extra_sql'} = $extra_sql; + + qsearch($opt); +} + +# required for use as an eventtable; +sub svc_acct { + my $self = shift; + $self->svc_x('svc_acct', @_); } =item cust_credit @@ -4245,6 +3481,19 @@ sub cust_credit_pkgnum { ); } +=item cust_credit_void + +Returns all voided credits (see L) for this customer. + +=cut + +sub cust_credit_void { + my $self = shift; + map { $_ } + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } ) +} + =item cust_pay Returns all the payments (see L) for this customer. @@ -4253,9 +3502,17 @@ Returns all the payments (see L) for this customer. sub cust_pay { my $self = shift; - return $self->num_cust_pay unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) + my $opt = ref($_[0]) ? shift : { @_ }; + + return $self->num_cust_pay unless wantarray || keys %$opt; + + $opt->{'table'} = 'cust_pay'; + $opt->{'hashref'}{'custnum'} = $self->custnum; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->_date <=> $b->_date } + qsearch($opt); + } =item num_cust_pay @@ -4273,6 +3530,22 @@ sub num_cust_pay { $sth->fetchrow_arrayref->[0]; } +=item unapplied_cust_pay + +Returns all the unapplied payments (see L) for this customer. + +=cut + +sub unapplied_cust_pay { + my $self = shift; + + $self->cust_pay( + 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0', + #@_ + ); + +} + =item cust_pay_pkgnum Returns all the payments (see L) for this customer's specific @@ -4303,19 +3576,6 @@ sub cust_pay_void { qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) } -=item cust_pay_batch - -Returns all batched payments (see L) for this customer. - -=cut - -sub cust_pay_batch { - my $self = shift; - map { $_ } #return $self->num_cust_pay_batch unless wantarray; - sort { $a->paybatchnum <=> $b->paybatchnum } - qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } ) -} - =item cust_pay_pending Returns all pending payments (see L) for this customer @@ -4410,8 +3670,35 @@ cust_main-default_agent_custid is set and it has a value, custnum otherwise. sub display_custnum { my $self = shift; + + my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || ''; + if ( my $special = $conf->config('cust_main-custnum-display_special') ) { + if ( $special eq 'CoStAg' ) { + $prefix = uc( join('', + $self->country, + ($self->state =~ /^(..)/), + $prefix || ($self->agent->agent =~ /^(..)/) + ) ); + } + elsif ( $special eq 'CoStCl' ) { + $prefix = uc( join('', + $self->country, + ($self->state =~ /^(..)/), + ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__') + ) ); + } + # add any others here if needed + } + + my $length = $conf->config('cust_main-custnum-display_length'); if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){ return $self->agent_custid; + } elsif ( $prefix ) { + $length = 8 if !defined($length); + return $prefix . + sprintf('%0'.$length.'d', $self->custnum) + } elsif ( $length ) { + return sprintf('%0'.$length.'d', $self->custnum); } else { return $self->custnum; } @@ -4431,6 +3718,29 @@ sub name { $name; } +=item service_contact + +Returns the L object for this customer that has the 'Service' +contact class, or undef if there is no such contact. Deprecated; don't use +this in new code. + +=cut + +sub service_contact { + my $self = shift; + if ( !exists($self->{service_contact}) ) { + my $classnum = $self->scalar_sql( + 'SELECT classnum FROM contact_class WHERE classname = \'Service\'' + ) || 0; #if it's zero, qsearchs will return nothing + my $cust_contact = qsearchs('cust_contact', { + 'classnum' => $classnum, + 'custnum' => $self->custnum, + }); + $self->{service_contact} = $cust_contact->contact if $cust_contact; + } + $self->{service_contact}; +} + =item ship_name Returns a name string for this (service/shipping) contact, either @@ -4440,13 +3750,10 @@ Returns a name string for this (service/shipping) contact, either sub ship_name { my $self = shift; - if ( $self->get('ship_last') ) { - my $name = $self->ship_contact; - $name = $self->ship_company. " ($name)" if $self->ship_company; - $name; - } else { - $self->name; - } + + my $name = $self->ship_contact; + $name = $self->company. " ($name)" if $self->company; + $name; } =item name_short @@ -4469,13 +3776,9 @@ or "First Last". sub ship_name_short { my $self = shift; - if ( $self->get('ship_last') ) { - $self->ship_company !~ /^\s*$/ - ? $self->ship_company - : $self->ship_contact_firstlast; - } else { - $self->name_company_or_firstlast; - } + $self->service_contact + ? $self->ship_contact_firstlast + : $self->name_short } =item contact @@ -4497,9 +3800,8 @@ Returns this customer's full (shipping) contact name only, "Last, First" sub ship_contact { my $self = shift; - $self->get('ship_last') - ? $self->get('ship_last'). ', '. $self->ship_first - : $self->contact; + my $contact = $self->service_contact || $self; + $contact->get('last') . ', ' . $contact->get('first'); } =item contact_firstlast @@ -4521,20 +3823,48 @@ Returns this customer's full (shipping) contact name only, "First Last". sub ship_contact_firstlast { my $self = shift; - $self->get('ship_last') - ? $self->first. ' '. $self->get('ship_last') - : $self->contact_firstlast; + my $contact = $self->service_contact || $self; + $contact->get('first') . ' '. $contact->get('last'); +} + +#XXX this doesn't work in 3.x+ +#=item country_full +# +#Returns this customer's full country name +# +#=cut +# +#sub country_full { +# my $self = shift; +# code2country($self->country); +#} + +sub bill_country_full { + my $self = shift; + code2country($self->bill_location->country); +} + +sub ship_country_full { + my $self = shift; + code2country($self->ship_location->country); } -=item country_full +=item county_state_county [ PREFIX ] -Returns this customer's full country name +Returns a string consisting of just the county, state and country. =cut -sub country_full { +sub county_state_country { my $self = shift; - code2country($self->country); + my $locationnum; + if ( @_ && $_[0] && $self->has_ship_address ) { + $locationnum = $self->ship_locationnum; + } else { + $locationnum = $self->bill_locationnum; + } + my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum }); + $cust_location->county_state_country; } =item geocode DATA_VENDOR @@ -4544,67 +3874,49 @@ Currently this only makes sense for "CCH" as DATA_VENDOR. =cut -sub geocode { - my ($self, $data_vendor) = (shift, shift); #always cch for now - - my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode - return $geocode if $geocode; +=item cust_status - my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) ) - ? 'ship_' - : ''; +=item status - my($zip,$plus4) = split /-/, $self->get("${prefix}zip") - if $self->country eq 'US'; +Returns a status string for this customer, currently: - $zip ||= ''; - $plus4 ||= ''; - #CCH specific location stuff - my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'"; +=over 4 - my @cust_tax_location = - qsearch( { - 'table' => 'cust_tax_location', - 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor }, - 'extra_sql' => $extra_sql, - 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends - } - ); - $geocode = $cust_tax_location[0]->geocode - if scalar(@cust_tax_location); +=item prospect - $geocode; -} +No packages have ever been ordered. Displayed as "No packages". -=item cust_status +=item ordered -=item status +Recurring packages all are new (not yet billed). -Returns a status string for this customer, currently: +=item active -=over 4 +One or more recurring packages is active. -=item prospect - No packages have ever been ordered +=item inactive -=item ordered - Recurring packages all are new (not yet billed). +No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled). -=item active - One or more recurring packages is active +=item suspended -=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) +All non-cancelled recurring packages are suspended. -=item suspended - All non-cancelled recurring packages are suspended +=item cancelled -=item cancelled - All recurring packages are cancelled +All recurring packages are cancelled. =back +Behavior of inactive vs. cancelled edge cases can be adjusted with the +cust_main-status_module configuration option. + =cut sub status { shift->cust_status(@_); } sub cust_status { my $self = shift; - # prospect ordered active inactive suspended cancelled for my $status ( FS::cust_main->statuses() ) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; @@ -4615,52 +3927,88 @@ sub cust_status { } } +=item is_status_delay_cancel + +Returns true if customer status is 'suspended' +and all suspended cust_pkg return true for +cust_pkg->is_status_delay_cancel. + +This is not a real status, this only meant for hacking display +values, because otherwise treating the customer as suspended is +really the whole point of the delay_cancel option. + +=cut + +sub is_status_delay_cancel { + my ($self) = @_; + return 0 unless $self->status eq 'suspended'; + foreach my $cust_pkg ($self->ncancelled_pkgs) { + return 0 unless $cust_pkg->is_status_delay_cancel; + } + return 1; +} + =item ucfirst_cust_status =item ucfirst_status +Deprecated, use the cust_status_label method instead. + Returns the status with the first character capitalized. =cut -sub ucfirst_status { shift->ucfirst_cust_status(@_); } +sub ucfirst_status { + carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn; + local($ucfirst_nowarn) = 1; + shift->ucfirst_cust_status(@_); +} sub ucfirst_cust_status { + carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn; my $self = shift; ucfirst($self->cust_status); } +=item cust_status_label + +=item status_label + +Returns the display label for this status. + +=cut + +sub status_label { shift->cust_status_label(@_); } + +sub cust_status_label { + my $self = shift; + __PACKAGE__->statuslabels->{$self->cust_status}; +} + =item statuscolor Returns a hex triplet color string for this customer's status. =cut -use vars qw(%statuscolor); -tie %statuscolor, 'Tie::IxHash', - 'prospect' => '7e0079', #'000000', #black? naw, purple - 'active' => '00CC00', #green - 'ordered' => '009999', #teal? cyan? - 'inactive' => '0000CC', #blue - 'suspended' => 'FF9900', #yellow - 'cancelled' => 'FF0000', #red -; - sub statuscolor { shift->cust_statuscolor(@_); } sub cust_statuscolor { my $self = shift; - $statuscolor{$self->cust_status}; + __PACKAGE__->statuscolors->{$self->cust_status}; } -=item tickets +=item tickets [ STATUS ] Returns an array of hashes representing the customer's RT tickets. +An optional status (or arrayref or hashref of statuses) may be specified. + =cut sub tickets { my $self = shift; + my $status = ( @_ && $_[0] ) ? shift : ''; my $num = $conf->config('cust_main-max_tickets') || 10; my @tickets = (); @@ -4668,7 +4016,12 @@ sub tickets { if ( $conf->config('ticket_system') ) { unless ( $conf->config('ticket_system-custom_priority_field') ) { - @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) }; + @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum, + $num, + undef, + $status, + ) + }; } else { @@ -4680,6 +4033,7 @@ sub tickets { @{ FS::TicketSystem->customer_tickets( $self->custnum, $num - scalar(@tickets), $priority, + $status, ) }; } @@ -4714,6 +4068,22 @@ sub service_coordinates { scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : () } +=item masked FIELD + +Returns a masked version of the named field + +=cut + +sub masked { +my ($self,$field) = @_; + +# Show last four + +'x'x(length($self->getfield($field))-4). + substr($self->getfield($field), (length($self->getfield($field))-4)); + +} + =back =head1 CLASS METHODS @@ -4730,10 +4100,28 @@ Class method that returns the list of possible status strings for customers =cut sub statuses { - #my $self = shift; #could be class... - keys %statuscolor; + my $self = shift; + keys %{ $self->statuscolors }; } +=item cust_status_sql + +Returns an SQL fragment to determine the status of a cust_main record, as a +string. + +=cut + +sub cust_status_sql { + my $sql = 'CASE'; + for my $status ( FS::cust_main->statuses() ) { + my $method = $status.'_sql'; + $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'"; + } + $sql .= ' END'; + return $sql; +} + + =item prospect_sql Returns an SQL expression identifying prospective cust_main records (customers @@ -4757,13 +4145,14 @@ sub prospect_sql { =item ordered_sql Returns an SQL expression identifying ordered cust_main records (customers with -recurring packages not yet setup). +no active packages, but recurring packages not yet setup or one time charges +not yet billed). =cut sub ordered_sql { FS::cust_main->none_active_sql. - " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) "; + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) "; } =item active_sql @@ -4789,1147 +4178,216 @@ sub none_active_sql { " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } -=item inactive_sql - -Returns an SQL expression identifying inactive cust_main records (customers with -no active recurring packages, but otherwise unsuspended/uncancelled). - -=cut - -sub inactive_sql { - FS::cust_main->none_active_sql. - " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) "; -} - -=item susp_sql -=item suspended_sql - -Returns an SQL expression identifying suspended cust_main records. - -=cut - - -sub suspended_sql { susp_sql(@_); } -sub susp_sql { - FS::cust_main->none_active_sql. - " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) "; -} - -=item cancel_sql -=item cancelled_sql - -Returns an SQL expression identifying cancelled cust_main records. - -=cut - -sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { - - my $recurring_sql = FS::cust_pkg->recurring_sql; - my $cancelled_sql = FS::cust_pkg->cancelled_sql; - - " - 0 < ( $select_count_pkgs ) - AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql ) - AND 0 = ( $select_count_pkgs AND $recurring_sql - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) - AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) - "; - -} - -=item uncancel_sql -=item uncancelled_sql - -Returns an SQL expression identifying un-cancelled cust_main records. - -=cut - -sub uncancelled_sql { uncancel_sql(@_); } -sub uncancel_sql { " - ( 0 < ( $select_count_pkgs - AND ( cust_pkg.cancel IS NULL - OR cust_pkg.cancel = 0 - ) - ) - OR 0 = ( $select_count_pkgs ) - ) -"; } - -=item balance_sql - -Returns an SQL fragment to retreive the balance. - -=cut - -sub balance_sql { " - ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill - WHERE cust_bill.custnum = cust_main.custnum ) - - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay - WHERE cust_pay.custnum = cust_main.custnum ) - - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit - WHERE cust_credit.custnum = cust_main.custnum ) - + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund - WHERE cust_refund.custnum = cust_main.custnum ) -"; } - -=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] - -Returns an SQL fragment to retreive the balance for this customer, optionally -considering invoices with date earlier than START_TIME, and not -later than END_TIME (total_owed_date minus total_unapplied_credits minus -total_unapplied_payments). - -Times are specified as SQL fragments or numeric -UNIX timestamps; see L). Also see L and -L for conversion functions. The empty string can be passed -to disable that time constraint completely. - -Available options are: - -=over 4 - -=item unapplied_date - -set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) - -=item total - -(unused. obsolete?) -set to true to remove all customer comparison clauses, for totals - -=item where - -(unused. obsolete?) -WHERE clause hashref (elements "AND"ed together) (typically used with the total option) - -=item join - -(unused. obsolete?) -JOIN clause (typically used with the total option) - -=item cutoff - -An absolute cutoff time. Payments, credits, and refunds I after this -time will be ignored. Note that START_TIME and END_TIME only limit the date -range for invoices and I payments, credits, and refunds. - -=back - -=cut - -sub balance_date_sql { - my( $class, $start, $end, %opt ) = @_; - - my $cutoff = $opt{'cutoff'}; - - my $owed = FS::cust_bill->owed_sql($cutoff); - my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff); - my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff); - my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); - - my $j = $opt{'join'} || ''; - - my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt ); - my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt ); - my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt ); - my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt ); - - " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh ) - + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh ) - - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh ) - - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh ) - "; - -} - -=item unapplied_payments_date_sql START_TIME [ END_TIME ] - -Returns an SQL fragment to retreive the total unapplied payments for this -customer, only considering invoices with date earlier than START_TIME, and -optionally not later than END_TIME. - -Times are specified as SQL fragments or numeric -UNIX timestamps; see L). Also see L and -L for conversion functions. The empty string can be passed -to disable that time constraint completely. - -Available options are: - -=cut - -sub unapplied_payments_date_sql { - my( $class, $start, $end, %opt ) = @_; - - my $cutoff = $opt{'cutoff'}; - - my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); - - my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end, - 'unapplied_date'=>1 ); - - " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) "; -} - -=item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ] - -Helper method for balance_date_sql; name (and usage) subject to change -(suggestions welcome). - -Returns a WHERE clause for the specified monetary TABLE (cust_bill, -cust_refund, cust_credit or cust_pay). - -If TABLE is "cust_bill" or the unapplied_date option is true, only -considers records with date earlier than START_TIME, and optionally not -later than END_TIME . - -=cut - -sub _money_table_where { - my( $class, $table, $start, $end, %opt ) = @_; - - my @where = (); - push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'}; - if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) { - push @where, "$table._date <= $start" if defined($start) && length($start); - push @where, "$table._date > $end" if defined($end) && length($end); - } - push @where, @{$opt{'where'}} if $opt{'where'}; - my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : ''; - - $where; - -} - -=item search HASHREF - -(Class method) - -Returns a qsearch hash expression to search for parameters specified in -HASHREF. Valid parameters are - -=over 4 - -=item agentnum - -=item status - -=item cancelled_pkgs - -bool - -=item signupdate - -listref of start date, end date - -=item payby - -listref - -=item paydate_year - -=item paydate_month - -=item current_balance - -listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance')) - -=item cust_fields - -=item flattened_pkgs - -bool - -=back - -=cut - -sub search { - my ($class, $params) = @_; - - my $dbh = dbh; - - my @where = (); - my $orderby; - - ## - # parse agent - ## - - if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) { - push @where, - "cust_main.agentnum = $1"; - } - - ## - # do the same for user - ## - - if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) { - push @where, - "cust_main.usernum = $1"; - } - - ## - # parse status - ## - - #prospect ordered active inactive suspended cancelled - if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) { - my $method = $params->{'status'}. '_sql'; - #push @where, $class->$method(); - push @where, FS::cust_main->$method(); - } - - ## - # parse cancelled package checkbox - ## - - my $pkgwhere = ""; - - $pkgwhere .= "AND (cancel = 0 or cancel is null)" - unless $params->{'cancelled_pkgs'}; - - ## - # parse without census tract checkbox - ## - - push @where, "(censustract = '' or censustract is null)" - if $params->{'no_censustract'}; - - ## - # dates - ## - - foreach my $field (qw( signupdate )) { - - next unless exists($params->{$field}); - - my($beginning, $ending, $hour) = @{$params->{$field}}; - - push @where, - "cust_main.$field IS NOT NULL", - "cust_main.$field >= $beginning", - "cust_main.$field <= $ending"; - - # XXX: do this for mysql and/or pull it out of here - if(defined $hour) { - if ($dbh->{Driver}->{Name} eq 'Pg') { - push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour"; - } - else { - warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases"; - } - } - - $orderby ||= "ORDER BY cust_main.$field"; - - } - - ### - # classnum - ### - - if ( $params->{'classnum'} ) { - - my @classnum = ref( $params->{'classnum'} ) - ? @{ $params->{'classnum'} } - : ( $params->{'classnum'} ); - - @classnum = grep /^(\d*)$/, @classnum; - - if ( @classnum ) { - push @where, '( '. join(' OR ', map { - $_ ? "cust_main.classnum = $_" - : "cust_main.classnum IS NULL" - } - @classnum - ). - ' )'; - } - - } - - ### - # payby - ### - - if ( $params->{'payby'} ) { - - my @payby = ref( $params->{'payby'} ) - ? @{ $params->{'payby'} } - : ( $params->{'payby'} ); - - @payby = grep /^([A-Z]{4})$/, @payby; - - push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )' - if @payby; - - } - - ### - # paydate_year / paydate_month - ### - - if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) { - my $year = $1; - $params->{'paydate_month'} =~ /^(\d\d?)$/ - or die "paydate_year without paydate_month?"; - my $month = $1; - - push @where, - 'paydate IS NOT NULL', - "paydate != ''", - "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )" -; - } - - ### - # invoice terms - ### - - if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) { - my $terms = $1; - if ( $1 eq 'NULL' ) { - push @where, - "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )"; - } else { - push @where, - "cust_main.invoice_terms IS NOT NULL", - "cust_main.invoice_terms = '$1'"; - } - } - - ## - # amounts - ## - - if ( $params->{'current_balance'} ) { - - #my $balance_sql = $class->balance_sql(); - my $balance_sql = FS::cust_main->balance_sql(); - - my @current_balance = - ref( $params->{'current_balance'} ) - ? @{ $params->{'current_balance'} } - : ( $params->{'current_balance'} ); - - push @where, map { s/current_balance/$balance_sql/; $_ } - @current_balance; - - } - - ## - # custbatch - ## - - if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) { - push @where, - "cust_main.custbatch = '$1'"; - } - - ## - # setup queries, subs, etc. for the search - ## - - $orderby ||= 'ORDER BY custnum'; - - # here is the agent virtualization - push @where, $FS::CurrentUser::CurrentUser->agentnums_sql; - - my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; - - my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) '; - - my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql"; - - my $select = join(', ', - 'cust_main.custnum', - FS::UI::Web::cust_sql_fields($params->{'cust_fields'}), - ); - - my(@extra_headers) = (); - my(@extra_fields) = (); - - if ($params->{'flattened_pkgs'}) { - - if ($dbh->{Driver}->{Name} eq 'Pg') { - - $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic"; - - }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) { - $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic"; - $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )"; - }else{ - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "omitting packing information from report."; - } - - my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1"; - - my $sth = dbh->prepare($header_query) or die dbh->errstr; - $sth->execute() or die $sth->errstr; - my $headerrow = $sth->fetchrow_arrayref; - my $headercount = $headerrow ? $headerrow->[0] : 0; - while($headercount) { - unshift @extra_headers, "Package ". $headercount; - unshift @extra_fields, eval q!sub {my $c = shift; - my @a = split '\|', $c->magic; - my $p = $a[!.--$headercount. q!]; - $p; - };!; - } - - } - - my $sql_query = { - 'table' => 'cust_main', - 'select' => $select, - 'hashref' => {}, - 'extra_sql' => $extra_sql, - 'order_by' => $orderby, - 'count_query' => $count_query, - 'extra_headers' => \@extra_headers, - 'extra_fields' => \@extra_fields, - }; - -} - -=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] - -Performs a fuzzy (approximate) search and returns the matching FS::cust_main -records. Currently, I, I, I and/or I may be -specified (the appropriate ship_ field is also searched). - -Additional options are the same as FS::Record::qsearch - -=cut - -sub fuzzy_search { - my( $self, $fuzzy, $hash, @opt) = @_; - #$self - $hash ||= {}; - my @cust_main = (); - - check_and_rebuild_fuzzyfiles(); - foreach my $field ( keys %$fuzzy ) { - - my $all = $self->all_X($field); - next unless scalar(@$all); - - my %match = (); - $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) ); - - my @fcust = (); - foreach ( keys %match ) { - push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt); - push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt); - } - my %fsaw = (); - push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust; - } - - # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes - my %saw = (); - @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main; - - @cust_main; - -} - -=item masked FIELD - -Returns a masked version of the named field - -=cut - -sub masked { -my ($self,$field) = @_; - -# Show last four - -'x'x(length($self->getfield($field))-4). - substr($self->getfield($field), (length($self->getfield($field))-4)); - -} - -=back - -=head1 SUBROUTINES - -=over 4 - -=item smart_search OPTION => VALUE ... - -Accepts the following options: I, the string to search for. The string -will be searched for as a customer number, phone number, name or company name, -as an exact, or, in some cases, a substring or fuzzy match (see the source code -for the exact heuristics used); I, causes smart_search to -skip fuzzy matching when an exact match is found. - -Any additional options are treated as an additional qualifier on the search -(i.e. I). - -Returns a (possibly empty) array of FS::cust_main objects. - -=cut - -sub smart_search { - my %options = @_; - - #here is the agent virtualization - my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; - - my @cust_main = (); - - my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'}; - my $search = delete $options{'search'}; - ( my $alphanum_search = $search ) =~ s/\W//g; - - if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search - - #false laziness w/Record::ut_phone - my $phonen = "$1-$2-$3"; - $phonen .= " x$4" if $4; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). - ' ( '. - join(' OR ', map "$_ = '$phonen'", - qw( daytime night fax - ship_daytime ship_night ship_fax ) - ). - ' ) '. - " AND $agentnums_sql", #agent virtualization - } ); - - unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match - #try looking for matches with extensions unless one was specified - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). - ' ( '. - join(' OR ', map "$_ LIKE '$phonen\%'", - qw( daytime night - ship_daytime ship_night ) - ). - ' ) '. - " AND $agentnums_sql", #agent virtualization - } ); - - } - - # custnum search (also try agent_custid), with some tweaking options if your - # legacy cust "numbers" have letters - } - - if ( $search =~ /^\s*(\d+)\s*$/ - || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+' - && $search =~ /^\s*(\w\w?\d+)\s*$/ - ) - || ( $conf->exists('address1-search' ) - && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D - ) - ) - { - - my $num = $1; - - if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'custnum' => $num, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization - } ); - } - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'agent_custid' => $num, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization - } ); - - if ( $conf->exists('address1-search') ) { - my $len = length($num); - $num = lc($num); - foreach my $prefix ( '', 'ship_' ) { - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options, }, - 'extra_sql' => - ( keys(%options) ? ' AND ' : ' WHERE ' ). - " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ". - " AND $agentnums_sql", - } ); - } - } - - } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) { - - my($company, $last, $first) = ( $1, $2, $3 ); - - # "Company (Last, First)" - #this is probably something a browser remembered, - #so just do an exact search (but case-insensitive, so USPS standardization - #doesn't throw a wrench in the works) - - foreach my $prefix ( '', 'ship_' ) { - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => - ( keys(%options) ? ' AND ' : ' WHERE ' ). - join(' AND ', - " LOWER(${prefix}first) = ". dbh->quote(lc($first)), - " LOWER(${prefix}last) = ". dbh->quote(lc($last)), - " LOWER(${prefix}company) = ". dbh->quote(lc($company)), - $agentnums_sql, - ), - } ); - } - - } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search - # try (ship_){last,company} - - my $value = lc($1); - - # # remove "(Last, First)" in "Company (Last, First)", otherwise the - # # full strings the browser remembers won't work - # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name - - use Lingua::EN::NameParse; - my $NameParse = new Lingua::EN::NameParse( - auto_clean => 1, - allow_reversed => 1, - ); - - my($last, $first) = ( '', '' ); - #maybe disable this too and just rely on NameParse? - if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First - - ($last, $first) = ( $1, $2 ); - - #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) { - } elsif ( ! $NameParse->parse($value) ) { - - my %name = $NameParse->components; - $first = $name{'given_name_1'}; - $last = $name{'surname_1'}; - - } - - if ( $first && $last ) { - - my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) ); - - #exact - my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= " - ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first ) - OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first ) - )"; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => \%options, - 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - } ); - - # or it just be something that was typed in... (try that in a sec) - - } - - my $q_value = dbh->quote($value); - - #exact - my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= " ( LOWER(last) = $q_value - OR LOWER(company) = $q_value - OR LOWER(ship_last) = $q_value - OR LOWER(ship_company) = $q_value - "; - $sql .= " OR LOWER(address1) = $q_value - OR LOWER(ship_address1) = $q_value - " - if $conf->exists('address1-search'); - $sql .= " )"; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => \%options, - 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - } ); - - #no exact match, trying substring/fuzzy - #always do substring & fuzzy (unless they're explicity config'ed off) - #getting complaints searches are not returning enough - unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) { - - #still some false laziness w/search (was search/cust_main.cgi) - - #substring - - my @hashrefs = ( - { 'company' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, }, - ); - - if ( $first && $last ) { - - push @hashrefs, - { 'first' => { op=>'ILIKE', value=>"%$first%" }, - 'last' => { op=>'ILIKE', value=>"%$last%" }, - }, - { 'ship_first' => { op=>'ILIKE', value=>"%$first%" }, - 'ship_last' => { op=>'ILIKE', value=>"%$last%" }, - }, - ; - - } else { - - push @hashrefs, - { 'last' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, }, - ; - } - - if ( $conf->exists('address1-search') ) { - push @hashrefs, - { 'address1' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, }, - ; - } - - foreach my $hashref ( @hashrefs ) { - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %$hashref, - %options, - }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton - } ); - - } - - #fuzzy - my @fuzopts = ( - \%options, #hashref - '', #select - " AND $agentnums_sql", #extra_sql #agent virtualization - ); - - if ( $first && $last ) { - push @cust_main, FS::cust_main->fuzzy_search( - { 'last' => $last, #fuzzy hashref - 'first' => $first }, # - @fuzopts - ); - } - foreach my $field ( 'last', 'company' ) { - push @cust_main, - FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); - } - if ( $conf->exists('address1-search') ) { - push @cust_main, - FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts ); - } - - } - - } - - #eliminate duplicates - my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; - - @cust_main; - -} - -=item email_search - -Accepts the following options: I, the email address to search for. The -email address will be searched for as an email invoice destination and as an -svc_acct account. - -#Any additional options are treated as an additional qualifier on the search -#(i.e. I). +=item inactive_sql -Returns a (possibly empty) array of FS::cust_main objects (but usually just -none or one). +Returns an SQL expression identifying inactive cust_main records (customers with +no active recurring packages, but otherwise unsuspended/uncancelled). =cut -sub email_search { - my %options = @_; - - local($DEBUG) = 1; - - my $email = delete $options{'email'}; - - #we're only being used by RT at the moment... no agent virtualization yet - #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; +sub inactive_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) "; +} - my @cust_main = (); +=item susp_sql +=item suspended_sql - if ( $email =~ /([^@]+)\@([^@]+)/ ) { +Returns an SQL expression identifying suspended cust_main records. - my ( $user, $domain ) = ( $1, $2 ); +=cut - warn "$me smart_search: searching for $user in domain $domain" - if $DEBUG; - push @cust_main, - map $_->cust_main, - qsearch( { - 'table' => 'cust_main_invoice', - 'hashref' => { 'dest' => $email }, - } - ); +sub suspended_sql { susp_sql(@_); } +sub susp_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) "; +} - push @cust_main, - map $_->cust_main, - grep $_, - map $_->cust_svc->cust_pkg, - qsearch( { - 'table' => 'svc_acct', - 'hashref' => { 'username' => $user, }, - 'extra_sql' => - 'AND ( SELECT domain FROM svc_domain - WHERE svc_acct.domsvc = svc_domain.svcnum - ) = '. dbh->quote($domain), - } - ); - } +=item cancel_sql +=item cancelled_sql - my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; +Returns an SQL expression identifying cancelled cust_main records. - warn "$me smart_search: found ". scalar(@cust_main). " unique customers" - if $DEBUG; +=cut - @cust_main; +sub cancel_sql { shift->cancelled_sql(@_); } -} +=item uncancel_sql +=item uncancelled_sql -=item check_and_rebuild_fuzzyfiles +Returns an SQL expression identifying un-cancelled cust_main records. =cut -sub check_and_rebuild_fuzzyfiles { - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields -} - -=item rebuild_fuzzyfiles +sub uncancelled_sql { uncancel_sql(@_); } +sub uncancel_sql { " + ( 0 < ( $select_count_pkgs + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( $select_count_pkgs ) + ) +"; } -=cut +=item balance_sql -sub rebuild_fuzzyfiles { +Returns an SQL fragment to retreive the balance. - use Fcntl qw(:flock); +=cut - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - mkdir $dir, 0700 unless -d $dir; +sub balance_sql { " + ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill + WHERE cust_bill.custnum = cust_main.custnum ) + - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay + WHERE cust_pay.custnum = cust_main.custnum ) + - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit + WHERE cust_credit.custnum = cust_main.custnum ) + + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund + WHERE cust_refund.custnum = cust_main.custnum ) +"; } - foreach my $fuzzy ( @fuzzyfields ) { +=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] - open(LOCK,">>$dir/cust_main.$fuzzy") - or die "can't open $dir/cust_main.$fuzzy: $!"; - flock(LOCK,LOCK_EX) - or die "can't lock $dir/cust_main.$fuzzy: $!"; +Returns an SQL fragment to retreive the balance for this customer, optionally +considering invoices with date earlier than START_TIME, and not +later than END_TIME (total_owed_date minus total_unapplied_credits minus +total_unapplied_payments). - open (CACHE,">$dir/cust_main.$fuzzy.tmp") - or die "can't open $dir/cust_main.$fuzzy.tmp: $!"; +Times are specified as SQL fragments or numeric +UNIX timestamps; see L). Also see L and +L for conversion functions. The empty string can be passed +to disable that time constraint completely. - foreach my $field ( $fuzzy, "ship_$fuzzy" ) { - my $sth = dbh->prepare("SELECT $field FROM cust_main". - " WHERE $field != '' AND $field IS NOT NULL"); - $sth->execute or die $sth->errstr; +Available options are: - while ( my $row = $sth->fetchrow_arrayref ) { - print CACHE $row->[0]. "\n"; - } +=over 4 - } +=item unapplied_date - close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!"; - - rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy"; - close LOCK; - } +set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) -} +=item total -=item all_X +(unused. obsolete?) +set to true to remove all customer comparison clauses, for totals -=cut +=item where -sub all_X { - my( $self, $field ) = @_; - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - open(CACHE,"<$dir/cust_main.$field") - or die "can't open $dir/cust_main.$field: $!"; - my @array = map { chomp; $_; } ; - close CACHE; - \@array; -} +(unused. obsolete?) +WHERE clause hashref (elements "AND"ed together) (typically used with the total option) -=item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1 +=item join -=cut +(unused. obsolete?) +JOIN clause (typically used with the total option) -sub append_fuzzyfiles { - #my( $first, $last, $company ) = @_; +=item cutoff - &check_and_rebuild_fuzzyfiles; +An absolute cutoff time. Payments, credits, and refunds I after this +time will be ignored. Note that START_TIME and END_TIME only limit the date +range for invoices and I payments, credits, and refunds. - use Fcntl qw(:flock); +=back - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; +=cut - foreach my $field (@fuzzyfields) { - my $value = shift; +sub balance_date_sql { + my( $class, $start, $end, %opt ) = @_; - if ( $value ) { + my $cutoff = $opt{'cutoff'}; - open(CACHE,">>$dir/cust_main.$field") - or die "can't open $dir/cust_main.$field: $!"; - flock(CACHE,LOCK_EX) - or die "can't lock $dir/cust_main.$field: $!"; + my $owed = FS::cust_bill->owed_sql($cutoff); + my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff); + my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff); + my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); - print CACHE "$value\n"; + my $j = $opt{'join'} || ''; - flock(CACHE,LOCK_UN) - or die "can't unlock $dir/cust_main.$field: $!"; - close CACHE; - } + my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt ); + my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt ); + my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt ); + my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt ); - } + " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh ) + + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh ) + - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh ) + - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh ) + "; - 1; } -=item batch_charge - -=cut +=item unapplied_payments_date_sql START_TIME [ END_TIME ] -sub batch_charge { - my $param = shift; - #warn join('-',keys %$param); - my $fh = $param->{filehandle}; - my $agentnum = $param->{agentnum}; - my $format = $param->{format}; +Returns an SQL fragment to retreive the total unapplied payments for this +customer, only considering payments with date earlier than START_TIME, and +optionally not later than END_TIME. - my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql; +Times are specified as SQL fragments or numeric +UNIX timestamps; see L). Also see L and +L for conversion functions. The empty string can be passed +to disable that time constraint completely. - my @fields; - if ( $format eq 'simple' ) { - @fields = qw( custnum agent_custid amount pkg ); - } else { - die "unknown format $format"; - } +Available options are: - eval "use Text::CSV_XS;"; - die $@ if $@; +=cut - my $csv = new Text::CSV_XS; - #warn $csv; - #warn $fh; +sub unapplied_payments_date_sql { + my( $class, $start, $end, %opt ) = @_; - my $imported = 0; - #my $columns; + my $cutoff = $opt{'cutoff'}; - 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 $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #while ( $columns = $csv->getline($fh) ) { - my $line; - while ( defined($line=<$fh>) ) { + my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end, + 'unapplied_date'=>1 ); - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; + " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) "; +} - my @columns = $csv->fields(); - #warn join('-',@columns); +=item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ] - my %row = (); - foreach my $field ( @fields ) { - $row{$field} = shift @columns; - } +Helper method for balance_date_sql; name (and usage) subject to change +(suggestions welcome). - if ( $row{custnum} && $row{agent_custid} ) { - dbh->rollback if $oldAutoCommit; - return "can't specify custnum with agent_custid $row{agent_custid}"; - } +Returns a WHERE clause for the specified monetary TABLE (cust_bill, +cust_refund, cust_credit or cust_pay). - my %hash = (); - if ( $row{agent_custid} && $agentnum ) { - %hash = ( 'agent_custid' => $row{agent_custid}, - 'agentnum' => $agentnum, - ); - } +If TABLE is "cust_bill" or the unapplied_date option is true, only +considers records with date earlier than START_TIME, and optionally not +later than END_TIME . - if ( $row{custnum} ) { - %hash = ( 'custnum' => $row{custnum} ); - } +=cut - unless ( scalar(keys %hash) ) { - $dbh->rollback if $oldAutoCommit; - return "can't find customer without custnum or agent_custid and agentnum"; - } +sub _money_table_where { + my( $class, $table, $start, $end, %opt ) = @_; - my $cust_main = qsearchs('cust_main', { %hash } ); - unless ( $cust_main ) { - $dbh->rollback if $oldAutoCommit; - my $custnum = $row{custnum} || $row{agent_custid}; - return "unknown custnum $custnum"; - } + my @where = (); + push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'}; + if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) { + push @where, "$table._date <= $start" if defined($start) && length($start); + push @where, "$table._date > $end" if defined($end) && length($end); + } + push @where, @{$opt{'where'}} if $opt{'where'}; + my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : ''; - if ( $row{'amount'} > 0 ) { - my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } elsif ( $row{'amount'} < 0 ) { - my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), - $row{'pkg'} ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } else { - #hmm? - } + $where; - } +} - $dbh->commit or die $dbh->errstr if $oldAutoCommit; +#for dyanmic FS::$table->search in httemplate/misc/email_customers.html +use FS::cust_main::Search; +sub search { + my $class = shift; + FS::cust_main::Search->search(@_); +} - return "Empty file!" unless $imported; +=back - ''; #no error +=head1 SUBROUTINES -} +=over 4 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS @@ -5968,7 +4426,7 @@ sub notify { return unless $conf->exists($template); - my $from = $conf->config('invoice_from', $self->agentnum) + my $from = $conf->invoice_from_full($self->agentnum) if $conf->exists('invoice_from', $self->agentnum); $from = $options{from} if exists($options{from}); @@ -6170,15 +4628,18 @@ sub queueable_print { my %opt = @_; my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } ) - or die "invalid customer number: " . $opt{custvnum}; + or die "invalid customer number: " . $opt{custnum}; - my $error = $self->print( $opt{template} ); + my $error = $self->print( { 'template' => $opt{template} } ); die $error if $error; } sub print { my ($self, $template) = (shift, shift); - do_print [ $self->print_ps($template) ]; + do_print( + [ $self->print_ps($template) ], + 'agentnum' => $self->agentnum, + ); } #these three subs should just go away once agent stuff is all config overrides @@ -6236,7 +4697,7 @@ sub _agent_plandata { " ORDER BY CASE WHEN part_event_condition_option.optionname IS NULL THEN -1 - ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue'). + ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue'). " END , part_event.weight". " LIMIT 1" @@ -6252,6 +4713,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. @@ -6268,12 +4765,30 @@ sub queued_bill { my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } ); warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid + #without this errors don't get rolled back + $args{'fatal'} = 1; # runs from job queue, will be caught + $cust_main->bill_and_collect( %args ); } +=item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ] + +Like queued_bill, but instead of C, just runs the +C part. This is used in batch tax calculation, where invoice +generation and collection events have to be completely separated. + +=cut + +sub queued_collect { + my (%args) = @_; + my $cust_main = FS::cust_main->by_key($args{'custnum'}); + + $cust_main->collect(%args); +} + sub process_bill_and_collect { my $job = shift; - my $param = thaw(decode_base64(shift)); + my $param = shift; my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } ) or die "custnum '$param->{custnum}' not found!\n"; $param->{'job'} = $job; @@ -6283,15 +4798,141 @@ sub process_bill_and_collect { $cust_main->bill_and_collect( %$param ); } +#starting to take quite a while for big dbs +# (JRNL: journaled so it only happens once per database) +# - seq scan of h_cust_main (yuck), but not going to index paycvv, so +# JRNL seq scan of cust_main on signupdate... index signupdate? will that help? +# JRNL seq scan of cust_main on paydate... index on substrings? maybe set an +# JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that... +# JRNL leading/trailing spaces in first, last, company +# JRNL migrate to cust_payby +# - otaker upgrade? journal and call it good? (double check to make sure +# we're not still setting otaker here) +# +#only going to get worse with new location stuff... + sub _upgrade_data { #class method my ($class, %opts) = @_; - my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL'; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute or die $sth->errstr; + my @statements = ( + 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL', + ); + + #this seems to be the only expensive one.. why does it take so long? + unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) { + push @statements, + 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL'; + FS::upgrade_journal->set_done('cust_main__signupdate'); + } + + unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) { + + # fix yyyy-m-dd formatted paydates + if ( driver_name =~ /^mysql/i ) { + push @statements, + "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + } else { # the SQL standard + push @statements, + "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'"; + } + FS::upgrade_journal->set_done('cust_main__paydate'); + } + + unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) { + + push @statements, #fix the weird BILL with a cc# in payinfo problem + #DCRD to be safe + "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' ); + + FS::upgrade_journal->set_done('cust_main__payinfo'); + + } + + my $t = time; + foreach my $sql ( @statements ) { + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + #warn ( (time - $t). " seconds\n" ); + #$t = time; + } local($ignore_expired_card) = 1; + local($ignore_banned_card) = 1; local($skip_fuzzyfiles) = 1; + local($import) = 1; #prevent automatic geocoding (need its own variable?) + + FS::cust_main::Location->_upgrade_data(%opts); + + unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) { + + foreach my $cust_main ( qsearch({ + 'table' => 'cust_main', + 'hashref' => {}, + 'extra_sql' => 'WHERE '. + join(' OR ', + map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'", + qw( first last company ) + ), + }) ) { + my $error = $cust_main->replace; + die $error if $error; + } + + FS::upgrade_journal->set_done('cust_main__trimspaces'); + + } + + unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) { + + #we don't want to decrypt them, just stuff them as-is into cust_payby + local(@encrypted_fields) = (); + + local($FS::cust_payby::ignore_expired_card) = 1; + local($FS::cust_payby::ignore_banned_card) = 1; + + my @payfields = qw( payby payinfo paycvv paymask + paydate paystart_month paystart_year payissue + payname paystate paytype payip + ); + + my $search = new FS::Cursor { + 'table' => 'cust_main', + 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ", + }; + + while (my $cust_main = $search->fetch) { + + unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) { + + my $cust_payby = new FS::cust_payby { + 'custnum' => $cust_main->custnum, + 'weight' => 1, + map { $_ => $cust_main->$_(); } @payfields + }; + + my $error = $cust_payby->insert; + die $error if $error; + + } + + $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP'; + + $cust_main->invoice_attn( $cust_main->payname ) + if $cust_main->payby eq 'BILL' && $cust_main->payname; + $cust_main->po_number( $cust_main->payinfo ) + if $cust_main->payby eq 'BILL' && $cust_main->payinfo; + + $cust_main->setfield($_, '') foreach @payfields; + my $error = $cust_main->replace; + die "Error upgradging payment information for custnum ". + $cust_main->custnum. ": $error" + if $error; + + }; + + FS::upgrade_journal->set_done('cust_main__cust_payby'); + } + $class->_upgrade_otaker(%opts); }