[open-ils-commits] r17688 - in trunk/Open-ILS/src: perlmods/OpenILS/Application/Acq support-scripts (atz)
svn at svn.open-ils.org
svn at svn.open-ils.org
Wed Sep 15 01:25:09 EDT 2010
Author: atz
Date: 2010-09-15 01:25:05 -0400 (Wed, 15 Sep 2010)
New Revision: 17688
Modified:
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm
trunk/Open-ILS/src/support-scripts/edi_fetcher.pl
Log:
Deepen test mode feedback (into top level EDI function)
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:04 UTC (rev 17687)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm 2010-09-15 05:25:05 UTC (rev 17688)
@@ -80,7 +80,7 @@
);
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 @@
$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 @@
$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 @@
$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 @@
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:
Modified: trunk/Open-ILS/src/support-scripts/edi_fetcher.pl
===================================================================
--- trunk/Open-ILS/src/support-scripts/edi_fetcher.pl 2010-09-15 05:25:04 UTC (rev 17687)
+++ trunk/Open-ILS/src/support-scripts/edi_fetcher.pl 2010-09-15 05:25:05 UTC (rev 17688)
@@ -104,7 +104,8 @@
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 @@
}
# 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";
More information about the open-ils-commits
mailing list