X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=210ab63c9d86fc4a9de7c65fce94eb2adacb27c9;hb=dbb388836b7951a3db49deda05a1ff9ba5125c17;hp=95097da71df1c0c6d84eb70685f6f9c4b01fd5ac;hpb=16a001f9e22bdb68e85d6c23697bfb5f7b8fa8f4;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 95097da71..210ab63c9 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -42,7 +42,7 @@ use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; use FS::part_pkg; -use FS::part_bill_event; +use FS::part_bill_event qw(due_events); use FS::cust_bill_event; use FS::cust_tax_exempt; use FS::cust_tax_exempt_pkg; @@ -397,6 +397,8 @@ sub insert { warn " inserting $self\n" if $DEBUG > 1; + $self->signupdate(time) unless $self->signupdate; + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -416,6 +418,20 @@ sub insert { $self->invoicing_list( $invoicing_list ); } + 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; @@ -458,6 +474,133 @@ sub insert { } +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($conf->config_binary('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_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] Like the insert method on an existing record, this method orders a package @@ -549,21 +692,23 @@ sub order_pkgs { ''; #no error } -=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ] +=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] 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. -Optionally, two scalar references can be passed as well. They will have their -values filled in with the amount and number of seconds applied by this prepaid +Optionally, four scalar references can be passed as well. They will have their +values filled in with the amount, number of seconds, and number of upload and +download bytes applied by this prepaid card. =cut sub recharge_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, $amountref, $secondsref, + $upbytesref, $downbytesref ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -576,10 +721,14 @@ sub recharge_prepay { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes ) = ( 0, 0, 0, 0 ); - my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds) + my $error = $self->get_prepay($prepay_credit, \$amount, + \$seconds, \$upbytes, \$downbytes) || $self->increment_seconds($seconds) + || $self->increment_upbytes($upbytes) + || $self->increment_downbytes($downbytes) + || $self->increment_totalbytes($upbytes + $downbytes) || $self->insert_cust_pay_prepay( $amount, ref($prepay_credit) ? $prepay_credit->identifier @@ -593,6 +742,8 @@ sub recharge_prepay { if ( defined($amountref) ) { $$amountref = $amount; } if ( defined($secondsref) ) { $$secondsref = $seconds; } + if ( defined($upbytesref) ) { $$upbytesref = $upbytes; } + if ( defined($downbytesref) ) { $$downbytesref = $downbytes; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -616,7 +767,7 @@ If there is an error, returns the error, otherwise returns false. sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, $amountref, $secondsref, $upref, $downref) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -663,12 +814,50 @@ sub get_prepay { $$amountref += $prepay_credit->amount; $$secondsref += $prepay_credit->seconds; + $$upref += $prepay_credit->upbytes; + $$downref += $prepay_credit->downbytes; $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 @@ -678,10 +867,24 @@ otherwise returns false. =cut sub increment_seconds { - my( $self, $seconds ) = @_; - warn "$me increment_seconds called: $seconds seconds\n" + _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; @@ -711,7 +914,8 @@ sub increment_seconds { ' ('. $svc_acct->email. ")\n" if $DEBUG > 1; - $svc_acct->increment_seconds($seconds); + $column = "increment_$column"; + $svc_acct->$column($amount); } @@ -1023,15 +1227,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"; @@ -1064,6 +1272,8 @@ sub check { || $self->ut_number('refnum') || $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') @@ -1496,7 +1706,7 @@ Returns a list: an empty list on success or a list of errors. sub suspend { my $self = shift; - grep { $_->suspend } $self->unsuspended_pkgs; + grep { $_->suspend(@_) } $self->unsuspended_pkgs; } =item suspend_if_pkgpart PKGPART [ , PKGPART ... ] @@ -1510,8 +1720,14 @@ Returns a list: an empty list on success or a list of errors. sub suspend_if_pkgpart { my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } + 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; } @@ -1527,8 +1743,14 @@ Returns a list: an empty list on success or a list of errors. sub suspend_unless_pkgpart { my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } + 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; } @@ -1587,6 +1809,22 @@ sub _banned_pay_hashref { }; } +=item notes + +Returns all notes (see L) for this customer. + +=cut + +sub notes { + my $self = shift; + #order by? + qsearch( 'cust_main_note', + { 'custnum' => $self->custnum }, + '', + 'ORDER BY _DATE DESC' + ); +} + =item agent Returns the agent (see L) for this customer. @@ -2106,79 +2344,28 @@ sub collect { warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" if $DEBUG > 1; - foreach my $part_bill_event ( - sort { $a->seconds <=> $b->seconds - || $a->weight <=> $b->weight - || $a->eventpart <=> $b->eventpart } - grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) - && ! qsearch( 'cust_bill_event', { - 'invnum' => $cust_bill->invnum, - 'eventpart' => $_->eventpart, - 'status' => 'done', - } ) - } - qsearch( { - 'table' => 'part_bill_event', - 'hashref' => { 'payby' => (exists($options{'payby'}) - ? $options{'payby'} - : $self->payby - ), - 'disabled' => '', }, - 'extra_sql' => $extra_sql, - } ) - ) { + foreach my $part_bill_event ( due_events ( $cust_bill, + exists($options{'payby'}) + ? $options{'payby'} + : $self->payby, + $invoice_time, + $extra_sql ) ) { last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0 || $self->balance <= 0; # or if balance<=0 - warn " calling invoice event (". $part_bill_event->eventcode. ")\n" - if $DEBUG > 1; - my $cust_main = $self; #for callback - - my $error; { local $realtime_bop_decline_quiet = 1 if $options{'quiet'}; - local $SIG{__DIE__}; # don't want Mason __DIE__ handler active - $error = eval $part_bill_event->eventcode; - } - - my $status = ''; - my $statustext = ''; - if ( $@ ) { - $status = 'failed'; - $statustext = $@; - } elsif ( $error ) { - $status = 'done'; - $statustext = $error; - } else { - $status = 'done' - } - - #add cust_bill_event - my $cust_bill_event = new FS::cust_bill_event { - 'invnum' => $cust_bill->invnum, - 'eventpart' => $part_bill_event->eventpart, - #'_date' => $invoice_time, - '_date' => time, - 'status' => $status, - 'statustext' => $statustext, - }; - $error = $cust_bill_event->insert; - if ( $error ) { - #$dbh->rollback if $oldAutoCommit; - #return "error: $error"; + warn " do_event " . $cust_bill . " ". (%options) . "\n" + if $DEBUG > 1; - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Event run but database not updated - '. - 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum. - ', eventpart '. $part_bill_event->eventpart. - ": $error"; - warn $e; - return $e; + if (my $error = $part_bill_event->do_event($cust_bill, %options)) { + # gah, even with transactions. + $dbh->commit if $oldAutoCommit; #well. + return $error; + } } - } } @@ -2190,9 +2377,10 @@ sub collect { =item retry_realtime -Schedules realtime credit card / electronic check / LEC billing events for -for retry. Useful if card information has changed or manual retry is desired. -The 'collect' method must be called to actually retry the transaction. +Schedules realtime / batch credit card / electronic check / LEC billing +events for for retry. Useful if card information has changed or manual +retry is desired. The 'collect' method must be called to actually retry +the transaction. Implementation details: For each of this customer's open invoices, changes the status of the first "done" (with statustext error) realtime processing @@ -2223,7 +2411,7 @@ sub retry_realtime { grep { #$_->part_bill_event->plan eq 'realtime-card' $_->part_bill_event->eventcode =~ - /\$cust_bill\->realtime_(card|ach|lec)/ + /\$cust_bill\->(batch|realtime)_(card|ach|lec)/ && $_->status eq 'done' && $_->statustext } @@ -2391,6 +2579,9 @@ sub realtime_bop { $content{customer_ip} = $payip if length($payip); + $content{invoice_number} = $options{'invnum'} + if exists($options{'invnum'}) && length($options{'invnum'}); + if ( $method eq 'CC' ) { $content{card_number} = $payinfo; @@ -2456,7 +2647,7 @@ sub realtime_bop { 'action' => $action1, 'description' => $options{'description'}, 'amount' => $amount, - 'invoice_number' => $options{'invnum'}, + #'invoice_number' => $options{'invnum'}, 'customer_id' => $self->custnum, 'last_name' => $paylast, 'first_name' => $payfirst, @@ -3857,12 +4048,12 @@ sub fuzzy_search { check_and_rebuild_fuzzyfiles(); foreach my $field ( keys %$fuzzy ) { + + my $all = $self->all_X($field); + next unless scalar(@$all); + my %match = (); - $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, - ['i'], - @{ $self->all_X($field) } - ) - ); + $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) ); my @fcust = (); foreach ( keys %match ) { @@ -3891,10 +4082,10 @@ sub fuzzy_search { Accepts the following options: I, the string to search for. The string will be searched for as a customer number, phone number, name or company name, -first searching for an exact match then fuzzy and substring matches (in some -cases - see the source code for the exact heuristics used). +as an exact, or, in some cases, a substring or fuzzy match (see the source code +for the exact heuristics used). -Any additional options treated as an additional qualifier on the search +Any additional options are treated as an additional qualifier on the search (i.e. I). Returns a (possibly empty) array of FS::cust_main objects. @@ -4044,7 +4235,9 @@ sub smart_search { 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization } ); - unless ( @cust_main ) { #no exact match, trying substring/fuzzy + #always do substring & fuzzy, + #getting complains searches are not returning enough + #unless ( @cust_main ) { #no exact match, trying substring/fuzzy #still some false laziness w/ search/cust_main.cgi @@ -4105,7 +4298,7 @@ sub smart_search { FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); } - } + #} #eliminate duplicates my %saw = (); @@ -4146,14 +4339,21 @@ sub rebuild_fuzzyfiles { or die "can't open $dir/cust_main.$fuzzy: $!"; flock(LOCK,LOCK_EX) or die "can't lock $dir/cust_main.$fuzzy: $!"; - - my @all = map $_->getfield($fuzzy), qsearch('cust_main', {}); - push @all, - grep $_, map $_->getfield("ship_$fuzzy"), qsearch('cust_main',{}); - + open (CACHE,">$dir/cust_main.$fuzzy.tmp") or die "can't open $dir/cust_main.$fuzzy.tmp: $!"; - print CACHE join("\n", @all), "\n"; + + foreach my $field ( $fuzzy, "ship_$fuzzy" ) { + my $sth = dbh->prepare("SELECT $field FROM cust_main". + " WHERE $field != '' AND $field IS NOT NULL"); + $sth->execute or die $sth->errstr; + + while ( my $row = $sth->fetchrow_arrayref ) { + print CACHE $row->[0]. "\n"; + } + + } + close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!"; rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy"; @@ -4181,7 +4381,7 @@ sub all_X { =cut sub append_fuzzyfiles { - my( $last, $company ) = @_; + #my( $first, $last, $company ) = @_; &check_and_rebuild_fuzzyfiles; @@ -4189,33 +4389,23 @@ sub append_fuzzyfiles { my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; - if ( $last ) { + foreach my $field (qw( first last company )) { + my $value = shift; - open(LAST,">>$dir/cust_main.last") - or die "can't open $dir/cust_main.last: $!"; - flock(LAST,LOCK_EX) - or die "can't lock $dir/cust_main.last: $!"; + if ( $value ) { - print LAST "$last\n"; + open(CACHE,">>$dir/cust_main.$field") + or die "can't open $dir/cust_main.$field: $!"; + flock(CACHE,LOCK_EX) + or die "can't lock $dir/cust_main.$field: $!"; - flock(LAST,LOCK_UN) - or die "can't unlock $dir/cust_main.last: $!"; - close LAST; - } - - if ( $company ) { - - open(COMPANY,">>$dir/cust_main.company") - or die "can't open $dir/cust_main.company: $!"; - flock(COMPANY,LOCK_EX) - or die "can't lock $dir/cust_main.company: $!"; + print CACHE "$value\n"; - print COMPANY "$company\n"; - - flock(COMPANY,LOCK_UN) - or die "can't unlock $dir/cust_main.company: $!"; + flock(CACHE,LOCK_UN) + or die "can't unlock $dir/cust_main.$field: $!"; + close CACHE; + } - close COMPANY; } 1; @@ -4230,9 +4420,33 @@ sub batch_import { #warn join('-',keys %$param); my $fh = $param->{filehandle}; my $agentnum = $param->{agentnum}; + my $refnum = $param->{refnum}; my $pkgpart = $param->{pkgpart}; - my @fields = @{$param->{fields}}; + + #my @fields = @{$param->{fields}}; + 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'; + } else { + die "unknown format $format"; + } eval "use Text::CSV_XS;"; die $@ if $@; @@ -4271,51 +4485,112 @@ sub batch_import { agentnum => $agentnum, refnum => $refnum, country => $conf->config('countrydefault') || 'US', - payby => 'BILL', #default + payby => $payby, #default paydate => '12/2037', #default ); my $billtime = time; my %cust_pkg = ( pkgpart => $pkgpart ); + my %svc_acct = (); foreach my $field ( @fields ) { - if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) { + + if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|expire|cancel)$/ ) { + #$cust_pkg{$1} = str2time( shift @$columns ); - if ( $1 eq 'setup' ) { + 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_acct{$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; + } + #$cust_main{$field} = shift @$columns; $cust_main{$field} = shift @columns; } } - my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart; + $cust_main{'payby'} = 'CARD' if 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 - $hash{$cust_pkg} = [] if $pkgpart; - my $error = $cust_main->insert( \%hash ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't insert customer for $line: $error"; + if ( $cust_pkg{'pkgpart'} ) { + my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ); + + my @svc_acct = (); + if ( $svc_acct{'username'} ) { + my $part_pkg = $cust_pkg->part_pkg; + unless ( $part_pkg ) { + $dbh->rollback if $oldAutoCommit; + return "unknown pkgnum ". $cust_pkg{'pkgpart'}; + } + $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' ); + push @svc_acct, new FS::svc_acct ( \%svc_acct ) + } + + $hash{$cust_pkg} = \@svc_acct; } - #false laziness w/bill.cgi - $error = $cust_main->bill( 'time' => $billtime ); + my $error = $cust_main->insert( \%hash, $invoicing_list ); + if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't bill customer for $line: $error"; + return "can't insert customer for $line: $error"; } - $cust_main->apply_payments; - $cust_main->apply_credits; + 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"; + } + + $cust_main->apply_payments; + $cust_main->apply_credits; + + $error = $cust_main->collect(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't collect customer for $line: $error"; + } - $error = $cust_main->collect(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't collect customer for $line: $error"; } $imported++; @@ -4431,6 +4706,8 @@ No multiple currency support (probably a larger project than just this module). payinfo_masked false laziness with cust_pay.pm and cust_refund.pm +Birthdates rely on negative epoch values. + =head1 SEE ALSO L, L, L, L