bin/import-optigold.pl

   1 #!/usr/bin/perl -Tw
   2
   3 use strict;
   4 use DBI;
   5 use HTML::TableParser;
   6 use Date::Parse;
   7 use Data::Dumper;
   8 use FS::UID qw(adminsuidsetup);
   9 use FS::cust_credit;
  10 use FS::cust_main;
  11 use FS::cust_pkg;
  12 use FS::cust_svc;
  13 use FS::svc_acct;
  14 use FS::part_referral;
  15 use FS::part_pkg;
  16 use FS::Record qw(qsearch qsearchs);
  17
  18 my $DEBUG = 0;
  19
  20 my $dry_run = '0';
  21
  22 my $s_dbname = 'DBI:Pg:dbname=optigoldimport';
  23 my $s_dbuser = 'freeside';
  24 my $s_dbpass = '';
  25 my $extension = '.htm';
  26
  27 #my $d_dbuser = 'freeside';
  28 my $d_dbuser = 'enet';
  29 #my $d_dbuser = 'ivan';
  30
  31 #my $agentnum = 1;
  32 my $agentnum = 13;
  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;
  40
  41
  42
  43 my $state = '';  #statemachine-ish
  44 my $sourcefile;
  45 my $s_dbh;
  46 my $columncount;
  47 my $rowcount;
  48
  49 my @args = (
  50              {
  51                id    => 1,
  52                hdr   => \&header,
  53                row   => \&row,
  54                start => \&start,
  55                end   => \&end,
  56              },
  57            );
  58
  59
  60 $s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass,
  61                            { 'AutoCommit' => 0,
  62                              'ChopBlanks' => 1,
  63                              'ShowErrorStatement' => 1
  64                            }
  65                      );
  66
  67 foreach ( qw ( billcycle cust email product ) ) {
  68   $sourcefile = $_;
  69
  70   print "parsing $sourcefile\n";
  71
  72   die "bad file name" unless $sourcefile =~ /^\w+$/;
  73
  74   $columncount = 0;
  75   $rowcount = 0;
  76
  77   my $c_sth = '';
  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";
  82         next;
  83       }
  84     }
  85   }
  86
  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;
  90 #  $s_dbh->disconnect;
  91 }
  92
  93
  94 sub start {
  95   warn "start\n" if $DEBUG;
  96   my $table_id = shift;
  97   die "unexpected state change" unless $state eq '';
  98   die "unexpected table" unless $table_id eq '1';
  99   $state = 'table';
 100 }
 101
 102 sub end {
 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';
 107   $state = '';
 108 }
 109
 110 sub header {
 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';
 115   $state = 'rows';
 116
 117   die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols)
 118     if scalar(grep { !/^[ \w\r]+$/ } @$cols);
 119
 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 );
 124 }
 125
 126 sub row {
 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';
 131
 132   die "invalid number of columns: ". join(', ', @$cols)
 133     unless (scalar(@$cols) == $columncount);
 134
 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;
 138   $rowcount++;
 139   warn "row $rowcount\n" unless ($rowcount % 1000);
 140 }
 141
 142
 143
 144 $FS::cust_main::import=1;
 145 $FS::cust_pkg::disable_agentcheck = 1;
 146
 147 my (%part_pkg_map) = ();
 148 my (%referrals) = ();
 149 my (%custid) = ();
 150 my (%cancel) = ();
 151 my (%susp) = ();
 152 my (%adjo) = ();
 153 my (%bill) = ();
 154 my (%cust_pkg_map) = ();
 155 my (%object_map) = ();
 156 my (%package_cache) = ();
 157 my $count;
 158
 159 sub pkg_freq {
 160   my ( $href ) = ( shift );
 161   $href->{'one_type_item'}
 162     ? 0
 163     : int(eval "$href->{'months_credit'} + 0");
 164 }
 165
 166 sub b_or {
 167   my ( $field, $hash ) = ( shift, shift );
 168   $field = 'bill_'. $field
 169     if $hash->{'billing_use'} eq 'Billing Address';
 170   $hash->{$field};
 171 }
 172
 173 sub p_or {
 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'}. '-'
 180              : '903-' # wtf?
 181   ;
 182   ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
 183     ? $ac. $hash->{$field}
 184     : '';
 185 }
 186
 187 sub or_b {
 188   my ( $field, $hash ) = ( shift, shift );
 189   $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
 190 }
 191
 192 sub or_p {
 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'}. '-'
 197         : '903-'  # wtf?
 198       ). $hash->{$field}
 199     : '';
 200 }
 201
 202 my %payby_map = ( ''              => 'BILL',
 203                   'None'          => 'BILL',
 204                   'Credit Card'   => 'CARD',
 205                   'Bank Debit'    => 'CHEK',
 206                   'Virtual Check' => 'CHEK',
 207 );
 208 sub payby {
 209   $payby_map{ shift->{billing_type} };
 210 }
 211
 212 sub ut_name_fixup {
 213   my ($object, $field) = (shift, shift);
 214   my $value = $object->getfield($field);
 215   $value =~ s/[^\w \,\.\-\']/ /g;
 216   $object->setfield($field, $value);
 217 }
 218
 219 sub ut_text_fixup {
 220   my ($object, $field) = (shift, shift);
 221   my $value = $object->getfield($field);
 222   $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
 223   $object->setfield($field, $value);
 224 }
 225
 226 sub ut_state_fixup {
 227   my ($object, $field) = (shift, shift);
 228   my $value = $object->getfield($field);
 229   $value = 'TX' if $value eq 'TTX';
 230   $object->setfield($field, $value);
 231 }
 232
 233 sub ut_zip_fixup {
 234   my ($object, $field) = (shift, shift);
 235   my $value = $object->getfield($field);
 236   $value =~ s/[^-\d]//g;
 237   $object->setfield($field, $value);
 238 }
 239
 240 my @tables = (
 241 part_pkg => { 'stable'  => 'product',
 242               'mapping' =>
 243                 { 'pkg'      => sub { my $href = shift;
 244                                       $href->{'description'}
 245                                         ? $href->{'description'}
 246                                         : $href->{'product_id'};
 247                                     },
 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'}
 253                                         : 0
 254                                       );
 255                                       $price =~ s/[^\d.]//g;
 256                                       $price = 0 unless $price;
 257                                       sprintf("%.2f", $price);
 258                                     },
 259                   'setuptax' => sub { my $href = shift;
 260                                       $href->{'taxable'} ? '' : 'Y';
 261                                     },
 262                   'recurtax' => sub { my $href = shift;
 263                                       $href->{'taxable'} ? '' : 'Y';
 264                                     },
 265                   'plan'     => sub { 'flat' },
 266                   'disabled' => sub { 'Y' },
 267                   'pkg_svc'  => sub { my $href = shift;
 268                                       my $result = {};
 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};
 274                                       }
 275                                     },
 276                   'primary_svc'=> sub { pkg_freq(shift)
 277                                           ? $legacy_ppp_svcnum
 278                                           : ''
 279                                         ;
 280                                       },
 281                 },
 282               'fixup'   => sub { my $part_pkg = shift;
 283                                  my $row = shift;
 284                                  return 1 unless $part_pkg->comment;
 285                                  $package_cache{$part_pkg->comment} = $part_pkg;
 286                                  1;
 287                                },
 288               'wrapup'  => sub { foreach (keys %package_cache) {
 289                                    my $part_pkg = $package_cache{$_};
 290                                    my $options =
 291                                      { map { my $v = $part_pkg->$_;
 292                                              $part_pkg->$_('');
 293                                              ($_ => $v);
 294                                            }
 295                                        qw (setup recur)
 296                                      };
 297                                    my $error =
 298                                      $part_pkg->insert(options=>$options);
 299                                    die "Error inserting referral: $error"
 300                                      if $error;
 301                                    $count++ unless $error;
 302                                  }
 303                                },
 304             },
 305 part_referral => { 'stable'  => 'cust',
 306                    'mapping' =>
 307                      { 'agentnum' => sub { $agentnum },
 308                        'referral' => sub { my $r = shift->{'referred_from'};
 309                                            $referrals{$r} = 1;
 310                                          },
 311                      },
 312                    'fixup'   => sub { 1 },
 313                    'wrapup'  => sub { foreach (keys %referrals) {
 314                                         my $part_referral =
 315                                           new FS::part_referral( {
 316                                             'agentnum' => $agentnum,
 317                                             'referral' => $referrals{$_},
 318                                           } );
 319                                         my $error = $part_referral->insert;
 320                                         die "Error inserting referral: $error"
 321                                           if $error;
 322                                         $count++ unless $error;
 323                                         $referrals{$_} = $part_referral->refnum;
 324                                       }
 325                                     },
 326                  },
 327 svc_acct  => { 'stable'  => 'cust',
 328                'mapping' =>
 329                  { 'username'     => 'login',
 330                    '_password'    => 'password',
 331                    'svcpart'      => sub{ $legacy_ppp_svcnum },
 332                    'domsvc'       => sub{ $legacy_domain_svcnum },
 333                    'status'       => 'status',
 334                  },
 335                'fixup'   => sub { my $svc_acct = shift;
 336                                   my $row = shift;
 337                                   my $id = $row->{'master_account'}
 338                                            ? 'slave:'. $row->{'customer_id'}
 339                                            : $row->{'login'};
 340                                   my $status = $svc_acct->status;
 341                                   if ( $status ne 'Current'
 342                                     && $status ne 'On Hold' )
 343                                   {
 344                                     $cancel{$id} =
 345                                       str2time($row->{termination_date});
 346                                     warn "not creating (cancelled) svc_acct for " .
 347                                       $svc_acct->username. "\n";
 348                                     return 1
 349                                   }
 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' &&
 354                                          $row->{hold_date} );
 355                                   $bill{$id} =
 356                                     str2time($row->{expiration_date});
 357                                   '';
 358                                 },
 359                'skey'    => sub { my $svc_acct = shift;
 360                                   my $row = shift;
 361                                   my $id = $row->{'master_account'}
 362                                     ? 'slave:'. $row->{'customer_id'}
 363                                     : $row->{'login'};
 364                                 },
 365              },
 366 cust_main => { 'stable'  => 'cust',
 367                'mapping' =>
 368                  { 'agentnum'     => sub { $agentnum },
 369                    'agent_custid' => sub { my $id = shift->{'customer_number'};
 370                                            if (exists($custid{$id})) {
 371                                              $custid{$id}++;
 372                                              $id.  chr(64 + $custid{$id});
 373                                            }else{
 374                                              $custid{$id} = 0;
 375                                              $id;
 376                                            }
 377                                          },
 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) },
 400                    'payby'        => \&payby,
 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'}.
 410                                              '@'.
 411                                              $hash->{'bank_transit_number'};
 412                                            }elsif ($payby eq 'BILL') {
 413                                              $hash->{'blanket_purchase_order_number'};
 414                                            }else{
 415                                              die "unexpected payby";
 416                                            }
 417                                          },
 418                    'paycvv'       => sub { my $hash = shift;
 419                                            my $payby = payby($hash);
 420                                            if ($payby eq 'CARD') {
 421                                              $hash->{'credit_card_cvv_number'};
 422                                            }else{
 423                                              '';
 424                                            }
 425                                          },
 426                    'paydate'      => sub { my $hash = shift;
 427                                            my $payby = payby($hash);
 428                                            if ($payby eq 'CARD') {
 429                                              '20'.
 430                                              $hash->{'credit_card_exp_date_2'}.
 431                                              '-'.
 432                                              substr(
 433                                                $hash->{'credit_card_exp_date_1'},
 434                                                0,
 435                                                2,
 436                                              ).
 437                                              '-01';
 438                                            }else{
 439                                              '2037-12-01';
 440                                            }
 441                                          },
 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'};
 448                                            }else{
 449                                              '';
 450                                            }
 451                                          },
 452                    'paytype'      => sub { my $hash = shift;
 453                                            my $payby = payby($hash);
 454                                            if ($payby eq 'CHEK') {
 455                                              $hash->{'bank_account_to_debit'}
 456                                                ? 'Personal '.
 457                                                  $hash->{bank_account_to_debit}
 458                                                : '';
 459                                            }else{
 460                                              '';
 461                                            }
 462                                          },
 463                    'tax'          => sub { shift->{taxable} eq '' ? 'Y' : '' },
 464                    'refnum'       => sub { $referrals{shift->{'referred_from'}}
 465                                            || 1
 466                                          },
 467                  },
 468                'fixup'   => sub { my $cust_main = shift;
 469                                   my $row = 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');
 487                                   '';
 488                                 },
 489                'skey'    => sub { my $object = shift;
 490                                   my $href = shift;
 491                                   my $balance = sprintf("%.2f",
 492                                                         $href->{balance_due});
 493                                   if ($balance < 0) {
 494                                     my $cust_credit = new FS::cust_credit({
 495                                       'custnum'   => $object->custnum,
 496                                       'amount'    => sprintf("%.2f", -$balance),
 497                                       'reasonnum' => $previous_credit_reasonnum,
 498                                     });
 499                                     my $error = $cust_credit->insert;
 500                                     warn "Error inserting credit for ",
 501                                          $href->{'login'}, " : $error\n"
 502                                       if $error;
 503
 504                                   }elsif($balance > 0) {
 505                                     my $error = $object->charge(
 506                                                   $balance, "Prior balance",
 507                                                 );
 508                                     warn "Error inserting balance charge for ",
 509                                          $href->{'login'}, " : $error\n"
 510                                       if $error;
 511
 512                                   }
 513                                   $href->{'login'};
 514                                 },
 515              },
 516 #cust_main => { 'stable'  => 'cust',
 517 #               'mapping' =>
 518 #                 { 'referred_by' => sub { my $href = shift;
 519 #                                          my $u = shift->{'login'};
 520 #                                          my $cn = $href->{'customer_number'};
 521 #
 522 #                                          my $c = qsearch( 'cust_main',
 523 #                                                           { 'custnum' => $cn }
 524 #                                          ) or die "can't fine customer $cn";
 525 #
 526 #                                          my $s = qsearch( 'svc_acct',
 527 #                                                           { 'username' => $u }
 528 #                                                         ) or return '';
 529 #
 530 #                                          my $n = $s->cust_svc
 531 #                                                    ->cust_pkg
 532 #                                                    ->cust_main
 533 #                                                    ->custnum;
 534 #
 535 #                                          $c->referral_custnum($n);
 536 #                                          my $error = $c->replace;
 537 #                                          die "error setting referral: $error"
 538 #                                            if $error;
 539 #                                          '';
 540 #                                        },
 541 #                 };
 542 #               'fixup'   => sub { 1 },
 543 #             },
 544 cust_pkg  => { 'stable'  => 'billcycle',
 545                'mapping' =>
 546                  { 'custnum'     => sub { my $l = shift->{cbilling_cycle_login};
 547                                           $object_map{'cust_main'}{$l};
 548                                         },
 549                    'pkgpart'     => sub { my $p = shift->{product_id};
 550                                           $package_cache{$p}
 551                                             ? $package_cache{$p}->pkgpart
 552                                             : '';
 553                                         },
 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'};
 559                                           $bill{$id};
 560                                         },
 561                    'susp'        => sub { my $href = shift;
 562                                           my $id = $href->{'slave_account_id'}
 563                                             ? 'slave:'. $href->{'slave_account_id'}
 564                                             : $href->{'cbilling_cycle_login'};
 565                                           $susp{$id};
 566                                         },
 567                    'adjo'        => sub { my $href = shift;
 568                                           my $id = $href->{'slave_account_id'}
 569                                             ? 'slave:'. $href->{'slave_account_id'}
 570                                             : $href->{'cbilling_cycle_login'};
 571                                           $adjo{$id};
 572                                         },
 573                    'cancel'      => sub { my $href = shift;
 574                                           my $id = $href->{'slave_account_id'}
 575                                             ? 'slave:'. $href->{'slave_account_id'}
 576                                             : $href->{'cbilling_cycle_login'};
 577                                           $cancel{$id};
 578                                         },
 579                  },
 580                'skey'   => sub { my $object = shift;
 581                                  my $href = shift;
 582                                  if ($href->{'slave_account_id'}) {
 583                                    'slave:'. $href->{'slave_account_id'};
 584                                  }else{
 585                                    my $id = $href->{'billing_cycle_item_id'};
 586                                    $cust_pkg_map{$id} = $object->pkgnum;
 587                                    $href->{'cbilling_cycle_login'};
 588                                  }
 589                                },
 590                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 591                                      my $cust_svc =
 592                                        qsearchs( 'cust_svc', { 'svcnum' =>
 593                                                  $object_map{'svc_acct'}{$id} }
 594                                        );
 595                                      unless ($cust_svc) {
 596                                        warn "can't find legacy ppp $id\n";
 597                                        next;
 598                                      }
 599                                      $cust_svc->
 600                                        pkgnum($object_map{'cust_pkg'}{$id});
 601                                      my $error = $cust_svc->replace;
 602                                      warn "error linking legacy ppp $id: $error\n";
 603                                    }
 604                                  },
 605              },
 606 svc_acct  => { 'stable'  => 'email',
 607                'mapping' =>
 608                  { 'username'    => 'email_name',
 609                    '_password'   => 'password',
 610                    'svcpart'      => sub{ $legacy_email_svcnum },
 611                    'domsvc'       => sub{ $legacy_domain_svcnum },
 612                  },
 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];
 619                                     $cy += 1900; $cm++;
 620                                     return 1 if $sy < $cy;
 621                                     return 1 if ($sy == $cy && $sm < $cm);
 622                                     return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 623                                   }
 624                                   return 1 if $object_map{'cust_main'}{$object->username};
 625                                   '';
 626                                 },
 627                'skey'    => sub { my $object = shift;
 628                                   my $href = shift;
 629                                   'email:'. $href->{'email_customer_id'};
 630                                 },
 631                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 632                                      next unless $id =~ /^email:(\d+)/;
 633                                      my $custid = $1;
 634                                      my $cust_svc =
 635                                        qsearchs( 'cust_svc', { 'svcnum' =>
 636                                                  $object_map{'svc_acct'}{$id} }
 637                                        );
 638                                      unless ($cust_svc) {
 639                                        warn "can't find legacy ppp $id\n";
 640                                        next;
 641                                      }
 642
 643                                      $cust_svc->
 644                                        pkgnum($cust_pkg_map{$custid});
 645                                      my $error = $cust_svc->replace;
 646                                      warn "error linking legacy ppp $id: $error\n";
 647                                    }
 648                                  },
 649              },
 650 );
 651
 652 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
 653 my $d_dbh = adminsuidsetup $d_dbuser;
 654
 655 local $FS::UID::AutoCommit = 0;
 656
 657 while ( @tables ) {
 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'};
 665
 666   #$d_dbh->do("delete from $table");
 667
 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];
 671
 672   $s_sth = $s_dbh->prepare("select * from $stable");
 673   $s_sth->execute or die $s_sth->errstr;
 674
 675   my $row;
 676   $count = 0;
 677   while ( $row = $s_sth->fetchrow_hashref ) {
 678     my $class = "FS::$table";
 679
 680     warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
 681       unless( !$count || $count % 100 );
 682
 683     my $object = new $class ( {
 684         map { $_  => ( ref($mapping{$_}) eq 'CODE'
 685                        ? &{$mapping{$_}}($row)
 686                        : $row->{$mapping{$_}}
 687                      )
 688             }
 689           keys(%mapping)
 690     } );
 691     my $skip = &{$fixup}($object, $row)
 692       if $fixup;
 693
 694     unless ($skip) {
 695       my $error = $object->insert;
 696       if ($error) {
 697         warn "Error inserting $table ".
 698           join(", ", map{"$_ => ". $object->get($_)} fields $object).
 699           ": $error\n";
 700         next;
 701       }
 702       if ($skey) {
 703         my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
 704                                          : $row->{$skey};
 705         $object_map{$table}{$key} = $object->get($object->primary_key)
 706       }
 707       $count++;
 708     }
 709   }
 710
 711   &{$wrapup}()
 712     if $wrapup;
 713
 714   print "$count/$rowcount of $table SUCCESSFULLY processed\n";
 715
 716 }
 717
 718 if ($dry_run) {
 719   $d_dbh->rollback;
 720 }else{
 721   $d_dbh->commit or die $d_dbh->errstr;
 722 }
 723