+# bad idea to disable, causes billing to fail because of no tax rates later
+# unless ( $import ) {
+ unless ( qsearch('cust_main_county', {
+ 'country' => $self->country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown state/county/country: ".
+ $self->state. "/". $self->county. "/". $self->country
+ unless qsearch('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ '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;
+
+ my @addfields = qw(
+ last first company address1 address2 city county state zip
+ country daytime night fax
+ );
+
+ 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;
+
+ #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;
+
+ } 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 );
+ }
+ }
+
+ #$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;
+
+ if ( $self->payip eq '' ) {
+ $self->payip('');
+ } else {
+ $error = $self->ut_ip('payip');
+ return $error if $error;
+ }
+
+ # If it is encrypted and the private key is not availaible then we can't
+ # check the credit card.
+
+ my $check_payinfo = 1;
+
+ if ($self->is_encrypted($self->payinfo)) {
+ $check_payinfo = 0;
+ }
+
+ if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
+
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\D//g;
+ $payinfo =~ /^(\d{13,16})$/
+ or return gettext('invalid_card'); # . ": ". $self->payinfo;
+ $payinfo = $1;
+ $self->payinfo($payinfo);
+ validate($payinfo)
+ or return gettext('invalid_card'); # . ": ". $self->payinfo;
+
+ return gettext('unknown_card_type')
+ if 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. ')';
+ }
+
+ 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);
+ }
+ } else {
+ $self->paycvv('');
+ }
+
+ my $cardtype = cardtype($payinfo);
+ if ( $cardtype =~ /^(Switch|Solo)$/i ) {
+
+ return "Start date or issue number is required for $cardtype cards"
+ unless $self->paystart_month && $self->paystart_year or $self->payissue;
+
+ return "Start month must be between 1 and 12"
+ if $self->paystart_month
+ and $self->paystart_month < 1 || $self->paystart_month > 12;
+
+ return "Start year must be 1990 or later"
+ if $self->paystart_year
+ and $self->paystart_year < 1990;
+
+ return "Issue number must be beween 1 and 99"
+ if $self->payissue
+ and $self->payissue < 1 || $self->payissue > 99;
+
+ } else {
+ $self->paystart_month('');
+ $self->paystart_year('');
+ $self->payissue('');
+ }
+
+ } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
+
+ my $payinfo = $self->payinfo;
+ $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";
+ }
+ $self->payinfo($payinfo);
+ $self->paycvv('');
+
+ my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
+ if ( $ban ) {
+ return 'Banned ACH account: banned on '.
+ time2str('%a %h %o at %r', $ban->_date).
+ ' by '. $ban->otaker.
+ ' (ban# '. $ban->bannum. ')';
+ }
+
+ } elsif ( $self->payby eq 'LECB' ) {
+
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\D//g;
+ $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
+ $payinfo = $1;
+ $self->payinfo($payinfo);
+ $self->paycvv('');
+
+ } elsif ( $self->payby eq 'BILL' ) {
+
+ $error = $self->ut_textn('payinfo');
+ return "Illegal P.O. number: ". $self->payinfo if $error;
+ $self->paycvv('');
+
+ } elsif ( $self->payby eq 'COMP' ) {
+
+ my $curuser = $FS::CurrentUser::CurrentUser;
+ if ( ! $self->custnum
+ && ! $curuser->access_right('Complimentary customer')
+ )
+ {
+ return "You are not permitted to create complimentary accounts."
+ }
+
+ $error = $self->ut_textn('payinfo');
+ return "Illegal comp account issuer: ". $self->payinfo if $error;
+ $self->paycvv('');
+
+ } elsif ( $self->payby eq 'PREPAY' ) {
+
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\W//g; #anything else would just confuse things
+ $self->payinfo($payinfo);
+ $error = $self->ut_alpha('payinfo');
+ return "Illegal prepayment identifier: ". $self->payinfo if $error;
+ return "Unknown prepayment identifier"
+ unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
+ $self->paycvv('');
+
+ }
+
+ if ( $self->paydate eq '' || $self->paydate eq '-' ) {
+ return "Expiration date required"
+ unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
+ $self->paydate('');
+ } else {
+ my( $m, $y );
+ if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
+ ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
+ } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
+ ( $m, $y ) = ( $3, "20$2" );
+ } else {
+ return "Illegal expiration date: ". $self->paydate;
+ }
+ $self->paydate("$y-$m-01");
+ my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
+ return gettext('expired_card')
+ if !$import
+ && !$ignore_expired_card
+ && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
+ }
+
+ if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
+ ( ! $conf->exists('require_cardname')
+ || $self->payby !~ /^(CARD|DCRD)$/ )
+ ) {
+ $self->payname( $self->first. " ". $self->getfield('last') );
+ } else {
+ $self->payname =~ /^([\w \,\.\-\'\&]+)$/
+ or return gettext('illegal_name'). " payname: ". $self->payname;
+ $self->payname($1);
+ }
+
+ foreach my $flag (qw( tax spool_cdr )) {
+ $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
+ $self->$flag($1);
+ }
+
+ $self->otaker(getotaker) unless $self->otaker;
+
+ warn "$me check AFTER: \n". $self->_dump
+ if $DEBUG > 2;
+
+ $self->SUPER::check;
+}
+
+=item all_pkgs
+
+Returns all packages (see L<FS::cust_pkg>) for this customer.
+
+=cut
+
+sub all_pkgs {
+ my $self = shift;
+
+ return $self->num_pkgs unless wantarray;
+
+ my @cust_pkg = ();
+ if ( $self->{'_pkgnum'} ) {
+ @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
+ } else {
+ @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+ }
+
+ sort sort_packages @cust_pkg;
+}
+
+=item ncancelled_pkgs
+
+Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
+
+=cut
+
+sub ncancelled_pkgs {
+ my $self = shift;
+
+ return $self->num_ncancelled_pkgs unless wantarray;
+
+ my @cust_pkg = ();
+ if ( $self->{'_pkgnum'} ) {
+
+ @cust_pkg = grep { ! $_->getfield('cancel') }
+ values %{ $self->{'_pkgnum'}->cache };
+
+ } else {
+
+ @cust_pkg =
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => '',
+ });
+ push @cust_pkg,
+ qsearch( 'cust_pkg', {
+ '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;
+ }
+}
+
+=item suspended_pkgs
+
+Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
+
+=cut
+
+sub suspended_pkgs {
+ my $self = shift;
+ grep { $_->susp } $self->ncancelled_pkgs;
+}
+
+=item unflagged_suspended_pkgs
+
+Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
+customer (thouse packages without the `manual_flag' set).
+
+=cut
+
+sub unflagged_suspended_pkgs {
+ my $self = shift;
+ return $self->suspended_pkgs
+ unless dbdef->table('cust_pkg')->column('manual_flag');
+ grep { ! $_->manual_flag } $self->suspended_pkgs;
+}
+
+=item unsuspended_pkgs
+
+Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
+this customer.
+
+=cut
+
+sub unsuspended_pkgs {
+ my $self = shift;
+ grep { ! $_->susp } $self->ncancelled_pkgs;
+}
+
+=item num_cancelled_pkgs
+
+Returns the number of cancelled packages (see L<FS::cust_pkg>) 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, $sql ) = @_;
+ $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</unflagged_suspended_pkgs>
+and L<FS::cust_pkg>) 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<FS::cust_pkg>) 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 PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
+PKGPARTs (see L<FS::part_pkg>).
+
+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 PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
+listed PKGPARTs (see L<FS::part_pkg>).
+
+Returns a list: an empty list on success or a list of errors.
+
+=cut
+
+sub suspend_unless_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 cancel [ OPTION => VALUE ... ]
+
+Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
+
+Available options are: I<quiet>, I<reasonnum>, and I<ban>
+
+I<quiet> can be set true to supress email cancellation notices.
+
+# I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
+
+I<ban> can be set true to ban this customer's credit card or ACH information,
+if present.
+
+Always returns a list: an empty list on success or a list of errors.
+
+=cut
+
+sub cancel {
+ my $self = shift;
+ my %opt = @_;
+
+ 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;
+
+ }
+
+ grep { $_ } map { $_->cancel(@_) } $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 bill OPTIONS
+
+Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
+conjunction with the collect method.
+
+Options are passed as name-value pairs.
+
+Currently available options are:
+
+resetup - if set true, re-charges setup fees.
+
+time - bills the customer as if it were that time. Specified as a UNIX
+timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and
+L<Date::Parse> for conversion functions. For example:
+
+ use Date::Parse;
+ ...
+ $cust_main->bill( 'time' => str2time('April 20th, 2001') );
+
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub bill {
+ my( $self, %options ) = @_;
+ return '' if $self->payby eq 'COMP';
+ warn "$me bill customer ". $self->custnum. "\n"
+ if $DEBUG;
+
+ my $time = $options{'time'} || time;
+
+ my $error;
+
+ #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
+
+ #create a new invoice
+ #(we'll remove it later if it doesn't actually need to be generated [contains
+ # no line items] and we're inside a transaciton so nothing else will see it)
+ my $cust_bill = new FS::cust_bill ( {
+ 'custnum' => $self->custnum,
+ '_date' => $time,
+ #'charged' => $charged,
+ 'charged' => 0,
+ } );
+ $error = $cust_bill->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice for customer #". $self->custnum. ": $error";
+ }
+ my $invnum = $cust_bill->invnum;
+
+ ###
+ # find the packages which are due for billing, find out how much they are
+ # & generate invoice database.
+ ###
+
+ my( $total_setup, $total_recur ) = ( 0, 0 );
+ my %tax;
+ my @precommit_hooks = ();
+
+ foreach my $cust_pkg (
+ qsearch('cust_pkg', { 'custnum' => $self->custnum } )
+ ) {
+
+ #NO!! next if $cust_pkg->cancel;
+ next if $cust_pkg->getfield('cancel');
+
+ warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
+
+ #? to avoid use of uninitialized value errors... ?
+ $cust_pkg->setfield('bill', '')
+ unless defined($cust_pkg->bill);
+
+ my $part_pkg = $cust_pkg->part_pkg;
+
+ my %hash = $cust_pkg->hash;
+ my $old_cust_pkg = new FS::cust_pkg \%hash;
+
+ my @details = ();
+
+ ###
+ # bill setup
+ ###
+
+ my $setup = 0;
+ if ( ! $cust_pkg->setup &&
+ (
+ ( $conf->exists('disable_setup_suspended_pkgs') &&
+ ! $cust_pkg->getfield('susp')
+ ) || ! $conf->exists('disable_setup_suspended_pkgs')
+ )
+ || $options{'resetup'}
+ ) {
+
+ warn " bill setup\n" if $DEBUG > 1;
+
+ $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$@ running calc_setup for $cust_pkg\n";
+ }
+
+ $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
+ }
+
+ ###
+ # bill recurring fee
+ ###
+
+ my $recur = 0;
+ my $sdate;
+ if ( $part_pkg->getfield('freq') ne '0' &&
+ ! $cust_pkg->getfield('susp') &&
+ ( $cust_pkg->getfield('bill') || 0 ) <= $time
+ ) {
+
+ warn " bill recur\n" if $DEBUG > 1;
+
+ # XXX shared with $recur_prog
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+
+ #over two params! lets at least switch to a hashref for the rest...
+ my %param = ( 'precommit_hooks' => \@precommit_hooks, );
+
+ $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$@ running calc_recur for $cust_pkg\n";
+ }
+
+ #change this bit to use Date::Manip? CAREFUL with timezones (see
+ # mailing list archive)
+ my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($sdate) )[0,1,2,3,4,5];
+
+ #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
+ # only for figuring next bill date, nothing else, so, reset $sdate again
+ # here
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+ $cust_pkg->last_bill($sdate)
+ if $cust_pkg->dbdef_table->column('last_bill');
+
+ if ( $part_pkg->freq =~ /^\d+$/ ) {
+ $mon += $part_pkg->freq;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
+ my $weeks = $1;
+ $mday += $weeks * 7;
+ } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
+ my $days = $1;
+ $mday += $days;
+ } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
+ my $hours = $1;
+ $hour += $hours;
+ } else {
+ $dbh->rollback if $oldAutoCommit;
+ return "unparsable frequency: ". $part_pkg->freq;
+ }
+ $cust_pkg->setfield('bill',
+ timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
+ }
+
+ warn "\$setup is undefined" unless defined($setup);
+ warn "\$recur is undefined" unless defined($recur);
+ warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
+
+ ###
+ # If $cust_pkg has been modified, update it and create cust_bill_pkg records
+ ###
+
+ if ( $cust_pkg->modified ) { # hmmm.. and if the options are modified?
+
+ warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
+ if $DEBUG >1;
+
+ $error=$cust_pkg->replace($old_cust_pkg,
+ options => { $cust_pkg->options },
+ );
+ if ( $error ) { #just in case
+ $dbh->rollback if $oldAutoCommit;
+ return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
+ }
+
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
+ }
+ if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
+ }
+
+ if ( $setup != 0 || $recur != 0 ) {
+
+ warn " charges (setup=$setup, recur=$recur); adding line items\n"
+ if $DEBUG > 1;
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
+ 'invnum' => $invnum,
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'setup' => $setup,
+ 'recur' => $recur,
+ 'sdate' => $sdate,
+ 'edate' => $cust_pkg->bill,
+ 'details' => \@details,
+ });
+ $error = $cust_bill_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice line item for invoice #$invnum: $error";
+ }
+ $total_setup += $setup;
+ $total_recur += $recur;
+
+ ###
+ # handle taxes
+ ###
+
+ unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
+
+ my $prefix =
+ ( $conf->exists('tax-ship_address') && length($self->ship_last) )
+ ? 'ship_'
+ : '';
+ my %taxhash = map { $_ => $self->get("$prefix$_") }
+ qw( state county country );
+
+ $taxhash{'taxclass'} = $part_pkg->taxclass;
+
+ my @taxes = qsearch( 'cust_main_county', \%taxhash );
+
+ unless ( @taxes ) {
+ $taxhash{'taxclass'} = '';
+ @taxes = qsearch( 'cust_main_county', \%taxhash );
+ }
+
+ #one more try at a whole-country tax rate
+ unless ( @taxes ) {
+ $taxhash{$_} = '' foreach qw( state county );
+ @taxes = qsearch( 'cust_main_county', \%taxhash );
+ }
+
+ # maybe eliminate this entirely, along with all the 0% records
+ unless ( @taxes ) {
+ $dbh->rollback if $oldAutoCommit;
+ return
+ "fatal: can't find tax rate for state/county/country/taxclass ".
+ join('/', ( map $self->get("$prefix$_"),
+ qw(state county country)
+ ),
+ $part_pkg->taxclass ). "\n";
+ }
+
+ foreach my $tax ( @taxes ) {
+
+ my $taxable_charged = 0;
+ $taxable_charged += $setup
+ unless $part_pkg->setuptax =~ /^Y$/i
+ || $tax->setuptax =~ /^Y$/i;
+ $taxable_charged += $recur
+ unless $part_pkg->recurtax =~ /^Y$/i
+ || $tax->recurtax =~ /^Y$/i;
+ next unless $taxable_charged;
+
+ if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
+ #my ($mon,$year) = (localtime($sdate) )[4,5];
+ my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
+ $mon++;
+ my $freq = $part_pkg->freq || 1;
+ if ( $freq !~ /(\d+)$/ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "daily/weekly package definitions not (yet?)".
+ " compatible with monthly tax exemptions";
+ }
+ my $taxable_per_month =
+ sprintf("%.2f", $taxable_charged / $freq );
+
+ #call the whole thing off if this customer has any old
+ #exemption records...
+ my @cust_tax_exempt =
+ qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
+ if ( @cust_tax_exempt ) {
+ $dbh->rollback if $oldAutoCommit;
+ return
+ 'this customer still has old-style tax exemption records; '.
+ 'run bin/fs-migrate-cust_tax_exempt?';
+ }
+
+ foreach my $which_month ( 1 .. $freq ) {
+
+ #maintain the new exemption table now
+ my $sql = "
+ SELECT SUM(amount)
+ FROM cust_tax_exempt_pkg
+ LEFT JOIN cust_bill_pkg USING ( billpkgnum )
+ LEFT JOIN cust_bill USING ( invnum )
+ WHERE custnum = ?
+ AND taxnum = ?
+ AND year = ?
+ AND month = ?
+ ";
+ my $sth = dbh->prepare($sql) or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "fatal: can't lookup exising exemption: ". dbh->errstr;
+ };
+ $sth->execute(
+ $self->custnum,
+ $tax->taxnum,
+ 1900+$year,
+ $mon,
+ ) or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "fatal: can't lookup exising exemption: ". dbh->errstr;
+ };
+ my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
+
+ my $remaining_exemption =
+ $tax->exempt_amount - $existing_exemption;
+ if ( $remaining_exemption > 0 ) {
+ my $addl = $remaining_exemption > $taxable_per_month
+ ? $taxable_per_month
+ : $remaining_exemption;
+ $taxable_charged -= $addl;
+
+ my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
+ 'billpkgnum' => $cust_bill_pkg->billpkgnum,
+ 'taxnum' => $tax->taxnum,
+ 'year' => 1900+$year,
+ 'month' => $mon,
+ 'amount' => sprintf("%.2f", $addl ),
+ } );
+ $error = $cust_tax_exempt_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "fatal: can't insert cust_tax_exempt_pkg: $error";
+ }
+ } # if $remaining_exemption > 0
+
+ #++
+ $mon++;
+ #until ( $mon < 12 ) { $mon -= 12; $year++; }
+ until ( $mon < 13 ) { $mon -= 12; $year++; }
+
+ } #foreach $which_month
+
+ } #if $tax->exempt_amount
+
+ $taxable_charged = sprintf( "%.2f", $taxable_charged);
+
+ #$tax += $taxable_charged * $cust_main_county->tax / 100
+ $tax{ $tax->taxname || 'Tax' } +=
+ $taxable_charged * $tax->tax / 100
+
+ } #foreach my $tax ( @taxes )
+
+ } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
+
+ } #if $setup != 0 || $recur != 0
+
+ } #if $cust_pkg->modified
+
+ } #foreach my $cust_pkg
+
+ unless ( $cust_bill->cust_bill_pkg ) {
+ $cust_bill->delete; #don't create an invoice w/o line items
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+ my $charged = sprintf( "%.2f", $total_setup + $total_recur );
+
+ foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
+ my $tax = sprintf("%.2f", $tax{$taxname} );
+ $charged = sprintf( "%.2f", $charged+$tax );
+
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
+ 'invnum' => $invnum,
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ 'itemdesc' => $taxname,
+ });
+ $error = $cust_bill_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice line item for invoice #$invnum: $error";
+ }
+ $total_setup += $tax;
+
+ }
+
+ $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
+ $error = $cust_bill->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't update charged for invoice #$invnum: $error";
+ }
+
+ foreach my $hook ( @precommit_hooks ) {
+ eval {
+ &{$hook}; #($self) ?
+ };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$@ running precommit hook $hook\n";
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+}
+
+=item collect OPTIONS
+
+(Attempt to) collect money for this customer's outstanding invoices (see
+L<FS::cust_bill>). Usually used after the bill method.
+
+Depending on the value of `payby', this may print or email an invoice (I<BILL>,
+I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
+check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
+
+Most actions are now triggered by invoice events; see L<FS::part_bill_event>
+and the invoice 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:
+
+invoice_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.
+
+retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
+events.
+
+quiet - set true to surpress email card/ACH decline notices.
+
+freq - "1d" for the traditional, daily events (the default), or "1m" for the
+new monthly events
+
+payby - allows for one time override of normal customer billing method
+
+=cut
+
+sub collect {
+ my( $self, %options ) = @_;
+ my $invoice_time = $options{'invoice_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
+
+ my $balance = $self->balance;
+ warn "$me collect customer ". $self->custnum. ": balance $balance\n"
+ if $DEBUG;
+ unless ( $balance > 0 ) { #redundant?????
+ $dbh->rollback if $oldAutoCommit; #hmm
+ return '';
+ }
+
+ 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;
+ }
+ }
+
+ my $extra_sql = '';
+ if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
+ $extra_sql = " AND freq = '1m' ";
+ } else {
+ $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
+ }
+
+ foreach my $cust_bill ( $self->open_cust_bill ) {
+
+ # don't try to charge for the same invoice if it's already in a batch
+ #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
+
+ last if $self->balance <= 0;
+
+ warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
+ if $DEBUG > 1;
+
+ foreach my $part_bill_event ( due_events ( $cust_bill,
+ exists($options{'payby'})
+ ? $options{'payby'}
+ : $self->payby,
+ $invoice_time,
+ $extra_sql ) ) {
+
+ last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0
+ || $self->balance <= 0; # or if balance<=0
+
+ {
+ local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
+ warn " do_event " . $cust_bill . " ". (%options) . "\n"
+ if $DEBUG > 1;
+
+ if (my $error = $part_bill_event->do_event($cust_bill, %options)) {
+ # gah, even with transactions.
+ $dbh->commit if $oldAutoCommit; #well.
+ return $error;
+ }
+ }
+