X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=2b94dca3343062e506782e164e7ae7ef04d7cda4;hb=2b8ffc98529637ffddfe7cbf6b4f9b8deb90f0fa;hp=3e767d9f0277f9cb844d8294c2d79215127799f5;hpb=3bd1b2b68adbb67f90addd668132d3d3e9adb698;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 3e767d9f0..2b94dca33 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -9,14 +9,12 @@ use Safe; use Carp; use Exporter; use Scalar::Util qw( blessed ); -use Time::Local qw(timelocal_nocheck); +use Time::Local qw(timelocal timelocal_nocheck); use Data::Dumper; use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; -use Date::Parse; #use Date::Manip; -use File::Slurp qw( slurp ); use File::Temp qw( tempfile ); use String::Approx qw(amatch); use Business::CreditCard 0.28; @@ -38,7 +36,9 @@ use FS::cust_credit; use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; +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; @@ -135,101 +135,181 @@ FS::Record. The following fields are currently supported: =over 4 -=item custnum - primary key (assigned automatically for new customers) +=item custnum -=item agentnum - agent (see L) +Primary key (assigned automatically for new customers) -=item refnum - Advertising source (see L) +=item agentnum + +Agent (see L) + +=item refnum + +Advertising source (see L) + +=item first -=item first - name +First name -=item last - name +=item last -=item ss - social security number (optional) +Last name -=item company - (optional) +=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 - (see L) +=item state + +(see L) =item zip -=item country - (see L) +=item country + +(see L) + +=item daytime + +phone (optional) + +=item night -=item daytime - phone (optional) +phone (optional) -=item night - phone (optional) +=item fax -=item fax - phone (optional) +phone (optional) -=item ship_first - name +=item ship_first -=item ship_last - name +Shipping first name -=item ship_company - (optional) +=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 + +phone (optional) -=item ship_daytime - phone (optional) +=item payby -=item ship_night - phone (optional) +Payment Type (See L for valid payby values) -=item ship_fax - phone (optional) +=item payinfo -=item payby - Payment Type (See L for valid payby values) +Payment Information (See L for data format) -=item payinfo - Payment Information (See L for data format) +=item paymask -=item paymask - Masked payinfo (See L for how this works) +Masked payinfo (See L for how this works) =item paycvv Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card -=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy +=item paydate + +Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy + +=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 -=item paystart_month - start date month (maestro/solo cards only) +Name on card or billing name -=item paystart_year - start date year (maestro/solo cards only) +=item payip -=item payissue - issue number (maestro/solo cards only) +IP address from which payment information was received -=item payname - name on card or billing name +=item tax -=item payip - IP address from which payment information was received +Tax exempt, empty or `Y' -=item tax - tax exempt, empty or `Y' +=item otaker -=item otaker - order taker (assigned automatically, see L) +Order taker (assigned automatically, see L) -=item comments - comments (optional) +=item comments -=item referral_custnum - referring customer number +Comments (optional) -=item spool_cdr - Enable individual CDR spooling, empty or `Y' +=item referral_custnum -=item dundate - a suggestion to events (see L) to delay until this unix timestamp +Referring customer number -=item squelch_cdr - Discourage individual CDR printing, empty or `Y' +=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 @@ -1264,6 +1344,7 @@ sub check { || $self->ut_textn('stateid') || $self->ut_textn('stateid_state') || $self->ut_textn('invoice_terms') + || $self->ut_alphan('geocode') ; #barf. need message catalogs. i18n. etc. @@ -2099,6 +2180,7 @@ sub bill { if $DEBUG; my $time = $options{'time'} || time; + my $invoice_time = $options{'invoice_time'} || $time; #put below somehow? local $SIG{HUP} = 'IGNORE'; @@ -2209,7 +2291,11 @@ sub bill { foreach my $tax ( keys %taxlisthash ) { my $tax_object = shift @{ $taxlisthash{$tax} }; warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2; - my $listref_or_error = $tax_object->taxline( @{ $taxlisthash{$tax} } ); + my $listref_or_error = + $tax_object->taxline( $taxlisthash{$tax}, + 'custnum' => $self->custnum, + 'invoice_time' => $invoice_time + ); unless (ref($listref_or_error)) { $dbh->rollback if $oldAutoCommit; return $listref_or_error; @@ -2219,15 +2305,26 @@ sub bill { warn "adding ". $listref_or_error->[1]. " as ". $listref_or_error->[0]. "\n" if $DEBUG > 2; - $tax{ $tax_object->taxname } += $listref_or_error->[1]; + $tax{ $tax } += $listref_or_error->[1]; if ( $taxname{ $listref_or_error->[0] } ) { - push @{ $taxname{ $listref_or_error->[0] } }, $tax_object->taxname; + push @{ $taxname{ $listref_or_error->[0] } }, $tax; }else{ - $taxname{ $listref_or_error->[0] } = [ $tax_object->taxname ]; + $taxname{ $listref_or_error->[0] } = [ $tax ]; } } + #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit + my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg; + foreach my $tax ( keys %taxlisthash ) { + foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) { + next unless ref($_) eq 'FS::cust_bill_pkg'; # shouldn't happen + + push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, + splice( @{ $_->_cust_tax_exempt_pkg } ); + } + } + #some taxes are taxed my %totlisthash; @@ -2247,9 +2344,9 @@ sub bill { # existing taxes warn "adding $totname to taxed taxes\n" if $DEBUG > 2; if ( exists( $totlisthash{ $totname } ) ) { - push @{ $totlisthash{ $totname } }, $tax{ $tax_object->taxname }; + push @{ $totlisthash{ $totname } }, $tax{ $tax }; }else{ - $totlisthash{ $totname } = [ $tot, $tax{ $tax_object->taxname } ]; + $totlisthash{ $totname } = [ $tot, $tax{ $tax } ]; } } } @@ -2259,7 +2356,11 @@ sub bill { my $tax_object = shift @{ $totlisthash{$tax} }; warn "found previously found taxed tax ". $tax_object->taxname. "\n" if $DEBUG > 2; - my $listref_or_error = $tax_object->taxline( @{ $totlisthash{$tax} } ); + my $listref_or_error = + $tax_object->taxline( $totlisthash{$tax}, + 'custnum' => $self->custnum, + 'invoice_time' => $invoice_time + ); unless (ref($listref_or_error)) { $dbh->rollback if $oldAutoCommit; return $listref_or_error; @@ -2268,7 +2369,7 @@ sub bill { warn "adding taxed tax amount ". $listref_or_error->[1]. " as ". $tax_object->taxname. "\n" if $DEBUG; - $tax{ $tax_object->taxname } += $listref_or_error->[1]; + $tax{ $tax } += $listref_or_error->[1]; } #consolidate and create tax line items @@ -2279,6 +2380,7 @@ sub bill { warn "adding $taxname\n" if $DEBUG > 1; foreach my $taxitem ( @{ $taxname{$taxname} } ) { $tax += $tax{$taxitem} unless $seen{$taxitem}; + $seen{$taxitem} = 1; warn "adding $tax{$taxitem}\n" if $DEBUG > 1; } next unless $tax; @@ -2302,7 +2404,7 @@ sub bill { #create the new invoice my $cust_bill = new FS::cust_bill ( { 'custnum' => $self->custnum, - '_date' => ( $options{'invoice_time'} || $time ), + '_date' => ( $invoice_time ), 'charged' => $charged, } ); my $error = $cust_bill->insert; @@ -2652,7 +2754,7 @@ sub _handle_taxes { my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; foreach my $key (keys %tax_cust_bill_pkg) { - my @taxes = @{ $taxes{$key} }; + my @taxes = @{ $taxes{$key} || [] }; my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key}; foreach my $tax ( @taxes ) { @@ -2883,6 +2985,11 @@ Only return events for the specified eventtable (by default, events of all event Explicitly pass the objects to be tested (typically used with eventtable). +=item testonly + +Set to true to return the objects, but not actually insert them into the +database. + =back =cut @@ -2913,7 +3020,8 @@ sub due_cust_event { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $self->select_for_update; #mutex + $self->select_for_update #mutex + unless $opt{testonly}; ### # 1: find possible events (initial search) @@ -4248,7 +4356,9 @@ sub batch_card { die $error; } - my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments; + my $unapplied = $self->total_unapplied_credits + + $self->total_unapplied_payments + + $self->in_transit_payments; foreach my $cust_bill ($self->open_cust_bill) { #$dbh->commit or die $dbh->errstr if $oldAutoCommit; my $cust_bill_pay_batch = new FS::cust_bill_pay_batch { @@ -4275,39 +4385,6 @@ sub batch_card { ''; } -=item total_owed - -Returns the total owed for this customer on all invoices -(see L). - -=cut - -sub total_owed { - my $self = shift; - $self->total_owed_date(2145859200); #12/31/2037 -} - -=item total_owed_date TIME - -Returns the total owed for this customer on all invoices with date earlier than -TIME. TIME is specified as a UNIX timestamp; see L). Also -see L and L for conversion functions. - -=cut - -sub total_owed_date { - my $self = shift; - my $time = shift; - my $total_bill = 0; - foreach my $cust_bill ( - grep { $_->_date <= $time } - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) - ) { - $total_bill += $cust_bill->owed; - } - sprintf( "%.2f", $total_bill ); -} - =item apply_payments_and_credits Applies unapplied payments and credits. @@ -4377,7 +4454,7 @@ sub apply_credits { $self->select_for_update; #mutex - unless ( $self->total_credited ) { + unless ( $self->total_unapplied_credits ) { $dbh->commit or die $dbh->errstr if $oldAutoCommit; return 0; } @@ -4418,11 +4495,11 @@ sub apply_credits { } - my $total_credited = $self->total_credited; + my $total_unapplied_credits = $self->total_unapplied_credits; $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return $total_credited; + return $total_unapplied_credits; } =item apply_payments @@ -4454,11 +4531,13 @@ sub apply_payments { #return 0 unless - my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 } - qsearch('cust_pay', { 'custnum' => $self->custnum } ) ); + my @payments = sort { $b->_date <=> $a->_date } + grep { $_->unapplied > 0 } + $self->cust_pay; - my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 } - qsearch('cust_bill', { 'custnum' => $self->custnum } ) ); + my @invoices = sort { $a->_date <=> $b->_date} + grep { $_->owed > 0 } + $self->cust_bill; my $payment; @@ -4497,21 +4576,72 @@ sub apply_payments { return $total_unapplied_payments; } -=item total_credited +=item total_owed + +Returns the total owed for this customer on all invoices +(see L). + +=cut + +sub total_owed { + my $self = shift; + $self->total_owed_date(2145859200); #12/31/2037 +} + +=item total_owed_date TIME + +Returns the total owed for this customer on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L). Also +see L and L for conversion functions. + +=cut + +sub total_owed_date { + my $self = shift; + my $time = shift; + my $total_bill = 0; + foreach my $cust_bill ( + grep { $_->_date <= $time } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { + $total_bill += $cust_bill->owed; + } + sprintf( "%.2f", $total_bill ); +} + +=item total_paid + +Returns the total amount of all payments. + +=cut + +sub total_paid { + my $self = shift; + my $total = 0; + $total += $_->paid foreach $self->cust_pay; + sprintf( "%.2f", $total ); +} + +=item total_unapplied_credits Returns the total outstanding credit (see L) for this customer. See L. +=item total_credited + +Old name for total_unapplied_credits. Don't use. + =cut sub total_credited { + #carp "total_credited deprecated, use total_unapplied_credits"; + shift->total_unapplied_credits(@_); +} + +sub total_unapplied_credits { my $self = shift; my $total_credit = 0; - foreach my $cust_credit ( qsearch('cust_credit', { - 'custnum' => $self->custnum, - } ) ) { - $total_credit += $cust_credit->credited; - } + $total_credit += $_->credited foreach $self->cust_credit; sprintf( "%.2f", $total_credit ); } @@ -4525,11 +4655,7 @@ See L. sub total_unapplied_payments { my $self = shift; my $total_unapplied = 0; - foreach my $cust_pay ( qsearch('cust_pay', { - 'custnum' => $self->custnum, - } ) ) { - $total_unapplied += $cust_pay->unapplied; - } + $total_unapplied += $_->unapplied foreach $self->cust_pay; sprintf( "%.2f", $total_unapplied ); } @@ -4543,18 +4669,14 @@ customer. See L. sub total_unapplied_refunds { my $self = shift; my $total_unapplied = 0; - foreach my $cust_refund ( qsearch('cust_refund', { - 'custnum' => $self->custnum, - } ) ) { - $total_unapplied += $cust_refund->unapplied; - } + $total_unapplied += $_->unapplied foreach $self->cust_refund; sprintf( "%.2f", $total_unapplied ); } =item balance Returns the balance for this customer (total_owed plus total_unrefunded, minus -total_credited minus total_unapplied_payments). +total_unapplied_credits minus total_unapplied_payments). =cut @@ -4563,7 +4685,7 @@ sub balance { sprintf( "%.2f", $self->total_owed + $self->total_unapplied_refunds - - $self->total_credited + - $self->total_unapplied_credits - $self->total_unapplied_payments ); } @@ -4584,7 +4706,7 @@ sub balance_date { sprintf( "%.2f", $self->total_owed_date($time) + $self->total_unapplied_refunds - - $self->total_credited + - $self->total_unapplied_credits - $self->total_unapplied_payments ); } @@ -4872,21 +4994,47 @@ sub referring_cust_main { qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); } -=item credit AMOUNT, REASON +=item credit AMOUNT, REASON [ , OPTION => VALUE ... ] Applies a credit to this customer. If there is an error, returns the error, otherwise returns false. +REASON can be a text string, an FS::reason object, or a scalar reference to +a reasonnum. If a text string, it will be automatically inserted as a new +reason, and a 'reason_type' option must be passed to indicate the +FS::reason_type for the new reason. + +An I option may be passed to set the credit's I field. + +Any other options are passed to FS::cust_credit::insert. + =cut sub credit { my( $self, $amount, $reason, %options ) = @_; + my $cust_credit = new FS::cust_credit { 'custnum' => $self->custnum, 'amount' => $amount, - 'reason' => $reason, }; + + if ( ref($reason) ) { + + if ( ref($reason) eq 'SCALAR' ) { + $cust_credit->reasonnum( $$reason ); + } else { + $cust_credit->reasonnum( $reason->reasonnum ); + } + + } else { + $cust_credit->set('reason', $reason) + } + + $cust_credit->addlinfo( delete $options{'addlinfo'} ) + if exists($options{'addlinfo'}); + $cust_credit->insert(%options); + } =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] @@ -5189,6 +5337,9 @@ Currently this only makes sense for "CCH" as DATA_VENDOR. sub geocode { my ($self, $data_vendor) = (shift, shift); #always cch for now + my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode + return $geocode if $geocode; + my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) ) ? 'ship_' : ''; @@ -5199,7 +5350,6 @@ sub geocode { #CCH specific location stuff my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'"; - my $geocode = ''; my @cust_tax_location = qsearch( { 'table' => 'cust_tax_location', @@ -5476,7 +5626,7 @@ sub balance_sql { " Returns an SQL fragment to retreive the balance for this customer, only considering invoices with date earlier than START_TIME, and optionally not -later than END_TIME (total_owed_date minus total_credited minus +later than END_TIME (total_owed_date minus total_unapplied_credits minus total_unapplied_payments). Times are specified as SQL fragments or numeric @@ -6355,348 +6505,6 @@ sub append_fuzzyfiles { 1; } -=item process_batch_import - -Load a batch import as a queued JSRPC job - -=cut - -use Storable qw(thaw); -use Data::Dumper; -use MIME::Base64; -sub process_batch_import { - my $job = shift; - - my $param = thaw(decode_base64(shift)); - warn Dumper($param) if $DEBUG; - - my $files = $param->{'uploaded_files'} - or die "No files provided.\n"; - - my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files; - - my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; - my $file = $dir. $files{'file'}; - - my $type; - if ( $file =~ /\.(\w+)$/i ) { - $type = lc($1); - } else { - #or error out??? - warn "can't parse file type from filename $file; defaulting to CSV"; - $type = 'csv'; - } - - my $error = - FS::cust_main::batch_import( { - job => $job, - file => $file, - type => $type, - custbatch => $param->{custbatch}, - agentnum => $param->{'agentnum'}, - refnum => $param->{'refnum'}, - pkgpart => $param->{'pkgpart'}, - #'fields' => [qw( cust_pkg.setup dayphone first last address1 address2 - # city state zip comments )], - 'format' => $param->{'format'}, - } ); - - unlink $file; - - die "$error\n" if $error; - -} - -=item batch_import - -=cut - -use FS::svc_acct; -use FS::svc_external; - -#some false laziness w/cdr.pm now -sub batch_import { - my $param = shift; - - my $job = $param->{job}; - - my $filename = $param->{file}; - my $type = $param->{type} || 'csv'; - - my $custbatch = $param->{custbatch}; - - my $agentnum = $param->{agentnum}; - my $refnum = $param->{refnum}; - my $pkgpart = $param->{pkgpart}; - - my $format = $param->{'format'}; - - my @fields; - my $payby; - if ( $format eq 'simple' ) { - @fields = qw( cust_pkg.setup dayphone first last - address1 address2 city state zip comments ); - $payby = 'BILL'; - } elsif ( $format eq 'extended' ) { - @fields = qw( agent_custid refnum - last first address1 address2 city state zip country - daytime night - ship_last ship_first ship_address1 ship_address2 - ship_city ship_state ship_zip ship_country - payinfo paycvv paydate - invoicing_list - cust_pkg.pkgpart - svc_acct.username svc_acct._password - ); - $payby = 'BILL'; - } elsif ( $format eq 'extended-plus_company' ) { - @fields = qw( agent_custid refnum - last first company address1 address2 city state zip country - daytime night - ship_last ship_first ship_company ship_address1 ship_address2 - ship_city ship_state ship_zip ship_country - payinfo paycvv paydate - invoicing_list - cust_pkg.pkgpart - svc_acct.username svc_acct._password - ); - $payby = 'BILL'; - } elsif ( $format eq 'svc_external' ) { - @fields = qw( agent_custid refnum - last first company address1 address2 city state zip country - daytime night - ship_last ship_first ship_company ship_address1 ship_address2 - ship_city ship_state ship_zip ship_country - payinfo paycvv paydate - invoicing_list - cust_pkg.pkgpart cust_pkg.bill - svc_external.id svc_external.title - ); - $payby = 'BILL'; - } else { - die "unknown format $format"; - } - - my $count; - my $parser; - my @buffer = (); - if ( $type eq 'csv' ) { - - eval "use Text::CSV_XS;"; - die $@ if $@; - - $parser = new Text::CSV_XS; - - @buffer = split(/\r?\n/, slurp($filename) ); - $count = scalar(@buffer); - - } elsif ( $type eq 'xls' ) { - - eval "use Spreadsheet::ParseExcel;"; - die $@ if $@; - - my $excel = new Spreadsheet::ParseExcel::Workbook->Parse($filename); - $parser = $excel->{Worksheet}[0]; #first sheet - - $count = $parser->{MaxRow} || $parser->{MinRow}; - $count++; - - } else { - die "Unknown file type $type\n"; - } - - #my $columns; - - 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; - - my $line; - my $row = 0; - my( $last, $min_sec ) = ( time, 5 ); #progressbar foo - while (1) { - - my @columns = (); - if ( $type eq 'csv' ) { - - last unless scalar(@buffer); - $line = shift(@buffer); - - $parser->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $parser->error_input(); - }; - @columns = $parser->fields(); - - } elsif ( $type eq 'xls' ) { - - last if $row > ($parser->{MaxRow} || $parser->{MinRow}); - - my @row = @{ $parser->{Cells}[$row] }; - @columns = map $_->{Val}, @row; - - #my $z = 'A'; - #warn $z++. ": $_\n" for @columns; - - } else { - die "Unknown file type $type\n"; - } - - #warn join('-',@columns); - - my %cust_main = ( - custbatch => $custbatch, - agentnum => $agentnum, - refnum => $refnum, - country => $conf->config('countrydefault') || 'US', - payby => $payby, #default - paydate => '12/2037', #default - ); - my $billtime = time; - my %cust_pkg = ( pkgpart => $pkgpart ); - my %svc_x = (); - foreach my $field ( @fields ) { - - if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) { - - #$cust_pkg{$1} = str2time( shift @$columns ); - if ( $1 eq 'pkgpart' ) { - $cust_pkg{$1} = shift @columns; - } elsif ( $1 eq 'setup' ) { - $billtime = str2time(shift @columns); - } else { - $cust_pkg{$1} = str2time( shift @columns ); - } - - } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) { - - $svc_x{$1} = shift @columns; - - } elsif ( $field =~ /^svc_external\.(id|title)$/ ) { - - $svc_x{$1} = shift @columns; - - } else { - - #refnum interception - if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) { - - my $referral = $columns[0]; - my %hash = ( 'referral' => $referral, - 'agentnum' => $agentnum, - 'disabled' => '', - ); - - my $part_referral = qsearchs('part_referral', \%hash ) - || new FS::part_referral \%hash; - - unless ( $part_referral->refnum ) { - my $error = $part_referral->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't auto-insert advertising source: $referral: $error"; - } - } - - $columns[0] = $part_referral->refnum; - } - - my $value = shift @columns; - $cust_main{$field} = $value if length($value); - } - } - - $cust_main{'payby'} = 'CARD' - if defined $cust_main{'payinfo'} - && length $cust_main{'payinfo'}; - - my $invoicing_list = $cust_main{'invoicing_list'} - ? [ delete $cust_main{'invoicing_list'} ] - : []; - - my $cust_main = new FS::cust_main ( \%cust_main ); - - use Tie::RefHash; - tie my %hash, 'Tie::RefHash'; #this part is important - - if ( $cust_pkg{'pkgpart'} ) { - my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ); - - my @svc_x = (); - my $svcdb = ''; - if ( $svc_x{'username'} ) { - $svcdb = 'svc_acct'; - } elsif ( $svc_x{'id'} || $svc_x{'title'} ) { - $svcdb = 'svc_external'; - } - if ( $svcdb ) { - my $part_pkg = $cust_pkg->part_pkg; - unless ( $part_pkg ) { - $dbh->rollback if $oldAutoCommit; - return "unknown pkgpart: ". $cust_pkg{'pkgpart'}; - } - $svc_x{svcpart} = $part_pkg->svcpart( $svcdb ); - my $class = "FS::$svcdb"; - push @svc_x, $class->new( \%svc_x ); - } - - $hash{$cust_pkg} = \@svc_x; - } - - my $error = $cust_main->insert( \%hash, $invoicing_list ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't insert customer". ( $line ? " for $line" : '' ). ": $error"; - } - - if ( $format eq 'simple' ) { - - #false laziness w/bill.cgi - $error = $cust_main->bill( 'time' => $billtime ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't bill customer for $line: $error"; - } - - $error = $cust_main->apply_payments_and_credits; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't bill customer for $line: $error"; - } - - $error = $cust_main->collect(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't collect customer for $line: $error"; - } - - } - - $row++; - - if ( $job && time - $min_sec > $last ) { #progress bar - $job->update_statustext( int(100 * $row / $count) ); - $last = time; - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit;; - - return "Empty file!" unless $row; - - ''; #no error - -} - =item batch_charge =cut @@ -6955,7 +6763,7 @@ sub generate_letter { $letter_data{company_name} = $conf->config('company_name'); - my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc; + my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc; my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX', DIR => $dir, SUFFIX => '.tex',