X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=946495cebf7d9e9d76285d4c080426693e2500cf;hp=0534686c48dc4807eca594563ff58a5ac159131d;hb=7153190ee1bfeb6d3ad9e6da270a41a949333a7e;hpb=2a863bbb144830dfb8fca4afb3af76a84a647c76 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 0534686c4..946495ceb 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,19 +1,17 @@ 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 ); + $import $skip_fuzzyfiles $ignore_expired_card @paytypes); 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; @@ -21,16 +19,19 @@ use Date::Parse; use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; -use FS::UID qw( getotaker dbh ); +use Data::Dumper; +use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef ); -use FS::Misc qw( send_email ); +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; @@ -42,15 +43,15 @@ 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 ); @@ -69,6 +70,7 @@ $skip_fuzzyfiles = 0; $ignore_expired_card = 0; @encrypted_fields = ('payinfo', 'paycvv'); +@paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { @@ -348,7 +350,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 ); } @@ -417,7 +420,7 @@ sub start_copy_skel { #'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($conf->config_binary('cust_main-skeleton_tables')); + my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables'))); die $@ if $@; _copy_skel( 'cust_main', #tablename @@ -1011,7 +1014,9 @@ sub delete { my %hash = $cust_pkg->hash; $hash{'custnum'} = $new_custnum; my $new_cust_pkg = new FS::cust_pkg ( \%hash ); - my $error = $new_cust_pkg->replace($cust_pkg); + my $error = $new_cust_pkg->replace($cust_pkg, + options => { $cust_pkg->options }, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1048,7 +1053,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. @@ -1064,23 +1069,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 @@ -1095,6 +1093,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; @@ -1216,6 +1221,9 @@ sub check { || $self->ut_country('country') || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') + || $self->ut_textn('stateid') + || $self->ut_textn('stateid_state') + || $self->ut_textn('invoice_terms') ; #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." @@ -1267,58 +1275,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)$/ @@ -1330,6 +1355,7 @@ sub check { $error = $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') + || $self->ut_textn('paytype') ; return $error if $error; @@ -1518,6 +1544,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. @@ -1539,6 +1589,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. @@ -1553,11 +1613,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, @@ -1640,7 +1707,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" @@ -1675,10 +1743,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. @@ -1698,10 +1776,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. @@ -1725,22 +1812,31 @@ sub suspend_unless_pkgpart { Cancels all uncancelled packages (see L) for this customer. -Available options are: I, I, and I +Available options are: -I can be set true to supress email cancellation notices. +=over 4 + +=item quiet - can be set true to supress email cancellation notices. -# I can be set to a cancellation reason (see L) +=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 true to ban this customer's credit card or ACH information, -if present. +=item ban - 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)$/ ) { @@ -1755,7 +1851,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 { @@ -1802,27 +1904,138 @@ 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