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 Text::CSV_XS;
   8 use FS::Record qw(qsearch qsearchs);
   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::UID qw(adminsuidsetup);
  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 $radius_file    = 'radius.csv';
  33 my $email_file    = 'email.csv';
  34
  35 #my $agentnum = 1;
  36 my $agentnum = 13;
  37 my $legacy_domain_svcnum = 1;
  38 my $legacy_ppp_svcpart = 2;
  39 my $legacy_email_svcpart = 3;
  40 #my $legacy_broadband_svcpart = 4;
  41 #my $legacy_broadband_svcpart = 14;
  42 #my $previous_credit_reasonnum = 1;
  43 my $previous_credit_reasonnum = 1220;
  44
  45
  46 my $state = '';  #statemachine-ish
  47 my $sourcefile;
  48 my $s_dbh;
  49 my $columncount;
  50 my $rowcount;
  51
  52 my @args = (
  53              {
  54                id    => 1,
  55                hdr   => \&header,
  56                row   => \&row,
  57                start => \&start,
  58                end   => \&end,
  59              },
  60            );
  61
  62
  63 $s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass,
  64                            { 'AutoCommit' => 0,
  65                              'ChopBlanks' => 1,
  66                              'ShowErrorStatement' => 1
  67                            }
  68                      );
  69
  70 foreach ( qw ( billcycle cust email product ) ) {
  71   $sourcefile = $_;
  72
  73   print "parsing $sourcefile\n";
  74
  75   die "bad file name" unless $sourcefile =~ /^\w+$/;
  76
  77   $columncount = 0;
  78   $rowcount = 0;
  79
  80   my $c_sth = '';
  81   if ( $c_sth = $s_dbh->prepare("SELECT COUNT(*) FROM $sourcefile") ) {
  82     if ( $c_sth->execute ) {
  83       if ( $c_sth->fetchrow_arrayref->[0] ) {
  84         warn "already have data in $sourcefile table; skipping";
  85         next;
  86       }
  87     }
  88   }
  89
  90   my $tp = new HTML::TableParser( \@args, { Decode => 1, Trim => 1, Chomp => 1 });
  91   $tp->parse_file($sourcefile.$extension) or die "failed";
  92   $s_dbh->commit or die $s_dbh->errstr;
  93 #  $s_dbh->disconnect;
  94 }
  95
  96
  97 sub start {
  98   warn "start\n" if $DEBUG;
  99   my $table_id = shift;
 100   die "unexpected state change" unless $state eq '';
 101   die "unexpected table" unless $table_id eq '1';
 102   $state = 'table';
 103 }
 104
 105 sub end {
 106   warn "end\n" if $DEBUG;
 107   my ($tbl_id, $line, $udata) = @_;
 108   die "unexpected state change in header" unless $state eq 'rows';
 109   die "unexpected table" unless $tbl_id eq '1';
 110   $state = '';
 111 }
 112
 113 sub header {
 114   warn "header\n" if $DEBUG;
 115   my ($tbl_id, $line, $cols, $udata) = @_;
 116   die "unexpected state change in header" unless $state eq 'table';
 117   die "unexpected table" unless $tbl_id eq '1';
 118   $state = 'rows';
 119
 120   die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols)
 121     if scalar(grep { !/^[ \w\r]+$/ } @$cols);
 122
 123   my $sql = "CREATE TABLE $sourcefile ( ".
 124     join(', ', map { s/[ \r]/_/g; "$_ varchar NULL" } @$cols). " )";
 125   $s_dbh->do($sql) or die "create table failed: ". $s_dbh->errstr;
 126   $columncount = scalar( @$cols );
 127 }
 128
 129 sub row {
 130   warn "row\n" if $DEBUG;
 131   my ($tbl_id, $line, $cols, $udata) = @_;
 132   die "unexpected state change in row" unless $state eq 'rows';
 133   die "unexpected table" unless $tbl_id eq '1';
 134
 135   die "invalid number of columns: ". join(', ', @$cols)
 136     unless (scalar(@$cols) == $columncount);
 137
 138   my $sql = "INSERT INTO $sourcefile VALUES(".
 139     join(', ', map { $s_dbh->quote($_) } @$cols). ")";
 140   $s_dbh->do($sql) or die "insert failed: ". $s_dbh->errstr;
 141   $rowcount++;
 142   warn "row $rowcount\n" unless ($rowcount % 1000);
 143 }
 144
 145 ## now svc_acct from CSV files
 146
 147 $FS::cust_main::import=1;
 148 $FS::cust_pkg::disable_agentcheck = 1;
 149 $FS::cust_svc::ignore_quantity = 1;
 150
 151 my (%master_map) = ();
 152 my (%referrals) = ();
 153 my (%custid) = ();
 154 my (%cancel) = ();
 155 my (%susp) = ();
 156 my (%adjo) = ();
 157 my (%bill) = ();
 158 my (%cust_pkg_map) = ();
 159 my (%object_map) = ();
 160 my (%package_cache) = ();
 161 my $count = 0;
 162
 163 my $d_dbh = adminsuidsetup $d_dbuser;
 164 local $FS::UID::AutoCommit = 0;
 165
 166 my @import = ( { 'file'     => $radius_file,
 167                  'sep_char' => ';',
 168                  'fields'   => [ qw( garbage1 username garbage2 garbage3 _password ) ],
 169                  'fixup'    => sub {
 170                                      my $hash = shift;
 171                                      delete $hash->{$_}
 172                                        foreach qw (garbage1 garbage2 garbage3);
 173                                      $hash->{'svcpart'} = $legacy_ppp_svcpart;
 174                                      $hash->{'domsvc'} = $legacy_domain_svcnum;
 175                                      '';
 176                                    },
 177                  'mapkey'   => 'legacy_ppp',
 178                  'skey'     => 'username',
 179                },
 180                { 'file'     => $email_file,
 181                  'sep_char' => ';',
 182                  'fields'   => [ qw( username null finger _password status garbage ) ],
 183                  'fixup'    => sub {
 184                                      my $hash = shift;
 185                                      return 1
 186                                        if $object_map{'legacy_ppp'}{$hash->{'username'}};
 187                                      delete $hash->{$_}
 188                                        foreach qw (null status garbage);
 189                                      $hash->{'svcpart'} = $legacy_email_svcpart;
 190                                      $hash->{'domsvc'} = $legacy_domain_svcnum;
 191                                      '';
 192                                    },
 193                  'mapkey'   => 'legacy_email',
 194                  'skey'     => 'username',
 195                },
 196 );
 197
 198 while ( @import ) {
 199   my $href = shift @import;
 200   my $file = $href->{'file'} or die "No file specified";
 201   my (@fields)   = @{$href->{'fields'}};
 202   my ($sep_char) = $href->{'sep_char'} || ';';
 203   my ($fixup)    = $href->{'fixup'};
 204   my ($mapkey)   = $href->{'mapkey'};
 205   my ($skey)     = $href->{'skey'};
 206   my $line;
 207
 208   my $csv = new Text::CSV_XS({'sep_char' => $sep_char});
 209   open(FH, $file) or die "cannot open $file: $!";
 210   $count = 0;
 211
 212   while ( defined($line=<FH>) ) {
 213     chomp $line;
 214
 215     $line &= "\177" x length($line); # i hope this isn't really necessary
 216     $csv->parse($line)
 217       or die "cannot parse: " . $csv->error_input();
 218
 219     my @values = $csv->fields();
 220     my %hash;
 221     foreach my $field (@fields) {
 222       $hash{$field} = shift @values;
 223     }
 224
 225     if (@values) {
 226       warn "skipping malformed line: $line\n";
 227       next;
 228     }
 229
 230     my $skip = &{$fixup}(\%hash)
 231       if $fixup;
 232
 233     unless ($skip) {
 234       my $svc_acct = new FS::svc_acct { %hash };
 235       my $error = $svc_acct->insert;
 236       if ($error) {
 237         warn $error;
 238         next;
 239       }
 240
 241       if ($skey && $mapkey) {
 242         my $key = (ref($skey) eq 'CODE') ? &{$skey}($svc_acct) : $hash{$skey};
 243         $object_map{$mapkey}{$key} = $svc_acct->svcnum;
 244       }
 245
 246       $count++
 247     }
 248   }
 249   print "Imported $count service records\n";
 250
 251 }
 252
 253
 254
 255 sub pkg_freq {
 256   my ( $href ) = ( shift );
 257   $href->{'one_time_list'}
 258     ? 0
 259 #    : int(eval "$href->{'months_credit'} + 0");
 260     : int(eval "$href->{'month_credit'} + 0");
 261 }
 262
 263 sub b_or {
 264   my ( $field, $hash ) = ( shift, shift );
 265   $field = 'bill_'. $field
 266     if $hash->{'billing_use'} eq 'Billing Address';
 267   $hash->{$field};
 268 }
 269
 270 sub p_or {
 271   my ( $field, $hash ) = ( shift, shift );
 272   $field = 'bill_'. $field
 273     if $hash->{'billing_use'} eq 'Billing Address';
 274   my $ac = ( $hash->{$field. '_area_code'}
 275           && $hash->{$field. '_area_code'} =~ /^\d{3}$/ )
 276              ? $hash->{$field. '_area_code'}. '-'
 277              : '903-' # wtf?
 278   ;
 279   ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
 280     ? $ac. $hash->{$field}
 281     : '';
 282 }
 283
 284 sub or_b {
 285   my ( $field, $hash ) = ( shift, shift );
 286   $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
 287 }
 288
 289 sub or_p {
 290   my ( $field, $hash ) = ( shift, shift );
 291   $hash->{'billing_use'} eq 'Billing Address' && $hash->{$field} =~ /^\d{3}-\d{4}$/
 292     ? ( $hash->{$field. '_area_code'} =~ /^\d{3}$/
 293         ? $hash->{$field. '_area_code'}. '-'
 294         : '903-'  # wtf?
 295       ). $hash->{$field}
 296     : '';
 297 }
 298
 299 my %payby_map = ( ''              => 'BILL',
 300                   'None'          => 'BILL',
 301                   'Credit Card'   => 'CARD',
 302                   'Bank Debit'    => 'CHEK',
 303                   'Virtual Check' => 'CHEK',
 304 );
 305 sub payby {
 306   $payby_map{ shift->{billing_type} };
 307 }
 308
 309 sub payinfo {
 310   my $hash = shift;
 311   my $payby = payby($hash);
 312   my $info;
 313   my $cc =
 314     $hash->{'credit_card_number_1'}.
 315     $hash->{'credit_card_number_2'}.
 316     $hash->{'credit_card_number_3'}.
 317     $hash->{'credit_card_number_4'};
 318   my $bank =
 319     $hash->{'bank_account_number'}.
 320     '@'.
 321     $hash->{'bank_transit_number'};
 322   if ($payby eq 'CARD') {
 323     $info = $cc;
 324   }elsif ($payby eq 'CHEK') {
 325     $info = $bank;
 326   }elsif ($payby eq 'BILL') {
 327     $info = $hash->{'blanket_purchase_order_number'};
 328     $bank =~ s/[^\d\@]//g;
 329     $cc =~ s/\D//g;
 330     if ( $bank =~ /^\d+\@\d{9}/) {
 331       $info = $bank;
 332       $payby = 'DCHK';
 333     }
 334     if ( $cc =~ /^\d{13,16}/ ) {
 335       $info = $cc;
 336       $payby = 'DCRD';
 337     }
 338   }else{
 339     die "unexpected payby";
 340   }
 341   ($info, $payby);
 342 }
 343
 344 sub ut_name_fixup {
 345   my ($object, $field) = (shift, shift);
 346   my $value = $object->getfield($field);
 347   $value =~ s/[^\w \,\.\-\']/ /g;
 348   $object->setfield($field, $value);
 349 }
 350
 351 sub ut_text_fixup {
 352   my ($object, $field) = (shift, shift);
 353   my $value = $object->getfield($field);
 354   $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
 355   $object->setfield($field, $value);
 356 }
 357
 358 sub ut_state_fixup {
 359   my ($object, $field) = (shift, shift);
 360   my $value = $object->getfield($field);
 361   $value = 'TX' if $value eq 'TTX';
 362   $object->setfield($field, $value);
 363 }
 364
 365 sub ut_zip_fixup {
 366   my ($object, $field) = (shift, shift);
 367   my $value = $object->getfield($field);
 368   $value =~ s/[^-\d]//g;
 369   $object->setfield($field, $value);
 370 }
 371
 372 my @tables = (
 373 #part_pkg => { 'stable'  => 'product',
 374 part_pkg => { 'stable'  => 'billcycle',
 375               'mapping' =>
 376                 { 'pkg'      => sub { my $href = shift;
 377                                       $href->{'description'}
 378                                         ? $href->{'description'}
 379                                         : $href->{'product_id'};
 380                                     },
 381                   'comment'  => 'product_id',
 382                   'freq'     => sub { pkg_freq(shift) },
 383                   'recur'    => sub { my $href = shift;
 384                                       my $price = ( pkg_freq($href)
 385                                         ? $href->{'unit_price'}
 386                                         : 0
 387                                       );
 388                                       $price =~ s/[^\d.]//g;
 389                                       $price = 0 unless $price;
 390                                       sprintf("%.2f", $price);
 391                                     },
 392                   'setuptax' => sub { my $href = shift;
 393                                       $href->{'taxable'} ? '' : 'Y';
 394                                     },
 395                   'recurtax' => sub { my $href = shift;
 396                                       $href->{'taxable'} ? '' : 'Y';
 397                                     },
 398                   'plan'     => sub { 'flat' },
 399                   'disabled' => sub { 'Y' },
 400                   'pkg_svc'  => sub { my $href = shift;
 401                                       my $result = {};
 402                                       if (pkg_freq($href)){
 403                                         $result->{$legacy_ppp_svcpart} = 1;
 404                                         $result->{$legacy_email_svcpart} =
 405                                             $href->{emails_allowed}
 406                                           if $href->{emails_allowed};
 407                                       }
 408                                     },
 409                   'primary_svc'=> sub { pkg_freq(shift)
 410                                           ? $legacy_ppp_svcpart
 411                                           : ''
 412                                         ;
 413                                       },
 414                 },
 415               'fixup'   => sub { my $part_pkg = shift;
 416                                  my $row = shift;
 417                                  unless ($part_pkg->pkg =~ /^\s*(\S[\S ]*?)\s*$/) {
 418                                    warn "no pkg: ". $part_pkg->pkg. " for ". $row->{product_id};
 419                                    return 1;
 420                                  }
 421
 422                                  unless ($part_pkg->comment =~ /^\s*(\S[\S ]*?)\s*$/) {
 423                                    warn "no comment: ". $part_pkg->comment. " for ". $row->{product_id};
 424                                    return 1;
 425                                  }
 426
 427                                  return 1 if exists($package_cache{$1});
 428                                  $package_cache{$1} = $part_pkg;
 429                                  1;
 430                                },
 431               'wrapup'  => sub { foreach (keys %package_cache) {
 432                                    my $part_pkg = $package_cache{$_};
 433                                    my $options =
 434                                      { map { my $v = $part_pkg->$_;
 435                                              $part_pkg->$_('');
 436                                              ($_ => $v);
 437                                            }
 438                                        qw (setup recur)
 439                                      };
 440                                    my $error =
 441                                      $part_pkg->insert(options=>$options);
 442                                    die "Error inserting package: $error"
 443                                      if $error;
 444                                    $count++ unless $error;
 445                                  }
 446                                },
 447             },
 448 part_referral => { 'stable'  => 'cust',
 449                    'mapping' =>
 450                      { 'agentnum' => sub { $agentnum },
 451                        'referral' => sub { my $r = shift->{'referred_from'};
 452                                            $referrals{$r} = 1;
 453                                          },
 454                      },
 455                    'fixup'   => sub { 1 },
 456                    'wrapup'  => sub { foreach (keys %referrals) {
 457                                         my $part_referral =
 458                                           new FS::part_referral( {
 459                                             'agentnum' => $agentnum,
 460                                             'referral' => $referrals{$_},
 461                                           } );
 462                                         my $error = $part_referral->insert;
 463                                         die "Error inserting referral: $error"
 464                                           if $error;
 465                                         $count++ unless $error;
 466                                         $referrals{$_} = $part_referral->refnum;
 467                                       }
 468                                     },
 469                  },
 470 #svc_acct  => { 'stable'  => 'cust',
 471 #               'mapping' =>
 472 #                 { 'username'     => 'login',
 473 #                   '_password'    => 'password',
 474 #                   'svcpart'      => sub{ $legacy_ppp_svcpart },
 475 #                   'domsvc'       => sub{ $legacy_domain_svcnum },
 476 #                   'status'       => 'status',
 477 #                 },
 478 #               'fixup'   => sub { my $svc_acct = shift;
 479 #                                  my $row = shift;
 480 #                                  my $id = $row->{'master_account'}
 481 #                                           ? 'slave:'. $row->{'customer_id'}
 482 #                                           : $row->{'login'};
 483 #                                  my $status = $svc_acct->status;
 484 #                                  if ( $status ne 'Current'
 485 #                                    && $status ne 'On Hold' )
 486 #                                  {
 487 #                                    $cancel{$id} =
 488 #                                      str2time($row->{termination_date});
 489 #                                    warn "not creating (cancelled) svc_acct for " .
 490 #                                      $svc_acct->username. "\n";
 491 #                                    return 1
 492 #                                  }
 493 #                                  $susp{$id} = str2time($row->{hold_date})
 494 #                                    if $status eq 'On Hold';
 495 #                                  $adjo{$id} = str2time($row->{hold_date})
 496 #                                    if ( $status eq 'Current' &&
 497 #                                         $row->{hold_date} );
 498 #                                  $bill{$id} =
 499 #                                    str2time($row->{expiration_date});
 500 #                                  '';
 501 #                                },
 502 #               'skey'    => sub { my $svc_acct = shift;
 503 #                                  my $row = shift;
 504 #                                  my $id = $row->{'master_account'}
 505 #                                    ? 'slave:'. $row->{'customer_id'}
 506 #                                    : $row->{'login'};
 507 #                                },
 508 #             },
 509 cust_main => { 'stable'  => 'cust',
 510                'mapping' =>
 511                  { 'agentnum'     => sub { $agentnum },
 512                    'agent_custid' => sub { my $id = shift->{'customer_number'};
 513                                            if (exists($custid{$id})) {
 514                                              $custid{$id}++;
 515                                              $id.  chr(64 + $custid{$id});
 516                                            }else{
 517                                              $custid{$id} = 0;
 518                                              $id;
 519                                            }
 520                                          },
 521                    'last'         => sub { b_or('last_name', shift) || ' ' },
 522                    'first'        => sub { b_or('first_name', shift)  || ' ' },
 523                    'stateid'      => 'drivers_license_number',
 524                    'signupdate'   => sub { str2time(shift->{'creation_date'}) },
 525                    'company'      => sub { b_or('company_name', shift) },
 526                    'address1'     => sub { b_or('address', shift) || ' ' },
 527                    'city'         => sub { b_or('city', shift) || 'Paris' },
 528                    'state'        => sub { uc(b_or('state', shift)) || 'TX' },
 529                    'zip'          => sub { b_or('zip_code', shift) || '75460' },
 530                    'country'      => sub { 'US' },
 531                    'daytime'      => sub { p_or('phone', shift) },
 532                    'night'        => sub { p_or('phone_alternate_1', shift) },
 533                    'fax'          => sub { p_or('fax', shift) },
 534                    'ship_last'    => sub { or_b('last_name', shift) },
 535                    'ship_first'   => sub { or_b('first_name', shift) },
 536                    'ship_company' => sub { or_b('company_name', shift) },
 537                    'ship_address1'=> sub { or_b('address', shift) },
 538                    'ship_city'    => sub { or_b('city', shift) },
 539                    'ship_state'   => sub { uc(or_b('state', shift)) },
 540                    'ship_zip'     => sub { or_b('zip_code', shift) },
 541                    'ship_daytime' => sub { or_p('phone', shift) },
 542                    'ship_fax'     => sub { or_p('fax', shift) },
 543                    'tax'          => sub { shift->{taxable} eq '' ? 'Y' : '' },
 544                    'refnum'       => sub { $referrals{shift->{'referred_from'}}
 545                                            || 1
 546                                          },
 547                  },
 548                'fixup'   => sub { my $cust_main = shift;
 549                                   my $row = shift;
 550
 551                                   my ($master_account, $customer_id, $login) =
 552                                     ('', '', '');
 553                                   $row->{'master_account'} =~ /^\s*(\S[\S ]*?)\s*$/
 554                                     && ($master_account = $1);
 555                                   $row->{'customer_id'} =~ /^\s*(\S[\S ]*?)\s*$/
 556                                     && ($customer_id = $1);
 557                                   $row->{'login'} =~ /^\s*(\S[\S ]*?)\s*$/
 558                                     && ($login = $1);
 559
 560                                   my $id = $master_account
 561                                            ? 'slave:'. $customer_id
 562                                            : $login;
 563                                   my $status = $row->{status};
 564
 565                                   my $cancelled = 0;
 566                                   if ( $status ne 'Current'
 567                                     && $status ne 'On Hold' )
 568                                   {
 569                                     $cancelled = 1;
 570                                     $cancel{$login} =
 571                                       str2time($row->{termination_date});
 572                                   }
 573                                   $susp{$login} = str2time($row->{hold_date})
 574                                     if ($status eq 'On Hold' && !$cancelled);
 575                                   $adjo{$login} = str2time($row->{hold_date})
 576                                     if ( $status eq 'Current' && !$cancelled &&
 577                                          $row->{hold_date} );
 578                                   $bill{$login} =
 579                                       str2time($row->{expiration_date})
 580                                     if (!$cancelled);
 581
 582                                   my $svcnum =
 583                                     $object_map{legacy_ppp}{$row->{'login'} };
 584                                   unless( $cancelled || $svcnum ) {
 585                                     warn "can't find svc_acct for legacy ppp ".
 586                                         $row->{'login'}, "\n";
 587                                   }
 588
 589                                   $object_map{svc_acct}{$id} = $svcnum
 590                                     unless $cancelled;
 591
 592                                   $master_map{$login} = $row->{master_account}
 593                                     if $row->{master_account};
 594                                   return 1 if $row->{master_account};
 595                                   $cust_main->ship_country('US')
 596                                     if $cust_main->has_ship_address;
 597                                   ut_name_fixup($cust_main, 'first');
 598                                   ut_name_fixup($cust_main, 'company');
 599                                   ut_name_fixup($cust_main, 'last');
 600
 601                                   my ($info, $payby) = payinfo($row);
 602                                   $cust_main->payby($payby);
 603                                   $cust_main->payinfo($info);
 604
 605                                   $cust_main->paycvv(
 606                                       $row->{'credit_card_cvv_number'}
 607                                   )
 608                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 609
 610                                   $cust_main->paydate('20'.
 611                                       $row->{'credit_card_exp_date_2'}.  '-'.
 612                                       substr(
 613                                         $row->{'credit_card_exp_date_1'},
 614                                         0,
 615                                         2,
 616                                       ).
 617                                       '-01'
 618                                   )
 619                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 620
 621                                   my $payname = '';
 622                                   $payname = $row->{'credit_card_name'}
 623                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 624                                   $payname = $row->{'bank_name'}
 625                                     if ($payby eq 'CHEK' or $payby eq 'DCHK');
 626                                   $cust_main->payname($payname);
 627
 628                                   $cust_main->paytype(
 629                                       $row->{'bank_account_to_debit'}
 630                                         ? 'Personal '.
 631                                           $row->{bank_account_to_debit}
 632                                         : ''
 633                                   )
 634                                     if ($payby eq 'CHEK' or $payby eq 'DCHK');
 635
 636                                   $cust_main->payby('BILL')
 637                                     if ($cust_main->payby eq 'CHEK' &&
 638                                         $cust_main->payinfo !~ /^\d+\@\d{9}$/);
 639                                   $cust_main->payby('BILL')
 640                                     if ($cust_main->payby eq 'CARD' &&
 641                                         $cust_main->payinfo =~ /^\s*$/);
 642                                   $cust_main->paydate('2037-12-01')
 643                                     if ($cust_main->payby eq 'BILL');
 644                                   ut_text_fixup($cust_main, 'address1');
 645                                   ut_state_fixup($cust_main, 'state');
 646                                   ut_zip_fixup($cust_main, 'zip');
 647
 648
 649                                   '';
 650                                 },
 651                'skey'    => sub { my $object = shift;
 652                                   my $href = shift;
 653                                   my $balance = sprintf("%.2f",
 654                                                         $href->{balance_due});
 655                                   if ($balance < 0) {
 656                                     my $cust_credit = new FS::cust_credit({
 657                                       'custnum'   => $object->custnum,
 658                                       'amount'    => sprintf("%.2f", -$balance),
 659                                       'reasonnum' => $previous_credit_reasonnum,
 660                                     });
 661                                     my $error = $cust_credit->insert;
 662                                     warn "Error inserting credit for ",
 663                                          $href->{'login'}, " : $error\n"
 664                                       if $error;
 665
 666                                   }elsif($balance > 0) {
 667                                     my $error = $object->charge(
 668                                                   $balance, "Prior balance",
 669                                                 );
 670                                     warn "Error inserting balance charge for ",
 671                                          $href->{'login'}, " : $error\n"
 672                                       if $error;
 673
 674                                   }
 675                                   $href->{'login'};
 676                                 },
 677              },
 678 #cust_main => { 'stable'  => 'cust',
 679 #               'mapping' =>
 680 #                 { 'referred_by' => sub { my $href = shift;
 681 #                                          my $u = shift->{'login'};
 682 #                                          my $cn = $href->{'customer_number'};
 683 #
 684 #                                          my $c = qsearch( 'cust_main',
 685 #                                                           { 'custnum' => $cn }
 686 #                                          ) or die "can't fine customer $cn";
 687 #
 688 #                                          my $s = qsearch( 'svc_acct',
 689 #                                                           { 'username' => $u }
 690 #                                                         ) or return '';
 691 #
 692 #                                          my $n = $s->cust_svc
 693 #                                                    ->cust_pkg
 694 #                                                    ->cust_main
 695 #                                                    ->custnum;
 696 #
 697 #                                          $c->referral_custnum($n);
 698 #                                          my $error = $c->replace;
 699 #                                          die "error setting referral: $error"
 700 #                                            if $error;
 701 #                                          '';
 702 #                                        },
 703 #                 };
 704 #               'fixup'   => sub { 1 },
 705 #             },
 706 cust_pkg  => { 'stable'  => 'billcycle',
 707                'mapping' =>
 708                  { 'custnum'     => sub { my $l = shift->{cbilling_cycle_login};
 709                                           $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
 710                                           my $r = $object_map{'cust_main'}{$l};
 711                                           unless ($r) {
 712                                             my $m = $master_map{$l};
 713                                             $r = $object_map{'cust_main'}{$m}
 714                                               if $m;
 715                                           }
 716                                           $r;
 717                                         },
 718                    'pkgpart'     => sub { my $p = shift->{product_id};
 719                                           $p =~ /^\s*(\S[\S ]*?)\s*$/ && ($p = $1);
 720                                           $package_cache{$p}
 721                                             ? $package_cache{$p}->pkgpart
 722                                             : '';
 723                                         },
 724                    'setup'       => sub { str2time(shift->{creation_date}) },
 725                    'bill'        => sub { my $href = shift;
 726                                           #my $id = $href->{'slave_account_id'}
 727                                           #  ? 'slave:'. $href->{'slave_account_id'}
 728                                           #  : $href->{'cbilling_cycle_login'};
 729                                           #$bill{$id};
 730                                           $bill{$href->{cbilling_cycle_login}};
 731                                         },
 732                    'susp'        => sub { my $href = shift;
 733                                           #my $id = $href->{'slave_account_id'}
 734                                           #  ? 'slave:'. $href->{'slave_account_id'}
 735                                           #  : $href->{'cbilling_cycle_login'};
 736                                           #$susp{$id};
 737                                           $susp{$href->{cbilling_cycle_login}};
 738                                         },
 739                    'adjo'        => sub { my $href = shift;
 740                                           #my $id = $href->{'slave_account_id'}
 741                                           #  ? 'slave:'. $href->{'slave_account_id'}
 742                                           #  : $href->{'cbilling_cycle_login'};
 743                                           #$adjo{$id};
 744                                           $adjo{$href->{cbilling_cycle_login}};
 745                                         },
 746                    'cancel'      => sub { my $href = shift;
 747                                           #my $id = $href->{'slave_account_id'}
 748                                           #  ? 'slave:'. $href->{'slave_account_id'}
 749                                           #  : $href->{'cbilling_cycle_login'};
 750                                           #$cancel{$id};
 751                                           $cancel{$href->{cbilling_cycle_login}};
 752                                         },
 753                  },
 754                'fixup'  => sub { my ($object, $row) = (shift,shift);
 755                                  unless ($object->custnum) {
 756                                    warn "can't find customer for ".
 757                                      $row->{cbilling_cycle_login}. "\n";
 758                                    return 1;
 759                                  }
 760                                  unless ($object->pkgpart) {
 761                                    warn "can't find package for ".
 762                                      $row->{product_id}. "\n";
 763                                    return 1;
 764                                  }
 765                                  '';
 766                                },
 767                'skey'   => sub { my $object = shift;
 768                                  my $href = shift;
 769                                  if ($href->{'slave_account_id'} =~ /^\s*(\S[\S ]*?)\s*$/) {
 770                                    "slave:$1";
 771                                  }else{
 772                                    my $id = $href->{'billing_cycle_item_id'};
 773                                    $cust_pkg_map{$id} = $object->pkgnum;
 774                                    $href->{'cbilling_cycle_login'};
 775                                  }
 776                                },
 777                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 778                                      my $cust_svc =
 779                                        qsearchs( 'cust_svc', { 'svcnum' =>
 780                                                  $object_map{'svc_acct'}{$id} }
 781                                        );
 782                                      unless ($cust_svc) {
 783                                        warn "can't find legacy ppp $id\n";
 784                                        next;
 785                                      }
 786                                      $cust_svc->
 787                                        pkgnum($object_map{'cust_pkg'}{$id});
 788                                      my $error = $cust_svc->replace;
 789                                      warn "error linking legacy ppp $id: $error\n"
 790                                        if $error;
 791                                    }
 792                                  },
 793              },
 794 svc_acct  => { 'stable'  => 'email',
 795                'mapping' =>
 796                  { 'username'    => 'email_name',
 797                    '_password'   => 'password',
 798                    'svcpart'      => sub{ $legacy_email_svcpart },
 799                    'domsvc'       => sub{ $legacy_domain_svcnum },
 800                  },
 801 #               'fixup'   => sub { my ($object, $row) = (shift,shift);
 802 #                                  my ($sd,$sm,$sy) = split '/',
 803 #                                                     $row->{shut_off_date}
 804 #                                    if $row->{shut_off_date};
 805 #                                  if ($sd && $sm && $sy) {
 806 #                                    my ($cd, $cm, $cy) = (localtime)[3,4,5];
 807 #                                    $cy += 1900; $cm++;
 808 #                                    return 1 if $sy < $cy;
 809 #                                    return 1 if ($sy == $cy && $sm < $cm);
 810 #                                    return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 811 #                                  }
 812 #                                  return 1 if $object_map{'cust_main'}{$object->username};
 813 #                                  '';
 814 #                                },
 815                'fixup'   => sub { my ($object, $row) = (shift,shift);
 816                                   my ($sd,$sm,$sy) = split '/',
 817                                                      $row->{shut_off_date}
 818                                     if $row->{shut_off_date};
 819                                   if ($sd && $sm && $sy) {
 820                                     my ($cd, $cm, $cy) = (localtime)[3,4,5];
 821                                     $cy += 1900; $cm++;
 822                                     return 1 if $sy < $cy;
 823                                     return 1 if ($sy == $cy && $sm < $cm);
 824                                     return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 825                                   }
 826                                   return 1 if $object_map{'cust_main'}{$object->username};
 827
 828                                   my $svcnum =
 829                                     $object_map{legacy_email}{$row->{'email_name'} };
 830                                   unless( $svcnum ) {
 831                                     warn "can't find svc_acct for legacy email ".
 832                                       $row->{'email_name'}, "\n";
 833                                     return 1;
 834                                   }
 835
 836                                   $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svcnum;
 837                                   return 1;
 838                                 },
 839 #               'skey'    => sub { my $object = shift;
 840 #                                  my $href = shift;
 841 #                                  'email:'. $href->{'email_customer_id'};
 842 #                                },
 843                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 844                                      next unless $id =~ /^email:(\d+)/;
 845                                      my $custid = $1;
 846                                      my $cust_svc =
 847                                        qsearchs( 'cust_svc', { 'svcnum' =>
 848                                                  $object_map{'svc_acct'}{$id} }
 849                                        );
 850                                      unless ($cust_svc) {
 851                                        warn "can't find legacy email $id\n";
 852                                        next;
 853                                      }
 854
 855                                      $cust_svc->
 856                                        pkgnum($cust_pkg_map{$custid});
 857                                      my $error = $cust_svc->replace;
 858                                      warn "error linking legacy email $id: $error\n"
 859                                        if $error;
 860                                    }
 861                                  },
 862              },
 863 );
 864
 865 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
 866
 867 while ( @tables ) {
 868   my ($table, $href) = (shift @tables, shift @tables);
 869   my $stable = $href->{'stable'} or die "No source table"; # good enough for now
 870   my (%mapping) = %{$href->{'mapping'}};
 871   my ($fixup)   = $href->{'fixup'};
 872   my ($wrapup)  = $href->{'wrapup'};
 873   my ($id)      = $href->{'id'};
 874   my ($skey)    = $href->{'skey'};
 875
 876   #$d_dbh->do("delete from $table");
 877
 878   my $s_sth = $s_dbh->prepare("select count(*) from $stable");
 879   $s_sth->execute or die $s_sth->errstr;
 880   my $rowcount = $s_sth->fetchrow_arrayref->[0];
 881
 882   $s_sth = $s_dbh->prepare("select * from $stable");
 883   $s_sth->execute or die $s_sth->errstr;
 884
 885   my $row;
 886   $count = 0;
 887   while ( $row = $s_sth->fetchrow_hashref ) {
 888     my $class = "FS::$table";
 889
 890     warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
 891       unless( !$count || $count % 100 );
 892
 893     my $object = new $class ( {
 894         map { $_  => ( ref($mapping{$_}) eq 'CODE'
 895                        ? &{$mapping{$_}}($row)
 896                        : $row->{$mapping{$_}}
 897                      )
 898             }
 899           keys(%mapping)
 900     } );
 901     my $skip = &{$fixup}($object, $row)
 902       if $fixup;
 903
 904     unless ($skip) {
 905       my $error = $object->insert;
 906       if ($error) {
 907         warn "Error inserting $table ".
 908           join(", ", map{"$_ => ". $object->get($_)} fields $object).
 909           ": $error\n";
 910         next;
 911       }
 912       if ($skey) {
 913         my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
 914                                          : $row->{$skey};
 915         $object_map{$table}{$key} = $object->get($object->primary_key)
 916       }
 917       $count++;
 918     }
 919   }
 920
 921   &{$wrapup}()
 922     if $wrapup;
 923
 924   print "$count/$rowcount of $table SUCCESSFULLY processed\n";
 925
 926 }
 927
 928 if ($dry_run) {
 929   $d_dbh->rollback;
 930 }else{
 931   $d_dbh->commit or die $d_dbh->errstr;
 932 }
 933