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 ut_name_fixup {
 214   my ($object, $field) = (shift, shift);
 215   my $value = $object->getfield($field);
 216   $value =~ s/[^\w \,\.\-\']/ /g;
 217   $object->setfield($field, $value);
 218 }
 219
 220 sub ut_text_fixup {
 221   my ($object, $field) = (shift, shift);
 222   my $value = $object->getfield($field);
 223   $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
 224   $object->setfield($field, $value);
 225 }
 226
 227 sub ut_state_fixup {
 228   my ($object, $field) = (shift, shift);
 229   my $value = $object->getfield($field);
 230   $value = 'TX' if $value eq 'TTX';
 231   $object->setfield($field, $value);
 232 }
 233
 234 sub ut_zip_fixup {
 235   my ($object, $field) = (shift, shift);
 236   my $value = $object->getfield($field);
 237   $value =~ s/[^-\d]//g;
 238   $object->setfield($field, $value);
 239 }
 240
 241 my @tables = (
 242 part_pkg => { 'stable'  => 'product',
 243               'mapping' =>
 244                 { 'pkg'      => sub { my $href = shift;
 245                                       $href->{'description'}
 246                                         ? $href->{'description'}
 247                                         : $href->{'product_id'};
 248                                     },
 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'}
 254                                         : 0
 255                                       );
 256                                       $price =~ s/[^\d.]//g;
 257                                       $price = 0 unless $price;
 258                                       sprintf("%.2f", $price);
 259                                     },
 260                   'setuptax' => sub { my $href = shift;
 261                                       $href->{'taxable'} ? '' : 'Y';
 262                                     },
 263                   'recurtax' => sub { my $href = shift;
 264                                       $href->{'taxable'} ? '' : 'Y';
 265                                     },
 266                   'plan'     => sub { 'flat' },
 267                   'disabled' => sub { 'Y' },
 268                   'pkg_svc'  => sub { my $href = shift;
 269                                       my $result = {};
 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};
 275                                       }
 276                                     },
 277                   'primary_svc'=> sub { pkg_freq(shift)
 278                                           ? $legacy_ppp_svcnum
 279                                           : ''
 280                                         ;
 281                                       },
 282                 },
 283               'fixup'   => sub { my $part_pkg = shift;
 284                                  my $row = shift;
 285                                  return 1 unless $part_pkg->comment;
 286                                  $package_cache{$part_pkg->comment} = $part_pkg;
 287                                  1;
 288                                },
 289               'wrapup'  => sub { foreach (keys %package_cache) {
 290                                    my $part_pkg = $package_cache{$_};
 291                                    my $options =
 292                                      { map { my $v = $part_pkg->$_;
 293                                              $part_pkg->$_('');
 294                                              ($_ => $v);
 295                                            }
 296                                        qw (setup recur)
 297                                      };
 298                                    my $error =
 299                                      $part_pkg->insert(options=>$options);
 300                                    die "Error inserting referral: $error"
 301                                      if $error;
 302                                    $count++ unless $error;
 303                                  }
 304                                },
 305             },
 306 part_referral => { 'stable'  => 'cust',
 307                    'mapping' =>
 308                      { 'agentnum' => sub { $agentnum },
 309                        'referral' => sub { my $r = shift->{'referred_from'};
 310                                            $referrals{$r} = 1;
 311                                          },
 312                      },
 313                    'fixup'   => sub { 1 },
 314                    'wrapup'  => sub { foreach (keys %referrals) {
 315                                         my $part_referral =
 316                                           new FS::part_referral( {
 317                                             'agentnum' => $agentnum,
 318                                             'referral' => $referrals{$_},
 319                                           } );
 320                                         my $error = $part_referral->insert;
 321                                         die "Error inserting referral: $error"
 322                                           if $error;
 323                                         $count++ unless $error;
 324                                         $referrals{$_} = $part_referral->refnum;
 325                                       }
 326                                     },
 327                  },
 328 svc_acct  => { 'stable'  => 'cust',
 329                'mapping' =>
 330                  { 'username'     => 'login',
 331                    '_password'    => 'password',
 332                    'svcpart'      => sub{ $legacy_ppp_svcnum },
 333                    'domsvc'       => sub{ $legacy_domain_svcnum },
 334                    'status'       => 'status',
 335                  },
 336 #               'fixup'   => sub { my $svc_acct = shift;
 337 #                                  my $row = shift;
 338 #                                  my $id = $row->{'master_account'}
 339 #                                           ? 'slave:'. $row->{'customer_id'}
 340 #                                           : $row->{'login'};
 341 #                                  my $status = $svc_acct->status;
 342 #                                  if ( $status ne 'Current'
 343 #                                    && $status ne 'On Hold' )
 344 #                                  {
 345 #                                    $cancel{$id} =
 346 #                                      str2time($row->{termination_date});
 347 #                                    warn "not creating (cancelled) svc_acct for " .
 348 #                                      $svc_acct->username. "\n";
 349 #                                    return 1
 350 #                                  }
 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} );
 356 #                                  $bill{$id} =
 357 #                                    str2time($row->{expiration_date});
 358 #                                  '';
 359 #                                },
 360                'fixup'   => sub { my $svc_acct = shift;
 361                                   my $row = shift;
 362                                   my $id = $row->{'master_account'}
 363                                            ? 'slave:'. $row->{'customer_id'}
 364                                            : $row->{'login'};
 365                                   my $status = $svc_acct->status;
 366                                   if ( $status ne 'Current'
 367                                     && $status ne 'On Hold' )
 368                                   {
 369                                     $cancel{$id} =
 370                                       str2time($row->{termination_date});
 371                                     return 1
 372                                   }
 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' &&
 377                                          $row->{hold_date} );
 378                                   $bill{$id} =
 379                                     str2time($row->{expiration_date});
 380                                   my $object =
 381                                     qsearchs( 'svc_acct',
 382                                               { 'username' => $row->{'login'} }
 383                                             );
 384                                   unless( $object ) {
 385                                     warn "can't find svc_acct for legacy ppp ".
 386                                       $row->{'login'};
 387                                     return 1;
 388                                   }
 389
 390                                   $object_map{svc_acct}{$id} = $object->svcnum;
 391                                   return 1;
 392                                 },
 393 #               'skey'    => sub { my $svc_acct = shift;
 394 #                                  my $row = shift;
 395 #                                  my $id = $row->{'master_account'}
 396 #                                    ? 'slave:'. $row->{'customer_id'}
 397 #                                    : $row->{'login'};
 398 #                                },
 399              },
 400 cust_main => { 'stable'  => 'cust',
 401                'mapping' =>
 402                  { 'agentnum'     => sub { $agentnum },
 403                    'agent_custid' => sub { my $id = shift->{'customer_number'};
 404                                            if (exists($custid{$id})) {
 405                                              $custid{$id}++;
 406                                              $id.  chr(64 + $custid{$id});
 407                                            }else{
 408                                              $custid{$id} = 0;
 409                                              $id;
 410                                            }
 411                                          },
 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) },
 434                    'payby'        => \&payby,
 435                    'payinfo'      => sub { my $hash = shift;
 436                                            my $payby = payby($hash);
 437                                            my $cc =
 438                                              $hash->{'credit_card_number_1'}.
 439                                              $hash->{'credit_card_number_2'}.
 440                                              $hash->{'credit_card_number_3'}.
 441                                              $hash->{'credit_card_number_4'};
 442                                            my $bank =
 443                                              $hash->{'bank_account_number'}.
 444                                              '@'.
 445                                              $hash->{'bank_transit_number'};
 446                                            if ($payby eq 'CARD') {
 447                                              $cc;
 448                                            }elsif ($payby eq 'CHEK') {
 449                                              $bank;
 450                                            }elsif ($payby eq 'BILL') {
 451                                              my $info = $hash->{'blanket_purchase_order_number'};
 452                                              $bank =~ s/[^\d\@]//g;
 453                                              $cc =~ s/\D//g;
 454                                              $info = $bank
 455                                                if $bank =~ /^\d+\@\d{9}/;
 456                                              $info = $cc
 457                                                if $cc =~ /^\d{13,16}/;
 458                                              $info;
 459                                            }else{
 460                                              die "unexpected payby";
 461                                            }
 462                                          },
 463                    'paycvv'       => sub { my $hash = shift;
 464                                            my $payby = payby($hash);
 465                                            if ($payby eq 'CARD') {
 466                                              $hash->{'credit_card_cvv_number'};
 467                                            }else{
 468                                              '';
 469                                            }
 470                                          },
 471                    'paydate'      => sub { my $hash = shift;
 472                                            my $payby = payby($hash);
 473                                            if ($payby eq 'CARD') {
 474                                              '20'.
 475                                              $hash->{'credit_card_exp_date_2'}.
 476                                              '-'.
 477                                              substr(
 478                                                $hash->{'credit_card_exp_date_1'},
 479                                                0,
 480                                                2,
 481                                              ).
 482                                              '-01';
 483                                            }else{
 484                                              '2037-12-01';
 485                                            }
 486                                          },
 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'};
 493                                            }else{
 494                                              '';
 495                                            }
 496                                          },
 497                    'paytype'      => sub { my $hash = shift;
 498                                            my $payby = payby($hash);
 499                                            if ($payby eq 'CHEK') {
 500                                              $hash->{'bank_account_to_debit'}
 501                                                ? 'Personal '.
 502                                                  $hash->{bank_account_to_debit}
 503                                                : '';
 504                                            }else{
 505                                              '';
 506                                            }
 507                                          },
 508                    'tax'          => sub { shift->{taxable} eq '' ? 'Y' : '' },
 509                    'refnum'       => sub { $referrals{shift->{'referred_from'}}
 510                                            || 1
 511                                          },
 512                  },
 513                'fixup'   => sub { my $cust_main = shift;
 514                                   my $row = 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');
 532                                   '';
 533                                 },
 534                'skey'    => sub { my $object = shift;
 535                                   my $href = shift;
 536                                   my $balance = sprintf("%.2f",
 537                                                         $href->{balance_due});
 538                                   if ($balance < 0) {
 539                                     my $cust_credit = new FS::cust_credit({
 540                                       'custnum'   => $object->custnum,
 541                                       'amount'    => sprintf("%.2f", -$balance),
 542                                       'reasonnum' => $previous_credit_reasonnum,
 543                                     });
 544                                     my $error = $cust_credit->insert;
 545                                     warn "Error inserting credit for ",
 546                                          $href->{'login'}, " : $error\n"
 547                                       if $error;
 548
 549                                   }elsif($balance > 0) {
 550                                     my $error = $object->charge(
 551                                                   $balance, "Prior balance",
 552                                                 );
 553                                     warn "Error inserting balance charge for ",
 554                                          $href->{'login'}, " : $error\n"
 555                                       if $error;
 556
 557                                   }
 558                                   $href->{'login'};
 559                                 },
 560              },
 561 #cust_main => { 'stable'  => 'cust',
 562 #               'mapping' =>
 563 #                 { 'referred_by' => sub { my $href = shift;
 564 #                                          my $u = shift->{'login'};
 565 #                                          my $cn = $href->{'customer_number'};
 566 #
 567 #                                          my $c = qsearch( 'cust_main',
 568 #                                                           { 'custnum' => $cn }
 569 #                                          ) or die "can't fine customer $cn";
 570 #
 571 #                                          my $s = qsearch( 'svc_acct',
 572 #                                                           { 'username' => $u }
 573 #                                                         ) or return '';
 574 #
 575 #                                          my $n = $s->cust_svc
 576 #                                                    ->cust_pkg
 577 #                                                    ->cust_main
 578 #                                                    ->custnum;
 579 #
 580 #                                          $c->referral_custnum($n);
 581 #                                          my $error = $c->replace;
 582 #                                          die "error setting referral: $error"
 583 #                                            if $error;
 584 #                                          '';
 585 #                                        },
 586 #                 };
 587 #               'fixup'   => sub { 1 },
 588 #             },
 589 cust_pkg  => { 'stable'  => 'billcycle',
 590                'mapping' =>
 591                  { 'custnum'     => sub { my $l = shift->{cbilling_cycle_login};
 592                                           $object_map{'cust_main'}{$l};
 593                                         },
 594                    'pkgpart'     => sub { my $p = shift->{product_id};
 595                                           $package_cache{$p}
 596                                             ? $package_cache{$p}->pkgpart
 597                                             : '';
 598                                         },
 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'};
 604                                           $bill{$id};
 605                                         },
 606                    'susp'        => sub { my $href = shift;
 607                                           my $id = $href->{'slave_account_id'}
 608                                             ? 'slave:'. $href->{'slave_account_id'}
 609                                             : $href->{'cbilling_cycle_login'};
 610                                           $susp{$id};
 611                                         },
 612                    'adjo'        => sub { my $href = shift;
 613                                           my $id = $href->{'slave_account_id'}
 614                                             ? 'slave:'. $href->{'slave_account_id'}
 615                                             : $href->{'cbilling_cycle_login'};
 616                                           $adjo{$id};
 617                                         },
 618                    'cancel'      => sub { my $href = shift;
 619                                           my $id = $href->{'slave_account_id'}
 620                                             ? 'slave:'. $href->{'slave_account_id'}
 621                                             : $href->{'cbilling_cycle_login'};
 622                                           $cancel{$id};
 623                                         },
 624                  },
 625                'skey'   => sub { my $object = shift;
 626                                  my $href = shift;
 627                                  if ($href->{'slave_account_id'}) {
 628                                    'slave:'. $href->{'slave_account_id'};
 629                                  }else{
 630                                    my $id = $href->{'billing_cycle_item_id'};
 631                                    $cust_pkg_map{$id} = $object->pkgnum;
 632                                    $href->{'cbilling_cycle_login'};
 633                                  }
 634                                },
 635                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 636                                      my $cust_svc =
 637                                        qsearchs( 'cust_svc', { 'svcnum' =>
 638                                                  $object_map{'svc_acct'}{$id} }
 639                                        );
 640                                      unless ($cust_svc) {
 641                                        warn "can't find legacy ppp $id\n";
 642                                        next;
 643                                      }
 644                                      $cust_svc->
 645                                        pkgnum($object_map{'cust_pkg'}{$id});
 646                                      my $error = $cust_svc->replace;
 647                                      warn "error linking legacy ppp $id: $error\n";
 648                                    }
 649                                  },
 650              },
 651 svc_acct  => { 'stable'  => 'email',
 652                'mapping' =>
 653                  { 'username'    => 'email_name',
 654                    '_password'   => 'password',
 655                    'svcpart'      => sub{ $legacy_email_svcnum },
 656                    'domsvc'       => sub{ $legacy_domain_svcnum },
 657                  },
 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);
 668 #                                  }
 669 #                                  return 1 if $object_map{'cust_main'}{$object->username};
 670 #                                  '';
 671 #                                },
 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];
 678                                     $cy += 1900; $cm++;
 679                                     return 1 if $sy < $cy;
 680                                     return 1 if ($sy == $cy && $sm < $cm);
 681                                     return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 682                                   }
 683                                   return 1 if $object_map{'cust_main'}{$object->username};
 684                                   my $svc_acct =
 685                                     qsearchs( 'svc_acct',
 686                                               { 'username' => $row->{'login'} }
 687                                             );
 688                                   unless( $svc_acct ) {
 689                                     warn "can't find svc_acct for email ".
 690                                       $row->{'login'};
 691                                     return 1;
 692                                   }
 693                                   $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svc_acct->svcnum;
 694                                   return 1;
 695                                 },
 696 #               'skey'    => sub { my $object = shift;
 697 #                                  my $href = shift;
 698 #                                  'email:'. $href->{'email_customer_id'};
 699 #                                },
 700                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 701                                      next unless $id =~ /^email:(\d+)/;
 702                                      my $custid = $1;
 703                                      my $cust_svc =
 704                                        qsearchs( 'cust_svc', { 'svcnum' =>
 705                                                  $object_map{'svc_acct'}{$id} }
 706                                        );
 707                                      unless ($cust_svc) {
 708                                        warn "can't find legacy email $id\n";
 709                                        next;
 710                                      }
 711
 712                                      $cust_svc->
 713                                        pkgnum($cust_pkg_map{$custid});
 714                                      my $error = $cust_svc->replace;
 715                                      warn "error linking legacy email $id: $error\n";
 716                                    }
 717                                  },
 718              },
 719 );
 720
 721 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
 722 my $d_dbh = adminsuidsetup $d_dbuser;
 723
 724 local $FS::UID::AutoCommit = 0;
 725
 726 while ( @tables ) {
 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'};
 734
 735   #$d_dbh->do("delete from $table");
 736
 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];
 740
 741   $s_sth = $s_dbh->prepare("select * from $stable");
 742   $s_sth->execute or die $s_sth->errstr;
 743
 744   my $row;
 745   $count = 0;
 746   while ( $row = $s_sth->fetchrow_hashref ) {
 747     my $class = "FS::$table";
 748
 749     warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
 750       unless( !$count || $count % 100 );
 751
 752     my $object = new $class ( {
 753         map { $_  => ( ref($mapping{$_}) eq 'CODE'
 754                        ? &{$mapping{$_}}($row)
 755                        : $row->{$mapping{$_}}
 756                      )
 757             }
 758           keys(%mapping)
 759     } );
 760     my $skip = &{$fixup}($object, $row)
 761       if $fixup;
 762
 763     unless ($skip) {
 764       my $error = $object->insert;
 765       if ($error) {
 766         warn "Error inserting $table ".
 767           join(", ", map{"$_ => ". $object->get($_)} fields $object).
 768           ": $error\n";
 769         next;
 770       }
 771       if ($skey) {
 772         my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
 773                                          : $row->{$skey};
 774         $object_map{$table}{$key} = $object->get($object->primary_key)
 775       }
 776       $count++;
 777     }
 778   }
 779
 780   &{$wrapup}()
 781     if $wrapup;
 782
 783   print "$count/$rowcount of $table SUCCESSFULLY processed\n";
 784
 785 }
 786
 787 if ($dry_run) {
 788   $d_dbh->rollback;
 789 }else{
 790   $d_dbh->commit or die $d_dbh->errstr;
 791 }
 792