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 #my $d_dbuser = 'freesideimport';
  31
  32 #my $agentnum = 1;
  33 my $agentnum = 13;
  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;
  41
  42
  43
  44 my $state = '';  #statemachine-ish
  45 my $sourcefile;
  46 my $s_dbh;
  47 my $columncount;
  48 my $rowcount;
  49
  50 my @args = (
  51              {
  52                id    => 1,
  53                hdr   => \&header,
  54                row   => \&row,
  55                start => \&start,
  56                end   => \&end,
  57              },
  58            );
  59
  60
  61 $s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass,
  62                            { 'AutoCommit' => 0,
  63                              'ChopBlanks' => 1,
  64                              'ShowErrorStatement' => 1
  65                            }
  66                      );
  67
  68 foreach ( qw ( billcycle cust email product ) ) {
  69   $sourcefile = $_;
  70
  71   print "parsing $sourcefile\n";
  72
  73   die "bad file name" unless $sourcefile =~ /^\w+$/;
  74
  75   $columncount = 0;
  76   $rowcount = 0;
  77
  78   my $c_sth = '';
  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";
  83         next;
  84       }
  85     }
  86   }
  87
  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;
  91 #  $s_dbh->disconnect;
  92 }
  93
  94
  95 sub start {
  96   warn "start\n" if $DEBUG;
  97   my $table_id = shift;
  98   die "unexpected state change" unless $state eq '';
  99   die "unexpected table" unless $table_id eq '1';
 100   $state = 'table';
 101 }
 102
 103 sub end {
 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';
 108   $state = '';
 109 }
 110
 111 sub header {
 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';
 116   $state = 'rows';
 117
 118   die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols)
 119     if scalar(grep { !/^[ \w\r]+$/ } @$cols);
 120
 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 );
 125 }
 126
 127 sub row {
 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';
 132
 133   die "invalid number of columns: ". join(', ', @$cols)
 134     unless (scalar(@$cols) == $columncount);
 135
 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;
 139   $rowcount++;
 140   warn "row $rowcount\n" unless ($rowcount % 1000);
 141 }
 142
 143
 144
 145 $FS::cust_main::import=1;
 146 $FS::cust_pkg::disable_agentcheck = 1;
 147
 148 my (%part_pkg_map) = ();
 149 my (%referrals) = ();
 150 my (%custid) = ();
 151 my (%cancel) = ();
 152 my (%susp) = ();
 153 my (%adjo) = ();
 154 my (%bill) = ();
 155 my (%cust_pkg_map) = ();
 156 my (%object_map) = ();
 157 my (%package_cache) = ();
 158 my $count;
 159
 160 sub pkg_freq {
 161   my ( $href ) = ( shift );
 162   $href->{'one_type_item'}
 163     ? 0
 164     : int(eval "$href->{'months_credit'} + 0");
 165 }
 166
 167 sub b_or {
 168   my ( $field, $hash ) = ( shift, shift );
 169   $field = 'bill_'. $field
 170     if $hash->{'billing_use'} eq 'Billing Address';
 171   $hash->{$field};
 172 }
 173
 174 sub p_or {
 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'}. '-'
 181              : '903-' # wtf?
 182   ;
 183   ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
 184     ? $ac. $hash->{$field}
 185     : '';
 186 }
 187
 188 sub or_b {
 189   my ( $field, $hash ) = ( shift, shift );
 190   $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
 191 }
 192
 193 sub or_p {
 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'}. '-'
 198         : '903-'  # wtf?
 199       ). $hash->{$field}
 200     : '';
 201 }
 202
 203 my %payby_map = ( ''              => 'BILL',
 204                   'None'          => 'BILL',
 205                   'Credit Card'   => 'CARD',
 206                   'Bank Debit'    => 'CHEK',
 207                   'Virtual Check' => 'CHEK',
 208 );
 209 sub payby {
 210   $payby_map{ shift->{billing_type} };
 211 }
 212
 213 sub payinfo {
 214   my $hash = shift;
 215   my $payby = payby($hash);
 216   my $info;
 217   my $cc =
 218     $hash->{'credit_card_number_1'}.
 219     $hash->{'credit_card_number_2'}.
 220     $hash->{'credit_card_number_3'}.
 221     $hash->{'credit_card_number_4'};
 222   my $bank =
 223     $hash->{'bank_account_number'}.
 224     '@'.
 225     $hash->{'bank_transit_number'};
 226   if ($payby eq 'CARD') {
 227     $info = $cc;
 228   }elsif ($payby eq 'CHEK') {
 229     $info = $bank;
 230   }elsif ($payby eq 'BILL') {
 231     $info = $hash->{'blanket_purchase_order_number'};
 232     $bank =~ s/[^\d\@]//g;
 233     $cc =~ s/\D//g;
 234     if ( $bank =~ /^\d+\@\d{9}/) {
 235       $info = $bank;
 236       $payby = 'DCHK';
 237     }
 238     if ( $cc =~ /^\d{13,16}/ ) {
 239       $info = $cc;
 240       $payby = 'DCRD';
 241     }
 242   }else{
 243     die "unexpected payby";
 244   }
 245   ($info, $payby);
 246 }
 247
 248 sub ut_name_fixup {
 249   my ($object, $field) = (shift, shift);
 250   my $value = $object->getfield($field);
 251   $value =~ s/[^\w \,\.\-\']/ /g;
 252   $object->setfield($field, $value);
 253 }
 254
 255 sub ut_text_fixup {
 256   my ($object, $field) = (shift, shift);
 257   my $value = $object->getfield($field);
 258   $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
 259   $object->setfield($field, $value);
 260 }
 261
 262 sub ut_state_fixup {
 263   my ($object, $field) = (shift, shift);
 264   my $value = $object->getfield($field);
 265   $value = 'TX' if $value eq 'TTX';
 266   $object->setfield($field, $value);
 267 }
 268
 269 sub ut_zip_fixup {
 270   my ($object, $field) = (shift, shift);
 271   my $value = $object->getfield($field);
 272   $value =~ s/[^-\d]//g;
 273   $object->setfield($field, $value);
 274 }
 275
 276 my @tables = (
 277 part_pkg => { 'stable'  => 'product',
 278               'mapping' =>
 279                 { 'pkg'      => sub { my $href = shift;
 280                                       $href->{'description'}
 281                                         ? $href->{'description'}
 282                                         : $href->{'product_id'};
 283                                     },
 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'}
 289                                         : 0
 290                                       );
 291                                       $price =~ s/[^\d.]//g;
 292                                       $price = 0 unless $price;
 293                                       sprintf("%.2f", $price);
 294                                     },
 295                   'setuptax' => sub { my $href = shift;
 296                                       $href->{'taxable'} ? '' : 'Y';
 297                                     },
 298                   'recurtax' => sub { my $href = shift;
 299                                       $href->{'taxable'} ? '' : 'Y';
 300                                     },
 301                   'plan'     => sub { 'flat' },
 302                   'disabled' => sub { 'Y' },
 303                   'pkg_svc'  => sub { my $href = shift;
 304                                       my $result = {};
 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};
 310                                       }
 311                                     },
 312                   'primary_svc'=> sub { pkg_freq(shift)
 313                                           ? $legacy_ppp_svcnum
 314                                           : ''
 315                                         ;
 316                                       },
 317                 },
 318               'fixup'   => sub { my $part_pkg = shift;
 319                                  my $row = shift;
 320                                  return 1 unless $part_pkg->comment;
 321                                  $package_cache{$part_pkg->comment} = $part_pkg;
 322                                  1;
 323                                },
 324               'wrapup'  => sub { foreach (keys %package_cache) {
 325                                    my $part_pkg = $package_cache{$_};
 326                                    my $options =
 327                                      { map { my $v = $part_pkg->$_;
 328                                              $part_pkg->$_('');
 329                                              ($_ => $v);
 330                                            }
 331                                        qw (setup recur)
 332                                      };
 333                                    my $error =
 334                                      $part_pkg->insert(options=>$options);
 335                                    die "Error inserting referral: $error"
 336                                      if $error;
 337                                    $count++ unless $error;
 338                                  }
 339                                },
 340             },
 341 part_referral => { 'stable'  => 'cust',
 342                    'mapping' =>
 343                      { 'agentnum' => sub { $agentnum },
 344                        'referral' => sub { my $r = shift->{'referred_from'};
 345                                            $referrals{$r} = 1;
 346                                          },
 347                      },
 348                    'fixup'   => sub { 1 },
 349                    'wrapup'  => sub { foreach (keys %referrals) {
 350                                         my $part_referral =
 351                                           new FS::part_referral( {
 352                                             'agentnum' => $agentnum,
 353                                             'referral' => $referrals{$_},
 354                                           } );
 355                                         my $error = $part_referral->insert;
 356                                         die "Error inserting referral: $error"
 357                                           if $error;
 358                                         $count++ unless $error;
 359                                         $referrals{$_} = $part_referral->refnum;
 360                                       }
 361                                     },
 362                  },
 363 svc_acct  => { 'stable'  => 'cust',
 364                'mapping' =>
 365                  { 'username'     => 'login',
 366                    '_password'    => 'password',
 367                    'svcpart'      => sub{ $legacy_ppp_svcnum },
 368                    'domsvc'       => sub{ $legacy_domain_svcnum },
 369                    'status'       => 'status',
 370                  },
 371 #               'fixup'   => sub { my $svc_acct = shift;
 372 #                                  my $row = shift;
 373 #                                  my $id = $row->{'master_account'}
 374 #                                           ? 'slave:'. $row->{'customer_id'}
 375 #                                           : $row->{'login'};
 376 #                                  my $status = $svc_acct->status;
 377 #                                  if ( $status ne 'Current'
 378 #                                    && $status ne 'On Hold' )
 379 #                                  {
 380 #                                    $cancel{$id} =
 381 #                                      str2time($row->{termination_date});
 382 #                                    warn "not creating (cancelled) svc_acct for " .
 383 #                                      $svc_acct->username. "\n";
 384 #                                    return 1
 385 #                                  }
 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} );
 391 #                                  $bill{$id} =
 392 #                                    str2time($row->{expiration_date});
 393 #                                  '';
 394 #                                },
 395                'fixup'   => sub { my $svc_acct = shift;
 396                                   my $row = shift;
 397                                   my $id = $row->{'master_account'}
 398                                            ? 'slave:'. $row->{'customer_id'}
 399                                            : $row->{'login'};
 400                                   my $status = $svc_acct->status;
 401                                   if ( $status ne 'Current'
 402                                     && $status ne 'On Hold' )
 403                                   {
 404                                     $cancel{$id} =
 405                                       str2time($row->{termination_date});
 406                                     return 1
 407                                   }
 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' &&
 412                                          $row->{hold_date} );
 413                                   $bill{$id} =
 414                                     str2time($row->{expiration_date});
 415                                   my $object =
 416                                     qsearchs( 'svc_acct',
 417                                               { 'username' => $row->{'login'} }
 418                                             );
 419                                   unless( $object ) {
 420                                     warn "can't find svc_acct for legacy ppp ".
 421                                       $row->{'login'}, "\n";
 422                                     return 1;
 423                                   }
 424
 425                                   $object_map{svc_acct}{$id} = $object->svcnum;
 426                                   return 1;
 427                                 },
 428 #               'skey'    => sub { my $svc_acct = shift;
 429 #                                  my $row = shift;
 430 #                                  my $id = $row->{'master_account'}
 431 #                                    ? 'slave:'. $row->{'customer_id'}
 432 #                                    : $row->{'login'};
 433 #                                },
 434              },
 435 cust_main => { 'stable'  => 'cust',
 436                'mapping' =>
 437                  { 'agentnum'     => sub { $agentnum },
 438                    'agent_custid' => sub { my $id = shift->{'customer_number'};
 439                                            if (exists($custid{$id})) {
 440                                              $custid{$id}++;
 441                                              $id.  chr(64 + $custid{$id});
 442                                            }else{
 443                                              $custid{$id} = 0;
 444                                              $id;
 445                                            }
 446                                          },
 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'}}
 471                                            || 1
 472                                          },
 473                  },
 474                'fixup'   => sub { my $cust_main = shift;
 475                                   my $row = 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');
 482
 483                                   my ($info, $payby) = payinfo($row);
 484                                   $cust_main->payby($payby);
 485                                   $cust_main->payinfo($info);
 486
 487                                   $cust_main->paycvv(
 488                                       $row->{'credit_card_cvv_number'}
 489                                   )
 490                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 491
 492                                   $cust_main->paydate('20'.
 493                                       $row->{'credit_card_exp_date_2'}.  '-'.
 494                                       substr(
 495                                         $row->{'credit_card_exp_date_1'},
 496                                         0,
 497                                         2,
 498                                       ).
 499                                       '-01'
 500                                   )
 501                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 502
 503                                   my $payname = '';
 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);
 509
 510                                   $cust_main->paytype(
 511                                       $row->{'bank_account_to_debit'}
 512                                         ? 'Personal '.
 513                                           $row->{bank_account_to_debit}
 514                                         : ''
 515                                   )
 516                                     if ($payby eq 'CHEK' or $payby eq 'DCHK');
 517
 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');
 529
 530
 531                                   '';
 532                                 },
 533                'skey'    => sub { my $object = shift;
 534                                   my $href = shift;
 535                                   my $balance = sprintf("%.2f",
 536                                                         $href->{balance_due});
 537                                   if ($balance < 0) {
 538                                     my $cust_credit = new FS::cust_credit({
 539                                       'custnum'   => $object->custnum,
 540                                       'amount'    => sprintf("%.2f", -$balance),
 541                                       'reasonnum' => $previous_credit_reasonnum,
 542                                     });
 543                                     my $error = $cust_credit->insert;
 544                                     warn "Error inserting credit for ",
 545                                          $href->{'login'}, " : $error\n"
 546                                       if $error;
 547
 548                                   }elsif($balance > 0) {
 549                                     my $error = $object->charge(
 550                                                   $balance, "Prior balance",
 551                                                 );
 552                                     warn "Error inserting balance charge for ",
 553                                          $href->{'login'}, " : $error\n"
 554                                       if $error;
 555
 556                                   }
 557                                   $href->{'login'};
 558                                 },
 559              },
 560 #cust_main => { 'stable'  => 'cust',
 561 #               'mapping' =>
 562 #                 { 'referred_by' => sub { my $href = shift;
 563 #                                          my $u = shift->{'login'};
 564 #                                          my $cn = $href->{'customer_number'};
 565 #
 566 #                                          my $c = qsearch( 'cust_main',
 567 #                                                           { 'custnum' => $cn }
 568 #                                          ) or die "can't fine customer $cn";
 569 #
 570 #                                          my $s = qsearch( 'svc_acct',
 571 #                                                           { 'username' => $u }
 572 #                                                         ) or return '';
 573 #
 574 #                                          my $n = $s->cust_svc
 575 #                                                    ->cust_pkg
 576 #                                                    ->cust_main
 577 #                                                    ->custnum;
 578 #
 579 #                                          $c->referral_custnum($n);
 580 #                                          my $error = $c->replace;
 581 #                                          die "error setting referral: $error"
 582 #                                            if $error;
 583 #                                          '';
 584 #                                        },
 585 #                 };
 586 #               'fixup'   => sub { 1 },
 587 #             },
 588 cust_pkg  => { 'stable'  => 'billcycle',
 589                'mapping' =>
 590                  { 'custnum'     => sub { my $l = shift->{cbilling_cycle_login};
 591                                           $object_map{'cust_main'}{$l};
 592                                         },
 593                    'pkgpart'     => sub { my $p = shift->{product_id};
 594                                           $package_cache{$p}
 595                                             ? $package_cache{$p}->pkgpart
 596                                             : '';
 597                                         },
 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'};
 603                                           $bill{$id};
 604                                         },
 605                    'susp'        => sub { my $href = shift;
 606                                           my $id = $href->{'slave_account_id'}
 607                                             ? 'slave:'. $href->{'slave_account_id'}
 608                                             : $href->{'cbilling_cycle_login'};
 609                                           $susp{$id};
 610                                         },
 611                    'adjo'        => sub { my $href = shift;
 612                                           my $id = $href->{'slave_account_id'}
 613                                             ? 'slave:'. $href->{'slave_account_id'}
 614                                             : $href->{'cbilling_cycle_login'};
 615                                           $adjo{$id};
 616                                         },
 617                    'cancel'      => sub { my $href = shift;
 618                                           my $id = $href->{'slave_account_id'}
 619                                             ? 'slave:'. $href->{'slave_account_id'}
 620                                             : $href->{'cbilling_cycle_login'};
 621                                           $cancel{$id};
 622                                         },
 623                  },
 624                'skey'   => sub { my $object = shift;
 625                                  my $href = shift;
 626                                  if ($href->{'slave_account_id'}) {
 627                                    'slave:'. $href->{'slave_account_id'};
 628                                  }else{
 629                                    my $id = $href->{'billing_cycle_item_id'};
 630                                    $cust_pkg_map{$id} = $object->pkgnum;
 631                                    $href->{'cbilling_cycle_login'};
 632                                  }
 633                                },
 634                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 635                                      my $cust_svc =
 636                                        qsearchs( 'cust_svc', { 'svcnum' =>
 637                                                  $object_map{'svc_acct'}{$id} }
 638                                        );
 639                                      unless ($cust_svc) {
 640                                        warn "can't find legacy ppp $id\n";
 641                                        next;
 642                                      }
 643                                      $cust_svc->
 644                                        pkgnum($object_map{'cust_pkg'}{$id});
 645                                      my $error = $cust_svc->replace;
 646                                      warn "error linking legacy ppp $id: $error\n";
 647                                    }
 648                                  },
 649              },
 650 svc_acct  => { 'stable'  => 'email',
 651                'mapping' =>
 652                  { 'username'    => 'email_name',
 653                    '_password'   => 'password',
 654                    'svcpart'      => sub{ $legacy_email_svcnum },
 655                    'domsvc'       => sub{ $legacy_domain_svcnum },
 656                  },
 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);
 667 #                                  }
 668 #                                  return 1 if $object_map{'cust_main'}{$object->username};
 669 #                                  '';
 670 #                                },
 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];
 677                                     $cy += 1900; $cm++;
 678                                     return 1 if $sy < $cy;
 679                                     return 1 if ($sy == $cy && $sm < $cm);
 680                                     return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 681                                   }
 682                                   return 1 if $object_map{'cust_main'}{$object->username};
 683                                   my $svc_acct =
 684                                     qsearchs( 'svc_acct',
 685                                               { 'username' => $row->{'login'} }
 686                                             );
 687                                   unless( $svc_acct ) {
 688                                     warn "can't find svc_acct for email ".
 689                                       $row->{'login'}. "\n";
 690                                     return 1;
 691                                   }
 692                                   $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svc_acct->svcnum;
 693                                   return 1;
 694                                 },
 695 #               'skey'    => sub { my $object = shift;
 696 #                                  my $href = shift;
 697 #                                  'email:'. $href->{'email_customer_id'};
 698 #                                },
 699                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 700                                      next unless $id =~ /^email:(\d+)/;
 701                                      my $custid = $1;
 702                                      my $cust_svc =
 703                                        qsearchs( 'cust_svc', { 'svcnum' =>
 704                                                  $object_map{'svc_acct'}{$id} }
 705                                        );
 706                                      unless ($cust_svc) {
 707                                        warn "can't find legacy email $id\n";
 708                                        next;
 709                                      }
 710
 711                                      $cust_svc->
 712                                        pkgnum($cust_pkg_map{$custid});
 713                                      my $error = $cust_svc->replace;
 714                                      warn "error linking legacy email $id: $error\n";
 715                                    }
 716                                  },
 717              },
 718 );
 719
 720 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
 721 my $d_dbh = adminsuidsetup $d_dbuser;
 722
 723 local $FS::UID::AutoCommit = 0;
 724
 725 while ( @tables ) {
 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'};
 733
 734   #$d_dbh->do("delete from $table");
 735
 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];
 739
 740   $s_sth = $s_dbh->prepare("select * from $stable");
 741   $s_sth->execute or die $s_sth->errstr;
 742
 743   my $row;
 744   $count = 0;
 745   while ( $row = $s_sth->fetchrow_hashref ) {
 746     my $class = "FS::$table";
 747
 748     warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
 749       unless( !$count || $count % 100 );
 750
 751     my $object = new $class ( {
 752         map { $_  => ( ref($mapping{$_}) eq 'CODE'
 753                        ? &{$mapping{$_}}($row)
 754                        : $row->{$mapping{$_}}
 755                      )
 756             }
 757           keys(%mapping)
 758     } );
 759     my $skip = &{$fixup}($object, $row)
 760       if $fixup;
 761
 762     unless ($skip) {
 763       my $error = $object->insert;
 764       if ($error) {
 765         warn "Error inserting $table ".
 766           join(", ", map{"$_ => ". $object->get($_)} fields $object).
 767           ": $error\n";
 768         next;
 769       }
 770       if ($skey) {
 771         my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
 772                                          : $row->{$skey};
 773         $object_map{$table}{$key} = $object->get($object->primary_key)
 774       }
 775       $count++;
 776     }
 777   }
 778
 779   &{$wrapup}()
 780     if $wrapup;
 781
 782   print "$count/$rowcount of $table SUCCESSFULLY processed\n";
 783
 784 }
 785
 786 if ($dry_run) {
 787   $d_dbh->rollback;
 788 }else{
 789   $d_dbh->commit or die $d_dbh->errstr;
 790 }
 791