[open-ils-commits] r17684 - in trunk/Open-ILS/src: edi_translator perlmods/OpenILS/Application/Acq support-scripts (atz)
svn at svn.open-ils.org
svn at svn.open-ils.org
Wed Sep 15 01:25:05 EDT 2010
Author: atz
Date: 2010-09-15 01:25:02 -0400 (Wed, 15 Sep 2010)
New Revision: 17684
Modified:
trunk/Open-ILS/src/edi_translator/test_client.pl
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm
trunk/Open-ILS/src/support-scripts/edi_fetcher.pl
Log:
edi_fetcher overhaul, test_client improvement
New options: --test --provider --account
Lots of crosschecking. Accept files from command line or STDIN.
Had to break out the logic in EDI to accommodate non-retrieved input.
Remote retrieval now avoids pulling a file if the same file was
previously retrieved and successfully processed. If it bombed out,
then we get it again (on the hopes it might have been fixed).
Also better test_client behavior on edi2json failure.
Modified: trunk/Open-ILS/src/edi_translator/test_client.pl
===================================================================
--- trunk/Open-ILS/src/edi_translator/test_client.pl 2010-09-15 05:25:01 UTC (rev 17683)
+++ trunk/Open-ILS/src/edi_translator/test_client.pl 2010-09-15 05:25:02 UTC (rev 17684)
@@ -88,9 +88,20 @@
} else {
$string =~ s/ORDRSP:0(:...:UN::)/ORDRSP:D$1/ and print STDERR "Corrected broken data 'ORDRSP:0' ==> 'ORDRSP:D'\n";
$resp = $client->send_request('edi2json', $string);
+ }
+ unless ($resp) {
+ warn "Response does not have a payload value!";
+ next;
+ }
+ if ($resp->is_fault) {
+ print "\n\nERROR code ", $resp->code, " received:\n", nice_string($resp->string) . "\n...\n";
+ next;
+ }
+ if ($command ne 'json2edi') { # like the else of the first conditional
$parser ||= JSON::XS->new()->pretty(1)->ascii(1)->allow_nonref(1)->space_before(0); # get it once
+ $verbose and print Dumper($resp);
my $parsed = $parser->decode($resp->value) or warn "Failed to decode response payload value";
- my $perl = JSONObject2Perl($parsed) or warn "Failed to decode and create perl object from JSON";
+ my $perl = JSONObject2Perl($parsed) or warn "Failed to decode and create perl object from JSON";
if ($perl) {
print STDERR "\n########## We were able to decode and perl-ify the JSON\n";
} else {
@@ -98,12 +109,6 @@
}
print "# $command Response: \n", $command eq 'edi2perl' ? Dumper($perl) : $parser->encode($parsed);
}
-
- $resp or next;
- if ($resp->is_fault) {
- print "\n\nERROR code ", $resp->code, " received:\n", nice_string($resp->string) . "\n...\n";
- next;
- }
}
exit;
}
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm 2010-09-15 05:25:01 UTC (rev 17683)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm 2010-09-15 05:25:02 UTC (rev 17684)
@@ -80,7 +80,7 @@
);
sub retrieve_core {
- my ($self, $e, $set, $max) = @_; # $e is a working editor
+ my ($self, $set, $max, $e) = @_; # $e is a working editor
$e ||= new_editor();
$set ||= __PACKAGE__->retrieve_vendors($e);
@@ -92,38 +92,55 @@
my $server;
$logger->info("EDI check for vendor " . ++$vcount . " of " . scalar(@$set) . ": " . $account->host);
unless ($server = __PACKAGE__->remote_account($account)) { # assignment, not comparison
- $logger->err(sprintf "Failed remote account connection for %s (%s)", $account->host, $account->id);
+ $logger->err(sprintf "Failed remote account mapping for %s (%s)", $account->host, $account->id);
next;
};
- my @files = $server->ls({remote_file => ($account->in_dir || '.')});
- my @ok_files = grep {$_ !~ /\/\.?\.$/ } @files;
- $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, ($account->in_dir || ''));
+ my $rf_starter = '';
+ if ($account->in_dir) {
+ if ($account->in_dir =~ /\*+.*\//) {
+ $logger->err("EDI in_dir has a slash after an asterisk in value: '" . $account->in_dir . "'. Skipping account with indeterminate target dir!");
+ next;
+ }
+ $rf_starter = $account->in_dir;
+ $rf_starter =~ s/((\/)?[^\/]*)\*+[^\/]*$//; # kill up to the first (possible) slash before the asterisk: keep the preceeding static dir
+ $rf_starter .= '/' if $rf_starter or $2; # recap the dir, or replace leading "/" if there was one (but don't add if empty)
+ }
+ my @files = ($server->ls({remote_file => ($rf_starter || '.')}));
+ my @ok_files = grep {$_ !~ /\/\.?\.$/ and $_ ne '0'} @files;
+ $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, ($rf_starter || '.'));
+ $server->remote_path(undef);
foreach (@ok_files) {
+ my $remote_file = $rf_starter . $_;
+ my $description = sprintf "%s/%s", $account->host, $remote_file;
+
+ # deduplicate vs. acct/filenames already in DB
+ my $hits = $e->search_acq_edi_message([
+ {
+ account => $account->id,
+ remote_file => $remote_file,
+ status => {'in' => [qw/ processed /]}, # if it never got processed, go ahead and get the new one (try again)
+ # create_time => 'NOW() - 60 DAYS', # if we wanted to allow filenames to be reused after a certain time
+ # ideally we would also use the date from FTP, but that info isn't available via RemoteAccount
+ }
+ # { flesh => 1, flesh_fields => {...}, }
+ ]);
+ if (scalar(@$hits)) {
+ $logger->debug("EDI: $remote_file already retrieved. Skipping");
+ print ("EDI: $remote_file already retrieved. Skipping");
+ next;
+ }
+
++$count;
$max and $count > $max and last;
+ $logger->info(sprintf "%s of %s targets: %s", $count, scalar(@ok_files), $description);
+ print sprintf "%s of %s targets: %s\n", $count, scalar(@ok_files), $description;
my $content;
my $io = IO::Scalar->new(\$content);
- unless (
- $server->get({remote_file => ($account->in_dir ? ($account->in_dir . "/$_") : $_),
- local_file => $io})
- ) {
- $logger->error("(S)FTP get($_) failed");
+ unless ( $server->get({remote_file => $remote_file, local_file => $io}) ) {
+ $logger->error("(S)FTP get($description) failed");
next;
}
- my $z; # must predeclare
- $z = ( $content =~ s/('UNH\+\d+\+ORDRSP:)0(:96A:UN')/$1D$2/g )
- and $logger->warn("Patching bogus spec reference ORDRSP:0:96A:UN => ORDRSP:D:96A:UN ($z times)"); # Hack/fix some faulty "0" in (B&T) data
- my $incoming = Fieldmapper::acq::edi_message->new;
- $incoming->remote_file($_);
- $incoming->message_type('ORDRSP'); # FIXME: we don't actually know w/o sniffing, but DB constraint makes us say something
- $incoming->edi($content);
- $incoming->account($account->id);
- __PACKAGE__->attempt_translation($incoming);
- $e->xact_begin;
- $e->create_acq_edi_message($incoming);
- $e->xact_commit;
- __PACKAGE__->record_activity($account, $e);
- __PACKAGE__->process_jedi($incoming, $server, $e);
+ my $incoming = __PACKAGE__->process_retrieval($content, $_, $server, $account->id, $e);
# $server->delete(remote_file => $_); # delete remote copies of saved message
push @return, $incoming->id;
}
@@ -131,6 +148,32 @@
return \@return;
}
+# my $in = OpenILS::Application::Acq::EDI->process_retrieval($file_content, $remote_filename, $server, $account_id, $editor);
+
+sub process_retrieval {
+ my $incoming = Fieldmapper::acq::edi_message->new;
+ my ($class, $content, $remote, $server, $account_or_id, $e) = @_;
+ $content or return;
+ $e ||= new_editor;
+
+ my $account = __PACKAGE__->record_activity( $account_or_id, $e );
+
+ my $z; # must predeclare
+ $z = ( $content =~ s/('UNH\+\d+\+ORDRSP:)0(:96A:UN')/$1D$2/g )
+ and $logger->warn("Patching bogus spec reference ORDRSP:0:96A:UN => ORDRSP:D:96A:UN ($z times)"); # Hack/fix some faulty "0" in (B&T) data
+
+ $incoming->remote_file($remote);
+ $incoming->account($account->id);
+ $incoming->edi($content);
+ $incoming->message_type(($content =~ /'UNH\+\d+\+(\S{6}):/) ? $1 : 'ORDRSP'); # cheap sniffing, ORDRSP fallback
+ __PACKAGE__->attempt_translation($incoming);
+ $e->xact_begin;
+ $e->create_acq_edi_message($incoming);
+ $e->xact_commit;
+ __PACKAGE__->process_jedi($incoming, $server, $e);
+ return $incoming;
+}
+
# ->send_core
# $account is a Fieldmapper object for acq.edi_account row
# $messageset is an arrayref with acq.edi_message.id values
@@ -225,7 +268,7 @@
$e ||= new_editor();
my $criteria = {'+acqpro' => {active => 't'}};
- # $criteria->{vendor_id} = $vendor_id if $vendor_id;
+ $criteria->{'+acqpro'}->{id} = $vendor_id if $vendor_id;
return $e->search_acq_edi_account([
$criteria, {
'join' => 'acqpro',
@@ -299,10 +342,13 @@
);
}
+# takes account ID or account Fieldmapper object
+
sub record_activity {
- my ($class, $account, $e) = @_;
- $account or return;
+ my ($class, $account_or_id, $e) = @_;
+ $account_or_id or return;
$e ||= new_editor();
+ my $account = ref($account_or_id) ? $account_or_id : $e->retrieve_acq_edi_account($account_or_id);
$logger->info("EDI record_activity calling update_acq_edi_account");
$account->last_activity('NOW') or return;
$e->xact_begin;
@@ -376,7 +422,8 @@
# So you might access it like:
# $obj->{body}->[0]->{ORDERS}->[0]->[0] eq 'UNH'
- $logger->info("EDI interchange body has " . scalar(@{$perl->{body}}) . " messages(s)");
+ $logger->info("EDI interchange body has " . scalar(@{$perl->{body}}) . " message(s)");
+ my @ok_msg_codes = qw/ORDERS OSTRPT/;
my @messages;
my $i = 0;
foreach my $part (@{$perl->{body}}) {
@@ -390,9 +437,10 @@
$logger->warn("EDI interchange $i contains unhandled '$key' message. Ignoring it.");
next;
}
- my $msg = __PACKAGE__->message_object($key, $part->{$key}) or next;
+ my $msg = __PACKAGE__->message_object($part->{$key}) or next;
push @messages, $msg;
+ my $bgm = $msg->xpath('BGM') or $logger->warn("EDI No BGM segment found?!");
my $tag4343 = $msg->xpath('BGM/4343');
my $tag1225 = $msg->xpath('BGM/1225');
if (ref $tag4343) {
@@ -502,14 +550,16 @@
sub message_object {
my $class = shift;
- my $key = shift or return;
my $body = shift or return;
+ my $key = shift if @_;
+ my $keystring = $key || 'UNSPECIFIED';
my $msg = Business::EDI::Message->new($body);
unless ($msg) {
- $logger->error("EDI interchange message: $key body failed Business::EDI constructor. Skipping it.");
+ $logger->error("EDI interchange message: $keystring body failed Business::EDI constructor. Skipping it.");
return;
}
+ $key = $msg->code if ! $key; # Now we set the key for reference if it wasn't specified
my $val_0065 = $msg->xpath_value('UNH/S009/0065') || '';
unless ($val_0065 eq $key) {
$logger->error("EDI $key UNH/S009/0065 ('$val_0065') conflicts w/ message type $key. Aborting");
@@ -537,6 +587,8 @@
my $line_item = OpenILS::Application::Acq::EDI->eg_li($edi_line);
+$server is a RemoteAccount object
+
Updates:
acq.lineitem.estimated_unit_price,
acq.lineitem.state (dependent on mapping codes),
@@ -585,7 +637,7 @@
}); # Could send more {options}
if (! $li or ref($li) ne 'Fieldmapper::acq::lineitem') {
- $logger->error("EDI failed to retrieve lineitem by id '$id' for server " . $server->remote_host);
+ $logger->error("EDI failed to retrieve lineitem by id '$id' for server " . ($server->{remote_host} || $server->{host} || Dumper($server)));
return;
}
unless ((! $server) or (! $server->provider)) {
Modified: trunk/Open-ILS/src/support-scripts/edi_fetcher.pl
===================================================================
--- trunk/Open-ILS/src/support-scripts/edi_fetcher.pl 2010-09-15 05:25:01 UTC (rev 17683)
+++ trunk/Open-ILS/src/support-scripts/edi_fetcher.pl 2010-09-15 05:25:02 UTC (rev 17684)
@@ -21,59 +21,163 @@
use vars qw/$debug/;
use OpenILS::Application::Acq::EDI;
-use OpenILS::Utils::CStoreEditor; # needs init() after IDL is loaded (by Cronscript session)
use OpenILS::Utils::Cronscript;
+use File::Spec;
-INIT {
- $debug = 1;
-}
+my $defaults = {
+ "account=i" => 0,
+ "provider=i" => 0,
+ "inactive" => 0,
+ "test" => 0,
+};
-OpenILS::Utils::Cronscript->new()->session('open-ils.acq') or die "No session created";
-OpenILS::Utils::CStoreEditor::init();
+my $core = OpenILS::Utils::Cronscript->new($defaults);
+my $opts = $core->MyGetOptions() or die "Getting options failed!";
+my $e = $core->editor();
+my $debug = $opts->{debug};
-sub editor {
- my $ed = OpenILS::Utils::CStoreEditor->new(@_) or die "Failed to get new CStoreEditor";
- return $ed;
+if ($debug) {
+ print join "\n", "OPTIONS:", map {sprintf "%16s: %s", $_, $opts->{$_}} sort keys %$opts;
+ print "\n\n";
}
+sub main_search {
+ my $select = {'+acqpro' => {active => {"in"=>['t','f']}} }; # either way
+ my %args = @_ ? @_ : ();
+ foreach (keys %args) {
+ $select->{$_} = $args{$_};
+ }
+ return $e->search_acq_edi_account([
+ $select,
+ {
+ 'join' => 'acqpro',
+ flesh => 1,
+ flesh_fields => {acqedi => ['provider']},
+ }
+ ]);
+}
-my $e = editor();
-my $set = $e->retrieve_all_acq_edi_account();
+my $set = main_search() or die "No EDI accounts found in database (table: acq.edi_account)";
+
my $total_accts = scalar(@$set);
($total_accts) or die "No EDI accounts found in database (table: acq.edi_account)";
-print "EDI Accounts Total : ", scalar(@$set), "\n";
+print "EDI Accounts Total : $total_accts\n";
+my $active = [ grep {$_->provider->active eq 't'} @$set ];
+print "EDI Accounts Active: ", scalar(@$active), "\n";
-my $subset = $e->search_acq_edi_account([
- {'+acqpro' => {active => 't'}},
- {
- 'join' => 'acqpro',
- flesh => 1,
- flesh_fields => {acqedi => ['provider']},
+my $subset;
+if ($opts->{inactive} or $opts->{provider} or $opts->{account}) {
+ print "Including inactive accounts\n";
+ $subset = [@$set];
+} else {
+ $subset = $active;
+}
+
+my ($acct, $pro);
+if ($opts->{provider}) {
+ print "Limiting by provider: " . $opts->{provider} . "\n";
+ $pro = $e->retrieve_acq_provider($opts->{provider}) or die "provider '" . $opts->{provider} . "' not found";
+ printf "Provider %s found (edi_default %s)\n", $pro->id, $pro->edi_default;
+ $subset = main_search( 'id' => $pro->edi_default );
+ # $subset = [ grep {$_->provider->id == $opts->{provider}} @$subset ];
+ foreach (@$subset) {
+ $_->provider($pro); # force provider match (short of LEFT JOINing the main_search query and dealing w/ multiple combos)
}
-]);
+ scalar(@$subset) or die "provider '" . $opts->{provider} . "' edi_default invalid (failed to match acq.edi_account.id)";
+ if ($opts->{account} and $opts->{account} != $pro->edi_default) {
+ die sprintf "ERROR: --provider=%s and --account=%s specify rows that exist, but are not paired by acq.provider.edi_default", $opts->{provider}, $opts->{account};
+ }
+ $acct = $subset->[0];
+}
+if ($opts->{account}) {
+ print "Limiting by account: " . $opts->{account} . "\n";
+ $subset = [ grep {$opts->{account} == $_->id} @$subset ];
+ scalar(@$subset) or die "No acq.provider.edi_default matches option --account=" . $opts->{account} . " ";
+ scalar(@$subset) > 1 and warn "account '" . $opts->{account} . "' has multiple matches. Ignoring all but the first.";
+ $acct = $subset->[0];
+}
+scalar(@$subset) or die "No acq.provider rows match options " .
+ ($opts->{account} ? ("--account=" . $opts->{account} ) : '') .
+ ($opts->{provider} ? ("--provider=" . $opts->{provider}) : '') ;
-print "EDI Accounts Active: ", scalar(@$subset), "\n";
+print "Limiting to " . scalar(@$subset) . " account(s)\n";
+foreach (@$subset) {
+ printf "Provider %s - %s, edi_account %s - %s: %s\n", $_->provider->id, $_->provider->name, $_->id, $_->label, $_->host;
+}
-my $res = OpenILS::Application::Acq::EDI->retrieve_core();
+if (@ARGV) {
+ $opts->{provider} or $opts->{account}
+ or die "ERROR: --account=[ID] or --provider=[ID] option required for local data ingest, with valid edi_account or provider id";
+ print "READING FROM ", scalar(@ARGV), " LOCAL SOURCE(s) ONLY. NO REMOTE SERVER(s) WILL BE USED\n";
+ printf "File will be attributed to edi_account %s - %s: %s\n", $acct->id, $acct->label, $acct->host;
+ my @files = @ARGV; # copy original @ARGV
+ foreach (@files) {
+ @ARGV = ($_); # We'll use the diamond op, so we can pull from STDIN too
+ my $content = join '', <> or next;
+ $opts->{test} and next;
+ my $in = OpenILS::Application::Acq::EDI->process_retrieval(
+ $content,
+ "localhost:" . File::Spec->rel2abs($_),
+ OpenILS::Application::Acq::EDI->remote_account($acct),
+ $acct,
+ $e
+ );
+ }
+ exit;
+}
+# else no args
+
+my $res = $opts->{test} ? [] : OpenILS::Application::Acq::EDI->retrieve_core($subset);
print "Files retrieved: ", scalar(@$res), "\n";
$debug and print "retrieve_core returns ", scalar(@$res), " ids: " . join(', ', @$res), "\n";
+# $Data::Dumper::Indent = 1;
$debug and print map {Dumper($_) . "\n"} @$subset;
print "\ndone\n";
__END__
-=head1 edi_fetcher.pl - A script for retrieving and processing EDI files from remote accounts.
+=pod
-Note: This script is expected to be run via crontab.
+=head1 NAME
-Note: Depending on your vendors and you own network environment, you may want to set/export
+edi_fetcher.pl - A script for retrieving and processing EDI files from remote accounts.
+
+=head1 DESCRIPTION
+
+This script is expected to be run via crontab, for the purpose of retrieving vendor EDI files.
+
+Note: Depending on your vendors' and your own network environments, you may want to set/export
the environmental variable FTP_PASSIVE like:
export FTP_PASSIVE=1
# or
FTP_PASSIVE=1 Open-ILS/src/support-scripts/edi_fetcher.pl
+=head1 OPTIONS
+ --account=[id] Target one account, whether or not it is inactive.
+ --inactive Includes inactive provider accounts (default OFF, forced ON if --account specified)
+
+=head1 ARGUMENTS
+
+edi_fetcher can also read from files specified as arguments on the command line, or from STDIN, or both.
+In such cases, the filename is not used to check whether the file has been loaded or not.
+
+=head1 TODO
+
+More docs here.
+
+=head1 SEE ALSO
+
+ OpenILS::Utils::Cronscript
+ edi_pusher.pl
+
+=head1 AUTHOR
+
+Joe Atzberger <jatzberger at esilibrary.com>
+
+=cut
+
More information about the open-ils-commits
mailing list