summaryrefslogtreecommitdiff
path: root/bin/import-optigold.pl
diff options
context:
space:
mode:
Diffstat (limited to 'bin/import-optigold.pl')
-rwxr-xr-xbin/import-optigold.pl1077
1 files changed, 1077 insertions, 0 deletions
diff --git a/bin/import-optigold.pl b/bin/import-optigold.pl
new file mode 100755
index 0000000..d32a2a1
--- /dev/null
+++ b/bin/import-optigold.pl
@@ -0,0 +1,1077 @@
+#!/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=<FH>) ) {
+ 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;
+}
+