From 6ee978af46425c2947906a95c19172358aa08d83 Mon Sep 17 00:00:00 2001 From: atz Date: Wed, 15 Sep 2010 05:25:05 +0000 Subject: [PATCH] Deepen test mode feedback (into top level EDI function) git-svn-id: svn://svn.open-ils.org/ILS/trunk@17688 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- .../src/perlmods/OpenILS/Application/Acq/EDI.pm | 57 +++++++++++++--------- Open-ILS/src/support-scripts/edi_fetcher.pl | 5 +- 2 files changed, 38 insertions(+), 24 deletions(-) diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm index 9f53ea1d4..9b4e43ee7 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, $set, $max, $e) = @_; # $e is a working editor + my ($self, $set, $max, $e, $test) = @_; # $e is a working editor $e ||= new_editor(); $set ||= __PACKAGE__->retrieve_vendors($e); @@ -95,22 +95,22 @@ sub retrieve_core { $logger->err(sprintf "Failed remote account mapping for %s (%s)", $account->host, $account->id); next; }; - my $rf_starter = ''; +# my $rf_starter = './'; # default to current dir 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) +# $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 @files = ($server->ls({remote_file => ($account->in_dir || './')})); 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 . $_; + $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, $account->in_dir); + # $server->remote_path(undef); + foreach my $remote_file (@ok_files) { + # my $remote_file = $rf_starter . $_; my $description = sprintf "%s/%s", $account->host, $remote_file; # deduplicate vs. acct/filenames already in DB @@ -134,13 +134,17 @@ sub retrieve_core { $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; + if ($test) { + push @return, "test_$count"; + next; + } my $content; my $io = IO::Scalar->new(\$content); unless ( $server->get({remote_file => $remote_file, local_file => $io}) ) { $logger->error("(S)FTP get($description) failed"); next; } - my $incoming = __PACKAGE__->process_retrieval($content, $_, $server, $account->id, $e); + my $incoming = __PACKAGE__->process_retrieval($content, $remote_file, $server, $account->id, $e); # $server->delete(remote_file => $_); # delete remote copies of saved message push @return, $incoming->id; } @@ -170,7 +174,13 @@ sub process_retrieval { $e->xact_begin; $e->create_acq_edi_message($incoming); $e->xact_commit; - __PACKAGE__->process_jedi($incoming, $server, $e); + my $res = __PACKAGE__->process_jedi($incoming, $server, $e); + $incoming->status($res ? 'processed' : 'proc_error'); + if ($res) { + $e->xact_begin; + $e->update_acq_edi_message($incoming); + $e->xact_commit; + } return $incoming; } @@ -397,23 +407,26 @@ sub process_jedi { return; } my $e = @_ ? shift : new_editor(); - my $perl = __PACKAGE__->jedi2perl($jedi); + my $perl = __PACKAGE__->jedi2perl($jedi); + my $error = ''; if (ref($message) and not $perl) { - $message->error(($message->error || '') . " JSON2perl (jedi2perl) FAILED to convert jedi"); + $error = ($message->error || '') . " JSON2perl (jedi2perl) FAILED to convert jedi"; + } + elsif (! $perl->{body}) { + $error = "EDI interchange body not found!"; + } + elsif (! $perl->{body}->[0]) { + $error = "EDI interchange body not a populated arrayref!"; + } + if ($error) { + $logger->warn($error); + $message->error($error); $message->error_time('NOW'); $e->xact_begin; $e->udpate_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message failed! $!"); $e->xact_commit; return; } - if (! $perl->{body}) { - $logger->warn("EDI interchange body not found!"); - return; - } - if (! $perl->{body}->[0]) { - $logger->warn("EDI interchange body not a populated arrayref!"); - return; - } # Crazy data structure. Most of the arrays will be 1 element... we think. # JEDI looks like: diff --git a/Open-ILS/src/support-scripts/edi_fetcher.pl b/Open-ILS/src/support-scripts/edi_fetcher.pl index 287ed7b7e..3339f4e27 100755 --- a/Open-ILS/src/support-scripts/edi_fetcher.pl +++ b/Open-ILS/src/support-scripts/edi_fetcher.pl @@ -104,7 +104,8 @@ scalar(@$subset) or die "No acq.provider rows match options " . 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; + printf "Provider %s - %s, edi_account %s - %s: %s%s\n", + $_->provider->id, $_->provider->name, $_->id, $_->label, $_->host, ($_->in_dir ? ('/' . $_->in_dir) : '') ; } if (@ARGV) { @@ -129,7 +130,7 @@ if (@ARGV) { } # else no args -my $res = $opts->{test} ? [] : OpenILS::Application::Acq::EDI->retrieve_core($subset); +my $res = OpenILS::Application::Acq::EDI->retrieve_core($subset,undef,undef,$opts->{test}); print "Files retrieved: ", scalar(@$res), "\n"; $debug and print "retrieve_core returns ", scalar(@$res), " ids: " . join(', ', @$res), "\n"; -- 2.11.0