[open-ils-commits] r15606 - in trunk/Open-ILS: examples src/perlmods/OpenILS/Application src/perlmods/OpenILS/Application/Acq src/perlmods/OpenILS/Application/Acq/EDI src/perlmods/OpenILS/Application/Trigger src/perlmods/OpenILS/Utils src/sql/Pg src/sql/Pg/upgrade (erickson)
svn at svn.open-ils.org
svn at svn.open-ils.org
Sun Feb 21 21:59:36 EST 2010
Author: erickson
Date: 2010-02-21 21:59:34 -0500 (Sun, 21 Feb 2010)
New Revision: 15606
Added:
trunk/Open-ILS/src/sql/Pg/upgrade/0166.schema.acq_edi_message.sql
trunk/Open-ILS/src/sql/Pg/upgrade/0167.data.event_definition_po_jedi.sql
Modified:
trunk/Open-ILS/examples/fm_IDL.xml
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm
trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor.pm
trunk/Open-ILS/src/perlmods/OpenILS/Utils/CStoreEditor.pm
trunk/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm
trunk/Open-ILS/src/perlmods/OpenILS/Utils/Editor.pm
trunk/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm
trunk/Open-ILS/src/sql/Pg/002.schema.config.sql
trunk/Open-ILS/src/sql/Pg/005.schema.actors.sql
Log:
Patch from Joe Atzberger to implement much of the plumbing for EDI support. It includes
fixes for remote account handling, EDI JEDI event_def, an edi_message table, CstoreEditor
init fixes
Modified: trunk/Open-ILS/examples/fm_IDL.xml
===================================================================
--- trunk/Open-ILS/examples/fm_IDL.xml 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/examples/fm_IDL.xml 2010-02-22 02:59:34 UTC (rev 15606)
@@ -3078,6 +3078,7 @@
<field name="street1" reporter:datatype="text"/>
<field name="street2" reporter:datatype="text"/>
<field name="valid" reporter:datatype="bool"/>
+ <field name="san" reporter:datatype="text" reporter:label="SAN"/>
</fields>
<links>
<link field="org_unit" reltype="has_a" key="id" map="" class="aou"/>
@@ -5411,6 +5412,39 @@
</permacrud>
</class>
+ <class id="acqedim" controller="open-ils.cstore open-ils.pcrud" oils_obj:fieldmapper="acq::edi_message" oils_persist:tablename="acq.edi_message" reporter:label="EDI Message">
+ <fields oils_persist:primary="id" oils_persist:sequence="acq.edi_message_id_seq">
+ <field name="id" reporter:datatype="id" reporter:label="EDI Message ID"/>
+ <field name="account" reporter:datatype="link" reporter:label="EDI Account"/>
+ <field name="remote_file" reporter:datatype="text" reporter:label="Filename"/>
+ <field name="create_time" reporter:datatype="timestamp" reporter:label="Time Created"/>
+ <field name="translate_time" reporter:datatype="timestamp" reporter:label="Time Translated"/>
+ <field name="process_time" reporter:datatype="timestamp" reporter:label="Time Processed"/>
+ <field name="error_time" reporter:datatype="timestamp" reporter:label="Time of Error"/>
+ <field name="status" reporter:datatype="text" reporter:label="Status"/>
+ <field name="edi" reporter:datatype="text" reporter:label="EDI Message Body"/>
+ <field name="jedi" reporter:datatype="text" reporter:label="JEDI Message Body"/>
+ <field name="error" reporter:datatype="text" reporter:label="Error"/>
+ </fields>
+ <links>
+ <link field="account" reltype="has_a" key="id" map="" class="acqedi"/>
+ </links>
+ <permacrud xmlns="http://open-ils.org/spec/opensrf/IDL/permacrud/v1">
+ <actions>
+ <retrieve permission="ADMIN_PROVIDER MANAGE_PROVIDER VIEW_PROVIDER">
+ <context link="account" jump="provider" field="owner"/>
+ </retrieve>
+ <update permission="ADMIN_PROVIDER MANAGE_PROVIDER VIEW_PROVIDER">
+ <context link="account" jump="provider" field="owner"/>
+ </update>
+ <delete permission="ADMIN_PROVIDER MANAGE_PROVIDER VIEW_PROVIDER">
+ <context link="account" jump="provider" field="owner"/>
+ </delete>
+ </actions>
+ </permacrud>
+ </class>
+
+
<class id="rof" controller="open-ils.reporter-store" oils_obj:fieldmapper="reporter::output_folder" oils_persist:tablename="reporter.output_folder" reporter:label="Output Folder">
<fields oils_persist:primary="id" oils_persist:sequence="reporter.output_folder_id_seq">
<field name="id" reporter:datatype="id" />
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm 2010-02-22 02:59:34 UTC (rev 15606)
@@ -41,12 +41,27 @@
return $self->{client} ||= RPC::XML::Client->new($self->{host}); # TODO: auth
}
+sub debug_file {
+ my $self = shift;
+ my $text = shift;
+ my $filename = @_ ? shift : ('/tmp/' . __PACKAGE__ . '_unknown.tmp');
+ unless (open (TMP_EDI, ">$filename")) {
+ warn "Cannot write $filename: $!";
+ return;
+ }
+ print TMP_EDI $text, "\n";
+ close TMP_EDI;
+ return 1;
+}
+
sub json2edi {
my $self = shift;
my $text = shift;
+ $self->debug_file($text, '/tmp/perl_json2edi.tmp');
my $client = $self->client();
$self->{verbose} and print "Trying json2edi on host: $self->{host}\n";
- my $resp = $client->send_request('edi2json', $text);
+ $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
+ my $resp = $client->send_request('json2edi', $text);
$self->{verbose} and print Dumper($resp);
return $resp;
}
@@ -54,9 +69,11 @@
sub edi2json {
my $self = shift;
my $text = shift;
+ $self->debug_file($text, '/tmp/perl_edi2json.tmp');
my $client = $self->client();
$self->{verbose} and print "Trying edi2json on host: $self->{host}\n";
- my $resp = $client->send_request('json2edi', $text);
+ $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
+ my $resp = $client->send_request('edi2json', $text);
$self->{verbose} and print Dumper($resp);
return $resp;
}
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm 2010-02-22 02:59:34 UTC (rev 15606)
@@ -3,17 +3,20 @@
use strict; use warnings;
+use IO::Scalar;
+
use OpenSRF::AppSession;
use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenSRF::Utils::JSON;
+
+use OpenILS::Utils::RemoteAccount;
+use OpenILS::Utils::CStoreEditor q/new_editor/;
+use OpenILS::Utils::Fieldmapper;
use OpenILS::Application::Acq::EDI::Translator;
-# use OpenILS::Event;
-use OpenSRF::Utils::Logger qw(:logger);
-# use OpenSRF::Utils::JSON;
-# use OpenILS::Utils::Fieldmapper;
-# use OpenILS::Utils::CStoreEditor q/:funcs/;
-# use OpenILS::Const qw/:const/;
-# use OpenILS::Application::AppUtils;
+use Data::Dumper;
+our $verbose = 0;
sub new {
my($class, %args) = @_;
@@ -28,6 +31,29 @@
return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_);
}
+my %map = (
+ host => 'remote_host',
+ username => 'remote_user',
+ password => 'remote_password',
+ account => 'remote_account',
+ # in_dir => 'remote_path', # field_map overrides path with in_dir
+ path => 'remote_path',
+);
+
+
+## Just for debugging stuff:
+sub add_a_msg {
+ my ($self, $conn) = @_;
+ my $e = new_editor(xact=>1);
+ my $incoming = Fieldmapper::acq::edi_message->new;
+ $incoming->edi("This is content");
+ $incoming->account(1);
+ $incoming->remote_file('in/some_file.edi');
+ $e->create_acq_edi_message($incoming);;
+ $e->commit;
+}
+# __PACKAGE__->register_method( method => 'add_a_msg', api_name => 'open-ils.acq.edi.add_a_msg'); # debugging
+
__PACKAGE__->register_method(
method => 'retrieve',
api_name => 'open-ils.acq.edi.retrieve',
@@ -38,6 +64,7 @@
param => [
{desc => 'Authentication token', type => 'string'},
{desc => 'Vendor ID (undef for "all")', type => 'number'},
+ {desc => 'Date Inactive Since', type => 'string'},
{desc => 'Max Messages Retrieved', type => 'number'}
],
return => {
@@ -47,59 +74,287 @@
}
);
-sub retrieve {
- my ($self, $conn, $auth, $vendor_id, $max) = @_;
+sub retrieve_core {
+ my ($self, $e, $set, $max) = @_; # $e is a working editor
+ $e ||= new_editor();
+ $set ||= __PACKAGE__->retrieve_vendors($e);
+
my @return = ();
- my $e = new_editor(xact=>1, authtoken=>$auth);
- unless ($e->checkauth) {
- $logger->warn("checkauth failed for authtoken '$auth'");
- return @return;
+ my $vcount = 0;
+ foreach my $account (@$set) {
+ my $count = 0;
+ 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);
+ 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 || ''));
+ foreach (@ok_files) {
+ ++$count;
+ $max and $count > $max and last;
+ my $content;
+ my $io = IO::Scalar->new(\$content);
+ unless ($server->get({remote_file => $_, local_file => $io})) {
+ $logger->error("(S)FTP get($_) failed");
+ next;
+ }
+ my $incoming = Fieldmapper::acq::edi_message->new;
+ $incoming->remote_file($_);
+ $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, $e);
+# $server->delete(remote_file => $_); # delete remote copies of saved message
+ push @return, $incoming->id;
+ }
}
+ return \@return;
+}
- my $criteria = {};
- $criteria->{vendor_id} = $vendor_id if $vendor_id;
- my $set = $e->search_acq_edi_account(
+# ->send_core
+# $account is a Fieldmapper object for acq.edi_account row
+# $messageset is an arrayref with acq.edi_message.id values
+# $e is optional editor object
+sub send_core {
+ my ($class, $account, $message_ids, $e) = @_; # $e is a working editor
+
+ ($account and scalar @$message_ids) or return;
+ $e ||= new_editor();
+
+ my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids;
+ my $m_count = scalar(@messageset);
+ (scalar(@$message_ids) == $m_count) or
+ $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)");
+
+ my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host;
+ $logger->info("$log_str: $m_count message(s)");
+ $m_count or return;
+
+ my $server;
+ my $server_error;
+ unless ($server = __PACKAGE__->remote_account($account, 1)) { # assignment, not comparison
+ $logger->error("Failed remote account connection for $log_str");
+ $server_error = 1;
+ };
+ foreach (@messageset) {
+ $_ or next; # we already warned about bum ids
+ my ($res, $error);
+ if ($server_error) {
+ $error = "Server error: Failed remote account connection for $log_str"; # already told $logger, this is to update object below
+ } elsif (! $_->edi) {
+ $logger->error("Message (id " . $_->id. ") for $log_str has no EDI content");
+ $error = "EDI empty!";
+ } elsif ($res = $server->put({remote_path => $account->path, content => $_->edi})) {
+ # This is the successful case!
+ $_->remote_file($res);
+ $_->status('complete');
+ $_->process_time('NOW'); # For outbound files, sending is the end of processing on the EG side.
+ $logger->info("Sent message (id " . $_->id. ") via $log_str");
+ } else {
+ $logger->error("(S)FTP put to $log_str FAILED: " . ($server->error || 'UNKOWNN'));
+ $error = "put FAILED: " . ($server->error || 'UNKOWNN');
+ }
+ if ($error) {
+ $_->error($error);
+ $_->error_time('NOW');
+ }
+ $logger->info("Calling update_acq_edi_message");
+ $e->xact_begin;
+ unless ($e->update_acq_edi_message($_)) {
+ $logger->error("EDI send_core update_acq_edi_message failed for message object: " . Dumper($_));
+ OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_ ), '/tmp/update_acq_edi_message.FAIL');
+ OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_->to_bare_hash), '/tmp/update_acq_edi_message.FAIL.to_bare_hash');
+ }
+ # There's always an update, even if we failed.
+ $e->xact_commit;
+ __PACKAGE__->record_activity($account, $e); # There's always an update, even if we failed.
+ }
+ return \@messageset;
+}
+
+# attempt_translation does not touch the DB, just the object.
+sub attempt_translation {
+ my ($class, $edi_message, $to_edi) = @_;
+ my $tran = translator();
+ my $ret = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi);
+# $logger->error("json: " . Dumper($json)); # debugging
+ if (not $ret or (! ref($ret)) or $ret->is_fault) { # RPC::XML::fault on failure
+ $edi_message->status('trans_error');
+ $edi_message->error_time('NOW');
+ my $pre = "EDI Translator " . ($to_edi ? 'json2edi' : 'edi2json') . " failed";
+ my $message = ref($ret) ?
+ ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) :
+ ("$pre: " . __PACKAGE__->nice_string($ret) ) ;
+ $edi_message->error($message);
+ $logger->error( $message);
+ return;
+ }
+ $edi_message->status('translated');
+ $edi_message->translate_time('NOW');
+ if ($to_edi) {
+ $edi_message->edi($ret->value); # translator returns an object
+ } else {
+ $edi_message->jedi($ret->value); # translator returns an object
+ }
+ return $edi_message;
+}
+
+sub retrieve_vendors {
+ my ($self, $e, $vendor_id, $last_activity) = @_; # $e is a working editor
+
+ $e ||= new_editor();
+
+ my $criteria = {'+acqpro' => {active => 't'}};
+ # $criteria->{vendor_id} = $vendor_id if $vendor_id;
+ return $e->search_acq_edi_account([
$criteria, {
+ 'join' => 'acqpro',
flesh => 1,
flesh_fields => {
+ acqedi => ['provider']
}
}
- ) or return $e->die_event;
+ ]);
+# {"id":{"!=":null},"+acqpro":{"active":"t"}}, {"join":"acqpro", "flesh_fields":{"acqedi":["provider"]},"flesh":1}
+}
- my $tran = translator();
- foreach my $account (@$set) {
- $logger->warn("EDI check for " . $account->host);
-# foreach message {
-# my $incoming = $e->create_acq_edi_message;
-# $incoming->edi($content);
-# $incoming->edi_account($account->id);
-# my $json = $tran->edi2json;
-# unless ($json) {
-# $logger->error("EDI Translator failed on $incoming->id");
-# next;
-# }
-# $incoming->json($json);
-# $e->commit;
-# delete remote copies of saved message (?)
-# push @return, $incoming->id;
-# }
+# This is the SRF-exposed call, so it does checkauth
+
+sub retrieve {
+ my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_;
+
+ my $e = new_editor(authtoken=>$auth);
+ unless ($e and $e->checkauth()) {
+ $logger->warn("checkauth failed for authtoken '$auth'");
+ return ();
}
- # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
- # $e->commit;
- return @return;
+ # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency); # add permission here ?
+
+ my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event;
+ return __PACKAGE__->retrieve_core($e, $set, $max);
}
+
+# field_map takes the hashref of vendor data with fields from acq.edi_account and
+# maps them to the argument style needed for RemoteAccount. It also extrapolates
+# data from the remote_host string for type and port, when available.
+
+sub field_map {
+ my $self = shift;
+ my $vendor = shift or return;
+ my $no_override = @_ ? shift : 0;
+ my %args = ();
+ $verbose and $logger->warn("vendor: " . Dumper($vendor));
+ foreach (keys %map) {
+ $args{$map{$_}} = $vendor->$_ if defined $vendor->$_;
+ }
+ unless ($no_override) {
+ $args{remote_path} = $vendor->in_dir; # override "path" with "in_dir"
+ }
+ my $host = $args{remote_host} || '';
+ ($host =~ /^(S?FTP):/i and $args{type} = uc($1)) or
+ ($host =~ /^(SSH|SCP):/i and $args{type} = 'SCP' ) ;
+ $host =~ /:(\d+)$/ and $args{port} = $1;
+ $verbose and $logger->warn("field_map: " . Dumper(\%args));
+ return %args;
+}
+
+
+# The point of remote_account is to get the RemoteAccount object with args from the DB
+
+sub remote_account {
+ my ($self, $vendor, $outbound, $e) = @_;
+
+ unless (ref($vendor)) { # It's not a hashref/object.
+ $vendor or return; # If in fact it's nothing: abort!
+ # else it's a vendor_id string, so get the full vendor data
+ $e ||= new_editor();
+ my $set_of_one = $self->retrieve_vendors($e, $vendor) or return;
+ $vendor = shift @$set_of_one;
+ }
+
+ return OpenILS::Utils::RemoteAccount->new(
+ $self->field_map($vendor, $outbound)
+ );
+}
+
sub record_activity {
- my $self = shift;
- my $account = shift or return;
+ my ($class, $account, $e) = @_;
+ $account or return;
+ $e ||= new_editor();
+ $logger->info("EDI record_activity calling update_acq_edi_account");
+ $account->last_activity('NOW') or return;
+ $e->xact_begin;
+ $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED");
+ $e->xact_commit;
+ return $account;
}
-sub retrieve_one {
- my $self = shift;
- my $account = shift or return;
+sub nice_string {
+ my $class = shift;
+ my $string = shift or return '';
+ chomp($string);
+ my $head = @_ ? shift : 100;
+ my $tail = @_ ? shift : 25;
+ (length($string) < $head + $tail) and return $string;
+ my $h = substr($string,0,$head);
+ my $t = substr($string, -1*$tail);
+ $h =~s/\s*$//o;
+ $t =~s/\s*$//o;
+ return "$h ... $t";
+ # return substr($string,0,$head) . "... " . substr($string, -1*$tail);
+}
+sub jedi2perl {
+ my ($class, $jedi) = @_;
+ $jedi or return;
+ my $msg = OpenSRF::Utils::JSON->JSON2perl( $jedi );
+ open (FOO, ">>/tmp/joe_jedi_dump.txt");
+ print FOO Dumper($msg), "\n\n";
+ close FOO;
+ $logger->warn("Dumped JSON2perl to /tmp/JSON2perl_dump.txt");
+ return $msg;
}
+# ->process_jedi($message, $e)
+sub process_jedi {
+ my $class = shift;
+ my $message = shift or return;
+ my $jedi = ref($message) ? $message->jedi : $message; # If we got an object, it's an edi_message. A string is the jedi content itself.
+ unless ($jedi) {
+ $logger->warn("EDI process_jedi missing required argument (edi_message object with jedi or jedi scalar)!");
+ return;
+ }
+ my $perl = __PACKAGE__->jedi2perl($jedi);
+ if (ref($message) and not $perl) {
+ my $e = @_ ? shift : new_editor();
+ $message->error(($message->error || '') . " JSON2perl FAILED to convert jedi");
+ $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;
+ }
+ # __PACKAGE__->process_eval_msg(__PACKAGE__->jedi2perl($jedi), @_);
+ return $perl; # TODO process perl
+}
+
+sub process_eval_msg {
+ my ($class, $msg, $e) = @_;
+ $msg or return;
+ $e ||= new_editor();
+## Do all the hard work.
+# ID the message type
+# Find PO references
+# update POs & lineitems(?)
+}
+
1;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm 2010-02-22 02:59:34 UTC (rev 15606)
@@ -7,5 +7,6 @@
use OpenILS::Application::Acq::Provider;
use OpenILS::Application::Acq::Lineitem;
use OpenILS::Application::Acq::Order;
+use OpenILS::Application::Acq::EDI;
1;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor.pm 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor.pm 2010-02-22 02:59:34 UTC (rev 15606)
@@ -42,6 +42,12 @@
return $str;
},
+ escape_json => sub {
+ my $str = shift;
+ $str =~ s/([\x{0080}-\x{fffd}])/sprintf('\u%0.4x',ord($1))/sgoe;
+ return $str;
+ },
+
# returns the calculated user locale
get_user_locale => sub {
my $user_id = shift;
@@ -89,7 +95,9 @@
# returns matching line item attribute, or undef
get_li_attr => sub {
- my ($name, $type, $attr) = @_;
+ my $name = shift or return; # the first arg is always the name
+ my ($type, $attr) = (scalar(@_) == 1) ? (undef, $_[0]) : @_;
+ # if the next is the last, it's the attributes, otherwise type
# use Data::Dumper; $logger->warn("get_li_attr: " . Dumper($attr));
($name and @$attr) or return;
foreach (@$attr) {
@@ -111,6 +119,7 @@
my $error;
my $output = '';
my $tt = Template->new;
+ # my $tt = Template->new(ENCODING => 'utf8'); # ??
$env->{helpers} = $_TT_helpers;
unless( $tt->process(\$env->{template}, $env, \$output) ) {
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/CStoreEditor.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/CStoreEditor.pm 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/CStoreEditor.pm 2010-02-22 02:59:34 UTC (rev 15606)
@@ -767,47 +767,22 @@
# -------------------------------------------------------------
# Load up the methods from the FM classes
# -------------------------------------------------------------
-my $map = $Fieldmapper::fieldmap;
-for my $object (keys %$map) {
- my $obj = __fm2meth($object,'_');
- my $type = __fm2meth($object, '.');
- my $update = "update_$obj";
- my $updatef =
- "sub $update {return shift()->runmethod('update', '$type', \@_);}";
- eval $updatef;
-
- my $retrieve = "retrieve_$obj";
- my $retrievef =
- "sub $retrieve {return shift()->runmethod('retrieve', '$type', \@_);}";
- eval $retrievef;
-
- my $search = "search_$obj";
- my $searchf =
- "sub $search {return shift()->runmethod('search', '$type', \@_);}";
- eval $searchf;
-
- my $create = "create_$obj";
- my $createf =
- "sub $create {return shift()->runmethod('create', '$type', \@_);}";
- eval $createf;
-
- my $delete = "delete_$obj";
- my $deletef =
- "sub $delete {return shift()->runmethod('delete', '$type', \@_);}";
- eval $deletef;
-
- my $bretrieve = "batch_retrieve_$obj";
- my $bretrievef =
- "sub $bretrieve {return shift()->runmethod('batch_retrieve', '$type', \@_);}";
- eval $bretrievef;
-
- my $retrieveall = "retrieve_all_$obj";
- my $retrieveallf =
- "sub $retrieveall {return shift()->runmethod('retrieve_all', '$type', \@_);}";
- eval $retrieveallf;
+sub init {
+ no warnings; # Here we potentially redefine subs via eval
+ my $map = $Fieldmapper::fieldmap;
+ for my $object (keys %$map) {
+ my $obj = __fm2meth($object, '_');
+ my $type = __fm2meth($object, '.');
+ foreach my $command (qw/ update retrieve search create delete batch_retrieve retrieve_all /) {
+ eval "sub ${command}_$obj {return shift()->runmethod('$command', '$type', \@_);}\n";
+ }
+ # TODO: performance test against concatenating a big string of all the subs and eval'ing only ONCE.
+ }
}
+init(); # Add very many subs to this namespace
+
sub json_query {
my( $self, $arg, $options ) = @_;
$options ||= {};
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm 2010-02-22 02:59:34 UTC (rev 15606)
@@ -35,6 +35,7 @@
use File::Basename qw/fileparse/;
use Data::Dumper;
+use Carp;
our @extra_opts = ( # additional keys are stored here
# 'addlopt'
@@ -56,7 +57,11 @@
'internal_var' => 'XYZ',
},
# lockfile => undef,
- }
+ # session => undef,
+ # bootstrapped => 0,
+ # got_options => 0,
+ auto_get_options_4_bootstrap => 1,
+ };
}
sub is_clean {
@@ -92,6 +97,7 @@
sub MyGetOptions {
my $self = shift;
+ $self->{got_options} and carp "MyGetOptions called after options were already retrieved previously";
my @keys = sort {is_clean($b) <=> is_clean($a)} keys %{$self->{default_opts}};
$debug and print "KEYS: ", join(", ", @keys), "\n";
foreach (@keys) {
@@ -112,6 +118,8 @@
$self->{lockfile_obj} = OpenILS::Utils::Lockfile->new($self->first_defined('lock-file'));
$self->{lockfile} = $self->{lockfile_obj}->filename;
}
+ $self->{got_options}++;
+ return $self;
}
sub first_defined {
@@ -137,7 +145,7 @@
my $self = _default_self;
bless ($self, $class);
$self->init(@_);
- $debug and print "new obj: ", Dumper($self);
+ $debug and print "new ", __PACKAGE__, " obj: ", Dumper($self);
return $self;
}
@@ -204,19 +212,30 @@
return "\n\nEXAMPLES:\n\n $0 --osrf-config /my/other/opensrf_core.xml\n";
}
+# the proper order is: MyGetOptions, bootstrap, session.
+# But the latter subs will check to see if they need to call the preceeding one(s).
+
sub session {
my $self = shift or return;
+ $self->{bootstrapped} or $self->bootstrap();
+ @_ or croak "session() called without required argument (app_name, e.g. 'open-ils.acq')";
return ($self->{session} ||= OpenSRF::AppSession->create(@_));
}
sub bootstrap {
my $self = shift or return;
+ if ($self->{auto_get_options_4_bootstrap} and not $self->{got_options}) {
+ $debug and print "Automatically calling MyGetOptions before bootstrap\n";
+ $self->MyGetOptions();
+ }
try {
$debug and print "bootstrap lock-file : ", $self->first_defined('lock-file'), "\n";
$debug and print "bootstrap osrf-config: ", $self->first_defined('osrf-config'), "\n";
OpenSRF::System->bootstrap_client(config_file => $self->first_defined('osrf-config'));
Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
+ $self->{bootstrapped} = 1;
} otherwise {
+ $self->{bootstrapped} = 0;
warn shift;
};
}
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/Editor.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/Editor.pm 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/Editor.pm 2010-02-22 02:59:34 UTC (rev 15606)
@@ -33,7 +33,6 @@
'action.circulation' => { retrieve => 'VIEW_CIRCULATIONS'},
);
-my $logstr;
use constant E => 'error';
use constant W => 'warn';
use constant I => 'info';
@@ -52,8 +51,6 @@
$class = ref($class) || $class;
my $self = bless( \%params, $class );
$self->{checked_perms} = {};
- $logstr = "editor [0";
- $logstr = "editor [1" if $self->{xact};
return $self;
}
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm 2010-02-22 02:59:34 UTC (rev 15606)
@@ -7,6 +7,8 @@
use Net::uFTP;
use Net::SSH2; # because uFTP doesn't handle SSH keys (yet?)
use File::Temp;
+use File::Basename;
+# use Error;
$Data::Dumper::Indent = 0;
@@ -20,17 +22,19 @@
our %keyfiles = ();
my %fields = (
+ accound_object => undef,
remote_host => undef,
remote_user => undef,
remote_password => undef,
remote_account => undef,
remote_file => undef,
+ remote_path => undef, # not really doing anything with this... yet.
ssh_privatekey => undef,
ssh_publickey => undef,
type => undef,
port => undef,
content => undef,
- localfile => undef,
+ local_file => undef,
tempfile => undef,
error => undef,
specific => 0,
@@ -99,7 +103,7 @@
return grep {-d $_} map {"$_/.ssh"} @bases;
}
-sub get_keyfiles {
+sub local_keyfiles {
# populates %keyfiles hash
# %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY
my $self = shift;
@@ -163,156 +167,396 @@
my $text = shift || $self->content || '';
my $tmp = File::Temp->new(); # magical self-destructing tempfile
# print $tmp "THIS IS TEXT\n";
- print $tmp $text or $logger->error(__PACKAGE__ . " : could not write to tempfile '$tmp'");
+ print $tmp $text or $logger->error($self->_error("could not write to tempfile '$tmp'"));
close $tmp;
$self->tempfile($tmp); # save the object
- $self->localfile($tmp->filename); # save the filename
- $logger->info(__PACKAGE__ . " : using tempfile $tmp");
- return $self->localfile; # return the filename
+ $self->local_file($tmp->filename); # save the filename
+ $logger->info(_pkg("using tempfile $tmp"));
+ return $self->local_file; # return the filename
}
-sub get {
- my $self = shift;
- my $params = shift;
-
- $self->init($params); # secondary init
-}
-
sub outbound_file {
my $self = shift;
my $params = shift;
- unless (defined $self->content or $self->localfile) { # content can be emptystring
- $logger->error($self->error("No content or localfile specified -- nothing to send"));
+ unless (defined $self->content or $self->local_file) { # content can be emptystring
+ $logger->error($self->_error("No content or local_file specified -- nothing to send"));
return;
}
# tricky subtlety: we want to use the most recently specified options
# with priority order: filename, content, old filename, old content.
#
- # The $params->{x} will already match $self->x after the init above,
- # so the checks using $params below are for whether the value was specified NOW (via put()) or not.
+ # The $params->{x} will already match $self->x after the secondary init,
+ # so the checks using $params below are for whether the value was specified NOW (e.g. via put()) or not.
#
- # if we got a new localfile value, we use it
+ # if we got a new local_file value, we use it
# else if the content is new to this call, build a new tempfile w/ it,
- # else use existing localfile,
+ # else use existing local_file,
# else build new tempfile w/ content already specified via new()
- return $params->{localfile} || (
+ return $params->{local_file} || (
(defined $params->{content}) ?
$self->new_tempfile($self->content) : # $self->content is same value as $params->{content}
- ($self->localfile || $self->new_tempfile($self->content))
+ ($self->local_file || $self->new_tempfile($self->content))
);
}
+sub key_check {
+ my $self = shift;
+ my $params = shift;
+
+ return if ($params->{type} and $params->{type} eq 'FTP'); # Forget it, user specified regular FTP
+ return if ( $self->type and $self->type eq 'FTP'); # Forget it, user specified regular FTP
+
+ if ($self->ssh_publickey || $self->ssh_privatekey) {
+ $self->specific(1);
+ return $self->param_keys(); # we got one or both params, but they didn't pan out
+ }
+ return local_keyfiles(); # optional "force" arg could be used here to empty cache
+}
+
+
+# TOP LEVEL methods
+# TODO: delete for both uFTP and SSH2
+# TODO: handle IO::Scalar and IO::File for uFTP
+
+sub get {
+ my $self = shift;
+ my $params = shift;
+ if (! ref $params) {
+ $params = {remote_file => $params} ;
+ }
+
+ $self->init($params); # secondary init
+
+ $self->{get_args} = [$self->remote_file]; # same for scp_put and uFTP put
+ push @{$self->{get_args}}, $self->local_file if defined $self->local_file;
+
+ # $self->content($content);
+
+ my %keys = $self->key_check($params);
+ if (%keys) {
+ my $try = $self->get_ssh2(\%keys, @{$self->{get_args}});
+ return $try if $try; # if we had keys and they worked, we're done
+ }
+
+ # Otherwise, try w/ non-key uFTP methods
+ return $self->get_uftp(@{$self->{get_args}});
+}
+
sub put {
my $self = shift;
my $params = shift;
+ if (! ref $params) {
+ $params = {local_file => $params} ;
+ }
$self->init($params); # secondary init
- my $localfile = $self->outbound_file($params) or return;
+ my $local_file = $self->outbound_file($params) or return;
- my %keys = ();
- $self->{put_args} = [$localfile]; # same for scp_put and uFTP put
+ $self->{put_args} = [$local_file]; # same for scp_put and uFTP put
+ if (defined $self->remote_path and not defined $self->remote_file) {
+ $self->remote_file($self->remote_path . '/' . basename($local_file)); # if we know just the dir
+ }
+ if (defined $self->remote_file) {
+ push @{$self->{put_args}}, $self->remote_file; # user can specify remote_file name, optionally
+ }
- push @{$self->{put_args}}, $self->remote_file if $self->remote_file; # user can specify remote_file name, optionally
+ my %keys = $self->key_check($params);
+ if (%keys) {
+ $self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file;
+ # if we had keys and they worked, we're done
+ }
- unless ($self->type and $self->type eq 'FTP') {
- if ($self->ssh_publickey || $self->ssh_privatekey) {
- $self->specific(1);
- %keys = $self->param_keys() or return; # we got one or both params, but they didn't pan out
- } else {
- %keys = get_keyfiles(); # optional "force" arg could be used here to empty cache
+ # Otherwise, try w/ non-key uFTP methods
+ return $self->put_uftp(@{$self->{put_args}});
+}
+
+sub ls {
+ my $self = shift;
+ my $params = shift;
+ my @targets = @_;
+ if (! ref $params) {
+ unshift @targets, ($params || '.'); # If it was just a string, it's the first target, else default pwd
+ delete $self->{remote_file}; # overriding any target in the object previously.
+ $params = {}; # make params a normal hashref again
+ } else {
+ if ($params->{remote_file} and @_) {
+ $logger->warn($self->_error("Ignoring ls parameter remote_file for subsequent args"));
+ delete $params->{remote_file};
}
+ $self->init($params); # secondary init
+ $self->remote_file and (! @targets) and push @targets, $self->remote_file; # if remote_file is there, and there's nothing else, use it
+ delete $self->{remote_file};
}
- my $try;
- $try = $self->put_ssh2(%keys) if (%keys);
- return $try if $try; # if we had keys and they worked, we're done
+ $self->{ls_args} = \@targets;
+ my %keys = $self->key_check($params);
+ if (%keys) {
+ # $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys");
+ my @try = $self->ls_ssh2(\%keys, @targets);
+ return @try if @try; # if we had keys and they worked, we're done
+ }
+
# Otherwise, try w/ non-key uFTP methods
- return $self->put_uftp;
+ return $self->ls_uftp(@targets);
}
-sub put_ssh2 {
+# Internal Mechanics
+
+sub _ssh2 {
my $self = shift;
- my %keys = (@_);
+ $self->{ssh2} and return $self->{ssh2}; # caching
+ my $keys = shift;
- $logger->info("*** attempting put with ssh keys");
my $ssh2 = Net::SSH2->new();
unless($ssh2->connect($self->remote_host)) {
$logger->warn($self->error("SSH2 connect FAILED: $!" . join(" ", $ssh2->error)));
- $self->specific and return; # user told us what key(s) she wanted, and it failed.
- %keys = (); # forget the keys, we cannot connect
+ return; # we cannot connect
}
- foreach (keys %keys) {
- my %auth_args = (
- privatekey => $_,
- publickey => $keys{$_},
- rank => [qw/ publickey hostbased password /],
- );
- $self->remote_user and $auth_args{username} = $self->remote_user ;
- $self->remote_password and $auth_args{password} = $self->remote_password;
- $self->remote_host and $auth_args{hostname} = $self->remote_host ;
- if ($ssh2->auth(%auth_args)) {
- if ($ssh2->scp_put( @{$self->{put_args}} )) {
- $logger->info(sprintf __PACKAGE__ . " : successfully sent %s %s", $self->remote_host, join(' --> ', @{$self->{put_args}} ));
- return 1;
+ my $success = 0;
+ my @privates = keys %$keys;
+ my $count = scalar @privates;
+ foreach (@privates) {
+ if ($self->auth_ssh2($ssh2, $self->auth_ssh2_args($_, $keys->{$_}))) {
+ $success++;
+ last;
+ }
+ }
+ unless ($success) {
+ $logger->error($self->error("All ($count) keypair(s) FAILED for " . $self->remote_host));
+ return;
+ }
+ return $self->{ssh2} = $ssh2;
+}
+
+sub auth_ssh2 {
+ my $self = shift;
+ my $ssh2 = shift;
+ my %auth_args = @_;
+ $ssh2 or return;
+
+ my $host = $auth_args{hostname} || 'UNKNOWN';
+ my $key = $auth_args{privatekey} || 'UNKNOWN';
+ my $msg = "ssh2->auth by keypair for $host using $key";
+ if ($ssh2->auth(%auth_args)) {
+ $logger->info("Successful $msg");
+ return 1;
+ }
+
+ if ($self->specific) {
+ $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
+ } else {
+ $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
+ }
+ return;
+}
+
+sub auth_ssh2_args {
+ my $self = shift;
+ my %auth_args = (
+ privatekey => shift,
+ publickey => shift,
+ rank => [qw/ publickey hostbased password /],
+ );
+ $self->remote_user and $auth_args{username} = $self->remote_user ;
+ $self->remote_password and $auth_args{password} = $self->remote_password;
+ $self->remote_host and $auth_args{hostname} = $self->remote_host ;
+ return %auth_args;
+}
+
+sub put_ssh2 {
+ my $self = shift;
+ my $keys = shift; # could have many keypairs here
+ unless (@_) {
+ $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
+ return;
+ }
+
+ $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
+ my $ssh2 = $self->_ssh2($keys) or return;
+ my $res;
+ if ($res = $ssh2->scp_put( @_ )) {
+ $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
+ return $res;
+ }
+ $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
+ return;
+}
+
+sub get_ssh2 {
+ my $self = shift;
+ my $keys = shift; # could have many keypairs here
+ unless (@_) {
+ $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
+ return;
+ }
+
+ $logger->info("*** get args: " . Dumper(\@_));
+ $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {$_ || '*Object'} @_) . ") with ssh keys");
+ my $ssh2 = $self->_ssh2($keys) or return;
+ my $res;
+ if ($res = $ssh2->scp_get( @_ )) {
+ $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
+ return $res;
+ }
+ $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
+ return;
+}
+
+sub ls_ssh2 {
+ my $self = shift;
+ my @list = $self->ls_ssh2_full(@_);
+ @list and return sort map {$_->{slash_path}} @list;
+# @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
+}
+
+sub ls_ssh2_full {
+ my $self = shift;
+ my $keys = shift; # could have many keypairs here
+ my @targets = grep {defined} @_;
+
+ $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
+ my $ssh2 = $self->_ssh2($keys) or return;
+ my $sftp = $ssh2->sftp or return;
+
+ my @list = ();
+ foreach my $target (@targets) {
+ my ($dir, $file);
+ $dir = $sftp->opendir($target);
+ unless ($dir) {
+ $file = $sftp->stat($target);
+ if ($file) {
+ $file->{slash_path} = $self->_slash_path($target, $file->{name}); # it was a file, not a dir. That's OK.
+ push @list, $file;
} else {
- $logger->error($self->error(sprintf __PACKAGE__ . " : put to %s failed with error: $!", $self->remote_host));
- return;
+ $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
}
- } elsif ($self->specific) {
- $logger->error($self->error(sprintf "Abort: ssh2->auth FAILED for %s using %s: $!", $self->remote_host, $_));
- return;
- } else {
- $logger->notice($self->error(sprintf "Unsuccessful keypair: ssh2->auth FAILED for %s using %s: $!", $self->remote_host, $_));
+ next;
}
+ while ($file = $dir->read()) {
+ $file->{slash_path} = $self->_slash_path($target, $file->{name});
+ push @list, $file;
+ # foreach (sort keys %$line) { printf " %20s => %s\n", $_, $line->{$_}; }
+ }
}
+ return @list;
+
}
-sub uftp {
+sub _slash_path { # not OO
my $self = shift;
+ my $dir = shift || '.';
+ my $file = shift || '';
+ return $dir . ($dir =~ /\/$/ ? '' : '/') . $file;
+}
+
+sub _uftp {
+ my $self = shift;
my %options = ();
+ $self->{uftp} and return $self->{uftp}; # caching
foreach (qw/debug type port/) {
$options{$_} = $self->{$_} if $self->{$_};
}
- # TODO: eval wrapper, set $self->error($!) on failure
- my $ftp = Net::uFTP->new($self->remote_host, %options) or return;
+
+ my $ftp = Net::uFTP->new($self->remote_host, %options);
+ unless ($ftp) {
+ $logger->error($self->_error('Net::uFTP->new("' . $self->remote_host . ", ...) FAILED: $@"));
+ return;
+ }
my @login_args = ();
foreach (qw/remote_user remote_password remote_account/) {
- push @login_args, $self->{$_} if $self->{$_};
+ $self->{$_} or last;
+ push @login_args, $self->{$_};
}
- unless ($ftp->login(@login_args)) {
- $logger->error(__PACKAGE__ . ' : ' . $self->error("failed login to " . $self->remote_host . " w/ args(" . join(',', @login_args) . ')'));
+ eval { $ftp->login(@login_args) };
+ if ($@) {
+ $logger->error($self->_error("failed login to", $self->remote_host, "w/ args(" . join(',', @login_args) . ") : $@"));
return;
}
- return $ftp;
+ return $self->{uftp} = $ftp;
}
sub put_uftp {
my $self = shift;
- my $ftp = $self->uftp or return;
- my $filename = $ftp->put(@{$self->{put_args}});
- if ($filename) {
- $logger->info(__PACKAGE__ . " : successfully sent $self->remote_host $self->localfile --> $filename");
- return $filename;
- } else {
- $logger->error(__PACKAGE__ . ' : ' . $self->error("put to " . $self->remote_host . " failed with error: $!"));
+ my $ftp = $self->_uftp or return;
+ my $filename;
+ eval { $filename = $ftp->put(@{$self->{put_args}}) };
+ if ($@ or ! $filename) {
+ $logger->error($self->_error("put to", $self->remote_host, "failed with error: $@"));
return;
}
+ $self->remote_file($filename);
+ $logger->info(_pkg("successfully sent", $self->remote_host, $self->local_file, '-->', $filename));
+ return $filename;
}
+sub get_uftp {
+ my $self = shift;
+ my $ftp = $self->_uftp or return;
+ my $filename;
+ eval { $filename = $ftp->get(@{$self->{get_args}}) };
+ if ($@ or ! $filename) {
+ $logger->error($self->_error("get from", $self->remote_host, "failed with error: $@"));
+ return;
+ }
+ $self->local_file($filename);
+ $logger->info(_pkg("successfully retrieved $filename <--", $self->remote_host . '/' . $self->remote_file));
+ return $self->local_file;
+}
+
+sub ls_uftp {
+ my $self = shift;
+ my $ftp = $self->_uftp or return;
+ my @list;
+ foreach (@_) {
+ my @part;
+ eval { @part = $ftp->ls($_) };
+ if ($@) {
+ $logger->error($self->_error("ls from", $self->remote_host, "failed with error: $@"));
+ next;
+ }
+ push @list, @part;
+ }
+ return @list;
+}
+
+sub delete_uftp {
+ my $self = shift;
+ my $ftp = $self->_uftp or return;
+ return $ftp->delete(shift);
+}
+
+sub _pkg { # Not OO
+ return __PACKAGE__ . ' : ' unless @_;
+ return __PACKAGE__ . ' : ' . join(' ', @_);
+}
+
+sub _error {
+ my $self = shift;
+ return _pkg($self->error(join(' ', at _)));
+}
+
sub init {
my $self = shift;
my $params = shift;
my @required = @_; # qw(remote_host) ; # nothing required now
+ if ($params->{account_object}) { # if we got passed an object, we initialize off that first
+ $self->{remote_host } = $params->{account_object}->host;
+ $self->{remote_user } = $params->{account_object}->username;
+ $self->{remote_password} = $params->{account_object}->password;
+ $self->{remote_account } = $params->{account_object}->account;
+ $self->{remote_path } = $params->{account_object}->path; # not really the same as remote_file, maybe expand on this later
+ }
+
foreach (keys %{$self->{_permitted}}) {
- $self->{$_} = $params->{$_} if defined $params->{$_};
+ $self->{$_} = $params->{$_} if defined $params->{$_}; # possibly override settings from object
}
foreach (@required) {
@@ -324,9 +568,8 @@
return $self;
}
-
sub new {
- my( $class, %args ) = @_;
+ my ($class, %args) = @_;
my $self = { _permitted => \%fields, %fields };
bless $self, $class;
@@ -337,11 +580,14 @@
sub DESTROY {
# in order to create, we must first ...
+ my $self = shift;
+ $self->{ssh2} and $self->{ssh2}->disconnect(); # let the other end know we're done.
+ $self->{uftp} and $self->{uftp}->quit(); # let the other end know we're done.
}
sub AUTOLOAD {
my $self = shift;
- my $class = ref($self) or croak "$self is not an object";
+ my $class = ref($self) or croak "AUTOLOAD error: $self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip leading package stuff
@@ -358,3 +604,4 @@
}
1;
+
Modified: trunk/Open-ILS/src/sql/Pg/002.schema.config.sql
===================================================================
--- trunk/Open-ILS/src/sql/Pg/002.schema.config.sql 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/sql/Pg/002.schema.config.sql 2010-02-22 02:59:34 UTC (rev 15606)
@@ -51,7 +51,7 @@
install_date TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW()
);
-INSERT INTO config.upgrade_log (version) VALUES ('0165'); -- phasefx
+INSERT INTO config.upgrade_log (version) VALUES ('0167'); -- atz
CREATE TABLE config.bib_source (
id SERIAL PRIMARY KEY,
Modified: trunk/Open-ILS/src/sql/Pg/005.schema.actors.sql
===================================================================
--- trunk/Open-ILS/src/sql/Pg/005.schema.actors.sql 2010-02-21 04:47:35 UTC (rev 15605)
+++ trunk/Open-ILS/src/sql/Pg/005.schema.actors.sql 2010-02-22 02:59:34 UTC (rev 15606)
@@ -532,7 +532,8 @@
county TEXT,
state TEXT NOT NULL,
country TEXT NOT NULL,
- post_code TEXT NOT NULL
+ post_code TEXT NOT NULL,
+ san TEXT
);
CREATE INDEX actor_org_address_org_unit_idx ON actor.org_address (org_unit);
Added: trunk/Open-ILS/src/sql/Pg/upgrade/0166.schema.acq_edi_message.sql
===================================================================
--- trunk/Open-ILS/src/sql/Pg/upgrade/0166.schema.acq_edi_message.sql (rev 0)
+++ trunk/Open-ILS/src/sql/Pg/upgrade/0166.schema.acq_edi_message.sql 2010-02-22 02:59:34 UTC (rev 15606)
@@ -0,0 +1,32 @@
+BEGIN;
+
+INSERT INTO config.upgrade_log (version) VALUES ('0166');
+
+CREATE TABLE acq.edi_message (
+ id SERIAL PRIMARY KEY,
+ account INTEGER REFERENCES acq.edi_account(id)
+ DEFERRABLE INITIALLY DEFERRED,
+ remote_file TEXT,
+ create_time TIMESTAMPTZ NOT NULL DEFAULT now(),
+ translate_time TIMESTAMPTZ,
+ process_time TIMESTAMPTZ,
+ error_time TIMESTAMPTZ,
+ status TEXT NOT NULL DEFAULT 'new'
+ CONSTRAINT status_value CHECK
+ ( status IN (
+ 'new', -- needs to be translated
+ 'translated', -- needs to be processed
+ 'trans_error', -- error in translation step
+ 'processed', -- needs to have remote_file deleted
+ 'proc_error', -- error in processing step
+ 'delete_error', -- error in deletion
+ 'complete' -- done
+ )),
+ edi TEXT,
+ jedi TEXT,
+ error TEXT
+);
+
+ALTER TABLE actor.org_address ADD COLUMN san TEXT;
+
+COMMIT;
Added: trunk/Open-ILS/src/sql/Pg/upgrade/0167.data.event_definition_po_jedi.sql
===================================================================
--- trunk/Open-ILS/src/sql/Pg/upgrade/0167.data.event_definition_po_jedi.sql (rev 0)
+++ trunk/Open-ILS/src/sql/Pg/upgrade/0167.data.event_definition_po_jedi.sql 2010-02-22 02:59:34 UTC (rev 15606)
@@ -0,0 +1,79 @@
+BEGIN;
+
+INSERT INTO config.upgrade_log (version) VALUES ('0167');
+
+INSERT INTO acq.event_definition (active, owner, name, hook, validator, reactor, cleanup_success, cleanup_failure, delay, delay_field, group_field, template) VALUES (true, 1, 'PO JEDI', 'format.po.jedi', 'NOOP_True', 'ProcessTemplate', NULL, NULL, '00:05:00', NULL, NULL,
+$$[%- USE date -%]
+[%# start JEDI document -%]
+[%- BLOCK big_block -%]
+["order", {
+ "po_number":[% target.id %],
+ "date":"[% date.format(date.now, '%Y%m%d') %]",
+ "buyer":[
+ {"id":"[% target.ordering_agency.mailing_address.san %]",
+ "reference":{"API":"[% target.ordering_agency.mailing_address.san %]"}}
+ ],
+ "vendor":[
+ "[% target.provider.san %]", // [% target.provider.name %] ([% target.provider.id %])
+ {"id-qualifier":"91", "reference":{"IA":"[% target.provider.id %]"}, "id":"[% target.provider.san %]"}
+ ],
+ "currency":"[% target.provider.currency_type %]",
+ "items":[
+ [% FOR li IN target.lineitems %]
+ {
+ "identifiers":[
+ {"id-qualifier":"SA","id":"[% li.id %]"},
+ {"id-qualifier":"IB","id":"[% helpers.get_li_attr('isbn', li.attributes) %]"}
+ ],
+ "price":[% helpers.get_li_attr('estimated_price', '', li.attributes) %],
+ "desc":[
+ {"BTI":"[% helpers.get_li_attr('title', '', li.attributes) %]"},
+ {"BPU":"[% helpers.get_li_attr('publisher', '', li.attributes) %]"},
+ {"BPD":"[% helpers.get_li_attr('pubdate', '', li.attributes) %]"},
+ {"BPH":"[% helpers.get_li_attr('pagination','', li.attributes) %]"}
+ ],
+ "quantity":[% li.lineitem_details.size %]
+ [%-# TODO: lineitem details (later) -%]
+ }[% UNLESS loop.last %],[% END -%]
+ [%- END %]
+ ],
+ "line_items":[% target.lineitems.size %]
+}]
+[% END %]
+[% tempo = PROCESS big_block; helpers.escape_json(tempo) %]
+$$
+);
+
+/*
+// API : additional party identification -- supplier’s code for library acct or dept (EAN code)
+// IA : internal vendor number (vendor profile number)
+// VA : VAT registered number.... TODO
+
+BUYER id-qualifier:
+ 9 = EAN - location number -- not the same as EAN-13 barcode
+31B = US book trade SANs (Standard Address Numbers aka EDItEUR code) - TRANSLATOR DEFAULT!
+91 = Assigned by supplier or supplier’s agent
+92 = Assigned by buyer
+
+ITEM id-qualifier (Item number type, coded):
+EN = EAN-13 article number - 13 digit barcode
+IB = ISBN (International Standard Book Number)
+IM = ISMN (International Standard Music Number)
+IS = ISSN (International Standard Serial Number): use only in a continuation order message coded 22C in BGM DE 1001, to identify the series to which the order applies
+MF = manufacturer’s article number
+SA = supplier’s article number
+*/
+
+
+INSERT INTO action_trigger.environment (event_def, path) VALUES
+ ((SELECT id FROM action_trigger.event_definition WHERE name='PO JEDI'), 'lineitems.attributes'),
+ ((SELECT id FROM action_trigger.event_definition WHERE name='PO JEDI'), 'lineitems.lineitem_details'),
+ ((SELECT id FROM action_trigger.event_definition WHERE name='PO JEDI'), 'lineitems.lineitem_notes'),
+ ((SELECT id FROM action_trigger.event_definition WHERE name='PO JEDI'), 'ordering_agency.mailing_address'),
+ ((SELECT id FROM action_trigger.event_definition WHERE name='PO JEDI'), 'provider');
+
+-- The environment insert has to happen here because it relies on subquerying the user-editable field "name" to
+-- provide the FK. Outside of this tranasaction, we cannot be sure the user hasn't changed the name to something else.
+
+COMMIT;
+
More information about the open-ils-commits
mailing list