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} };
214 my ($object, $field) = (shift, shift);
215 my $value = $object->getfield($field);
216 $value =~ s/[^\w \,\.\-\']/ /g;
217 $object->setfield($field, $value);
221 my ($object, $field) = (shift, shift);
222 my $value = $object->getfield($field);
223 $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
224 $object->setfield($field, $value);
228 my ($object, $field) = (shift, shift);
229 my $value = $object->getfield($field);
230 $value = 'TX' if $value eq 'TTX';
231 $object->setfield($field, $value);
235 my ($object, $field) = (shift, shift);
236 my $value = $object->getfield($field);
237 $value =~ s/[^-\d]//g;
238 $object->setfield($field, $value);
242 part_pkg => { 'stable' => 'product',
244 { 'pkg' => sub { my $href = shift;
245 $href->{'description'}
246 ? $href->{'description'}
247 : $href->{'product_id'};
249 'comment' => 'product_id',
250 'freq' => sub { pkg_freq(shift) },
251 'recur' => sub { my $href = shift;
252 my $price = ( pkg_freq($href)
253 ? $href->{'unit_price'}
256 $price =~ s/[^\d.]//g;
257 $price = 0 unless $price;
258 sprintf("%.2f", $price);
260 'setuptax' => sub { my $href = shift;
261 $href->{'taxable'} ? '' : 'Y';
263 'recurtax' => sub { my $href = shift;
264 $href->{'taxable'} ? '' : 'Y';
266 'plan' => sub { 'flat' },
267 'disabled' => sub { 'Y' },
268 'pkg_svc' => sub { my $href = shift;
270 if (pkg_freq($href)){
271 $result->{$legacy_ppp_svcnum} = 1;
272 $result->{$legacy_email_svcnum} =
273 $href->{emails_allowed}
274 if $href->{emails_allowed};
277 'primary_svc'=> sub { pkg_freq(shift)
283 'fixup' => sub { my $part_pkg = shift;
285 return 1 unless $part_pkg->comment;
286 $package_cache{$part_pkg->comment} = $part_pkg;
289 'wrapup' => sub { foreach (keys %package_cache) {
290 my $part_pkg = $package_cache{$_};
292 { map { my $v = $part_pkg->$_;
299 $part_pkg->insert(options=>$options);
300 die "Error inserting referral: $error"
302 $count++ unless $error;
306 part_referral => { 'stable' => 'cust',
308 { 'agentnum' => sub { $agentnum },
309 'referral' => sub { my $r = shift->{'referred_from'};
313 'fixup' => sub { 1 },
314 'wrapup' => sub { foreach (keys %referrals) {
316 new FS::part_referral( {
317 'agentnum' => $agentnum,
318 'referral' => $referrals{$_},
320 my $error = $part_referral->insert;
321 die "Error inserting referral: $error"
323 $count++ unless $error;
324 $referrals{$_} = $part_referral->refnum;
328 svc_acct => { 'stable' => 'cust',
330 { 'username' => 'login',
331 '_password' => 'password',
332 'svcpart' => sub{ $legacy_ppp_svcnum },
333 'domsvc' => sub{ $legacy_domain_svcnum },
334 'status' => 'status',
336 # 'fixup' => sub { my $svc_acct = shift;
338 # my $id = $row->{'master_account'}
339 # ? 'slave:'. $row->{'customer_id'}
341 # my $status = $svc_acct->status;
342 # if ( $status ne 'Current'
343 # && $status ne 'On Hold' )
346 # str2time($row->{termination_date});
347 # warn "not creating (cancelled) svc_acct for " .
348 # $svc_acct->username. "\n";
351 # $susp{$id} = str2time($row->{hold_date})
352 # if $status eq 'On Hold';
353 # $adjo{$id} = str2time($row->{hold_date})
354 # if ( $status eq 'Current' &&
355 # $row->{hold_date} );
357 # str2time($row->{expiration_date});
360 'fixup' => sub { my $svc_acct = shift;
362 my $id = $row->{'master_account'}
363 ? 'slave:'. $row->{'customer_id'}
365 my $status = $svc_acct->status;
366 if ( $status ne 'Current'
367 && $status ne 'On Hold' )
370 str2time($row->{termination_date});
373 $susp{$id} = str2time($row->{hold_date})
374 if $status eq 'On Hold';
375 $adjo{$id} = str2time($row->{hold_date})
376 if ( $status eq 'Current' &&
379 str2time($row->{expiration_date});
381 qsearchs( 'svc_acct',
382 { 'username' => $row->{'login'} }
385 warn "can't find svc_acct for legacy ppp ".
390 $object_map{svc_acct}{$id} = $object->svcnum;
393 # 'skey' => sub { my $svc_acct = shift;
395 # my $id = $row->{'master_account'}
396 # ? 'slave:'. $row->{'customer_id'}
400 cust_main => { 'stable' => 'cust',
402 { 'agentnum' => sub { $agentnum },
403 'agent_custid' => sub { my $id = shift->{'customer_number'};
404 if (exists($custid{$id})) {
406 $id. chr(64 + $custid{$id});
412 'last' => sub { b_or('last_name', shift) || ' ' },
413 'first' => sub { b_or('first_name', shift) || ' ' },
414 'stateid' => 'drivers_license_number',
415 'signupdate' => sub { str2time(shift->{'creation_date'}) },
416 'company' => sub { b_or('company_name', shift) },
417 'address1' => sub { b_or('address', shift) || ' ' },
418 'city' => sub { b_or('city', shift) || 'Paris' },
419 'state' => sub { uc(b_or('state', shift)) || 'TX' },
420 'zip' => sub { b_or('zip_code', shift) || '75460' },
421 'country' => sub { 'US' },
422 'daytime' => sub { p_or('phone', shift) },
423 'night' => sub { p_or('phone_alternate_1', shift) },
424 'fax' => sub { p_or('fax', shift) },
425 'ship_last' => sub { or_b('last_name', shift) },
426 'ship_first' => sub { or_b('first_name', shift) },
427 'ship_company' => sub { or_b('company_name', shift) },
428 'ship_address1'=> sub { or_b('address', shift) },
429 'ship_city' => sub { or_b('city', shift) },
430 'ship_state' => sub { uc(or_b('state', shift)) },
431 'ship_zip' => sub { or_b('zip_code', shift) },
432 'ship_daytime' => sub { or_p('phone', shift) },
433 'ship_fax' => sub { or_p('fax', shift) },
435 'payinfo' => sub { my $hash = shift;
436 my $payby = payby($hash);
438 $hash->{'credit_card_number_1'}.
439 $hash->{'credit_card_number_2'}.
440 $hash->{'credit_card_number_3'}.
441 $hash->{'credit_card_number_4'};
443 $hash->{'bank_account_number'}.
445 $hash->{'bank_transit_number'};
446 if ($payby eq 'CARD') {
448 }elsif ($payby eq 'CHEK') {
450 }elsif ($payby eq 'BILL') {
451 my $info = $hash->{'blanket_purchase_order_number'};
452 $bank =~ s/[^\d\@]//g;
455 if $bank =~ /^\d+\@\d{9}/;
457 if $cc =~ /^\d{13,16}/;
460 die "unexpected payby";
463 'paycvv' => sub { my $hash = shift;
464 my $payby = payby($hash);
465 if ($payby eq 'CARD') {
466 $hash->{'credit_card_cvv_number'};
471 'paydate' => sub { my $hash = shift;
472 my $payby = payby($hash);
473 if ($payby eq 'CARD') {
475 $hash->{'credit_card_exp_date_2'}.
478 $hash->{'credit_card_exp_date_1'},
487 'payname' => sub { my $hash = shift;
488 my $payby = payby($hash);
489 if ($payby eq 'CARD') {
490 $hash->{'credit_card_name'};
491 }elsif ($payby eq 'CHEK') {
492 $hash->{'bank_name'};
497 'paytype' => sub { my $hash = shift;
498 my $payby = payby($hash);
499 if ($payby eq 'CHEK') {
500 $hash->{'bank_account_to_debit'}
502 $hash->{bank_account_to_debit}
508 'tax' => sub { shift->{taxable} eq '' ? 'Y' : '' },
509 'refnum' => sub { $referrals{shift->{'referred_from'}}
513 'fixup' => sub { my $cust_main = shift;
515 return 1 if $row->{master_account};
516 $cust_main->ship_country('US')
517 if $cust_main->has_ship_address;
518 ut_name_fixup($cust_main, 'first');
519 ut_name_fixup($cust_main, 'company');
520 ut_name_fixup($cust_main, 'last');
521 $cust_main->payby('BILL')
522 if ($cust_main->payby eq 'CHEK' &&
523 $cust_main->payinfo !~ /^\d+\@\d{9}$/);
524 $cust_main->payby('BILL')
525 if ($cust_main->payby eq 'CARD' &&
526 $cust_main->payinfo =~ /^\s*$/);
527 $cust_main->paydate('2037-12-01')
528 if ($cust_main->payby eq 'BILL');
529 ut_text_fixup($cust_main, 'address1');
530 ut_state_fixup($cust_main, 'state');
531 ut_zip_fixup($cust_main, 'zip');
534 'skey' => sub { my $object = shift;
536 my $balance = sprintf("%.2f",
537 $href->{balance_due});
539 my $cust_credit = new FS::cust_credit({
540 'custnum' => $object->custnum,
541 'amount' => sprintf("%.2f", -$balance),
542 'reasonnum' => $previous_credit_reasonnum,
544 my $error = $cust_credit->insert;
545 warn "Error inserting credit for ",
546 $href->{'login'}, " : $error\n"
549 }elsif($balance > 0) {
550 my $error = $object->charge(
551 $balance, "Prior balance",
553 warn "Error inserting balance charge for ",
554 $href->{'login'}, " : $error\n"
561 #cust_main => { 'stable' => 'cust',
563 # { 'referred_by' => sub { my $href = shift;
564 # my $u = shift->{'login'};
565 # my $cn = $href->{'customer_number'};
567 # my $c = qsearch( 'cust_main',
568 # { 'custnum' => $cn }
569 # ) or die "can't fine customer $cn";
571 # my $s = qsearch( 'svc_acct',
572 # { 'username' => $u }
575 # my $n = $s->cust_svc
580 # $c->referral_custnum($n);
581 # my $error = $c->replace;
582 # die "error setting referral: $error"
587 # 'fixup' => sub { 1 },
589 cust_pkg => { 'stable' => 'billcycle',
591 { 'custnum' => sub { my $l = shift->{cbilling_cycle_login};
592 $object_map{'cust_main'}{$l};
594 'pkgpart' => sub { my $p = shift->{product_id};
596 ? $package_cache{$p}->pkgpart
599 'setup' => sub { str2time(shift->{creation_date}) },
600 'bill' => sub { my $href = shift;
601 my $id = $href->{'slave_account_id'}
602 ? 'slave:'. $href->{'slave_account_id'}
603 : $href->{'cbilling_cycle_login'};
606 'susp' => sub { my $href = shift;
607 my $id = $href->{'slave_account_id'}
608 ? 'slave:'. $href->{'slave_account_id'}
609 : $href->{'cbilling_cycle_login'};
612 'adjo' => sub { my $href = shift;
613 my $id = $href->{'slave_account_id'}
614 ? 'slave:'. $href->{'slave_account_id'}
615 : $href->{'cbilling_cycle_login'};
618 'cancel' => sub { my $href = shift;
619 my $id = $href->{'slave_account_id'}
620 ? 'slave:'. $href->{'slave_account_id'}
621 : $href->{'cbilling_cycle_login'};
625 'skey' => sub { my $object = shift;
627 if ($href->{'slave_account_id'}) {
628 'slave:'. $href->{'slave_account_id'};
630 my $id = $href->{'billing_cycle_item_id'};
631 $cust_pkg_map{$id} = $object->pkgnum;
632 $href->{'cbilling_cycle_login'};
635 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
637 qsearchs( 'cust_svc', { 'svcnum' =>
638 $object_map{'svc_acct'}{$id} }
641 warn "can't find legacy ppp $id\n";
645 pkgnum($object_map{'cust_pkg'}{$id});
646 my $error = $cust_svc->replace;
647 warn "error linking legacy ppp $id: $error\n";
651 svc_acct => { 'stable' => 'email',
653 { 'username' => 'email_name',
654 '_password' => 'password',
655 'svcpart' => sub{ $legacy_email_svcnum },
656 'domsvc' => sub{ $legacy_domain_svcnum },
658 # 'fixup' => sub { my ($object, $row) = (shift,shift);
659 # my ($sd,$sm,$sy) = split '/',
660 # $row->{shut_off_date}
661 # if $row->{shut_off_date};
662 # if ($sd && $sm && $sy) {
663 # my ($cd, $cm, $cy) = (localtime)[3,4,5];
664 # $cy += 1900; $cm++;
665 # return 1 if $sy < $cy;
666 # return 1 if ($sy == $cy && $sm < $cm);
667 # return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
669 # return 1 if $object_map{'cust_main'}{$object->username};
672 'fixup' => sub { my ($object, $row) = (shift,shift);
673 my ($sd,$sm,$sy) = split '/',
674 $row->{shut_off_date}
675 if $row->{shut_off_date};
676 if ($sd && $sm && $sy) {
677 my ($cd, $cm, $cy) = (localtime)[3,4,5];
679 return 1 if $sy < $cy;
680 return 1 if ($sy == $cy && $sm < $cm);
681 return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
683 return 1 if $object_map{'cust_main'}{$object->username};
685 qsearchs( 'svc_acct',
686 { 'username' => $row->{'login'} }
688 unless( $svc_acct ) {
689 warn "can't find svc_acct for email ".
693 $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svc_acct->svcnum;
696 # 'skey' => sub { my $object = shift;
698 # 'email:'. $href->{'email_customer_id'};
700 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
701 next unless $id =~ /^email:(\d+)/;
704 qsearchs( 'cust_svc', { 'svcnum' =>
705 $object_map{'svc_acct'}{$id} }
708 warn "can't find legacy email $id\n";
713 pkgnum($cust_pkg_map{$custid});
714 my $error = $cust_svc->replace;
715 warn "error linking legacy email $id: $error\n";
721 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
722 my $d_dbh = adminsuidsetup $d_dbuser;
724 local $FS::UID::AutoCommit = 0;
727 my ($table, $href) = (shift @tables, shift @tables);
728 my $stable = $href->{'stable'} or die "No source table"; # good enough for now
729 my (%mapping) = %{$href->{'mapping'}};
730 my ($fixup) = $href->{'fixup'};
731 my ($wrapup) = $href->{'wrapup'};
732 my ($id) = $href->{'id'};
733 my ($skey) = $href->{'skey'};
735 #$d_dbh->do("delete from $table");
737 my $s_sth = $s_dbh->prepare("select count(*) from $stable");
738 $s_sth->execute or die $s_sth->errstr;
739 my $rowcount = $s_sth->fetchrow_arrayref->[0];
741 $s_sth = $s_dbh->prepare("select * from $stable");
742 $s_sth->execute or die $s_sth->errstr;
746 while ( $row = $s_sth->fetchrow_hashref ) {
747 my $class = "FS::$table";
749 warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
750 unless( !$count || $count % 100 );
752 my $object = new $class ( {
753 map { $_ => ( ref($mapping{$_}) eq 'CODE'
754 ? &{$mapping{$_}}($row)
755 : $row->{$mapping{$_}}
760 my $skip = &{$fixup}($object, $row)
764 my $error = $object->insert;
766 warn "Error inserting $table ".
767 join(", ", map{"$_ => ". $object->get($_)} fields $object).
772 my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
774 $object_map{$table}{$key} = $object->get($object->primary_key)
783 print "$count/$rowcount of $table SUCCESSFULLY processed\n";
790 $d_dbh->commit or die $d_dbh->errstr;