8 use FS::Record qw(qsearch qsearchs);
14 use FS::part_referral;
16 use FS::UID qw(adminsuidsetup);
22 my $s_dbname = 'DBI:Pg:dbname=optigoldimport';
23 my $s_dbuser = 'freeside';
25 my $extension = '.htm';
27 #my $d_dbuser = 'freeside';
28 my $d_dbuser = 'enet';
29 #my $d_dbuser = 'ivan';
30 #my $d_dbuser = 'freesideimport';
32 my $radius_file = 'radius.csv';
33 my $email_file = 'email.csv';
37 my $legacy_domain_svcnum = 1;
38 my $legacy_ppp_svcpart = 2;
39 my $legacy_email_svcpart = 3;
40 #my $legacy_broadband_svcpart = 4;
41 #my $legacy_broadband_svcpart = 14;
42 #my $previous_credit_reasonnum = 1;
43 my $previous_credit_reasonnum = 1220;
46 my $state = ''; #statemachine-ish
63 $s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass,
66 'ShowErrorStatement' => 1
70 foreach ( qw ( billcycle cust email product ) ) {
73 print "parsing $sourcefile\n";
75 die "bad file name" unless $sourcefile =~ /^\w+$/;
81 if ( $c_sth = $s_dbh->prepare("SELECT COUNT(*) FROM $sourcefile") ) {
82 if ( $c_sth->execute ) {
83 if ( $c_sth->fetchrow_arrayref->[0] ) {
84 warn "already have data in $sourcefile table; skipping";
90 my $tp = new HTML::TableParser( \@args, { Decode => 1, Trim => 1, Chomp => 1 });
91 $tp->parse_file($sourcefile.$extension) or die "failed";
92 $s_dbh->commit or die $s_dbh->errstr;
98 warn "start\n" if $DEBUG;
100 die "unexpected state change" unless $state eq '';
101 die "unexpected table" unless $table_id eq '1';
106 warn "end\n" if $DEBUG;
107 my ($tbl_id, $line, $udata) = @_;
108 die "unexpected state change in header" unless $state eq 'rows';
109 die "unexpected table" unless $tbl_id eq '1';
114 warn "header\n" if $DEBUG;
115 my ($tbl_id, $line, $cols, $udata) = @_;
116 die "unexpected state change in header" unless $state eq 'table';
117 die "unexpected table" unless $tbl_id eq '1';
120 die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols)
121 if scalar(grep { !/^[ \w\r]+$/ } @$cols);
123 my $sql = "CREATE TABLE $sourcefile ( ".
124 join(', ', map { s/[ \r]/_/g; "$_ varchar NULL" } @$cols). " )";
125 $s_dbh->do($sql) or die "create table failed: ". $s_dbh->errstr;
126 $columncount = scalar( @$cols );
130 warn "row\n" if $DEBUG;
131 my ($tbl_id, $line, $cols, $udata) = @_;
132 die "unexpected state change in row" unless $state eq 'rows';
133 die "unexpected table" unless $tbl_id eq '1';
135 die "invalid number of columns: ". join(', ', @$cols)
136 unless (scalar(@$cols) == $columncount);
138 my $sql = "INSERT INTO $sourcefile VALUES(".
139 join(', ', map { s/\s*(\S[\S ]*?)\s*$/$1/; $s_dbh->quote($_) } @$cols). ")";
140 $s_dbh->do($sql) or die "insert failed: ". $s_dbh->errstr;
142 warn "row $rowcount\n" unless ($rowcount % 1000);
145 ## now svc_acct from CSV files
147 $FS::cust_main::import=1;
148 $FS::cust_pkg::disable_agentcheck = 1;
149 $FS::cust_svc::ignore_quantity = 1;
151 my (%master_map) = ();
152 my (%referrals) = ();
158 my (%cust_pkg_map) = ();
159 my (%object_map) = ();
160 my (%package_cache) = ();
163 my $d_dbh = adminsuidsetup $d_dbuser;
164 local $FS::UID::AutoCommit = 0;
166 my @import = ( { 'file' => $radius_file,
168 'fields' => [ qw( garbage1 username garbage2 garbage3 _password ) ],
172 foreach qw (garbage1 garbage2 garbage3);
173 $hash->{'svcpart'} = $legacy_ppp_svcpart;
174 $hash->{'domsvc'} = $legacy_domain_svcnum;
177 'mapkey' => 'legacy_ppp',
178 'skey' => 'username',
180 { 'file' => $email_file,
182 'fields' => [ qw( username null finger _password status garbage ) ],
186 # if $object_map{'legacy_ppp'}{$hash->{'username'}};
188 foreach qw (null status garbage);
189 $hash->{'svcpart'} = $legacy_email_svcpart;
190 $hash->{'domsvc'} = $legacy_domain_svcnum;
193 'mapkey' => 'legacy_email',
194 'skey' => 'username',
199 my $href = shift @import;
200 my $file = $href->{'file'} or die "No file specified";
201 my (@fields) = @{$href->{'fields'}};
202 my ($sep_char) = $href->{'sep_char'} || ';';
203 my ($fixup) = $href->{'fixup'};
204 my ($mapkey) = $href->{'mapkey'};
205 my ($skey) = $href->{'skey'};
208 my $csv = new Text::CSV_XS({'sep_char' => $sep_char});
209 open(FH, $file) or die "cannot open $file: $!";
212 while ( defined($line=<FH>) ) {
215 $line &= "\177" x length($line); # i hope this isn't really necessary
217 or die "cannot parse: " . $csv->error_input();
219 my @values = $csv->fields();
221 foreach my $field (@fields) {
222 $hash{$field} = shift @values;
226 warn "skipping malformed line: $line\n";
230 my $skip = &{$fixup}(\%hash)
234 my $svc_acct = new FS::svc_acct { %hash };
235 my $error = $svc_acct->insert;
241 if ($skey && $mapkey) {
242 my $key = (ref($skey) eq 'CODE') ? &{$skey}($svc_acct) : $hash{$skey};
243 $object_map{$mapkey}{$key} = $svc_acct->svcnum;
249 print "Imported $count service records\n";
256 my ( $href ) = ( shift );
258 $href->{'one_time_list'} =~ /^\s*(\S[\S ]*?)\s*$/ && ($once = $1);
261 : int(eval "$href->{'months_credit'} + 0");
262 # int(eval "$href->{'month_credit'} + 0");
266 my ( $field, $hash ) = ( shift, shift );
267 $field = 'billing_'. $field
268 if $hash->{'billing_use'} eq 'Billing Address';
273 my ( $field, $hash ) = ( shift, shift );
274 $field = 'billing_'. $field
275 if $hash->{'billing_use'} eq 'Billing Address';
276 my $ac = ( $hash->{$field. '_area_code'}
277 && $hash->{$field. '_area_code'} =~ /^\d{3}$/ )
278 ? $hash->{$field. '_area_code'}. '-'
281 ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
282 ? $ac. $hash->{$field}
287 my ( $field, $hash ) = ( shift, shift );
288 $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
292 my ( $field, $hash ) = ( shift, shift );
293 $hash->{'billing_use'} eq 'Billing Address' && $hash->{$field} =~ /^\d{3}-\d{4}$/
294 ? ( $hash->{$field. '_area_code'} =~ /^\d{3}$/
295 ? $hash->{$field. '_area_code'}. '-'
301 my %payby_map = ( '' => 'BILL',
303 'Credit Card' => 'CARD',
304 'Bank Debit' => 'CHEK',
305 'Virtual Check' => 'CHEK',
308 $payby_map{ shift->{billing_type} };
313 my $payby = payby($hash);
316 $hash->{'credit_card_number_1'}.
317 $hash->{'credit_card_number_2'}.
318 $hash->{'credit_card_number_3'}.
319 $hash->{'credit_card_number_4'};
321 $hash->{'bank_account_number'}.
323 $hash->{'bank_transit_number'};
324 if ($payby eq 'CARD') {
326 }elsif ($payby eq 'CHEK') {
328 }elsif ($payby eq 'BILL') {
329 $info = $hash->{'blanket_purchase_order_number'};
330 $bank =~ s/[^\d\@]//g;
332 if ( $bank =~ /^\d+\@\d{9}/) {
336 if ( $cc =~ /^\d{13,16}/ ) {
341 die "unexpected payby";
347 my ($object, $field) = (shift, shift);
348 my $value = $object->getfield($field);
349 $value =~ s/[^\w \,\.\-\']/ /g;
350 $object->setfield($field, $value);
354 my ($object, $field) = (shift, shift);
355 my $value = $object->getfield($field);
356 $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
357 $object->setfield($field, $value);
361 my ($object, $field) = (shift, shift);
362 my $value = $object->getfield($field);
363 $value = 'TX' if $value eq 'TTX';
364 $object->setfield($field, $value);
368 my ($object, $field) = (shift, shift);
369 my $value = $object->getfield($field);
370 $value =~ s/[^-\d]//g;
371 $object->setfield($field, $value);
375 part_pkg => { 'stable' => 'product',
376 #part_pkg => { 'stable' => 'billcycle',
378 { 'pkg' => sub { my $href = shift;
379 $href->{'description'}
380 ? $href->{'description'}
381 : $href->{'product_id'};
383 'comment' => 'product_id',
384 'freq' => sub { pkg_freq(shift) },
385 'recur' => sub { my $href = shift;
386 my $price = ( pkg_freq($href)
387 ? $href->{'unit_price'}
390 $price =~ s/[^\d.]//g;
391 $price = 0 unless $price;
392 sprintf("%.2f", $price);
394 'setuptax' => sub { my $href = shift;
395 $href->{'taxable'} ? '' : 'Y';
397 'recurtax' => sub { my $href = shift;
398 $href->{'taxable'} ? '' : 'Y';
400 'plan' => sub { 'flat' },
401 'disabled' => sub { 'Y' },
402 'pkg_svc' => sub { my $href = shift;
404 if (pkg_freq($href)){
405 $result->{$legacy_ppp_svcpart} = 1;
406 $result->{$legacy_email_svcpart} =
407 $href->{emails_allowed}
408 if $href->{emails_allowed};
411 'primary_svc'=> sub { pkg_freq(shift)
412 ? $legacy_ppp_svcpart
417 'fixup' => sub { my $part_pkg = shift;
419 unless ($part_pkg->pkg =~ /^\s*(\S[\S ]*?)\s*$/) {
420 warn "no pkg: ". $part_pkg->pkg. " for ". $row->{product_id};
424 unless ($part_pkg->comment =~ /^\s*(\S[\S ]*?)\s*$/) {
425 warn "no comment: ". $part_pkg->comment. " for ". $row->{product_id};
429 return 1 if exists($package_cache{$1});
430 $package_cache{$1} = $part_pkg;
433 'wrapup' => sub { foreach (keys %package_cache) {
434 my $part_pkg = $package_cache{$_};
436 { map { my $v = $part_pkg->$_;
443 $part_pkg->insert(options=>$options);
444 die "Error inserting package: $error"
446 $count++ unless $error;
450 part_referral => { 'stable' => 'cust',
452 { 'agentnum' => sub { $agentnum },
453 'referral' => sub { my $r = shift->{'referred_from'};
457 'fixup' => sub { 1 },
458 'wrapup' => sub { foreach (keys %referrals) {
460 new FS::part_referral( {
461 'agentnum' => $agentnum,
462 'referral' => $referrals{$_},
464 my $error = $part_referral->insert;
465 die "Error inserting referral: $error"
467 $count++ unless $error;
468 $referrals{$_} = $part_referral->refnum;
472 #svc_acct => { 'stable' => 'cust',
474 # { 'username' => 'login',
475 # '_password' => 'password',
476 # 'svcpart' => sub{ $legacy_ppp_svcpart },
477 # 'domsvc' => sub{ $legacy_domain_svcnum },
478 # 'status' => 'status',
480 # 'fixup' => sub { my $svc_acct = shift;
482 # my $id = $row->{'master_account'}
483 # ? 'slave:'. $row->{'customer_id'}
485 # my $status = $svc_acct->status;
486 # if ( $status ne 'Current'
487 # && $status ne 'On Hold' )
490 # str2time($row->{termination_date});
491 # warn "not creating (cancelled) svc_acct for " .
492 # $svc_acct->username. "\n";
495 # $susp{$id} = str2time($row->{hold_date})
496 # if $status eq 'On Hold';
497 # $adjo{$id} = str2time($row->{hold_date})
498 # if ( $status eq 'Current' &&
499 # $row->{hold_date} );
501 # str2time($row->{expiration_date});
504 # 'skey' => sub { my $svc_acct = shift;
506 # my $id = $row->{'master_account'}
507 # ? 'slave:'. $row->{'customer_id'}
511 cust_main => { 'stable' => 'cust',
513 { 'agentnum' => sub { $agentnum },
514 'agent_custid' => sub { my $id = shift->{'customer_number'};
515 if (exists($custid{$id})) {
517 $id. chr(64 + $custid{$id});
523 'last' => sub { b_or('last_name', shift) || ' ' },
524 'first' => sub { b_or('first_name', shift) || ' ' },
525 'stateid' => 'drivers_license_number',
526 'signupdate' => sub { str2time(shift->{'creation_date'}) },
527 'company' => sub { b_or('company_name', shift) },
528 'address1' => sub { b_or('address', shift) || ' ' },
529 'city' => sub { b_or('city', shift) || 'Paris' },
530 'state' => sub { uc(b_or('state', shift)) || 'TX' },
531 'zip' => sub { b_or('zip_code', shift) || '75460' },
532 'country' => sub { 'US' },
533 'daytime' => sub { p_or('phone', shift) },
534 'night' => sub { p_or('phone_alternate_1', shift) },
535 'fax' => sub { p_or('fax', shift) },
536 'ship_last' => sub { or_b('last_name', shift) },
537 'ship_first' => sub { or_b('first_name', shift) },
538 'ship_company' => sub { or_b('company_name', shift) },
539 'ship_address1'=> sub { or_b('address', shift) },
540 'ship_city' => sub { or_b('city', shift) },
541 'ship_state' => sub { uc(or_b('state', shift)) },
542 'ship_zip' => sub { or_b('zip_code', shift) },
543 'ship_daytime' => sub { or_p('phone', shift) },
544 'ship_fax' => sub { or_p('fax', shift) },
545 'tax' => sub { shift->{taxable} eq '' ? 'Y' : '' },
546 'refnum' => sub { $referrals{shift->{'referred_from'}}
550 'fixup' => sub { my $cust_main = shift;
553 my ($master_account, $customer_id, $login) =
555 $row->{'master_account'} =~ /^\s*(\S[\S ]*?)\s*$/
556 && ($master_account = $1);
557 $row->{'customer_id'} =~ /^\s*(\S[\S ]*?)\s*$/
558 && ($customer_id = $1);
559 $row->{'login'} =~ /^\s*(\S[\S ]*?)\s*$/
562 my $id = $master_account
563 ? 'slave:'. $customer_id
566 my $status = $row->{status};
569 if ( $status ne 'Current'
570 && $status ne 'current'
571 && $status ne 'On Hold' )
575 str2time($row->{termination_date});
577 $susp{$id} = str2time($row->{hold_date})
578 if ($status eq 'On Hold' && !$cancelled);
579 $adjo{$id} = str2time($row->{hold_date})
580 if ( $status eq 'Current' && !$cancelled &&
583 str2time($row->{expiration_date})
587 $object_map{legacy_ppp}{$row->{'login'} };
588 unless( $cancelled || $svcnum || $status eq 'Pn Hold' ) {
589 warn "can't find svc_acct for legacy ppp ".
590 $row->{'login'}, "\n";
593 $object_map{svc_acct}{$id} = $svcnum
596 $master_map{$login} = $master_account
598 return 1 if $master_account;
599 $cust_main->ship_country('US')
600 if $cust_main->has_ship_address;
601 ut_name_fixup($cust_main, 'first');
602 ut_name_fixup($cust_main, 'company');
603 ut_name_fixup($cust_main, 'last');
605 my ($info, $payby) = payinfo($row);
606 $cust_main->payby($payby);
607 $cust_main->payinfo($info);
610 $row->{'credit_card_cvv_number'}
612 if ($payby eq 'CARD' or $payby eq 'DCRD');
614 $cust_main->paydate('20'.
615 $row->{'credit_card_exp_date_2'}. '-'.
617 $row->{'credit_card_exp_date_1'},
623 if ($payby eq 'CARD' or $payby eq 'DCRD');
626 $payname = $row->{'credit_card_name'}
627 if ($payby eq 'CARD' or $payby eq 'DCRD');
628 $payname = $row->{'bank_name'}
629 if ($payby eq 'CHEK' or $payby eq 'DCHK');
630 $cust_main->payname($payname);
633 $row->{'bank_account_to_debit'}
635 $row->{bank_account_to_debit}
638 if ($payby eq 'CHEK' or $payby eq 'DCHK');
640 $cust_main->payby('BILL')
641 if ($cust_main->payby eq 'CHEK' &&
642 $cust_main->payinfo !~ /^\d+\@\d{9}$/);
643 $cust_main->payby('BILL')
644 if ($cust_main->payby eq 'CARD' &&
645 $cust_main->payinfo =~ /^\s*$/);
646 $cust_main->paydate('2037-12-01')
647 if ($cust_main->payby eq 'BILL');
648 ut_text_fixup($cust_main, 'address1');
649 ut_state_fixup($cust_main, 'state');
650 ut_zip_fixup($cust_main, 'zip');
655 'skey' => sub { my $object = shift;
657 my $balance = sprintf("%.2f",
658 $href->{balance_due});
660 my $cust_credit = new FS::cust_credit({
661 'custnum' => $object->custnum,
662 'amount' => sprintf("%.2f", -$balance),
663 'reasonnum' => $previous_credit_reasonnum,
665 my $error = $cust_credit->insert;
666 warn "Error inserting credit for ",
667 $href->{'login'}, " : $error\n"
670 }elsif($balance > 0) {
671 my $error = $object->charge(
672 $balance, "Prior balance",
674 warn "Error inserting balance charge for ",
675 $href->{'login'}, " : $error\n"
682 #cust_main => { 'stable' => 'cust',
684 # { 'referred_by' => sub { my $href = shift;
685 # my $u = shift->{'login'};
686 # my $cn = $href->{'customer_number'};
688 # my $c = qsearch( 'cust_main',
689 # { 'custnum' => $cn }
690 # ) or die "can't fine customer $cn";
692 # my $s = qsearch( 'svc_acct',
693 # { 'username' => $u }
696 # my $n = $s->cust_svc
701 # $c->referral_custnum($n);
702 # my $error = $c->replace;
703 # die "error setting referral: $error"
708 # 'fixup' => sub { 1 },
710 cust_pkg => { 'stable' => 'billcycle',
712 { 'custnum' => sub { my $l = shift->{cbilling_cycle_login};
713 $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
714 my $r = $object_map{'cust_main'}{$l};
716 my $m = $master_map{$l};
717 $r = $object_map{'cust_main'}{$m}
722 'pkgpart' => sub { my $href = shift;
723 my $p = $href->{product_id};
724 $p =~ /^\s*(\S[\S ]*?)\s*$/ && ($p = $1);
725 my $pkg = $package_cache{$p}
726 if $package_cache{$p};
729 $href->{month_credit} =~ /\s*(\S[\S ]*?)\s*$/ && ($month = $1);
730 $month = int(eval "$month + 0");
733 $href->{unit_price} =~ /\s*(\S[\S ]*?)\s*$/ && ($price = $1);
734 $price = eval "$price + 0";
738 unless $pkg->freq + 0 == $month;
740 if ($pkg && ($pkg->freq + 0)) {
742 $pkg->recur =~ /\s*(\S[\S ]*?)\s*$/ && ($recur = $1);
743 $recur = eval "$recur + 0";
745 unless $recur == $price;
750 unless $pkg->setuptax
751 eq ($href->{taxable} ? '' : 'Y');
757 my $pkghref = { 'pkg' => ($href->{description} ? $href->{description} : $href->{product_id} ),
758 'comment' => $href->{product_id},
760 'setuptax' => ($href->{'taxable'} ? '' : 'Y'),
761 'recurtax' => ($href->{'taxable'} ? '' : 'Y'),
766 my @pkgs = qsearch('part_pkg', $pkghref);
767 my $recur = sprintf("%.2f", ($month ? $price : 0));
769 my %options = $_->options;
770 if ($options{recur} eq $recur) {
776 $pkghref->{recur} = $recur
782 $pkg_svc->{$legacy_ppp_svcpart} = 1;
783 $pkg_svc->{$legacy_email_svcpart} =
784 $href->{emails_allowed}
785 if $href->{emails_allowed};
787 $pkghref->{pkg_svc} = $pkg_svc;
788 $pkghref->{primary_svc}
790 ? $legacy_ppp_svcpart
793 $pkg = new FS::part_pkg $pkghref;
795 { map { my $v = $pkg->$_;
802 $pkg->insert(options=>$options);
804 warn "Error inserting pkg ".
805 join(", ", map{"$_ => ". $pkg->get($_)} fields $pkg).
811 $pkg ? $pkg->pkgpart : '';
813 'setup' => sub { str2time(shift->{creation_date}) },
814 'bill' => sub { my $href = shift;
815 my $id = $href->{'slave_account_id'}
816 ? 'slave:'. $href->{'slave_account_id'}
817 : $href->{'cbilling_cycle_login'};
819 #$bill{$href->{cbilling_cycle_login}};
821 'susp' => sub { my $href = shift;
822 my $id = $href->{'slave_account_id'}
823 ? 'slave:'. $href->{'slave_account_id'}
824 : $href->{'cbilling_cycle_login'};
826 #$susp{$href->{cbilling_cycle_login}};
828 'adjo' => sub { my $href = shift;
829 my $id = $href->{'slave_account_id'}
830 ? 'slave:'. $href->{'slave_account_id'}
831 : $href->{'cbilling_cycle_login'};
833 #$adjo{$href->{cbilling_cycle_login}};
835 'cancel' => sub { my $href = shift;
836 my $id = $href->{'slave_account_id'}
837 ? 'slave:'. $href->{'slave_account_id'}
838 : $href->{'cbilling_cycle_login'};
840 #$cancel{$href->{cbilling_cycle_login}};
843 'fixup' => sub { my ($object, $row) = (shift,shift);
844 unless ($object->custnum) {
845 warn "can't find customer for ".
846 $row->{cbilling_cycle_login}. "\n";
849 unless ($object->pkgpart) {
850 warn "can't find package for ".
851 $row->{product_id}. "\n";
856 'skey' => sub { my $object = shift;
858 my $id = $href->{'billing_cycle_item_id'};
859 $id =~ /^\s*(\S[\S ]*?)\s*$/ && ($id = $1);
860 $cust_pkg_map{$id} = $object->pkgnum;
861 if ($href->{'slave_account_id'} =~ /^\s*(\S[\S ]*?)\s*$/) {
864 my $l = $href->{cbilling_cycle_login};
865 $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
869 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
871 qsearchs( 'cust_svc', { 'svcnum' =>
872 $object_map{'svc_acct'}{$id} }
875 warn "can't find legacy ppp $id\n";
879 pkgnum($object_map{'cust_pkg'}{$id});
880 my $error = $cust_svc->replace;
881 warn "error linking legacy ppp $id: $error\n"
886 svc_acct => { 'stable' => 'email',
888 { 'username' => 'email_name',
889 '_password' => 'password',
890 'svcpart' => sub{ $legacy_email_svcpart },
891 'domsvc' => sub{ $legacy_domain_svcnum },
893 # 'fixup' => sub { my ($object, $row) = (shift,shift);
894 # my ($sd,$sm,$sy) = split '/',
895 # $row->{shut_off_date}
896 # if $row->{shut_off_date};
897 # if ($sd && $sm && $sy) {
898 # my ($cd, $cm, $cy) = (localtime)[3,4,5];
899 # $cy += 1900; $cm++;
900 # return 1 if $sy < $cy;
901 # return 1 if ($sy == $cy && $sm < $cm);
902 # return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
904 # return 1 if $object_map{'cust_main'}{$object->username};
907 'fixup' => sub { my ($object, $row) = (shift,shift);
908 my ($sd,$sm,$sy) = split '/',
909 $row->{shut_off_date}
910 if $row->{shut_off_date};
911 if ($sd && $sm && $sy) {
912 my ($cd, $cm, $cy) = (localtime)[3,4,5];
914 return 1 if $sy < $cy;
915 return 1 if ($sy == $cy && $sm < $cm);
916 return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
918 #return 1 if $object_map{'cust_main'}{$object->username};
921 $row->{email_name} =~ /^\s*(\S[\S ]*?)\s*$/
922 && ($email_name = $1);
925 $object_map{legacy_email}{$email_name}
928 warn "can't find svc_acct for legacy email ".
929 $row->{'email_name'}, "\n";
933 $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svcnum;
936 # 'skey' => sub { my $object = shift;
938 # 'email:'. $href->{'email_customer_id'};
940 'wrapup' => sub { for my $id (keys %{$object_map{'svc_acct'}}){
941 next unless $id =~ /^email:(\d+)/;
944 qsearchs( 'cust_svc', { 'svcnum' =>
945 $object_map{'svc_acct'}{$id} }
948 warn "can't find legacy email $id\n";
952 if ($cust_svc->pkgnum) {
953 warn "service already linked for $id\n";
958 pkgnum($cust_pkg_map{$custid});
959 if ($cust_svc->pkgnum){
960 my $error = $cust_svc->replace;
961 warn "error linking legacy email $id: $error\n"
964 warn "can't find package for $id\n"
971 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
974 my ($table, $href) = (shift @tables, shift @tables);
975 my $stable = $href->{'stable'} or die "No source table"; # good enough for now
976 my (%mapping) = %{$href->{'mapping'}};
977 my ($fixup) = $href->{'fixup'};
978 my ($wrapup) = $href->{'wrapup'};
979 my ($id) = $href->{'id'};
980 my ($skey) = $href->{'skey'};
982 #$d_dbh->do("delete from $table");
984 my $s_sth = $s_dbh->prepare("select count(*) from $stable");
985 $s_sth->execute or die $s_sth->errstr;
986 my $rowcount = $s_sth->fetchrow_arrayref->[0];
988 $s_sth = $s_dbh->prepare("select * from $stable");
989 $s_sth->execute or die $s_sth->errstr;
993 while ( $row = $s_sth->fetchrow_hashref ) {
994 my $class = "FS::$table";
996 warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
997 unless( !$count || $count % 100 );
999 my $object = new $class ( {
1000 map { $_ => ( ref($mapping{$_}) eq 'CODE'
1001 ? &{$mapping{$_}}($row)
1002 : $row->{$mapping{$_}}
1007 my $skip = &{$fixup}($object, $row)
1011 my $error = $object->insert;
1013 warn "Error inserting $table ".
1014 join(", ", map{"$_ => ". $object->get($_)} fields $object).
1019 my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
1021 $object_map{$table}{$key} = $object->get($object->primary_key)
1030 print "$count/$rowcount of $table SUCCESSFULLY processed\n";
1034 # link to any uncancelled package on customer
1035 foreach my $username ( keys %{$object_map{'legacy_email'}} ) {
1036 my $cust_svc = qsearchs( 'cust_svc',
1037 { 'svcnum' => $object_map{legacy_email}{$username} }
1039 next unless $cust_svc;
1040 next if $cust_svc->pkgnum;
1042 my $custnum = $object_map{cust_main}{$username};
1044 my $master = $master_map{$username};
1045 $custnum = $object_map{'cust_main'}{$master}
1047 next unless $custnum;
1050 #my $extra_sql = ' AND 0 != (select freq from part_pkg where '.
1051 # 'cust_pkg.pkgpart = part_pkg.pkgpart )';
1052 my $extra_sql = " AND 'Prior balance' != (select pkg from part_pkg where ".
1053 "cust_pkg.pkgpart = part_pkg.pkgpart )";
1055 my @cust_pkg = qsearch( {
1056 'table' => 'cust_pkg',
1057 'hashref' => { 'custnum' => $custnum,
1060 'extra_sql' => $extra_sql,
1062 next unless scalar(@cust_pkg);
1064 $cust_svc->pkgnum($cust_pkg[0]->pkgnum);
1072 $d_dbh->commit or die $d_dbh->errstr;