8 use FS::UID qw(adminsuidsetup);
14 use FS::part_referral;
16 use FS::Record qw(qsearch qsearchs);
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';
34 my $legacy_domain_svcnum = 1;
35 my $legacy_ppp_svcnum = 2;
36 my $legacy_email_svcnum = 3;
37 #my $legacy_broadband_svcnum = 4;
38 #my $legacy_broadband_svcnum = 14;
39 #my $previous_credit_reasonnum = 1;
40 my $previous_credit_reasonnum = 1220;
44 my $state = ''; #statemachine-ish
61 $s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass,
64 'ShowErrorStatement' => 1
68 foreach ( qw ( billcycle cust email product ) ) {
71 print "parsing $sourcefile\n";
73 die "bad file name" unless $sourcefile =~ /^\w+$/;
79 if ( $c_sth = $s_dbh->prepare("SELECT COUNT(*) FROM $sourcefile") ) {
80 if ( $c_sth->execute ) {
81 if ( $c_sth->fetchrow_arrayref->[0] ) {
82 warn "already have data in $sourcefile table; skipping";
88 my $tp = new HTML::TableParser( \@args, { Decode => 1, Trim => 1, Chomp => 1 });
89 $tp->parse_file($sourcefile.$extension) or die "failed";
90 $s_dbh->commit or die $s_dbh->errstr;
96 warn "start\n" if $DEBUG;
98 die "unexpected state change" unless $state eq '';
99 die "unexpected table" unless $table_id eq '1';
104 warn "end\n" if $DEBUG;
105 my ($tbl_id, $line, $udata) = @_;
106 die "unexpected state change in header" unless $state eq 'rows';
107 die "unexpected table" unless $tbl_id eq '1';
112 warn "header\n" if $DEBUG;
113 my ($tbl_id, $line, $cols, $udata) = @_;
114 die "unexpected state change in header" unless $state eq 'table';
115 die "unexpected table" unless $tbl_id eq '1';
118 die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols)
119 if scalar(grep { !/^[ \w\r]+$/ } @$cols);
121 my $sql = "CREATE TABLE $sourcefile ( ".
122 join(', ', map { s/[ \r]/_/g; "$_ varchar NULL" } @$cols). " )";
123 $s_dbh->do($sql) or die "create table failed: ". $s_dbh->errstr;
124 $columncount = scalar( @$cols );
128 warn "row\n" if $DEBUG;
129 my ($tbl_id, $line, $cols, $udata) = @_;
130 die "unexpected state change in row" unless $state eq 'rows';
131 die "unexpected table" unless $tbl_id eq '1';
133 die "invalid number of columns: ". join(', ', @$cols)
134 unless (scalar(@$cols) == $columncount);
136 my $sql = "INSERT INTO $sourcefile VALUES(".
137 join(', ', map { $s_dbh->quote($_) } @$cols). ")";
138 $s_dbh->do($sql) or die "insert failed: ". $s_dbh->errstr;
140 warn "row $rowcount\n" unless ($rowcount % 1000);
145 $FS::cust_main::import=1;
146 $FS::cust_pkg::disable_agentcheck = 1;
148 my (%part_pkg_map) = ();
149 my (%referrals) = ();
155 my (%cust_pkg_map) = ();
156 my (%object_map) = ();
157 my (%package_cache) = ();
161 my ( $href ) = ( shift );
162 $href->{'one_type_item'}
164 : int(eval "$href->{'months_credit'} + 0");
168 my ( $field, $hash ) = ( shift, shift );
169 $field = 'bill_'. $field
170 if $hash->{'billing_use'} eq 'Billing Address';
175 my ( $field, $hash ) = ( shift, shift );
176 $field = 'bill_'. $field
177 if $hash->{'billing_use'} eq 'Billing Address';
178 my $ac = ( $hash->{$field. '_area_code'}
179 && $hash->{$field. '_area_code'} =~ /^\d{3}$/ )
180 ? $hash->{$field. '_area_code'}. '-'
183 ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
184 ? $ac. $hash->{$field}
189 my ( $field, $hash ) = ( shift, shift );
190 $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
194 my ( $field, $hash ) = ( shift, shift );
195 $hash->{'billing_use'} eq 'Billing Address' && $hash->{$field} =~ /^\d{3}-\d{4}$/
196 ? ( $hash->{$field. '_area_code'} =~ /^\d{3}$/
197 ? $hash->{$field. '_area_code'}. '-'
203 my %payby_map = ( '' => 'BILL',
205 'Credit Card' => 'CARD',
206 'Bank Debit' => 'CHEK',
207 'Virtual Check' => 'CHEK',
210 $payby_map{ shift->{billing_type} };
215 my $payby = payby($hash);
218 $hash->{'credit_card_number_1'}.
219 $hash->{'credit_card_number_2'}.
220 $hash->{'credit_card_number_3'}.
221 $hash->{'credit_card_number_4'};
223 $hash->{'bank_account_number'}.
225 $hash->{'bank_transit_number'};
226 if ($payby eq 'CARD') {
228 }elsif ($payby eq 'CHEK') {
230 }elsif ($payby eq 'BILL') {
231 $info = $hash->{'blanket_purchase_order_number'};
232 $bank =~ s/[^\d\@]//g;
234 if ( $bank =~ /^\d+\@\d{9}/) {
238 if ( $cc =~ /^\d{13,16}/ ) {
243 die "unexpected payby";
249 my ($object, $field) = (shift, shift);
250 my $value = $object->getfield($field);
251 $value =~ s/[^\w \,\.\-\']/ /g;
252 $object->setfield($field, $value);
256 my ($object, $field) = (shift, shift);
257 my $value = $object->getfield($field);
258 $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
259 $object->setfield($field, $value);
263 my ($object, $field) = (shift, shift);
264 my $value = $object->getfield($field);
265 $value = 'TX' if $value eq 'TTX';
266 $object->setfield($field, $value);
270 my ($object, $field) = (shift, shift);
271 my $value = $object->getfield($field);
272 $value =~ s/[^-\d]//g;
273 $object->setfield($field, $value);
277 part_pkg => { 'stable' => 'product',
279 { 'pkg' => sub { my $href = shift;
280 $href->{'description'}
281 ? $href->{'description'}
282 : $href->{'product_id'};
284 'comment' => 'product_id',
285 'freq' => sub { pkg_freq(shift) },
286 'recur' => sub { my $href = shift;
287 my $price = ( pkg_freq($href)
288 ? $href->{'unit_price'}
291 $price =~ s/[^\d.]//g;
292 $price = 0 unless $price;
293 sprintf("%.2f", $price);
295 'setuptax' => sub { my $href = shift;
296 $href->{'taxable'} ? '' : 'Y';
298 'recurtax' => sub { my $href = shift;
299 $href->{'taxable'} ? '' : 'Y';
301 'plan' => sub { 'flat' },
302 'disabled' => sub { 'Y' },
303 'pkg_svc' => sub { my $href = shift;
305 if (pkg_freq($href)){
306 $result->{$legacy_ppp_svcnum} = 1;
307 $result->{$legacy_email_svcnum} =
308 $href->{emails_allowed}
309 if $href->{emails_allowed};
312 'primary_svc'=> sub { pkg_freq(shift)
318 'fixup' => sub { my $part_pkg = shift;
320 return 1 unless $part_pkg->comment;
321 $package_cache{$part_pkg->comment} = $part_pkg;
324 'wrapup' => sub { foreach (keys %package_cache) {
325 my $part_pkg = $package_cache{$_};
327 { map { my $v = $part_pkg->$_;
334 $part_pkg->insert(options=>$options);
335 die "Error inserting referral: $error"
337 $count++ unless $error;
341 part_referral => { 'stable' => 'cust',
343 { 'agentnum' => sub { $agentnum },
344 'referral' => sub { my $r = shift->{'referred_from'};
348 'fixup' => sub { 1 },
349 'wrapup' => sub { foreach (keys %referrals) {
351 new FS::part_referral( {
352 'agentnum' => $agentnum,
353 'referral' => $referrals{$_},
355 my $error = $part_referral->insert;
356 die "Error inserting referral: $error"
358 $count++ unless $error;
359 $referrals{$_} = $part_referral->refnum;
363 svc_acct => { 'stable' => 'cust',
365 { 'username' => 'login',
366 '_password' => 'password',
367 'svcpart' => sub{ $legacy_ppp_svcnum },
368 'domsvc' => sub{ $legacy_domain_svcnum },
369 'status' => 'status',
371 # 'fixup' => sub { my $svc_acct = shift;
373 # my $id = $row->{'master_account'}
374 # ? 'slave:'. $row->{'customer_id'}
376 # my $status = $svc_acct->status;
377 # if ( $status ne 'Current'
378 # && $status ne 'On Hold' )
381 # str2time($row->{termination_date});
382 # warn "not creating (cancelled) svc_acct for " .
383 # $svc_acct->username. "\n";
386 # $susp{$id} = str2time($row->{hold_date})
387 # if $status eq 'On Hold';
388 # $adjo{$id} = str2time($row->{hold_date})
389 # if ( $status eq 'Current' &&
390 # $row->{hold_date} );
392 # str2time($row->{expiration_date});
395 'fixup' => sub { my $svc_acct = shift;
397 my $id = $row->{'master_account'}
398 ? 'slave:'. $row->{'customer_id'}
400 my $status = $svc_acct->status;
401 if ( $status ne 'Current'
402 && $status ne 'On Hold' )
405 str2time($row->{termination_date});
408 $susp{$id} = str2time($row->{hold_date})
409 if $status eq 'On Hold';
410 $adjo{$id} = str2time($row->{hold_date})
411 if ( $status eq 'Current' &&
414 str2time($row->{expiration_date});
416 qsearchs( 'svc_acct',
417 { 'username' => $row->{'login'} }
420 warn "can't find svc_acct for legacy ppp ".
421 $row->{'login'}, "\n";
425 $object_map{svc_acct}{$id} = $object->svcnum;
428 # 'skey' => sub { my $svc_acct = shift;
430 # my $id = $row->{'master_account'}
431 # ? 'slave:'. $row->{'customer_id'}
435 cust_main => { 'stable' => 'cust',
437 { 'agentnum' => sub { $agentnum },
438 'agent_custid' => sub { my $id = shift->{'customer_number'};
439 if (exists($custid{$id})) {
441 $id. chr(64 + $custid{$id});
447 'last' => sub { b_or('last_name', shift) || ' ' },
448 'first' => sub { b_or('first_name', shift) || ' ' },
449 'stateid' => 'drivers_license_number',
450 'signupdate' => sub { str2time(shift->{'creation_date'}) },
451 'company' => sub { b_or('company_name', shift) },
452 'address1' => sub { b_or('address', shift) || ' ' },
453 'city' => sub { b_or('city', shift) || 'Paris' },
454 'state' => sub { uc(b_or('state', shift)) || 'TX' },
455 'zip' => sub { b_or('zip_code', shift) || '75460' },
456 'country' => sub { 'US' },
457 'daytime' => sub { p_or('phone', shift) },
458 'night' => sub { p_or('phone_alternate_1', shift) },
459 'fax' => sub { p_or('fax', shift) },
460 'ship_last' => sub { or_b('last_name', shift) },
461 'ship_first' => sub { or_b('first_name', shift) },
462 'ship_company' => sub { or_b('company_name', shift) },
463 'ship_address1'=> sub { or_b('address', shift) },
464 'ship_city' => sub { or_b('city', shift) },
465 'ship_state' => sub { uc(or_b('state', shift)) },
466 'ship_zip' => sub { or_b('zip_code', shift) },
467 'ship_daytime' => sub { or_p('phone', shift) },
468 'ship_fax' => sub { or_p('fax', shift) },
469 'tax' => sub { shift->{taxable} eq '' ? 'Y' : '' },
470 'refnum' => sub { $referrals{shift->{'referred_from'}}
474 'fixup' => sub { my $cust_main = shift;
476 return 1 if $row->{master_account};
477 $cust_main->ship_country('US')
478 if $cust_main->has_ship_address;
479 ut_name_fixup($cust_main, 'first');
480 ut_name_fixup($cust_main, 'company');
481 ut_name_fixup($cust_main, 'last');
483 my ($info, $payby) = payinfo($row);
484 $cust_main->payby($payby);
485 $cust_main->payinfo($info);
488 $row->{'credit_card_cvv_number'}
490 if ($payby eq 'CARD' or $payby eq 'DCRD');
492 $cust_main->paydate('20'.
493 $row->{'credit_card_exp_date_2'}. '-'.
495 $row->{'credit_card_exp_date_1'},
501 if ($payby eq 'CARD' or $payby eq 'DCRD');
504 $payname = $row->{'credit_card_name'}
505 if ($payby eq 'CARD' or $payby eq 'DCRD');
506 $payname = $row->{'bank_name'}
507 if ($payby eq 'CHEK' or $payby eq 'DCHK');
508 $cust_main->payname($payname);
511 $row->{'bank_account_to_debit'}
513 $row->{bank_account_to_debit}
516 if ($payby eq 'CHEK' or $payby eq 'DCHK');
518 $cust_main->payby('BILL')
519 if ($cust_main->payby eq 'CHEK' &&
520 $cust_main->payinfo !~ /^\d+\@\d{9}$/);
521 $cust_main->payby('BILL')
522 if ($cust_main->payby eq 'CARD' &&
523 $cust_main->payinfo =~ /^\s*$/);
524 $cust_main->paydate('2037-12-01')
525 if ($cust_main->payby eq 'BILL');
526 ut_text_fixup($cust_main, 'address1');
527 ut_state_fixup($cust_main, 'state');
528 ut_zip_fixup($cust_main, 'zip');
533 'skey' => sub { my $object = shift;
535 my $balance = sprintf("%.2f",
536 $href->{balance_due});
538 my $cust_credit = new FS::cust_credit({
539 'custnum' => $object->custnum,
540 'amount' => sprintf("%.2f", -$balance),
541 'reasonnum' => $previous_credit_reasonnum,
543 my $error = $cust_credit->insert;
544 warn "Error inserting credit for ",
545 $href->{'login'}, " : $error\n"
548 }elsif($balance > 0) {
549 my $error = $object->charge(
550 $balance, "Prior balance",
552 warn "Error inserting balance charge for ",
553 $href->{'login'}, " : $error\n"
560 #cust_main => { 'stable' => 'cust',
562 # { 'referred_by' => sub { my $href = shift;
563 # my $u = shift->{'login'};
564 # my $cn = $href->{'customer_number'};
566 # my $c = qsearch( 'cust_main',
567 # { 'custnum' => $cn }
568 # ) or die "can't fine customer $cn";
570 # my $s = qsearch( 'svc_acct',
571 # { 'username' => $u }
574 # my $n = $s->cust_svc
579 # $c->referral_custnum($n);
580 # my $error = $c->replace;
581 # die "error setting referral: $error"
586 # 'fixup' => sub { 1 },
588 cust_pkg => { 'stable' => 'billcycle',
590 { 'custnum' => sub { my $l = shift->{cbilling_cycle_login};
591 $object_map{'cust_main'}{$l};
593 'pkgpart' => sub { my $p = shift->{product_id};
595 ? $package_cache{$p}->pkgpart
598 'setup' => sub { str2time(shift->{creation_date}) },
599 'bill' => sub { my $href = shift;
600 my $id = $href->{'slave_account_id'}
601 ? 'slave:'. $href->{'slave_account_id'}
602 : $href->{'cbilling_cycle_login'};
605 'susp' => sub { my $href = shift;
606 my $id = $href->{'slave_account_id'}
607 ? 'slave:'. $href->{'slave_account_id'}
608 : $href->{'cbilling_cycle_login'};
611 'adjo' => sub { my $href = shift;
612 my $id = $href->{'slave_account_id'}
613 ? 'slave:'. $href->{'slave_account_id'}
614 : $href->{'cbilling_cycle_login'};
617 'cancel' => sub { my $href = shift;
618 my $id = $href->{'slave_account_id'}
619 ? 'slave:'. $href->{'slave_account_id'}
620 : $href->{'cbilling_cycle_login'};
624 'skey' => sub { my $object = shift;
626 if ($href->{'slave_account_id'}) {
627 'slave:'. $href->{'slave_account_id'};
629 my $id = $href->{'billing_cycle_item_id'};
630 $cust_pkg_map{$id} = $object->pkgnum;
631 $href->{'cbilling_cycle_login'};
634 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
636 qsearchs( 'cust_svc', { 'svcnum' =>
637 $object_map{'svc_acct'}{$id} }
640 warn "can't find legacy ppp $id\n";
644 pkgnum($object_map{'cust_pkg'}{$id});
645 my $error = $cust_svc->replace;
646 warn "error linking legacy ppp $id: $error\n";
650 svc_acct => { 'stable' => 'email',
652 { 'username' => 'email_name',
653 '_password' => 'password',
654 'svcpart' => sub{ $legacy_email_svcnum },
655 'domsvc' => sub{ $legacy_domain_svcnum },
657 # 'fixup' => sub { my ($object, $row) = (shift,shift);
658 # my ($sd,$sm,$sy) = split '/',
659 # $row->{shut_off_date}
660 # if $row->{shut_off_date};
661 # if ($sd && $sm && $sy) {
662 # my ($cd, $cm, $cy) = (localtime)[3,4,5];
663 # $cy += 1900; $cm++;
664 # return 1 if $sy < $cy;
665 # return 1 if ($sy == $cy && $sm < $cm);
666 # return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
668 # return 1 if $object_map{'cust_main'}{$object->username};
671 'fixup' => sub { my ($object, $row) = (shift,shift);
672 my ($sd,$sm,$sy) = split '/',
673 $row->{shut_off_date}
674 if $row->{shut_off_date};
675 if ($sd && $sm && $sy) {
676 my ($cd, $cm, $cy) = (localtime)[3,4,5];
678 return 1 if $sy < $cy;
679 return 1 if ($sy == $cy && $sm < $cm);
680 return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
682 return 1 if $object_map{'cust_main'}{$object->username};
684 qsearchs( 'svc_acct',
685 { 'username' => $row->{'login'} }
687 unless( $svc_acct ) {
688 warn "can't find svc_acct for email ".
689 $row->{'login'}. "\n";
692 $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svc_acct->svcnum;
695 # 'skey' => sub { my $object = shift;
697 # 'email:'. $href->{'email_customer_id'};
699 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
700 next unless $id =~ /^email:(\d+)/;
703 qsearchs( 'cust_svc', { 'svcnum' =>
704 $object_map{'svc_acct'}{$id} }
707 warn "can't find legacy email $id\n";
712 pkgnum($cust_pkg_map{$custid});
713 my $error = $cust_svc->replace;
714 warn "error linking legacy email $id: $error\n";
720 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
721 my $d_dbh = adminsuidsetup $d_dbuser;
723 local $FS::UID::AutoCommit = 0;
726 my ($table, $href) = (shift @tables, shift @tables);
727 my $stable = $href->{'stable'} or die "No source table"; # good enough for now
728 my (%mapping) = %{$href->{'mapping'}};
729 my ($fixup) = $href->{'fixup'};
730 my ($wrapup) = $href->{'wrapup'};
731 my ($id) = $href->{'id'};
732 my ($skey) = $href->{'skey'};
734 #$d_dbh->do("delete from $table");
736 my $s_sth = $s_dbh->prepare("select count(*) from $stable");
737 $s_sth->execute or die $s_sth->errstr;
738 my $rowcount = $s_sth->fetchrow_arrayref->[0];
740 $s_sth = $s_dbh->prepare("select * from $stable");
741 $s_sth->execute or die $s_sth->errstr;
745 while ( $row = $s_sth->fetchrow_hashref ) {
746 my $class = "FS::$table";
748 warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
749 unless( !$count || $count % 100 );
751 my $object = new $class ( {
752 map { $_ => ( ref($mapping{$_}) eq 'CODE'
753 ? &{$mapping{$_}}($row)
754 : $row->{$mapping{$_}}
759 my $skip = &{$fixup}($object, $row)
763 my $error = $object->insert;
765 warn "Error inserting $table ".
766 join(", ", map{"$_ => ". $object->get($_)} fields $object).
771 my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
773 $object_map{$table}{$key} = $object->get($object->primary_key)
782 print "$count/$rowcount of $table SUCCESSFULLY processed\n";
789 $d_dbh->commit or die $d_dbh->errstr;