X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=dd99edab36eeb6cca7896314ba3e949bfc4c2492;hb=1ec723c2b944c08c32362d05cefe8b332c80276d;hp=19323e8a409c45b516d12b692234cda016218d7c;hpb=6577fcc50b6a711f1988bb4c83924e90f4bc97d6;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 19323e8a4..e107e6c91 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,32 +2,43 @@ package FS::cust_main; require 5.006; use strict; -use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles $ignore_expired_card @paytypes); +use base qw( FS::otaker_Mixin FS::payinfo_Mixin 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 use Safe; use Carp; use Exporter; use Scalar::Util qw( blessed ); -use Time::Local qw(timelocal_nocheck); +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::Parse; #use Date::Manip; +use File::Temp qw( tempfile ); use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; -use Data::Dumper; use FS::UID qw( getotaker dbh driver_name ); -use FS::Record qw( qsearchs qsearch dbdef ); +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::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; use FS::cust_bill_pkg; +use FS::cust_bill_pkg_display; +use FS::cust_bill_pkg_tax_location; +use FS::cust_bill_pkg_tax_rate_location; use FS::cust_pay; use FS::cust_pay_pending; use FS::cust_pay_void; @@ -36,8 +47,17 @@ use FS::cust_credit; use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; +use FS::cust_location; +use FS::cust_class; +use FS::cust_main_exemption; +use FS::cust_tax_adjustment; +use FS::tax_rate; +use FS::tax_rate_location; +use FS::cust_tax_location; +use FS::part_pkg_taxrate; use FS::agent; use FS::cust_main_invoice; +use FS::cust_tag; use FS::cust_credit_bill; use FS::cust_bill_pay; use FS::prepay_credit; @@ -45,16 +65,14 @@ 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::payinfo_Mixin; use FS::TicketSystem; -@ISA = qw( FS::Record FS::payinfo_Mixin ); - @EXPORT_OK = qw( smart_search ); $realtime_bop_decline_quiet = 0; @@ -66,10 +84,14 @@ $DEBUG = 0; $me = '[FS::cust_main]'; $import = 0; -$skip_fuzzyfiles = 0; $ignore_expired_card = 0; +$skip_fuzzyfiles = 0; +@fuzzyfields = ( 'first', 'last', 'company', 'address1' ); + @encrypted_fields = ('payinfo', 'paycvv'); +sub nohistory_fields { ('payinfo', 'paycvv'); } + @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); #ask FS::UID to run this stuff for us later @@ -132,97 +154,181 @@ FS::Record. The following fields are currently supported: =over 4 -=item custnum - primary key (assigned automatically for new customers) +=item custnum + +Primary key (assigned automatically for new customers) + +=item agentnum + +Agent (see L) + +=item refnum + +Advertising source (see L) + +=item first + +First name -=item agentnum - agent (see L) +=item last -=item refnum - Advertising source (see L) +Last name -=item first - name +=item ss -=item last - name +Cocial security number (optional) -=item ss - social security number (optional) +=item company -=item company - (optional) +(optional) =item address1 -=item address2 - (optional) +=item address2 + +(optional) =item city -=item county - (optional, see L) +=item county + +(optional, see L) -=item state - (see L) +=item state + +(see L) =item zip -=item country - (see L) +=item country + +(see L) + +=item daytime + +phone (optional) + +=item night + +phone (optional) -=item daytime - phone (optional) +=item fax -=item night - phone (optional) +phone (optional) -=item fax - phone (optional) +=item ship_first -=item ship_first - name +Shipping first name -=item ship_last - name +=item ship_last -=item ship_company - (optional) +Shipping last name + +=item ship_company + +(optional) =item ship_address1 -=item ship_address2 - (optional) +=item ship_address2 + +(optional) =item ship_city -=item ship_county - (optional, see L) +=item ship_county + +(optional, see L) -=item ship_state - (see L) +=item ship_state + +(see L) =item ship_zip -=item ship_country - (see L) +=item ship_country + +(see L) + +=item ship_daytime + +phone (optional) -=item ship_daytime - phone (optional) +=item ship_night -=item ship_night - phone (optional) +phone (optional) -=item ship_fax - phone (optional) +=item ship_fax -=item payby - Payment Type (See L for valid payby values) +phone (optional) -=item payinfo - Payment Information (See L for data format) +=item payby + +Payment Type (See L for valid payby values) + +=item payinfo + +Payment Information (See L for data format) -=item paymask - Masked payinfo (See L for how this works) +=item paymask + +Masked payinfo (See L for how this works) =item paycvv Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card -=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy +=item paydate + +Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy + +=item paystart_month + +Start date month (maestro/solo cards only) + +=item paystart_year + +Start date year (maestro/solo cards only) + +=item payissue + +Issue number (maestro/solo cards only) + +=item payname + +Name on card or billing name + +=item payip + +IP address from which payment information was received -=item paystart_month - start date month (maestro/solo cards only) +=item tax -=item paystart_year - start date year (maestro/solo cards only) +Tax exempt, empty or `Y' -=item payissue - issue number (maestro/solo cards only) +=item usernum -=item payname - name on card or billing name +Order taker (see L) -=item payip - IP address from which payment information was received +=item comments -=item tax - tax exempt, empty or `Y' +Comments (optional) -=item otaker - order taker (assigned automatically, see L) +=item referral_custnum -=item comments - comments (optional) +Referring customer number -=item referral_custnum - referring customer number +=item spool_cdr -=item spool_cdr - Enable individual CDR spooling, empty or `Y' +Enable individual CDR spooling, empty or `Y' + +=item dundate + +A suggestion to events (see L) to delay until this unix timestamp + +=item squelch_cdr + +Discourage individual CDR printing, empty or `Y' =back @@ -269,7 +375,7 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I and I. +Currently available options are: 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). @@ -280,6 +386,9 @@ 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. + =cut sub insert { @@ -303,7 +412,7 @@ sub insert { my $dbh = dbh; my $prepay_identifier = ''; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0); my $payby = ''; if ( $self->payby eq 'PREPAY' ) { @@ -314,7 +423,13 @@ sub insert { warn " looking up prepaid card $prepay_identifier\n" if $DEBUG > 1; - my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); + my $error = $self->get_prepay( $prepay_identifier, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "error applying prepaid card (transaction rolled back): $error"; @@ -336,6 +451,9 @@ sub insert { $self->signupdate(time) unless $self->signupdate; + $self->auto_agent_custid() + if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -356,6 +474,48 @@ sub insert { $self->invoicing_list( $invoicing_list ); } + warn " setting customer tags\n" + if $DEBUG > 1; + + foreach my $tagnum ( @{ $self->tagnum || [] } ) { + my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, + 'custnum' => $self->custnum }; + my $error = $cust_tag->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( $invoicing_list ) { + $error = $self->check_invoicing_list( $invoicing_list ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + #return "checking invoicing_list (transaction rolled back): $error"; + return $error; + } + $self->invoicing_list( $invoicing_list ); + } + + + warn " setting cust_main_exemption\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 ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } + } + if ( $conf->config('cust_main-skeleton_tables') && $conf->config('cust_main-skeleton_custnum') ) { @@ -373,7 +533,13 @@ sub insert { warn " ordering packages\n" if $DEBUG > 1; - $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); + $error = $self->order_pkgs( $cust_pkgs, + %options, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -383,6 +549,10 @@ sub insert { $dbh->rollback if $oldAutoCommit; return "No svc_acct record to apply pre-paid time"; } + if ( $upbytes || $downbytes || $totalbytes ) { + $dbh->rollback if $oldAutoCommit; + return "No svc_acct record to apply pre-paid data"; + } if ( $amount ) { warn " inserting initial $payby payment of $amount\n" @@ -404,6 +574,45 @@ sub insert { } } + # cust_main exports! + warn " exporting\n" if $DEBUG > 1; + + my $export_args = $options{'export_args'} || []; + + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_insert($self, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + + #foreach my $depend_jobnum ( @$depend_jobnums ) { + # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n" + # if $DEBUG; + # foreach my $jobnum ( @jobnums ) { + # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } ); + # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n" + # if $DEBUG; + # my $error = $queue->depend_insert($depend_jobnum); + # if ( $error ) { + # $dbh->rollback if $oldAutoCommit; + # return "error queuing job dependancy: $error"; + # } + # } + # } + # + #} + # + #if ( exists $options{'jobnums'} ) { + # push @{ $options{'jobnums'} }, @jobnums; + #} + warn " insert complete; committing transaction\n" if $DEBUG > 1; @@ -412,6 +621,35 @@ sub insert { } +use File::CounterFile; +sub auto_agent_custid { + my $self = shift; + + my $format = $conf->config('cust_main-auto_agent_custid'); + my $agent_custid; + if ( $format eq '1YMMXXXXXXXX' ) { + + my $counter = new File::CounterFile 'cust_main.agent_custid'; + $counter->lock; + + my $ym = 100000000000 + time2str('%y%m00000000', time); + if ( $ym > $counter->value ) { + $counter->{'value'} = $agent_custid = $ym; + $counter->{'updated'} = 1; + } else { + $agent_custid = $counter->inc; + } + + $counter->unlock; + + } else { + die "Unknown cust_main-auto_agent_custid format: $format"; + } + + $self->agent_custid($agent_custid); + +} + sub start_copy_skel { my $self = shift; @@ -539,12 +777,129 @@ sub _copy_skel { } -=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] +=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 a package -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: +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 @@ -552,12 +907,13 @@ be a better explanation of this, but until then, here's an example: $cust_pkg => [ $svc_acct ], ... ); - $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + $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 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). @@ -570,16 +926,19 @@ 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 = shift; + my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated my %options = @_; - my %svc_options = (); - $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} - if exists $options{'depend_jobnum'}; + $seconds_ref ||= $options{'seconds_ref'}; + warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -598,32 +957,20 @@ sub order_pkgs { local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - my $error = $cust_pkg->insert; + + 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 "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - 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 ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $$seconds ); - $$seconds = 0; - } - $error = $svc_something->insert(%svc_options); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } + return $error; } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -637,13 +984,14 @@ L), specified either by I or as an FS::prepay_credit object. If there is an error, returns the error, otherwise returns false. -Optionally, four scalar references can be passed as well. They will have their -values filled in with the amount, number of seconds, and number of upload and -download bytes applied by this prepaid -card. +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 ) = @_; @@ -661,8 +1009,13 @@ sub recharge_prepay { my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); - my $error = $self->get_prepay($prepay_credit, \$amount, - \$seconds, \$upbytes, \$downbytes, \$totalbytes) + 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) @@ -689,13 +1042,13 @@ sub recharge_prepay { } -=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF +=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. -References to I and I scalars should be passed as arguments -and will be incremented by the values of the prepaid card. +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. @@ -706,8 +1059,7 @@ If there is an error, returns the error, otherwise returns false. sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref, - $upref, $downref, $totalref) = @_; + my( $self, $prepay_credit, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -752,11 +1104,8 @@ sub get_prepay { return "removing prepay_credit (transaction rolled back): $error"; } - $$amountref += $prepay_credit->amount; - $$secondsref += $prepay_credit->seconds; - $$upref += $prepay_credit->upbytes; - $$downref += $prepay_credit->downbytes; - $$totalref += $prepay_credit->totalbytes; + ${ $opt{$_.'_ref'} } += $prepay_credit->$_() + for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes ); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1032,13 +1381,13 @@ sub delete { } } - foreach my $cust_main_invoice ( #(email invoice destinations, not invoices) - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) - ) { - my $error = $cust_main_invoice->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + foreach my $table (qw( cust_main_invoice cust_main_exemption cust_tag )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + my $error = $record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } } @@ -1048,12 +1397,30 @@ sub delete { return $error; } + # cust_main exports! + + #my $export_args = $options{'export_args'} || []; + + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_delete( $self ); #, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } -=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] +=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. @@ -1065,6 +1432,11 @@ 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 { @@ -1111,7 +1483,7 @@ sub replace { return $error; } - if ( @param ) { # INVOICING_LIST_ARYREF + if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF my $invoicing_list = shift @param; $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { @@ -1121,8 +1493,71 @@ sub replace { $self->invoicing_list( $invoicing_list ); } - if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && - grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { + 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; + } + } + foreach my $tagnum ( @{ $self->tagnum || [] } ) { + my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, + 'custnum' => $self->custnum }; + my $error = $cust_tag->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + my %options = @param; + + my $tax_exemption = delete $options{'tax_exemption'}; + if ( $tax_exemption ) { + + my %cust_main_exemption = + map { $_->taxname => $_ } + qsearch('cust_main_exemption', { 'custnum' => $old->custnum } ); + + foreach my $taxname ( @$tax_exemption ) { + + next if delete $cust_main_exemption{$taxname}; + + my $cust_main_exemption = new FS::cust_main_exemption { + 'custnum' => $self->custnum, + 'taxname' => $taxname, + }; + my $error = $cust_main_exemption->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } + + foreach my $cust_main_exemption ( values %cust_main_exemption ) { + my $error = $cust_main_exemption->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "deleting cust_main_exemption (transaction rolled back): $error"; + } + } + + } + + 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) + ) + ) + { + # card/check/lec info has changed, want to retry realtime_ invoice events my $error = $self->retry_realtime; if ( $error ) { @@ -1139,6 +1574,23 @@ sub replace { } } + # cust_main exports! + + my $export_args = $options{'export_args'} || []; + + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_replace( $self, $old, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1165,9 +1617,7 @@ sub queue_fuzzyfiles_update { my $dbh = dbh; my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), - qw(first last company) - ); + my $error = $queue->insert( map $self->getfield($_), @fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1175,9 +1625,7 @@ sub queue_fuzzyfiles_update { if ( $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), - qw(first last company) - ); + $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1208,6 +1656,8 @@ sub check { || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum') + || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') || $self->ut_snumbern('birthdate') @@ -1224,7 +1674,10 @@ sub check { || $self->ut_textn('stateid') || $self->ut_textn('stateid_state') || $self->ut_textn('invoice_terms') + || $self->ut_alphan('geocode') + || $self->ut_floatn('cdr_termination_percentage') ; + #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; @@ -1240,6 +1693,13 @@ 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 { @@ -1368,12 +1828,7 @@ sub check { # If it is encrypted and the private key is not availaible then we can't # check the credit card. - - my $check_payinfo = 1; - - if ($self->is_encrypted($self->payinfo)) { - $check_payinfo = 0; - } + my $check_payinfo = ! $self->is_encrypted($self->payinfo); if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { @@ -1387,7 +1842,8 @@ sub check { or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') - if cardtype($self->payinfo) eq "Unknown"; + if $self->payinfo !~ /^99\d{14}$/ #token + && cardtype($self->payinfo) eq "Unknown"; my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); if ( $ban ) { @@ -1507,6 +1963,8 @@ sub check { my( $m, $y ); if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); + } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { + ( $m, $y ) = ( $2, "19$1" ); } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { ( $m, $y ) = ( $3, "20$2" ); } else { @@ -1531,7 +1989,7 @@ sub check { $self->payname($1); } - foreach my $flag (qw( tax spool_cdr )) { + 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); } @@ -1568,7 +2026,26 @@ sub has_ship_address { scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); } -=item all_pkgs +=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. + +=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. @@ -1576,14 +2053,15 @@ Returns all packages (see L) for this customer. sub all_pkgs { my $self = shift; + my $extra_qsearch = ref($_[0]) ? shift : {}; - return $self->num_pkgs unless wantarray; + return $self->num_pkgs unless wantarray || keys(%$extra_qsearch); my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; } else { - @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + @cust_pkg = $self->_cust_pkg($extra_qsearch); } sort sort_packages @cust_pkg; @@ -1599,7 +2077,73 @@ sub cust_pkg { shift->all_pkgs(@_); } -=item ncancelled_pkgs +=item cust_location + +Returns all locations (see L) for this customer. + +=cut + +sub cust_location { + 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. @@ -1607,6 +2151,7 @@ Returns all non-cancelled packages (see L) for this customer. sub ncancelled_pkgs { my $self = shift; + my $extra_qsearch = ref($_[0]) ? shift : {}; return $self->num_ncancelled_pkgs unless wantarray; @@ -1625,33 +2170,62 @@ sub ncancelled_pkgs { $self->custnum. "\n" if $DEBUG > 1; - @cust_pkg = - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }); - push @cust_pkg, - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }); + $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 { - if ( $a->get('cancel') and $b->get('cancel') ) { - $a->pkgnum <=> $b->pkgnum; - } elsif ( $a->get('cancel') or $b->get('cancel') ) { + + 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 { - $a->pkgnum <=> $b->pkgnum; + 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 @@ -1691,6 +2265,18 @@ sub unsuspended_pkgs { 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 @@ -1822,12 +2408,16 @@ Available options are: =item ban - can be set true to ban this customer's credit card or ACH information, if present. +=item nobill - can be set true to skip billing if it might otherwise be done. + =back Always returns a list: an empty list on success or a list of errors. =cut +# nb that dates are not specified as valid options to this method + sub cancel { my( $self, %opt ) = @_; @@ -1853,6 +2443,13 @@ sub cancel { my @pkgs = $self->ncancelled_pkgs; + if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) { + $opt{nobill} = 1; + my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 ); + warn "Error billing during cancel, custnum ". $self->custnum. ": $error" + if $error; + } + warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". scalar(@pkgs). " packages for customer ". $self->custnum. "\n" if $DEBUG; @@ -1904,12 +2501,97 @@ sub agent { 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 bill_and_collect Cancels and suspends any packages due, generates bills, applies payments and -cred +credits, and applies collection events to run cards, send bills and notices, +etc. -Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.) +By default, warns on errors and continues with the next operation (but see the +"fatal" flag below). Options are passed as name-value pairs. Currently available options are: @@ -1935,70 +2617,153 @@ Used in conjunction with the I