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, 0 insertions, 1077 deletions
diff --git a/bin/import-optigold.pl b/bin/import-optigold.pl
deleted file mode 100755
index d32a2a129..000000000
--- a/bin/import-optigold.pl
+++ /dev/null
@@ -1,1077 +0,0 @@
-#!/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;
-}
-
generated by cgit v1.2.1 (git 2.18.0) at 2025-04-20 20:38:08 +0000