X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=fb64fa3add2917730079ce51f17b070a6ef1ec50;hp=73afe2183c097f1837eb74c69da16b0c79333260;hb=eb4ff7f73c5d4bdf74a3472448b5a195598ff4cd;hpb=a54563b7d5cbac55d89ddd1f11e6c9a12c46b6f1 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 73afe2183..fb64fa3ad 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,19 +1,16 @@ 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 Time::Local qw(timelocal_nocheck); +use Data::Dumper; +use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; use Date::Parse; @@ -21,9 +18,10 @@ use Date::Parse; use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; +use Data::Dumper; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); -use FS::Misc qw( send_email ); +use FS::Misc qw( send_email generate_ps do_print ); use FS::Msgcat qw(gettext); use FS::cust_pkg; use FS::cust_svc; @@ -31,6 +29,7 @@ use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; use FS::cust_pay_void; +use FS::cust_pay_batch; use FS::cust_credit; use FS::cust_refund; use FS::part_referral; @@ -42,16 +41,18 @@ use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; use FS::part_pkg; -use FS::part_bill_event; -use FS::cust_bill_event; +use FS::part_event; +use FS::part_event_condition; +#use FS::cust_event; use FS::cust_tax_exempt; use FS::cust_tax_exempt_pkg; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; use FS::banned_pay; +use FS::payinfo_Mixin; -@ISA = qw( FS::Record ); +@ISA = qw( FS::Record FS::payinfo_Mixin ); @EXPORT_OK = qw( smart_search ); @@ -68,6 +69,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 { @@ -189,81 +191,15 @@ FS::Record. The following fields are currently supported: =item ship_fax - phone (optional) -=item payby - -I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a credit - see L and sets billing type to I) - -=item payinfo - -Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) +=item payby - Payment Type (See L for valid payby values) -=cut - -sub payinfo { - my($self,$payinfo) = @_; - if ( defined($payinfo) ) { - $self->paymask($payinfo); - $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter' - } else { - $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter' - return $payinfo; - } -} +=item payinfo - Payment Information (See L for data format) +=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 - -=cut - -=item paymask - Masked payment type - -=over 4 - -=item Credit Cards - -Mask all but the last four characters. -=item Checks - -Mask all but last 2 of account number and bank routing number. - -=item Others - -Do nothing, return the unmasked string. - -=back - -=cut - -sub paymask { - my($self,$value)=@_; - - # If it doesn't exist then generate it - my $paymask=$self->getfield('paymask'); - if (!defined($value) && (!defined($paymask) || $paymask eq '')) { - $value = $self->payinfo; - } - - if ( defined($value) && !$self->is_encrypted($value)) { - my $payinfo = $value; - my $payby = $self->payby; - if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four) - $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); - } elsif ($payby eq 'CHEK' || - $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank) - my( $account, $aba ) = split('@', $payinfo ); - $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba; - } else { # Tie up loose ends - $paymask = $payinfo; - } - $self->setfield('paymask', $paymask); # This is okay since we are the 'setter' - } elsif (defined($value) && $self->is_encrypted($value)) { - $paymask = 'N/A'; - } - return $paymask; -} +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 @@ -397,6 +333,8 @@ sub insert { warn " inserting $self\n" if $DEBUG > 1; + $self->signupdate(time) unless $self->signupdate; + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -476,11 +414,11 @@ sub start_copy_skel { my $self = shift; #'mg_user_preference' => {}, - #'mg_user_indicator_profile' => { 'mg_profile_indicator' => { 'mg_profile_details' }, }, - #'mg_watchlist_header' => { 'mg_watchlist_details' }, - #'mg_user_grid_header' => { 'mg_user_grid_details' }, - #'mg_portfolio_header' => { 'mg_portfolio_trades' => { 'mg_portfolio_trades_positions' } }, - my @tables = eval($conf->config('cust_main-skeleton_tables')); + #'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 @@ -494,24 +432,40 @@ sub start_copy_skel { sub _copy_skel { my( $table, $sourceid, $destid, %child_tables ) = @_; - my $dbdef_table = dbdef->table($table); - my $primary_key = $dbdef_table->primary_key - or return "$table has no primary key". - " (or do you need to run dbdef-create?)"; + 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 ( keys %child_tables ) { + 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 $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} } ) { + if ( keys %{ $child_tables{$child_table_def} } ) { - return "$child_table has no primary key\n" unless $child_pkey; + 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 @@ -526,14 +480,17 @@ sub _copy_skel { my @sel_columns = grep { $_ ne $primary_key } dbdef->table($child_table)->columns; - my $sel_columns = ' ( '. join(', ', @sel_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_sth = dbh->prepare( "SELECT $sel_columns FROM $child_table". - " WHERE $primary_key = $sourceid") + 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; @@ -565,10 +522,10 @@ sub _copy_skel { # don't drink soap! recurse! recurse! okay! my $error = - _copy_skel( $child_table, + _copy_skel( $child_table_def, $row->{$child_pkey}, #sourceid $insertid, #destid - %{ $child_tables{$child_table} }, + %{ $child_tables{$child_table_def} }, ); return $error if $error; @@ -671,21 +628,23 @@ sub order_pkgs { ''; #no error } -=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ] +=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] Recharges this (existing) customer with the specified prepaid card (see L), specified either by I or as an FS::prepay_credit object. If there is an error, returns the error, otherwise returns false. -Optionally, two scalar references can be passed as well. They will have their -values filled in with the amount and number of seconds applied by this prepaid +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. =cut sub recharge_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, $amountref, $secondsref, + $upbytesref, $downbytesref, $totalbytesref ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -698,10 +657,14 @@ sub recharge_prepay { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); - my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds) + my $error = $self->get_prepay($prepay_credit, \$amount, + \$seconds, \$upbytes, \$downbytes, \$totalbytes) || $self->increment_seconds($seconds) + || $self->increment_upbytes($upbytes) + || $self->increment_downbytes($downbytes) + || $self->increment_totalbytes($totalbytes) || $self->insert_cust_pay_prepay( $amount, ref($prepay_credit) ? $prepay_credit->identifier @@ -715,6 +678,9 @@ sub recharge_prepay { if ( defined($amountref) ) { $$amountref = $amount; } if ( defined($secondsref) ) { $$secondsref = $seconds; } + if ( defined($upbytesref) ) { $$upbytesref = $upbytes; } + if ( defined($downbytesref) ) { $$downbytesref = $downbytes; } + if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -738,7 +704,8 @@ If there is an error, returns the error, otherwise returns false. sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, $amountref, $secondsref, + $upref, $downref, $totalref) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -785,12 +752,51 @@ sub get_prepay { $$amountref += $prepay_credit->amount; $$secondsref += $prepay_credit->seconds; + $$upref += $prepay_credit->upbytes; + $$downref += $prepay_credit->downbytes; + $$totalref += $prepay_credit->totalbytes; $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } +=item increment_upbytes SECONDS + +Updates this customer's single or primary account (see L) by +the specified number of upbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_upbytes { + _increment_column( shift, 'upbytes', @_); +} + +=item increment_downbytes SECONDS + +Updates this customer's single or primary account (see L) by +the specified number of downbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_downbytes { + _increment_column( shift, 'downbytes', @_); +} + +=item increment_totalbytes SECONDS + +Updates this customer's single or primary account (see L) by +the specified number of totalbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_totalbytes { + _increment_column( shift, 'totalbytes', @_); +} + =item increment_seconds SECONDS Updates this customer's single or primary account (see L) by @@ -800,10 +806,24 @@ otherwise returns false. =cut sub increment_seconds { - my( $self, $seconds ) = @_; - warn "$me increment_seconds called: $seconds seconds\n" + _increment_column( shift, 'seconds', @_); +} + +=item _increment_column AMOUNT + +Updates this customer's single or primary account (see L) by +the specified number of seconds or bytes. If there is an error, returns +the error, otherwise returns false. + +=cut + +sub _increment_column { + my( $self, $column, $amount ) = @_; + warn "$me increment_column called: $column, $amount\n" if $DEBUG; + return '' unless $amount; + my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') } $self->ncancelled_pkgs; @@ -833,7 +853,8 @@ sub increment_seconds { ' ('. $svc_acct->email. ")\n" if $DEBUG > 1; - $svc_acct->increment_seconds($seconds); + $column = "increment_$column"; + $svc_acct->$column($amount); } @@ -991,7 +1012,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; @@ -1056,11 +1079,6 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - # If the mask is blank then try to set it - if we can... - if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') { - $self->paymask($self->payinfo); - } - # We absolutely have to have an old vs. new record to make this work. if (!defined($old)) { $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); @@ -1078,7 +1096,7 @@ sub replace { local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ - && $old->payinfo eq $self->payinfo; + && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; @@ -1190,6 +1208,8 @@ sub check { || $self->ut_number('refnum') || $self->ut_name('last') || $self->ut_name('first') + || $self->ut_snumbern('birthdate') + || $self->ut_snumbern('signupdate') || $self->ut_textn('company') || $self->ut_text('address1') || $self->ut_textn('address2') @@ -1199,6 +1219,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." @@ -1304,12 +1327,16 @@ sub check { } } - $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ + #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ + # or return "Illegal payby: ". $self->payby; + #$self->payby($1); + FS::payby->can_payby($self->table, $self->payby) or return "Illegal payby: ". $self->payby; $error = $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') + || $self->ut_textn('paytype') ; return $error if $error; @@ -1329,8 +1356,6 @@ sub check { $check_payinfo = 0; } - $self->payby($1); - if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; @@ -1353,20 +1378,18 @@ sub check { ' (ban# '. $ban->bannum. ')'; } - if ( defined $self->dbdef_table->column('paycvv') ) { - if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { - if ( cardtype($self->payinfo) eq 'American Express card' ) { - $self->paycvv =~ /^(\d{4})$/ - or return "CVV2 (CID) for American Express cards is four digits."; - $self->paycvv($1); - } else { - $self->paycvv =~ /^(\d{3})$/ - or return "CVV2 (CVC2/CID) is three digits."; - $self->paycvv($1); - } + if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { + if ( cardtype($self->payinfo) eq 'American Express card' ) { + $self->paycvv =~ /^(\d{4})$/ + or return "CVV2 (CID) for American Express cards is four digits."; + $self->paycvv($1); } else { - $self->paycvv(''); + $self->paycvv =~ /^(\d{3})$/ + or return "CVV2 (CVC2/CID) is three digits."; + $self->paycvv($1); } + } else { + $self->paycvv(''); } my $cardtype = cardtype($payinfo); @@ -1399,13 +1422,12 @@ sub check { $payinfo =~ s/[^\d\@]//g; if ( $conf->exists('echeck-nonus') ) { $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; } else { $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; } + $payinfo = "$1\@$2"; $self->payinfo($payinfo); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); if ( $ban ) { @@ -1422,13 +1444,13 @@ sub check { $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; $payinfo = $1; $self->payinfo($payinfo); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'BILL' ) { $error = $self->ut_textn('payinfo'); return "Illegal P.O. number: ". $self->payinfo if $error; - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'COMP' ) { @@ -1442,7 +1464,7 @@ sub check { $error = $self->ut_textn('payinfo'); return "Illegal comp account issuer: ". $self->payinfo if $error; - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'PREPAY' ) { @@ -1453,7 +1475,7 @@ sub check { return "Illegal prepayment identifier: ". $self->payinfo if $error; return "Unknown prepayment identifier" unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } @@ -1510,11 +1532,27 @@ Returns all packages (see L) for this customer. sub all_pkgs { my $self = shift; + + return $self->num_pkgs unless wantarray; + + my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { - values %{ $self->{'_pkgnum'}->cache }; + @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; } else { - qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); } + + sort sort_packages @cust_pkg; +} + +=item cust_pkg + +Synonym for B. + +=cut + +sub cust_pkg { + shift->all_pkgs(@_); } =item ncancelled_pkgs @@ -1525,19 +1563,50 @@ Returns all non-cancelled packages (see L) for this customer. sub ncancelled_pkgs { my $self = shift; + + return $self->num_ncancelled_pkgs unless wantarray; + + my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { - grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; + + warn "$me ncancelled_pkgs: returning cached objects" + if $DEBUG > 1; + + @cust_pkg = grep { ! $_->getfield('cancel') } + values %{ $self->{'_pkgnum'}->cache }; + } else { - @{ [ # force list context + + warn "$me ncancelled_pkgs: searching for packages for custnum ". + $self->custnum + if $DEBUG > 1; + + @cust_pkg = qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), + 'custnum' => $self->custnum, + 'cancel' => '', + }); + push @cust_pkg, qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ] }; + 'custnum' => $self->custnum, + 'cancel' => 0, + }); + } + + sort sort_packages @cust_pkg; + +} + +# 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') ) { + return -1 if $b->get('cancel'); + return 1 if $a->get('cancel'); + return 0; + } else { + $a->pkgnum <=> $b->pkgnum; } } @@ -1586,14 +1655,18 @@ customer. =cut sub num_cancelled_pkgs { - my $self = shift; - $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0"); + 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, $sql ) = @_; + $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i; my $sth = dbh->prepare( - "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql" + "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql" ) or die dbh->errstr; $sth->execute($self->custnum) or die $sth->errstr; $sth->fetchrow_arrayref->[0]; @@ -1622,13 +1695,23 @@ Returns a list: an empty list on success or a list of errors. sub suspend { my $self = shift; - grep { $_->suspend } $self->unsuspended_pkgs; + 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. @@ -1636,16 +1719,31 @@ Returns a list: an empty list on success or a list of errors. sub suspend_if_pkgpart { my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } + my (@pkgparts, %opt); + if (ref($_[0]) eq 'HASH'){ + @pkgparts = @{$_[0]{pkgparts}}; + %opt = %{$_[0]}; + }else{ + @pkgparts = @_; + } + grep { $_->suspend(%opt) } grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } $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. @@ -1653,8 +1751,14 @@ Returns a list: an empty list on success or a list of errors. sub suspend_unless_pkgpart { my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } + my (@pkgparts, %opt); + if (ref($_[0]) eq 'HASH'){ + @pkgparts = @{$_[0]{pkgparts}}; + %opt = %{$_[0]}; + }else{ + @pkgparts = @_; + } + grep { $_->suspend(%opt) } grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } $self->unsuspended_pkgs; } @@ -1663,22 +1767,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)$/ ) { @@ -1693,7 +1806,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 { @@ -1709,10 +1828,26 @@ sub _banned_pay_hashref { { 'payby' => $payby2ban{$self->payby}, 'payinfo' => md5_base64($self->payinfo), - #'reason' => + #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. @@ -1724,27 +1859,109 @@ 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