path: root/install/rpm/freeside-import

#!/usr/bin/perl -w
# Import text file into Freeside
# Input is a formatted text file containing basic item definitions
#
use strict;
use Date::Parse;
use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(fields qsearch qsearchs);
use FS::cust_main;
use FS::cust_pkg;
use FS::cust_svc;
use FS::svc_acct;
use FS::pkg_svc;

my $user = shift or die &usage;
adminsuidsetup $user;

#use vars qw($cust_main::import);
#$import = 1;

sub usage {
	die "Usage: freeside-import freeside-user file(s)\nWhere:\tfreeside-user is a user created with freeside-adduser\n\tfile(s) are text formatted object lists";
}

# Define tag types that can be used in the data file
# These are essentially FS:: record types and their fields.
my %tags = (
	'agent_type' => [qw/atype/],
	'agent' => [qw/agent typenum/],
	'svc_acct_pop' => [qw/city state ac exch loc/],
	'part_pop_local' => [qw/popnum city state npa nxx/],
	'part_referral' => [qw/referral/],
	'part_svc' => [qw/svc svcdb disabled/],
	'part_svc_column' => [qw/columnnum svcpart columnname columnvalue columnflag/],
	'part_pkg' => [qw/pkg comment setup freq recur setuptax recurtax taxclass plan plandata disabled/],
	'part_pkg_option' => [qw/optionnum pkgpart optionname optionvalue/],
	'pkg_svc' => [qw/pkgpart svcpart quantity primary_svc/],
	'cust_main' => [qw/custnum agentnum refnum first last ss company address1 address2 city county state zip country daytime night fax ship_first ship_last ship_company ship_address1 ship_address2 ship_city ship_county ship_state ship_zip ship_country ship_daytime ship_night ship_fax payby payinfo paydate payname tax otaker comments invoicing/],
	'cust_pkg' => [qw/pkgnum custnum pkgpart setup bill last_bill susp expire cancel otaker manual_flag/],
	# svc_ objects should also include "pkgnum svcpart"
	'svc_acct' => [qw/svcnum username _password sec_phrase popnum uid gid finger dir shell quota slipip seconds domsvc pkgnum svcpart usergroup/],
	'svc_domain' => [qw/svcnum domain catchall pkgnum svcpart action email/],
	'svc_forward' => [qw/svcnum srcsvc dstsvc dst pkgnum svcpart/],
	'svc_www' => [qw /svcnum recnum usersvc pkgnum svcpart/],
	'part_export' => [qw/exportnum machine exporttype nodomain/],
	'part_export_option' => [qw/optionnum exportnum optionname optionvalue/],
	'export_svc' => [qw/exportsvcnum exportnum svcpart/],
	'cust_main_county' => [qw/taxnum state county country tax taxclass exempt_amount/],
	'cust_bill' => [qw/invnum custnum _date charged printed closed/],
	'cust_bill_pkg' => [qw/invnum pkgnum setup recur sdate edate/],
	'cust_pay' => [qw/paynum custnum paid _date payby payinfo paybatch closed/],
	'cust_credit' => [qw/crednum custnum amount _date otaker reason closed/],
	'cust_refund' => [qw/refundnum custnum refund _date payby payinfo paybatch otaker closed/],
	'part_bill_event' => [qw/eventpart payby event eventcode seconds weight plan plandata disabled/],
);

