-=item cancel [ OPTION => VALUE ... ]
-
-Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
-
-Available options are:
-
-=over 4
-
-=item quiet - can be set true to supress email cancellation notices.
-
-=item reason - can be set to a cancellation reason (see L<FS:reason>), 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<FS::reason_type>, reason - Text of the new reason.
-
-=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 ) = @_;
-
- 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)$/ ) {
-
- #should try decryption (we might have the private key)
- # and if not maybe queue a job for the server that does?
- return ( "Can't (yet) ban encrypted credit cards" )
- if $self->is_encrypted($self->payinfo);
-
- my $ban = new FS::banned_pay $self->_banned_pay_hashref;
- my $error = $ban->insert;
- return ( $error ) if $error;
-
- }
-
- 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;
-
- grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
-}
-
-sub _banned_pay_hashref {
- my $self = shift;
-
- my %payby2ban = (
- 'CARD' => 'CARD',
- 'DCRD' => 'CARD',
- 'CHEK' => 'CHEK',
- 'DCHK' => 'CHEK'
- );
-
- {
- 'payby' => $payby2ban{$self->payby},
- 'payinfo' => md5_base64($self->payinfo),
- #don't ever *search* on reason! #'reason' =>
- };
-}
-
-=item notes
-
-Returns all notes (see L<FS::cust_main_note>) 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<FS::agent>) for this customer.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
-}
-
-=item agent_name
-
-Returns the agent name (see L<FS::agent>) 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 BILLING METHODS
-
-Documentation on billing methods has been moved to
-L<FS::cust_main::Billing>.
-
-=item do_cust_event [ HASHREF | OPTION => VALUE ... ]
-
-Runs billing events; see L<FS::part_event> and the billing events web
-interface.
-
-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
-
-Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item check_freq
-
-"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
-
-=item stage
-
-"collect" (the default) or "pre-bill"
-
-=item quiet
-
-set true to surpress email card/ACH decline notices.
-
-=item debug
-
-Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
-
-=cut
-
-# =item payby
-#
-# allows for one time override of normal customer billing method
-
-# =item retry
-#
-# Retry card/echeck/LEC transactions even when not scheduled by invoice events.
-
-sub do_cust_event {
- my( $self, %options ) = @_;
- my $time = $options{'time'} || time;
-
- #put below somehow?
- 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;
-
- $self->select_for_update; #mutex
-
- if ( $DEBUG ) {
- my $balance = $self->balance;
- warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
- }
-
-# if ( exists($options{'retry_card'}) ) {
-# carp 'retry_card option passed to collect is deprecated; use retry';
-# $options{'retry'} ||= $options{'retry_card'};
-# }
-# if ( exists($options{'retry'}) && $options{'retry'} ) {
-# my $error = $self->retry_realtime;
-# if ( $error ) {
-# $dbh->rollback if $oldAutoCommit;
-# return $error;
-# }
-# }
-
- # false laziness w/pay_batch::import_results
-
- my $due_cust_event = $self->due_cust_event(
- 'debug' => ( $options{'debug'} || 0 ),
- 'time' => $time,
- 'check_freq' => $options{'check_freq'},
- 'stage' => ( $options{'stage'} || 'collect' ),
- );
- unless( ref($due_cust_event) ) {
- $dbh->rollback if $oldAutoCommit;
- return $due_cust_event;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- #never want to roll back an event just because it or a different one
- # returned an error
- local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
-
- foreach my $cust_event ( @$due_cust_event ) {
-
- #XXX lock event
-
- #re-eval event conditions (a previous event could have changed things)
- unless ( $cust_event->test_conditions( 'time' => $time ) ) {
- #don't leave stray "new/locked" records around
- my $error = $cust_event->delete;
- return $error if $error;
- next;
- }
-
- {
- local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
- warn " running cust_event ". $cust_event->eventnum. "\n"
- if $DEBUG > 1;
-
- #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
- if ( my $error = $cust_event->do_event() ) {
- #XXX wtf is this? figure out a proper dealio with return value
- #from do_event
- return $error;
- }
- }
-
- }
-
- '';
-
-}
-
-=item due_cust_event [ HASHREF | OPTION => VALUE ... ]
-
-Inserts database records for and returns an ordered listref of new events due
-for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
-events are due, an empty listref is returned. If there is an error, returns a
-scalar error message.
-
-To actually run the events, call each event's test_condition method, and if
-still true, call the event's do_event method.
-
-Options are passed as a hashref or as a list of name-value pairs. Available
-options are:
-
-=over 4
-
-=item check_freq
-
-Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
-
-=item stage
-
-"collect" (the default) or "pre-bill"
-
-=item time
-
-"Current time" for the events.
-
-=item debug
-
-Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
-
-=item eventtable
-
-Only return events for the specified eventtable (by default, events of all eventtables are returned)
-
-=item objects
-
-Explicitly pass the objects to be tested (typically used with eventtable).
-
-=item testonly
-
-Set to true to return the objects, but not actually insert them into the
-database.
-
-=back
-
-=cut
-
-sub due_cust_event {
- my $self = shift;
- my %opt = ref($_[0]) ? %{ $_[0] } : @_;
-
- #???
- #my $DEBUG = $opt{'debug'}
- local($DEBUG) = $opt{'debug'}
- if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
-
- warn "$me due_cust_event called with options ".
- join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
- if $DEBUG;
-
- $opt{'time'} ||= time;
-
- 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;