1 package OpenILS::Application::Acq::EDI;
2 use base qw/OpenILS::Application/;
4 use strict; use warnings;
8 use OpenSRF::AppSession;
9 use OpenSRF::EX qw/:try/;
10 use OpenSRF::Utils::Logger qw(:logger);
11 use OpenSRF::Utils::JSON;
13 use OpenILS::Utils::RemoteAccount;
14 use OpenILS::Utils::CStoreEditor q/new_editor/;
15 use OpenILS::Utils::Fieldmapper;
16 use OpenILS::Application::Acq::EDI::Translator;
22 my($class, %args) = @_;
23 my $self = bless(\%args, $class);
31 return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_);
35 host => 'remote_host',
36 username => 'remote_user',
37 password => 'remote_password',
38 account => 'remote_account',
39 # in_dir => 'remote_path', # field_map overrides path with in_dir
40 path => 'remote_path',
44 ## Just for debugging stuff:
46 my ($self, $conn) = @_;
47 my $e = new_editor(xact=>1);
48 my $incoming = Fieldmapper::acq::edi_message->new;
49 $incoming->edi("This is content");
50 $incoming->account(1);
51 $incoming->remote_file('in/some_file.edi');
52 $e->create_acq_edi_message($incoming);;
55 # __PACKAGE__->register_method( method => 'add_a_msg', api_name => 'open-ils.acq.edi.add_a_msg'); # debugging
57 __PACKAGE__->register_method(
59 api_name => 'open-ils.acq.edi.retrieve',
61 desc => 'Fetch incoming message(s) from EDI accounts. ' .
62 'Optional arguments to restrict to one vendor and/or a max number of messages. ' .
63 'Note that messages are not parsed or processed here, just fetched and translated.',
65 {desc => 'Authentication token', type => 'string'},
66 {desc => 'Vendor ID (undef for "all")', type => 'number'},
67 {desc => 'Date Inactive Since', type => 'string'},
68 {desc => 'Max Messages Retrieved', type => 'number'}
71 desc => 'List of new message IDs (empty if none)',
78 my ($self, $e, $set, $max) = @_; # $e is a working editor
81 $set ||= __PACKAGE__->retrieve_vendors($e);
85 foreach my $account (@$set) {
88 $logger->info("EDI check for vendor " . ++$vcount . " of " . scalar(@$set) . ": " . $account->host);
89 unless ($server = __PACKAGE__->remote_account($account)) { # assignment, not comparison
90 $logger->err(sprintf "Failed remote account connection for %s (%s)", $account->host, $account->id);
93 my @files = $server->ls({remote_file => ($account->in_dir || '.')});
94 my @ok_files = grep {$_ !~ /\/\.?\.$/ } @files;
95 $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, ($account->in_dir || ''));
98 $max and $count > $max and last;
100 my $io = IO::Scalar->new(\$content);
101 unless ($server->get({remote_file => $_, local_file => $io})) {
102 $logger->error("(S)FTP get($_) failed");
105 my $incoming = Fieldmapper::acq::edi_message->new;
106 $incoming->remote_file($_);
107 $incoming->edi($content);
108 $incoming->account($account->id);
109 __PACKAGE__->attempt_translation($incoming);
111 $e->create_acq_edi_message($incoming);
113 __PACKAGE__->record_activity($account, $e);
114 __PACKAGE__->process_jedi($incoming, $e);
115 # $server->delete(remote_file => $_); # delete remote copies of saved message
116 push @return, $incoming->id;
123 # $account is a Fieldmapper object for acq.edi_account row
124 # $messageset is an arrayref with acq.edi_message.id values
125 # $e is optional editor object
127 my ($class, $account, $message_ids, $e) = @_; # $e is a working editor
129 ($account and scalar @$message_ids) or return;
132 my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids;
133 my $m_count = scalar(@messageset);
134 (scalar(@$message_ids) == $m_count) or
135 $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)");
137 my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host;
138 $logger->info("$log_str: $m_count message(s)");
143 unless ($server = __PACKAGE__->remote_account($account, 1)) { # assignment, not comparison
144 $logger->error("Failed remote account connection for $log_str");
147 foreach (@messageset) {
148 $_ or next; # we already warned about bum ids
151 $error = "Server error: Failed remote account connection for $log_str"; # already told $logger, this is to update object below
152 } elsif (! $_->edi) {
153 $logger->error("Message (id " . $_->id. ") for $log_str has no EDI content");
154 $error = "EDI empty!";
155 } elsif ($res = $server->put({remote_path => $account->path, content => $_->edi})) {
156 # This is the successful case!
157 $_->remote_file($res);
158 $_->status('complete');
159 $_->process_time('NOW'); # For outbound files, sending is the end of processing on the EG side.
160 $logger->info("Sent message (id " . $_->id. ") via $log_str");
162 $logger->error("(S)FTP put to $log_str FAILED: " . ($server->error || 'UNKOWNN'));
163 $error = "put FAILED: " . ($server->error || 'UNKOWNN');
167 $_->error_time('NOW');
169 $logger->info("Calling update_acq_edi_message");
171 unless ($e->update_acq_edi_message($_)) {
172 $logger->error("EDI send_core update_acq_edi_message failed for message object: " . Dumper($_));
173 OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_ ), '/tmp/update_acq_edi_message.FAIL');
174 OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_->to_bare_hash), '/tmp/update_acq_edi_message.FAIL.to_bare_hash');
176 # There's always an update, even if we failed.
178 __PACKAGE__->record_activity($account, $e); # There's always an update, even if we failed.
183 # attempt_translation does not touch the DB, just the object.
184 sub attempt_translation {
185 my ($class, $edi_message, $to_edi) = @_;
186 my $tran = translator();
187 my $ret = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi);
188 # $logger->error("json: " . Dumper($json)); # debugging
189 if (not $ret or (! ref($ret)) or $ret->is_fault) { # RPC::XML::fault on failure
190 $edi_message->status('trans_error');
191 $edi_message->error_time('NOW');
192 my $pre = "EDI Translator " . ($to_edi ? 'json2edi' : 'edi2json') . " failed";
193 my $message = ref($ret) ?
194 ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) :
195 ("$pre: " . __PACKAGE__->nice_string($ret) ) ;
196 $edi_message->error($message);
197 $logger->error( $message);
200 $edi_message->status('translated');
201 $edi_message->translate_time('NOW');
203 $edi_message->edi($ret->value); # translator returns an object
205 $edi_message->jedi($ret->value); # translator returns an object
210 sub retrieve_vendors {
211 my ($self, $e, $vendor_id, $last_activity) = @_; # $e is a working editor
215 my $criteria = {'+acqpro' => {active => 't'}};
216 # $criteria->{vendor_id} = $vendor_id if $vendor_id;
217 return $e->search_acq_edi_account([
222 acqedi => ['provider']
226 # {"id":{"!=":null},"+acqpro":{"active":"t"}}, {"join":"acqpro", "flesh_fields":{"acqedi":["provider"]},"flesh":1}
229 # This is the SRF-exposed call, so it does checkauth
232 my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_;
234 my $e = new_editor(authtoken=>$auth);
235 unless ($e and $e->checkauth()) {
236 $logger->warn("checkauth failed for authtoken '$auth'");
239 # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency); # add permission here ?
241 my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event;
242 return __PACKAGE__->retrieve_core($e, $set, $max);
246 # field_map takes the hashref of vendor data with fields from acq.edi_account and
247 # maps them to the argument style needed for RemoteAccount. It also extrapolates
248 # data from the remote_host string for type and port, when available.
252 my $vendor = shift or return;
253 my $no_override = @_ ? shift : 0;
255 $verbose and $logger->warn("vendor: " . Dumper($vendor));
256 foreach (keys %map) {
257 $args{$map{$_}} = $vendor->$_ if defined $vendor->$_;
259 unless ($no_override) {
260 $args{remote_path} = $vendor->in_dir; # override "path" with "in_dir"
262 my $host = $args{remote_host} || '';
263 ($host =~ /^(S?FTP):/i and $args{type} = uc($1)) or
264 ($host =~ /^(SSH|SCP):/i and $args{type} = 'SCP' ) ;
265 $host =~ /:(\d+)$/ and $args{port} = $1;
266 $verbose and $logger->warn("field_map: " . Dumper(\%args));
271 # The point of remote_account is to get the RemoteAccount object with args from the DB
274 my ($self, $vendor, $outbound, $e) = @_;
276 unless (ref($vendor)) { # It's not a hashref/object.
277 $vendor or return; # If in fact it's nothing: abort!
278 # else it's a vendor_id string, so get the full vendor data
280 my $set_of_one = $self->retrieve_vendors($e, $vendor) or return;
281 $vendor = shift @$set_of_one;
284 return OpenILS::Utils::RemoteAccount->new(
285 $self->field_map($vendor, $outbound)
289 sub record_activity {
290 my ($class, $account, $e) = @_;
293 $logger->info("EDI record_activity calling update_acq_edi_account");
294 $account->last_activity('NOW') or return;
296 $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED");
303 my $string = shift or return '';
305 my $head = @_ ? shift : 100;
306 my $tail = @_ ? shift : 25;
307 (length($string) < $head + $tail) and return $string;
308 my $h = substr($string,0,$head);
309 my $t = substr($string, -1*$tail);
313 # return substr($string,0,$head) . "... " . substr($string, -1*$tail);
317 my ($class, $jedi) = @_;
319 my $msg = OpenSRF::Utils::JSON->JSON2perl( $jedi );
320 open (FOO, ">>/tmp/joe_jedi_dump.txt");
321 print FOO Dumper($msg), "\n\n";
323 $logger->warn("Dumped JSON2perl to /tmp/JSON2perl_dump.txt");
327 # ->process_jedi($message, $e)
330 my $message = shift or return;
331 my $jedi = ref($message) ? $message->jedi : $message; # If we got an object, it's an edi_message. A string is the jedi content itself.
333 $logger->warn("EDI process_jedi missing required argument (edi_message object with jedi or jedi scalar)!");
336 my $perl = __PACKAGE__->jedi2perl($jedi);
337 if (ref($message) and not $perl) {
338 my $e = @_ ? shift : new_editor();
339 $message->error(($message->error || '') . " JSON2perl FAILED to convert jedi");
340 $message->error_time('NOW');
342 $e->udpate_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message failed! $!");
345 # __PACKAGE__->process_eval_msg(__PACKAGE__->jedi2perl($jedi), @_);
346 return $perl; # TODO process perl
349 sub process_eval_msg {
350 my ($class, $msg, $e) = @_;
353 ## Do all the hard work.
354 # ID the message type
356 # update POs & lineitems(?)