# Define fields that can be looked up in other object types.
# These are fields that should be unique numbers but can be text in the data file
my %lookups = (
	'agent' => {'typenum' => 'agent_type.atype'},
	'svc_acct_pop' => {'popnum' => 'part_pop_local.popnum'},
	'part_svc_column' => {'svcpart' => 'part_svc.svc'},
	'part_pkg_option' => {'pkgpart' => 'part_pkg.pkg'},
	'pkg_svc' => {'pkgpart' => 'part_pkg.pkg', 'svcpart' => 'part_svc.svc'},
	'cust_main' => {'agentnum' => 'agent.agent', 'refnum' => 'part_referral.referral'},
	'cust_pkg' => {'pkgpart' => 'part_pkg.pkg', 'custnum' => 'cust_main.first+last|ship_first+ship_last|company'},
	'svc_acct' => {'pkgnum' => 'cust_main.first+last|ship_first+ship_last|company', 'svcpart' => 'part_svc.svc', 'domsvc' => 'svc_domain.domain'},
	'svc_domain' => {'pkgnum' => 'cust_main.first+last|ship_first+ship_last|company', 'svcpart' => 'part_svc.svc'},
	'svc_forward' => {'pkgnum' => 'cust_main.first+last|ship_first+ship_last|company', 'svcpart' => 'part_svc.svc'},
	'svc_www' => {'recnum' => 'domain_record.reczone+svcnum', 'pkgnum' => 'cust_main.first+last|ship_first+ship_last|company', 'svcpart' => 'part_svc.svc'},
	'part_export_option' => {'exportnum' => 'part_export.machine+exporttype'},
	'export_svc' => {'exportnum' => 'part_export.machine+exporttype', 'svcpart' => 'part_svc.svc'},
	'cust_bill' => {'custnum' => 'cust_main.first+last|ship_first+ship_last|company'},
	'cust_bill_pkg' => {'invnum' => 'cust_bill._date', 'pkgnum' => 'cust_pkg.custnum+pkgpart'},
	'cust_pay' => {'custnum' => 'cust_main.first+last|ship_first+ship_last|company'},
	'cust_credit' => {'custnum' => 'cust_main.first+last|ship_first+ship_last|company'},
	'cust_refund' => {'custnum' => 'cust_main.first+last|ship_first+ship_last|company'},
	'domain_record' => {'svcnum' => 'svc_domain.domain'},
);

my %nolookup = (
	'pkg_svc' => 'pkg_svc',
);

my %conversions = (
	'cust_pkg' => {'setup' => 'date', 'bill' => 'date', 'last_bill' => 'date', 'susp' => 'date', 'expire' => 'date', 'cancel' => 'date'},
#	'part_svc_column' => {'columnname' => 'svc_column'}, # 'columnflag' => 'enum:D|F'
	'svc_acct' => {'usergroup' => 'array'},
	'cust_main' => {'invoicing' => 'array'},
	'cust_bill' => {'_date' => 'date'},
	'cust_bill_pkg' => {'sdate' => 'date', 'edate' => 'date'},
	'cust_pay' => {'_date' => 'date'},
	'cust_credit' => {'_date' => 'date'},
	'cust_refund' => {'_date' => 'date'},
);

my %enumerations = (
	'part_pkg' => {'plan' => [qw/flat flat_delayed prorate subscription flat_comission_cust flat_comission flat_comission_pkg sesmon_hour sesmon_minute sqlradacct_hour/] },
	'part_bill_event' => {'payby' => [qw/CARD DCRD CHEK DCHK LECB BILL COMP/] },
);

my @values;	# Presumably we can bypass memory limitations by tying this to a DBM file.
my %pairs;
my $type;
my $verbose = 1;
my $parse_error = 0;
my $svcdb;
my %lastids;

