X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=718fccf2f1de56373e7104cf78402c0f4ea3b5da;hb=0269c850cfefc00d5da255f88c63a314e1ab6cd0;hp=b2b0a9b1c15f6677beeedbf607d28f45e6f9aee3;hpb=cd907554f4c08175c379e204e28e26483acf957a;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index b2b0a9b1c..718fccf2f 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,5 +1,6 @@ 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); @@ -7,35 +8,36 @@ use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; use Exporter; -BEGIN { - eval "use Time::Local;"; - die "Time::Local minimum version 1.05 required with Perl versions before 5.6" - if $] < 5.006 && !defined($Time::Local::VERSION); - #eval "use Time::Local qw(timelocal timelocal_nocheck);"; - eval "use Time::Local qw(timelocal_nocheck);"; -} +use Scalar::Util qw( blessed ); +use Time::Local qw(timelocal_nocheck); +use Data::Dumper; +use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; use Date::Parse; #use Date::Manip; +use File::Slurp qw( slurp ); +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 ); +use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef ); -use FS::Misc qw( send_email generate_ps do_print ); +use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; +use FS::cust_pay_pending; use FS::cust_pay_void; +use FS::cust_pay_batch; use FS::cust_credit; use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; +use FS::cust_tax_location; use FS::agent; use FS::cust_main_invoice; use FS::cust_credit_bill; @@ -43,17 +45,17 @@ use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; use FS::part_pkg; -use FS::part_bill_event qw(due_events); -use FS::cust_bill_event; -use FS::cust_tax_exempt; -use FS::cust_tax_exempt_pkg; +use FS::part_event; +use FS::part_event_condition; +#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 ); +@ISA = qw( FS::payinfo_Mixin FS::Record ); @EXPORT_OK = qw( smart_search ); @@ -224,6 +226,8 @@ Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit nu =item spool_cdr - Enable individual CDR spooling, empty or `Y' +=item squelch_cdr - Discourage individual CDR printing, empty or `Y' + =back =head1 METHODS @@ -350,7 +354,8 @@ sub insert { $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "checking invoicing_list (transaction rolled back): $error"; + #return "checking invoicing_list (transaction rolled back): $error"; + return $error; } $self->invoicing_list( $invoicing_list ); } @@ -1052,7 +1057,7 @@ sub delete { } -=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ] +=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. @@ -1068,23 +1073,16 @@ check_invoicing_list first. Here's an example: sub replace { my $self = shift; - my $old = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $self->replace_old; + my @param = @_; + warn "$me replace called\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'; - - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - } - my $curuser = $FS::CurrentUser::CurrentUser; if ( $self->payby eq 'COMP' && $self->payby ne $old->payby @@ -1099,6 +1097,13 @@ sub replace { && $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'; + 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; @@ -1207,6 +1212,7 @@ sub check { || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') || $self->ut_snumbern('birthdate') @@ -1274,58 +1280,75 @@ sub check { ; return $error if $error; - my @addfields = qw( - last first company address1 address2 city county state zip - country daytime night fax - ); + if ( $conf->exists('cust_main-require_phone') + && ! length($self->daytime) && ! length($self->night) + ) { - if ( defined $self->dbdef_table->column('ship_last') ) { - if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } - @addfields ) - && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields ) - ) - { - my $error = - $self->ut_name('ship_last') - || $self->ut_name('ship_first') - || $self->ut_textn('ship_company') - || $self->ut_text('ship_address1') - || $self->ut_textn('ship_address2') - || $self->ut_text('ship_city') - || $self->ut_textn('ship_county') - || $self->ut_textn('ship_state') - || $self->ut_country('ship_country') - ; - return $error if $error; + my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/ + ? 'Day Phone' + : FS::Msgcat::_gettext('daytime'); + my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/ + ? 'Night Phone' + : FS::Msgcat::_gettext('night'); + + return "$daytime_label or $night_label is required" + + } - #false laziness with above - unless ( qsearchs('cust_main_county', { - 'country' => $self->ship_country, - 'state' => '', - } ) ) { - return "Unknown ship_state/ship_county/ship_country: ". - $self->ship_state. "/". $self->ship_county. "/". $self->ship_country - unless qsearch('cust_main_county',{ - 'state' => $self->ship_state, - 'county' => $self->ship_county, - 'country' => $self->ship_country, - } ); - } - #eofalse - - $error = - $self->ut_phonen('ship_daytime', $self->ship_country) - || $self->ut_phonen('ship_night', $self->ship_country) - || $self->ut_phonen('ship_fax', $self->ship_country) - || $self->ut_zip('ship_zip', $self->ship_country) - ; - return $error if $error; + if ( $self->has_ship_address + && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } + $self->addr_fields ) + ) + { + my $error = + $self->ut_name('ship_last') + || $self->ut_name('ship_first') + || $self->ut_textn('ship_company') + || $self->ut_text('ship_address1') + || $self->ut_textn('ship_address2') + || $self->ut_text('ship_city') + || $self->ut_textn('ship_county') + || $self->ut_textn('ship_state') + || $self->ut_country('ship_country') + ; + return $error if $error; - } else { # ship_ info eq billing info, so don't store dup info in database - $self->setfield("ship_$_", '') - foreach qw( last first company address1 address2 city county state zip - country daytime night fax ); + #false laziness with above + unless ( qsearchs('cust_main_county', { + 'country' => $self->ship_country, + 'state' => '', + } ) ) { + return "Unknown ship_state/ship_county/ship_country: ". + $self->ship_state. "/". $self->ship_county. "/". $self->ship_country + unless qsearch('cust_main_county',{ + 'state' => $self->ship_state, + 'county' => $self->ship_county, + 'country' => $self->ship_country, + } ); } + #eofalse + + $error = + $self->ut_phonen('ship_daytime', $self->ship_country) + || $self->ut_phonen('ship_night', $self->ship_country) + || $self->ut_phonen('ship_fax', $self->ship_country) + || $self->ut_zip('ship_zip', $self->ship_country) + ; + return $error if $error; + + return "Unit # is required." + if $self->ship_address2 =~ /^\s*$/ + && $conf->exists('cust_main-require_address2'); + + } else { # ship_ info eq billing info, so don't store dup info in database + + $self->setfield("ship_$_", '') + foreach $self->addr_fields; + + return "Unit # is required." + if $self->address2 =~ /^\s*$/ + && $conf->exists('cust_main-require_address2'); + } #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ @@ -1513,7 +1536,7 @@ sub check { $self->payname($1); } - foreach my $flag (qw( tax spool_cdr )) { + foreach my $flag (qw( tax spool_cdr squelch_cdr )) { $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); $self->$flag($1); } @@ -1526,6 +1549,30 @@ sub check { $self->SUPER::check; } +=item addr_fields + +Returns a list of fields which have ship_ duplicates. + +=cut + +sub addr_fields { + qw( last first company + address1 address2 city county state zip country + daytime night fax + ); +} + +=item has_ship_address + +Returns true if this customer record has a separate shipping address. + +=cut + +sub has_ship_address { + my $self = shift; + scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); +} + =item all_pkgs Returns all packages (see L) for this customer. @@ -1547,6 +1594,16 @@ sub all_pkgs { sort sort_packages @cust_pkg; } +=item cust_pkg + +Synonym for B. + +=cut + +sub cust_pkg { + shift->all_pkgs(@_); +} + =item ncancelled_pkgs Returns all non-cancelled packages (see L) for this customer. @@ -1561,11 +1618,18 @@ sub ncancelled_pkgs { 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; + @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum, @@ -1648,7 +1712,8 @@ sub num_ncancelled_pkgs { } sub num_pkgs { - my( $self, $sql ) = @_; + 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" @@ -1683,10 +1748,20 @@ sub suspend { grep { $_->suspend(@_) } $self->unsuspended_pkgs; } -=item suspend_if_pkgpart PKGPART [ , PKGPART ... ] +=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) matching the listed -PKGPARTs (see L). +PKGPARTs (see L). Preferred usage is to pass a hashref instead +of a list of pkgparts; the hashref has the following keys: + +=over 4 + +=item pkgparts - listref of pkgparts + +=item (other options are passed to the suspend method) + +=back + Returns a list: an empty list on success or a list of errors. @@ -1706,10 +1781,19 @@ sub suspend_if_pkgpart { $self->unsuspended_pkgs; } -=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] +=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) unless they match the -listed PKGPARTs (see L). +given PKGPARTs (see L). Preferred usage is to pass a hashref +instead of a list of pkgparts; the hashref has the following keys: + +=over 4 + +=item pkgparts - listref of pkgparts + +=item (other options are passed to the suspend method) + +=back Returns a list: an empty list on success or a list of errors. @@ -1733,22 +1817,31 @@ sub suspend_unless_pkgpart { Cancels all uncancelled packages (see L) for this customer. -Available options are: I, I, and I +Available options are: + +=over 4 + +=item quiet - can be set true to supress email cancellation notices. -I can be set true to supress email cancellation notices. +=item reason - can be set to a cancellation reason (see L), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L, reason - Text of the new reason. -# I can be set to a cancellation reason (see L) +=item ban - can be set true to ban this customer's credit card or ACH information, if present. -I can be set true to ban this customer's credit card or ACH information, -if present. +=back Always returns a list: an empty list on success or a list of errors. =cut sub cancel { - my $self = shift; - my %opt = @_; + my( $self, %opt ) = @_; + + warn "$me cancel called on customer ". $self->custnum. " with options ". + join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" + if $DEBUG; + + return ( 'access denied' ) + unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { @@ -1763,7 +1856,13 @@ sub cancel { } - grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; + my @pkgs = $self->ncancelled_pkgs; + + 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 { @@ -1810,10 +1909,108 @@ sub agent { qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } +=item bill_and_collect + +Cancels and suspends any packages due, generates bills, applies payments and +cred + +Warns on errors (Does not currently: 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 + +Bills the customer as if it were that time. Specified as a UNIX timestamp; see L). Also see L and L for conversion functions. For example: + + use Date::Parse; + ... + $cust_main->bill( 'time' => str2time('April 20th, 2001') ); + +=item invoice_time + +Used in conjunction with the I