X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=a62987b3273d2a886da3a9f9708c8cf0f0d99439;hb=8a5bf08dfcc3e44ac3c5e8015ccce494d991025e;hp=ad5b0df1f914758a467f758d822cfe82667e6d44;hpb=d01dbb663c0d58ed4294c9284106a0e46f274301;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index ad5b0df1f..a62987b32 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,30 +1,47 @@ package FS::cust_main; +require 5.006; use strict; -use vars qw( @ISA $conf $DEBUG $import ); +use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields + $import $skip_fuzzyfiles $ignore_expired_card @paytypes); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; -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);"; -} +use Exporter; +use Scalar::Util qw( blessed ); +use Time::Local qw(timelocal); +use Data::Dumper; +use Tie::IxHash; +use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; -use Business::CreditCard; -use FS::UID qw( getotaker dbh ); +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 ); -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::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_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; use FS::cust_main_county; +use FS::cust_location; +use FS::tax_rate; +use FS::cust_tax_location; +use FS::part_pkg_taxrate; use FS::agent; use FS::cust_main_invoice; use FS::cust_credit_bill; @@ -32,20 +49,36 @@ 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::cust_tax_exempt; +use FS::part_event; +use FS::part_event_condition; +#use FS::cust_event; use FS::type_pkgs; -use FS::Msgcat qw(gettext); +use FS::payment_gateway; +use FS::agent_payment_gateway; +use FS::banned_pay; +use FS::payinfo_Mixin; +use FS::TicketSystem; + +@ISA = qw( FS::payinfo_Mixin FS::Record ); -@ISA = qw( FS::Record ); +@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 $DEBUG = 0; -#$DEBUG = 1; +$me = '[FS::cust_main]'; $import = 0; +$skip_fuzzyfiles = 0; +$ignore_expired_card = 0; + +@encrypted_fields = ('payinfo', 'paycvv'); +sub nohistory_fields { ('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 { @@ -58,7 +91,7 @@ sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; if ( exists $hashref->{'pkgnum'} ) { -# #@{ $self->{'_pkgnum'} } = (); + #@{ $self->{'_pkgnum'} } = (); my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); $self->{'_pkgnum'} = $subcache; #push @{ $self->{'_pkgnum'} }, @@ -98,8 +131,6 @@ FS::cust_main - Object methods for cust_main records $error = $record->collect; $error = $record->collect %options; $error = $record->collect 'invoice_time' => $time, - 'batch_card' => 'yes', - 'report_badcard' => 'yes', ; =head1 DESCRIPTION @@ -109,83 +140,181 @@ FS::Record. The following fields are currently supported: =over 4 -=item custnum - primary key (assigned automatically for new customers) +=item custnum + +Primary key (assigned automatically for new customers) + +=item agentnum -=item agentnum - agent (see L) +Agent (see L) -=item refnum - Advertising source (see L) +=item refnum -=item first - name +Advertising source (see L) -=item last - name +=item first -=item ss - social security number (optional) +First name -=item company - (optional) +=item last + +Last name + +=item ss + +Cocial security number (optional) + +=item company + +(optional) =item address1 -=item address2 - (optional) +=item address2 + +(optional) =item city -=item county - (optional, see L) +=item county + +(optional, see L) + +=item state -=item state - (see L) +(see L) =item zip -=item country - (see L) +=item country -=item daytime - phone (optional) +(see L) -=item night - phone (optional) +=item daytime -=item fax - phone (optional) +phone (optional) -=item ship_first - name +=item night -=item ship_last - name +phone (optional) -=item ship_company - (optional) +=item fax + +phone (optional) + +=item ship_first + +Shipping first name + +=item ship_last + +Shipping last name + +=item ship_company + +(optional) =item ship_address1 -=item ship_address2 - (optional) +=item ship_address2 + +(optional) =item ship_city -=item ship_county - (optional, see L) +=item ship_county -=item ship_state - (see L) +(optional, see L) + +=item ship_state + +(see L) =item ship_zip -=item ship_country - (see L) +=item ship_country + +(see L) + +=item ship_daytime + +phone (optional) + +=item ship_night + +phone (optional) + +=item ship_fax -=item ship_daytime - phone (optional) +phone (optional) -=item ship_night - phone (optional) +=item payby -=item ship_fax - phone (optional) +Payment Type (See L for valid payby values) -=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 -=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) +Payment Information (See L for data format) -=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 +=item paymask -=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy +Masked payinfo (See L for how this works) -=item payname - name on card or billing name +=item paycvv -=item tax - tax exempt, empty or `Y' +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 otaker - order taker (assigned automatically, see L) +=item paydate -=item comments - comments (optional) +Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy -=item referral_custnum - referring customer number +=item paystart_month + +Start date month (maestro/solo cards only) + +=item paystart_year + +Start date year (maestro/solo cards only) + +=item payissue + +Issue number (maestro/solo cards only) + +=item payname + +Name on card or billing name + +=item payip + +IP address from which payment information was received + +=item tax + +Tax exempt, empty or `Y' + +=item otaker + +Order taker (assigned automatically, see L) + +=item comments + +Comments (optional) + +=item referral_custnum + +Referring customer number + +=item spool_cdr + +Enable individual CDR spooling, empty or `Y' + +=item dundate + +A suggestion to events (see L) to delay until this unix timestamp + +=item squelch_cdr + +Discourage individual CDR printing, empty or `Y' =back @@ -237,7 +366,7 @@ Currently available options are: 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 sucessfully). +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 @@ -250,7 +379,7 @@ sub insert { my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; my %options = @_; - warn "FS::cust_main::insert called with options ". + warn "$me insert called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -265,27 +394,49 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $amount = 0; - my $seconds = 0; + my $prepay_identifier = ''; + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0); + my $payby = ''; if ( $self->payby eq 'PREPAY' ) { + $self->payby('BILL'); - my $prepay_credit = qsearchs( - 'prepay_credit', - { 'identifier' => $self->payinfo }, - '', - 'FOR UPDATE' - ); - warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo - unless $prepay_credit; - $amount = $prepay_credit->amount; - $seconds = $prepay_credit->seconds; - my $error = $prepay_credit->delete; + $prepay_identifier = $self->payinfo; + $self->payinfo(''); + + warn " looking up prepaid card $prepay_identifier\n" + if $DEBUG > 1; + + my $error = $self->get_prepay( $prepay_identifier, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "removing prepay_credit (transaction rolled back): $error"; + #return "error applying prepaid card (transaction rolled back): $error"; + return $error; } + + $payby = 'PREP' if $amount; + + } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { + + $payby = $1; + $self->payby('BILL'); + $amount = $self->paid; + } + warn " inserting $self\n" + if $DEBUG > 1; + + $self->signupdate(time) unless $self->signupdate; + + $self->auto_agent_custid() + if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -293,18 +444,43 @@ sub insert { return $error; } - # invoicing list + warn " setting invoicing list\n" + if $DEBUG > 1; + if ( $invoicing_list ) { $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 ); } - # packages - $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); + if ( $conf->config('cust_main-skeleton_tables') + && $conf->config('cust_main-skeleton_custnum') ) { + + warn " inserting skeleton records\n" + if $DEBUG > 1; + + my $error = $self->start_copy_skel; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + warn " ordering packages\n" + if $DEBUG > 1; + + $error = $self->order_pkgs( $cust_pkgs, + %options, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -314,36 +490,307 @@ sub insert { $dbh->rollback if $oldAutoCommit; return "No svc_acct record to apply pre-paid time"; } + if ( $upbytes || $downbytes || $totalbytes ) { + $dbh->rollback if $oldAutoCommit; + return "No svc_acct record to apply pre-paid data"; + } if ( $amount ) { - my $cust_credit = new FS::cust_credit { - 'custnum' => $self->custnum, - 'amount' => $amount, - }; - $error = $cust_credit->insert; + warn " inserting initial $payby payment of $amount\n" + if $DEBUG > 1; + $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting payment (transaction rolled back): $error"; + } + } + + unless ( $import || $skip_fuzzyfiles ) { + warn " queueing fuzzyfiles update\n" + if $DEBUG > 1; + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; + } + } + + warn " insert complete; committing transaction\n" + if $DEBUG > 1; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +use File::CounterFile; +sub auto_agent_custid { + my $self = shift; + + my $format = $conf->config('cust_main-auto_agent_custid'); + my $agent_custid; + if ( $format eq '1YMMXXXXXXXX' ) { + + my $counter = new File::CounterFile 'cust_main.agent_custid'; + $counter->lock; + + my $ym = 100000000000 + time2str('%y%m00000000', time); + if ( $ym > $counter->value ) { + $counter->{'value'} = $agent_custid = $ym; + $counter->{'updated'} = 1; + } else { + $agent_custid = $counter->inc; + } + + $counter->unlock; + + } else { + die "Unknown cust_main-auto_agent_custid format: $format"; + } + + $self->agent_custid($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). + +=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'}; + + 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 credit (transaction rolled back): $error"; + return "inserting cust_location (transaction rolled back): $error"; } + $cust_pkg->locationnum($opt->{'cust_location'}->locationnum); } - $error = $self->queue_fuzzyfiles_update; + $cust_pkg->custnum( $self->custnum ); + + my $error = $cust_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; + 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 } -=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] +#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 a package -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: +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 @@ -351,14 +798,18 @@ be a better explanation of this, but until then, here's an example: $cust_pkg => [ $svc_acct ], ... ); - $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); -Currently available options are: I and I. +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 sucessfully). +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 @@ -366,17 +817,20 @@ 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 = shift; + my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated my %options = @_; - my %svc_options = (); - $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} - if exists $options{'depend_jobnum'}; - warn "FS::cust_main::order_pkgs called with options ". + $seconds_ref ||= $options{'seconds_ref'}; + + warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -394,47 +848,44 @@ sub order_pkgs { local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - my $error = $cust_pkg->insert; + + 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 "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $$seconds ); - $$seconds = 0; - } - $error = $svc_something->insert(%svc_options); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } + return $error; } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } -=item reexport +=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] -This method is deprecated. See the I option to the insert and -order_pkgs methods for a better way to defer provisioning. +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. -Re-schedules all exports by calling the B method of all associated -packages (see L). If there is an error, returns the error; -otherwise returns false. +Optionally, five scalar references can be passed as well. They will have their +values filled in with the amount, number of seconds, and number of upload, +download, and total bytes applied by this prepaid card. =cut -sub reexport { - my $self = shift; - - carp "warning: FS::cust_main::reexport is deprectated; ". - "use the depend_jobnum option to insert or order_pkgs to delay export"; +#the ref bullshit here should be refactored like get_prepay. MyAccount.pm is +#the only place that uses these args +sub recharge_prepay { + my( $self, $prepay_credit, $amountref, $secondsref, + $upbytesref, $downbytesref, $totalbytesref ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -447,41 +898,59 @@ sub reexport { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - foreach my $cust_pkg ( $self->ncancelled_pkgs ) { - my $error = $cust_pkg->reexport; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); + + my $error = $self->get_prepay( $prepay_credit, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$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 + : $prepay_credit + ); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } + 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; ''; } -=item delete NEW_CUSTNUM +=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ] -This deletes the customer. If there is an error, returns the error, otherwise -returns false. +Looks up and deletes a prepaid card (see L), +specified either by I or as an FS::prepay_credit object. -This will completely remove all traces of the customer record. This is not -what you want when a customer cancels service; for that, cancel all of the -customer's packages (see L). +Available options are: I, I, I, I, and I. The scalars (provided by references) will be +incremented by the values of the prepaid card. -If the customer has any uncancelled packages, you need to pass a new (valid) -customer number for those packages to be transferred to. Cancelled packages -will be deleted. Did I mention that this is NOT what you want when a customer -cancels service and that you really should be looking see L? +If the prepaid card specifies an I (see L), it is used to +check or set this customer's I. -You can't delete a customer with invoices (see L), -or credits (see L), payments (see L) or -refunds (see L). +If there is an error, returns the error, otherwise returns false. =cut -sub delete { - my $self = shift; + +sub get_prepay { + my( $self, $prepay_credit, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -494,7 +963,270 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( $self->cust_bill ) { + unless ( ref($prepay_credit) ) { + + my $identifier = $prepay_credit; + + $prepay_credit = qsearchs( + 'prepay_credit', + { 'identifier' => $prepay_credit }, + '', + 'FOR UPDATE' + ); + + unless ( $prepay_credit ) { + $dbh->rollback if $oldAutoCommit; + return "Invalid prepaid card: ". $identifier; + } + + } + + if ( $prepay_credit->agentnum ) { + if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) { + $dbh->rollback if $oldAutoCommit; + return "prepaid card not valid for agent ". $self->agentnum; + } + $self->agentnum($prepay_credit->agentnum); + } + + my $error = $prepay_credit->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "removing prepay_credit (transaction rolled back): $error"; + } + + ${ $opt{$_.'_ref'} } += $prepay_credit->$_() + for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes 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 +the specified number of seconds. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_seconds { + _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; + + if ( ! @cust_pkg ) { + return 'No packages with primary or single services found'. + ' to apply pre-paid time'; + } elsif ( scalar(@cust_pkg) > 1 ) { + #maybe have a way to specify the package/account? + return 'Multiple packages found to apply pre-paid time'; + } + + my $cust_pkg = $cust_pkg[0]; + warn " found package pkgnum ". $cust_pkg->pkgnum. "\n" + if $DEBUG > 1; + + my @cust_svc = + $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') ); + + if ( ! @cust_svc ) { + return 'No account found to apply pre-paid time'; + } elsif ( scalar(@cust_svc) > 1 ) { + return 'Multiple accounts found to apply pre-paid time'; + } + + my $svc_acct = $cust_svc[0]->svc_x; + warn " found service svcnum ". $svc_acct->pkgnum. + ' ('. $svc_acct->email. ")\n" + if $DEBUG > 1; + + $column = "increment_$column"; + $svc_acct->$column($amount); + +} + +=item insert_cust_pay_prepay AMOUNT [ PAYINFO ] + +Inserts a prepayment in the specified amount for this customer. An optional +second argument can specify the prepayment identifier for tracking purposes. +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_prepay { + shift->insert_cust_pay('PREP', @_); +} + +=item insert_cust_pay_cash AMOUNT [ PAYINFO ] + +Inserts a cash payment in the specified amount for this customer. An optional +second argument can specify the payment identifier for tracking purposes. +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_cash { + shift->insert_cust_pay('CASH', @_); +} + +=item insert_cust_pay_west AMOUNT [ PAYINFO ] + +Inserts a Western Union payment in the specified amount for this customer. An +optional second argument can specify the prepayment identifier for tracking +purposes. If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_west { + shift->insert_cust_pay('WEST', @_); +} + +sub insert_cust_pay { + my( $self, $payby, $amount ) = splice(@_, 0, 3); + my $payinfo = scalar(@_) ? shift : ''; + + my $cust_pay = new FS::cust_pay { + 'custnum' => $self->custnum, + 'paid' => sprintf('%.2f', $amount), + #'_date' => #date the prepaid card was purchased??? + 'payby' => $payby, + 'payinfo' => $payinfo, + }; + $cust_pay->insert; + +} + +=item reexport + +This method is deprecated. See the I option to the insert and +order_pkgs methods for a better way to defer provisioning. + +Re-schedules all exports by calling the B method of all associated +packages (see L). If there is an error, returns the error; +otherwise returns false. + +=cut + +sub reexport { + my $self = shift; + + carp "WARNING: FS::cust_main::reexport is deprectated; ". + "use the depend_jobnum option to insert or order_pkgs to delay export"; + + 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; + + foreach my $cust_pkg ( $self->ncancelled_pkgs ) { + my $error = $cust_pkg->reexport; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item delete NEW_CUSTNUM + +This deletes the customer. If there is an error, returns the error, otherwise +returns false. + +This will completely remove all traces of the customer record. This is not +what you want when a customer cancels service; for that, cancel all of the +customer's packages (see L). + +If the customer has any uncancelled packages, you need to pass a new (valid) +customer number for those packages to be transferred to. Cancelled packages +will be deleted. Did I mention that this is NOT what you want when a customer +cancels service and that you really should be looking see L? + +You can't delete a customer with invoices (see L), +or credits (see L), payments (see L) or +refunds (see L). + +=cut + +sub delete { + my $self = shift; + + 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 ( $self->cust_bill ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with invoices"; } @@ -522,7 +1254,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; @@ -559,7 +1293,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. @@ -575,9 +1309,30 @@ 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; + + my $curuser = $FS::CurrentUser::CurrentUser; + if ( $self->payby eq 'COMP' + && $self->payby ne $old->payby + && ! $curuser->access_right('Complimentary customer') + ) + { + return "You are not permitted to create complimentary accounts."; + } + + local($ignore_expired_card) = 1 + if $old->payby =~ /^(CARD|DCRD)$/ + && $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'; @@ -585,12 +1340,6 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - if ( $self->payby eq 'COMP' && $self->payby ne $old->payby - && $conf->config('users-allow_comp') ) { - return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); - } - my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -622,10 +1371,12 @@ sub replace { } } - $error = $self->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; + unless ( $import || $skip_fuzzyfiles ) { + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; + } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -654,15 +1405,19 @@ sub queue_fuzzyfiles_update { my $dbh = dbh; my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert($self->getfield('last'), $self->company); + my $error = $queue->insert( map $self->getfield($_), + qw(first last company) + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } - if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { + if ( $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('ship_last'), $self->ship_company); + $error = $queue->insert( map $self->getfield("ship_$_"), + qw(first last company) + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -678,21 +1433,26 @@ sub queue_fuzzyfiles_update { Checks all fields to make sure this is a valid customer record. If there is an error, returns the error, otherwise returns false. Called by the insert -and repalce methods. +and replace methods. =cut sub check { my $self = shift; - #warn "BEFORE: \n". $self->_dump; + warn "$me check BEFORE: \n". $self->_dump + if $DEBUG > 2; my $error = $self->ut_numbern('custnum') || $self->ut_number('agentnum') + || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_textn('custbatch') || $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') @@ -702,7 +1462,12 @@ 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') + || $self->ut_alphan('geocode') ; + #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; @@ -714,7 +1479,7 @@ sub check { return "Unknown refnum" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); - return "Unknown referring custnum ". $self->referral_custnum + return "Unknown referring custnum: ". $self->referral_custnum unless ! $self->referral_custnum || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); @@ -753,65 +1518,107 @@ 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 qsearchs('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)$/ + #$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; - $self->payby($1); - if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) { + $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; @@ -821,32 +1628,77 @@ sub check { $self->payinfo($payinfo); validate($payinfo) or return gettext('invalid_card'); # . ": ". $self->payinfo; + return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; - if ( defined $self->dbdef_table->column('paycvv') ) { - if ( length($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); - } + + 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(''); + $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 ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) { + } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@]//g; - $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; + 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('') if $self->dbdef_table->column('paycvv'); + $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' ) { @@ -855,24 +1707,27 @@ 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' ) { - if ( !$self->custnum && $conf->config('users-allow_comp') ) { + my $curuser = $FS::CurrentUser::CurrentUser; + if ( ! $self->custnum + && ! $curuser->access_right('Complimentary customer') + ) + { return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); } $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' ) { @@ -883,19 +1738,19 @@ 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(''); } if ( $self->paydate eq '' || $self->paydate eq '-' ) { - return "Expriation date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/; + 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{2})[\/\-]\d+$/ ) { + } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { ( $m, $y ) = ( $3, "20$2" ); } else { return "Illegal expiration date: ". $self->paydate; @@ -903,7 +1758,9 @@ sub check { $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') - if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); + if !$import + && !$ignore_expired_card + && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && @@ -912,58 +1769,168 @@ sub check { ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { - $self->payname =~ /^([\w \,\.\-\']+)$/ + $self->payname =~ /^([\w \,\.\-\'\&]+)$/ or return gettext('illegal_name'). " payname: ". $self->payname; $self->payname($1); } - $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax; - $self->tax($1); + foreach my $flag (qw( tax spool_cdr squelch_cdr )) { + $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); + $self->$flag($1); + } $self->otaker(getotaker) unless $self->otaker; - #warn "AFTER: \n". $self->_dump; + warn "$me check AFTER: \n". $self->_dump + if $DEBUG > 2; $self->SUPER::check; } -=item all_pkgs +=item addr_fields -Returns all packages (see L) for this customer. +Returns a list of fields which have ship_ duplicates. =cut -sub all_pkgs { - my $self = shift; - if ( $self->{'_pkgnum'} ) { - values %{ $self->{'_pkgnum'}->cache }; - } else { - qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); - } +sub addr_fields { + qw( last first company + address1 address2 city county state zip country + daytime night fax + ); } -=item ncancelled_pkgs +=item has_ship_address -Returns all non-cancelled packages (see L) for this customer. +Returns true if this customer record has a separate shipping address. =cut -sub ncancelled_pkgs { +sub has_ship_address { my $self = shift; - if ( $self->{'_pkgnum'} ) { - grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; - } else { - @{ [ # force list context - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ] }; + scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); +} + +=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. + +=cut + +sub cust_location { + my $self = shift; + qsearch('cust_location', { 'custnum' => $self->custnum } ); +} + +=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] + +Returns all non-cancelled packages (see L) for this customer. + +=cut + +sub ncancelled_pkgs { + 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 ) '; + + @cust_pkg = $self->_cust_pkg($extra_qsearch); + + } + + sort sort_packages @cust_pkg; + +} + +sub _cust_pkg { + 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 }, + }); + +} + +# This should be generalized to use config options to determine order. +sub sort_packages { + + 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; + $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; } + } =item suspended_pkgs @@ -1003,6 +1970,32 @@ sub unsuspended_pkgs { grep { ! $_->susp } $self->ncancelled_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 @@ -1019,475 +2012,332 @@ sub unsuspend { =item suspend Suspends all unsuspended packages (see L) for this customer. -Always 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 sub suspend { my $self = shift; - grep { $_->suspend } $self->unsuspended_pkgs; + grep { $_->suspend(@_) } $self->unsuspended_pkgs; } -=item cancel [ OPTION => VALUE ... ] +=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] -Cancels all uncancelled packages (see L) for this customer. +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 -Available options are: I +=item pkgparts - listref of pkgparts -I can be set true to supress email cancellation notices. +=item (other options are passed to the suspend method) + +=back -Always 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 -sub cancel { +sub suspend_if_pkgpart { my $self = shift; - grep { $_ } map { $_->cancel(@_) } $self->ncancelled_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 agent +=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] -Returns the agent (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: + +=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 agent { +sub suspend_unless_pkgpart { my $self = shift; - qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); + 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 bill OPTIONS +=item cancel [ OPTION => VALUE ... ] -Generates invoices (see L) for this customer. Usually used in -conjunction with the collect method. +Cancels all uncancelled packages (see L) for this customer. -Options are passed as name-value pairs. +Available options are: -Currently available options are: +=over 4 -resetup - if set true, re-charges setup fees. +=item quiet - can be set true to supress email cancellation notices. -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: +=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. - use Date::Parse; - ... - $cust_main->bill( 'time' => str2time('April 20th, 2001') ); +=item ban - can be set true to ban this customer's credit card or ACH information, if present. +=back -If there is an error, returns the error, otherwise returns false. +Always returns a list: an empty list on success or a list of errors. =cut -sub bill { - my( $self, %options ) = @_; - my $time = $options{'time'} || time; +sub cancel { + my( $self, %opt ) = @_; - my $error; + warn "$me cancel called on customer ". $self->custnum. " with options ". + join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" + if $DEBUG; - #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'; + return ( 'access denied' ) + unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; + if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { - $self->select_for_update; #mutex + #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); - # 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( $taxable_setup, $taxable_recur ) = ( 0, 0 ); - my @cust_bill_pkg = (); - #my $tax = 0;## - #my $taxable_charged = 0;## - #my $charged = 0;## + my $ban = new FS::banned_pay $self->_banned_pay_hashref; + my $error = $ban->insert; + return ( $error ) if $error; - my %tax; + } - foreach my $cust_pkg ( - qsearch('cust_pkg', { 'custnum' => $self->custnum } ) - ) { + my @pkgs = $self->ncancelled_pkgs; - #NO!! next if $cust_pkg->cancel; - next if $cust_pkg->getfield('cancel'); + warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". + scalar(@pkgs). " packages for customer ". $self->custnum. "\n" + if $DEBUG; - #? to avoid use of uninitialized value errors... ? - $cust_pkg->setfield('bill', '') - unless defined($cust_pkg->bill); - - my $part_pkg = $cust_pkg->part_pkg; + grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs; +} - #so we don't modify cust_pkg record unnecessarily - my $cust_pkg_mod_flag = 0; - my %hash = $cust_pkg->hash; - my $old_cust_pkg = new FS::cust_pkg \%hash; +sub _banned_pay_hashref { + my $self = shift; - my @details = (); + my %payby2ban = ( + 'CARD' => 'CARD', + 'DCRD' => 'CARD', + 'CHEK' => 'CHEK', + 'DCHK' => 'CHEK' + ); - # bill setup - my $setup = 0; - if ( !$cust_pkg->setup || $options{'resetup'} ) { - my $setup_prog = $part_pkg->getfield('setup'); - $setup_prog =~ /^(.*)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal setup for pkgpart ". $part_pkg->pkgpart. - ": $setup_prog"; - }; - $setup_prog = $1; - $setup_prog = '0' if $setup_prog =~ /^\s*$/; - - #my $cpt = new Safe; - ##$cpt->permit(); #what is necessary? - #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - #$setup = $cpt->reval($setup_prog); - $setup = eval $setup_prog; - unless ( defined($setup) ) { - $dbh->rollback if $oldAutoCommit; - return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. - "(expression $setup_prog): $@"; - } - $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; - $cust_pkg_mod_flag=1; - } + { + 'payby' => $payby2ban{$self->payby}, + 'payinfo' => md5_base64($self->payinfo), + #don't ever *search* on reason! #'reason' => + }; +} - #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 - ) { - my $recur_prog = $part_pkg->getfield('recur'); - $recur_prog =~ /^(.*)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal recur for pkgpart ". $part_pkg->pkgpart. - ": $recur_prog"; - }; - $recur_prog = $1; - $recur_prog = '0' if $recur_prog =~ /^\s*$/; +=item notes - # shared with $recur_prog - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; +Returns all notes (see L) for this customer. - #my $cpt = new Safe; - ##$cpt->permit(); #what is necessary? - #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - #$recur = $cpt->reval($recur_prog); - $recur = eval $recur_prog; - unless ( defined($recur) ) { - $dbh->rollback if $oldAutoCommit; - return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart. - "(expression $recur_prog): $@"; - } - #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]; +=cut - #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; - } else { - $dbh->rollback if $oldAutoCommit; - return "unparsable frequency: ". $part_pkg->freq; - } - $cust_pkg->setfield('bill', - timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year)); - $cust_pkg_mod_flag = 1; - } +sub notes { + my $self = shift; + #order by? + qsearch( 'cust_main_note', + { 'custnum' => $self->custnum }, + '', + 'ORDER BY _DATE DESC' + ); +} - 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); +=item agent - if ( $cust_pkg_mod_flag ) { - $error=$cust_pkg->replace($old_cust_pkg); - 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 ) { - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'recur' => $recur, - 'sdate' => $sdate, - 'edate' => $cust_pkg->bill, - 'details' => \@details, - }); - push @cust_bill_pkg, $cust_bill_pkg; - $total_setup += $setup; - $total_recur += $recur; - - unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { - - my @taxes = qsearch( 'cust_main_county', { - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => $part_pkg->taxclass, - } ); - unless ( @taxes ) { - @taxes = qsearch( 'cust_main_county', { - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => '', - } ); - } - - #one more try at a whole-country tax rate - unless ( @taxes ) { - @taxes = qsearch( 'cust_main_county', { - 'state' => '', - 'county' => '', - 'country' => $self->country, - 'taxclass' => '', - } ); - } - - # 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->$_(), 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 > 0 ) { - my ($mon,$year) = (localtime($sdate) )[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 ); - foreach my $which_month ( 1 .. $freq ) { - my %hash = ( - 'custnum' => $self->custnum, - 'taxnum' => $tax->taxnum, - 'year' => 1900+$year, - 'month' => $mon++, - ); - #until ( $mon < 12 ) { $mon -= 12; $year++; } - until ( $mon < 13 ) { $mon -= 12; $year++; } - my $cust_tax_exempt = - qsearchs('cust_tax_exempt', \%hash) - || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } ); - my $remaining_exemption = sprintf("%.2f", - $tax->exempt_amount - $cust_tax_exempt->amount ); - if ( $remaining_exemption > 0 ) { - my $addl = $remaining_exemption > $taxable_per_month - ? $taxable_per_month - : $remaining_exemption; - $taxable_charged -= $addl; - my $new_cust_tax_exempt = new FS::cust_tax_exempt ( { - $cust_tax_exempt->hash, - 'amount' => - sprintf("%.2f", $cust_tax_exempt->amount + $addl), - } ); - $error = $new_cust_tax_exempt->exemptnum - ? $new_cust_tax_exempt->replace($cust_tax_exempt) - : $new_cust_tax_exempt->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "fatal: can't update cust_tax_exempt: $error"; - } - - } # if $remaining_exemption > 0 - - } #foreach $which_month - - } #if $tax->exempt_amount +Returns the agent (see L) for this customer. - $taxable_charged = sprintf( "%.2f", $taxable_charged); +=cut - #$tax += $taxable_charged * $cust_main_county->tax / 100 - $tax{ $tax->taxname || 'Tax' } += - $taxable_charged * $tax->tax / 100 +sub agent { + my $self = shift; + qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); +} - } #foreach my $tax ( @taxes ) +=item bill_and_collect - } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP' +Cancels and suspends any packages due, generates bills, applies payments and +cred - } #if $setup != 0 || $recur != 0 - - } #if $cust_pkg_mod_flag +Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.) - } #foreach my $cust_pkg +Options are passed as name-value pairs. Currently available options are: - my $charged = sprintf( "%.2f", $total_setup + $total_recur ); -# my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur ); +=over 4 - unless ( @cust_bill_pkg ) { #don't create invoices with no line items - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; - } +=item time -# unless ( $self->tax =~ /Y/i -# || $self->payby eq 'COMP' -# || $taxable_charged == 0 ) { -# my $cust_main_county = qsearchs('cust_main_county',{ -# 'state' => $self->state, -# 'county' => $self->county, -# 'country' => $self->country, -# } ) or die "fatal: can't find tax rate for state/county/country ". -# $self->state. "/". $self->county. "/". $self->country. "\n"; -# my $tax = sprintf( "%.2f", -# $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) -# ); - - if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema - - 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 ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $taxname, - }); - push @cust_bill_pkg, $cust_bill_pkg; - } - - } else { #1.4 schema +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: - my $tax = 0; - foreach ( values %tax ) { $tax += $_ }; - $tax = sprintf("%.2f", $tax); - if ( $tax > 0 ) { - $charged = sprintf( "%.2f", $charged+$tax ); + use Date::Parse; + ... + $cust_main->bill( 'time' => str2time('April 20th, 2001') ); - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - }); - push @cust_bill_pkg, $cust_bill_pkg; - } +=item invoice_time - } +Used in conjunction with the I