#!/usr/bin/perl -Tw
use strict;
use DBI;
use HTML::TableParser;
use Date::Parse;
use Text::CSV_XS;
use FS::Record qw(qsearch qsearchs);
use FS::cust_credit;
use FS::cust_main;
use FS::cust_pkg;
use FS::cust_svc;
use FS::svc_acct;
use FS::part_referral;
use FS::part_pkg;
use FS::UID qw(adminsuidsetup);
my $DEBUG = 0;
my $dry_run = '0';
my $s_dbname = 'DBI:Pg:dbname=optigoldimport';
my $s_dbuser = 'freeside';
my $s_dbpass = '';
my $extension = '.htm';
#my $d_dbuser = 'freeside';
my $d_dbuser = 'enet';
#my $d_dbuser = 'ivan';
#my $d_dbuser = 'freesideimport';
my $radius_file = 'radius.csv';
my $email_file = 'email.csv';
#my $agentnum = 1;
my $agentnum = 13;
my $legacy_domain_svcnum = 1;
my $legacy_ppp_svcpart = 2;
my $legacy_email_svcpart = 3;
#my $legacy_broadband_svcpart = 4;
#my $legacy_broadband_svcpart = 14;
#my $previous_credit_reasonnum = 1;
my $previous_credit_reasonnum = 1220;
my $state = ''; #statemachine-ish
my $sourcefile;
my $s_dbh;
my $columncount;
my $rowcount;
my @args = (
{
id => 1,
hdr => \&header,
row => \&row,
start => \&start,
end => \&end,
},
);
$s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass,
{ 'AutoCommit' => 0,
'ChopBlanks' => 1,
'ShowErrorStatement' => 1
}
);
foreach ( qw ( billcycle cust email product ) ) {
$sourcefile = $_;
print "parsing $sourcefile\n";
die "bad file name" unless $sourcefile =~ /^\w+$/;
$columncount = 0;
$rowcount = 0;
my $c_sth = '';
if ( $c_sth = $s_dbh->prepare("SELECT COUNT(*) FROM $sourcefile") ) {
if ( $c_sth->execute ) {
if ( $c_sth->fetchrow_arrayref->[0] ) {
warn "already have data in $sourcefile table; skipping";
next;
}
}
}
my $tp = new HTML::TableParser( \@args, { Decode => 1, Trim => 1, Chomp => 1 });
$tp->parse_file($sourcefile.$extension) or die "failed";
$s_dbh->commit or die $s_dbh->errstr;
# $s_dbh->disconnect;
}
sub start {
warn "start\n" if $DEBUG;
my $table_id = shift;
die "unexpected state change" unless $state eq '';
die "unexpected table" unless $table_id eq '1';
$state = 'table';
}
sub end {
warn "end\n" if $DEBUG;
my ($tbl_id, $line, $udata) = @_;
die "unexpected state change in header" unless $state eq 'rows';
die "unexpected table" unless $tbl_id eq '1';
$state = '';
}
sub header {
warn "header\n" if $DEBUG;
my ($tbl_id, $line, $cols, $udata) = @_;
die "unexpected state change in header" unless $state eq 'table';
die "unexpected table" unless $tbl_id eq '1';
$state = 'rows';
die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols)
if scalar(grep { !/^[ \w\r]+$/ } @$cols);
my $sql = "CREATE TABLE $sourcefile ( ".
join(', ', map { s/[ \r]/_/g; "$_ varchar NULL" } @$cols). " )";
$s_dbh->do($sql) or die "create table failed: ". $s_dbh->errstr;
$columncount = scalar( @$cols );
}
sub row {
warn "row\n" if $DEBUG;
my ($tbl_id, $line, $cols, $udata) = @_;
die "unexpected state change in row" unless $state eq 'rows';
die "unexpected table" unless $tbl_id eq '1';
die "invalid number of columns: ". join(', ', @$cols)
unless (scalar(@$cols) == $columncount);
my $sql = "INSERT INTO $sourcefile VALUES(".
join(', ', map { s/\s*(\S[\S ]*?)\s*$/$1/; $s_dbh->quote($_) } @$cols). ")";
$s_dbh->do($sql) or die "insert failed: ". $s_dbh->errstr;
$rowcount++;
warn "row $rowcount\n" unless ($rowcount % 1000);
}
## now svc_acct from CSV files
$FS::cust_main::import=1;
$FS::cust_pkg::disable_agentcheck = 1;
$FS::cust_svc::ignore_quantity = 1;
my (%master_map) = ();
my (%referrals) = ();
my (%custid) = ();
my (%cancel) = ();
my (%susp) = ();
my (%adjo) = ();
my (%bill) = ();
my (%cust_pkg_map) = ();
my (%object_map) = ();
my (%package_cache) = ();
my $count = 0;
my $d_dbh = adminsuidsetup $d_dbuser;
local $FS::UID::AutoCommit = 0;
my @import = ( { 'file' => $radius_file,
'sep_char' => ';',
'fields' => [ qw( garbage1 username garbage2 garbage3 _password ) ],
'fixup' => sub {
my $hash = shift;
delete $hash->{$_}
foreach qw (garbage1 garbage2 garbage3);
$hash->{'svcpart'} = $legacy_ppp_svcpart;
$hash->{'domsvc'} = $legacy_domain_svcnum;
'';
},
'mapkey' => 'legacy_ppp',
'skey' => 'username',
},
{ 'file' => $email_file,
'sep_char' => ';',
'fields' => [ qw( username null finger _password status garbage ) ],
'fixup' => sub {
my $hash = shift;
#return 1
# if $object_map{'legacy_ppp'}{$hash->{'username'}};
delete $hash->{$_}
foreach qw (null status garbage);
$hash->{'svcpart'} = $legacy_email_svcpart;
$hash->{'domsvc'} = $legacy_domain_svcnum;
'';
},
'mapkey' => 'legacy_email',
'skey' => 'username',
},
);
while ( @import ) {
my $href = shift @import;
my $file = $href->{'file'} or die "No file specified";
my (@fields) = @{$href->{'fields'}};
my ($sep_char) = $href->{'sep_char'} || ';';
my ($fixup) = $href->{'fixup'};
my ($mapkey) = $href->{'mapkey'};
my ($skey) = $href->{'skey'};
my $line;
my $csv = new Text::CSV_XS({'sep_char' => $sep_char});
open(FH, $file) or die "cannot open $file: $!";
$count = 0;
while ( defined($line=) ) {
chomp $line;
$line &= "\177" x length($line); # i hope this isn't really necessary
$csv->parse($line)
or die "cannot parse: " . $csv->error_input();
my @values = $csv->fields();
my %hash;
foreach my $field (@fields) {
$hash{$field} = shift @values;
}
if (@values) {
warn "skipping malformed line: $line\n";
next;
}
my $skip = &{$fixup}(\%hash)
if $fixup;
unless ($skip) {
my $svc_acct = new FS::svc_acct { %hash };
my $error = $svc_acct->insert;
if ($error) {
warn $error;
next;
}
if ($skey && $mapkey) {
my $key = (ref($skey) eq 'CODE') ? &{$skey}($svc_acct) : $hash{$skey};
$object_map{$mapkey}{$key} = $svc_acct->svcnum;
}
$count++
}
}
print "Imported $count service records\n";
}
sub pkg_freq {
my ( $href ) = ( shift );
my $once;
$href->{'one_time_list'} =~ /^\s*(\S[\S ]*?)\s*$/ && ($once = $1);
$once
? 0
: int(eval "$href->{'months_credit'} + 0");
# int(eval "$href->{'month_credit'} + 0");
}
sub account_id {
my $href = shift;
if ($href->{'slave_account_id'} =~ /^\s*(\S[\S ]*?)\s*$/) {
"slave:$1";
}else{
my $l = $href->{cbilling_cycle_login};
$l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
$l;
}
}
sub b_or {
my ( $field, $hash ) = ( shift, shift );
$field = 'billing_'. $field
if $hash->{'billing_use'} eq 'Billing Address';
$hash->{$field};
}
sub p_or {
my ( $field, $hash ) = ( shift, shift );
$field = 'billing_'. $field
if $hash->{'billing_use'} eq 'Billing Address';
my $ac = ( $hash->{$field. '_area_code'}
&& $hash->{$field. '_area_code'} =~ /^\d{3}$/ )
? $hash->{$field. '_area_code'}. '-'
: '903-' # wtf?
;
( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
? $ac. $hash->{$field}
: '';
}
sub or_b {
my ( $field, $hash ) = ( shift, shift );
$hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
}
sub or_p {
my ( $field, $hash ) = ( shift, shift );
$hash->{'billing_use'} eq 'Billing Address' && $hash->{$field} =~ /^\d{3}-\d{4}$/
? ( $hash->{$field. '_area_code'} =~ /^\d{3}$/
? $hash->{$field. '_area_code'}. '-'
: '903-' # wtf?
). $hash->{$field}
: '';
}
my %payby_map = ( '' => 'BILL',
'None' => 'BILL',
'Credit Card' => 'CARD',
'Bank Debit' => 'CHEK',
'Virtual Check' => 'CHEK',
);
sub payby {
$payby_map{ shift->{billing_type} };
}
sub payinfo {
my $hash = shift;
my $payby = payby($hash);
my $info;
my $cc =
$hash->{'credit_card_number_1'}.
$hash->{'credit_card_number_2'}.
$hash->{'credit_card_number_3'}.
$hash->{'credit_card_number_4'};
my $bank =
$hash->{'bank_account_number'}.
'@'.
$hash->{'bank_transit_number'};
if ($payby eq 'CARD') {
$info = $cc;
}elsif ($payby eq 'CHEK') {
$info = $bank;
}elsif ($payby eq 'BILL') {
$info = $hash->{'blanket_purchase_order_number'};
$bank =~ s/[^\d\@]//g;
$cc =~ s/\D//g;
if ( $bank =~ /^\d+\@\d{9}/) {
$info = $bank;
$payby = 'DCHK';
}
if ( $cc =~ /^\d{13,16}/ ) {
$info = $cc;
$payby = 'DCRD';
}
}else{
die "unexpected payby";
}
($info, $payby);
}
sub ut_name_fixup {
my ($object, $field) = (shift, shift);
my $value = $object->getfield($field);
$value =~ s/[^\w \,\.\-\']/ /g;
$object->setfield($field, $value);
}
sub ut_text_fixup {
my ($object, $field) = (shift, shift);
my $value = $object->getfield($field);
$value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
$object->setfield($field, $value);
}
sub ut_state_fixup {
my ($object, $field) = (shift, shift);
my $value = $object->getfield($field);
$value = 'TX' if $value eq 'TTX';
$object->setfield($field, $value);
}
sub ut_zip_fixup {
my ($object, $field) = (shift, shift);
my $value = $object->getfield($field);
$value =~ s/[^-\d]//g;
$object->setfield($field, $value);
}
my @tables = (
part_pkg => { 'stable' => 'product',
#part_pkg => { 'stable' => 'billcycle',
'mapping' =>
{ 'pkg' => sub { my $href = shift;
$href->{'description'}
? $href->{'description'}
: $href->{'product_id'};
},
'comment' => 'product_id',
'freq' => sub { pkg_freq(shift) },
'recur_fee'=> sub { my $href = shift;
my $price = ( pkg_freq($href)
? $href->{'unit_price'}
: 0
);
$price =~ s/[^\d.]//g;
$price = 0 unless $price;
sprintf("%.2f", $price);
},
'setuptax' => sub { my $href = shift;
$href->{'taxable'} ? '' : 'Y';
},
'recurtax' => sub { my $href = shift;
$href->{'taxable'} ? '' : 'Y';
},
'plan' => sub { 'flat' },
'disabled' => sub { 'Y' },
'pkg_svc' => sub { my $href = shift;
my $result = {};
if (pkg_freq($href)){
$result->{$legacy_ppp_svcpart} = 1;
$result->{$legacy_email_svcpart} =
$href->{emails_allowed}
if $href->{emails_allowed};
}
},
'primary_svc'=> sub { pkg_freq(shift)
? $legacy_ppp_svcpart
: ''
;
},
},
'fixup' => sub { my $part_pkg = shift;
my $row = shift;
unless ($part_pkg->pkg =~ /^\s*(\S[\S ]*?)\s*$/) {
warn "no pkg: ". $part_pkg->pkg. " for ". $row->{product_id};
return 1;
}
unless ($part_pkg->comment =~ /^\s*(\S[\S ]*?)\s*$/) {
warn "no comment: ". $part_pkg->comment. " for ". $row->{product_id};
return 1;
}
return 1 if exists($package_cache{$1});
$package_cache{$1} = $part_pkg;
1;
},
'wrapup' => sub { foreach (keys %package_cache) {
my $part_pkg = $package_cache{$_};
my $options =
{ map { my $v = $part_pkg->$_;
$part_pkg->$_('');
($_ => $v);
}
qw (setup_fee recur_fee)
};
my $error =
$part_pkg->insert(options=>$options);
die "Error inserting package: $error"
if $error;
$count++ unless $error;
}
},
},
part_referral => { 'stable' => 'cust',
'mapping' =>
{ 'agentnum' => sub { $agentnum },
'referral' => sub { my $r = shift->{'referred_from'};
$referrals{$r} = 1;
},
},
'fixup' => sub { 1 },
'wrapup' => sub { foreach (keys %referrals) {
my $part_referral =
new FS::part_referral( {
'agentnum' => $agentnum,
'referral' => $referrals{$_},
} );
my $error = $part_referral->insert;
die "Error inserting referral: $error"
if $error;
$count++ unless $error;
$referrals{$_} = $part_referral->refnum;
}
},
},
#svc_acct => { 'stable' => 'cust',
# 'mapping' =>
# { 'username' => 'login',
# '_password' => 'password',
# 'svcpart' => sub{ $legacy_ppp_svcpart },
# 'domsvc' => sub{ $legacy_domain_svcnum },
# 'status' => 'status',
# },
# 'fixup' => sub { my $svc_acct = shift;
# my $row = shift;
# my $id = $row->{'master_account'}
# ? 'slave:'. $row->{'customer_id'}
# : $row->{'login'};
# my $status = $svc_acct->status;
# if ( $status ne 'Current'
# && $status ne 'On Hold' )
# {
# $cancel{$id} =
# str2time($row->{termination_date});
# warn "not creating (cancelled) svc_acct for " .
# $svc_acct->username. "\n";
# return 1
# }
# $susp{$id} = str2time($row->{hold_date})
# if $status eq 'On Hold';
# $adjo{$id} = str2time($row->{hold_date})
# if ( $status eq 'Current' &&
# $row->{hold_date} );
# $bill{$id} =
# str2time($row->{expiration_date});
# '';
# },
# 'skey' => sub { my $svc_acct = shift;
# my $row = shift;
# my $id = $row->{'master_account'}
# ? 'slave:'. $row->{'customer_id'}
# : $row->{'login'};
# },
# },
cust_main => { 'stable' => 'cust',
'mapping' =>
{ 'agentnum' => sub { $agentnum },
'agent_custid' => sub { my $id = shift->{'customer_number'};
if (exists($custid{$id})) {
$custid{$id}++;
$id. chr(64 + $custid{$id});
}else{
$custid{$id} = 0;
$id;
}
},
'last' => sub { b_or('last_name', shift) || ' ' },
'first' => sub { b_or('first_name', shift) || ' ' },
'stateid' => 'drivers_license_number',
'signupdate' => sub { str2time(shift->{'creation_date'}) },
'company' => sub { b_or('company_name', shift) },
'address1' => sub { b_or('address', shift) || ' ' },
'city' => sub { b_or('city', shift) || 'Paris' },
'state' => sub { uc(b_or('state', shift)) || 'TX' },
'zip' => sub { b_or('zip_code', shift) || '75460' },
'country' => sub { 'US' },
'daytime' => sub { p_or('phone', shift) },
'night' => sub { p_or('phone_alternate_1', shift) },
'fax' => sub { p_or('fax', shift) },
'ship_last' => sub { or_b('last_name', shift) },
'ship_first' => sub { or_b('first_name', shift) },
'ship_company' => sub { or_b('company_name', shift) },
'ship_address1'=> sub { or_b('address', shift) },
'ship_city' => sub { or_b('city', shift) },
'ship_state' => sub { uc(or_b('state', shift)) },
'ship_zip' => sub { or_b('zip_code', shift) },
'ship_daytime' => sub { or_p('phone', shift) },
'ship_fax' => sub { or_p('fax', shift) },
'tax' => sub { shift->{taxable} eq '' ? 'Y' : '' },
'refnum' => sub { $referrals{shift->{'referred_from'}}
|| 1
},
},
'fixup' => sub { my $cust_main = shift;
my $row = shift;
my ($master_account, $customer_id, $login) =
('', '', '');
$row->{'master_account'} =~ /^\s*(\S[\S ]*?)\s*$/
&& ($master_account = $1);
$row->{'customer_id'} =~ /^\s*(\S[\S ]*?)\s*$/
&& ($customer_id = $1);
$row->{'login'} =~ /^\s*(\S[\S ]*?)\s*$/
&& ($login = $1);
my ($first, $last, $company) =
('', '', '');
$cust_main->first =~ /^\s*(\S[\S ]*?)\s*$/
&& ($first = $1);
$cust_main->last =~ /^\s*(\S[\S ]*?)\s*$/
&& ($last = $1);
$cust_main->company =~ /^\s*(\S[\S ]*?)\s*$/
&& ($company = $1);
unless ($first || $last || $company) {
warn "bogus entry: ". $row->{'login'};
return 1;
}
my $id = $master_account
? 'slave:'. $customer_id
: $login;
#my $id = $login;
my $status = $row->{status};
my $cancelled = 0;
if ( $status ne 'Current'
&& $status ne 'current'
&& $status ne 'On Hold' )
{
$cancelled = 1;
$cancel{$login} =
str2time($row->{termination_date});
}
$susp{$id} = str2time($row->{hold_date})
if ($status eq 'On Hold' && !$cancelled);
$adjo{$id} = str2time($row->{hold_date})
if ( $status eq 'Current' && !$cancelled &&
$row->{hold_date} );
$bill{$id} =
str2time($row->{expiration_date})
if (!$cancelled);
my $svcnum =
$object_map{legacy_ppp}{$row->{'login'} };
unless( $cancelled || $svcnum || $status eq 'Pn Hold' ) {
warn "can't find svc_acct for legacy ppp ".
$row->{'login'}, "\n";
}
$object_map{svc_acct}{$id} = $svcnum
unless $cancelled;
$master_map{$login} = $master_account
if $master_account;
return 1 if $master_account;
$cust_main->ship_country('US')
if $cust_main->has_ship_address;
ut_name_fixup($cust_main, 'first');
ut_name_fixup($cust_main, 'company');
ut_name_fixup($cust_main, 'last');
my ($info, $payby) = payinfo($row);
$cust_main->payby($payby);
$cust_main->payinfo($info);
$cust_main->paycvv(
$row->{'credit_card_cvv_number'}
)
if ($payby eq 'CARD' or $payby eq 'DCRD');
$cust_main->paydate('20'.
$row->{'credit_card_exp_date_2'}. '-'.
substr(
$row->{'credit_card_exp_date_1'},
0,
2,
).
'-01'
)
if ($payby eq 'CARD' or $payby eq 'DCRD');
my $payname = '';
$payname = $row->{'credit_card_name'}
if ($payby eq 'CARD' or $payby eq 'DCRD');
$payname = $row->{'bank_name'}
if ($payby eq 'CHEK' or $payby eq 'DCHK');
$cust_main->payname($payname);
$cust_main->paytype(
$row->{'bank_account_to_debit'}
? 'Personal '.
$row->{bank_account_to_debit}
: ''
)
if ($payby eq 'CHEK' or $payby eq 'DCHK');
$cust_main->payby('BILL')
if ($cust_main->payby eq 'CHEK' &&
$cust_main->payinfo !~ /^\d+\@\d{9}$/);
$cust_main->payby('BILL')
if ($cust_main->payby eq 'CARD' &&
$cust_main->payinfo =~ /^\s*$/);
$cust_main->paydate('2037-12-01')
if ($cust_main->payby eq 'BILL');
ut_text_fixup($cust_main, 'address1');
ut_state_fixup($cust_main, 'state');
ut_zip_fixup($cust_main, 'zip');
'';
},
'skey' => sub { my $object = shift;
my $href = shift;
my $balance = sprintf("%.2f",
$href->{balance_due});
if ($balance < 0) {
my $cust_credit = new FS::cust_credit({
'custnum' => $object->custnum,
'amount' => sprintf("%.2f", -$balance),
'reasonnum' => $previous_credit_reasonnum,
});
my $error = $cust_credit->insert;
warn "Error inserting credit for ",
$href->{'login'}, " : $error\n"
if $error;
}elsif($balance > 0) {
my $error = $object->charge(
$balance, "Prior balance",
);
warn "Error inserting balance charge for ",
$href->{'login'}, " : $error\n"
if $error;
}
$href->{'login'};
},
},
#cust_main => { 'stable' => 'cust',
# 'mapping' =>
# { 'referred_by' => sub { my $href = shift;
# my $u = shift->{'login'};
# my $cn = $href->{'customer_number'};
#
# my $c = qsearch( 'cust_main',
# { 'custnum' => $cn }
# ) or die "can't fine customer $cn";
#
# my $s = qsearch( 'svc_acct',
# { 'username' => $u }
# ) or return '';
#
# my $n = $s->cust_svc
# ->cust_pkg
# ->cust_main
# ->custnum;
#
# $c->referral_custnum($n);
# my $error = $c->replace;
# die "error setting referral: $error"
# if $error;
# '';
# },
# };
# 'fixup' => sub { 1 },
# },
cust_pkg => { 'stable' => 'billcycle',
'mapping' =>
{ 'custnum' => sub { my $l = shift->{cbilling_cycle_login};
$l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
my $r = $object_map{'cust_main'}{$l};
unless ($r) {
my $m = $master_map{$l};
$r = $object_map{'cust_main'}{$m}
if $m;
}
$r;
},
'pkgpart' => sub { my $href = shift;
my $p = $href->{product_id};
$p =~ /^\s*(\S[\S ]*?)\s*$/ && ($p = $1);
my $pkg = $package_cache{$p}
if $package_cache{$p};
my $month = '';
$href->{month_credit} =~ /\s*(\S[\S ]*?)\s*$/ && ($month = $1);
$month = int(eval "$month + 0");
my $price = 0;
$href->{unit_price} =~ /\s*(\S[\S ]*?)\s*$/ && ($price = $1);
$price = eval "$price + 0";
if ($pkg) {
$pkg = ''
unless $pkg->freq + 0 == $month;
if ($pkg && ($pkg->freq + 0)) {
my $recur = 0;
$pkg->recur_fee =~ /\s*(\S[\S ]*?)\s*$/ && ($recur = $1);
$recur = eval "$recur + 0";
$pkg = ''
unless $recur == $price;
}
if ($pkg) {
$pkg = ''
unless $pkg->setuptax
eq ($href->{taxable} ? '' : 'Y');
}
}
unless ($pkg) {
my $pkghref = { 'pkg' => ($href->{description} ? $href->{description} : $href->{product_id} ),
'comment' => $href->{product_id},
'freq' => $month,
'setuptax' => ($href->{'taxable'} ? '' : 'Y'),
'recurtax' => ($href->{'taxable'} ? '' : 'Y'),
'plan' => 'flat',
'disabled' => 'Y',
};
my @pkgs = qsearch('part_pkg', $pkghref);
my $recur = sprintf("%.2f", ($month ? $price : 0));
for (@pkgs) {
my %options = $_->options;
if ($options{recur_fee} eq $recur) {
$pkg = $_;
last;
}
}
$pkghref->{recur_fee} = $recur
unless $pkg;
my $pkg_svc = {};
if ($month){
$pkg_svc->{$legacy_ppp_svcpart} = 1;
$pkg_svc->{$legacy_email_svcpart} =
$href->{emails_allowed}
if $href->{emails_allowed};
}
$pkghref->{pkg_svc} = $pkg_svc;
$pkghref->{primary_svc}
= ( $month
? $legacy_ppp_svcpart
: '');
unless ($pkg) {
$pkg = new FS::part_pkg $pkghref;
my $options =
{ map { my $v = $pkg->$_;
$pkg->$_('');
($_ => $v);
}
qw (setup_fee recur_fee)
};
my $error =
$pkg->insert(options=>$options);
if ($error) {
warn "Error inserting pkg ".
join(", ", map{"$_ => ". $pkg->get($_)} fields $pkg).
": $error\n";
$pkg = '';
}
}
}
$pkg ? $pkg->pkgpart : '';
},
'setup' => sub { str2time(shift->{creation_date}) },
'bill' => sub { $bill{account_id(shift)}
#$bill{$href->{cbilling_cycle_login}};
},
'susp' => sub { $susp{account_id(shift)}
#$susp{$href->{cbilling_cycle_login}};
},
'adjo' => sub { $adjo{account_id(shift)}
#$adjo{$href->{cbilling_cycle_login}};
},
'cancel' => sub { $cancel{account_id(shift)}
#$cancel{$href->{cbilling_cycle_login}};
},
},
'fixup' => sub { my ($object, $row) = (shift,shift);
unless ($object->custnum) {
warn "can't find customer for ".
$row->{cbilling_cycle_login}. "\n";
return 1;
}
unless ($object->pkgpart) {
warn "can't find package for ".
$row->{product_id}. "\n";
return 1;
}
'';
},
'skey' => sub { my $object = shift;
my $href = shift;
my $id = $href->{'billing_cycle_item_id'};
$id =~ /^\s*(\S[\S ]*?)\s*$/ && ($id = $1);
$cust_pkg_map{$id} = $object->pkgnum;
account_id($href);
},
'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
my $cust_svc =
qsearchs( 'cust_svc', { 'svcnum' =>
$object_map{'svc_acct'}{$id} }
);
unless ($cust_svc) {
warn "can't find legacy ppp $id\n";
next;
}
$cust_svc->
pkgnum($object_map{'cust_pkg'}{$id});
my $error = $cust_svc->replace;
warn "error linking legacy ppp $id: $error\n"
if $error;
}
},
},
svc_acct => { 'stable' => 'email',
'mapping' =>
{ 'username' => 'email_name',
'_password' => 'password',
'svcpart' => sub{ $legacy_email_svcpart },
'domsvc' => sub{ $legacy_domain_svcnum },
},
# 'fixup' => sub { my ($object, $row) = (shift,shift);
# my ($sd,$sm,$sy) = split '/',
# $row->{shut_off_date}
# if $row->{shut_off_date};
# if ($sd && $sm && $sy) {
# my ($cd, $cm, $cy) = (localtime)[3,4,5];
# $cy += 1900; $cm++;
# return 1 if $sy < $cy;
# return 1 if ($sy == $cy && $sm < $cm);
# return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
# }
# return 1 if $object_map{'cust_main'}{$object->username};
# '';
# },
'fixup' => sub { my ($object, $row) = (shift,shift);
my ($sd,$sm,$sy) = split '/',
$row->{shut_off_date}
if $row->{shut_off_date};
if ($sd && $sm && $sy) {
my ($cd, $cm, $cy) = (localtime)[3,4,5];
$cy += 1900; $cm++;
return 1 if $sy < $cy;
return 1 if ($sy == $cy && $sm < $cm);
return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
}
#return 1 if $object_map{'cust_main'}{$object->username};
my $email_name;
$row->{email_name} =~ /^\s*(\S[\S ]*?)\s*$/
&& ($email_name = $1);
my $svcnum =
$object_map{legacy_email}{$email_name}
if $email_name;
unless( $svcnum ) {
warn "can't find svc_acct for legacy email ".
$row->{'email_name'}, "\n";
return 1;
}
$object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svcnum;
return 1;
},
# 'skey' => sub { my $object = shift;
# my $href = shift;
# 'email:'. $href->{'email_customer_id'};
# },
'wrapup' => sub { for my $id (keys %{$object_map{'svc_acct'}}){
next unless $id =~ /^email:(\d+)/;
my $custid = $1;
my $cust_svc =
qsearchs( 'cust_svc', { 'svcnum' =>
$object_map{'svc_acct'}{$id} }
);
unless ($cust_svc) {
warn "can't find legacy email $id\n";
next;
}
if ($cust_svc->pkgnum) {
warn "service already linked for $id\n";
next;
}
$cust_svc->
pkgnum($cust_pkg_map{$custid});
if ($cust_svc->pkgnum){
my $error = $cust_svc->replace;
warn "error linking legacy email $id: $error\n"
if $error;
}else{
warn "can't find package for $id\n"
}
}
},
},
);
#my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
while ( @tables ) {
my ($table, $href) = (shift @tables, shift @tables);
my $stable = $href->{'stable'} or die "No source table"; # good enough for now
my (%mapping) = %{$href->{'mapping'}};
my ($fixup) = $href->{'fixup'};
my ($wrapup) = $href->{'wrapup'};
my ($id) = $href->{'id'};
my ($skey) = $href->{'skey'};
#$d_dbh->do("delete from $table");
my $s_sth = $s_dbh->prepare("select count(*) from $stable");
$s_sth->execute or die $s_sth->errstr;
my $rowcount = $s_sth->fetchrow_arrayref->[0];
$s_sth = $s_dbh->prepare("select * from $stable");
$s_sth->execute or die $s_sth->errstr;
my $row;
$count = 0;
while ( $row = $s_sth->fetchrow_hashref ) {
my $class = "FS::$table";
warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
unless( !$count || $count % 100 );
my $object = new $class ( {
map { $_ => ( ref($mapping{$_}) eq 'CODE'
? &{$mapping{$_}}($row)
: $row->{$mapping{$_}}
)
}
keys(%mapping)
} );
my $skip = &{$fixup}($object, $row)
if $fixup;
unless ($skip) {
my $error = $object->insert;
if ($error) {
warn "Error inserting $table ".
join(", ", map{"$_ => ". $object->get($_)} fields $object).
": $error\n";
next;
}
if ($skey) {
my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
: $row->{$skey};
$object_map{$table}{$key} = $object->get($object->primary_key)
}
$count++;
}
}
&{$wrapup}()
if $wrapup;
print "$count/$rowcount of $table SUCCESSFULLY processed\n";
}
# link to any uncancelled package on customer
foreach my $username ( keys %{$object_map{'legacy_email'}} ) {
my $cust_svc = qsearchs( 'cust_svc',
{ 'svcnum' => $object_map{legacy_email}{$username} }
);
next unless $cust_svc;
next if $cust_svc->pkgnum;
my $custnum = $object_map{cust_main}{$username};
unless ($custnum) {
my $master = $master_map{$username};
$custnum = $object_map{'cust_main'}{$master}
if $master;
next unless $custnum;
}
#my $extra_sql = ' AND 0 != (select freq from part_pkg where '.
# 'cust_pkg.pkgpart = part_pkg.pkgpart )';
my $extra_sql = " AND 'Prior balance' != (select pkg from part_pkg where ".
"cust_pkg.pkgpart = part_pkg.pkgpart )";
my @cust_pkg = qsearch( {
'table' => 'cust_pkg',
'hashref' => { 'custnum' => $custnum,
'cancel' => '',
},
'extra_sql' => $extra_sql,
} );
next unless scalar(@cust_pkg);
$cust_svc->pkgnum($cust_pkg[0]->pkgnum);
$cust_svc->replace;
}
if ($dry_run) {
$d_dbh->rollback;
}else{
$d_dbh->commit or die $d_dbh->errstr;
}