Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI/Translator.pm

   1 package OpenILS::Application::Acq::EDI::Translator;
   2
   3 use warnings;
   4 use strict;
   5
   6 use RPC::XML::Client;
   7 use Data::Dumper;
   8
   9 # DEFAULTS
  10 my $proto = 'http://';
  11 my $host  = $proto . 'localhost';
  12 my $path  = '/EDI';
  13 my $port  = 9191;
  14 my $verbose = 0;
  15
  16 sub new {
  17     my ($class, %args) = @_;
  18     my $self = bless(\%args, $class);
  19     $self->init;
  20     return $self;
  21 }
  22
  23 sub init {
  24     my $self = shift;
  25     $self->host_cleanup;
  26 }
  27
  28 sub host_cleanup {
  29     my $self = shift;
  30     my $target = $self->{host} || $host;
  31     $target =~ /^\S+:\/\// or $target  = ($self->{proto} || $proto) . $target;
  32     $target =~ /:\d+$/     or $target .= ':' . ($self->{port} || $port);
  33     $target .= ($self->{path} || $path);
  34     $self->{verbose} and print "Cleanup: $self->{host} ==> $target\n";
  35     $self->{host} = $target;
  36     return $target;
  37 }
  38
  39 sub client {
  40     my $self = shift;
  41     return $self->{client} ||= RPC::XML::Client->new($self->{host});     # TODO: auth
  42 }
  43
  44 sub debug_file {
  45     my $self = shift;
  46     my $text = shift;
  47     my $filename = @_ ? shift : ('/tmp/' . __PACKAGE__ . '_unknown.tmp');
  48     unless (open (TMP_EDI, ">$filename")) {
  49         warn "Cannot write $filename: $!";
  50         return;
  51     }
  52     print TMP_EDI $text, "\n";
  53     close TMP_EDI;
  54     return 1;
  55 }
  56
  57 sub json2edi {
  58     my $self = shift;
  59     my $text = shift;
  60     $self->debug_file($text, '/tmp/perl_json2edi.tmp');
  61     my $client = $self->client();
  62     $self->{verbose} and print "Trying json2edi on host: $self->{host}\n";
  63     $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
  64     my $resp = $client->send_request('json2edi', $text);
  65     $self->{verbose} and print Dumper($resp);
  66     return $resp;
  67 }
  68
  69 sub edi2json {
  70     my $self = shift;
  71     my $text  = shift;
  72     $self->debug_file($text, '/tmp/perl_edi2json.tmp');
  73     my $client = $self->client();
  74     $self->{verbose} and print "Trying edi2json on host: $self->{host}\n";
  75     $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
  76     my $resp = $client->send_request('edi2json', $text);
  77     $self->{verbose} and print Dumper($resp);
  78     return $resp;
  79 }
  80
  81 1;
  82