[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb:[5713] addons/1.3
- Subject: SF.net SVN: ledger-smb:[5713] addons/1.3
- From: ..hidden..
- Date: Tue, 16 Apr 2013 12:11:32 +0000
Revision: 5713
http://sourceforge.net/p/ledger-smb/code/5713
Author: einhverfr
Date: 2013-04-16 12:11:32 +0000 (Tue, 16 Apr 2013)
Log Message:
-----------
X12 addon for 1.3
Added Paths:
-----------
addons/1.3/X12/
addons/1.3/X12/LedgerSMB/
addons/1.3/X12/LedgerSMB/X12/
addons/1.3/X12/LedgerSMB/X12/EDI850.pm
addons/1.3/X12/LedgerSMB/X12/EDI894.pm
addons/1.3/X12/LedgerSMB/X12/cf/
addons/1.3/X12/LedgerSMB/X12/cf/850.cf
addons/1.3/X12/LedgerSMB/X12/cf/894.cf
addons/1.3/X12/LedgerSMB/X12/cf/997.cf
addons/1.3/X12/LedgerSMB/X12.pm
Added: addons/1.3/X12/LedgerSMB/X12/EDI850.pm
===================================================================
--- addons/1.3/X12/LedgerSMB/X12/EDI850.pm (rev 0)
+++ addons/1.3/X12/LedgerSMB/X12/EDI850.pm 2013-04-16 12:11:32 UTC (rev 5713)
@@ -0,0 +1,94 @@
+=head1 NAME
+
+LedgerSMB::X12::EDI850 - Conversion class for X12 850 files to LedgerSMB
+structures
+
+=head1 SYNOPSIS
+
+ my $edi = LedgerSMB::X12::EDI850->new(message => 'message.edi');
+ my $form = $edi->order;
+
+=cut
+
+package LedgerSMB::X12::EDI850;
+use Moose;
+use LedgerSMB::Form;
+use feature 'switch';
+extends 'LedgerSMB::X12';
+
+sub _config {
+ return 'LedgerSMB/X12/cf/850.cf';
+}
+
+=head1 DESCRIPTION
+
+This module processes X12 EDI 850 purchase orders and can present them in
+structures compatible with LedgerSMB's order entry system. The API is simple.
+
+=head1 PROPERTIES
+
+=over
+
+=item order
+
+This is an order hashref using the same data structures that a form screen
+would submit (flat format).
+
+=cut
+
+has order => (is => 'ro', isa => 'Form', lazy => 1,
+ builder => '_order');
+
+sub _order {
+ my ($self) = @_;
+ $self->parse;
+ my $sep = $self->parser->get_element_separator;
+ my $form = new Form;
+ my $sender_idx;
+ my $sender_id;
+
+ my $i = 0;
+
+ while (my $loop = $self->parser->get_next_loop){
+ given ($loop) {
+ when ('ISA'){
+ my ($segment) = $self->parser->get_loop_segments;
+ my @elements = split(/\Q$sep\E/, $segment);
+ $sender_idx = $elements[5];
+ $sender_id = $elements[6];
+ }
+ when ('BEG'){
+ my ($segment) = $self->parser->get_loop_segments;
+ my @elements = split(/\Q$sep\E/, $segment);
+ $form->{ordnumber} = $elements[3];
+ $form->{transdate} = $elements[5];
+ $form->{transdate} =~ s/(\d{4})(\d{2})(\d{2})/$1-$2-$3/;
+ }
+ when ('PO1'){
+ ++$i;
+ my ($segment) = $self->parser->get_loop_segments;
+ my @elements = split(/\Q$sep\E/, $segment);
+ $form->{"qty_$i"} = $elements[2];
+ $form->{"sellprice_$i"} = $elements[4];
+ $form->{"partnumber_$i"} = $elements[7];
+ }
+ when ('PID'){
+ my ($segment) = $self->parser->get_loop_segments;
+ my @elements = split(/\Q$sep\E/, $segment);
+ $form->{"description_$i"} = $elements[5];
+ }
+ when ('CTT'){
+ # Perform checks and error if does not work.
+ my ($segment) = $self->parser->get_loop_segments;
+ my @elements = split(/\Q$sep\E/, $segment);
+ my $invtotal;
+ $invtotal += ($form->{"qty_$_"} * $form->{"sellprice_$_"})
+ for (1 .. $i);
+ #die 'Incorrect total: got ' . $elements[2] . " expected $invtotal" if $elements[2] and $elements[2] != $invtotal;
+ }
+ }
+ }
+ return $form;
+}
+
+__PACKAGE__->meta->make_immutable;
Added: addons/1.3/X12/LedgerSMB/X12/EDI894.pm
===================================================================
--- addons/1.3/X12/LedgerSMB/X12/EDI894.pm (rev 0)
+++ addons/1.3/X12/LedgerSMB/X12/EDI894.pm 2013-04-16 12:11:32 UTC (rev 5713)
@@ -0,0 +1,79 @@
+=head1 NAME
+
+LedgerSMB::X12::EDI894 - X12 894 support for LedgerSMB
+
+=head1 SYNPOSIS
+
+ my $edi = LedgerSMB::X12::EDI894->new(message => 'message.edi');
+ my $form = $edi->order;
+
+=cut
+
+package LedgerSMB::X12::EDI894;
+use Moose;
+use LedgerSMB::Form;
+use feature 'switch';
+extends 'LedgerSMB::X12';
+
+sub _config {
+ return 'LedgerSMB/X12/cf/894.cf';
+}
+
+=head1 DESCRIPTION
+
+The X12 894 provides for delivery notifications of orders or product returns.
+While it is not yet clear what we want to do with this, this does return the
+data in a $form object.
+
+=head1 PROPERTIES
+
+=over
+
+=item order
+
+This is an order hashref using the same data structures that a form screen
+would submit (flat format).
+
+=cut
+
+has order => (is => 'ro', isa => 'HashRef[Any]', lazy => 1,
+ builder => '_order');
+
+sub _order {
+ my ($self) = @_;
+ my $sep = $self->parser->get_element_separator;
+ my $form = new Form;
+ my $sender_idx;
+ my $sender_id;
+
+ my $i = 0;
+
+ while (my $loop = $self->parser->get_next_loop){
+ given ($loop) {
+ when ('ISA'){
+ my ($segment) = $self->parser->get_loop_segments;
+ my @elements = split(/\Q$sep\E/, $segment);
+ $sender_idx = $elements[5];
+ $sender_id = $elements[6];
+ }
+ when ('G82') {
+ my ($segment) = $self->parser->get_loop_segments;
+ my @elements = split(/\Q$sep\E/, $segment);
+ $form->{transdate} = $elements[10];
+ $form->{ordnumber} = $elements[9];
+ }
+ when ('G83') {
+ ++$i;
+ my ($segment) = $self->parser->get_loop_segments;
+ my @elements = split(/\Q$sep\E/, $segment);
+ $form->{"qty_$i"} = $elements[2];
+ $form->{"unit_$i"} = $elements[3];
+ $form->{"partnumber_$i"} = $elements[5];
+ $form->{"sellprice_$i"} = $elements[9];
+ }
+ }
+ }
+ return $form;
+}
+
+__PACKAGE__->meta->make_immutable;
Added: addons/1.3/X12/LedgerSMB/X12/cf/850.cf
===================================================================
--- addons/1.3/X12/LedgerSMB/X12/cf/850.cf (rev 0)
+++ addons/1.3/X12/LedgerSMB/X12/cf/850.cf 2013-04-16 12:11:32 UTC (rev 5713)
@@ -0,0 +1,76 @@
+# 850 Purchase Order for X12 format by Chris Travers
+# ..hidden..
+
+[LOOPS]
+ISA
+GS
+ST
+BEG
+PER
+SAC
+DTM
+N9
+PO1
+PID
+SAC
+SDQ
+CTT
+SE
+GE
+IEA
+
+[ISA]
+segment=ISA:::ISA:R:1
+
+[GS]
+segment=GS:::GS:R:1
+
+#LOOP ID - HEADER
+[ST]
+segment=ST:1:850:Transaction Set Header:R:1
+
+[BEG]
+segment=BEG:::Begin Transaction:R:1
+
+[PER]
+segment=PER:::Administrative Contact (Person):S:3
+
+[SAC]
+segment=SAC:::Service, Promotion, Allowance, and Charge:S:1
+
+[DTM]
+segment=DTM:::Date/Time Reference:S:10
+
+[N9]
+segment=N9:::Extended Reference Information:S:1
+segment=MTX:::Text:S:1
+loop=N1
+
+[N1]
+segment=N1:::Party Identification:S:1
+
+[PO1]
+segment=PO1:::Baseline Item Data:M:1
+loop=PID
+loop=SAC
+loop=SDQ
+
+[PID]
+segment=PID:::Product/Item Description:S:1
+
+[SDQ]
+segment=SDQ:::Destination Quantity:S:1
+
+
+[CTT]
+segment=CTT:::Transaction Totals:S:1
+
+[SE]
+segment=SE:::Transaction Set Trailer:R:1
+
+[GE]
+segment=GE:::GE:R:1
+
+[IEA]
+segment=IEA:::IEA:R:1
+
Added: addons/1.3/X12/LedgerSMB/X12/cf/894.cf
===================================================================
--- addons/1.3/X12/LedgerSMB/X12/cf/894.cf (rev 0)
+++ addons/1.3/X12/LedgerSMB/X12/cf/894.cf 2013-04-16 12:11:32 UTC (rev 5713)
@@ -0,0 +1,61 @@
+# 894 Purchase Order for X12 format by Chris Travers
+# ..hidden..
+
+[LOOPS]
+ISA
+GS
+ST
+G82
+LS
+0100
+LE
+G72
+G84
+G86
+G85
+SE
+GE
+IEA
+
+[ISA]
+segment=ISA:::ISA:R:1
+
+[GS]
+segment=GS:::GS:R:1
+
+#LOOP ID - HEADER
+[ST]
+segment=ST:1:894:Transaction Set Header:R:1
+
+[G82]
+segment=G82:::Delivery/Return Base Record ID:R:1
+
+[0100]
+segment=G83:::Line Item Detail/Direct Store Delivery:S:1
+segment=G72:::Allowance of Charge:S:10
+
+[LE]
+segment=LE:::Loop Trailer:R:1
+
+[G72]
+segment=G72:::Allowance of Charge:S:20
+
+
+[G84]
+segment=G84:::Delivery/Return Record of Totals:R:1
+
+[G86]
+segment=G86:::Signature Identification:R:1
+
+[G85]
+segment=G85::Record Integrity Check:R:1
+
+[SE]
+segment=SE:::Transaction Set Trailer:R:1
+
+[GE]
+segment=GE:::GE:R:1
+
+[IEA]
+segment=IEA:::IEA:R:1
+
Added: addons/1.3/X12/LedgerSMB/X12/cf/997.cf
===================================================================
--- addons/1.3/X12/LedgerSMB/X12/cf/997.cf (rev 0)
+++ addons/1.3/X12/LedgerSMB/X12/cf/997.cf 2013-04-16 12:11:32 UTC (rev 5713)
@@ -0,0 +1,57 @@
+[LOOPS]
+ISA
+GS
+ST
+AK1
+AK2
+AK2/AK3
+AK5
+AK9
+SE
+GE
+IEA
+
+#--- start of loop details ---#
+
+[ISA]
+segment=ISA:::ISA:R:1
+
+[GS]
+segment=GS:::GS:R:1
+
+#LOOP ID - HEADER
+[ST]
+segment=ST:1:997:Transaction Set Header:R:1
+
+#LOOP ID - AK1
+[AK1]
+segment=AK1:::Functional Group Response Header:S:1
+
+#LOOP ID - AK2 999999
+[AK2]
+segment=AK2:::Transaction Set Response Header:S:1
+loop=AK2/AK3
+
+#LOOP ID - AK2/AK3 999999
+[AK2/AK3]
+segment=AK3:::Data Segment Note:S:99
+segment=AK4:::Data Element Note:S:99
+
+#LOOP ID - AK5
+[AK5]
+segment=AK5:::Transaction Set Response Trailer:R:1
+
+#LOOP ID - AK9
+[AK9]
+segment=AK9:::Functional Group Response Trailer:R:1
+
+#LOOP ID - TRAILER
+[SE]
+segment=SE:::Transaction Set Trailer:R:1
+
+[GE]
+segment=GE:::GE:R:1
+
+[IEA]
+segment=IEA:::IEA:R:1
+
Added: addons/1.3/X12/LedgerSMB/X12.pm
===================================================================
--- addons/1.3/X12/LedgerSMB/X12.pm (rev 0)
+++ addons/1.3/X12/LedgerSMB/X12.pm 2013-04-16 12:11:32 UTC (rev 5713)
@@ -0,0 +1,197 @@
+=head1 NAME
+
+LedgerSMB::X12 - Base Class for LedgerSMB X12 handling
+
+=head1 SYNOPSIS
+
+Not used directly, only by subclasses
+
+However the API expected to be used by a subclass is:
+
+ my $edi945 = LedgerSMB::X12::EDI945->new({message => $string});
+ my @shipments = $edi945->shipments
+ for my $ship(@shipments){
+ ...
+ }
+
+=head1 DESCRIPTION
+
+This module is the basis for EDI file parsing in LedgerSMB. Although X12 is
+a very large spec, this only implements the portions of
+character-separated-value formatted EDI files that are needed at present. XML
+files would need to go through another interface.
+
+This application relies on X12::Parser and includes some extra configuration
+files, namely 850.cf and 895.cf. Separators for segments and elements is
+supported by X12::Parser.
+
+=cut
+
+package LedgerSMB::X12;
+use Moose;
+use X12::Parser;
+use LedgerSMB::Sysconfig;
+
+=head1 REQUIRED PROPERTIES FOR PARSING
+
+=head2 message
+
+This is the textual message of the EDI file to be processed. This is only
+required if parsing, as running the builders with no message will generate
+errors. Note that interfaces other than parsing do not require instantiation
+of the object externally....
+
+Note that if message is shorter than 180 chars long, if it does not start with
+"ISA" and if it contains slashes or ends in /\.\w{3}/, it will be seen as a
+path to a file, but if it is 180 chars or longer, if it does not start with
+'ISA' or if it does not end in a . followed by a three letter/number extension,
+it will be seen as the message text itself. This can be overridden by setting
+the read_file property explicitly below.
+
+=cut
+
+has message => (is => 'ro', isa => 'Str', required => 1);
+
+=head2 config_file
+
+This is the path to the cf file for setting up loop hierarchies.
+
+=cut
+
+has config_file => (is => 'ro', isa => 'Str', lazy => 1, builder => '_config');
+
+sub _config {
+ die 'cannot call builder here!';
+}
+
+=head2 read_file bool
+
+If this is set, override the auto detection of the message file. If true, this
+is a file to be read, if false, it is a message, and if not provided, we
+autodetect.
+
+=cut
+
+has read_file => (is => 'ro', isa => 'Bool', predicate => 'has_read_file',
+ required => 0);
+
+=head2 parser X12::Parser
+
+This is the parser, automatically generated via builder.
+
+=cut
+
+has parser => (is => 'ro', isa => 'X12::Parser', lazy => 1, builder => '_parser');
+
+=item ISA
+
+This is the exchange security and routing information header.
+
+=cut
+
+has ISA => (is => 'ro', isa => 'HashRef[Any]', lazy => 1, builder => '_ISA');
+
+sub _ISA {
+ my ($self) = @_;
+ my @segments = $self->parser->get_loop_segments;
+ @segments = $self->parser->get_loop_segments unless @segments;
+ if ($segments[0] != 'ISA'){
+ $self->parse; # re-initialize parser, we don't have an ISA!
+ die 'No ISA'; # Trappable error.
+ }
+
+ my $isa = {};
+
+ my @keys;
+
+ push @keys, sprintf('ISA%02d', $_) for (1 .. 16);
+
+ for my $key (@keys){
+ $isa->{$key} = shift @segments;
+ }
+ return $isa;
+}
+
+
+=head1 METHODS
+
+=over
+
+=item is_message_file
+
+Returns 1 if message is a file, 0 or undef if message is not a file, and dies
+on error.
+
+=cut
+
+sub is_message_file {
+ my ($self) = @_;
+ return $self->read_file if $self->has_read_file;
+
+ if (length($self->message) > 180
+ or ($self->message !~ /\.\w{3}$/ and $self->message !~ /\//)
+ ){
+ return 0;
+ };
+ return 1;
+}
+
+=item parse()
+
+This function sets up the basic parser and runs it. It is the builder for
+$self->parser.
+
+=cut
+
+sub _parser {
+ my ($self) = @_;
+ my $parser = new X12::Parser;
+ my $file = $self->message;
+ return $parser;
+}
+
+sub parse {
+ my ($self) = @_;
+ my $file;
+ my $parser = $self->parser;
+ if (!$self->is_message_file){
+ $file = $LedgerSMB::Sysconfig::tempdir . '/' . $$ . '-' . $self->message;
+ open TMPFILE, '>', $file;
+ print TMPFILE $self->message;
+ close TMPFILE;
+ } else {
+ $file = $self->message;
+ }
+ $parser->parsefile( file => $file,
+ conf => $self->config_file);
+ return $parser;
+}
+
+=item set_segment_sep(char $sep)
+
+In certain cases, people have been known to generate EDI files using illegal
+characters as separators, or otherwise have EDI files where the parser cannot
+properly define the segment separator (the element separator poses no such
+problems).
+
+In these cases one needs to set it manually. Use this function to do this.
+
+=cut
+
+sub set_segement_sep {
+ my ($self, $sep) = @_;
+ # ick, ai don't like how this involves messing around with internals.
+ $self->parser->{_SEGMENT_SEPARATOR} = $sep;
+}
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2013 The LedgerSMB Core Team. This file may be re-used under the
+terms of the GNU General Public License version 2 or at your option any later
+version. Please see included LICENSE.txt file for details.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.