X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=845d0984889a2760e45ede4e0532ef4d69efea3e;hb=18459c4369f63b7fda11a3ff7a0af067bed0c9bf;hp=007d6e48e40e88616361d6e9f94d5a7ad2f33d7e;hpb=b04bf86eadcbac04d7caf52a90f56fc3cc9b3568;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 007d6e48e..845d09848 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,21 +2,24 @@ package FS::cust_main; require 5.006; use strict; -use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime + #FS::cust_main:_Marketgear when they're ready to move to 2.1 +use base qw( FS::cust_main::Packages FS::cust_main::Status + FS::cust_main::Billing FS::cust_main::Billing_Realtime + FS::cust_main::Billing_Discount FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin + FS::geocode_Mixin + FS::o2m_Common FS::Record ); use vars qw( $DEBUG $me $conf @encrypted_fields $import $ignore_expired_card $ignore_illegal_zip $ignore_banned_card - $skip_fuzzyfiles @fuzzyfields + $skip_fuzzyfiles @paytypes ); -use vars qw( $realtime_bop_decline_quiet ); #ugh use Carp; use Scalar::Util qw( blessed ); -use List::Util qw( min ); use Time::Local qw(timelocal); use Storable qw(thaw); use MIME::Base64; @@ -25,7 +28,7 @@ use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; -use File::Temp qw( tempfile ); +use File::Temp; #qw( tempfile ); use Business::CreditCard 0.28; use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); @@ -33,10 +36,12 @@ use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); 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::legacy_cust_bill; use FS::cust_pay; use FS::cust_pay_pending; use FS::cust_pay_void; @@ -56,17 +61,16 @@ 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; - -$realtime_bop_decline_quiet = 0; #move to Billing_Realtime +use FS::cust_main_note; +use FS::cust_attachment; +use FS::contact; +use FS::Locales; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -80,7 +84,6 @@ $ignore_illegal_zip = 0; $ignore_banned_card = 0; $skip_fuzzyfiles = 0; -@fuzzyfields = ( 'first', 'last', 'company', 'address1' ); @encrypted_fields = ('payinfo', 'paycvv'); sub nohistory_fields { ('payinfo', 'paycvv'); } @@ -209,6 +212,10 @@ phone (optional) phone (optional) +=item mobile + +phone (optional) + =item ship_first Shipping first name @@ -255,6 +262,10 @@ phone (optional) phone (optional) +=item ship_mobile + +phone (optional) + =item payby Payment Type (See L for valid payby values) @@ -323,6 +334,14 @@ 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' + =back =head1 METHODS @@ -368,7 +387,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 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). @@ -382,6 +402,8 @@ 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. +If I is set, moves contacts and locations from that prospect. + =cut sub insert { @@ -444,6 +466,8 @@ sub insert { $self->signupdate(time) unless $self->signupdate; + $self->censusyear($conf->config('census_year')||'2012') if $self->censustract; + $self->auto_agent_custid() if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; @@ -480,16 +504,41 @@ 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 ); - } + my @contact = $prospect_main->contact; + my @cust_location = $prospect_main->cust_location; + my @qual = $prospect_main->qual; + + foreach my $r ( @contact, @cust_location, @qual ) { + $r->prospectnum(''); + $r->custnum($self->custnum); + my $error = $r->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } warn " setting cust_main_exemption\n" if $DEBUG > 1; @@ -509,18 +558,12 @@ sub insert { } } - if ( $conf->config('cust_main-skeleton_tables') - && $conf->config('cust_main-skeleton_custnum') ) { - - warn " inserting skeleton records\n" - if $DEBUG > 1; - + if ( $self->can('start_copy_skel') ) { my $error = $self->start_copy_skel; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - } warn " ordering packages\n" @@ -567,6 +610,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; @@ -643,332 +700,10 @@ 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 ) = @_; - - 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?)"; - } - - warn " _copy_skel: $table.$primary_key $sourceid to $destid for ". - join (', ', keys %child_tables). "\n" - if $DEBUG > 2; - - foreach my $child_table_def ( keys %child_tables ) { - - my $child_table; - my $child_pkey = ''; - if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) { - ( $child_table, $child_pkey ) = ( $1, $2 ); - } else { - $child_table = $child_table_def; - - $child_pkey = dbdef->table($child_table)->primary_key; - # or return "$table has no primary key". - # " (or do you need to run dbdef-create?)\n"; - } - - my $sequence = ''; - if ( keys %{ $child_tables{$child_table_def} } ) { - - return "$child_table has no primary key". - " (run dbdef-create or try specifying it?)\n" - unless $child_pkey; - - #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 @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; - - } - - } - - return ''; - -} - -=item order_pkg HASHREF | OPTION => VALUE ... - -Orders a single package. - -Options may be passed as a list of key/value pairs or as a hash reference. -Options are: - -=over 4 - -=item cust_pkg - -FS::cust_pkg object - -=item cust_location - -Optional FS::cust_location object - -=item svcs - -Optional arryaref of FS::svc_* service objects. - -=item depend_jobnum - -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). - -=item ticket_subject - -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; - } - - } +=item PACKAGE METHODS - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} +Documentation on customer package methods has been moved to +L. =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] @@ -1071,7 +806,7 @@ sub get_prepay { $prepay_credit = qsearchs( 'prepay_credit', - { 'identifier' => $prepay_credit }, + { 'identifier' => $identifier }, '', 'FOR UPDATE' ); @@ -1490,52 +1225,38 @@ sub delete { } -=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] +=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ] +This merges this customer into the provided new custnum, and then deletes the +customer. If there is an error, returns the error, otherwise returns false. -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. +The source customer's name, company name, phone numbers, agent, +referring customer, customer class, advertising source, order taker, and +billing information (except balance) are discarded. -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 -check_invoicing_list first. Here's an example: +All packages are moved to the target customer. Packages with package locations +are preserved. Packages without package locations are moved to a new package +location with the source customer's service/shipping address. - $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); +All invoices, statements, payments, credits and refunds are moved to the target +customer. The source customer's balance is added to the target customer. -Currently available options are: I. +All notes, attachments, tickets and customer tags are moved to the target +customer. -The I option can be set to an arrayref of tax names. -FS::cust_main_exemption records will be deleted and inserted as appropriate. +Change history is not currently moved. =cut -sub replace { - my $self = shift; - - my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) - ? shift - : $self->replace_old; - - my @param = @_; +sub merge { + my( $self, $new_custnum, %opt ) = @_; - warn "$me replace called\n" - if $DEBUG; + return "Can't merge a customer into self" if $self->custnum == $new_custnum; - 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."; + unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { + return "Invalid new customer number: $new_custnum"; } - 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 $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1547,30 +1268,312 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::replace($old); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a master agent customer"; } - 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 ); + #use FS::access_user + if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a master employee customer"; } - if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident + if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' }, + } + ) + ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a customer with pending payments"; + } - #this could be more efficient than deleting and re-inserting, if it matters - foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) { - my $error = $cust_tag->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; + tie my %financial_tables, 'Tie::IxHash', + 'cust_bill' => 'invoices', + 'cust_statement' => 'statements', + 'cust_credit' => 'credits', + 'cust_pay' => 'payments', + 'cust_pay_void' => 'voided payments', + 'cust_refund' => 'refunds', + ; + + foreach my $table ( keys %financial_tables ) { + + my @records = $self->$table(); + + foreach my $record ( @records ) { + $record->custnum($new_custnum); + my $error = $record->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error merging ". $financial_tables{$table}. ": $error\n"; + } + } + + } + + my $name = $self->ship_name; + + my $locationnum = ''; + foreach my $cust_pkg ( $self->all_pkgs ) { + $cust_pkg->custnum($new_custnum); + + unless ( $cust_pkg->locationnum ) { + unless ( $locationnum ) { + my $cust_location = new FS::cust_location { + $self->location_hash, + 'custnum' => $new_custnum, + }; + my $error = $cust_location->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $locationnum = $cust_location->locationnum; + } + $cust_pkg->locationnum($locationnum); + } + + my $error = $cust_pkg->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + # add customer (ship) name to svc_phone.phone_name if blank + my @cust_svc = $cust_pkg->cust_svc; + foreach my $cust_svc (@cust_svc) { + my($label, $value, $svcdb) = $cust_svc->label; + next unless $svcdb eq 'svc_phone'; + my $svc_phone = $cust_svc->svc_x; + next if $svc_phone->phone_name; + $svc_phone->phone_name($name); + my $error = $svc_phone->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + #not considered: + # cust_tax_exempt (texas tax exemptions) + # cust_recon (some sort of not-well understood thing for OnPac) + + #these are moved over + foreach my $table (qw( + cust_tag cust_location contact cust_attachment cust_main_note + cust_tax_adjustment cust_pay_batch queue + )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + $record->custnum($new_custnum); + my $error = $record->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + #these aren't preserved + foreach my $table (qw( + cust_main_exemption cust_main_invoice + )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + my $error = $record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + + my $sth = $dbh->prepare( + 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?' + ) or do { + my $errstr = $dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $sth->execute($new_custnum, $self->custnum) or do { + my $errstr = $sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + #tickets + + my $ticket_dbh = ''; + if ($conf->config('ticket_system') eq 'RT_Internal') { + $ticket_dbh = $dbh; + } elsif ($conf->config('ticket_system') eq 'RT_External') { + my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); + $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); + #or die "RT_External DBI->connect error: $DBI::errstr\n"; + } + + if ( $ticket_dbh ) { + + my $ticket_sth = $ticket_dbh->prepare( + 'UPDATE Links SET Target = ? WHERE Target = ?' + ) or do { + my $errstr = $ticket_dbh->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum, + 'freeside://freeside/cust_main/'.$self->custnum) + or do { + my $errstr = $ticket_sth->errstr; + $dbh->rollback if $oldAutoCommit; + return $errstr; + }; + + } + + #delete the customer record + + my $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=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. + +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 +check_invoicing_list first. Here's an example: + + $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); + +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. + +=cut + +sub replace { + my $self = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $self->replace_old; + + my @param = @_; + + warn "$me replace called\n" + 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."; + } + + if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode') + && $conf->exists('enable_taxproducts') + ) + { + my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip) + ? 'ship_' : ''; + $self->set('geocode', '') + if $old->get($pre.'zip') ne $self->get($pre.'zip') + && length($self->get($pre.'zip')) >= 10; + } + + for my $pre ( grep $old->get($_.'coord_auto'), ( '', 'ship_' ) ) { + + $self->set($pre.'coord_auto', '') && next + if $self->get($pre.'latitude') && $self->get($pre.'longitude') + && ( $self->get($pre.'latitude') != $old->get($pre.'latitude') + || $self->get($pre.'longitude') != $old->get($pre.'longitude') + ); + + $self->set_coord($pre) + if $old->get($pre.'address1') ne $self->get($pre.'address1') + || $old->get($pre.'city') ne $self->get($pre.'city') + || $old->get($pre.'state') ne $self->get($pre.'state') + || $old->get($pre.'country') ne $self->get($pre.'country'); + + } + + unless ( $import ) { + $self->set_coord + if ! $self->coord_auto && ! $self->latitude && ! $self->longitude; + + $self->set_coord('ship_') + if $self->has_ship_address && ! $self->ship_coord_auto + && ! $self->ship_latitude && ! $self->ship_longitude; + } + + 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 ); + + if ( $self->censustract ne '' and $self->censustract ne $old->censustract ) { + # update censusyear whenever tract code changes + $self->censusyear($conf->config('census_year')||'2012'); + } + + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::replace($old); + + 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; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; return $error; } } @@ -1645,6 +1648,25 @@ sub replace { } } + # FS::geocode_Mixin::after_replace ? + # though this will go away anyway once we move customer bill/service + # locations into cust_location + # We can trigger this on any address change--just have to make sure + # not to trigger it on itself. + if ( $conf->config('tax_district_method') and !$import + and ( $self->get('ship_address1') ne $old->get('ship_address1') + or $self->get('address1') ne $old->get('address1') ) ) { + 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! my $export_args = $options{'export_args'} || []; @@ -1673,6 +1695,7 @@ Used by insert & replace to update the fuzzy search cache =cut +use FS::cust_main::Search; sub queue_fuzzyfiles_update { my $self = shift; @@ -1687,16 +1710,16 @@ 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 ); + my $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' }; + my $error = $queue->insert( map $self->getfield($_), @FS::cust_main::Search::fuzzyfields ); 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 ); + $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' }; + $error = $queue->insert( map $self->getfield("ship_$_"), @FS::cust_main::Search::fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1740,15 +1763,28 @@ sub check { || $self->ut_textn('county') || $self->ut_textn('state') || $self->ut_country('country') + || $self->ut_coordn('latitude') + || $self->ut_coordn('longitude') + || $self->ut_enum('coord_auto', [ '', 'Y' ]) + || $self->ut_numbern('censusyear') || $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_alphan('district') || $self->ut_floatn('cdr_termination_percentage') + || $self->ut_floatn('credit_limit') + || $self->ut_numbern('billday') + || $self->ut_enum('edit_subject', [ '', 'Y' ] ) + || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] ) + || $self->ut_enum('locale', [ '', FS::Locales->locales ]) ; + $self->set_coord + unless $import || ($self->latitude && $self->longitude); + #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; @@ -1800,9 +1836,10 @@ sub check { } $error = - $self->ut_phonen('daytime', $self->country) - || $self->ut_phonen('night', $self->country) - || $self->ut_phonen('fax', $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; @@ -1811,8 +1848,8 @@ sub check { 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) + && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile) ) { my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/ @@ -1821,8 +1858,12 @@ sub check { my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/ ? 'Night Phone' : FS::Msgcat::_gettext('night'); - - return "$daytime_label or $night_label is required" + + my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/ + ? 'Mobile Phone' + : FS::Msgcat::_gettext('mobile'); + + return "$daytime_label, $night_label or $mobile_label is required" } @@ -1841,9 +1882,15 @@ sub check { || $self->ut_textn('ship_county') || $self->ut_textn('ship_state') || $self->ut_country('ship_country') + || $self->ut_coordn('ship_latitude') + || $self->ut_coordn('ship_longitude') + || $self->ut_enum('ship_coord_auto', [ '', 'Y' ] ) ; return $error if $error; + $self->set_coord('ship_') + unless $import || ($self->ship_latitude && $self->ship_longitude); + #false laziness with above unless ( qsearchs('cust_main_county', { 'country' => $self->ship_country, @@ -1860,9 +1907,10 @@ sub check { #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_phonen('ship_daytime', $self->ship_country) + || $self->ut_phonen('ship_night', $self->ship_country) + || $self->ut_phonen('ship_fax', $self->ship_country) + || $self->ut_phonen('ship_mobile', $self->ship_country) ; return $error if $error; @@ -1913,7 +1961,7 @@ sub check { 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); @@ -1925,12 +1973,21 @@ sub check { && cardtype($self->payinfo) eq "Unknown"; unless ( $ignore_banned_card ) { - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); + my $ban = FS::banned_pay->ban_search( %{ $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. ')'; + 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. ')'; + } } } @@ -1975,23 +2032,34 @@ sub check { } elsif ( $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' ) { @@ -2051,6 +2119,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') @@ -2092,7 +2161,8 @@ Returns a list of fields which have ship_ duplicates. sub addr_fields { qw( last first company address1 address2 city county state zip country - daytime night fax + latitude longitude + daytime night fax mobile ); } @@ -2109,292 +2179,46 @@ sub has_ship_address { =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 ] +=item cust_location -Returns all packages (see L) for this customer. +Returns all locations (see L) for this customer. =cut -sub all_pkgs { +sub cust_location { 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; + qsearch('cust_location', { 'custnum' => $self->custnum } ); } -=item cust_pkg +=item cust_contact -Synonym for B. +Returns all contacts (see L) for this customer. =cut -sub cust_pkg { - shift->all_pkgs(@_); +#already used :/ sub contact { +sub cust_contact { + my $self = shift; + qsearch('contact', { 'custnum' => $self->custnum } ); } -=item cust_location +=item unsuspend -Returns all locations (see L) for this customer. +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. =cut -sub cust_location { +sub unsuspend { my $self = shift; - qsearch('cust_location', { 'custnum' => $self->custnum } ); -} - -=item location_label [ OPTION => VALUE ... ] - -Returns the label of the service location (see analog in L) for this customer. - -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 - -=cut - -# false laziness with FS::cust_location::line - -sub location_label { - 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; -} - -=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] - -Returns all non-cancelled packages (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 { - 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 }, - }); - -} - -# 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 next_bill_date - -Returns the next date this customer will be billed, as a UNIX timestamp, or -undef if no active package has a next bill date. - -=cut - -sub next_bill_date { - 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]; -} - -=item unsuspend - -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. - -=cut - -sub unsuspend { - my $self = shift; - grep { $_->unsuspend } $self->suspended_pkgs; + grep { $_->unsuspend } $self->suspended_pkgs; } =item suspend @@ -2516,7 +2340,7 @@ sub cancel { return ( "Can't (yet) ban encrypted credit cards" ) if $self->is_encrypted($self->payinfo); - my $ban = new FS::banned_pay $self->_banned_pay_hashref; + my $ban = new FS::banned_pay $self->_new_banned_pay_hashref; my $error = $ban->insert; return ( $error ) if $error; @@ -2533,588 +2357,149 @@ sub cancel { warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". scalar(@pkgs). " packages for customer ". $self->custnum. "\n" - if $DEBUG; - - grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs; -} - -sub _banned_pay_hashref { - my $self = shift; - - my %payby2ban = ( - 'CARD' => 'CARD', - 'DCRD' => 'CARD', - 'CHEK' => 'CHEK', - 'DCHK' => 'CHEK' - ); - - { - 'payby' => $payby2ban{$self->payby}, - 'payinfo' => md5_base64($self->payinfo), - #don't ever *search* on reason! #'reason' => - }; -} - -=item notes - -Returns all notes (see L) for this customer. - -=cut - -sub notes { - my $self = shift; - #order by? - qsearch( 'cust_main_note', - { 'custnum' => $self->custnum }, - '', - 'ORDER BY _DATE DESC' - ); -} - -=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. - -=cut - -sub agent_name { - my $self = shift; - $self->agent->agent; -} - -=item cust_tag - -Returns any tags associated with this customer, as FS::cust_tag objects, -or an empty list if there are no tags. - -=cut - -sub cust_tag { - my $self = shift; - qsearch('cust_tag', { 'custnum' => $self->custnum } ); -} - -=item part_tag - -Returns any tags associated with this customer, as FS::part_tag objects, -or an empty list if there are no tags. - -=cut - -sub part_tag { - my $self = shift; - map $_->part_tag, $self->cust_tag; -} - - -=item cust_class - -Returns the customer class, as an FS::cust_class object, or the empty string -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 -category. - -=cut - -sub categoryname { - my $self = shift; - my $cust_class = $self->cust_class; - $cust_class - ? $cust_class->categoryname - : ''; -} - -=item classname - -Returns the customer class name, or the empty string if there is no customer -class. - -=cut - -sub classname { - my $self = shift; - my $cust_class = $self->cust_class; - $cust_class - ? $cust_class->classname - : ''; -} - -=item BILLING METHODS - -Documentation on billing methods has been moved to -L. - -=item do_cust_event [ HASHREF | OPTION => VALUE ... ] - -Runs billing events; see L and the billing events web -interface. - -If there is an error, returns the error, otherwise returns false. - -Options are passed as name-value pairs. - -Currently available options are: - -=over 4 - -=item time - -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. - -=item check_freq - -"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) - -=item stage - -"collect" (the default) or "pre-bill" - -=item quiet - -set true to surpress email card/ACH decline notices. - -=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) - -=cut - -# =item payby -# -# allows for one time override of normal customer billing method - -# =item retry -# -# Retry card/echeck/LEC transactions even when not scheduled by invoice events. - -sub do_cust_event { - my( $self, %options ) = @_; - my $time = $options{'time'} || time; - - #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; + if $DEBUG; - #here is the agent virtualization - $extra_sql .= " AND ( part_event.agentnum IS NULL - OR part_event.agentnum = ". $self->agentnum. ' )'; + grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs; +} - $extra_sql .= " $order"; +sub _banned_pay_hashref { + my $self = shift; - 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", - } ); + my %payby2ban = ( + 'CARD' => 'CARD', + 'DCRD' => 'CARD', + 'CHEK' => 'CHEK', + 'DCHK' => 'CHEK' + ); - if ( $DEBUG > 2 ) { - my $pkey = $object->primary_key; - warn " ". scalar(@part_event). - " possible events found for $eventtable ". $object->$pkey(). "\n"; - } + { + 'payby' => $payby2ban{$self->payby}, + 'payinfo' => $self->payinfo, + #don't ever *search* on reason! #'reason' => + }; +} - push @e_cust_event, map { $_->new_cust_event($object) } @part_event; +sub _new_banned_pay_hashref { + my $self = shift; + my $hr = $self->_banned_pay_hashref; + $hr->{payinfo} = md5_base64($hr->{payinfo}); + $hr; +} - } +=item notes - warn " ". scalar(@e_cust_event). - " subtotal possible cust events found for $eventtable\n" - if $DEBUG > 1; +Returns all notes (see L) for this customer. - push @cust_event, @e_cust_event; +=cut - } +sub notes { + my($self,$orderby_classnum) = (shift,shift); + my $orderby = "_DATE DESC"; + $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum; + qsearch( 'cust_main_note', + { 'custnum' => $self->custnum }, + '', + "ORDER BY $orderby", + ); +} - warn " ". scalar(@cust_event). - " total possible cust events found in initial search\n" - if $DEBUG; # > 1; +=item agent +Returns the agent (see L) for this customer. - ## - # test stage - ## +=cut - $opt{stage} ||= 'collect'; - @cust_event = - grep { my $stage = $_->part_event->event_stage; - $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' ) - } - @cust_event; +sub agent { + my $self = shift; + qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); +} - ## - # test conditions - ## - - my %unsat = (); +=item agent_name - @cust_event = grep $_->test_conditions( 'time' => $opt{'time'}, - 'stats_hashref' => \%unsat ), - @cust_event; +Returns the agent name (see L) for this customer. - warn " ". scalar(@cust_event). " cust events left satisfying conditions\n" - if $DEBUG; # > 1; +=cut - warn " invalid conditions not eliminated with condition_sql:\n". - join('', map " $_: ".$unsat{$_}."\n", keys %unsat ) - if keys %unsat && $DEBUG; # > 1; +sub agent_name { + my $self = shift; + $self->agent->agent; +} - ## - # insert - ## +=item cust_tag - unless( $opt{testonly} ) { - foreach my $cust_event ( @cust_event ) { +Returns any tags associated with this customer, as FS::cust_tag objects, +or an empty list if there are no tags. - my $error = $cust_event->insert(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - } +=cut - $dbh->commit or die $dbh->errstr if $oldAutoCommit; +sub cust_tag { + my $self = shift; + qsearch('cust_tag', { 'custnum' => $self->custnum } ); +} - ## - # return - ## +=item part_tag - warn " returning events: ". Dumper(@cust_event). "\n" - if $DEBUG > 2; +Returns any tags associated with this customer, as FS::part_tag objects, +or an empty list if there are no tags. - \@cust_event; +=cut +sub part_tag { + my $self = shift; + map $_->part_tag, $self->cust_tag; } -=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. +=item cust_class -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". +Returns the customer class, as an FS::cust_class object, or the empty string +if there is no customer class. =cut -sub retry_realtime { +sub cust_class { my $self = shift; + if ( $self->classnum ) { + qsearchs('cust_class', { 'classnum' => $self->classnum } ); + } else { + return ''; + } +} - 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 categoryname - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; +Returns the customer category name, or the empty string if there is no customer +category. - #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 - ); +=cut - 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"; - } +sub categoryname { + my $self = shift; + my $cust_class = $self->cust_class; + $cust_class + ? $cust_class->categoryname + : ''; +} - } +=item classname - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; +Returns the customer class name, or the empty string if there is no customer +class. +=cut + +sub classname { + my $self = shift; + my $cust_class = $self->cust_class; + $cust_class + ? $cust_class->classname + : ''; } +=item BILLING METHODS -=cut +Documentation on billing methods has been moved to +L. =item REALTIME BILLING METHODS @@ -3159,7 +2544,7 @@ sub batch_card { return '' unless $amount > 0; my $invnum = delete $options{invnum}; - my $payby = $options{invnum} || $self->payby; #dubious + my $payby = $options{payby} || $self->payby; #still dubious if ($options{'realtime'}) { return $self->realtime_bop( FS::payby->payby2bop($self->payby), @@ -3181,6 +2566,7 @@ sub batch_card { 'status' => 'O', 'payby' => FS::payby->payby2payment($payby), ); + $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent'); my $pay_batch = qsearchs( 'pay_batch', \%pay_batch ); @@ -3198,8 +2584,9 @@ sub batch_card { 'custnum' => $self->custnum, } ); - foreach (qw( address1 address2 city state zip country payby payinfo paydate - payname )) { + foreach (qw( address1 address2 city state zip country latitude longitude + payby payinfo paydate payname )) + { $options{$_} = '' unless exists($options{$_}); } @@ -3303,7 +2690,7 @@ sub total_owed_date { AND _date <= $time "; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } @@ -3383,7 +2770,7 @@ sub total_unapplied_credits { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } @@ -3421,7 +2808,7 @@ sub total_unapplied_payments { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } @@ -3459,7 +2846,7 @@ sub total_unapplied_refunds { WHERE custnum = $custnum "; - sprintf( "%.2f", $self->scalar_sql($sql) ); + sprintf( "%.2f", $self->scalar_sql($sql) || 0 ); } @@ -3517,7 +2904,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 @@ -3661,6 +3048,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 @@ -3774,7 +3215,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; ''; @@ -4165,7 +3606,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 ( { @@ -4178,17 +3619,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 @@ -4201,26 +3654,105 @@ 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 { my $self = shift; - map { $_ } #return $self->num_cust_statement unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch('cust_statement', { 'custnum' => $self->custnum, } ) + 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 @@ -4311,17 +3843,29 @@ sub cust_pay_void { qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) } -=item cust_pay_batch +=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all batched payments (see L) for this customer. +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. + =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 } ) + my $opt = ref($_[0]) ? shift : { @_ }; + + #return $self->num_cust_statement unless wantarray || keys %$opt; + + $opt->{'table'} = 'cust_pay_batch'; + $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway... + $opt->{'hashref'}{'custnum'} = $self->custnum; + $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC'; + + map { $_ } #behavior of sort undefined in scalar context + sort { $a->paybatchnum <=> $b->paybatchnum } + qsearch($opt); } =item cust_pay_pending @@ -4418,8 +3962,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; } @@ -4552,38 +4123,6 @@ 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; - - my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) ) - ? 'ship_' - : ''; - - my($zip,$plus4) = split /-/, $self->get("${prefix}zip") - if $self->country eq 'US'; - - $zip ||= ''; - $plus4 ||= ''; - #CCH specific location stuff - my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'"; - - 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); - - $geocode; -} - =item cust_status =item status @@ -4606,13 +4145,15 @@ Returns a status string for this customer, currently: =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; @@ -4644,21 +4185,11 @@ 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 @@ -4754,10 +4285,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 @@ -4781,13 +4330,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 @@ -4846,22 +4396,7 @@ 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. " ) - "; - -} +sub cancel_sql { shift->cancelled_sql(@_); } =item uncancel_sql =item uncancelled_sql @@ -4971,7 +4506,7 @@ sub balance_date_sql { =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 +customer, only considering payments with date earlier than START_TIME, and optionally not later than END_TIME. Times are specified as SQL fragments or numeric @@ -5039,41 +4574,6 @@ sub search { =over 4 -=item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1 - -=cut - -sub append_fuzzyfiles { - #my( $first, $last, $company ) = @_; - - &check_and_rebuild_fuzzyfiles; - - use Fcntl qw(:flock); - - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - - foreach my $field (@fuzzyfields) { - my $value = shift; - - if ( $value ) { - - 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: $!"; - - print CACHE "$value\n"; - - flock(CACHE,LOCK_UN) - or die "can't unlock $dir/cust_main.$field: $!"; - close CACHE; - } - - } - - 1; -} - =item batch_charge =cut @@ -5494,7 +4994,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" @@ -5541,17 +5041,73 @@ sub process_bill_and_collect { $cust_main->bill_and_collect( %$param ); } +=item process_censustract_update CUSTNUM + +Queueable function to update the census tract to the current year (as set in +the 'census_year' configuration variable) and retrieve the new tract code. + +=cut + +sub process_censustract_update { + eval "use FS::Misc::Geo qw(get_censustract)"; + die $@ if $@; + my $custnum = shift; + my $cust_main = qsearchs( 'cust_main', { custnum => $custnum }) + or die "custnum '$custnum' not found!\n"; + + my $new_year = $conf->config('census_year') or return; + my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year); + if ( $new_tract =~ /^\d/ ) { + # then it's a tract code + $cust_main->set('censustract', $new_tract); + $cust_main->set('censusyear', $new_year); + + local($ignore_expired_card) = 1; + local($ignore_illegal_zip) = 1; + local($ignore_banned_card) = 1; + local($skip_fuzzyfiles) = 1; + local($import) = 1; #prevent automatic geocoding (need its own variable?) + my $error = $cust_main->replace; + die $error if $error; + } + else { + # it's an error message + die $new_tract; + } + return; +} + 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', + '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', + ); + # 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) = '-'"; + } + + 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]*$' ); + + foreach my $sql ( @statements ) { + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + } local($ignore_expired_card) = 1; local($ignore_illegal_zip) = 1; - local($ignore_illegal_zip) = 1; local($ignore_banned_card) = 1; + local($skip_fuzzyfiles) = 1; + local($import) = 1; #prevent automatic geocoding (need its own variable?) $class->_upgrade_otaker(%opts); }