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