From 81bb29148d66f259f57b159d5209d58c27df7df7 Mon Sep 17 00:00:00 2001 From: atz Date: Wed, 15 Sep 2010 05:25:02 +0000 Subject: [PATCH] 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. git-svn-id: svn://svn.open-ils.org/ILS/trunk@17684 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- Open-ILS/src/edi_translator/test_client.pl | 19 ++- .../perlmods/OpenILS/Application/Acq/EDI.pm | 116 +++++++++---- Open-ILS/src/support-scripts/edi_fetcher.pl | 154 +++++++++++++++--- 3 files changed, 225 insertions(+), 64 deletions(-) diff --git a/Open-ILS/src/edi_translator/test_client.pl b/Open-ILS/src/edi_translator/test_client.pl index c47197946e..41ea047d43 100755 --- a/Open-ILS/src/edi_translator/test_client.pl +++ b/Open-ILS/src/edi_translator/test_client.pl @@ -88,9 +88,20 @@ if ($command eq 'json2edi' or $command eq 'edi2json' or $command eq 'edi2perl') } 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 @@ if ($command eq 'json2edi' or $command eq 'edi2json' or $command eq 'edi2perl') } 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; } diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm index 5e7adc2283..9f53ea1d49 100644 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm +++ b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm @@ -80,7 +80,7 @@ __PACKAGE__->register_method( ); 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 @@ sub retrieve_core { 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 @@ sub retrieve_core { 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 @@ sub retrieve_vendors { $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 @@ sub remote_account { ); } +# 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 @@ sub process_jedi { # 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 @@ sub process_jedi { $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 process_jedi { 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 @@ sub message_object { 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 @@ sub eg_li { }); # 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)) { diff --git a/Open-ILS/src/support-scripts/edi_fetcher.pl b/Open-ILS/src/support-scripts/edi_fetcher.pl index cdeac7c453..287ed7b7ec 100755 --- a/Open-ILS/src/support-scripts/edi_fetcher.pl +++ b/Open-ILS/src/support-scripts/edi_fetcher.pl @@ -21,59 +21,163 @@ use Data::Dumper; 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; - -INIT { - $debug = 1; +use File::Spec; + +my $defaults = { + "account=i" => 0, + "provider=i" => 0, + "inactive" => 0, + "test" => 0, +}; + +my $core = OpenILS::Utils::Cronscript->new($defaults); +my $opts = $core->MyGetOptions() or die "Getting options failed!"; +my $e = $core->editor(); +my $debug = $opts->{debug}; + +if ($debug) { + print join "\n", "OPTIONS:", map {sprintf "%16s: %s", $_, $opts->{$_}} sort keys %$opts; + print "\n\n"; } -OpenILS::Utils::Cronscript->new()->session('open-ils.acq') or die "No session created"; -OpenILS::Utils::CStoreEditor::init(); - -sub editor { - my $ed = OpenILS::Utils::CStoreEditor->new(@_) or die "Failed to get new CStoreEditor"; - return $ed; +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 $set = main_search() or die "No EDI accounts found in database (table: acq.edi_account)"; -my $e = editor(); -my $set = $e->retrieve_all_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 "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; +} -print "EDI Accounts Active: ", scalar(@$subset), "\n"; +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 = OpenILS::Application::Acq::EDI->retrieve_core(); +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 + +=head1 NAME -Note: This script is expected to be run via crontab. +edi_fetcher.pl - A script for retrieving and processing EDI files from remote accounts. -Note: Depending on your vendors and you own network environment, you may want to set/export +=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 + +=cut -- 2.43.2