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/\s*(\S[\S ]*?)\s*$/$1/; $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   my $once;
 258   $href->{'one_time_list'} =~ /^\s*(\S[\S ]*?)\s*$/ && ($once = $1);
 259   $once
 260     ? 0
 261     : int(eval "$href->{'months_credit'} + 0");
 262 #   int(eval "$href->{'month_credit'} + 0");
 263 }
 264
 265 sub account_id {
 266   my $href = shift;
 267   if ($href->{'slave_account_id'} =~ /^\s*(\S[\S ]*?)\s*$/) {
 268     "slave:$1";
 269   }else{
 270     my $l = $href->{cbilling_cycle_login};
 271     $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
 272     $l;
 273   }
 274 }
 275
 276 sub b_or {
 277   my ( $field, $hash ) = ( shift, shift );
 278   $field = 'billing_'. $field
 279     if $hash->{'billing_use'} eq 'Billing Address';
 280   $hash->{$field};
 281 }
 282
 283 sub p_or {
 284   my ( $field, $hash ) = ( shift, shift );
 285   $field = 'billing_'. $field
 286     if $hash->{'billing_use'} eq 'Billing Address';
 287   my $ac = ( $hash->{$field. '_area_code'}
 288           && $hash->{$field. '_area_code'} =~ /^\d{3}$/ )
 289              ? $hash->{$field. '_area_code'}. '-'
 290              : '903-' # wtf?
 291   ;
 292   ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
 293     ? $ac. $hash->{$field}
 294     : '';
 295 }
 296
 297 sub or_b {
 298   my ( $field, $hash ) = ( shift, shift );
 299   $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
 300 }
 301
 302 sub or_p {
 303   my ( $field, $hash ) = ( shift, shift );
 304   $hash->{'billing_use'} eq 'Billing Address' && $hash->{$field} =~ /^\d{3}-\d{4}$/
 305     ? ( $hash->{$field. '_area_code'} =~ /^\d{3}$/
 306         ? $hash->{$field. '_area_code'}. '-'
 307         : '903-'  # wtf?
 308       ). $hash->{$field}
 309     : '';
 310 }
 311
 312 my %payby_map = ( ''              => 'BILL',
 313                   'None'          => 'BILL',
 314                   'Credit Card'   => 'CARD',
 315                   'Bank Debit'    => 'CHEK',
 316                   'Virtual Check' => 'CHEK',
 317 );
 318 sub payby {
 319   $payby_map{ shift->{billing_type} };
 320 }
 321
 322 sub payinfo {
 323   my $hash = shift;
 324   my $payby = payby($hash);
 325   my $info;
 326   my $cc =
 327     $hash->{'credit_card_number_1'}.
 328     $hash->{'credit_card_number_2'}.
 329     $hash->{'credit_card_number_3'}.
 330     $hash->{'credit_card_number_4'};
 331   my $bank =
 332     $hash->{'bank_account_number'}.
 333     '@'.
 334     $hash->{'bank_transit_number'};
 335   if ($payby eq 'CARD') {
 336     $info = $cc;
 337   }elsif ($payby eq 'CHEK') {
 338     $info = $bank;
 339   }elsif ($payby eq 'BILL') {
 340     $info = $hash->{'blanket_purchase_order_number'};
 341     $bank =~ s/[^\d\@]//g;
 342     $cc =~ s/\D//g;
 343     if ( $bank =~ /^\d+\@\d{9}/) {
 344       $info = $bank;
 345       $payby = 'DCHK';
 346     }
 347     if ( $cc =~ /^\d{13,16}/ ) {
 348       $info = $cc;
 349       $payby = 'DCRD';
 350     }
 351   }else{
 352     die "unexpected payby";
 353   }
 354   ($info, $payby);
 355 }
 356
 357 sub ut_name_fixup {
 358   my ($object, $field) = (shift, shift);
 359   my $value = $object->getfield($field);
 360   $value =~ s/[^\w \,\.\-\']/ /g;
 361   $object->setfield($field, $value);
 362 }
 363
 364 sub ut_text_fixup {
 365   my ($object, $field) = (shift, shift);
 366   my $value = $object->getfield($field);
 367   $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
 368   $object->setfield($field, $value);
 369 }
 370
 371 sub ut_state_fixup {
 372   my ($object, $field) = (shift, shift);
 373   my $value = $object->getfield($field);
 374   $value = 'TX' if $value eq 'TTX';
 375   $object->setfield($field, $value);
 376 }
 377
 378 sub ut_zip_fixup {
 379   my ($object, $field) = (shift, shift);
 380   my $value = $object->getfield($field);
 381   $value =~ s/[^-\d]//g;
 382   $object->setfield($field, $value);
 383 }
 384
 385 my @tables = (
 386 part_pkg => { 'stable'  => 'product',
 387 #part_pkg => { 'stable'  => 'billcycle',
 388               'mapping' =>
 389                 { 'pkg'      => sub { my $href = shift;
 390                                       $href->{'description'}
 391                                         ? $href->{'description'}
 392                                         : $href->{'product_id'};
 393                                     },
 394                   'comment'  => 'product_id',
 395                   'freq'     => sub { pkg_freq(shift) },
 396                   'recur_fee'=> sub { my $href = shift;
 397                                       my $price = ( pkg_freq($href)
 398                                         ? $href->{'unit_price'}
 399                                         : 0
 400                                       );
 401                                       $price =~ s/[^\d.]//g;
 402                                       $price = 0 unless $price;
 403                                       sprintf("%.2f", $price);
 404                                     },
 405                   'setuptax' => sub { my $href = shift;
 406                                       $href->{'taxable'} ? '' : 'Y';
 407                                     },
 408                   'recurtax' => sub { my $href = shift;
 409                                       $href->{'taxable'} ? '' : 'Y';
 410                                     },
 411                   'plan'     => sub { 'flat' },
 412                   'disabled' => sub { 'Y' },
 413                   'pkg_svc'  => sub { my $href = shift;
 414                                       my $result = {};
 415                                       if (pkg_freq($href)){
 416                                         $result->{$legacy_ppp_svcpart} = 1;
 417                                         $result->{$legacy_email_svcpart} =
 418                                             $href->{emails_allowed}
 419                                           if $href->{emails_allowed};
 420                                       }
 421                                     },
 422                   'primary_svc'=> sub { pkg_freq(shift)
 423                                           ? $legacy_ppp_svcpart
 424                                           : ''
 425                                         ;
 426                                       },
 427                 },
 428               'fixup'   => sub { my $part_pkg = shift;
 429                                  my $row = shift;
 430                                  unless ($part_pkg->pkg =~ /^\s*(\S[\S ]*?)\s*$/) {
 431                                    warn "no pkg: ". $part_pkg->pkg. " for ". $row->{product_id};
 432                                    return 1;
 433                                  }
 434
 435                                  unless ($part_pkg->comment =~ /^\s*(\S[\S ]*?)\s*$/) {
 436                                    warn "no comment: ". $part_pkg->comment. " for ". $row->{product_id};
 437                                    return 1;
 438                                  }
 439
 440                                  return 1 if exists($package_cache{$1});
 441                                  $package_cache{$1} = $part_pkg;
 442                                  1;
 443                                },
 444               'wrapup'  => sub { foreach (keys %package_cache) {
 445                                    my $part_pkg = $package_cache{$_};
 446                                    my $options =
 447                                      { map { my $v = $part_pkg->$_;
 448                                              $part_pkg->$_('');
 449                                              ($_ => $v);
 450                                            }
 451                                        qw (setup_fee recur_fee)
 452                                      };
 453                                    my $error =
 454                                      $part_pkg->insert(options=>$options);
 455                                    die "Error inserting package: $error"
 456                                      if $error;
 457                                    $count++ unless $error;
 458                                  }
 459                                },
 460             },
 461 part_referral => { 'stable'  => 'cust',
 462                    'mapping' =>
 463                      { 'agentnum' => sub { $agentnum },
 464                        'referral' => sub { my $r = shift->{'referred_from'};
 465                                            $referrals{$r} = 1;
 466                                          },
 467                      },
 468                    'fixup'   => sub { 1 },
 469                    'wrapup'  => sub { foreach (keys %referrals) {
 470                                         my $part_referral =
 471                                           new FS::part_referral( {
 472                                             'agentnum' => $agentnum,
 473                                             'referral' => $referrals{$_},
 474                                           } );
 475                                         my $error = $part_referral->insert;
 476                                         die "Error inserting referral: $error"
 477                                           if $error;
 478                                         $count++ unless $error;
 479                                         $referrals{$_} = $part_referral->refnum;
 480                                       }
 481                                     },
 482                  },
 483 #svc_acct  => { 'stable'  => 'cust',
 484 #               'mapping' =>
 485 #                 { 'username'     => 'login',
 486 #                   '_password'    => 'password',
 487 #                   'svcpart'      => sub{ $legacy_ppp_svcpart },
 488 #                   'domsvc'       => sub{ $legacy_domain_svcnum },
 489 #                   'status'       => 'status',
 490 #                 },
 491 #               'fixup'   => sub { my $svc_acct = shift;
 492 #                                  my $row = shift;
 493 #                                  my $id = $row->{'master_account'}
 494 #                                           ? 'slave:'. $row->{'customer_id'}
 495 #                                           : $row->{'login'};
 496 #                                  my $status = $svc_acct->status;
 497 #                                  if ( $status ne 'Current'
 498 #                                    && $status ne 'On Hold' )
 499 #                                  {
 500 #                                    $cancel{$id} =
 501 #                                      str2time($row->{termination_date});
 502 #                                    warn "not creating (cancelled) svc_acct for " .
 503 #                                      $svc_acct->username. "\n";
 504 #                                    return 1
 505 #                                  }
 506 #                                  $susp{$id} = str2time($row->{hold_date})
 507 #                                    if $status eq 'On Hold';
 508 #                                  $adjo{$id} = str2time($row->{hold_date})
 509 #                                    if ( $status eq 'Current' &&
 510 #                                         $row->{hold_date} );
 511 #                                  $bill{$id} =
 512 #                                    str2time($row->{expiration_date});
 513 #                                  '';
 514 #                                },
 515 #               'skey'    => sub { my $svc_acct = shift;
 516 #                                  my $row = shift;
 517 #                                  my $id = $row->{'master_account'}
 518 #                                    ? 'slave:'. $row->{'customer_id'}
 519 #                                    : $row->{'login'};
 520 #                                },
 521 #             },
 522 cust_main => { 'stable'  => 'cust',
 523                'mapping' =>
 524                  { 'agentnum'     => sub { $agentnum },
 525                    'agent_custid' => sub { my $id = shift->{'customer_number'};
 526                                            if (exists($custid{$id})) {
 527                                              $custid{$id}++;
 528                                              $id.  chr(64 + $custid{$id});
 529                                            }else{
 530                                              $custid{$id} = 0;
 531                                              $id;
 532                                            }
 533                                          },
 534                    'last'         => sub { b_or('last_name', shift) || ' ' },
 535                    'first'        => sub { b_or('first_name', shift)  || ' ' },
 536                    'stateid'      => 'drivers_license_number',
 537                    'signupdate'   => sub { str2time(shift->{'creation_date'}) },
 538                    'company'      => sub { b_or('company_name', shift) },
 539                    'address1'     => sub { b_or('address', shift) || ' ' },
 540                    'city'         => sub { b_or('city', shift) || 'Paris' },
 541                    'state'        => sub { uc(b_or('state', shift)) || 'TX' },
 542                    'zip'          => sub { b_or('zip_code', shift) || '75460' },
 543                    'country'      => sub { 'US' },
 544                    'daytime'      => sub { p_or('phone', shift) },
 545                    'night'        => sub { p_or('phone_alternate_1', shift) },
 546                    'fax'          => sub { p_or('fax', shift) },
 547                    'ship_last'    => sub { or_b('last_name', shift) },
 548                    'ship_first'   => sub { or_b('first_name', shift) },
 549                    'ship_company' => sub { or_b('company_name', shift) },
 550                    'ship_address1'=> sub { or_b('address', shift) },
 551                    'ship_city'    => sub { or_b('city', shift) },
 552                    'ship_state'   => sub { uc(or_b('state', shift)) },
 553                    'ship_zip'     => sub { or_b('zip_code', shift) },
 554                    'ship_daytime' => sub { or_p('phone', shift) },
 555                    'ship_fax'     => sub { or_p('fax', shift) },
 556                    'tax'          => sub { shift->{taxable} eq '' ? 'Y' : '' },
 557                    'refnum'       => sub { $referrals{shift->{'referred_from'}}
 558                                            || 1
 559                                          },
 560                  },
 561                'fixup'   => sub { my $cust_main = shift;
 562                                   my $row = shift;
 563
 564                                   my ($master_account, $customer_id, $login) =
 565                                     ('', '', '');
 566                                   $row->{'master_account'} =~ /^\s*(\S[\S ]*?)\s*$/
 567                                     && ($master_account = $1);
 568                                   $row->{'customer_id'} =~ /^\s*(\S[\S ]*?)\s*$/
 569                                     && ($customer_id = $1);
 570                                   $row->{'login'} =~ /^\s*(\S[\S ]*?)\s*$/
 571                                     && ($login = $1);
 572
 573                                   my ($first, $last, $company) =
 574                                     ('', '', '');
 575                                   $cust_main->first =~ /^\s*(\S[\S ]*?)\s*$/
 576                                     && ($first = $1);
 577                                   $cust_main->last =~ /^\s*(\S[\S ]*?)\s*$/
 578                                     && ($last = $1);
 579                                   $cust_main->company =~ /^\s*(\S[\S ]*?)\s*$/
 580                                     && ($company = $1);
 581
 582                                   unless ($first || $last || $company) {
 583                                     warn "bogus entry: ". $row->{'login'};
 584                                     return 1;
 585                                   }
 586
 587                                   my $id = $master_account
 588                                            ? 'slave:'. $customer_id
 589                                            : $login;
 590                                   #my $id = $login;
 591                                   my $status = $row->{status};
 592
 593                                   my $cancelled = 0;
 594                                   if ( $status ne 'Current'
 595                                     && $status ne 'current'
 596                                     && $status ne 'On Hold' )
 597                                   {
 598                                     $cancelled = 1;
 599                                     $cancel{$login} =
 600                                       str2time($row->{termination_date});
 601                                   }
 602                                   $susp{$id} = str2time($row->{hold_date})
 603                                     if ($status eq 'On Hold' && !$cancelled);
 604                                   $adjo{$id} = str2time($row->{hold_date})
 605                                     if ( $status eq 'Current' && !$cancelled &&
 606                                          $row->{hold_date} );
 607                                   $bill{$id} =
 608                                       str2time($row->{expiration_date})
 609                                     if (!$cancelled);
 610
 611                                   my $svcnum =
 612                                     $object_map{legacy_ppp}{$row->{'login'} };
 613                                   unless( $cancelled || $svcnum || $status eq 'Pn Hold' ) {
 614                                     warn "can't find svc_acct for legacy ppp ".
 615                                         $row->{'login'}, "\n";
 616                                   }
 617
 618                                   $object_map{svc_acct}{$id} = $svcnum
 619                                     unless $cancelled;
 620
 621                                   $master_map{$login} = $master_account
 622                                     if $master_account;
 623                                   return 1 if $master_account;
 624                                   $cust_main->ship_country('US')
 625                                     if $cust_main->has_ship_address;
 626                                   ut_name_fixup($cust_main, 'first');
 627                                   ut_name_fixup($cust_main, 'company');
 628                                   ut_name_fixup($cust_main, 'last');
 629
 630                                   my ($info, $payby) = payinfo($row);
 631                                   $cust_main->payby($payby);
 632                                   $cust_main->payinfo($info);
 633
 634                                   $cust_main->paycvv(
 635                                       $row->{'credit_card_cvv_number'}
 636                                   )
 637                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 638
 639                                   $cust_main->paydate('20'.
 640                                       $row->{'credit_card_exp_date_2'}.  '-'.
 641                                       substr(
 642                                         $row->{'credit_card_exp_date_1'},
 643                                         0,
 644                                         2,
 645                                       ).
 646                                       '-01'
 647                                   )
 648                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 649
 650                                   my $payname = '';
 651                                   $payname = $row->{'credit_card_name'}
 652                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 653                                   $payname = $row->{'bank_name'}
 654                                     if ($payby eq 'CHEK' or $payby eq 'DCHK');
 655                                   $cust_main->payname($payname);
 656
 657                                   $cust_main->paytype(
 658                                       $row->{'bank_account_to_debit'}
 659                                         ? 'Personal '.
 660                                           $row->{bank_account_to_debit}
 661                                         : ''
 662                                   )
 663                                     if ($payby eq 'CHEK' or $payby eq 'DCHK');
 664
 665                                   $cust_main->payby('BILL')
 666                                     if ($cust_main->payby eq 'CHEK' &&
 667                                         $cust_main->payinfo !~ /^\d+\@\d{9}$/);
 668                                   $cust_main->payby('BILL')
 669                                     if ($cust_main->payby eq 'CARD' &&
 670                                         $cust_main->payinfo =~ /^\s*$/);
 671                                   $cust_main->paydate('2037-12-01')
 672                                     if ($cust_main->payby eq 'BILL');
 673                                   ut_text_fixup($cust_main, 'address1');
 674                                   ut_state_fixup($cust_main, 'state');
 675                                   ut_zip_fixup($cust_main, 'zip');
 676
 677
 678                                   '';
 679                                 },
 680                'skey'    => sub { my $object = shift;
 681                                   my $href = shift;
 682                                   my $balance = sprintf("%.2f",
 683                                                         $href->{balance_due});
 684                                   if ($balance < 0) {
 685                                     my $cust_credit = new FS::cust_credit({
 686                                       'custnum'   => $object->custnum,
 687                                       'amount'    => sprintf("%.2f", -$balance),
 688                                       'reasonnum' => $previous_credit_reasonnum,
 689                                     });
 690                                     my $error = $cust_credit->insert;
 691                                     warn "Error inserting credit for ",
 692                                          $href->{'login'}, " : $error\n"
 693                                       if $error;
 694
 695                                   }elsif($balance > 0) {
 696                                     my $error = $object->charge(
 697                                                   $balance, "Prior balance",
 698                                                 );
 699                                     warn "Error inserting balance charge for ",
 700                                          $href->{'login'}, " : $error\n"
 701                                       if $error;
 702
 703                                   }
 704                                   $href->{'login'};
 705                                 },
 706              },
 707 #cust_main => { 'stable'  => 'cust',
 708 #               'mapping' =>
 709 #                 { 'referred_by' => sub { my $href = shift;
 710 #                                          my $u = shift->{'login'};
 711 #                                          my $cn = $href->{'customer_number'};
 712 #
 713 #                                          my $c = qsearch( 'cust_main',
 714 #                                                           { 'custnum' => $cn }
 715 #                                          ) or die "can't fine customer $cn";
 716 #
 717 #                                          my $s = qsearch( 'svc_acct',
 718 #                                                           { 'username' => $u }
 719 #                                                         ) or return '';
 720 #
 721 #                                          my $n = $s->cust_svc
 722 #                                                    ->cust_pkg
 723 #                                                    ->cust_main
 724 #                                                    ->custnum;
 725 #
 726 #                                          $c->referral_custnum($n);
 727 #                                          my $error = $c->replace;
 728 #                                          die "error setting referral: $error"
 729 #                                            if $error;
 730 #                                          '';
 731 #                                        },
 732 #                 };
 733 #               'fixup'   => sub { 1 },
 734 #             },
 735 cust_pkg  => { 'stable'  => 'billcycle',
 736                'mapping' =>
 737                  { 'custnum'     => sub { my $l = shift->{cbilling_cycle_login};
 738                                           $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
 739                                           my $r = $object_map{'cust_main'}{$l};
 740                                           unless ($r) {
 741                                             my $m = $master_map{$l};
 742                                             $r = $object_map{'cust_main'}{$m}
 743                                               if $m;
 744                                           }
 745                                           $r;
 746                                         },
 747                    'pkgpart'     => sub { my $href = shift;
 748                                           my $p = $href->{product_id};
 749                                           $p =~ /^\s*(\S[\S ]*?)\s*$/ && ($p = $1);
 750                                           my $pkg = $package_cache{$p}
 751                                             if $package_cache{$p};
 752
 753                                           my $month = '';
 754                                           $href->{month_credit} =~ /\s*(\S[\S ]*?)\s*$/ && ($month = $1);
 755                                           $month = int(eval "$month + 0");
 756
 757                                           my $price = 0;
 758                                           $href->{unit_price} =~ /\s*(\S[\S ]*?)\s*$/ && ($price = $1);
 759                                           $price = eval "$price + 0";
 760
 761                                           if ($pkg) {
 762                                             $pkg = ''
 763                                               unless $pkg->freq + 0 == $month;
 764
 765                                             if ($pkg && ($pkg->freq + 0)) {
 766                                               my $recur = 0;
 767                                               $pkg->recur_fee =~ /\s*(\S[\S ]*?)\s*$/ && ($recur = $1);
 768                                               $recur = eval "$recur + 0";
 769                                               $pkg = ''
 770                                                 unless $recur == $price;
 771                                             }
 772
 773                                             if ($pkg) {
 774                                               $pkg = ''
 775                                                 unless $pkg->setuptax
 776                                                   eq ($href->{taxable} ? '' : 'Y');
 777                                             }
 778
 779                                           }
 780
 781                                           unless ($pkg) {
 782                                             my $pkghref = { 'pkg' => ($href->{description} ? $href->{description} : $href->{product_id} ),
 783                                                             'comment' => $href->{product_id},
 784                                                             'freq' => $month,
 785                                                             'setuptax' => ($href->{'taxable'} ? '' : 'Y'),
 786                                                             'recurtax' => ($href->{'taxable'} ? '' : 'Y'),
 787                                                             'plan' => 'flat',
 788                                                             'disabled' => 'Y',
 789                                                           };
 790
 791                                             my @pkgs = qsearch('part_pkg', $pkghref);
 792                                             my $recur = sprintf("%.2f", ($month ? $price : 0));
 793                                             for (@pkgs) {
 794                                               my %options = $_->options;
 795                                               if ($options{recur_fee} eq $recur) {
 796                                                 $pkg = $_;
 797                                                 last;
 798                                               }
 799                                             }
 800
 801                                             $pkghref->{recur_fee} = $recur
 802                                               unless $pkg;
 803
 804                                             my $pkg_svc = {};
 805
 806                                             if ($month){
 807                                               $pkg_svc->{$legacy_ppp_svcpart} = 1;
 808                                               $pkg_svc->{$legacy_email_svcpart} =
 809                                                   $href->{emails_allowed}
 810                                                 if $href->{emails_allowed};
 811                                             }
 812                                             $pkghref->{pkg_svc} = $pkg_svc;
 813                                             $pkghref->{primary_svc}
 814                                               = ( $month
 815                                                   ? $legacy_ppp_svcpart
 816                                                   : '');
 817                                             unless ($pkg) {
 818                                               $pkg = new FS::part_pkg $pkghref;
 819                                               my $options =
 820                                                 { map { my $v = $pkg->$_;
 821                                                         $pkg->$_('');
 822                                                         ($_ => $v);
 823                                                       }
 824                                                   qw (setup_fee recur_fee)
 825                                                 };
 826                                               my $error =
 827                                                 $pkg->insert(options=>$options);
 828                                               if ($error) {
 829                                                 warn "Error inserting pkg ".
 830                                                   join(", ", map{"$_ => ". $pkg->get($_)} fields $pkg).
 831                                                   ": $error\n";
 832                                                 $pkg = '';
 833                                               }
 834                                             }
 835                                           }
 836                                           $pkg ? $pkg->pkgpart : '';
 837                                         },
 838                    'setup'       => sub { str2time(shift->{creation_date}) },
 839                    'bill'        => sub { $bill{account_id(shift)}
 840                                           #$bill{$href->{cbilling_cycle_login}};
 841                                         },
 842                    'susp'        => sub { $susp{account_id(shift)}
 843                                           #$susp{$href->{cbilling_cycle_login}};
 844                                         },
 845                    'adjo'        => sub { $adjo{account_id(shift)}
 846                                           #$adjo{$href->{cbilling_cycle_login}};
 847                                         },
 848                    'cancel'      => sub { $cancel{account_id(shift)}
 849                                           #$cancel{$href->{cbilling_cycle_login}};
 850                                         },
 851                  },
 852                'fixup'  => sub { my ($object, $row) = (shift,shift);
 853                                  unless ($object->custnum) {
 854                                    warn "can't find customer for ".
 855                                      $row->{cbilling_cycle_login}. "\n";
 856                                    return 1;
 857                                  }
 858                                  unless ($object->pkgpart) {
 859                                    warn "can't find package for ".
 860                                      $row->{product_id}. "\n";
 861                                    return 1;
 862                                  }
 863                                  '';
 864                                },
 865                'skey'   => sub { my $object = shift;
 866                                  my $href = shift;
 867                                  my $id = $href->{'billing_cycle_item_id'};
 868                                  $id =~ /^\s*(\S[\S ]*?)\s*$/ && ($id = $1);
 869                                  $cust_pkg_map{$id} = $object->pkgnum;
 870                                  account_id($href);
 871                                },
 872                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 873                                      my $cust_svc =
 874                                        qsearchs( 'cust_svc', { 'svcnum' =>
 875                                                  $object_map{'svc_acct'}{$id} }
 876                                        );
 877                                      unless ($cust_svc) {
 878                                        warn "can't find legacy ppp $id\n";
 879                                        next;
 880                                      }
 881                                      $cust_svc->
 882                                        pkgnum($object_map{'cust_pkg'}{$id});
 883                                      my $error = $cust_svc->replace;
 884                                      warn "error linking legacy ppp $id: $error\n"
 885                                        if $error;
 886                                    }
 887                                  },
 888              },
 889 svc_acct  => { 'stable'  => 'email',
 890                'mapping' =>
 891                  { 'username'    => 'email_name',
 892                    '_password'   => 'password',
 893                    'svcpart'      => sub{ $legacy_email_svcpart },
 894                    'domsvc'       => sub{ $legacy_domain_svcnum },
 895                  },
 896 #               'fixup'   => sub { my ($object, $row) = (shift,shift);
 897 #                                  my ($sd,$sm,$sy) = split '/',
 898 #                                                     $row->{shut_off_date}
 899 #                                    if $row->{shut_off_date};
 900 #                                  if ($sd && $sm && $sy) {
 901 #                                    my ($cd, $cm, $cy) = (localtime)[3,4,5];
 902 #                                    $cy += 1900; $cm++;
 903 #                                    return 1 if $sy < $cy;
 904 #                                    return 1 if ($sy == $cy && $sm < $cm);
 905 #                                    return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 906 #                                  }
 907 #                                  return 1 if $object_map{'cust_main'}{$object->username};
 908 #                                  '';
 909 #                                },
 910                'fixup'   => sub { my ($object, $row) = (shift,shift);
 911                                   my ($sd,$sm,$sy) = split '/',
 912                                                      $row->{shut_off_date}
 913                                     if $row->{shut_off_date};
 914                                   if ($sd && $sm && $sy) {
 915                                     my ($cd, $cm, $cy) = (localtime)[3,4,5];
 916                                     $cy += 1900; $cm++;
 917                                     return 1 if $sy < $cy;
 918                                     return 1 if ($sy == $cy && $sm < $cm);
 919                                     return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 920                                   }
 921                                   #return 1 if $object_map{'cust_main'}{$object->username};
 922
 923                                   my $email_name;
 924                                   $row->{email_name} =~ /^\s*(\S[\S ]*?)\s*$/
 925                                     && ($email_name = $1);
 926
 927                                   my $svcnum =
 928                                       $object_map{legacy_email}{$email_name}
 929                                     if $email_name;
 930                                   unless( $svcnum ) {
 931                                     warn "can't find svc_acct for legacy email ".
 932                                       $row->{'email_name'}, "\n";
 933                                     return 1;
 934                                   }
 935
 936                                   $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svcnum;
 937                                   return 1;
 938                                 },
 939 #               'skey'    => sub { my $object = shift;
 940 #                                  my $href = shift;
 941 #                                  'email:'. $href->{'email_customer_id'};
 942 #                                },
 943                'wrapup'   => sub { for my $id (keys %{$object_map{'svc_acct'}}){
 944                                      next unless $id =~ /^email:(\d+)/;
 945                                      my $custid = $1;
 946                                      my $cust_svc =
 947                                        qsearchs( 'cust_svc', { 'svcnum' =>
 948                                                  $object_map{'svc_acct'}{$id} }
 949                                        );
 950                                      unless ($cust_svc) {
 951                                        warn "can't find legacy email $id\n";
 952                                        next;
 953                                      }
 954
 955                                      if ($cust_svc->pkgnum) {
 956                                        warn "service already linked for $id\n";
 957                                        next;
 958                                      }
 959
 960                                      $cust_svc->
 961                                        pkgnum($cust_pkg_map{$custid});
 962                                      if ($cust_svc->pkgnum){
 963                                        my $error = $cust_svc->replace;
 964                                        warn "error linking legacy email $id: $error\n"
 965                                          if $error;
 966                                      }else{
 967                                        warn "can't find package for $id\n"
 968                                      }
 969                                    }
 970                                  },
 971              },
 972 );
 973
 974 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
 975
 976 while ( @tables ) {
 977   my ($table, $href) = (shift @tables, shift @tables);
 978   my $stable = $href->{'stable'} or die "No source table"; # good enough for now
 979   my (%mapping) = %{$href->{'mapping'}};
 980   my ($fixup)   = $href->{'fixup'};
 981   my ($wrapup)  = $href->{'wrapup'};
 982   my ($id)      = $href->{'id'};
 983   my ($skey)    = $href->{'skey'};
 984
 985   #$d_dbh->do("delete from $table");
 986
 987   my $s_sth = $s_dbh->prepare("select count(*) from $stable");
 988   $s_sth->execute or die $s_sth->errstr;
 989   my $rowcount = $s_sth->fetchrow_arrayref->[0];
 990
 991   $s_sth = $s_dbh->prepare("select * from $stable");
 992   $s_sth->execute or die $s_sth->errstr;
 993
 994   my $row;
 995   $count = 0;
 996   while ( $row = $s_sth->fetchrow_hashref ) {
 997     my $class = "FS::$table";
 998
 999     warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
1000       unless( !$count || $count % 100 );
1001
1002     my $object = new $class ( {
1003         map { $_  => ( ref($mapping{$_}) eq 'CODE'
1004                        ? &{$mapping{$_}}($row)
1005                        : $row->{$mapping{$_}}
1006                      )
1007             }
1008           keys(%mapping)
1009     } );
1010     my $skip = &{$fixup}($object, $row)
1011       if $fixup;
1012
1013     unless ($skip) {
1014       my $error = $object->insert;
1015       if ($error) {
1016         warn "Error inserting $table ".
1017           join(", ", map{"$_ => ". $object->get($_)} fields $object).
1018           ": $error\n";
1019         next;
1020       }
1021       if ($skey) {
1022         my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
1023                                          : $row->{$skey};
1024         $object_map{$table}{$key} = $object->get($object->primary_key)
1025       }
1026       $count++;
1027     }
1028   }
1029
1030   &{$wrapup}()
1031     if $wrapup;
1032
1033   print "$count/$rowcount of $table SUCCESSFULLY processed\n";
1034
1035 }
1036
1037 # link to any uncancelled package on customer
1038 foreach my $username ( keys %{$object_map{'legacy_email'}} ) {
1039   my $cust_svc = qsearchs( 'cust_svc',
1040                            { 'svcnum' => $object_map{legacy_email}{$username} }
1041                          );
1042  next unless $cust_svc;
1043  next if $cust_svc->pkgnum;
1044
1045  my $custnum = $object_map{cust_main}{$username};
1046  unless ($custnum) {
1047    my $master = $master_map{$username};
1048    $custnum = $object_map{'cust_main'}{$master}
1049      if $master;
1050    next unless $custnum;
1051  }
1052
1053  #my $extra_sql = ' AND 0 != (select freq from part_pkg where '.
1054  #                'cust_pkg.pkgpart = part_pkg.pkgpart )';
1055  my $extra_sql = " AND 'Prior balance' != (select pkg from part_pkg where ".
1056                  "cust_pkg.pkgpart = part_pkg.pkgpart )";
1057
1058  my @cust_pkg = qsearch( {
1059                            'table'   => 'cust_pkg',
1060                            'hashref' => { 'custnum' => $custnum,
1061                                           'cancel'  => '',
1062                                         },
1063                            'extra_sql' => $extra_sql,
1064                        } );
1065  next unless scalar(@cust_pkg);
1066
1067  $cust_svc->pkgnum($cust_pkg[0]->pkgnum);
1068  $cust_svc->replace;
1069 }
1070
1071
1072 if ($dry_run) {
1073   $d_dbh->rollback;
1074 }else{
1075   $d_dbh->commit or die $d_dbh->errstr;
1076 }
1077