# Read in the data file and construct a data structure, validating attributes as you go.
while (<ARGV>) {
	next if (/^\s*$/ || /^\s*#/);	# Skip blank lines and comments
	chomp;
	if (/^\s*\[\s*(.*?)\s*\]\s*(#.*)?$/) {
		if ($type) {
			push @values, {$type => {%pairs} };
			%pairs = ();
		}
		$type = $1;
		$type =~ s/-/_/;
		print "[$type]\n" if $verbose;
		report_error("$ARGV $.: $_", "Object $type not known\n\n") if !exists($tags{$type});
	} elsif (/^\s*(.*?)\s*=\s*'(.*?)'\s*(#.*)?$/ ||
		/^\s*(.*?)\s*=\s*"(.*?)"\s*(#.*)?$/ ||
		/^\s*(.*?)\s*=\s*(.*?)\s*(#.*)?$/) {
		my ($col, $val) = ($1, $2);
		$val =~ s/\\n/\n/g;
		print "$col=$val\n" if $verbose;
		$pairs{$col} = $val;
		report_error("$ARGV $.: $_", "Attribute $col not known in definition of $type\n\n") if !grep {grep {$_ eq $col} @$_} $tags{$type};
		$svcdb = $val if $col eq 'svcdb' && $type eq 'part_svc';
		report_error("$ARGV $.: $_", "Service column $col not known in definition of $svcdb\n\n") if $type eq 'part_svc' && $col eq 'columnname' && !grep {grep {$_ eq $col} @$_} $tags{$svcdb};
	}
}
if ($type) {
	push @values, {$type => {%pairs} };
}

die "$parse_error parse errors - can't continue" if $parse_error;

# Should do validation at this point

# !!! TBD !!!

dump_it() if $verbose & 2;
#print_it();
process_it();
print "freeside-import complete\n"; # Sign off to confirm everything went well

sub report_error {
	print STDERR @_;
	$parse_error++;
}

sub dump_it {
# Print out the data structure using Data::Dumper
use Data::Dumper;

print Dumper(@values);
}

# Do something with the data structure
# Should be populating the FS database
# Is currently just printing it out again.
sub print_it {

	foreach my $entry (@values) {
		#print $_->{type} . "\n";
		#foreach ($_->{values}) {
		#	print $_[0] . "=" . $_[1] . "\n";
		#}
		foreach my $type (keys %$entry) {
			print "\t\$record = new FS::$type(\n";
			my $values = $$entry{$type};
			foreach (keys %$values) {
				if (defined($lookups{$type})) {
					my $lookup = $lookups{$type};
					if (defined($$lookup{$_})) {
						my ($table,$field) = split /\./, $$lookup{$_};
						print "\t\t$_ => qsearch(\"$table\", { \"$field\" => \"$$values{$_}\" });\n";
						next;
					}
				}
				print "\t\t$_ => '$$values{$_}',\n";
			}
			print "\t);\n";
			print "\t\$error = \$record->insert();\n\n";
		}
	}
}

sub process_it {

	$FS::cust_main::import = 1;	# Suppress expired credit card errors

	foreach my $entry (@values) {
		#print $_->{type} . "\n";
		#foreach ($_->{values}) {
		#	print $_[0] . "=" . $_[1] . "\n";
		#}
		foreach my $type (keys %$entry) {
	#		print "\t\$record = new FS::$type(\n";
			my $values = $$entry{$type};
			# part_svc_column lookups can be done before working through each attribute in the object
			if ($type eq 'part_svc_column') {
				if ($$values{'columnname'} eq 'domsvc') {
					my $record = qsearchs('svc_domain', { 'domain' => $$values{'columnvalue'} });
					die "Can't find domain $$values{'columnvalue'}" if !$record;
					$$values{'columnvalue'} = get_recordid('svc_domain', $record);
				}
			}
			foreach (keys %$values) {
				if ($$values{$_} =~ /^=\s*(.*)/) {
					if ($1 =~ /^\d+$/) {
						# User supplied a record number "==num"
						$$values{$_} =~ s/^=\s*//;
					} else {
						# User specified last object created "==object_type"
						print "Looking up ID of last $1 created\n";
						$$values{$_} = $lastids{$1};
					}
					next;
				}
				my $value = lookup_recordid($type, $_, $$values{$_});
				if ($value) {
					$$values{$_} = $value;
					next;
				}
				if (defined($conversions{$type})) {
					my $conversion = $conversions{$type};
					if (!defined($$conversion{$_})) {
						next;
					} elsif ($$conversion{$_} eq 'date') {
						$$values{$_} = str2time($$values{$_}) if $$values{$_} !~ /^\s*\d+\s*$/;
					} elsif ($$conversion{$_} eq 'array') {
						$$values{$_} = [split ',', $$values{$_}];
#					} elsif ($$conversion{$_} eq 'svc_column') {
#						$$values{$_} = str2time($$values{$_});
					}
				}
	#			print "\t\t$_ => '$$values{$_}',\n";
			}
	#		print "\t);\n";
	#		print "\t\$error = \$record->insert();\n\n";
			my $record;
			my $oldrec;
			if ($type eq 'agent_type') {
				$record = new FS::agent_type($values);
			} elsif ($type eq 'agent') {
				$record = new FS::agent($values);
			} elsif ($type eq 'svc_acct_pop') {
				$record = new FS::svc_acct_pop($values);
			} elsif ($type eq 'part_pop_local') {
				$record = new FS::part_pop_local($values);
			} elsif ($type eq 'part_referral') {
				$record = new FS::part_referral($values);
			} elsif ($type eq 'part_svc') {
				$record = new FS::part_svc($values);
			} elsif ($type eq 'part_svc_column') {
				$record = new FS::part_svc_column($values);
			} elsif ($type eq 'part_pkg') {
				$record = new FS::part_pkg($values);
			} elsif ($type eq 'part_pkg_option') {
				$record = new FS::part_pkg_option($values);
			} elsif ($type eq 'pkg_svc') {
				# As of 1.5.7, part_pkg inserts a pkg_svc with quantity zero for every known part_svc
				# Therefore, we replace pkg_svc records instead of inserting
				my $oldrec = qsearchs('pkg_svc', {pkgpart => $values->{pkgpart}, svcpart => $values->{svcpart}});
				if ($oldrec) {
#					$values->{pkgsvcnum} = $oldrec->pkgsvcnum;
					$oldrec->delete();
#					print "Replacing record $values->{pkgsvcnum} with pkgpart = $values->{pkgpart}, svcpart = $values->{svcpart}\n";
					print "Deleting record with pkgpart = $values->{pkgpart}, svcpart = $values->{svcpart}\n";
				} else {
					print "Inserting record with pkgpart = $values->{pkgpart}, svcpart = $values->{svcpart}\n";
				}
				$record = new FS::pkg_svc($values);
			} elsif ($type eq 'part_export') {
				$record = new FS::part_export($values);
			} elsif ($type eq 'part_export_option') {
				$record = new FS::part_export_option($values);
			} elsif ($type eq 'export_svc') {
				$record = new FS::export_svc($values);
			} elsif ($type eq 'cust_main_county') {
				$record = new FS::cust_main_county($values);
			} elsif ($type eq 'cust_main') {
				$oldrec = $$values{'invoicing'};
				delete $$values{'invoicing'};
				$record = new FS::cust_main($values);
				my $err = $record->check_invoicing_list($oldrec);
				warn $err if $err;
			} elsif ($type eq 'cust_pkg') {
				$record = new FS::cust_pkg($values);
			} elsif ($type eq 'svc_acct') {
				$record = new FS::svc_acct($values);
			} elsif ($type eq 'svc_domain') {
				$FS::svc_domain::whois_hack = 1;	# Disables domain registrations
				$record = new FS::svc_domain($values);
			} elsif ($type eq 'svc_forward') {
				$record = new FS::svc_forward($values);
			} elsif ($type eq 'svc_www') {
				$record = new FS::svc_www($values);
			} elsif ($type eq 'cust_bill') {
				$record = new FS::cust_bill($values);
			} elsif ($type eq 'cust_bill_pkg') {
				$record = new FS::cust_bill_pkg($values);
			} elsif ($type eq 'cust_pay') {
				$record = new FS::cust_pay($values);
			} elsif ($type eq 'cust_credit') {
				$record = new FS::cust_credit($values);
			} elsif ($type eq 'cust_refund') {
				$record = new FS::cust_refund($values);
			} elsif ($type eq 'part_bill_event') {
				$record = new FS::part_bill_event($values);
			} else {
				die "Unknown type $type: can't create object";
			}
#			my $error = $oldrec ? $record->replace($oldrec) : $record->insert();
			my $error = $type eq 'cust_main' ? $record->insert({}, $oldrec) : $record->insert();
			if ( $error ) {
				warn $record->_dump;
				warn map "$_: ". $$values{$_}. "|\n", keys %$values;
				die $error;
			} else {
				# Update the last created object record number for the current type
				my $id = "";
				$id = get_recordid($type, $record) if !exists($nolookup{$type});
				print "$type - $id: OK\n";
				$lastids{$type} = $id;
				# Apply payments or credits automatically (not everyone may want this).
				if ($type eq 'cust_pay' || $type eq 'cust_credit') {
					my $cust_main = qsearchs('cust_main', {'custnum' => $$values{'custnum'} });
					die "Can't find customer to apply payment/credit: cust_num = $$values{custnum}" unless $record;
					$cust_main->apply_payments if $type eq 'cust_pay';
					$cust_main->apply_credits if $type eq 'cust_credit';
				}
			}
		}
	}
}

sub lookup_recordid {
	my ($type, $attrib, $value) = @_;

	if (defined($lookups{$type}->{$attrib})) {
		my ($table,$field) = split /\./, $lookups{$type}->{$attrib};
		my @vals = split /\+/, $value;
		foreach my $option (split /\|/, $field) {
			my @fields = split /\+/, $option;
			my $searchvals = {};
			foreach my $f (@fields) {
				if (defined($lookups{$table}->{$f})) {
					my @v;
					my @p = split /\+/, $lookups{$table}->{$f};
					foreach (@p) {
						push @v, shift @vals;
					}
					my $v = join '+', @v;
					print "Recursive lookup in $table for $v in fields $f\n";
					$$searchvals{$f} = lookup_recordid($table, $f, $v);
				} else {
					$$searchvals{$f} = shift @vals;
				}
			}
			my $record = qsearchs($table, $searchvals);
			return get_recordid($table, $record) if $record;
		}
		die "Unknown $table: $field = $value";
	}
	undef;
}

sub get_recordid {
	my $table = shift;
	my $record = shift;

	my $value;
	if ($table eq 'agent_type') {
		$value = $record->typenum;
	} elsif ($table eq 'agent') {
		$value = $record->agentnum;
	} elsif ($table eq 'svc_acct_pop') {
		$value = $record->popnum;
	} elsif ($table eq 'part_pop_local') {
		$value = $record->localnum;
	} elsif ($table eq 'part_referral') {
		$value = $record->refnum;
	} elsif ($table eq 'part_svc') {
		$value = $record->svcpart;
	} elsif ($table eq 'part_svc_column') {
		$value = $record->columnnum;
	} elsif ($table eq 'part_pkg') {
		$value = $record->pkgpart;
	} elsif ($table eq 'part_pkg_option') {
		$value = $record->optionnum;
	} elsif ($table eq 'pkg_svc') {
#		die "No unique key in pkg_svc";
		$value = $record->pkgsvcnum;
	} elsif ($table eq 'part_export') {
		$value = $record->exportnum;
	} elsif ($table eq 'part_export_option') {
		$value = $record->optionnum;
	} elsif ($table eq 'export_svc') {
		$value = $record->exportsvcnum;
	} elsif ($table eq 'cust_main_county') {
		$value = $record->taxnum;
	} elsif ($table eq 'cust_main') {
		$value = $record->custnum;
	} elsif ($table eq 'cust_pkg') {
		$value = $record->pkgnum;
	} elsif ($table eq 'svc_acct') {
		$value = $record->svcnum;
	} elsif ($table eq 'svc_domain') {
		$value = $record->svcnum;
	} elsif ($table eq 'svc_forward') {
		$value = $record->svcnum;
	} elsif ($table eq 'svc_www') {
		$value = $record->svcnum;
	} elsif ($table eq 'cust_bill') {
		$value = $record->invnum ;
	} elsif ($table eq 'cust_bill_pkg') {
		$value = $record->invnum;
	} elsif ($table eq 'cust_pay') {
		$value = $record->paynum;
	} elsif ($table eq 'cust_credit') {
		$value = $record->crednum;
	} elsif ($table eq 'cust_refund') {
		$value = $record->refundnum;
	} elsif ($table eq 'part_bill_event') {
		$value = $record->eventpart;
	} elsif ($table eq 'domain_record') {
		$value = $record->recnum;
	} else {
		die "Unknown table $table in lookup";
	}
	$value;
}

=head1 NAME

freeside-import - Command line utility to import text object descriptions into Freeside via Perl API

=head1 SYNOPSIS

  freeside-import user file file ...

=head1 DESCRIPTION

Reads in files containing Freeside object data in Windows-ini style format, does
basic checks for accuracy, then uses the Perl API to create the objects.

Object fields which reference other objects can contain lookups instead of object numbers,
e.g.

   custnum==cust_main # Use last created cust_main
   custnum=Ivan+Kohler # Look up in First+Last

user: From the mapsecrets file - see config.html from the base documentation

file: File containing the object text dump

=head1 BUGS

=head1 SEE ALSO

Perl API, config.html from the base documentation

=cut