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';
33 my $legacy_domain_svcnum = 1;
34 my $legacy_ppp_svcnum = 2;
35 my $legacy_email_svcnum = 3;
36 #my $legacy_broadband_svcnum = 4;
37 my $legacy_broadband_svcnum = 14;
38 #my $previous_credit_reasonnum = 1;
39 my $previous_credit_reasonnum = 1220;
43 my $state = ''; #statemachine-ish
60 $s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass,
63 'ShowErrorStatement' => 1
67 foreach ( qw ( billcycle cust email product ) ) {
70 print "parsing $sourcefile\n";
72 die "bad file name" unless $sourcefile =~ /^\w+$/;
78 if ( $c_sth = $s_dbh->prepare("SELECT COUNT(*) FROM $sourcefile") ) {
79 if ( $c_sth->execute ) {
80 if ( $c_sth->fetchrow_arrayref->[0] ) {
81 warn "already have data in $sourcefile table; skipping";
87 my $tp = new HTML::TableParser( \@args, { Decode => 1, Trim => 1, Chomp => 1 });
88 $tp->parse_file($sourcefile.$extension) or die "failed";
89 $s_dbh->commit or die $s_dbh->errstr;
95 warn "start\n" if $DEBUG;
97 die "unexpected state change" unless $state eq '';
98 die "unexpected table" unless $table_id eq '1';
103 warn "end\n" if $DEBUG;
104 my ($tbl_id, $line, $udata) = @_;
105 die "unexpected state change in header" unless $state eq 'rows';
106 die "unexpected table" unless $tbl_id eq '1';
111 warn "header\n" if $DEBUG;
112 my ($tbl_id, $line, $cols, $udata) = @_;
113 die "unexpected state change in header" unless $state eq 'table';
114 die "unexpected table" unless $tbl_id eq '1';
117 die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols)
118 if scalar(grep { !/^[ \w\r]+$/ } @$cols);
120 my $sql = "CREATE TABLE $sourcefile ( ".
121 join(', ', map { s/[ \r]/_/g; "$_ varchar NULL" } @$cols). " )";
122 $s_dbh->do($sql) or die "create table failed: ". $s_dbh->errstr;
123 $columncount = scalar( @$cols );
127 warn "row\n" if $DEBUG;
128 my ($tbl_id, $line, $cols, $udata) = @_;
129 die "unexpected state change in row" unless $state eq 'rows';
130 die "unexpected table" unless $tbl_id eq '1';
132 die "invalid number of columns: ". join(', ', @$cols)
133 unless (scalar(@$cols) == $columncount);
135 my $sql = "INSERT INTO $sourcefile VALUES(".
136 join(', ', map { $s_dbh->quote($_) } @$cols). ")";
137 $s_dbh->do($sql) or die "insert failed: ". $s_dbh->errstr;
139 warn "row $rowcount\n" unless ($rowcount % 1000);
144 $FS::cust_main::import=1;
145 $FS::cust_pkg::disable_agentcheck = 1;
147 my (%part_pkg_map) = ();
148 my (%referrals) = ();
154 my (%cust_pkg_map) = ();
155 my (%object_map) = ();
156 my (%package_cache) = ();
160 my ( $href ) = ( shift );
161 $href->{'one_type_item'}
163 : int(eval "$href->{'months_credit'} + 0");
167 my ( $field, $hash ) = ( shift, shift );
168 $field = 'bill_'. $field
169 if $hash->{'billing_use'} eq 'Billing Address';
174 my ( $field, $hash ) = ( shift, shift );
175 $field = 'bill_'. $field
176 if $hash->{'billing_use'} eq 'Billing Address';
177 my $ac = ( $hash->{$field. '_area_code'}
178 && $hash->{$field. '_area_code'} =~ /^\d{3}$/ )
179 ? $hash->{$field. '_area_code'}. '-'
182 ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
183 ? $ac. $hash->{$field}
188 my ( $field, $hash ) = ( shift, shift );
189 $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
193 my ( $field, $hash ) = ( shift, shift );
194 $hash->{'billing_use'} eq 'Billing Address' && $hash->{$field} =~ /^\d{3}-\d{4}$/
195 ? ( $hash->{$field. '_area_code'} =~ /^\d{3}$/
196 ? $hash->{$field. '_area_code'}. '-'
202 my %payby_map = ( '' => 'BILL',
204 'Credit Card' => 'CARD',
205 'Bank Debit' => 'CHEK',
206 'Virtual Check' => 'CHEK',
209 $payby_map{ shift->{billing_type} };
213 my ($object, $field) = (shift, shift);
214 my $value = $object->getfield($field);
215 $value =~ s/[^\w \,\.\-\']/ /g;
216 $object->setfield($field, $value);
220 my ($object, $field) = (shift, shift);
221 my $value = $object->getfield($field);
222 $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
223 $object->setfield($field, $value);
227 my ($object, $field) = (shift, shift);
228 my $value = $object->getfield($field);
229 $value = 'TX' if $value eq 'TTX';
230 $object->setfield($field, $value);
234 my ($object, $field) = (shift, shift);
235 my $value = $object->getfield($field);
236 $value =~ s/[^-\d]//g;
237 $object->setfield($field, $value);
241 part_pkg => { 'stable' => 'product',
243 { 'pkg' => sub { my $href = shift;
244 $href->{'description'}
245 ? $href->{'description'}
246 : $href->{'product_id'};
248 'comment' => 'product_id',
249 'freq' => sub { pkg_freq(shift) },
250 'recur' => sub { my $href = shift;
251 my $price = ( pkg_freq($href)
252 ? $href->{'unit_price'}
255 $price =~ s/[^\d.]//g;
256 $price = 0 unless $price;
257 sprintf("%.2f", $price);
259 'setuptax' => sub { my $href = shift;
260 $href->{'taxable'} ? '' : 'Y';
262 'recurtax' => sub { my $href = shift;
263 $href->{'taxable'} ? '' : 'Y';
265 'plan' => sub { 'flat' },
266 'disabled' => sub { 'Y' },
267 'pkg_svc' => sub { my $href = shift;
269 if (pkg_freq($href)){
270 $result->{$legacy_ppp_svcnum} = 1;
271 $result->{$legacy_email_svcnum} =
272 $href->{emails_allowed}
273 if $href->{emails_allowed};
276 'primary_svc'=> sub { pkg_freq(shift)
282 'fixup' => sub { my $part_pkg = shift;
284 return 1 unless $part_pkg->comment;
285 $package_cache{$part_pkg->comment} = $part_pkg;
288 'wrapup' => sub { foreach (keys %package_cache) {
289 my $part_pkg = $package_cache{$_};
291 { map { my $v = $part_pkg->$_;
298 $part_pkg->insert(options=>$options);
299 die "Error inserting referral: $error"
301 $count++ unless $error;
305 part_referral => { 'stable' => 'cust',
307 { 'agentnum' => sub { $agentnum },
308 'referral' => sub { my $r = shift->{'referred_from'};
312 'fixup' => sub { 1 },
313 'wrapup' => sub { foreach (keys %referrals) {
315 new FS::part_referral( {
316 'agentnum' => $agentnum,
317 'referral' => $referrals{$_},
319 my $error = $part_referral->insert;
320 die "Error inserting referral: $error"
322 $count++ unless $error;
323 $referrals{$_} = $part_referral->refnum;
327 svc_acct => { 'stable' => 'cust',
329 { 'username' => 'login',
330 '_password' => 'password',
331 'svcpart' => sub{ $legacy_ppp_svcnum },
332 'domsvc' => sub{ $legacy_domain_svcnum },
333 'status' => 'status',
335 'fixup' => sub { my $svc_acct = shift;
337 my $id = $row->{'master_account'}
338 ? 'slave:'. $row->{'customer_id'}
340 my $status = $svc_acct->status;
341 if ( $status ne 'Current'
342 && $status ne 'On Hold' )
345 str2time($row->{termination_date});
346 warn "not creating (cancelled) svc_acct for " .
347 $svc_acct->username. "\n";
350 $susp{$id} = str2time($row->{hold_date})
351 if $status eq 'On Hold';
352 $adjo{$id} = str2time($row->{hold_date})
353 if ( $status eq 'Current' &&
356 str2time($row->{expiration_date});
359 'skey' => sub { my $svc_acct = shift;
361 my $id = $row->{'master_account'}
362 ? 'slave:'. $row->{'customer_id'}
366 cust_main => { 'stable' => 'cust',
368 { 'agentnum' => sub { $agentnum },
369 'agent_custid' => sub { my $id = shift->{'customer_number'};
370 if (exists($custid{$id})) {
372 $id. chr(64 + $custid{$id});
378 'last' => sub { b_or('last_name', shift) || ' ' },
379 'first' => sub { b_or('first_name', shift) || ' ' },
380 'stateid' => 'drivers_license_number',
381 'signupdate' => sub { str2time(shift->{'creation_date'}) },
382 'company' => sub { b_or('company_name', shift) },
383 'address1' => sub { b_or('address', shift) || ' ' },
384 'city' => sub { b_or('city', shift) || 'Paris' },
385 'state' => sub { uc(b_or('state', shift)) || 'TX' },
386 'zip' => sub { b_or('zip_code', shift) || '75460' },
387 'country' => sub { 'US' },
388 'daytime' => sub { p_or('phone', shift) },
389 'night' => sub { p_or('phone_alternate_1', shift) },
390 'fax' => sub { p_or('fax', shift) },
391 'ship_last' => sub { or_b('last_name', shift) },
392 'ship_first' => sub { or_b('first_name', shift) },
393 'ship_company' => sub { or_b('company_name', shift) },
394 'ship_address1'=> sub { or_b('address', shift) },
395 'ship_city' => sub { or_b('city', shift) },
396 'ship_state' => sub { uc(or_b('state', shift)) },
397 'ship_zip' => sub { or_b('zip_code', shift) },
398 'ship_daytime' => sub { or_p('phone', shift) },
399 'ship_fax' => sub { or_p('fax', shift) },
401 'payinfo' => sub { my $hash = shift;
402 my $payby = payby($hash);
403 if ($payby eq 'CARD') {
404 $hash->{'credit_card_number_1'}.
405 $hash->{'credit_card_number_2'}.
406 $hash->{'credit_card_number_3'}.
407 $hash->{'credit_card_number_4'};
408 }elsif ($payby eq 'CHEK') {
409 $hash->{'bank_account_number'}.
411 $hash->{'bank_transit_number'};
412 }elsif ($payby eq 'BILL') {
413 $hash->{'blanket_purchase_order_number'};
415 die "unexpected payby";
418 'paycvv' => sub { my $hash = shift;
419 my $payby = payby($hash);
420 if ($payby eq 'CARD') {
421 $hash->{'credit_card_cvv_number'};
426 'paydate' => sub { my $hash = shift;
427 my $payby = payby($hash);
428 if ($payby eq 'CARD') {
430 $hash->{'credit_card_exp_date_2'}.
433 $hash->{'credit_card_exp_date_1'},
442 'payname' => sub { my $hash = shift;
443 my $payby = payby($hash);
444 if ($payby eq 'CARD') {
445 $hash->{'credit_card_name'};
446 }elsif ($payby eq 'CHEK') {
447 $hash->{'bank_name'};
452 'paytype' => sub { my $hash = shift;
453 my $payby = payby($hash);
454 if ($payby eq 'CHEK') {
455 $hash->{'bank_account_to_debit'}
457 $hash->{bank_account_to_debit}
463 'tax' => sub { shift->{taxable} eq '' ? 'Y' : '' },
464 'refnum' => sub { $referrals{shift->{'referred_from'}}
468 'fixup' => sub { my $cust_main = shift;
470 return 1 if $row->{master_account};
471 $cust_main->ship_country('US')
472 if $cust_main->has_ship_address;
473 ut_name_fixup($cust_main, 'first');
474 ut_name_fixup($cust_main, 'company');
475 ut_name_fixup($cust_main, 'last');
476 $cust_main->payby('BILL')
477 if ($cust_main->payby eq 'CHEK' &&
478 $cust_main->payinfo !~ /^\d+\@\d{9}$/);
479 $cust_main->payby('BILL')
480 if ($cust_main->payby eq 'CARD' &&
481 $cust_main->payinfo =~ /^\s*$/);
482 $cust_main->paydate('2037-12-01')
483 if ($cust_main->payby eq 'BILL');
484 ut_text_fixup($cust_main, 'address1');
485 ut_state_fixup($cust_main, 'state');
486 ut_zip_fixup($cust_main, 'zip');
489 'skey' => sub { my $object = shift;
491 my $balance = sprintf("%.2f",
492 $href->{balance_due});
494 my $cust_credit = new FS::cust_credit({
495 'custnum' => $object->custnum,
496 'amount' => sprintf("%.2f", -$balance),
497 'reasonnum' => $previous_credit_reasonnum,
499 my $error = $cust_credit->insert;
500 warn "Error inserting credit for ",
501 $href->{'login'}, " : $error\n"
504 }elsif($balance > 0) {
505 my $error = $object->charge(
506 $balance, "Prior balance",
508 warn "Error inserting balance charge for ",
509 $href->{'login'}, " : $error\n"
516 #cust_main => { 'stable' => 'cust',
518 # { 'referred_by' => sub { my $href = shift;
519 # my $u = shift->{'login'};
520 # my $cn = $href->{'customer_number'};
522 # my $c = qsearch( 'cust_main',
523 # { 'custnum' => $cn }
524 # ) or die "can't fine customer $cn";
526 # my $s = qsearch( 'svc_acct',
527 # { 'username' => $u }
530 # my $n = $s->cust_svc
535 # $c->referral_custnum($n);
536 # my $error = $c->replace;
537 # die "error setting referral: $error"
542 # 'fixup' => sub { 1 },
544 cust_pkg => { 'stable' => 'billcycle',
546 { 'custnum' => sub { my $l = shift->{cbilling_cycle_login};
547 $object_map{'cust_main'}{$l};
549 'pkgpart' => sub { my $p = shift->{product_id};
551 ? $package_cache{$p}->pkgpart
554 'setup' => sub { str2time(shift->{creation_date}) },
555 'bill' => sub { my $href = shift;
556 my $id = $href->{'slave_account_id'}
557 ? 'slave:'. $href->{'slave_account_id'}
558 : $href->{'cbilling_cycle_login'};
561 'susp' => sub { my $href = shift;
562 my $id = $href->{'slave_account_id'}
563 ? 'slave:'. $href->{'slave_account_id'}
564 : $href->{'cbilling_cycle_login'};
567 'adjo' => sub { my $href = shift;
568 my $id = $href->{'slave_account_id'}
569 ? 'slave:'. $href->{'slave_account_id'}
570 : $href->{'cbilling_cycle_login'};
573 'cancel' => sub { my $href = shift;
574 my $id = $href->{'slave_account_id'}
575 ? 'slave:'. $href->{'slave_account_id'}
576 : $href->{'cbilling_cycle_login'};
580 'skey' => sub { my $object = shift;
582 if ($href->{'slave_account_id'}) {
583 'slave:'. $href->{'slave_account_id'};
585 my $id = $href->{'billing_cycle_item_id'};
586 $cust_pkg_map{$id} = $object->pkgnum;
587 $href->{'cbilling_cycle_login'};
590 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
592 qsearchs( 'cust_svc', { 'svcnum' =>
593 $object_map{'svc_acct'}{$id} }
596 warn "can't find legacy ppp $id\n";
600 pkgnum($object_map{'cust_pkg'}{$id});
601 my $error = $cust_svc->replace;
602 warn "error linking legacy ppp $id: $error\n";
606 svc_acct => { 'stable' => 'email',
608 { 'username' => 'email_name',
609 '_password' => 'password',
610 'svcpart' => sub{ $legacy_email_svcnum },
611 'domsvc' => sub{ $legacy_domain_svcnum },
613 'fixup' => sub { my $object = shift;
614 my ($sd,$sm,$sy) = split '/',
615 $object->{shut_off_date}
616 if $object->{shut_off_date};
617 if ($sd && $sm && $sy) {
618 my ($cd, $cm, $cy) = (localtime)[3,4,5];
620 return 1 if $sy < $cy;
621 return 1 if ($sy == $cy && $sm < $cm);
622 return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
624 return 1 if $object_map{'cust_main'}{$object->username};
627 'skey' => sub { my $object = shift;
629 'email:'. $href->{'email_customer_id'};
631 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
632 next unless $id =~ /^email:(\d+)/;
635 qsearchs( 'cust_svc', { 'svcnum' =>
636 $object_map{'svc_acct'}{$id} }
639 warn "can't find legacy ppp $id\n";
644 pkgnum($cust_pkg_map{$custid});
645 my $error = $cust_svc->replace;
646 warn "error linking legacy ppp $id: $error\n";
652 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
653 my $d_dbh = adminsuidsetup $d_dbuser;
655 local $FS::UID::AutoCommit = 0;
658 my ($table, $href) = (shift @tables, shift @tables);
659 my $stable = $href->{'stable'} or die "No source table"; # good enough for now
660 my (%mapping) = %{$href->{'mapping'}};
661 my ($fixup) = $href->{'fixup'};
662 my ($wrapup) = $href->{'wrapup'};
663 my ($id) = $href->{'id'};
664 my ($skey) = $href->{'skey'};
666 $d_dbh->do("delete from $table"); #XXX FIXME!
668 my $s_sth = $s_dbh->prepare("select count(*) from $stable");
669 $s_sth->execute or die $s_sth->errstr;
670 my $rowcount = $s_sth->fetchrow_arrayref->[0];
672 $s_sth = $s_dbh->prepare("select * from $stable");
673 $s_sth->execute or die $s_sth->errstr;
677 while ( $row = $s_sth->fetchrow_hashref ) {
678 my $class = "FS::$table";
680 warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
681 unless( !$count || $count % 100 );
683 my $object = new $class ( {
684 map { $_ => ( ref($mapping{$_}) eq 'CODE'
685 ? &{$mapping{$_}}($row)
686 : $row->{$mapping{$_}}
691 my $skip = &{$fixup}($object, $row)
695 my $error = $object->insert;
697 warn "Error inserting $table ".
698 join(", ", map{"$_ => ". $object->get($_)} fields $object).
703 my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
705 $object_map{$table}{$key} = $object->get($object->primary_key)
714 print "$count/$rowcount of $table SUCCESSFULLY processed\n";
721 $d_dbh->commit or die $d_dbh->errstr;