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 'On Hold' )
 571                                   {
 572                                     $cancelled = 1;
 573                                     $cancel{$login} =
 574                                       str2time($row->{termination_date});
 575                                   }
 576                                   $susp{$id} = str2time($row->{hold_date})
 577                                     if ($status eq 'On Hold' && !$cancelled);
 578                                   $adjo{$id} = str2time($row->{hold_date})
 579                                     if ( $status eq 'Current' && !$cancelled &&
 580                                          $row->{hold_date} );
 581                                   $bill{$id} =
 582                                       str2time($row->{expiration_date})
 583                                     if (!$cancelled);
 584
 585                                   my $svcnum =
 586                                     $object_map{legacy_ppp}{$row->{'login'} };
 587                                   unless( $cancelled || $svcnum || $status eq 'Pn Hold' ) {
 588                                     warn "can't find svc_acct for legacy ppp ".
 589                                         $row->{'login'}, "\n";
 590                                   }
 591
 592                                   $object_map{svc_acct}{$id} = $svcnum
 593                                     unless $cancelled;
 594
 595                                   $master_map{$login} = $master_account
 596                                     if $master_account;
 597                                   return 1 if $master_account;
 598                                   $cust_main->ship_country('US')
 599                                     if $cust_main->has_ship_address;
 600                                   ut_name_fixup($cust_main, 'first');
 601                                   ut_name_fixup($cust_main, 'company');
 602                                   ut_name_fixup($cust_main, 'last');
 603
 604                                   my ($info, $payby) = payinfo($row);
 605                                   $cust_main->payby($payby);
 606                                   $cust_main->payinfo($info);
 607
 608                                   $cust_main->paycvv(
 609                                       $row->{'credit_card_cvv_number'}
 610                                   )
 611                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 612
 613                                   $cust_main->paydate('20'.
 614                                       $row->{'credit_card_exp_date_2'}.  '-'.
 615                                       substr(
 616                                         $row->{'credit_card_exp_date_1'},
 617                                         0,
 618                                         2,
 619                                       ).
 620                                       '-01'
 621                                   )
 622                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 623
 624                                   my $payname = '';
 625                                   $payname = $row->{'credit_card_name'}
 626                                     if ($payby eq 'CARD' or $payby eq 'DCRD');
 627                                   $payname = $row->{'bank_name'}
 628                                     if ($payby eq 'CHEK' or $payby eq 'DCHK');
 629                                   $cust_main->payname($payname);
 630
 631                                   $cust_main->paytype(
 632                                       $row->{'bank_account_to_debit'}
 633                                         ? 'Personal '.
 634                                           $row->{bank_account_to_debit}
 635                                         : ''
 636                                   )
 637                                     if ($payby eq 'CHEK' or $payby eq 'DCHK');
 638
 639                                   $cust_main->payby('BILL')
 640                                     if ($cust_main->payby eq 'CHEK' &&
 641                                         $cust_main->payinfo !~ /^\d+\@\d{9}$/);
 642                                   $cust_main->payby('BILL')
 643                                     if ($cust_main->payby eq 'CARD' &&
 644                                         $cust_main->payinfo =~ /^\s*$/);
 645                                   $cust_main->paydate('2037-12-01')
 646                                     if ($cust_main->payby eq 'BILL');
 647                                   ut_text_fixup($cust_main, 'address1');
 648                                   ut_state_fixup($cust_main, 'state');
 649                                   ut_zip_fixup($cust_main, 'zip');
 650
 651
 652                                   '';
 653                                 },
 654                'skey'    => sub { my $object = shift;
 655                                   my $href = shift;
 656                                   my $balance = sprintf("%.2f",
 657                                                         $href->{balance_due});
 658                                   if ($balance < 0) {
 659                                     my $cust_credit = new FS::cust_credit({
 660                                       'custnum'   => $object->custnum,
 661                                       'amount'    => sprintf("%.2f", -$balance),
 662                                       'reasonnum' => $previous_credit_reasonnum,
 663                                     });
 664                                     my $error = $cust_credit->insert;
 665                                     warn "Error inserting credit for ",
 666                                          $href->{'login'}, " : $error\n"
 667                                       if $error;
 668
 669                                   }elsif($balance > 0) {
 670                                     my $error = $object->charge(
 671                                                   $balance, "Prior balance",
 672                                                 );
 673                                     warn "Error inserting balance charge for ",
 674                                          $href->{'login'}, " : $error\n"
 675                                       if $error;
 676
 677                                   }
 678                                   $href->{'login'};
 679                                 },
 680              },
 681 #cust_main => { 'stable'  => 'cust',
 682 #               'mapping' =>
 683 #                 { 'referred_by' => sub { my $href = shift;
 684 #                                          my $u = shift->{'login'};
 685 #                                          my $cn = $href->{'customer_number'};
 686 #
 687 #                                          my $c = qsearch( 'cust_main',
 688 #                                                           { 'custnum' => $cn }
 689 #                                          ) or die "can't fine customer $cn";
 690 #
 691 #                                          my $s = qsearch( 'svc_acct',
 692 #                                                           { 'username' => $u }
 693 #                                                         ) or return '';
 694 #
 695 #                                          my $n = $s->cust_svc
 696 #                                                    ->cust_pkg
 697 #                                                    ->cust_main
 698 #                                                    ->custnum;
 699 #
 700 #                                          $c->referral_custnum($n);
 701 #                                          my $error = $c->replace;
 702 #                                          die "error setting referral: $error"
 703 #                                            if $error;
 704 #                                          '';
 705 #                                        },
 706 #                 };
 707 #               'fixup'   => sub { 1 },
 708 #             },
 709 cust_pkg  => { 'stable'  => 'billcycle',
 710                'mapping' =>
 711                  { 'custnum'     => sub { my $l = shift->{cbilling_cycle_login};
 712                                           $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
 713                                           my $r = $object_map{'cust_main'}{$l};
 714                                           unless ($r) {
 715                                             my $m = $master_map{$l};
 716                                             $r = $object_map{'cust_main'}{$m}
 717                                               if $m;
 718                                           }
 719                                           $r;
 720                                         },
 721                    'pkgpart'     => sub { my $href = shift;
 722                                           my $p = $href->{product_id};
 723                                           $p =~ /^\s*(\S[\S ]*?)\s*$/ && ($p = $1);
 724                                           my $pkg = $package_cache{$p}
 725                                             if $package_cache{$p};
 726
 727                                           my $month = '';
 728                                           $href->{month_credit} =~ /\s*(\S[\S ]*?)\s*$/ && ($month = $1);
 729                                           $month = int(eval "$month + 0");
 730
 731                                           my $price = 0;
 732                                           $href->{unit_price} =~ /\s*(\S[\S ]*?)\s*$/ && ($price = $1);
 733                                           $price = eval "$price + 0";
 734
 735                                           if ($pkg) {
 736                                             $pkg = ''
 737                                               unless $pkg->freq + 0 == $month;
 738
 739                                             if ($pkg && ($pkg->freq + 0)) {
 740                                               my $recur = 0;
 741                                               $pkg->recur =~ /\s*(\S[\S ]*?)\s*$/ && ($recur = $1);
 742                                               $recur = eval "$recur + 0";
 743                                               $pkg = ''
 744                                                 unless $recur == $price;
 745                                             }
 746
 747                                             if ($pkg) {
 748                                               $pkg = ''
 749                                                 unless $pkg->setuptax
 750                                                   eq ($href->{taxable} ? '' : 'Y');
 751                                             }
 752
 753                                           }
 754
 755                                           unless ($pkg) {
 756                                             my $pkghref = { 'pkg' => ($href->{description} ? $href->{description} : $href->{product_id} ),
 757                                                             'comment' => $href->{product_id},
 758                                                             'freq' => $month,
 759                                                             'setuptax' => ($href->{'taxable'} ? '' : 'Y'),
 760                                                             'recurtax' => ($href->{'taxable'} ? '' : 'Y'),
 761                                                             'plan' => 'flat',
 762                                                             'disabled' => 'Y',
 763                                                           };
 764
 765                                             my @pkgs = qsearch('part_pkg', $pkghref);
 766                                             my $recur = sprintf("%.2f", ($month ? $price : 0));
 767                                             for (@pkgs) {
 768                                               my %options = $_->options;
 769                                               if ($options{recur} eq $recur) {
 770                                                 $pkg = $_;
 771                                                 last;
 772                                               }
 773                                             }
 774
 775                                             $pkghref->{recur} = $recur
 776                                               unless $pkg;
 777
 778                                             my $pkg_svc = {};
 779
 780                                             if ($month){
 781                                               $pkg_svc->{$legacy_ppp_svcpart} = 1;
 782                                               $pkg_svc->{$legacy_email_svcpart} =
 783                                                   $href->{emails_allowed}
 784                                                 if $href->{emails_allowed};
 785                                             }
 786                                             $pkghref->{pkg_svc} = $pkg_svc;
 787                                             $pkghref->{primary_svc}
 788                                               = ( $month
 789                                                   ? $legacy_ppp_svcpart
 790                                                   : '');
 791                                             unless ($pkg) {
 792                                               $pkg = new FS::part_pkg $pkghref;
 793                                               my $options =
 794                                                 { map { my $v = $pkg->$_;
 795                                                         $pkg->$_('');
 796                                                         ($_ => $v);
 797                                                       }
 798                                                   qw (setup recur)
 799                                                 };
 800                                               my $error =
 801                                                 $pkg->insert(options=>$options);
 802                                               if ($error) {
 803                                                 warn "Error inserting pkg ".
 804                                                   join(", ", map{"$_ => ". $pkg->get($_)} fields $pkg).
 805                                                   ": $error\n";
 806                                                 $pkg = '';
 807                                               }
 808                                             }
 809                                           }
 810                                           $pkg ? $pkg->pkgpart : '';
 811                                         },
 812                    'setup'       => sub { str2time(shift->{creation_date}) },
 813                    'bill'        => sub { my $href = shift;
 814                                           my $id = $href->{'slave_account_id'}
 815                                             ? 'slave:'. $href->{'slave_account_id'}
 816                                             : $href->{'cbilling_cycle_login'};
 817                                           $bill{$id};
 818                                           #$bill{$href->{cbilling_cycle_login}};
 819                                         },
 820                    'susp'        => sub { my $href = shift;
 821                                           my $id = $href->{'slave_account_id'}
 822                                             ? 'slave:'. $href->{'slave_account_id'}
 823                                             : $href->{'cbilling_cycle_login'};
 824                                           $susp{$id};
 825                                           #$susp{$href->{cbilling_cycle_login}};
 826                                         },
 827                    'adjo'        => sub { my $href = shift;
 828                                           my $id = $href->{'slave_account_id'}
 829                                             ? 'slave:'. $href->{'slave_account_id'}
 830                                             : $href->{'cbilling_cycle_login'};
 831                                           $adjo{$id};
 832                                           #$adjo{$href->{cbilling_cycle_login}};
 833                                         },
 834                    'cancel'      => sub { my $href = shift;
 835                                           my $id = $href->{'slave_account_id'}
 836                                             ? 'slave:'. $href->{'slave_account_id'}
 837                                             : $href->{'cbilling_cycle_login'};
 838                                           $cancel{$id};
 839                                           #$cancel{$href->{cbilling_cycle_login}};
 840                                         },
 841                  },
 842                'fixup'  => sub { my ($object, $row) = (shift,shift);
 843                                  unless ($object->custnum) {
 844                                    warn "can't find customer for ".
 845                                      $row->{cbilling_cycle_login}. "\n";
 846                                    return 1;
 847                                  }
 848                                  unless ($object->pkgpart) {
 849                                    warn "can't find package for ".
 850                                      $row->{product_id}. "\n";
 851                                    return 1;
 852                                  }
 853                                  '';
 854                                },
 855                'skey'   => sub { my $object = shift;
 856                                  my $href = shift;
 857                                  my $id = $href->{'billing_cycle_item_id'};
 858                                  $id =~ /^\s*(\S[\S ]*?)\s*$/ && ($id = $1);
 859                                  $cust_pkg_map{$id} = $object->pkgnum;
 860                                  if ($href->{'slave_account_id'} =~ /^\s*(\S[\S ]*?)\s*$/) {
 861                                    "slave:$1";
 862                                  }else{
 863                                    my $l = $href->{cbilling_cycle_login};
 864                                    $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
 865                                    $l;
 866                                  }
 867                                },
 868                'wrapup'   => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
 869                                      my $cust_svc =
 870                                        qsearchs( 'cust_svc', { 'svcnum' =>
 871                                                  $object_map{'svc_acct'}{$id} }
 872                                        );
 873                                      unless ($cust_svc) {
 874                                        warn "can't find legacy ppp $id\n";
 875                                        next;
 876                                      }
 877                                      $cust_svc->
 878                                        pkgnum($object_map{'cust_pkg'}{$id});
 879                                      my $error = $cust_svc->replace;
 880                                      warn "error linking legacy ppp $id: $error\n"
 881                                        if $error;
 882                                    }
 883                                  },
 884              },
 885 svc_acct  => { 'stable'  => 'email',
 886                'mapping' =>
 887                  { 'username'    => 'email_name',
 888                    '_password'   => 'password',
 889                    'svcpart'      => sub{ $legacy_email_svcpart },
 890                    'domsvc'       => sub{ $legacy_domain_svcnum },
 891                  },
 892 #               'fixup'   => sub { my ($object, $row) = (shift,shift);
 893 #                                  my ($sd,$sm,$sy) = split '/',
 894 #                                                     $row->{shut_off_date}
 895 #                                    if $row->{shut_off_date};
 896 #                                  if ($sd && $sm && $sy) {
 897 #                                    my ($cd, $cm, $cy) = (localtime)[3,4,5];
 898 #                                    $cy += 1900; $cm++;
 899 #                                    return 1 if $sy < $cy;
 900 #                                    return 1 if ($sy == $cy && $sm < $cm);
 901 #                                    return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 902 #                                  }
 903 #                                  return 1 if $object_map{'cust_main'}{$object->username};
 904 #                                  '';
 905 #                                },
 906                'fixup'   => sub { my ($object, $row) = (shift,shift);
 907                                   my ($sd,$sm,$sy) = split '/',
 908                                                      $row->{shut_off_date}
 909                                     if $row->{shut_off_date};
 910                                   if ($sd && $sm && $sy) {
 911                                     my ($cd, $cm, $cy) = (localtime)[3,4,5];
 912                                     $cy += 1900; $cm++;
 913                                     return 1 if $sy < $cy;
 914                                     return 1 if ($sy == $cy && $sm < $cm);
 915                                     return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
 916                                   }
 917                                   #return 1 if $object_map{'cust_main'}{$object->username};
 918
 919                                   my $email_name;
 920                                   $row->{email_name} =~ /^\s*(\S[\S ]*?)\s*$/
 921                                     && ($email_name = $1);
 922
 923                                   my $svcnum =
 924                                       $object_map{legacy_email}{$email_name}
 925                                     if $email_name;
 926                                   unless( $svcnum ) {
 927                                     warn "can't find svc_acct for legacy email ".
 928                                       $row->{'email_name'}, "\n";
 929                                     return 1;
 930                                   }
 931
 932                                   $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svcnum;
 933                                   return 1;
 934                                 },
 935 #               'skey'    => sub { my $object = shift;
 936 #                                  my $href = shift;
 937 #                                  'email:'. $href->{'email_customer_id'};
 938 #                                },
 939                'wrapup'   => sub { for my $id (keys %{$object_map{'svc_acct'}}){
 940                                      next unless $id =~ /^email:(\d+)/;
 941                                      my $custid = $1;
 942                                      my $cust_svc =
 943                                        qsearchs( 'cust_svc', { 'svcnum' =>
 944                                                  $object_map{'svc_acct'}{$id} }
 945                                        );
 946                                      unless ($cust_svc) {
 947                                        warn "can't find legacy email $id\n";
 948                                        next;
 949                                      }
 950
 951                                      if ($cust_svc->pkgnum) {
 952                                        warn "service already linked for $id\n";
 953                                        next;
 954                                      }
 955
 956                                      $cust_svc->
 957                                        pkgnum($cust_pkg_map{$custid});
 958                                      if ($cust_svc->pkgnum){
 959                                        my $error = $cust_svc->replace;
 960                                        warn "error linking legacy email $id: $error\n"
 961                                          if $error;
 962                                      }else{
 963                                        warn "can't find package for $id\n"
 964                                      }
 965                                    }
 966                                  },
 967              },
 968 );
 969
 970 #my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
 971
 972 while ( @tables ) {
 973   my ($table, $href) = (shift @tables, shift @tables);
 974   my $stable = $href->{'stable'} or die "No source table"; # good enough for now
 975   my (%mapping) = %{$href->{'mapping'}};
 976   my ($fixup)   = $href->{'fixup'};
 977   my ($wrapup)  = $href->{'wrapup'};
 978   my ($id)      = $href->{'id'};
 979   my ($skey)    = $href->{'skey'};
 980
 981   #$d_dbh->do("delete from $table");
 982
 983   my $s_sth = $s_dbh->prepare("select count(*) from $stable");
 984   $s_sth->execute or die $s_sth->errstr;
 985   my $rowcount = $s_sth->fetchrow_arrayref->[0];
 986
 987   $s_sth = $s_dbh->prepare("select * from $stable");
 988   $s_sth->execute or die $s_sth->errstr;
 989
 990   my $row;
 991   $count = 0;
 992   while ( $row = $s_sth->fetchrow_hashref ) {
 993     my $class = "FS::$table";
 994
 995     warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
 996       unless( !$count || $count % 100 );
 997
 998     my $object = new $class ( {
 999         map { $_  => ( ref($mapping{$_}) eq 'CODE'
1000                        ? &{$mapping{$_}}($row)
1001                        : $row->{$mapping{$_}}
1002                      )
1003             }
1004           keys(%mapping)
1005     } );
1006     my $skip = &{$fixup}($object, $row)
1007       if $fixup;
1008
1009     unless ($skip) {
1010       my $error = $object->insert;
1011       if ($error) {
1012         warn "Error inserting $table ".
1013           join(", ", map{"$_ => ". $object->get($_)} fields $object).
1014           ": $error\n";
1015         next;
1016       }
1017       if ($skey) {
1018         my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
1019                                          : $row->{$skey};
1020         $object_map{$table}{$key} = $object->get($object->primary_key)
1021       }
1022       $count++;
1023     }
1024   }
1025
1026   &{$wrapup}()
1027     if $wrapup;
1028
1029   print "$count/$rowcount of $table SUCCESSFULLY processed\n";
1030
1031 }
1032
1033 # link to any uncancelled package on customer
1034 foreach my $username ( keys %{$object_map{'legacy_email'}} ) {
1035   my $cust_svc = qsearchs( 'cust_svc',
1036                            { 'svcnum' => $object_map{legacy_email}{$username} }
1037                          );
1038  next unless $cust_svc;
1039  next if $cust_svc->pkgnum;
1040
1041  my $custnum = $object_map{cust_main}{$username};
1042  unless ($custnum) {
1043    my $master = $master_map{$username};
1044    $custnum = $object_map{'cust_main'}{$master}
1045      if $master;
1046    next unless $custnum;
1047  }
1048
1049  #my $extra_sql = ' AND 0 != (select freq from part_pkg where '.
1050  #                'cust_pkg.pkgpart = part_pkg.pkgpart )';
1051  my $extra_sql = " AND 'Prior balance' != (select pkg from part_pkg where ".
1052                  "cust_pkg.pkgpart = part_pkg.pkgpart )";
1053
1054  my @cust_pkg = qsearch( {
1055                            'table'   => 'cust_pkg',
1056                            'hashref' => { 'custnum' => $custnum,
1057                                           'cancel'  => '',
1058                                         },
1059                            'extra_sql' => $extra_sql,
1060                        } );
1061  next unless scalar(@cust_pkg);
1062
1063  $cust_svc->pkgnum($cust_pkg[0]->pkgnum);
1064  $cust_svc->replace;
1065 }
1066
1067
1068 if ($dry_run) {
1069   $d_dbh->rollback;
1070 }else{
1071   $d_dbh->commit or die $d_dbh->errstr;
1072 }
1073