X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=b1b2753ea2ba6697a7042bdb26dcbadc7f63a819;hb=cb0b8c862de7c7ab68b172faa29167f47894627b;hp=ac5e4561421cd3db43dc8b07c0d2fc2057244442;hpb=2e45f85a3b2544f89fb149a77b3a20df3381d48f;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index ac5e45614..b1b2753ea 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,19 +2,21 @@ package FS::cust_main; require 5.006; use strict; -use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::Record ); -use vars qw( @EXPORT_OK $DEBUG $me $conf + #FS::cust_main:_Marketgear when they're ready to move to 2.1 +use base qw( FS::cust_main::Packages + FS::cust_main::Billing FS::cust_main::Billing_Realtime + FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin + FS::Record + ); +use vars qw( $DEBUG $me $conf @encrypted_fields - $import $ignore_expired_card + $import + $ignore_expired_card $ignore_illegal_zip $ignore_banned_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 List::Util qw( min ); use Time::Local qw(timelocal); use Storable qw(thaw); use MIME::Base64; @@ -24,21 +26,17 @@ use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; use File::Temp qw( tempfile ); -use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); +use FS::CurrentUser; use FS::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; @@ -51,20 +49,13 @@ 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; 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; @@ -73,10 +64,6 @@ use FS::agent_payment_gateway; use FS::banned_pay; use FS::TicketSystem; -@EXPORT_OK = qw( smart_search ); - -$realtime_bop_decline_quiet = 0; - # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations # 3 is even more information including possibly sensitive data @@ -85,6 +72,8 @@ $me = '[FS::cust_main]'; $import = 0; $ignore_expired_card = 0; +$ignore_illegal_zip = 0; +$ignore_banned_card = 0; $skip_fuzzyfiles = 0; @fuzzyfields = ( 'first', 'last', 'company', 'address1' ); @@ -516,18 +505,12 @@ sub insert { } } - if ( $conf->config('cust_main-skeleton_tables') - && $conf->config('cust_main-skeleton_custnum') ) { - - warn " inserting skeleton records\n" - if $DEBUG > 1; - + if ( $self->can('start_copy_skel') ) { my $error = $self->start_copy_skel; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - } warn " ordering packages\n" @@ -650,332 +633,10 @@ sub auto_agent_custid { } -sub start_copy_skel { - my $self = shift; - - #'mg_user_preference' => {}, - #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, }, - #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' }, - #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' }, - #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } }, - my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables'))); - die $@ if $@; - - _copy_skel( 'cust_main', #tablename - $conf->config('cust_main-skeleton_custnum'), #sourceid - $self->custnum, #destid - @tables, #child tables - ); -} - -#recursive subroutine, not a method -sub _copy_skel { - my( $table, $sourceid, $destid, %child_tables ) = @_; - - my $primary_key; - if ( $table =~ /^(\w+)\.(\w+)$/ ) { - ( $table, $primary_key ) = ( $1, $2 ); - } else { - my $dbdef_table = dbdef->table($table); - $primary_key = $dbdef_table->primary_key - or return "$table has no primary key". - " (or do you need to run dbdef-create?)"; - } - - warn " _copy_skel: $table.$primary_key $sourceid to $destid for ". - join (', ', keys %child_tables). "\n" - if $DEBUG > 2; - - foreach my $child_table_def ( keys %child_tables ) { - - my $child_table; - my $child_pkey = ''; - if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) { - ( $child_table, $child_pkey ) = ( $1, $2 ); - } else { - $child_table = $child_table_def; - - $child_pkey = dbdef->table($child_table)->primary_key; - # or return "$table has no primary key". - # " (or do you need to run dbdef-create?)\n"; - } - - my $sequence = ''; - if ( keys %{ $child_tables{$child_table_def} } ) { - - return "$child_table has no primary key". - " (run dbdef-create or try specifying it?)\n" - unless $child_pkey; - - #false laziness w/Record::insert and only works on Pg - #refactor the proper last-inserted-id stuff out of Record::insert if this - # ever gets use for anything besides a quick kludge for one customer - my $default = dbdef->table($child_table)->column($child_pkey)->default; - $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i - or return "can't parse $child_table.$child_pkey default value ". - " for sequence name: $default"; - $sequence = $1; - - } - - my @sel_columns = grep { $_ ne $primary_key } - dbdef->table($child_table)->columns; - my $sel_columns = join(', ', @sel_columns ); - - my @ins_columns = grep { $_ ne $child_pkey } @sel_columns; - my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) '; - my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) '; - - my $sel_st = "SELECT $sel_columns FROM $child_table". - " WHERE $primary_key = $sourceid"; - warn " $sel_st\n" - if $DEBUG > 2; - my $sel_sth = dbh->prepare( $sel_st ) - or return dbh->errstr; - - $sel_sth->execute or return $sel_sth->errstr; - - while ( my $row = $sel_sth->fetchrow_hashref ) { - - warn " selected row: ". - join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n" - if $DEBUG > 2; - - my $statement = - "INSERT INTO $child_table $ins_columns VALUES $placeholders"; - my $ins_sth =dbh->prepare($statement) - or return dbh->errstr; - my @param = ( $destid, map $row->{$_}, @ins_columns ); - warn " $statement: [ ". join(', ', @param). " ]\n" - if $DEBUG > 2; - $ins_sth->execute( @param ) - or return $ins_sth->errstr; - - #next unless keys %{ $child_tables{$child_table} }; - next unless $sequence; - - #another section of that laziness - my $seq_sql = "SELECT currval('$sequence')"; - my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr; - $seq_sth->execute or return $seq_sth->errstr; - my $insertid = $seq_sth->fetchrow_arrayref->[0]; - - # don't drink soap! recurse! recurse! okay! - my $error = - _copy_skel( $child_table_def, - $row->{$child_pkey}, #sourceid - $insertid, #destid - %{ $child_tables{$child_table_def} }, - ); - return $error if $error; - - } - - } - - return ''; - -} - -=item order_pkg HASHREF | OPTION => VALUE ... - -Orders a single package. - -Options may be passed as a list of key/value pairs or as a hash reference. -Options are: - -=over 4 - -=item cust_pkg - -FS::cust_pkg object - -=item cust_location - -Optional FS::cust_location object - -=item svcs - -Optional arryaref of FS::svc_* service objects. - -=item depend_jobnum - -If this option is set to a job queue jobnum (see L), all provisioning -jobs will have a dependancy on the supplied job (they will not run until the -specific job completes). This can be used to defer provisioning until some -action completes (such as running the customer's credit card successfully). - -=item ticket_subject - -Optional subject for a ticket created and attached to this customer - -=item ticket_subject - -Optional queue name for ticket additions - -=back - -=cut - -sub order_pkg { - my $self = shift; - my $opt = ref($_[0]) ? shift : { @_ }; - - warn "$me order_pkg called with options ". - join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n" - if $DEBUG; - - my $cust_pkg = $opt->{'cust_pkg'}; - my $svcs = $opt->{'svcs'} || []; - - my %svc_options = (); - $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'} - if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'}; - - my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () } - qw( ticket_subject ticket_queue ); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( $opt->{'cust_location'} && - ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) { - my $error = $opt->{'cust_location'}->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_location (transaction rolled back): $error"; - } - $cust_pkg->locationnum($opt->{'cust_location'}->locationnum); - } - - $cust_pkg->custnum( $self->custnum ); - - my $error = $cust_pkg->insert( %insert_params ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - - foreach my $svc_something ( @{ $opt->{'svcs'} } ) { - if ( $svc_something->svcnum ) { - my $old_cust_svc = $svc_something->cust_svc; - my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; - $new_cust_svc->pkgnum( $cust_pkg->pkgnum); - $error = $new_cust_svc->replace($old_cust_svc); - } else { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $svc_something->isa('FS::svc_acct') ) { - foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } } - qw( seconds upbytes downbytes totalbytes ) ) { - $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } ); - ${ $opt->{$_.'_ref'} } = 0; - } - } - $error = $svc_something->insert(%svc_options); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "inserting svc_ (transaction rolled back): $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error - -} - -#deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ] -=item order_pkgs HASHREF [ , OPTION => VALUE ... ] - -Like the insert method on an existing record, this method orders multiple -packages and included services atomicaly. Pass a Tie::RefHash data structure -to this method containing FS::cust_pkg and FS::svc_I objects. -There should be a better explanation of this, but until then, here's an -example: - - use Tie::RefHash; - tie %hash, 'Tie::RefHash'; #this part is important - %hash = ( - $cust_pkg => [ $svc_acct ], - ... - ); - $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); - -Services can be new, in which case they are inserted, or existing unaudited -services, in which case they are linked to the newly-created package. - -Currently available options are: I, I, I, -I, I, and I. - -If I is set, all provisioning jobs will have a dependancy -on the supplied jobnum (they will not run until the specific job completes). -This can be used to defer provisioning until some action completes (such -as running the customer's credit card successfully). - -The I option is deprecated. If I is set true, no -provisioning jobs (exports) are scheduled. (You can schedule them later with -the B method for each cust_pkg object. Using the B method -on the cust_main object is not recommended, as existing services will also be -reexported.) - -If I, I, I, or I is -provided, the scalars (provided by references) will be incremented by the -values of the prepaid card.` - -=cut - -sub order_pkgs { - my $self = shift; - my $cust_pkgs = shift; - my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated - my %options = @_; - $seconds_ref ||= $options{'seconds_ref'}; - - warn "$me order_pkgs called with options ". - join(', ', map { "$_: $options{$_}" } keys %options ). "\n" - if $DEBUG; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; +=item PACKAGE METHODS - local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; - - foreach my $cust_pkg ( keys %$cust_pkgs ) { - - my $error = $self->order_pkg( - 'cust_pkg' => $cust_pkg, - 'svcs' => $cust_pkgs->{$cust_pkg}, - 'seconds_ref' => $seconds_ref, - map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref - depend_jobnum - ) - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} +Documentation on customer package methods has been moved to +L. =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] @@ -1754,6 +1415,7 @@ sub check { || $self->ut_textn('invoice_terms') || $self->ut_alphan('geocode') || $self->ut_floatn('cdr_termination_percentage') + || $self->ut_floatn('credit_limit') ; #barf. need message catalogs. i18n. etc. @@ -1790,7 +1452,8 @@ sub check { # bad idea to disable, causes billing to fail because of no tax rates later -# unless ( $import ) { +# except we don't fail any more + unless ( $import ) { unless ( qsearch('cust_main_county', { 'country' => $self->country, 'state' => '', @@ -1803,16 +1466,20 @@ sub check { 'country' => $self->country, } ); } -# } + } $error = $self->ut_phonen('daytime', $self->country) || $self->ut_phonen('night', $self->country) || $self->ut_phonen('fax', $self->country) - || $self->ut_zip('zip', $self->country) ; return $error if $error; + unless ( $ignore_illegal_zip ) { + $error = $self->ut_zip('zip', $self->country); + return $error if $error; + } + if ( $conf->exists('cust_main-require_phone') && ! length($self->daytime) && ! length($self->night) ) { @@ -1865,10 +1532,13 @@ sub check { $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; + unless ( $ignore_illegal_zip ) { + $error = $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'); @@ -1923,12 +1593,14 @@ sub check { if $self->payinfo !~ /^99\d{14}$/ #token && cardtype($self->payinfo) eq "Unknown"; - my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - if ( $ban ) { - return 'Banned credit card: banned on '. - time2str('%a %h %o at %r', $ban->_date). - ' by '. $ban->otaker. - ' (ban# '. $ban->bannum. ')'; + unless ( $ignore_banned_card ) { + my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); + if ( $ban ) { + return 'Banned credit card: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } } if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { @@ -2072,7 +1744,7 @@ sub check { $self->$flag($1); } - $self->otaker(getotaker) unless $self->otaker; + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; warn "$me check AFTER: \n". $self->_dump if $DEBUG > 2; @@ -2123,38 +1795,6 @@ sub location_hash { #fields that cust_location has } -=item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] - -Returns all packages (see L) for this customer. - -=cut - -sub all_pkgs { - my $self = shift; - my $extra_qsearch = ref($_[0]) ? shift : {}; - - return $self->num_pkgs unless wantarray || keys(%$extra_qsearch); - - my @cust_pkg = (); - if ( $self->{'_pkgnum'} ) { - @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; - } else { - @cust_pkg = $self->_cust_pkg($extra_qsearch); - } - - sort sort_packages @cust_pkg; -} - -=item cust_pkg - -Synonym for B. - -=cut - -sub cust_pkg { - shift->all_pkgs(@_); -} - =item cust_location Returns all locations (see L) for this customer. @@ -2221,240 +1861,80 @@ sub location_label { $line; } -=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] +=item unsuspend -Returns all non-cancelled packages (see L) for this customer. +Unsuspends all unflagged suspended packages (see L +and L) for this customer. Always returns a list: an empty list +on success or a list of errors. =cut -sub ncancelled_pkgs { +sub unsuspend { my $self = shift; - my $extra_qsearch = ref($_[0]) ? shift : {}; - - return $self->num_ncancelled_pkgs unless wantarray; - - my @cust_pkg = (); - if ( $self->{'_pkgnum'} ) { - - warn "$me ncancelled_pkgs: returning cached objects" - if $DEBUG > 1; - - @cust_pkg = grep { ! $_->getfield('cancel') } - values %{ $self->{'_pkgnum'}->cache }; - - } else { - - warn "$me ncancelled_pkgs: searching for packages with custnum ". - $self->custnum. "\n" - if $DEBUG > 1; - - $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) '; + grep { $_->unsuspend } $self->suspended_pkgs; +} - @cust_pkg = $self->_cust_pkg($extra_qsearch); +=item suspend - } +Suspends all unsuspended packages (see L) for this customer. - sort sort_packages @cust_pkg; +Returns a list: an empty list on success or a list of errors. -} +=cut -sub _cust_pkg { +sub suspend { 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 }, - }); - + grep { $_->suspend(@_) } $self->unsuspended_pkgs; } -# This should be generalized to use config options to determine order. -sub sort_packages { - - my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 ); - return $locationsort if $locationsort; - - if ( $a->get('cancel') xor $b->get('cancel') ) { - return -1 if $b->get('cancel'); - return 1 if $a->get('cancel'); - #shouldn't get here... - return 0; - } else { - my $a_num_cust_svc = $a->num_cust_svc; - my $b_num_cust_svc = $b->num_cust_svc; - return 0 if !$a_num_cust_svc && !$b_num_cust_svc; - return -1 if $a_num_cust_svc && !$b_num_cust_svc; - return 1 if !$a_num_cust_svc && $b_num_cust_svc; - my @a_cust_svc = $a->cust_svc; - my @b_cust_svc = $b->cust_svc; - return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc); - return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc); - return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc); - $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; - } +=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] -} +Suspends all unsuspended packages (see L) matching the listed +PKGPARTs (see L). Preferred usage is to pass a hashref instead +of a list of pkgparts; the hashref has the following keys: -=item suspended_pkgs +=over 4 -Returns all suspended packages (see L) for this customer. +=item pkgparts - listref of pkgparts -=cut +=item (other options are passed to the suspend method) -sub suspended_pkgs { - my $self = shift; - grep { $_->susp } $self->ncancelled_pkgs; -} +=back -=item unflagged_suspended_pkgs -Returns all unflagged suspended packages (see L) for this -customer (thouse packages without the `manual_flag' set). +Returns a list: an empty list on success or a list of errors. =cut -sub unflagged_suspended_pkgs { +sub suspend_if_pkgpart { my $self = shift; - return $self->suspended_pkgs - unless dbdef->table('cust_pkg')->column('manual_flag'); - grep { ! $_->manual_flag } $self->suspended_pkgs; + 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 unsuspended_pkgs +=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] -Returns all unsuspended (and uncancelled) packages (see L) for -this customer. +Suspends all unsuspended packages (see L) unless they match the +given PKGPARTs (see L). Preferred usage is to pass a hashref +instead of a list of pkgparts; the hashref has the following keys: -=cut +=over 4 -sub unsuspended_pkgs { - my $self = shift; - grep { ! $_->susp } $self->ncancelled_pkgs; -} +=item pkgparts - listref of pkgparts -=item next_bill_date +=item (other options are passed to the suspend method) + +=back -Returns the next date this customer will be billed, as a UNIX timestamp, or -undef if no active package has a next bill date. - -=cut - -sub next_bill_date { - my $self = shift; - min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs ); -} - -=item num_cancelled_pkgs - -Returns the number of cancelled packages (see L) for this -customer. - -=cut - -sub num_cancelled_pkgs { - shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"); -} - -sub num_ncancelled_pkgs { - shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )"); -} - -sub num_pkgs { - my( $self ) = shift; - my $sql = scalar(@_) ? shift : ''; - $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i; - my $sth = dbh->prepare( - "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql" - ) or die dbh->errstr; - $sth->execute($self->custnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=item unsuspend - -Unsuspends all unflagged suspended packages (see L -and L) for this customer. Always returns a list: an empty list -on success or a list of errors. - -=cut - -sub unsuspend { - my $self = shift; - grep { $_->unsuspend } $self->suspended_pkgs; -} - -=item suspend - -Suspends all unsuspended packages (see L) for this customer. - -Returns a list: an empty list on success or a list of errors. - -=cut - -sub suspend { - my $self = shift; - grep { $_->suspend(@_) } $self->unsuspended_pkgs; -} - -=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] - -Suspends all unsuspended packages (see L) matching the listed -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. - -=cut - -sub suspend_if_pkgpart { - my $self = shift; - 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 HASHREF | PKGPART [ , PKGPART ... ] - -Suspends all unsuspended packages (see L) unless they match the -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. +Returns a list: an empty list on success or a list of errors. =cut @@ -2661,1460 +2141,965 @@ sub classname { : ''; } +=item BILLING METHODS -=item bill_and_collect - -Cancels and suspends any packages due, generates bills, applies payments and -credits, and applies collection events to run cards, send bills and notices, -etc. - -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: +Documentation on billing methods has been moved to +L. -=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 REALTIME BILLING METHODS -=item invoice_time +Documentation on realtime billing methods has been moved to +L. -Used in conjunction with the I