Attachment #35718 for bug #7736

View | Details | Raw Unified | Return to bug 7736
Collapse All | Expand All

Lines 2495-2500 sub GetInvoices { Link Here

(-)a/C4/Acquisition.pm (-1 / +5 lines)
2495	push @bind_strs, " borrowers.branchcode = ? ";	2495	push @bind_strs, " borrowers.branchcode = ? ";
2496	push @bind_args, $args{branchcode};	2496	push @bind_args, $args{branchcode};
2497	}	2497	}
		2498	if($args{message_id}) {
		2499	push @bind_strs, " aqinvoices.message_id = ? ";
		2500	push @bind_args, $args{message_id};
		2501	}
2498		2502
2499	$query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;	2503	$query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2500	$query .= " GROUP BY aqinvoices.invoiceid ";	2504	$query .= " GROUP BY aqinvoices.invoiceid ";
Lines 2619-2625 sub AddInvoice { Link Here
2619	return unless(%invoice and $invoice{invoicenumber});	2623	return unless(%invoice and $invoice{invoicenumber});
2620		2624
2621	my @columns = qw(invoicenumber booksellerid shipmentdate billingdate	2625	my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2622	closedate shipmentcost shipmentcost_budgetid);	2626	closedate shipmentcost shipmentcost_budgetid message_id);
2623		2627
2624	my @set_strs;	2628	my @set_strs;
2625	my @set_args;	2629	my @set_args;

Lines 737-742 our $PERL_DEPS = { Link Here

(-)a/C4/Installer/PerlDependencies.pm (+10 lines)
737	'required' => '0',	737	'required' => '0',
738	'min_ver' => '5.61',	738	'min_ver' => '5.61',
739	},	739	},
		740	'Net::SFTP::Foreign' => {
		741	'usage' => 'Edifact',
		742	'required' => '0',
		743	'min_ver' => '1.73',
		744	},
		745	'Log::Log4perl' => {
		746	'usage' => 'Edifact',
		747	'required' => '0',
		748	'min_ver' => '1.29',
		749	},
740	};	750	};
741		751
742	1;	752	1;




package Koha::EDI;

# Copyright 2014 PTFS-Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use strict;
use warnings;
use base qw(Exporter);
use Carp;
use English qw{ -no_match_vars };
use Business::ISBN;
use DateTime;
use C4::Context;
use Koha::Database;
use C4::Acquisition qw( NewBasket AddInvoice ModReceiveOrder );
use C4::Items qw(AddItem);
use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
use Koha::Edifact::Order;
use Koha::Edifact;
use Log::Log4perl;

our $VERSION = 1.1;
our @EXPORT_OK =
  qw( process_quote process_invoice create_edi_order get_edifact_ean );

sub create_edi_order {
    my $parameters = shift;
    my $basketno   = $parameters->{basketno};
    my $ean        = $parameters->{ean};
    my $branchcode = $parameters->{branchcode};
    my $noingest   = $parameters->{noingest};
    $ean ||= C4::Context->preference('EDIfactEAN');
    if ( !$basketno || !$ean ) {
        carp 'create_edi_order called with no basketno or ean';
        return;
    }

    my $database = Koha::Database->new();
    my $schema   = $database->schema();

    my @orderlines = $schema->resultset('Aqorder')->search(
        {
            basketno    => $basketno,
            orderstatus => 'new',
        }
    )->all;

    my $vendor = $schema->resultset('VendorEdiAccount')->search(
        {
            vendor_id => $orderlines[0]->basketno->booksellerid->id,
        }
    )->single;

    my $ean_search_keys = { ean => $ean, };
    if ($branchcode) {
        $ean_search_keys->{branchcode} = $branchcode;
    }
    my $ean_obj =
      $schema->resultset('EdifactEan')->search($ean_search_keys)->single;

    my $edifact = Koha::Edifact::Order->new(
        { orderlines => \@orderlines, vendor => $vendor, ean => $ean_obj } );
    if ( !$edifact ) {
        return;
    }

    my $order_file = $edifact->encode();

    # ingest result
    if ($order_file) {
        if ($noingest) {    # allows scripts to produce test files
            return $order_file;
        }
        my $order = {
            message_type  => 'ORDERS',
            raw_msg       => $order_file,
            vendor_id     => $vendor->vendor_id,
            status        => 'Pending',
            basketno      => $basketno,
            filename      => $edifact->filename(),
            transfer_date => $edifact->msg_date_string(),
            edi_acct      => $vendor->id,

        };
        $schema->resultset('EdifactMessage')->create($order);
        return 1;
    }

    return;
}

sub process_invoice {
    my $invoice_message = shift;
    my $database        = Koha::Database->new();
    my $schema          = $database->schema();
    my $vendor_acct;
    my $logger = Log::Log4perl->get_logger();
    my $edi =
      Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
    my $messages = $edi->message_array();
    if ( @{$messages} ) {

        # BGM contains an invoice number
        foreach my $msg ( @{$messages} ) {
            my $invoicenumber  = $msg->docmsg_number();
            my $shipmentcharge = $msg->shipment_charge();
            my $msg_date       = $msg->message_date;
            my $tax_date       = $msg->tax_point_date;
            if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
                $tax_date = $msg_date;
            }

            my $vendor_ean = $msg->supplier_ean;
            if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
                $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
                    {
                        san => $vendor_ean,
                    }
                )->single;
            }
            if ( !$vendor_acct ) {
                carp
"Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
                next;
            }
            $invoice_message->edi_acct( $vendor_acct->id );
            $logger->trace("Adding invoice:$invoicenumber");
            my $invoiceid = AddInvoice(
                invoicenumber         => $invoicenumber,
                booksellerid          => $invoice_message->vendor_id,
                shipmentdate          => $msg_date,
                billingdate           => $tax_date,
                shipmentcost          => $shipmentcharge,
                shipmentcost_budgetid => $vendor_acct->shipment_budget,
                message_id            => $invoice_message->id,
            );
            $logger->trace("Added as invoiceno :$invoiceid");
            my $lines = $msg->lineitems();

            foreach my $line ( @{$lines} ) {
                my $ordernumber = $line->ordernumber;
                $logger->trace( "Receipting order:$ordernumber Qty: ",
                    $line->quantity );

                # handle old basketno/ordernumber references
                if ( $ordernumber =~ m{\d+\/(\d+)}xms ) {
                    $ordernumber = $1;
                }
                my $order = $schema->resultset('Aqorder')->find($ordernumber);

      # ModReceiveOrder does not validate that $ordernumber exists validate here
                if ($order) {
                    ModReceiveOrder(
                        {
                            biblionumber         => $order->biblionumber,
                            ordernumber          => $ordernumber,
                            quantityreceived     => $line->quantity,
                            cost                 => $line->price_net,
                            invoiceid            => $invoicenumber,
                            datereceived         => $msg_date,
                            received_itemnumbers => [],
                        }
                    );
                }
                else {
                    $logger->error(
                        "No order found for $ordernumber Invoice:$invoicenumber"
                    );
                    next;
                }

            }

        }
    }

    $invoice_message->status('received');
    $invoice_message->update;    # status and basketno link
    return;
}

# called on messages with status 'new'
sub process_quote {
    my $quote = shift;

    my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
    my $messages = $edi->message_array();
    my $process_errors = 0;
    my $logger         = Log::Log4perl->get_logger();
    my $database       = Koha::Database->new();
    my $schema         = $database->schema();

    if ( @{$messages} && $quote->vendor_id ) {
        my $basketno =
          NewBasket( $quote->vendor_id, 0, $quote->filename, q{}, q{} . q{} );
        $quote->basketno($basketno);
        $logger->trace("Created basket :$basketno");
        for my $msg ( @{$messages} ) {
            my $items  = $msg->lineitems();
            my $refnum = $msg->message_refno;

            for my $item ( @{$items} ) {
                if ( !quote_item( $schema, $item, $quote, $basketno ) ) {
                    ++$process_errors;
                }
            }
        }
    }
    my $status = 'received';
    if ($process_errors) {
        $status = 'error';
    }

    $quote->status($status);
    $quote->update;    # status and basketno link

    return;
}

sub quote_item {
    my ( $schema, $item, $quote, $basketno ) = @_;

    # create biblio record
    my $logger   = Log::Log4perl->get_logger();
    my $bib_hash = {
        'biblioitems.cn_source' => 'ddc',
        'items.cn_source'       => 'ddc',
        'items.notforloan'      => -1,
        'items.cn_sort'         => q{},
    };
    my $item_hash = {
        cn_source  => 'ddc',
        notforloan => -1,
        cn_dort    => q{},
    };
    $bib_hash->{'biblio.seriestitle'} = $item->series;

    $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
    $bib_hash->{'biblioitems.publicationyear'} =
      $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;

    $bib_hash->{'biblio.title'}         = $item->title;
    $bib_hash->{'biblio.author'}        = $item->author;
    $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
    $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
    $item_hash->{booksellerid}          = $quote->vendor_id;
    $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
    $item_hash->{itype}    = $item->girfield('stock_category');
    $item_hash->{location} = $item->girfield('collection_code');

    my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );

    if ( !$budget ) {
        carp 'Skipping line with no budget info';
        $logger->trace('line skipped for invalid budget');
        return;
    }

    my $note = {};

    my $shelfmark =
      $item->girfield('shelfmark') || $item->girfield('classification') || q{};
    $item_hash->{itemcallnumber} = $shelfmark;
    my $branch = $item->girfield('branch');
    $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
    for my $key ( keys %{$bib_hash} ) {
        if ( !defined $bib_hash->{$key} ) {
            delete $bib_hash->{$key};
        }
    }
    my $bib_record = TransformKohaToMarc($bib_hash);

    $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
    my $bib = _check_for_existing_bib( $item->item_number_id() );
    if ( !defined $bib ) {
        $bib = {};
        ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
          AddBiblio( $bib_record, q{} );
        $logger->trace("New biblio added $bib->{biblionumber}");
    }
    else {
        $logger->trace("Match found: $bib->{biblionumber}");
    }

    my $order_note = $item->{free_text};
    $order_note ||= q{};
    if ( !$basketno ) {
        $logger->error('Skipping order creation no basketno');
        return;
    }

    # database definitions should set some of these defaults but dont
    my $order_hash = {
        biblionumber     => $bib->{biblionumber},
        entrydate        => DateTime->now( time_zone => 'local' )->ymd(),
        quantity         => $item->quantity,
        basketno         => $basketno,
        listprice        => $item->price,
        quantityreceived => 0,

        #        notes             => $order_note, becane internalnote in 3.15
        order_internalnote => $order_note,
        rrp                => $item->price,
        ecost => _discounted_price( $quote->vendor->discount, $item->price ),
        budget_id         => $budget->budget_id,
        uncertainprice    => 0,
        sort1             => q{},
        sort2             => q{},
        supplierreference => $item->reference,
    };
    if ( $item->girfield('servicing_instruction') ) {

        # not in 3.14 !!!
        $order_hash->{order_vendornote} =
          $item->girfield('servicing_instruction');
    }
    if ( $item->internal_notes() ) {
        if ( $order_hash->{order_internalnote} ) {    # more than ''
            $order_hash->{order_internalnote} .= q{ };
        }

        $order_hash->{order_internalnote} .= $item->internal_notes;
    }

    my $new_order = $schema->resultset('Aqorder')->create($order_hash);
    my $o         = $new_order->ordernumber();
    $logger->trace("Order created :$o");

    # should be done by database settings
    $new_order->parent_ordernumber( $new_order->ordernumber() );
    $new_order->update();

    if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
        my $itemnumber;
        ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber ) =
          AddItem( $item_hash, $bib->{biblionumber} );
        $logger->trace("Added item:$itemnumber");
        $schema->resultset('AqordersItem')->create(
            {
                ordernumber => $new_order->ordernumber,
                itemnumber  => $itemnumber,
            }
        );

        if ( $item->quantity > 1 ) {
            my $occurence = 1;
            while ( $occurence < $item->quantity ) {
                my $new_item = {
                    notforloan       => -1,
                    cn_sort          => q{},
                    cn_source        => 'ddc',
                    price            => $item->price,
                    replacementprice => $item->price,
                    itype => $item->girfield( 'stock_category', $occurence ),
                    location =>
                      $item->girfield( 'collection_code', $occurence ),
                    itemcallnumber => $item->girfield( 'shelfmark', $occurence )
                      || $item->girfield( 'classification', $occurence ),
                    holdingbranch => $item->girfield( 'branch', $occurence ),
                    homebranch    => $item->girfield( 'branch', $occurence ),
                };
                ( undef, undef, $itemnumber ) =
                  AddItem( $new_item, $bib->{biblionumber} );
                $logger->trace("New item $itemnumber added");
                $schema->resultset('AqordersItem')->create(
                    {
                        ordernumber => $new_order->ordernumber,
                        itemnumber  => $itemnumber,
                    }
                );
                ++$occurence;
            }
        }

    }
    return 1;
}

sub get_edifact_ean {

    my $dbh = C4::Context->dbh;

    my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');

    return $eans->[0];
}

# We should not need to have a routine to do this here
sub _discounted_price {
    my ( $discount, $price ) = @_;
    return $price - ( ( $discount * $price ) / 100 );
}

sub _check_for_existing_bib {
    my $isbn = shift;

    my $search_isbn = $isbn;
    $search_isbn =~ s/^\s*/%/xms;
    $search_isbn =~ s/\s*$/%/xms;
    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare(
'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
    );
    my $tuple_arr =
      $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
    if ( @{$tuple_arr} ) {
        return $tuple_arr->[0];
    }
    else {
        undef $search_isbn;
        $isbn =~ s/\-//xmsg;
        if ( $isbn =~ m/(\d{13})/xms ) {
            my $b_isbn = Business::ISBN->new($1);
            if ( $b_isbn && $b_isbn->is_valid ) {
                $search_isbn = $b_isbn->as_isbn10->as_string( [] );
            }

        }
        elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
            my $b_isbn = Business::ISBN->new($1);
            if ( $b_isbn && $b_isbn->is_valid ) {
                $search_isbn = $b_isbn->as_isbn13->as_string( [] );
            }

        }
        if ($search_isbn) {
            $search_isbn = "%$search_isbn%";
            $tuple_arr =
              $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
            if ( @{$tuple_arr} ) {
                return $tuple_arr->[0];
            }
        }
    }
    return;
}

# returns a budget obj or undef
# fact we need this shows what a mess Acq API is
sub _get_budget {
    my ( $schema, $budget_code ) = @_;

    # db does not ensure budget code is unque
    return $schema->resultset('Aqbudget')->single(
        {
            budget_code => $budget_code,
        }
    );
}

1;
__END__

=head1 NAME
   Koha::EDI

=head1 SYNOPSIS

   Module exporting subroutines used in EDI processing for Koha

=head1 DESCRIPTION

   Subroutines called by batch processing to handle Edifact
   messages of various types and related utilities

=head1 BUGS

   These routines should really be methods of some object.
   get_edifact_ean is a stopgap which should be replaced

=head1 SUBROUTINES

=head2 process_quote

    process_quote(quote_message);

   passed a message object for a quote, parses it creating an order basket
   and orderlines in the database
   updates the message's status to received in the database and adds the
   link to basket

=head2 process_invoice

    process_invoice(invoice_message)

    passed a message object for an invoice, add the contained invoices
    and update the orderlines referred to in the invoice
    As an Edifact invoice is in effect a despatch note this receipts the
    appropriate quantities in the orders


=head2 create_edi_order

    create_edi_order( { parameter_hashref } )

    parameters must include basketno and ean

    branchcode can optionally be passed

    returns 1 on success undef otherwise

    if the parameter noingest is set the formatted order is returned
    and not saved in the database. This functionality is intended for debugging only

=head2 get_edifact_ean


=head2 quote_item

     quote_item(lineitem, quote_message);

      Called by process_quote to handle an individual lineitem
     Generate the biblios and items if required and orderline linking to them

=head1 AUTHOR

   Colin Campbell <colin.campbell@ptfs-europe.com>


=head1 COPYRIGHT

   Copyright 2014, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




package Koha::Edifact;

# Copyright 2014 PTFS-Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use strict;
use warnings;
use File::Slurp;
use Carp;
use Encode qw( from_to );
use Koha::Edifact::Segment;
use Koha::Edifact::Message;

my $separator = {
    component => q{\:},
    data      => q{\+},
    decimal   => q{.},
    release   => q{\?},
    reserved  => q{ },
    segment   => q{\'},
};

sub new {
    my ( $class, $param_hashref ) = @_;
    my $transmission;
    my $self = ();

    if ( $param_hashref->{filename} ) {
        if ( $param_hashref->{transmission} ) {
            carp
"Cannot instantiate $class : both filename and transmission passed";
            return;
        }
        $transmission = read_file( $param_hashref->{filename} );
    }
    else {
        $transmission = $param_hashref->{transmission};
    }
    $self->{transmission} = _init($transmission);

    bless $self, $class;
    return $self;
}

sub interchange_header {
    my ( $self, $field ) = @_;

    my %element = (
        sender                        => 1,
        recipient                     => 2,
        datetime                      => 3,
        interchange_control_reference => 4,
        application_reference         => 6,
    );
    if ( !exists $element{$field} ) {
        carp "No interchange header field $field available";
        return;
    }
    my $data = $self->{transmission}->[0]->elem( $element{$field} );
    return $data;
}

sub interchange_trailer {
    my ( $self, $field ) = @_;
    my $trailer = $self->{transmission}->[-1];
    if ( $field eq 'interchange_control_count' ) {
        return $trailer->elem(0);
    }
    elsif ( $field eq 'interchange_control_reference' ) {
        return $trailer->elem(1);
    }
    carp "Trailer field $field not recognized";
    return;
}

sub new_data_iterator {
    my $self   = shift;
    my $offset = 0;
    while ( $self->{transmission}->[$offset]->tag() ne 'UNH' ) {
        ++$offset;
        if ( $offset == @{ $self->{transmission} } ) {
            carp 'Cannot find message start';
            return;
        }
    }
    $self->{data_iterator} = $offset;
    return 1;
}

sub next_segment {
    my $self = shift;
    if ( defined $self->{data_iterator} ) {
        my $seg = $self->{transmission}->[ $self->{data_iterator} ];
        if ( $seg->tag eq 'UNH' ) {

            $self->{msg_type} = $seg->elem( 1, 0 );
        }
        elsif ( $seg->tag eq 'LIN' ) {
            $self->{msg_type} = 'detail';
        }

        if ( $seg->tag ne 'UNZ' ) {
            $self->{data_iterator}++;
        }
        else {
            $self->{data_iterator} = undef;
        }
        return $seg;
    }
    return;
}

# for debugging return whole transmission
sub get_transmission {
    my $self = shift;

    return $self->{transmission};
}

sub message_type {
    my $self = shift;
    return $self->{msg_type};
}

sub _init {
    my $msg = shift;
    if ( !$msg ) {
        return;
    }
    if ( $msg =~ s/^UNA(.{6})// ) {
        if ( service_string_advice($1) ) {
            return segmentize($msg);

        }
        return;
    }
    else {
        my $s = substr $msg, 10;
        croak "File does not start with a Service string advice :$s";
    }
}

# return an array of message data which will be used to
# create Message objects
sub message_array {
    my $self = shift;

    # return an array of array_refs 1 ref to a message
    my $msg_arr = [];
    my $msg     = [];
    my $in_msg  = 0;
    foreach my $seg ( @{ $self->{transmission} } ) {
        if ( $seg->tag eq 'UNH' ) {
            $in_msg = 1;
            push @{$msg}, $seg;
        }
        elsif ( $seg->tag eq 'UNT' ) {
            $in_msg = 0;
            if ( @{$msg} ) {
                push @{$msg_arr}, Koha::Edifact::Message->new($msg);
                $msg = [];
            }
        }
        elsif ($in_msg) {
            push @{$msg}, $seg;
        }
    }
    return $msg_arr;
}

#
# internal parsing routines used in _init
#
sub service_string_advice {
    my $ssa = shift;

    # At present this just validates that the ssa
    # is standard Edifact
    # TBD reset the seps if non standard
    if ( $ssa ne q{:+.? '} ) {
        carp " Non standard Service String Advice [$ssa]";
        return;
    }

    # else use default separators
    return 1;
}

sub segmentize {
    my $raw = shift;

    # In practice edifact uses latin-1 but check
    # Transport now converts to utf-8 on ingest
    # Do not convert here
    #my $char_set = 'iso-8859-1';
    #if ( $raw =~ m/^UNB[+]UNO(.)/ ) {
    #    $char_set = msgcharset($1);
    #}
    #from_to( $raw, $char_set, 'utf8' );

    my $re = qr{
(?>         # dont backtrack into this group
    [?].     # either the escape character
            # followed by any other character
     |      # or
     [^'?]   # a character that is neither escape
             # nor split
             )+
}x;
    my @segmented;
    while ( $raw =~ /($re)/g ) {
        push @segmented, Koha::Edifact::Segment->new( { seg_string => $1 } );
    }
    return \@segmented;
}

sub msgcharset {
    my $code = shift;
    if ( $code =~ m/^[^ABCDEF]$/ ) {
        $code = 'default';
    }
    my %encoding_map = (
        A       => 'ascii',
        B       => 'ascii',
        C       => 'iso-8859-1',
        D       => 'iso-8859-1',
        E       => 'iso-8859-1',
        F       => 'iso-8859-1',
        default => 'iso-8859-1',
    );
    return $encoding_map{$code};
}

1;
__END__

=head1 NAME
   Koha::Edifact

=head1 SYNOPSIS

=head1 DESCRIPTION

   Koha module for parsing Edifact messages

=head1 BUGS


=head1 SUBROUTINES

=head2 new

     my $e = Koha::Edifact->new( { filename => 'myfilename' } );
     or
     my $e = Koha::Edifact->new( { transmission => $msg_variable } );

     instantiate the Edifact parser, requires either to be passed an in-memory
     edifact message as transmission or a filename which it will read on creation

=head2 interchange_header

     will return the data in the header field designated by the parameter
     specified. Valid parameters are: 'sender', 'recipient', 'datetime',
    'interchange_control_reference', and 'application_reference'

=head2 interchange_trailer

     called either with the string 'interchange_control_count' or
     'interchange_control_reference' will return the corresponding field from
     the interchange trailer

=head2 new_data_iterator

     Sets the object's data_iterator to point to the UNH segment
=head2 next_segment

     Returns the next segment pointed to by the data_iterator. Increments the
     data_iterator member or destroys it if segment UNZ has been reached

=head2 get_transmission

     This method is useful in debugg:ing. Call on an Edifact it returns
     the object's transmission member

=head2 message_type

     return the object's message type

=head2 message_array

     return an array of Message objects contained in the Edifact transmission

=head1 Internal Methods

=head2 service_string_advice

  Examines the Service String Advice returns 1 if the default separartors are in use
  undef otherwise

=head2 segmentize

   takes a raw Edifact message and returns a reference to an array of
   its segments

=head2 msgcharset

    Return the character set the message was encoded in. The default is iso-8859-1

=head1 AUTHOR

   Colin Campbell <colin.campbell@ptfs-europe.com>


=head1 COPYRIGHT

   Copyright 2014, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




package Koha::Edifact::Line;

# Copyright 2014 PTFS-Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use strict;
use warnings;

use MARC::Record;
use MARC::Field;
use Carp;

sub new {
    my ( $class, $data_array_ref ) = @_;
    my $self = _parse_lines($data_array_ref);

    bless $self, $class;
    return $self;
}

# helper routine used by constructor
# creates the hashref used as a data structure by the Line object

sub _parse_lines {
    my $aref = shift;

    my $lin = shift @{$aref};

    my $d = {
        line_item_number       => $lin->elem(0),
        item_number_id         => $lin->elem( 2, 0 ),
        additional_product_ids => [],
    };
    my @item_description;

    foreach my $s ( @{$aref} ) {
        if ( $s->tag eq 'PIA' ) {
            push @{ $d->{additional_product_ids} },
              {
                function_code => $s->elem(0),
                item_number   => $s->elem( 1, 0 ),
                number_type   => $s->elem( 1, 1 ),
              };
        }
        elsif ( $s->tag eq 'IMD' ) {
            push @item_description, $s;
        }
        elsif ( $s->tag eq 'QTY' ) {
            $d->{quantity} = $s->elem( 0, 1 );
        }
        elsif ( $s->tag eq 'DTM' ) {
            $d->{avaiability_date} = $s->elem( 0, 1 );
        }
        elsif ( $s->tag eq 'GIR' ) {

            # we may get a Gir for each copy if QTY > 1
            if ( !$d->{GIR} ) {
                $d->{GIR} = [];
            }
            push @{ $d->{GIR} }, extract_gir($s);

        }
        elsif ( $s->tag eq 'FTX' ) {

            my $type = $s->elem(1);
            if ( $type eq 'LNO' ) {    # Ingrams Oasis Internal Notes field
                $type = 'internal_notes';
            }
            else {
                $type = 'free_text';
            }

            my $ftx = $s->elem(3);
            if ( ref $ftx eq 'ARRAY' ) {   # it comes in 70 character components
                $ftx = join ' ', @{$ftx};
            }
            if ( exists $d->{$type} ) {    # we can only catenate repeats
                $d->{$type} .= q{ };
                $d->{$type} .= $ftx;
            }
            else {
                $d->{$type} = $ftx;
            }
        }
        elsif ( $s->tag eq 'MOA' ) {

            $d->{monetary_amount} = $s->elem( 0, 1 );
        }
        elsif ( $s->tag eq 'PRI' ) {

            $d->{price} = $s->elem( 0, 1 );
        }
        elsif ( $s->tag eq 'RFF' ) {
            my $qualifier = $s->elem( 0, 0 );
            if ( $qualifier eq 'QLI' ) { # Suppliers unique quotation linenumber
                $d->{reference} = $s->elem( 0, 1 );
            }
            elsif ( $qualifier eq 'LI' ) {    # Buyer's unique orderline number
                $d->{ordernumber} = $s->elem( 0, 1 );
            }
        }
    }
    $d->{item_description} = _format_item_description(@item_description);
    $d->{segs}             = $aref;

    return $d;
}

sub _format_item_description {
    my @imd    = @_;
    my $bibrec = {};

 # IMD : +Type code 'L' + characteristic code 3 char + Description in comp 3 & 4
    foreach my $imd (@imd) {
        my $type_code = $imd->elem(0);
        my $ccode     = $imd->elem(1);
        my $desc      = $imd->elem( 2, 3 );
        if ( $imd->elem( 2, 4 ) ) {
            $desc .= $imd->elem( 2, 4 );
        }
        if ( $type_code ne 'L' ) {
            carp
              "Only handles text item descriptions at present: code=$type_code";
            next;
        }
        if ( exists $bibrec->{$ccode} ) {
            $bibrec->{$ccode} .= q{ };
            $bibrec->{$ccode} .= $desc;
        }
        else {
            $bibrec->{$ccode} = $desc;
        }
    }
    return $bibrec;
}

sub marc_record {
    my $self = shift;
    my $b    = $self->{item_description};

    my $bib = MARC::Record->new();

    my @spec;
    my @fields;
    if ( exists $b->{'010'} ) {
        @spec = qw( 100 a 011 c 012 b 013 d 014 e );
        push @fields, new_field( $b, [ 100, 1, q{ } ], @spec );
    }
    if ( exists $b->{'020'} ) {
        @spec = qw( 020 a 021 c 022 b 023 d 024 e );
        push @fields, new_field( $b, [ 700, 1, q{ } ], @spec );
    }

    # corp conf
    if ( exists $b->{'030'} ) {
        push @fields, $self->corpcon(1);
    }
    if ( exists $b->{'040'} ) {
        push @fields, $self->corpcon(7);
    }
    if ( exists $b->{'050'} ) {
        @spec = qw( '050' a '060' b '065' c );
        push @fields, new_field( $b, [ 245, 1, 0 ], @spec );
    }
    if ( exists $b->{100} ) {
        @spec = qw( 100 a 101 b);
        push @fields, new_field( $b, [ 250, q{ }, q{ } ], @spec );
    }
    @spec = qw( 110 a 120 b 170 c );
    my $f = new_field( $b, [ 260, q{ }, q{ } ], @spec );
    if ($f) {
        push @fields, $f;
    }
    @spec = qw( 180 a 181 b 182 c 183 e);
    $f = new_field( $b, [ 300, q{ }, q{ } ], @spec );
    if ($f) {
        push @fields, $f;
    }
    if ( exists $b->{190} ) {
        @spec = qw( 190 a);
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
    }

    if ( exists $b->{200} ) {
        @spec = qw( 200 a);
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
    }
    if ( exists $b->{210} ) {
        @spec = qw( 210 a);
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
    }
    if ( exists $b->{300} ) {
        @spec = qw( 300 a);
        push @fields, new_field( $b, [ 500, q{ }, q{ } ], @spec );
    }
    if ( exists $b->{310} ) {
        @spec = qw( 310 a);
        push @fields, new_field( $b, [ 520, q{ }, q{ } ], @spec );
    }
    if ( exists $b->{320} ) {
        @spec = qw( 320 a);
        push @fields, new_field( $b, [ 521, q{ }, q{ } ], @spec );
    }
    if ( exists $b->{260} ) {
        @spec = qw( 260 a);
        push @fields, new_field( $b, [ 600, q{ }, q{ } ], @spec );
    }
    if ( exists $b->{270} ) {
        @spec = qw( 270 a);
        push @fields, new_field( $b, [ 650, q{ }, q{ } ], @spec );
    }
    if ( exists $b->{280} ) {
        @spec = qw( 280 a);
        push @fields, new_field( $b, [ 655, q{ }, q{ } ], @spec );
    }

    # class
    if ( exists $b->{230} ) {
        @spec = qw( 230 a);
        push @fields, new_field( $b, [ '082', q{ }, q{ } ], @spec );
    }
    if ( exists $b->{240} ) {
        @spec = qw( 240 a);
        push @fields, new_field( $b, [ '084', q{ }, q{ } ], @spec );
    }
    $bib->insert_fields_ordered(@fields);

    return $bib;
}

sub corpcon {
    my ( $self, $level ) = @_;
    my $test_these = {
        1 => [ '033', '032', '034' ],
        7 => [ '043', '042', '044' ],
    };
    my $conf = 0;
    foreach my $t ( @{ $test_these->{$level} } ) {
        if ( exists $self->{item_description}->{$t} ) {
            $conf = 1;
        }
    }
    my $tag;
    my @spec;
    my ( $i1, $i2 ) = ( q{ }, q{ } );
    if ($conf) {
        $tag = ( $level * 100 ) + 11;
        if ( $level == 1 ) {
            @spec = qw( 030 a 031 e 032 n 033 c 034 d);
        }
        else {
            @spec = qw( 040 a 041 e 042 n 043 c 044 d);
        }
    }
    else {
        $tag = ( $level * 100 ) + 10;
        if ( $level == 1 ) {
            @spec = qw( 030 a 031 b);
        }
        else {
            @spec = qw( 040 a 041 b);
        }
    }
    return new_field( $self->{item_description}, [ $tag, $i1, $i2 ], @spec );
}

sub new_field {
    my ( $b, $tag_ind, @sfd_elem ) = @_;
    my @sfd;
    while (@sfd_elem) {
        my $e = shift @sfd_elem;
        my $c = shift @sfd_elem;
        if ( exists $b->{$e} ) {
            push @sfd, $c, $b->{$e};
        }
    }
    if (@sfd) {
        my $field = MARC::Field->new( @{$tag_ind}, @sfd );
        return $field;
    }
    return;
}

# Accessor methods to line data

sub item_number_id {
    my $self = shift;
    return $self->{item_number_id};
}

sub line_item_number {
    my $self = shift;
    return $self->{line_item_number};
}

sub additional_product_ids {
    my $self = shift;
    return $self->{additional_product_ids};
}

sub item_description {
    my $self = shift;
    return $self->{item_description};
}

sub monetary_amount {
    my $self = shift;
    return $self->{monetary_amount};
}

sub quantity {
    my $self = shift;
    return $self->{quantity};
}

sub price {
    my $self = shift;
    return $self->{price};
}

sub reference {
    my $self = shift;
    return $self->{reference};
}

sub ordernumber {
    my $self = shift;
    return $self->{ordernumber};
}

sub free_text {
    my $self = shift;
    return $self->{free_text};
}

sub internal_notes {
    my $self = shift;
    return $self->{internal_notes};
}

# item_desription_fields accessors

sub title {
    my $self       = shift;
    my $titlefield = q{050};
    if ( exists $self->{item_description}->{$titlefield} ) {
        return $self->{item_description}->{$titlefield};
    }
    return;
}

sub author {
    my $self  = shift;
    my $field = q{010};
    if ( exists $self->{item_description}->{$field} ) {
        return $self->{item_description}->{$field};
    }
    return;
}

sub series {
    my $self  = shift;
    my $field = q{190};
    if ( exists $self->{item_description}->{$field} ) {
        return $self->{item_description}->{$field};
    }
    return;
}

sub publisher {
    my $self  = shift;
    my $field = q{120};
    if ( exists $self->{item_description}->{$field} ) {
        return $self->{item_description}->{$field};
    }
    return;
}

sub publication_date {
    my $self  = shift;
    my $field = q{170};
    if ( exists $self->{item_description}->{$field} ) {
        return $self->{item_description}->{$field};
    }
    return;
}

sub girfield {
    my ( $self, $field, $occ ) = @_;

    # defaults to occurence 0 returns undef if occ requested > occs
    if ( defined $occ && $occ > @{ $self->{GIR} } ) {
        return;
    }
    $occ ||= 0;
    return $self->{GIR}->[$occ]->{$field};
}

sub extract_gir {
    my $s    = shift;
    my %qmap = (
        LAC => 'barcode',
        LCL => 'classification',
        LFN => 'fund_allocation',
        LLN => 'loan_category',
        LLO => 'branch',
        LSM => 'shelfmark',
        LSQ => 'collection_code',
        LST => 'stock_category',
        LVT => 'servicing_instruction',
        LCO => 'item_unique_id',
    );

    my $set_qualifier = $s->elem( 0, 0 );    # copy number
    my $gir_element = { copy => $set_qualifier, };
    my $element = 1;
    while ( my $e = $s->elem($element) ) {
        ++$element;
        if ( exists $qmap{ $e->[1] } ) {
            my $qualifier = $qmap{ $e->[1] };
            $gir_element->{$qualifier} = $e->[0];
        }
        else {

            carp "Unrecognized GIR code : $e->[1] for $e->[0]";
        }
    }
    return $gir_element;
}

# mainly for invoice processing amt_ will derive from MOA price_ from PRI and tax_ from TAX/MOA pairsn
sub moa_amt {
    my ( $self, $qualifier ) = @_;
    foreach my $s ( @{ $self->{segs} } ) {
        if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) {
            return $s->elem( 0, 1 );
        }
    }
    return;
}

sub amt_discount {
    my $self = shift;
    return $self->moa_amt('52');
}

sub amt_prepayment {
    my $self = shift;
    return $self->moa_amt('113');
}

# total including allowances & tax
sub amt_total {
    my $self = shift;
    return $self->moa_amt('128');
}

sub amt_unitprice {
    my $self = shift;
    return $self->moa_amt('146');
}

# item amount after allowances excluding tax
sub amt_lineitem {
    my $self = shift;
    return $self->moa_amt('146');
}

sub pri_price {
    my ( $self, $price_qualifier ) = @_;
    foreach my $s ( @{ $self->{segs} } ) {
        if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) {
            return {
                price          => $s->elem( 0, 1 ),
                type           => $s->elem( 0, 2 ),
                type_qualifier => $s->elem( 0, 3 ),
            };
        }
    }
    return;
}

# unit price that will be chaged excl tax
sub price_net {
    my $self = shift;
    my $p    = $self->pri_price('AAA');
    if ( defined $p ) {
        return $p->{price};
    }
    return;
}

# unit price excluding all allowances, charges and taxes
sub price_gross {
    my $self = shift;
    my $p    = $self->pri_price('AAB');
    if ( defined $p ) {
        return $p->{price};
    }
    return;
}

# information price incl tax excluding allowances, charges
sub price_info {
    my $self = shift;
    my $p    = $self->pri_price('AAE');
    if ( defined $p ) {
        return $p->{price};
    }
    return;
}

# information price incl tax,allowances, charges
sub price_info_inclusive {
    my $self = shift;
    my $p    = $self->pri_price('AAE');
    if ( defined $p ) {
        return $p->{price};
    }
    return;
}

sub tax {
    my $self = shift;
    return $self->moa_amt('124');
}

1;
__END__

=head1 NAME
   Koha::Edifact::Line

=head1 SYNOPSIS

  Class to abstractly handle a Line in an Edifact Transmission

=head1 DESCRIPTION

  Allows access to Edifact line elements by name

=head1 BUGS


=head1 Methods

=head2 new

   Called with an array ref of segments constituting the line

=head1 AUTHOR

   Colin Campbell <colin.campbell@ptfs-europe.com>


=head1 COPYRIGHT

   Copyright 2014, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




package Koha::Edifact::Message;

# Copyright 2014 PTFS-Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use strict;
use warnings;

use Koha::Edifact::Line;

sub new {
    my ( $class, $data_array_ref ) = @_;
    my $header       = shift @{$data_array_ref};
    my $bgm          = shift @{$data_array_ref};
    my $msg_function = $bgm->elem(2);
    my $dtm          = [];
    while ( $data_array_ref->[0]->tag eq 'DTM' ) {
        push @{$dtm}, shift @{$data_array_ref};
    }

    my $self = {
        function                 => $msg_function,
        header                   => $header,
        bgm                      => $bgm,
        message_reference_number => $header->elem(0),
        dtm                      => $dtm,
        datasegs                 => $data_array_ref,
    };

    bless $self, $class;
    return $self;
}

sub message_refno {
    my $self = shift;
    return $self->{message_reference_number};
}

sub function {
    my $self         = shift;
    my $msg_function = $self->{bgm}->elem(2);
    if ( $msg_function == 9 ) {
        return 'original';
    }
    elsif ( $msg_function == 7 ) {
        return 'retransmission';
    }
    return;
}

sub message_reference_number {
    my $self = shift;
    return $self->{header}->elem(0);
}

sub message_type {
    my $self = shift;
    return $self->{header}->elem( 1, 0 );
}

sub message_code {
    my $self = shift;
    return $self->{bgm}->elem( 0, 0 );
}

sub docmsg_number {
    my $self = shift;
    return $self->{bgm}->elem(1);
}

sub message_date {
    my $self = shift;

    # usually the first if not only dtm
    foreach my $d ( @{ $self->{dtm} } ) {
        if ( $d->elem( 0, 0 ) eq '137' ) {
            return $d->elem( 0, 1 );
        }
    }
    return;    # this should not happen
}

sub tax_point_date {
    my $self = shift;
    if ( $self->message_type eq 'INVOIC' ) {
        foreach my $d ( @{ $self->{dtm} } ) {
            if ( $d->elem( 0, 0 ) eq '131' ) {
                return $d->elem( 0, 1 );
            }
        }
    }
    return;
}

sub expiry_date {
    my $self = shift;
    if ( $self->message_type eq 'QUOTES' ) {
        foreach my $d ( @{ $self->{dtm} } ) {
            if ( $d->elem( 0, 0 ) eq '36' ) {
                return $d->elem( 0, 1 );
            }
        }
    }
    return;
}

sub shipment_charge {
    my $self = shift;

    # A large number of different charges can be expressed at invoice and
    # item level but the only one koha takes cognizance of is shipment
    # should we wrap all invoice level charges into it??
    if ( $self->message_type eq 'INVOIC' ) {
        my $delivery = 0;
        my $amt      = 0;
        foreach my $s ( @{ $self->{datasegs} } ) {
            if ( $s->tag eq 'LIN' ) {
                last;
            }
            if ( $s->tag eq 'ALC' ) {
                if ( $s->elem(0) eq 'C' ) {    # Its a charge
                    if ( $s->elem( 4, 0 ) eq 'DL' ) {    # delivery charge
                        $delivery = 1;
                    }
                }
                next;
            }
            if ( $s->tag eq 'MOA' ) {
                $amt += $s->elem( 0, 1 );
            }
        }
        return $amt;
    }
    return;
}

# return NAD fields

sub buyer_ean {
    my $self = shift;
    foreach my $s ( @{ $self->{datasegs} } ) {
        if ( $s->tag eq 'LIN' ) {
            last;
        }
        if ( $s->tag eq 'NAD' ) {
            my $qualifier = $s->elem(0);
            if ( $qualifier eq 'BY' ) {
                return $s->elem( 1, 0 );
            }
        }
    }
    return;
}

sub supplier_ean {
    my $self = shift;
    foreach my $s ( @{ $self->{datasegs} } ) {
        if ( $s->tag eq 'LIN' ) {
            last;
        }
        if ( $s->tag eq 'NAD' ) {
            my $qualifier = $s->elem(0);
            if ( $qualifier eq 'SU' ) {
                return $s->elem( 1, 0 );
            }
        }
    }
    return;

}

sub lineitems {
    my $self = shift;
    if ( $self->{quotation_lines} ) {
        return $self->{quotation_lines};
    }
    else {
        my $items    = [];
        my $item_arr = [];
        foreach my $seg ( @{ $self->{datasegs} } ) {
            my $tag = $seg->tag;
            if ( $tag eq 'LIN' ) {
                if ( @{$item_arr} ) {
                    push @{$items}, Koha::Edifact::Line->new($item_arr);
                }
                $item_arr = [$seg];
                next;
            }
            elsif ( $tag =~ m/^(UNS|CNT|UNT)$/sxm ) {
                if ( @{$item_arr} ) {
                    push @{$items}, Koha::Edifact::Line->new($item_arr);
                }
                last;
            }
            else {
                if ( @{$item_arr} ) {
                    push @{$item_arr}, $seg;
                }
            }
        }
        $self->{quotation_lines} = $items;
        return $items;
    }
}

1;
__END__

=head1 NAME
   Koha::Edifact::Message

=head1 SYNOPSIS


=head1 DESCRIPTION

Class modelling an Edifact Message for parsing

=head1 BUGS


=head1 METHODS

=head2 new

   Passed an array of segments extracts message level info
   and parses lineitems as Line objects

=head1 AUTHOR

   Colin Campbell <colin.campbell@ptfs-europe.com>


=head1 COPYRIGHT

   Copyright 2014, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




package Koha::Edifact::Order;

use strict;
use warnings;

# Copyright 2014 PTFS-Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Carp;
use DateTime;
use Readonly;
use Business::ISBN;
use Encode qw(from_to);
use Koha::Database;
use C4::Budgets qw( GetBudget );

Readonly::Scalar my $seg_terminator      => q{'};
Readonly::Scalar my $separator           => q{+};
Readonly::Scalar my $component_separator => q{:};
Readonly::Scalar my $release_character   => q{?};

Readonly::Scalar my $NINES_12  => 999_999_999_999;
Readonly::Scalar my $NINES_14  => 99_999_999_999_999;
Readonly::Scalar my $CHUNKSIZE => 35;

my $use_marc_based_description =
  0;    # A global configflag : not currently implemented

sub new {
    my ( $class, $parameter_hashref ) = @_;

    my $self = {};
    if ( ref $parameter_hashref ) {
        $self->{orderlines} = $parameter_hashref->{orderlines};
        $self->{recipient}  = $parameter_hashref->{vendor};
        $self->{sender}     = $parameter_hashref->{ean};

        # convenient alias
        $self->{basket} = $self->{orderlines}->[0]->basketno;
        $self->{message_date} = DateTime->now( time_zone => 'local' );
    }

    # validate that its worth proceeding
    if ( !$self->{orderlines} ) {
        carp 'No orderlines passed to create order';
        return;
    }
    if ( !$self->{recipient} ) {
        carp
"No vendor passed to order creation: basket = $self->{basket}->basketno()";
        return;
    }
    if ( !$self->{sender} ) {
        carp
"No sender ean passed to order creation: basket = $self->{basket}->basketno()";
        return;
    }

    # do this once per object not once per orderline
    my $database = Koha::Database->new();
    $self->{schema} = $database->schema;

    bless $self, $class;
    return $self;
}

sub filename {
    my $self = shift;
    if ( !$self->{orderlines} ) {
        return;
    }
    my $filename = 'ordr' . $self->{basket}->basketno;
    $filename .= '.CEP';
    return $filename;
}

sub encode {
    my ($self) = @_;

    $self->{interchange_control_reference} = int rand($NINES_14);
    $self->{message_count}                 = 0;

    #    $self->{segs}; # Message segments

    $self->{transmission} = q{};

    $self->{transmission} .= $self->initial_service_segments();

    $self->{transmission} .= $self->user_data_message_segments();

    $self->{transmission} .= $self->trailing_service_segments();
    return $self->{transmission};
}

sub msg_date_string {
    my $self = shift;
    return $self->{message_date}->ymd();
}

sub initial_service_segments {
    my $self = shift;

    #UNA service string advice - specifies standard separators
    my $segs = _const('service_string_advice');

    #UNB interchange header
    $segs .= $self->interchange_header();

    #UNG functional group header NOT USED
    return $segs;
}

sub interchange_header {
    my $self = shift;

    # syntax identifier
    my $hdr =
      'UNB+UNOC:3';    # controling agency character set syntax version number
                       # Interchange Sender
    $hdr .= _interchange_sr_identifier( $self->{sender}->ean,
        $self->{sender}->id_code_qualifier );    # interchange sender
    $hdr .= _interchange_sr_identifier( $self->{recipient}->san,
        $self->{recipient}->id_code_qualifier );    # interchange Recipient

    $hdr .= $separator;

    # DateTime of preparation
    $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm');
    $hdr .= $separator;
    $hdr .= $self->interchange_control_reference();
    $hdr .= $separator;

    # Recipents reference password not usually used in edifact
    $hdr .= q{+ORDERS};                             # application reference

#Edifact does not usually include the following
#    $hdr .= $separator; # Processing priority  not usually used in edifact
#    $hdr .= $separator; # Acknowledgewment request : not usually used in edifact
#    $hdr .= q{+EANCOM} # Communications agreement id
#    $hdr .= q{+1} # Test indicator
#
    $hdr .= $seg_terminator;
    return $hdr;
}

sub user_data_message_segments {
    my $self = shift;

    #UNH message_header  :: seg count begins here
    $self->message_header();

    $self->order_msg_header();

    my $line_number = 0;
    foreach my $ol ( @{ $self->{orderlines} } ) {
        ++$line_number;
        $self->order_line( $line_number, $ol );
    }

    $self->message_trailer();

    my $data_segment_string = join q{}, @{ $self->{segs} };
    return $data_segment_string;
}

sub message_trailer {
    my $self = shift;

    # terminate the message
    $self->add_seg("UNS+S$seg_terminator");

    # CNT Control_Total
    # Could be (code  1) total value of QTY segments
    # or ( code = 2 ) number of lineitems
    my $num_orderlines = @{ $self->{orderlines} };
    $self->add_seg("CNT+2:$num_orderlines$seg_terminator");

    # UNT Message Trailer
    my $segments_in_message =
      1 + @{ $self->{segs} };    # count incl UNH & UNT (!!this one)
    my $reference = $self->message_reference('current');
    $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator");
    return;
}

sub trailing_service_segments {
    my $self    = shift;
    my $trailer = q{};

    #UNE functional group trailer NOT USED
    #UNZ interchange trailer
    $trailer .= $self->interchange_trailer();

    return $trailer;
}

sub interchange_control_reference {
    my $self = shift;
    if ( $self->{interchange_control_reference} ) {
        return sprintf '%014d', $self->{interchange_control_reference};
    }
    else {
        carp 'calling for ref of unencoded order';
        return 'NONE ASSIGNED';
    }
}

sub message_reference {
    my ( $self, $function ) = @_;
    if ( $function eq 'new' || !$self->{message_reference_no} ) {

        # unique 14 char mesage ref
        $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12);
    }
    return $self->{message_reference_no};
}

sub message_header {
    my $self = shift;

    $self->{segs} = [];          # initialize the message
    $self->{message_count}++;    # In practice alwaya 1

    my $hdr = q{UNH+} . $self->message_reference('new');
    $hdr .= _const('message_identifier');
    $self->add_seg($hdr);
    return;
}

sub interchange_trailer {
    my $self = shift;

    my $t = "UNZ+$self->{message_count}+";
    $t .= $self->interchange_control_reference;
    $t .= $seg_terminator;
    return $t;
}

sub order_msg_header {
    my $self = shift;
    my @header;

    # UNH  see message_header
    # BGM
    push @header, beginning_of_message( $self->{basket}->basketno );

    # DTM
    push @header, message_date_segment( $self->{message_date} );

    # NAD-RFF buyer supplier ids
    push @header,
      name_and_address(
        'BUYER',
        $self->{sender}->ean,
        $self->{sender}->id_code_qualifier
      );
    push @header,
      name_and_address(
        'SUPPLIER',
        $self->{recipient}->san,
        $self->{recipient}->id_code_qualifier
      );

    # repeat for for other relevant parties

    # CUX currency
    # ISO 4217 code to show default currency prices are quoted in
    # e.g. CUX+2:GBP:9'
    # TBD currency handling

    $self->add_seg(@header);
    return;
}

sub beginning_of_message {
    my $basketno = shift;
    my $document_message_no = sprintf '%011d', $basketno;

    #    my $message_function = 9;    # original 7 = retransmission
    # message_code values
    #      220 prder
    #      224 rush order
    #      228 sample order :: order for approval / inspection copies
    #      22C continuation  order for volumes in a set etc.
    #    my $message_code = '220';

    return "BGM+220+$document_message_no+9$seg_terminator";
}

sub name_and_address {
    my ( $party, $id_code, $id_agency ) = @_;
    my %qualifier_code = (
        BUYER    => 'BY',
        DELIVERY => 'DP',    # delivery location if != buyer
        INVOICEE => 'IV',    # if different from buyer
        SUPPLIER => 'SU',
    );
    if ( !exists $qualifier_code{$party} ) {
        carp "No qualifier code for $party";
        return;
    }
    if ( $id_agency eq '14' ) {
        $id_agency = '9';    # ean coded differently in this seg
    }

    return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator";
}

sub order_line {
    my ( $self, $linenumber, $orderline ) = @_;

    my $schema       = $self->{schema};
    my $biblionumber = $orderline->biblionumber->biblionumber;
    my @biblioitems  = $schema->resultset('Biblioitem')
      ->search( { biblionumber => $biblionumber, } );
    my $biblioitem = $biblioitems[0];    # makes the assumption there is 1 only
                                         # or else all have same details

    # LIN line-number in msg :: if we had a 13 digit ean we could add
    $self->add_seg( lin_segment( $linenumber, $biblioitem->isbn ) );

    # PIA isbn or other id
    $self->add_seg( additional_product_id( $biblioitem->isbn ) );

    # IMD biblio description
    if ($use_marc_based_description) {

        # get marc from biblioitem->marc

        # $ol .= marc_item_description($orderline->{bib_description});
    }
    else {    # use brief description
        $self->add_seg(
            item_description( $orderline->biblionumber, $biblioitem ) );
    }

    # QTY order quantity
    my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator;
    $self->add_seg($qty);

    # DTM Optional date constraints on delivery
    #     we dont currently support this in koha
    # GIR copy-related data
    my @items;
    if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
        my @linked_itemnumbers = $orderline->aqorders_items;

        foreach my $item (@linked_itemnumbers) {
            my $i_obj = $schema->resultset('Item')->find( $item->itemnumber );
            if ( defined $i_obj ) {
                push @items, $i_obj;
            }
        }
    }
    else {
        my $item_hash = {
            itemtype  => $biblioitem->itemtype,
            shelfmark => $biblioitem->cn_class,
        };
        my $branch = $orderline->basketno->branch->branchcode;
        if ($branch) {
            $item_hash->{branch} = $branch;
        }
        for ( 1 .. $orderline->quantity ) {
            push @items, $item_hash;
        }
    }
    my $budget = GetBudget( $orderline->budget_id );
    my $ol_fields = { budget_code => $budget->{budget_code}, };
    if ( $orderline->order_vendornote ) {
        $ol_fields->{servicing_instruction} = $orderline->order_vendornote;
    }
    $self->add_seg( gir_segments( $ol_fields, @items ) );

    # TBD what if #items exceeds quantity

    # FTX free text for current orderline TBD
    #    dont really have a special instructions field to encode here
    # Encode notes here
    # PRI-CUX-DTM unit price on which order is placed : optional
    # Coutts read this as 0.00 if not present
    if ( $orderline->listprice ) {
        my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice;
        $price .= $seg_terminator;
        $self->add_seg($price);
    }

    # RFF unique orderline reference no
    my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator;
    $self->add_seg($rff);

    # LOC-QTY multiple delivery locations
    #TBD to specify extra delivery locs
    # NAD order line name and address
    #TBD Optionally indicate a name & address or order originator
    # TDT method of delivey ol-specific
    # TBD requests a special delivery option

    return;
}

# ??? Use the IMD MARC
sub marc_based_description {

    # this includes a much larger number of fields
    return;
}

sub item_description {
    my ( $bib, $biblioitem ) = @_;
    my $bib_desc = {
        author    => $bib->author,
        title     => $bib->title,
        publisher => $biblioitem->publishercode,
        year      => $biblioitem->publicationyear,
    };

    my @itm = ();

    # 009 Author
    # 050 Title   :: title
    # 080 Vol/Part no
    # 100 Edition statement
    # 109 Publisher  :: publisher
    # 110 place of pub
    # 170 Date of publication :: year
    # 220 Binding  :: binding
    my %code = (
        author    => '009',
        title     => '050',
        publisher => '109',
        year      => '170',
        binding   => '220',
    );
    for my $field (qw(author title publisher year binding )) {
        if ( $bib_desc->{$field} ) {
            my $data = encode_text( $bib_desc->{$field} );
            push @itm, imd_segment( $code{$field}, $data );
        }
    }

    return @itm;
}

sub imd_segment {
    my ( $code, $data ) = @_;

    my $seg_prefix = "IMD+L+$code+:::";

    # chunk_line
    my @chunks;
    while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) {
        if ( length $x == $CHUNKSIZE ) {
            if ( $x =~ s/([?]{1,2})$// ) {
                $data = "$1$data";    # dont breakup ?' ?? etc
            }
        }
        push @chunks, $x;
    }
    my @segs;
    my $odd = 1;
    foreach my $c (@chunks) {
        if ($odd) {
            push @segs, "$seg_prefix$c";
        }
        else {
            $segs[-1] .= ":$c$seg_terminator";
        }
        $odd = !$odd;
    }
    if ( @segs && $segs[-1] !~ m/$seg_terminator$/o ) {
        $segs[-1] .= $seg_terminator;
    }
    return @segs;
}

sub gir_segments {
    my ( $orderfields, @onorderitems ) = @_;

    my $budget_code = $orderfields->{budget_code};
    my @segments;
    my $sequence_no = 1;
    foreach my $item (@onorderitems) {
        my $seg = sprintf 'GIR+%03d', $sequence_no;
        $seg .= add_gir_identity_number( 'LFN', $budget_code );
        if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
            $seg .=
              add_gir_identity_number( 'LLO', $item->homebranch->branchcode );
            $seg .= add_gir_identity_number( 'LST', $item->itype );
            $seg .= add_gir_identity_number( 'LSQ', $item->location );
            $seg .= add_gir_identity_number( 'LSM', $item->itemcallnumber );

            # itemcallnumber -> shelfmark
        }
        else {
            if ( $item->{branch} ) {
                $seg .= add_gir_identity_number( 'LLO', $item->{branch} );
            }
            $seg .= add_gir_identity_number( 'LST', $item->{itemtype} );
            $seg .= add_gir_identity_number( 'LSM', $item->{shelfmark} );
        }
        if ( $orderfields->{servicing_instruction} ) {
            $seg .= add_gir_identity_number( 'LVT',
                $orderfields->{servicing_instruction} );
        }
        $sequence_no++;
        push @segments, $seg;
    }
    return @segments;
}

sub add_gir_identity_number {
    my ( $number_qualifier, $number ) = @_;
    if ($number) {
        return "+${number}:${number_qualifier}";
    }
    return q{};
}

sub add_seg {
    my ( $self, @s ) = @_;
    foreach my $segment (@s) {
        if ( $segment !~ m/$seg_terminator$/o ) {
            $segment .= $seg_terminator;
        }
    }
    push @{ $self->{segs} }, @s;
    return;
}

sub lin_segment {
    my ( $line_number, $isbn ) = @_;
    my $isbn_string = q||;
    if ($isbn) {
        if ( $isbn =~ m/(978\d{10})/ ) {
            $isbn = $1;
        }
        elsif ( $isbn =~ m/(\d{9}[\dxX])/ ) {
            $isbn = $1;
        }
        else {
            undef $isbn;
        }
        if ($isbn) {
            my $b_isbn = Business::ISBN->new($isbn);
            if ( $b_isbn->is_valid ) {
                $isbn        = $b_isbn->as_isbn13->isbn;
                $isbn_string = "++$isbn:EN";
            }
        }
    }
    return "LIN+$line_number$isbn_string$seg_terminator";
}

sub additional_product_id {
    my $isbn_field = shift;
    my ( $product_id, $product_code );
    if ( $isbn_field =~ m/(\d{13})/ ) {
        $product_id   = $1;
        $product_code = 'EN';
    }
    elsif ( $isbn_field =~ m/(\d{9})[Xx\d]/ ) {
        $product_id   = $1;
        $product_code = 'IB';
    }

    # TBD we could have a manufacturers no issn etc
    if ( !$product_id ) {
        return;
    }

    # function id set to 5 states this is the main product id
    return "PIA+5+$product_id:$product_code$seg_terminator";
}

sub message_date_segment {
    my $dt = shift;

    # qualifier:message_date:format_code

    my $message_date = $dt->ymd(q{});    # no sep in edifact format

    return "DTM+137:$message_date:102$seg_terminator";
}

sub _const {
    my $key = shift;
    Readonly my %S => {
        service_string_advice => q{UNA:+.? '},
        message_identifier    => q{+ORDERS:D:96A:UN:EAN008'},
    };
    return ( $S{$key} ) ? $S{$key} : q{};
}

sub _interchange_sr_identifier {
    my ( $identification, $qualifier ) = @_;

    if ( !$identification ) {
        $identification = 'RANDOM';
        $qualifier      = '92';
        carp 'undefined identifier';
    }

    # 14   EAN International
    # 31B   US SAN (preferred)
    # also 91 assigned by supplier
    # also 92 assigned by buyer
    if ( $qualifier !~ m/^(?:14|31B|91|92)/xms ) {
        $qualifier = '92';
    }

    return "+$identification:$qualifier";
}

sub encode_text {
    my $string = shift;
    if ($string) {
        from_to( $string, 'utf8', 'iso-8859-1' );
        $string =~ s/[?]/??/g;
        $string =~ s/'/?'/g;
        $string =~ s/:/?:/g;
        $string =~ s/[+]/?+/g;
    }
    return $string;
}

1;
__END__

=head1 NAME
   Koha::Edifact::Order

=head1 SYNOPSIS

Format an Edifact Order message from a Koha basket

=head1 DESCRIPTION


Generates an Edifact format Order message for a Koha basket.
Normally the only methods used directly by the caller would be
new to set up the message, encode to return the formatted message
and filename to obtain a name under which to store the message


=head1 BUGS

Should integrate into Koha::Edifact namespace
Can caller interface be made cleaner?
Make handling of GIR segments more customizable


=head1 METHODS

=head2 new

  my $edi_order = Edifact::Order->new(
  orderlines => \@orderlines,
  vendor     => $vendor_edi_account,
  ean        => $library_ean
  );

  instantiate the Edifact::Order object, all parameters are Schema::Resultset objects
  Called in Koha::Edifact create_edi_order

=head2 filename

   my $filename = $edi_order->filename()

   returns a filename for the edi order. The filename embeds a reference to the
   basket the message was created to encode

=head2 encode

   my $edifact_message = $edi_order->encode();

   Encodes the basket as a valid edifact message ready for transmission

=head2 initial_service_segments

    Creates the service segments which begin the message

=head2 interchange_header

    Return an interchange header encoding sender and recipient
    ids message date and standards

=head2 user_data_message_segments

    Include message data within the encoded message

=head2 message_trailer

    Terminate message data including control data on number
    of messages and segments included

=head2 trailing_service_segments

   Include the service segments occuring at the end of the message
=head2 interchange_control_reference

   Returns the unique interchange control reference as a 14 digit number

=head2 message_reference

    On generates and subsequently returns the unique message
    reference number as a 12 digit number preceded by ME, to generate a new number
    pass the string 'new'.
    In practice we encode 1 message per transmission so there is only one message
    referenced. were we to encode multiple messages a new reference would be
    neaded for each

=head2 message_header

    Commences a new message

=head2 interchange_trailer

    returns the UNZ segment which ends the tranmission encoding the
    message count and control reference for the interchange

=head2 order_msg_header

    Formats the message header segments

=head2 beginning_of_message

    Returns the BGM segment which includes the Koha basket number

=head2 name_and_address

    Parameters: Function ( BUYER, DELIVERY, INVOICE, SUPPLIER)
                Id
                Agency

    Returns a NAD segment containg the id and agency for for the Function
    value. Handles the fact that NAD segments encode the value for 'EAN' differently
    to elsewhere.

=head2 order_line

    Creates the message segments wncoding an order line

=head2 marc_based_description

    Not yet implemented - To encode the the bibliographic info
    as MARC based IMD fields has the potential of encoding a wider range of info

=head2 item_description

    Encodes the biblio item fields Author, title, publisher, date of publication
    binding

=head2 imd_segment

    Formats an IMD segment, handles the chunking of data into the 35 character
    lengths required and the creation of repeat segments

=head2 gir_segments

    Add item level information

=head2 add_gir_identity_number

    Handle the formatting of a GIR element
    return empty string if no data

=head2 add_seg

    Adds a parssed array of segments to the objects segment list
    ensures all segments are properly terminated by '

=head2 lin_segment

    Adds a LIN segment consisting of the line number and the ean number
    if the passed isbn is valid

=head2 additional_product_id

    Add a PIA segment for an additional product id

=head2 message_date_segment

    Passed a DateTime object returns a correctly formatted DTM segment

=head2 _const

    Stores and returns constant strings for service_string_advice
    and message_identifier
    TBD replace with class variables

=head2 _interchange_sr_identifier

    Format sender and receipient identifiers for use in the interchange header

=head2 encode_text

    Encode textual data into the standard character set ( iso 8859-1 )
    and quote any Edifact metacharacters

=head2 msg_date_string

    Convenient routine which returns message date as a Y-m-d string
    useful if the caller wants to log date of creation

=head1 AUTHOR

   Colin Campbell <colin.campbell@ptfs-europe.com>


=head1 COPYRIGHT

   Copyright 2014, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




package Koha::Edifact::Segment;

# Copyright 2014 PTFS-Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use strict;
use warnings;

sub new {
    my ( $class, $parm_ref ) = @_;
    my $self = {};
    if ( $parm_ref->{seg_string} ) {
        $self = _parse_seg( $parm_ref->{seg_string} );
    }

    bless $self, $class;
    return $self;
}

sub tag {
    my $self = shift;
    return $self->{tag};
}

# return specified element may be data or an array ref if components
sub elem {
    my ( $self, $element_number, $component_number ) = @_;
    if ( $element_number < @{ $self->{elem_arr} } ) {

        my $e = $self->{elem_arr}->[$element_number];
        if ( defined $component_number ) {
            if ( ref $e eq 'ARRAY' ) {
                if ( $component_number < @{$e} ) {
                    return $e->[$component_number];
                }
            }
            elsif ( $component_number == 0 ) {

                # a string could be an element with a single component
                return $e;
            }
            return;
        }
        else {
            return $e;
        }
    }
    return;    #element undefined ( out of range
}

sub element {
    my ( $self, @params ) = @_;

    return $self->elem(@params);
}

sub as_string {
    my $self = shift;

    my $string = $self->{tag};
    foreach my $e ( @{ $self->{elem_arr} } ) {
        $string .= q|+|;
        if ( ref $e eq 'ARRAY' ) {
            $string .= join q{:}, @{$e};
        }
        else {
            $string .= $e;
        }
    }

    return $string;
}

# parse a string into fields
sub _parse_seg {
    my $s = shift;
    my $e = {

        #        raw => $s,
        tag      => substr( $s,                0, 3 ),
        elem_arr => _get_elements( substr( $s, 3 ) ),
    };
    return $e;
}

##
# String parsing
#

sub _get_elements {
    my $seg = shift;

    $seg =~ s/^[+]//;    # dont start with a dummy element`
    my @elem_array = map { _components($_) } split /(?<![?])[+]/, $seg;

    return \@elem_array;
}

sub _components {
    my $element = shift;
    my @c = split /(?<![?])[:]/, $element;
    if ( @c == 1 ) {     # single element return a string
        return de_escape( $c[0] );
    }
    @c = map { de_escape($_) } @c;
    return \@c;
}

sub de_escape {
    my $string = shift;

    # remove escaped characters from the component string
    $string =~ s/[?]([:?+'])/$1/g;
    return $string;
}
1;
__END__

=head1 NAME
   Koha::Edifact::Segment

=head1 SYNOPSIS


=head1 DESCRIPTION

 Used by Koha::Edifact to represent segments in a parsed Edifact message


=head1 BUGS


=head1 METHODS

=head2 new

     my $s = Koha::Edifact::Segment->new( { seg_string => $raw });

     passed a string representation of the segment,  parses it
     and retums a Segment object

=head2 tag

     returns the three character segment tag

=head2 elem

      $data = $s->elem($element_number, $component_number)
      return the contents of a specified element and if specified
      component of that element

=head2 element

      syntactic sugar this wraps the rlem method in a fuller name

=head2 as_string

      returns a string representation of the segment

=head2 _parse_seg

   passed a string representation of a segment returns a hash ref with
   separate tag and data elements

=head2 _get_elements

   passed the data portion of a segment, splits it into elements, passing each to
   components to further parse them. Returns a reference to an array of
   elements

=head2 _components

   Passed a string element splits it into components  and returns a reference
   to an array of components, if only one component is present that is returned
   directly.
   quote characters are removed from the components

=head2 de_escape

   Removes Edifact escapes from the passed string and returns the modified
   string


=head1 AUTHOR

   Colin Campbell <colin.campbell@ptfs-europe.com>


=head1 COPYRIGHT

   Copyright 2014, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




package Koha::Edifact::Transport;

# Copyright 2014 PTFS-Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use strict;
use warnings;
use DateTime;
use Carp;
use English qw{ -no_match_vars };
use Net::FTP;
use Net::SFTP::Foreign;
use File::Slurp;
use File::Copy;
use File::Basename qw( fileparse );
use File::Spec;
use Koha::Database;
use Encode qw( from_to );

sub new {
    my ( $class, $account_id ) = @_;
    my $database = Koha::Database->new();
    my $schema   = $database->schema();
    my $acct     = $schema->resultset('VendorEdiAccount')->find($account_id);
    my $self     = {
        account     => $acct,
        schema      => $schema,
        working_dir => File::Spec->tmpdir(),    #temporary work directory
        transfer_date => DateTime->now( time_zone => 'local' ),
    };

    bless $self, $class;
    return $self;
}

sub working_directory {
    my ( $self, $new_value ) = @_;
    if ($new_value) {
        $self->{working_directory} = $new_value;
    }
    return $self->{working_directory};
}

sub download_messages {
    my ( $self, $message_type ) = @_;
    $self->{message_type} = $message_type;

    my @retrieved_files;

    if ( $self->{account}->transport eq 'SFTP' ) {
        @retrieved_files = $self->sftp_download();
    }
    elsif ( $self->{account}->transport eq 'FILE' ) {
        @retrieved_files = $self->file_download();
    }
    else {    # assume FTP
        @retrieved_files = $self->ftp_download();
    }
    return @retrieved_files;
}

sub upload_messages {
    my ( $self, @messages ) = @_;
    if (@messages) {
        if ( $self->{account}->transport eq 'SFTP' ) {
            $self->sftp_upload(@messages);
        }
        elsif ( $self->{account}->transport eq 'FILE' ) {
            $self->file_upload(@messages);
        }
        else {    # assume FTP
            $self->ftp_upload(@messages);
        }
    }
    return;
}

sub file_download {
    my $self = shift;
    my @downloaded_files;

    my $file_ext = _get_file_ext( $self->{message_type} );

    my $dir = $self->{account}->download_directory;   # makes code more readable
         # C = ready to retrieve E = Edifact
    my $msg_hash = $self->message_hash();
    if ( opendir my $dh, $dir ) {
        my @file_list = readdir $dh;
        closedir $dh;
        foreach my $filename (@file_list) {

            if ( $filename =~ m/[.]$file_ext$/ ) {
                if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
                }
                else {
                    carp "copy of $filename failed";
                    next;
                }
                push @downloaded_files, $filename;
                my $processed_name = $filename;
                substr $processed_name, -3, 1, 'E';
                move( "$dir/$filename", "$dir/$processed_name" );
            }
        }
        $self->ingest( $msg_hash, @downloaded_files );
    }
    else {
        carp "Cannot open $dir";
        return;
    }
    return @downloaded_files;
}

sub sftp_download {
    my $self = shift;

    my $file_ext = _get_file_ext( $self->{message_type} );

    # C = ready to retrieve E = Edifact
    my $msg_hash = $self->message_hash();
    my @downloaded_files;
    my $sftp = Net::SFTP::Foreign->new(
        $self->{account}->host,
        {
            user     => $self->{account}->user,
            password => $self->{account}->password,
            timeout  => 10,
        }
    );
    if ( $sftp->error ) {
        return $self->_abort_download( undef,
            'Unable to connect to remote host: ' . $sftp->error );
    }
    $sftp->setcwd( $self->{account}->download_directory )
      or return $self->_abort_download( $sftp,
        "Cannot change remote dir : $sftp->error" );
    my $file_list = $sftp->ls()
      or return $self->_abort_download( $sftp,
        "cannot get file list from server: $sftp->error" );
    foreach my $filename ( @{$file_list} ) {

        if ( $filename =~ m/[.]$file_ext$/ ) {
            $sftp->get( $filename, "$self->{working_dir}/$filename" );
            if ( $sftp->error ) {
                $self->_abort_download( $sftp,
                    "Error retrieving $filename: $sftp->error" );
                last;
            }
            push @downloaded_files, $filename;
            my $processed_name = $filename;
            substr $processed_name, -3, 1, 'E';
            $sftp->rename( $filename, $processed_name );
        }
    }
    $sftp->disconnect;
    $self->ingest( $msg_hash, @downloaded_files );

    return @downloaded_files;
}

sub ingest {
    my ( $self, $msg_hash, @downloaded_files ) = @_;
    foreach my $f (@downloaded_files) {
        $msg_hash->{filename} = $f;
        my $file_content =
          read_file( "$self->{working_dir}/$f", binmode => ':raw' );
        if ( !defined $file_content ) {
            carp "Unable to read download file $f";
            next;
        }
        from_to( $file_content, 'iso-8859-1', 'utf8' );
        $msg_hash->{raw_msg} = $file_content;
        $self->{schema}->resultset('EdifactMessage')->create($msg_hash);
    }
    return;
}

sub ftp_download {
    my $self = shift;

    my $file_ext = _get_file_ext( $self->{message_type} );

    # C = ready to retrieve E = Edifact

    my $msg_hash = $self->message_hash();
    my @downloaded_files;
    my $ftp = Net::FTP->new(
        $self->{account}->host,
        Timeout => 10,
        Passive => 1
      )
      or return $self->_abort_download( undef,
        "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
    $ftp->login( $self->{account}->username, $self->{account}->password )
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
    $ftp->cwd( $self->{account}->download_directory )
      or return $self->_abort_download( $ftp,
        "Cannot change remote dir : $ftp->message()" );
    my $file_list = $ftp->ls()
      or
      return $self->_abort_download( $ftp, 'cannot get file list from server' );

    foreach my $filename ( @{$file_list} ) {

        if ( $filename =~ m/[.]$file_ext$/ ) {

            if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
                $self->_abort_download( $ftp,
                    "Error retrieving $filename: $ftp->message" );
                last;
            }

            push @downloaded_files, $filename;
            my $processed_name = $filename;
            substr $processed_name, -3, 1, 'E';
            $ftp->rename( $filename, $processed_name );
        }
    }
    $ftp->quit;

    $self->ingest( $msg_hash, @downloaded_files );

    return @downloaded_files;
}

sub ftp_upload {
    my ( $self, @messages ) = @_;
    my $ftp = Net::FTP->new(
        $self->{account}->host,
        Timeout => 10,
        Passive => 1
      )
      or return $self->_abort_download( undef,
        "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
    $ftp->login( $self->{account}->username, $self->{account}->password )
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
    $ftp->cwd( $self->{account}->upload_directory )
      or return $self->_abort_download( $ftp,
        "Cannot change remote dir : $ftp->message()" );
    foreach my $m (@messages) {
        my $content = $m->raw_msg;
        if ($content) {
            open my $fh, '<', \$content;
            if ( $ftp->put( $fh, $m->filename ) ) {
                close $fh;
                $m->transfer_date( $self->{transfer_date} );
                $m->status('sent');
                $m->update;
            }
            else {
                # error in transfer

            }
        }
    }

    $ftp->quit;
    return;
}

sub sftp_upload {
    my ( $self, @messages ) = @_;
    my $sftp = Net::SFTP::Foreign->new(
        $self->{account}->host,
        {
            user     => $self->{account}->user,
            password => $self->{account}->password,
            timeout  => 10,
        }
    );
    $sftp->die_on_error("Cannot ssh to $self->{account}->host");
    $sftp->cwd( $self->{account}->upload_directory );
    $sftp->die_on_error('Cannot change to remote dir');
    foreach my $m (@messages) {
        my $content = $m->raw_msg;
        if ($content) {
            open my $fh, '<', \$content;
            if ( $sftp->put( $fh, $m->filename ) ) {
                close $fh;
                $m->transfer_date( $self->{transfer_date} );
                $m->status('sent');
                $m->update;
            }
            else {
                # error in transfer

            }
        }
    }

    # sftp will be closed on object destructor
    return;
}

sub file_upload {
    my ( $self, @messages ) = @_;
    my $dir = $self->{account}->upload_directory;
    if ( -d $dir ) {
        foreach my $m (@messages) {
            my $content = $m->raw_msg;
            if ($content) {
                my $filename     = $m->filename;
                my $new_filename = "$dir/$filename";
                if ( open my $fh, '>', $new_filename ) {
                    print {$fh} $content;
                    close $fh;
                    $m->transfer_date( $self->{transfer_date} );
                    $m->status('sent');
                    $m->update;
                }
                else {
                    carp "Could not transfer $m->filename : $ERRNO";
                    next;
                }
            }
        }
    }
    else {
        carp "Upload directory $dir does not exist";
    }
    return;
}

sub _abort_download {
    my ( $self, $handle, $log_message ) = @_;

    my $a = $self->{account}->description;

    $handle->abort();
    $log_message .= ": $a";
    carp $log_message;

    #returns undef i.e. an empty array
    return;
}

sub _get_file_ext {
    my $type = shift;

    # Extension format
    # 1st char Status C = Ready For pickup A = Completed E = Extracted
    # 2nd Char Standard E = Edifact
    # 3rd Char Type of message
    my %file_types = (
        QUOTE   => 'CEQ',
        INVOICE => 'CEI',
        ALL     => 'CE.',
    );
    if ( exists $file_types{$type} ) {
        return $file_types{$type};
    }
    return 'XXXX';    # non matching type
}

sub message_hash {
    my $self = shift;
    my $msg  = {
        message_type  => $self->{message_type},
        vendor_id     => $self->{account}->vendor_id,
        edi_acct      => $self->{account}->id,
        status        => 'new',
        deleted       => 0,
        transfer_date => $self->{transfer_date}->ymd(),
    };

    return $msg;
}

1;
__END__

=head1 NAME
   Koha::Edifact::Transport

=head1 SYNOPSIS

my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id );
$downlod->download_messages('QUOTE');


=head1 DESCRIPTION

Module that handles Edifact download and upload transport
currently can use sftp or ftp
Or FILE to access a local directory (useful for testing)

=head1 BUGS


=head1 METHODS

=head2 new

    Creates an object of Edifact::Transport requires to be passed the id
    identifying the relevant edi vendor account

=head2 working_directory

    getter and setter for the working_directory attribute

=head2 download_messages

    called with the message type to download will perform the download
    using the appropriate transport method

=head2 upload_messages

   passed an array of messages will upload them to the supplier site

=head2 sftp_download

   called by download_messages to perform the download using SFTP

=head2 ingest

   loads downloaded files into the database

=head2 ftp_download

   called by download_messages to perform the download using FTP

=head2 ftp_upload

  called by upload_messages to perform the upload using ftp

=head2 sftp_upload

  called by upload_messages to perform the upload using sftp

=head2 _abort_download

   internal routine to halt operation on error and supply a stacktrace

=head2 _get_file_ext

   internal method returning standard suffix for file names
   according to message type

=head2 set_transport_direct

  sets the direct ingest flag so that the object reads files from
  the local file system useful in debugging

=head1 AUTHOR

   Colin Campbell <colin.campbell@ptfs-europe.com>


=head1 COPYRIGHT

   Copyright 2014, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




  },
);

=head2 edifact_messages

Type: has_many

Related object: L<Koha::Schema::Result::EdifactMessage>

=cut

__PACKAGE__->has_many(
  "edifact_messages",
  "Koha::Schema::Result::EdifactMessage",
  { "foreign.basketno" => "self.basketno" },
  { cascade_copy => 0, cascade_delete => 0 },
);

=head2 borrowernumbers

Type: many_to_many

__PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber");


# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:tsMzwP7eofOR27sfZSTqFQ


# You can replace this text with custom content, and it will be preserved on regeneration

Lines 311-316 __PACKAGE__->has_many( Link Here

(-)a/Koha/Schema/Result/Aqbookseller.pm (-2 / +32 lines)
311	{ cascade_copy => 0, cascade_delete => 0 },	311	{ cascade_copy => 0, cascade_delete => 0 },
312	);	312	);
313		313
		314	=head2 edifact_messages
		315
		316	Type: has_many
		317
		318	Related object: L<Koha::Schema::Result::EdifactMessage>
		319
		320	=cut
		321
		322	__PACKAGE__->has_many(
		323	"edifact_messages",
		324	"Koha::Schema::Result::EdifactMessage",
		325	{ "foreign.vendor_id" => "self.id" },
		326	{ cascade_copy => 0, cascade_delete => 0 },
		327	);
		328
314	=head2 invoiceprice	329	=head2 invoiceprice
315		330
316	Type: belongs_to	331	Type: belongs_to
Lines 351-359 __PACKAGE__->belongs_to( Link Here
351	},	366	},
352	);	367	);
353		368
		369	=head2 vendor_edi_accounts
		370
		371	Type: has_many
		372
		373	Related object: L<Koha::Schema::Result::VendorEdiAccount>
		374
		375	=cut
		376
		377	__PACKAGE__->has_many(
		378	"vendor_edi_accounts",
		379	"Koha::Schema::Result::VendorEdiAccount",
		380	{ "foreign.vendor_id" => "self.id" },
		381	{ cascade_copy => 0, cascade_delete => 0 },
		382	);
		383
354		384
355	# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-08-26 11:53:50	385	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
356	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:kz1tuPJihENyV6OyCwyX/A	386	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:bm3bQTUitVpvT+euN9brOg
357		387
358		388
359	# You can replace this text with custom content, and it will be preserved on regeneration	389	# You can replace this text with custom content, and it will be preserved on regeneration




  { cascade_copy => 0, cascade_delete => 0 },
);

<<<<<<< HEAD
=head2 aqorders

Type: has_many

Related object: L<Koha::Schema::Result::Aqorder>
=======
=head2 vendor_edi_accounts

Type: has_many

Related object: L<Koha::Schema::Result::VendorEdiAccount>
>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling

=cut

__PACKAGE__->has_many(
<<<<<<< HEAD
  "aqorders",
  "Koha::Schema::Result::Aqorder",
  { "foreign.budget_id" => "self.budget_id" },
=======
  "vendor_edi_accounts",
  "Koha::Schema::Result::VendorEdiAccount",
  { "foreign.shipment_budget" => "self.budget_id" },
>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
  { cascade_copy => 0, cascade_delete => 0 },
);


__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");


<<<<<<< HEAD
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-02-05 15:20:11
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:733+8NRE5Ip/30URBcJsbA
=======
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:Ieg4SfRCek9KwaDyUKmoWA
>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling


# You can replace this text with custom content, and it will be preserved on regeneration

Lines 70-75 __PACKAGE__->table("aqinvoices"); Link Here

(-)a/Koha/Schema/Result/Aqinvoice.pm (-2 / +30 lines)
70	is_foreign_key: 1	70	is_foreign_key: 1
71	is_nullable: 1	71	is_nullable: 1
72		72
		73	=head2 message_id
		74
		75	data_type: 'integer'
		76	is_foreign_key: 1
		77	is_nullable: 1
		78
73	=cut	79	=cut
74		80
75	__PACKAGE__->add_columns(	81	__PACKAGE__->add_columns(
Lines 89-94 __PACKAGE__->add_columns( Link Here
89	{ data_type => "decimal", is_nullable => 1, size => [28, 6] },	95	{ data_type => "decimal", is_nullable => 1, size => [28, 6] },
90	"shipmentcost_budgetid",	96	"shipmentcost_budgetid",
91	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },	97	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
		98	"message_id",
		99	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
92	);	100	);
93		101
94	=head1 PRIMARY KEY	102	=head1 PRIMARY KEY
Lines 135-140 __PACKAGE__->belongs_to( Link Here
135	{ is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },	143	{ is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
136	);	144	);
137		145
		146	=head2 message
		147
		148	Type: belongs_to
		149
		150	Related object: L<Koha::Schema::Result::EdifactMessage>
		151
		152	=cut
		153
		154	__PACKAGE__->belongs_to(
		155	"message",
		156	"Koha::Schema::Result::EdifactMessage",
		157	{ id => "message_id" },
		158	{
		159	is_deferrable => 1,
		160	join_type => "LEFT",
		161	on_delete => "SET NULL",
		162	on_update => "RESTRICT",
		163	},
		164	);
		165
138	=head2 shipmentcost_budgetid	166	=head2 shipmentcost_budgetid
139		167
140	Type: belongs_to	168	Type: belongs_to
Lines 156-163 __PACKAGE__->belongs_to( Link Here
156	);	184	);
157		185
158		186
159	# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55	187	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46
160	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:3se4f767VfvBKaZ8tlXwHQ	188	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FPZXlNt8dkjhgt2Rtc+krQ
161		189
162		190
163	# You can replace this text with custom content, and it will be preserved on regeneration	191	# You can replace this text with custom content, and it will be preserved on regeneration




  { cascade_copy => 0, cascade_delete => 0 },
);

=head2 edifact_eans

Type: has_many

Related object: L<Koha::Schema::Result::EdifactEan>

=cut

__PACKAGE__->has_many(
  "edifact_eans",
  "Koha::Schema::Result::EdifactEan",
  { "foreign.branchcode" => "self.branchcode" },
  { cascade_copy => 0, cascade_delete => 0 },
);

=head2 hold_fill_targets

Type: has_many

__PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode");


# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-11-26 11:08:29
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FjNI9OEpa5OKfwwCkggu0w


# You can replace this text with custom code or comments, and it will be preserved on regeneration
1;




use utf8;
package Koha::Schema::Result::EdifactEan;

# Created by DBIx::Class::Schema::Loader
# DO NOT MODIFY THE FIRST PART OF THIS FILE

=head1 NAME

Koha::Schema::Result::EdifactEan

=cut

use strict;
use warnings;

use base 'DBIx::Class::Core';

=head1 TABLE: C<edifact_ean>

=cut

__PACKAGE__->table("edifact_ean");

=head1 ACCESSORS

=head2 branchcode

  data_type: 'varchar'
  is_foreign_key: 1
  is_nullable: 0
  size: 10

=head2 ean

  data_type: 'varchar'
  is_nullable: 0
  size: 15

=head2 id_code_qualifier

  data_type: 'varchar'
  default_value: 14
  is_nullable: 0
  size: 3

=cut

__PACKAGE__->add_columns(
  "branchcode",
  { data_type => "varchar", is_foreign_key => 1, is_nullable => 0, size => 10 },
  "ean",
  { data_type => "varchar", is_nullable => 0, size => 15 },
  "id_code_qualifier",
  { data_type => "varchar", default_value => 14, is_nullable => 0, size => 3 },
);

=head1 RELATIONS

=head2 branchcode

Type: belongs_to

Related object: L<Koha::Schema::Result::Branch>

=cut

__PACKAGE__->belongs_to(
  "branchcode",
  "Koha::Schema::Result::Branch",
  { branchcode => "branchcode" },
  { is_deferrable => 1, on_delete => "RESTRICT", on_update => "RESTRICT" },
);


# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:s5Z9txnCIqGyvOj02EOtdQ


# You can replace this text with custom code or comments, and it will be preserved on regeneration
__PACKAGE__->belongs_to('branch',
    "Koha::Schema::Result::Branch",
    { 'branchcode' => 'branchcode' },
    {
        is_deferrable => 1,
        join_type => 'LEFT',
        on_delete => 'CASCADE',
        on_update => 'CASCADE',
    },
);

1;




use utf8;
package Koha::Schema::Result::EdifactMessage;

# Created by DBIx::Class::Schema::Loader
# DO NOT MODIFY THE FIRST PART OF THIS FILE

=head1 NAME

Koha::Schema::Result::EdifactMessage

=cut

use strict;
use warnings;

use base 'DBIx::Class::Core';

=head1 TABLE: C<edifact_messages>

=cut

__PACKAGE__->table("edifact_messages");

=head1 ACCESSORS

=head2 id

  data_type: 'integer'
  is_auto_increment: 1
  is_nullable: 0

=head2 message_type

  data_type: 'varchar'
  is_nullable: 0
  size: 10

=head2 transfer_date

  data_type: 'date'
  datetime_undef_if_invalid: 1
  is_nullable: 1

=head2 vendor_id

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=head2 edi_acct

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=head2 status

  data_type: 'text'
  is_nullable: 1

=head2 basketno

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=head2 raw_msg

  data_type: 'text'
  is_nullable: 1

=head2 filename

  data_type: 'text'
  is_nullable: 1

=head2 deleted

  data_type: 'tinyint'
  default_value: 0
  is_nullable: 0

=cut

__PACKAGE__->add_columns(
  "id",
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
  "message_type",
  { data_type => "varchar", is_nullable => 0, size => 10 },
  "transfer_date",
  { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 },
  "vendor_id",
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
  "edi_acct",
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
  "status",
  { data_type => "text", is_nullable => 1 },
  "basketno",
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
  "raw_msg",
  { data_type => "text", is_nullable => 1 },
  "filename",
  { data_type => "text", is_nullable => 1 },
  "deleted",
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
);

=head1 PRIMARY KEY

=over 4

=item * L</id>

=back

=cut

__PACKAGE__->set_primary_key("id");

=head1 RELATIONS

=head2 aqinvoices

Type: has_many

Related object: L<Koha::Schema::Result::Aqinvoice>

=cut

__PACKAGE__->has_many(
  "aqinvoices",
  "Koha::Schema::Result::Aqinvoice",
  { "foreign.message_id" => "self.id" },
  { cascade_copy => 0, cascade_delete => 0 },
);

=head2 basketno

Type: belongs_to

Related object: L<Koha::Schema::Result::Aqbasket>

=cut

__PACKAGE__->belongs_to(
  "basketno",
  "Koha::Schema::Result::Aqbasket",
  { basketno => "basketno" },
  {
    is_deferrable => 1,
    join_type     => "LEFT",
    on_delete     => "RESTRICT",
    on_update     => "RESTRICT",
  },
);

=head2 edi_acct

Type: belongs_to

Related object: L<Koha::Schema::Result::VendorEdiAccount>

=cut

__PACKAGE__->belongs_to(
  "edi_acct",
  "Koha::Schema::Result::VendorEdiAccount",
  { id => "edi_acct" },
  {
    is_deferrable => 1,
    join_type     => "LEFT",
    on_delete     => "RESTRICT",
    on_update     => "RESTRICT",
  },
);

=head2 vendor

Type: belongs_to

Related object: L<Koha::Schema::Result::Aqbookseller>

=cut

__PACKAGE__->belongs_to(
  "vendor",
  "Koha::Schema::Result::Aqbookseller",
  { id => "vendor_id" },
  {
    is_deferrable => 1,
    join_type     => "LEFT",
    on_delete     => "RESTRICT",
    on_update     => "RESTRICT",
  },
);


# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:aOMWguyzdK9caRRecsuTmQ


1;




use utf8;
package Koha::Schema::Result::MsgInvoice;

# Created by DBIx::Class::Schema::Loader
# DO NOT MODIFY THE FIRST PART OF THIS FILE

=head1 NAME

Koha::Schema::Result::MsgInvoice

=cut

use strict;
use warnings;

use base 'DBIx::Class::Core';

=head1 TABLE: C<msg_invoice>

=cut

__PACKAGE__->table("msg_invoice");

=head1 ACCESSORS

=head2 mi_id

  data_type: 'integer'
  is_auto_increment: 1
  is_nullable: 0

=head2 msg_id

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=head2 invoiceid

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=cut

__PACKAGE__->add_columns(
  "mi_id",
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
  "msg_id",
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
  "invoiceid",
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
);

=head1 PRIMARY KEY

=over 4

=item * L</mi_id>

=back

=cut

__PACKAGE__->set_primary_key("mi_id");

=head1 RELATIONS

=head2 invoiceid

Type: belongs_to

Related object: L<Koha::Schema::Result::Aqinvoice>

=cut

__PACKAGE__->belongs_to(
  "invoiceid",
  "Koha::Schema::Result::Aqinvoice",
  { invoiceid => "invoiceid" },
  {
    is_deferrable => 1,
    join_type     => "LEFT",
    on_delete     => "RESTRICT",
    on_update     => "RESTRICT",
  },
);

=head2 msg

Type: belongs_to

Related object: L<Koha::Schema::Result::EdifactMessage>

=cut

__PACKAGE__->belongs_to(
  "msg",
  "Koha::Schema::Result::EdifactMessage",
  { id => "msg_id" },
  {
    is_deferrable => 1,
    join_type     => "LEFT",
    on_delete     => "RESTRICT",
    on_update     => "RESTRICT",
  },
);


# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:F1jqlEH57dpxn2Pvm/vPGA


# You can replace this text with custom code or comments, and it will be preserved on regeneration
1;




use utf8;
package Koha::Schema::Result::VendorEdiAccount;

# Created by DBIx::Class::Schema::Loader
# DO NOT MODIFY THE FIRST PART OF THIS FILE

=head1 NAME

Koha::Schema::Result::VendorEdiAccount

=cut

use strict;
use warnings;

use base 'DBIx::Class::Core';

=head1 TABLE: C<vendor_edi_accounts>

=cut

__PACKAGE__->table("vendor_edi_accounts");

=head1 ACCESSORS

=head2 id

  data_type: 'integer'
  is_auto_increment: 1
  is_nullable: 0

=head2 description

  data_type: 'text'
  is_nullable: 0

=head2 host

  data_type: 'varchar'
  is_nullable: 1
  size: 40

=head2 username

  data_type: 'varchar'
  is_nullable: 1
  size: 40

=head2 password

  data_type: 'varchar'
  is_nullable: 1
  size: 40

=head2 last_activity

  data_type: 'date'
  datetime_undef_if_invalid: 1
  is_nullable: 1

=head2 vendor_id

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=head2 download_directory

  data_type: 'text'
  is_nullable: 1

=head2 upload_directory

  data_type: 'text'
  is_nullable: 1

=head2 san

  data_type: 'varchar'
  is_nullable: 1
  size: 20

=head2 id_code_qualifier

  data_type: 'varchar'
  default_value: 14
  is_nullable: 1
  size: 3

=head2 transport

  data_type: 'varchar'
  default_value: 'FTP'
  is_nullable: 1
  size: 6

=head2 quotes_enabled

  data_type: 'tinyint'
  default_value: 0
  is_nullable: 0

=head2 invoices_enabled

  data_type: 'tinyint'
  default_value: 0
  is_nullable: 0

=head2 orders_enabled

  data_type: 'tinyint'
  default_value: 0
  is_nullable: 0

=head2 shipment_budget

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=cut

__PACKAGE__->add_columns(
  "id",
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
  "description",
  { data_type => "text", is_nullable => 0 },
  "host",
  { data_type => "varchar", is_nullable => 1, size => 40 },
  "username",
  { data_type => "varchar", is_nullable => 1, size => 40 },
  "password",
  { data_type => "varchar", is_nullable => 1, size => 40 },
  "last_activity",
  { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 },
  "vendor_id",
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
  "download_directory",
  { data_type => "text", is_nullable => 1 },
  "upload_directory",
  { data_type => "text", is_nullable => 1 },
  "san",
  { data_type => "varchar", is_nullable => 1, size => 20 },
  "id_code_qualifier",
  { data_type => "varchar", default_value => 14, is_nullable => 1, size => 3 },
  "transport",
  { data_type => "varchar", default_value => "FTP", is_nullable => 1, size => 6 },
  "quotes_enabled",
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
  "invoices_enabled",
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
  "orders_enabled",
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
  "shipment_budget",
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
);

=head1 PRIMARY KEY

=over 4

=item * L</id>

=back

=cut

__PACKAGE__->set_primary_key("id");

=head1 RELATIONS

=head2 edifact_messages

Type: has_many

Related object: L<Koha::Schema::Result::EdifactMessage>

=cut

__PACKAGE__->has_many(
  "edifact_messages",
  "Koha::Schema::Result::EdifactMessage",
  { "foreign.edi_acct" => "self.id" },
  { cascade_copy => 0, cascade_delete => 0 },
);

=head2 shipment_budget

Type: belongs_to

Related object: L<Koha::Schema::Result::Aqbudget>

=cut

__PACKAGE__->belongs_to(
  "shipment_budget",
  "Koha::Schema::Result::Aqbudget",
  { budget_id => "shipment_budget" },
  {
    is_deferrable => 1,
    join_type     => "LEFT",
    on_delete     => "RESTRICT",
    on_update     => "RESTRICT",
  },
);

=head2 vendor

Type: belongs_to

Related object: L<Koha::Schema::Result::Aqbookseller>

=cut

__PACKAGE__->belongs_to(
  "vendor",
  "Koha::Schema::Result::Aqbookseller",
  { id => "vendor_id" },
  {
    is_deferrable => 1,
    join_type     => "LEFT",
    on_delete     => "RESTRICT",
    on_update     => "RESTRICT",
  },
);


# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-10-02 17:14:15
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:6Yp5lyH2ld4lrmaM0OeYcw


# You can replace this text with custom code or comments, and it will be preserved on regeneration
1;

Lines 36-41 use C4::Members qw/GetMember/; #needed for permissions checking for changing ba Link Here

(-)a/acqui/basket.pl (+78 lines)
36	use C4::Items;	36	use C4::Items;
37	use C4::Suggestions;	37	use C4::Suggestions;
38	use Date::Calc qw/Add_Delta_Days/;	38	use Date::Calc qw/Add_Delta_Days/;
		39	use Koha::Database;
		40	use Koha::EDI qw( create_edi_order get_edifact_ean );
39		41
40	=head1 NAME	42	=head1 NAME
41		43
Lines 67-72 the supplier this script have to display the basket. Link Here
67		69
68	my $query = new CGI;	70	my $query = new CGI;
69	our $basketno = $query->param('basketno');	71	our $basketno = $query->param('basketno');
		72	my $ean = $query->param('ean');
70	my $booksellerid = $query->param('booksellerid');	73	my $booksellerid = $query->param('booksellerid');
71		74
72	my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(	75	my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
Lines 83-88 my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( Link Here
83	my $basket = GetBasket($basketno);	86	my $basket = GetBasket($basketno);
84	$booksellerid = $basket->{booksellerid} unless $booksellerid;	87	$booksellerid = $basket->{booksellerid} unless $booksellerid;
85	my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });	88	my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
		89	my $schema = Koha::Database->new()->schema();
		90	my $rs = $schema->resultset('VendorEdiAccount')->search(
		91	{ vendor_id => $booksellerid, } );
		92	$template->param( ediaccount => ($rs->count > 0));
86		93
87	unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {	94	unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
88	$template->param(	95	$template->param(
Lines 236-241 if ( $op eq 'delete_confirm' ) { Link Here
236	} elsif ($op eq 'reopen') {	243	} elsif ($op eq 'reopen') {
237	ReopenBasket($query->param('basketno'));	244	ReopenBasket($query->param('basketno'));
238	print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})	245	print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
		246	}
		247	elsif ( $op eq 'ediorder' ) {
		248	edi_close_and_order()
239	} elsif ( $op eq 'mod_users' ) {	249	} elsif ( $op eq 'mod_users' ) {
240	my $basketusers_ids = $query->param('basketusers_ids');	250	my $basketusers_ids = $query->param('basketusers_ids');
241	my @basketusers = split( /:/, $basketusers_ids );	251	my @basketusers = split( /:/, $basketusers_ids );
Lines 447-452 sub get_order_infos { Link Here
447	$line{basketno} = $basketno;	457	$line{basketno} = $basketno;
448	$line{budget_name} = $budget->{budget_name};	458	$line{budget_name} = $budget->{budget_name};
449	$line{rrp} = ConvertCurrency( $order->{'currency'}, $line{rrp} ); # FIXME from comm	459	$line{rrp} = ConvertCurrency( $order->{'currency'}, $line{rrp} ); # FIXME from comm
		460	$line{gstrate} \|\|= 0;
450	if ( $bookseller->{'listincgst'} ) {	461	if ( $bookseller->{'listincgst'} ) {
451	$line{rrpgsti} = sprintf( "%.2f", $line{rrp} );	462	$line{rrpgsti} = sprintf( "%.2f", $line{rrp} );
452	$line{gstgsti} = sprintf( "%.2f", $line{gstrate} * 100 );	463	$line{gstgsti} = sprintf( "%.2f", $line{gstrate} * 100 );
Lines 532-534 sub get_order_infos { Link Here
532	}	543	}
533		544
534	output_html_with_http_headers $query, $cookie, $template->output;	545	output_html_with_http_headers $query, $cookie, $template->output;
		546
		547
		548	sub edi_close_and_order {
		549	my $confirm = $query->param('confirm') \|\| $confirm_pref eq '2';
		550	if ($confirm) {
		551	my $edi_params = {
		552	basketno => $basketno,
		553	ean => $ean,
		554	};
		555	if ( $basket->{branch} ) {
		556	$edi_params->{branchcode} = $basket->{branch};
		557	}
		558	if ( create_edi_order($edi_params) ) {
		559	#$template->param( edifile => 1 );
		560	}
		561	CloseBasket($basketno);
		562
		563	# if requested, create basket group, close it and attach the basket
		564	if ( $query->param('createbasketgroup') ) {
		565	my $branchcode;
		566	if ( C4::Context->userenv
		567	and C4::Context->userenv->{'branch'}
		568	and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" )
		569	{
		570	$branchcode = C4::Context->userenv->{'branch'};
		571	}
		572	my $basketgroupid = NewBasketgroup(
		573	{
		574	name => $basket->{basketname},
		575	booksellerid => $booksellerid,
		576	deliveryplace => $branchcode,
		577	billingplace => $branchcode,
		578	closed => 1,
		579	}
		580	);
		581	ModBasket(
		582	{
		583	basketno => $basketno,
		584	basketgroupid => $basketgroupid
		585	}
		586	);
		587	print $query->redirect(
		588	"/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1"
		589	);
		590	}
		591	else {
		592	print $query->redirect(
		593	"/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid"
		594	);
		595	}
		596	exit;
		597	}
		598	else {
		599	$template->param(
		600	edi_confirm => 1,
		601	booksellerid => $booksellerid,
		602	basketno => $basket->{basketno},
		603	basketname => $basket->{basketname},
		604	basketgroupname => $basket->{basketname},
		605	);
		606	if ($ean) {
		607	$template->param( ean => $ean );
		608	}
		609
610	}
611	return;
612	}




use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;
use C4::Branch qw/GetBranches/;
use C4::Members qw/GetMember/;
use Koha::EDI qw/create_edi_order get_edifact_ean/;

use Koha::Acquisition::Bookseller;



}

sub generate_edifact_orders {
    my $basketgroupid = shift;
    my $baskets       = GetBasketsByBasketgroup($basketgroupid);
    my $ean           = get_edifact_ean();

    for my $basket ( @{$baskets} ) {
        create_edi_order( { ean => $ean, basketno => $basket->{basketno}, } );
    }
    return;
}

my $op = $input->param('op') || 'display';
# possible values of $op :
# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
# - mod_basket : modify an individual basket of the basketgroup
# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
# - ediprint : generate edi order messages for the baskets in the group
# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list

    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
    print $input->redirect($redirectpath );
    
} elsif ( $op eq 'ediprint') {
    my $basketgroupid = $input->param('basketgroupid');
    generate_edifact_orders( $basketgroupid );
    exit;
}else{
# no param : display the list of all basketgroups for a given vendor
    my $basketgroups = &GetBasketgroups($booksellerid);




#!/usr/bin/perl

# Copyright 2012 Mark Gavillet & PTFS Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

# This is an awkward construct and should probably be totally replaced
# but as all sites so far are single ordering ean its not clear what we should
# replace it with
#
use strict;
use warnings;

use C4::Auth;
use C4::Koha;
use C4::Output;
use Koha::Database;
use CGI;
my $schema = Koha::Database->new()->schema();

my @eans = $schema->resultset('EdifactEan')->search(
    {},
    {
        join => 'branch',
    }
);
my $query    = CGI->new();
my $basketno = $query->param('basketno');

if ( @eans == 1 ) {
    my $ean = $eans[0]->ean;
    print $query->redirect(
        "/cgi-bin/koha/acqui/basket.pl?basketno=$basketno&op=ediorder&ean=$ean"
    );
}
else {
    my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
        {
            template_name   => 'acqui/edi_ean.tt',
            query           => $query,
            type            => 'intranet',
            authnotrequired => 0,
            flagsrequired   => { acquisition => 'order_manage' },
            debug           => 1,
        }
    );
    $template->param( eans     => \@eans );
    $template->param( basketno => $basketno );

    output_html_with_http_headers( $query, $cookie, $template->output );
}




#!/usr/bin/perl

# Copyright 2014 PTFS Europe Ltd.
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use warnings;

use CGI;
use Koha::Database;
use C4::Koha;
use C4::Auth;
use C4::Output;

my $q = CGI->new;
my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
    {
        template_name   => 'acqui/edifactmsgs.tt',
        query           => $q,
        type            => 'intranet',
        authnotrequired => 0,
        flagsrequired   => { acquisition => 'manage_edi' },
        debug           => 1,
    }
);

my $schema = Koha::Database->new()->schema();

my @msgs = $schema->resultset('EdifactMessage')->search(
    {
        deleted => 0,
    },
    {
        join     => 'vendor',
        order_by => { -desc => 'transfer_date' },
    }

)->all;

$template->param( messages => \@msgs );

output_html_with_http_headers( $q, $cookie, $template->output );




#!/usr/bin/perl

# Copyright 2014 PTFS Europe Ltd.
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use warnings;

use CGI;
use Koha::Database;
use C4::Koha;
use C4::Auth;
use C4::Output;

my $q = CGI->new;
my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
    {
        template_name   => 'acqui/edimsg.tt',
        query           => $q,
        type            => 'intranet',
        authnotrequired => 0,
        flagsrequired   => { acquisition => 'manage_edi' },
        debug           => 1,
    }
);
my $msg_id = $q->param('id');
my $schema = Koha::Database->new()->schema();

my $msg = $schema->resultset('EdifactMessage')->find($msg_id);
if ($msg) {
    my $transmission = $msg->raw_msg;

    my @segments = segmentize($transmission);
    $template->param( segments => \@segments );
}
else {
    $template->param( no_message => 1 );
}

output_html_with_http_headers( $q, $cookie, $template->output );

sub segmentize {
    my $raw = shift;

    my $re = qr{
(?>    # dont backtrack into this group
    [?].      # either the escape character
            # followed by any other character
     |      # or
     [^'?]   # a character that is neither escape
             # nor split
             )+
}x;
    my @segmented;
    while ( $raw =~ /($re)/g ) {
        push @segmented, "$1'";
    }
    return @segmented;
}

Lines 61-66 my $author = $input->param('author'); Link Here

(-)a/acqui/invoices.pl (-1 / +3 lines)
61	my $publisher = $input->param('publisher');	61	my $publisher = $input->param('publisher');
62	my $publicationyear = $input->param('publicationyear');	62	my $publicationyear = $input->param('publicationyear');
63	my $branch = $input->param('branch');	63	my $branch = $input->param('branch');
		64	my $message_id = $input->param('message_id');
64	my $op = $input->param('op');	65	my $op = $input->param('op');
65		66
66	my $invoices = [];	67	my $invoices = [];
Lines 81-87 if ( $op and $op eq 'do_search' ) { Link Here
81	author => $author,	82	author => $author,
82	publisher => $publisher,	83	publisher => $publisher,
83	publicationyear => $publicationyear,	84	publicationyear => $publicationyear,
84	branchcode => $branch	85	branchcode => $branch,
		86	message_id => $message_id,
85	);	87	);
86	}	88	}
87		89




#!/usr/bin/perl

# Copyright 2011,2014 Mark Gavillet & PTFS Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use warnings;
use CGI;
use C4::Auth;
use C4::Output;
use Koha::Database;

my $input = CGI->new();

my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
    {
        template_name   => 'admin/edi_accounts.tt',
        query           => $input,
        type            => 'intranet',
        authnotrequired => 0,
        flagsrequired   => { acquisition => 'edi_manage' },
    }
);

my $op = $input->param('op');
$op ||= 'display';
my $schema = Koha::Database->new()->schema();

if ( $op eq 'acct_form' ) {
    show_account();
    $template->param( acct_form => 1 );
    my @vendors = $schema->resultset('Aqbookseller')->search(
        undef,
        {
            columns => [ 'name', 'id' ],
            order_by => { -asc => 'name' }
        }
    );
    $template->param( vendors => \@vendors );
    $template->param(
        code_qualifiers => [
            {
                code        => '14',
                description => 'EAN International',
            },
            {
                code        => '31B',
                description => 'US SAN Agency',
            },
            {
                code        => '91',
                description => 'Assigned by supplier',
            },
            {
                code        => '92',
                description => 'Assigned by buyer',
            },
        ]
    );

}
elsif ( $op eq 'delete_confirm' ) {
    show_account();
    $template->param( delete_confirm => 1 );
}
else {
    if ( $op eq 'save' ) {

        # validate & display
        my $id     = $input->param('id');
        my $fields = {
            description        => $input->param('description'),
            host               => $input->param('host'),
            username           => $input->param('username'),
            password           => $input->param('password'),
            vendor_id          => $input->param('vendor_id'),
            upload_directory   => $input->param('upload_directory'),
            download_directory => $input->param('download_directory'),
            san                => $input->param('san'),
            transport          => $input->param('transport'),
            quotes_enabled     => defined $input->param('quotes_enabled'),
            invoices_enabled   => defined $input->param('invoices_enabled'),
            orders_enabled     => defined $input->param('orders_enabled'),
            id_code_qualifier  => $input->param('id_code_qualifier'),
        };

        if ($id) {
            $schema->resultset('VendorEdiAccount')->search(
                {
                    id => $id,
                }
            )->update_all($fields);
        }
        else {    # new record
            $schema->resultset('VendorEdiAccount')->create($fields);
        }
    }
    elsif ( $op eq 'delete_confirmed' ) {

        $schema->resultset('VendorEdiAccount')
          ->search( { id => $input->param('id'), } )->delete_all;
    }

    # we do a default dispaly after deletes and saves
    # as well as when thats all you want
    $template->param( display => 1 );
    my @ediaccounts = $schema->resultset('VendorEdiAccount')->search(
        {},
        {
            join => 'vendor',
        }
    );
    $template->param( ediaccounts => \@ediaccounts );
}

output_html_with_http_headers( $input, $cookie, $template->output );

sub get_account {
    my $id = shift;

    my $account = $schema->resultset('VendorEdiAccount')->find($id);
    if ($account) {
        return $account;
    }

    # passing undef will default to add
    return;
}

sub show_account {
    my $acct_id = $input->param('id');
    if ($acct_id) {
        my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id);
        if ($acct) {
            $template->param( account => $acct );
        }
    }
    return;
}




#!/usr/bin/perl

# Copyright 2012, 2014 Mark Gavillet & PTFS Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use warnings;
use CGI;
use C4::Auth;
use C4::Output;
use Koha::Database;

my $input = CGI->new();

my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
    {
        template_name   => 'admin/edi_ean_accounts.tt',
        query           => $input,
        type            => 'intranet',
        authnotrequired => 0,
        flagsrequired   => { acquisition => 'edi_manage' },
    }
);

my $schema = Koha::Database->new()->schema();
my $op     = $input->param('op');
$op ||= 'display';

if ( $op eq 'ean_form' ) {
    show_ean();
    $template->param( ean_form => 1 );
    my @branches = $schema->resultset('Branch')->search(
        undef,
        {
            columns  => [ 'branchcode', 'branchname' ],
            order_by => 'branchname',
        }
    );
    $template->param( branches => \@branches );
    $template->param(
        code_qualifiers => [
            {
                code        => '14',
                description => 'EAN International',
            },
            {
                code        => '31B',
                description => 'US SAN Agency',
            },
            {
                code        => '91',
                description => 'Assigned by supplier',
            },
            {
                code        => '92',
                description => 'Assigned by buyer',
            },
        ]
    );

}
elsif ( $op eq 'delete_confirm' ) {
    show_ean();
    $template->param( delete_confirm => 1 );
}
else {
    if ( $op eq 'save' ) {
        my $change = $input->param('oldean');
        if ($change) {
            editsubmit();
        }
        else {
            addsubmit();
        }
    }
    elsif ( $op eq 'delete_confirmed' ) {
        delsubmit();
    }
    my @eans = $schema->resultset('EdifactEan')->search(
        {},
        {
            join => 'branch',
        }
    );
    $template->param( display => 1 );
    $template->param( eans    => \@eans );
}

output_html_with_http_headers( $input, $cookie, $template->output );

sub delsubmit {
    my $ean = $schema->resultset('EdifactEan')->find(
        {
            branchcode => $input->param('branchcode'),
            ean        => $input->param('ean')
        }
    );
    $ean->delete;
    return;
}

sub addsubmit {

    my $new_ean = $schema->resultset('EdifactEan')->new(
        {
            branchcode        => $input->param('branchcode'),
            ean               => $input->param('ean'),
            id_code_qualifier => $input->param('id_code_qualifier'),
        }
    );
    $new_ean->insert();
    return;
}

sub editsubmit {
    $schema->resultset('EdifactEan')->search(
        {
            branchcode => $input->param('oldbranchcode'),
            ean        => $input->param('oldean'),
        }
      )->update_all(
        {
            branchcode        => $input->param('branchcode'),
            ean               => $input->param('ean'),
            id_code_qualifier => $input->param('id_code_qualifier'),
        }
      );
    return;
}

sub show_ean {
    my $branchcode = $input->param('branchcode');
    my $ean        = $input->param('ean');
    if ( $branchcode && $ean ) {
        my $e = $schema->resultset('EdifactEan')->find(
            {
                ean        => $ean,
                branchcode => $branchcode,
            }
        );
        $template->param( ean => $e );
    }
    return;
}

Lines 27-32 INSERT INTO permissions (module_bit, code, description) VALUES Link Here

(-)a/installer/data/mysql/en/mandatory/userpermissions.sql (+1 lines)
27	(11, 'order_receive', 'Manage orders & basket'),	27	(11, 'order_receive', 'Manage orders & basket'),
28	(11, 'budget_add_del', 'Add and delete budgets (but can''t modify budgets)'),	28	(11, 'budget_add_del', 'Add and delete budgets (but can''t modify budgets)'),
29	(11, 'budget_manage_all', 'Manage all budgets'),	29	(11, 'budget_manage_all', 'Manage all budgets'),
		30	(11, 'edi_manage', 'Manage EDIFACT transmissions'),
30	(13, 'edit_news', 'Write news for the OPAC and staff interfaces'),	31	(13, 'edit_news', 'Write news for the OPAC and staff interfaces'),
31	(13, 'label_creator', 'Create printable labels and barcodes from catalog and patron data'),	32	(13, 'label_creator', 'Create printable labels and barcodes from catalog and patron data'),
32	(13, 'edit_calendar', 'Define days when the library is closed'),	33	(13, 'edit_calendar', 'Define days when the library is closed'),




) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;

--
-- Table structure for table vendor_edi_accounts
--

DROP TABLE IF EXISTS vendor_edi_accounts;
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
  id int(11) NOT NULL auto_increment,
  description text NOT NULL,
  host varchar(40),
  username varchar(40),
  password varchar(40),
  last_activity date,
  vendor_id int(11) references aqbooksellers( id ),
  download_directory text,
  upload_directory text,
  san varchar(20),
  id_code_qualifier varchar(3) default '14',
  transport varchar(6) default 'FTP',
  quotes_enabled tinyint(1) not null default 0,
  invoices_enabled tinyint(1) not null default 0,
  orders_enabled tinyint(1) not null default 0,
  shipment_budget integer(11) references aqbudgets( budget_id ),
  PRIMARY KEY  (id),
  KEY vendorid (vendor_id),
  KEY shipmentbudget (shipment_budget),
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
) ENGINE=InnoDB DEFAULT CHARSET=utf8;

--
-- Table structure for table edifact_messages
--

DROP TABLE IF EXISTS edifact_messages;
CREATE TABLE IF NOT EXISTS edifact_messages (
  id int(11) NOT NULL auto_increment,
  message_type varchar(10) NOT NULL,
  transfer_date date,
  vendor_id int(11) references aqbooksellers( id ),
  edi_acct  integer references vendor_edi_accounts( id ),
  status text,
  basketno int(11) references aqbasket( basketno),
  raw_msg text,
  filename text,
  deleted boolean not null default 0,
  PRIMARY KEY  (id),
  KEY vendorid ( vendor_id),
  KEY ediacct (edi_acct),
  KEY basketno ( basketno),
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
) ENGINE=InnoDB DEFAULT CHARSET=utf8;

--
-- Table structure for table aqinvoices
--


  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
  message_id int(11) default NULL, -- foreign key to edifact invoice message
  PRIMARY KEY (invoiceid),
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE,
  CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL
) ENGINE=InnoDB DEFAULT CHARSET=utf8;


--

    ON DELETE SET NULL ON UPDATE CASCADE
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;

--
-- Table structure for table 'edifact_ean'
--

DROP TABLE IF EXISTS edifact_ean;
CREATE TABLE IF NOT EXISTS edifact_ean (
  branchcode varchar(10) not null references branches (branchcode),
  ean varchar(15) NOT NULL,
  id_code_qualifier varchar(3) NOT NULL default '14',
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
) ENGINE=InnoDB DEFAULT CHARSET=utf8;

/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;

Lines 473-476 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here

(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
473	('XSLTResultsDisplay','default','','Enable XSL stylesheet control over results page display on intranet','Free'),	473	('XSLTResultsDisplay','default','','Enable XSL stylesheet control over results page display on intranet','Free'),
474	('z3950AuthorAuthFields','701,702,700',NULL,'Define the MARC biblio fields for Personal Name Authorities to fill biblio.author','free'),	474	('z3950AuthorAuthFields','701,702,700',NULL,'Define the MARC biblio fields for Personal Name Authorities to fill biblio.author','free'),
475	('z3950NormalizeAuthor','0','','If ON, Personal Name Authorities will replace authors in biblio.author','YesNo')	475	('z3950NormalizeAuthor','0','','If ON, Personal Name Authorities will replace authors in biblio.author','YesNo')
		476	('EDIInvoicesShippingBudget',NULL,NULL,'The budget code used to allocate shipping charges to when processing EDI Invoice messages','free')
476	;	477	;




    |);

    print "Upgrade to $DBversion done (Bug 12601 - Add new foreign key aqorders.budget_id" . ( ( $number_of_orders_not_linked->[0] > 0 )  ? ' WARNING: temporary budget and fund have been created (search for "BACKUP_TMP"). At least one of your order was not linked to a budget' : '' ) . ")\n";
$DBversion = "3.19.00.XXX";
if( CheckVersion($DBversion) ){

    my $sql=<<'VEA_END';
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
  id int(11) NOT NULL auto_increment,
  description text NOT NULL,
  host varchar(40),
  username varchar(40),
  password varchar(40),
  last_activity date,
  vendor_id int(11) references aqbooksellers( id ),
  download_directory text,
  upload_directory text,
  san varchar(20),
  id_code_qualifier varchar(3) default '14',
  transport varchar(6) default 'FTP',
  quotes_enabled tinyint(1) not null default 0,
  invoices_enabled tinyint(1) not null default 0,
  orders_enabled tinyint(1) not null default 0,
  shipment_budget integer(11) references aqbudgets( budget_id ),
  PRIMARY KEY  (id),
  KEY vendorid (vendor_id),
  KEY shipmentbudget (shipment_budget),
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
) ENGINE=InnoDB DEFAULT CHARSET=utf8
VEA_END

    $dbh->do($sql);

    $sql=<<'EM_END';
CREATE TABLE IF NOT EXISTS edifact_messages (
  id int(11) NOT NULL auto_increment,
  message_type varchar(10) NOT NULL,
  transfer_date date,
  vendor_id int(11) references aqbooksellers( id ),
  edi_acct  integer references vendor_edi_accounts( id ),
  status text,
  basketno int(11) REFERENCES aqbasket( basketno),
  raw_msg text,
  filename text,
  deleted boolean not null default 0,
  PRIMARY KEY  (id),
  KEY vendorid ( vendor_id),
  KEY ediacct (edi_acct),
  KEY basketno ( basketno),
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
) ENGINE=InnoDB DEFAULT CHARSET=utf8
EM_END

    $dbh->do($sql);

    $dbh->do('ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id )');

    $dbh->do(
        'ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL'
    );

    $sql=<<'EAN_END';
CREATE TABLE IF NOT EXISTS edifact_ean (
  branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode),
  ean varchar(15) NOT NULL,
  id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14',
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
) ENGINE=InnoDB DEFAULT CHARSET=utf8
EAN_END

    $dbh->do($sql);
    $dbh->do("INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages',  'free')");
    $dbh->do(
        q{INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions')}
    );

    print "Upgrade to $DBversion done (Bug 7736 DB Changes for Edifact Processing ( Quote, Order and Invoice))\n";
>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
    SetVersion($DBversion);
}


Lines 9-12 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc (+3 lines)
9	[% IF ( CAN_user_parameters ) %]	9	[% IF ( CAN_user_parameters ) %]
10	<li><a href="/cgi-bin/koha/admin/currency.pl">Currencies</a></li>	10	<li><a href="/cgi-bin/koha/admin/currency.pl">Currencies</a></li>
11	[% END %]	11	[% END %]
		12	[% IF CAN_user_acquisition_edi_manage %]
		13	<li><a href="/cgi-bin/koha/acqui/edifactmsgs.pl">Edifact Messages</a></li>
		14	[% END %]
12	</ul>	15	</ul>

Lines 54-59 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc (+2 lines)
54	<li><a href="/cgi-bin/koha/admin/currency.pl">Currencies and exchange rates</a></li>	54	<li><a href="/cgi-bin/koha/admin/currency.pl">Currencies and exchange rates</a></li>
55	<li><a href="/cgi-bin/koha/admin/aqbudgetperiods.pl">Budgets</a></li>	55	<li><a href="/cgi-bin/koha/admin/aqbudgetperiods.pl">Budgets</a></li>
56	<li><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></li>	56	<li><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></li>
		57	<li><a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI accounts</a></li>
		58	<li><a href="/cgi-bin/koha/admin/edi_ean_accounts.pl">EDI eans</a></li>
57		59
58	</ul>	60	</ul>
59		61

Lines 54-59 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt (-1 / +33 lines)
54	window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes');	54	window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes');
55	}	55	}
56		56
		57	function confirm_ediorder() {
		58	var is_confirmed = confirm(_("Are you sure you want to close this basket and generate an Edifact order?"));
		59	if (is_confirmed) {
		60	window.location = "[% script_name %]?op=edi_confirm&basketno=[% basketno %]";
		61	}
		62	}
		63
57	//]]>	64	//]]>
58	</script>	65	</script>
59	[% ELSE %]	66	[% ELSE %]
Lines 160-166 Link Here
160	</div>	167	</div>
161	[% ELSE %]	168	[% ELSE %]
162	<div class="yui-b">	169	<div class="yui-b">
163	[% UNLESS ( confirm_close ) %]	170	[% IF !confirm_close && !edi_confirm %]
164	[% UNLESS ( selectbasketg ) %]	171	[% UNLESS ( selectbasketg ) %]
165	[% UNLESS ( closedate ) %]	172	[% UNLESS ( closedate ) %]
166	<div id="toolbar" class="btn-toolbar">	173	<div id="toolbar" class="btn-toolbar">
Lines 176-181 Link Here
176	</div>	183	</div>
177	[% END %]	184	[% END %]
178	<div class="btn-group"><a href="[% script_name %]?op=export&basketno=[% basketno %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="icon-download"></i> Export this basket as CSV</a></div>	185	<div class="btn-group"><a href="[% script_name %]?op=export&basketno=[% basketno %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="icon-download"></i> Export this basket as CSV</a></div>
		186	[% IF ediaccount %]
		187	<div class="btn-group"><a href="/cgi-bin/koha/acqui/edi_ean.pl?op=ediorder&basketno=[% basketno %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="ediorderbutton"><i class="icon-download"></i>Create edifact order</a></div>
		188	[% END %]
179	</div>	189	</div>
180	<!-- Modal for confirm deletion box-->	190	<!-- Modal for confirm deletion box-->
181	<div class="modal hide" id="deleteBasketModal" tabindex="-1" role="dialog" aria-labelledby="delbasketModalLabel" aria-hidden="true">	191	<div class="modal hide" id="deleteBasketModal" tabindex="-1" role="dialog" aria-labelledby="delbasketModalLabel" aria-hidden="true">
Lines 667-672 Link Here
667	</form>	677	</form>
668	</div>	678	</div>
669	[% END %]	679	[% END %]
		680	[% IF edi_confirm %]
		681	<div id="closebasket_needsconfirmation" class="dialog alert">
		682
		683	<form action="/cgi-bin/koha/acqui/basket.pl" class="confirm">
		684	<h1>Are you sure you want to generate an edifact order and close basket [% basketname\|html %]?</h1>
		685	[% IF CAN_user_acquisition_group_manage %]
		686	<p>
		687	<label for="createbasketgroup">Attach this basket to a new basket group with the same name</label>
		688	<input type="checkbox" id="createbasketgroup" name="createbasketgroup"/>
		689	</p>
		690	[% END %]
		691	<input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
		692	<input type="hidden" value="ediorder" name="op" />
		693	<input type="hidden" name="ean" value="[% ean %]" />
		694	<input type="hidden" name="booksellerid" value="[% booksellerid %]" />
		695	<input type="hidden" name="confirm" value="1" />
		696	<input type="hidden" name="basketgroupname" value="[% basketgroupname %]" />
		697	<input type="submit" class="approve" value="Yes, close (Y)" accesskey="y" />
		698	<input type="submit" class="deny" value="No, don't close (N)" accesskey="n" onclick="javascript:window.location='/cgi-bin/koha/acqui/basket.pl?basketno=[% basketno %]';return false;" />
		699	</form>
		700	</div>
		701	[% END %]
670	</div>	702	</div>
671	[% END %][%# IF (cannot_manage_basket) %]	703	[% END %][%# IF (cannot_manage_basket) %]
672	</div>	704	</div>

Lines 144-149 function submitForm(form) { Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt (+2 lines)
144	<div class="btn-group"><a href="[% script_name %]?op=reopen&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]&mode=singlebg" class="btn btn-small" id="reopenbutton"><i class="icon-download"></i> Reopen this basket group</a></div>	144	<div class="btn-group"><a href="[% script_name %]?op=reopen&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]&mode=singlebg" class="btn btn-small" id="reopenbutton"><i class="icon-download"></i> Reopen this basket group</a></div>
145	<div class="btn-group"><a href="[% script_name %]?op=export&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="icon-download"></i> Export this basket group as CSV</a></div>	145	<div class="btn-group"><a href="[% script_name %]?op=export&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="icon-download"></i> Export this basket group as CSV</a></div>
146	<div class="btn-group"><a href="[% script_name %]?op=print&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="icon-download"></i> Print this basket group in PDF</a></div>	146	<div class="btn-group"><a href="[% script_name %]?op=print&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="icon-download"></i> Print this basket group in PDF</a></div>
		147	<div class="btn-group"><a href="[% script_name %]?op=ediprint&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="icon-download"></i>Generate edifact order</a></div>
147	</div>	148	</div>
148	[% ELSE %]	149	[% ELSE %]
149	<div class="btn-group"><a href="[% script_name %]?op=delete&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="delbutton"><i class="icon-remove"></i> Delete basket group</a></div>	150	<div class="btn-group"><a href="[% script_name %]?op=delete&basketgroupid=[% basketgroupid %]&booksellerid=[% booksellerid %]" class="btn btn-small" id="delbutton"><i class="icon-remove"></i> Delete basket group</a></div>
Lines 380-385 function submitForm(form) { Link Here
380	<form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="reopen" /><input type="hidden" name="booksellerid" value="[% basketgroup.booksellerid %]" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Reopen" /></form>	381	<form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="reopen" /><input type="hidden" name="booksellerid" value="[% basketgroup.booksellerid %]" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Reopen" /></form>
381	<form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="print" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Print" /></form>	382	<form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="print" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Print" /></form>
382	<form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="export" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Export as CSV" /></form>	383	<form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="export" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Export as CSV" /></form>
		384	<form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="ediprint" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Generate edifact order" /></form>
383	</td>	385	</td>
384	</tr>	386	</tr>
385	[% END %]	387	[% END %]




[% INCLUDE 'doc-head-open.inc' %]
<title>Koha &rsaquo; Acquisitions &rsaquo; Basket ([% basketno %])</title>
[% INCLUDE 'doc-head-close.inc' %]

</head>
<body>
[% INCLUDE 'header.inc' %]
[% INCLUDE 'acquisitions-search.inc' %]

<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a> &rsaquo; Basket ([% basketno %])</div>

<div id="doc3" class="yui-t2">

<div id="bd">
    <div id="yui-main">
    <div class="yui-b">

    <h2>Identify the branch account submitting the EDI order</h2>
    <br />
    <form action="/cgi-bin/koha/acqui/basket.pl" method="get">
         <p>Select ordering branch account: </p>
         <select id="ean" name="ean">
             [% FOREACH eanacct IN eans %]
             <option value="[% eanacct.ean %]">[% eanacct.branch.branchname %] ([% eanacct.ean %])</option>
             [% END %]
        </select>
        <br />
        <input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
        <input type="hidden" value="ediorder" name="op" />
        <input type="submit" value="Send EDI order" />
    </form>
</div>
</div>
<div class="yui-b">
[% INCLUDE 'acquisitions-menu.inc' %]
</div>
</div>
[% INCLUDE 'intranet-bottom.inc' %]




[% INCLUDE 'doc-head-open.inc' %]
<title>Koha &rsaquo; Acquisitions</title>
<link rel="stylesheet" type="text/css" href="[% themelang %]/css/datatables.css" />
[% INCLUDE 'doc-head-close.inc' %]
[% INCLUDE 'datatables.inc' %]
<script type="text/javascript">
$(document).ready(function() {
    $('#edi_msgs').dataTable($.extend(true, {}, dataTablesDefaults, {
        'aaSorting': [[1, "desc" ]],
        'sPaginationType': "four_button"
        }));
});
</script>

</head>
<body id="acq_edifactmsgs" class="acq">
[% INCLUDE 'header.inc' %]
[% INCLUDE 'acquisitions-search.inc' %]
<div id="breadcrumbs">
<a href="/cgi-bin/koha/mainpage.pl">Home</a>
&rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a>
&rsaquo; <a href="/cgi-bin/koha/acqui/edifactmsgs.pl">Edifact Messages</a>
</div>

<div id="doc3" class="yui-t2">

<div id="bd">
    <div id="yui-main">
    <div class="yui-b">


<h1>Edifact Messages</h1>
<div id="acqui_edifactmsgs">


<table id="edi_msgs">
<thead>
<th>Type</th>
<th>Transferred</th>
<th>Status</th>
<th>Vendor</th>
<th>Details</th>
<th>Filename</th>
<th> </th>
</thead>
<tbody>
[% FOREACH msg IN messages %]
<tr>
<td>[% msg.message_type %]</td>
<td>[% msg.transfer_date %]</td>
<td>[% msg.status %]</td>
<td>
<a href="/cgi-bin/koha/acqui/supplier.pl?booksellerid=[% msg.vendor_id %]"</a>
[% msg.vendor.name %]
</td>
<td>
[% IF msg.message_type == 'QUOTE' || msg.message_type == 'ORDERS' %]
    [% IF msg.basketno %]
    <a href="/cgi-bin/koha/acqui/basket.pl?basketno=[% msg.basketno.basketno %]">
    Basket: [% msg.basketno.basketno %]
    </a>
    [% END %]
[% ELSE %]
<!-- Assuming invoices -->
     <a href="/cgi-bin/koha/acqui/invoices.pl?message_id=[% msg.id %]">
      Invoices
     </a>
[% END %]
</td>
</td>
<td>[% msg.filename %]</td>
<td><a class="popup" target="_blank" title="View Message" href="/cgi-bin/koha/acqui/edimsg.pl?id=[% msg.id %]"</a>View Message</td>
</tr>
[% END %]

</tbody>
</table>

</div>
</div>
</div>
<div class="yui-b">
[% INCLUDE 'acquisitions-menu.inc' %]
</div>
</div>
[% INCLUDE 'intranet-bottom.inc' %]




[% INCLUDE 'doc-head-open.inc' %]
<title>Koha &rsaquo; Acquisitions &rsaquo; Edifact Message Display</title>
[% INCLUDE 'doc-head-close.inc' %]
</head>
<body id="acq_edifactmsgs" class="acq">
[% INCLUDE 'header.inc' %]
[% INCLUDE 'acquisitions-search.inc' %]
<div id="breadcrumbs">
<a href="/cgi-bin/koha/mainpage.pl">Home</a>
&rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a>
&rsaquo; <a href="/cgi-bin/koha/acqui/edifactmsgs.pl">Edifact Messages</a>
</div>

<div id="doc3" class="yui-t2">

[% IF no_message %]
  <div class"dialog message">The requested message cannot be displayed</div>
[% ELSE %]
  <div id="bd">
  <div id="yui-main">
  <div class="yui-b">
   <ul>
   [% FOREACH seg IN segments %]
   <li>[% seg | html %]</li>
   [% END %]
   </ul>
[% END %]

</div>
</div>
<div class="yui-b">
[% INCLUDE 'acquisitions-menu.inc' %]
</div>
</div>
[% INCLUDE 'intranet-bottom.inc' %]

Lines 91-96 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (+4 lines)
91		91
92	<dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>	92	<dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>
93	<dd>Define funds within your budgets</dd>	93	<dd>Define funds within your budgets</dd>
		94	<dt><a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI Accounts</a></dt>
		95	<dd>Manage vendor EDI accounts for import/export</dd>
		96	<dt><a href="/cgi-bin/koha/admin/edi_ean_accounts.pl">EDI EANs</a></dt>
		97	<dd>Manage Branch EDI EANs</dd>
94		98
95	</dl>	99	</dl>
96		100




[% INCLUDE 'doc-head-open.inc' %]
<title>Koha &rsaquo; Administration &rsaquo; EDI accounts
[% IF acct_form %]
  [% IF account %]
     &rsquo; Modify account
  [% ELSE %]
     &rsquo; Add new account
  [% END %]
[% END %]
[% IF delete_confirm %]
     &rsquo; Confirm deletion of account
[% END %]
</title>
[% INCLUDE 'doc-head-close.inc' %]
</head>
<body id="admin_edi_acct" class="admin">
[% INCLUDE 'header.inc' %]
[% INCLUDE 'cat-search.inc' %]

<div id="breadcrumbs">
<a href="/cgi-bin/koha/mainpage.pl">Home</a>
 &rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a>
 &rsaquo; <a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI accounts</a>
[% IF acct_form %]
  [% IF account %]
     &rsaquo; Modify account
  [% ELSE %]
     &rsaquo; Add new account
  [% END %]
[% ELSIF delete_confirm %]
     &rsaquo; Confirm deletion of account
[% ELSE %]
     &rsaquo; Accounts
[% END %]
</div>

<div id="doc3" class="yui-t2">

<div id="bd">
<div id="yui-main">
<div class="yui-b">
[% IF display %]
    <div id="toolbar" class="btn-toolbar">
    <a class="btn btn-small" id="newediacct" href="/cgi-bin/koha/admin/edi_accounts.pl?op=acct_form">
         <i class="icon-plus"></i>
         New account
    </a>
    </div>
[% END %]

[% IF acct_form %]
<form action="/cgi-bin/koha/admin/edi_accounts.pl" name="Actform" method="post">
  <input type="hidden" name="op" value="save" />
  [% IF account %]
  <input type="hidden" name="id" value="[% account.id %]" />
  [% END %]
  <fieldset class="rows">
  <legend>
  [% IF account %]
     Modify account
  [% ELSE %]
    New account
  [% END %]
  </legend>

  <ol>
  <li>
     <label for="vendor_id">Vendor: </label>
     <select name="vendor_id" id="vendor_id">
     [% FOREACH vendor IN vendors %]
       [% IF account.vendor_id == vendor.id %]
          <option value="[% vendor.id %]" selected="selected">[% vendor.name %]</option>
       [% ELSE %]
          <option value="[% vendor.id %]">[% vendor.name %]</option>
       [% END %]
     [% END %]
     </select>
  </li>
  <li>
     <label for="description">Description: </label>
     <input type="text" name="description" id="description" size="20" maxlength="90" value="[% account.description %]" />
  </li>
  <li>
     [% transport_types = [
                 'FTP', 'SFTP', 'FILE'
            ]
     %]
     <label for="transport">Transport: </label>
     <select name="transport" title="valid types of transport are FTP and SFTP"
      id="transport">
      [% FOREACH transport_type IN transport_types %]
           [% IF transport_type == account.transport %]
              <option value="[% transport_type %]" selected="selected">[% transport_type %]</option>
           [% ELSE %]
              <option value="[% transport_type %]">[% transport_type %]</option>
           [% END %]
       [% END %]
     </select>
  </li>
  <li>
     <label for="host">Remote host: </label>
     <input type="text" name="host" id="host" size="20" maxlength="90" value="[% account.host %]" />
  </li>
  <li>
     <label for="username">Username: </label>
     <input type="text" name="username" id="username" size="20" maxlength="90" value="[% account.username %]" />
  </li>
  <li>
     <label for="password">Password: </label>
     <input type="text" name="password" id="password" size="20" maxlength="90" value="[% account.password %]" />
  </li>
  <li>
     <label for="download_directory">Download directory: </label>
     <input type="text" name="download_directory" id="download_directory" size="20" maxlength="90"
      title="The download directory specifies the directory on the ftpsite from which we download quotes and invoices"
      value="[% account.download_directory %]" />
  </li>
  <li>
     <label for="upload_directory">Upload directory: </label>
     <input type="text" name="upload_directory" id="upload_directory" size="20" maxlength="90"
      title="The upload directory specifies the directory on the ftp site to which we upload orders"
      value="[% account.upload_directory %]" />
  </li>
  <li>
     <label for="id_code_qualifier">Qualifier:</label>
     <select name="id_code_qualifier" id="id_code_qualifier">
     [% FOREACH qualifier IN code_qualifiers %]
        [% IF qualifier.code == account.id_code_qualifier %]
           <option value="[% qualifier.code %]" selected="selected">
		[% qualifier.description %]
           </option>
        [% ELSE %]
           <option value="[% qualifier.code %]">
              [% qualifier.description %]
           </option>
        [% END %]
     [% END %]
   </select>
  </li>
  <li>
     <label for="san">SAN: </label>
     <input type="text" name="san" id="san" size="20" maxlength="90" value="[% account.san %]" />
  </li>
  <li>
     <label for="quotes_enabled">Quotes enabled: </label>
     <input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" [% IF account.quotes_enabled %]checked[% END %] />
  </li>
  <li>
     <label for="orders_enabled">Orders enabled: </label>
     <input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" [% IF account.orders_enabled %]checked[% END %] />
  </li>
  <li>
     <label for="invoices_enabled">Invoices enabled: </label>
     <input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" [% IF account.invoices_enabled %]checked[% END %] />
  </li>
  </ol>
  </fieldset>

  <fieldset class="action">
    <input type="submit" value="Submit" />
    <a href="/cgi-bin/koha/admin/edi_accounts.pl" class="cancel">Cancel</a>
  </fieldset>
</form>

[% END %]
[% IF delete_confirm %]
<div class="dialog alert">
<h3>Delete this account?</h3>
<table>
    <tr>
    <th>Vendor</th>
    <td>[% account.vendor %]</td>
    </tr>
    <tr>
    <th>Description</th>
    <td>[% account.description %]</td>
    </tr>
    <tr>
    <th>SAN</th>
    <td>[% account.san %]</td>
    </tr>
    <tr>
    <th>Last activity</th>
    <td>[% account.last_activity %]</td>
    </tr>
</table>
<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="post">
    <table>
    </table>
    <input type="hidden" name="op" value="delete_confirmed" />
    <input type="hidden" name="id" value="[% account.id %]" />
    <input type="submit" class="approve" value="Yes, Delete" />
</form>
<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="get">
    <input type="submit" class="deny" value="No, do not Delete" />
</form>
[% END %]
[% IF display %]
<h2>Vendor EDI accounts</h2>

    <table>
    <tr>
       <th>ID</th>
       <th>Vendor</th>
       <th>Description</th>
       <th>Transport</th>
       <th>Remote host</th>
       <th>Username</th>
       <th>Password</th>
       <th>Download Directory</th>
       <th>Upload Directory</th>
       <th>id_code_type</th>
       <th>id_code</th>
       <th>Quotes</th>
       <th>Orders</th>
       <th>Invoices</th>
       <th>Last activity</th>
       <th>Actions</th>
    </tr>
    [% FOREACH account IN ediaccounts %]
    [% IF loop.even %]<tr>
    [% ELSE %]<tr class="highlight">
    [% END %]
      <td>[% account.id %]</td>
      <td><a href="/cgi-bin/koha/acqui/supplier.pl?supplierid=[% account.vendor_id %]">[% account.vendor.name %]</a></td>
      <td>[% account.description %]</td>
      <td>[% account.transport %]</td>
      <td>[% account.host %]</td>
      <td>[% account.username %]</td>
      <td>[% IF account.password %]xxxxx[% END %]</td>
      <td>[% account.download_directory %]</td>
      <td>[% account.upload_directory %]</td>
      <td>[% account.id_code_qualifier %]</td>
      <td>[% account.san %]</td>
      [% IF account.quotes_enabled %]
         <td>Y</td>
      [% ELSE %]
         <td></td>
      [% END %]
      [% IF account.orders_enabled %]
         <td>Y</td>
      [% ELSE %]
         <td></td>
      [% END %]
      [% IF account.invoices_enabled %]
         <td>Y</td>
      [% ELSE %]
         <td></td>
      [% END %]
      <td>[% account.last_activity %]</td>
      <td align="center">
          <a href="/cgi-bin/koha/admin/edi_accounts.pl?op=acct_form&id=[% account.id %]">Edit</a> | <a href="/cgi-bin/koha/admin/edi_accounts.pl?op=delete_confirm&id=[% account.id %]">Delete</a>
      </td>
    </tr>
    [% END %]
    </table>
[% END %]

</div>
</div>
<div class="yui-b">
    [% INCLUDE 'admin-menu.inc' %]
</div>
</div>
[% INCLUDE 'intranet-bottom.inc' %]




[% INCLUDE 'doc-head-open.inc' %]
<title>Koha &rsaquo; Administration &rsaquo; EDI EANs</title>
[% IF ean_form %]
  [% IF ean %]
     &rsquo; Modify branch EAN
  [% ELSE %]
     &rsquo; Add new branch EAN
  [% END %]
[% END %]
[% IF delete_confirm %]
     &rsquo; Confirm deletion of EAN
[% END %]
</title>
[% INCLUDE 'doc-head-close.inc' %]
</head>
<body id="admin_edi_ean" class="admin">
[% INCLUDE 'header.inc' %]
[% INCLUDE 'cat-search.inc' %]

<div id="breadcrumbs">
<a href="/cgi-bin/koha/mainpage.pl">Home</a>
 &rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a>
 &rsaquo; <a href="/cgi-bin/koha/admin/edi_ean_accounts.pl">EDI EANs</a>
[% IF ean_form %]
  [% IF ean %]
     &rsaquo; Modify branch EAN
  [% ELSE %]
     &rsaquo; Add new branch EAN
  [% END %]
[% ELSIF delete_confirm %]
     &rsaquo; Confirm deletion of Ean
[% ELSE %]
     &rsaquo; Branch EANs
[% END %]
</div>

<div id="doc3" class="yui-t2">

<div id="bd">
<div id="yui-main">
<div class="yui-b">
[% IF display %]
    <div id="toolbar" class="btn-toolbar">
    <a class="btn btn-small" id="newediean" href="/cgi-bin/koha/admin/edi_ean_accounts.pl?op=ean_form">
         <i class="icon-plus"></i>
         New EAN
    </a>
    </div>
[% END %]

[% IF ean_form %]
<form action="/cgi-bin/koha/admin/edi_ean_accounts.pl" name="Eanform" method="post">
  <input type="hidden" name="op" value="save" />
  [% IF ean %]
  <input type="hidden" name="oldbranchcode" value="[% branchcode %]" />
  <input type="hidden" name="oldean" value="[% ean %]" />
  [% END %]
  <fieldset class="rows">
  <legend>
  [% IF ean %]
     Modify EAN
  [% ELSE %]
    New EAN
  [% END %]
  </legend>

  <ol>
  <li>
     <label for="branchcode">Branchcode: </label>
     <select name="branchcode" id="branchcode">
        [% FOREACH branch IN branches %]
            [% IF branch.branchcode == ean.branch.branchcode %]
               <option value="[% branch.branchcode %]" selected="selected">[% branch.branchname %]</option>
            [% ELSE %]
               <option value="[% branch.branchcode %]">[% branch.branchname %]</option>
            [% END %]
        [% END %]
      </select>
  </li>
  <li>
     <label for="ean">EAN: </label>
     <input type="text" name="ean" id="ean`" size="20" maxlength="90" value="[% ean.ean %]" />
  </li>
  <li>
     <label for="id_code_qualifier">
     <select name="id_code_qualifier" id="id_code_qualifier">
     [% FOREACH qualifier IN code_qualifiers %]
        [% IF qualifier.code == ean.id_code_qualifier %]
           <option value="[% qualifier.code %]" selected="selected">
		[% qualifier.description %]
           </option>
        [% ELSE %]
           <option value="[% qualifier.code %]">
              [% qualifier.description %]
           </option>
        [% END %]
     [% END %]
  </li>

  </ol>
  </fieldset>

  <fieldset class="action">
    <input type="submit" value="Submit"/>
    <a href="/cgi-bin/koha/admin/edi_ean_accounts.pl" class="cancel">Cancel</a>
  </fieldset>
</form>

[% END %]
[% IF delete_confirm %]
<div class="dialog alert">
<h3>Delete EAN [% ean.ean %] for branch [% ean.branch.branchname %]?</h3>
<form action="/cgi-bin/koha/admin/edi_ean_accounts.pl" method="post">
    <input type="hidden" name="op" value="delete_confirmed" />
    <input type="hidden" name="branchcode" value="[% ean.branch.branchcode %]" />
    <input type="hidden" name="ean" value="[% ean.ean %]" />
    <input type="submit" class="approve" value="Yes, Delete" />
</form>
<form action="/cgi-bin/koha/admin/edi_ean_accounts.pl" method="get">
    <input type="submit" class="deny" value="No, do not Delete" />
</form>
</div>
[% END %]
[% IF display %]
<h2>Branch EANs</h2>
   <table>
   <tr>
      <th>Branch</th>
      <th>EAN</th>
      <th>Code Type</th>
      <th>Actions</th>
   </tr>
   [% FOREACH ean IN eans %]
   [% IF loop.even %]<tr>
   [% ELSE %]<tr class="highlight">
   [% END %]
      <td>[% ean.branch.branchname %]</td>
      <td>[% ean.ean %]</td>
      <td>[% ean.id_code_qualifier %]</td>
      <td align="center">
           <a href="/cgi-bin/koha/admin/edi_ean_accounts.pl?op=ean_form&branchcode=[% ean.branch.branchcode %]&ean=[% ean.ean %]">Edit</a> | <a href="/cgi-bin/koha/admin/edi_ean_accounts.pl?op=delete_confirm&branchcode=[% ean.branch.branchcode %]&ean=[% ean.ean %]">Delete</a></td>
   </tr>
   [% END %]
    </table>
[% END %]

</div>
</div>
<div class="yui-b">
    [% INCLUDE 'admin-menu.inc' %]
</div>
</div>
[% INCLUDE 'intranet-bottom.inc' %]

Lines 107-112 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt (+5 lines)
107	<dd>Use tool plugins</dd>	107	<dd>Use tool plugins</dd>
108	[% END %]	108	[% END %]
109		109
		110	[% IF CAN_user_acquisition_edi_manage %]
		111	<dt><a href="/cgi-bin/koha/tools/edi.pl">EDIfact messages</a></dt>
		112	<dd>Manage EDIfact transmissions</dd>
		113	[% END %]
		114
110	</dl>	115	</dl>
111	</div>	116	</div>
112	<div class="yui-u">	117	<div class="yui-u">




#!/usr/bin/perl
#
# Copyright 2013,2014 PTFS Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use warnings;
use strict;

# Handles all the edi processing for a site
# loops through the vendor_edifact records and uploads and downloads
# edifact files id the appropriate type is enabled
# downloaded quotes and invoices are processed here
# can be run as frequently as required

use C4::Context;
use Log::Log4perl qw(:easy);
use Koha::Database;
use Koha::EDI qw( process_quote process_invoice);
use Koha::Edifact::Transport;

my $logdir = C4::Context->logdir;

# logging set to trace as this may be what you
# want on implementation
Log::Log4perl->easy_init(
    {
        level => $TRACE,
        file  => ">>$logdir/editrace.log",
    }
);

my $schema = Koha::Database->new()->schema();

my @edi_accts = $schema->resultset('VendorEdiAccount')->all();

my $logger = Log::Log4perl->get_logger();

for my $acct (@edi_accts) {
    if ( $acct->quotes_enabled ) {
        my $downloader = Koha::Edifact::Transport->new( $acct->id );
        $downloader->download_messages('QUOTE');

        #update vendor last activity
    }

    if ( $acct->invoices_enabled ) {
        my $downloader = Koha::Edifact::Transport->new( $acct->id );
        $downloader->download_messages('INVOICE');

        #update vendor last activity
    }
    if ( $acct->orders_enabled ) {

        # select pending messages
        my @pending_orders = $schema->resultset('EdifactMessage')->search(
            {
                message_type => 'ORDERS',
                vendor_id    => $acct->vendor_id,
                status       => 'Pending',
            }
        );
        my $uploader = Koha::Edifact::Transport->new( $acct->id );
        $uploader->upload_messages(@pending_orders);
    }
}

# process any downloaded quotes

my @downloaded_quotes = $schema->resultset('EdifactMessage')->search(
    {
        message_type => 'QUOTE',
        status       => 'new',
    }
)->all;

foreach my $quote_file (@downloaded_quotes) {
    my $filename = $quote_file->filename;
    $logger->trace("Processing quote $filename");
    process_quote($quote_file);
}

# process any downloaded invoices

my @downloaded_invoices = $schema->resultset('EdifactMessage')->search(
    {
        message_type => 'INVOICE',
        status       => 'new',
    }
)->all;

foreach my $invoice (@downloaded_invoices) {
    my $filename = $invoice->filename();
    $logger->trace("Processing invoice $filename");
    process_invoice($invoice);
}

exit 0;

(-)a/t/BLSINV337023.CEI (+1 lines)

Line 0 Link Here

UNA:+.? 'UNB+UNOC:3+5013546025078+5013546121974+140729:1153+337023++INVOIC'UNH+01975489+INVOIC:D:96A:UN:EAN008'BGM+380+01975489+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975489'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780007464593:EN'IMD+L+009+:::Beukes, Lauren'IMD+L+050+:::Broken monsters'QTY+47:1'GIR+001+34148009564714:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2724/71178'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:1'MOA+129:7.4'MOA+9:7.4'TAX+7+VAT+++:::0+Z'MOA+125:7.4'MOA+124:0'UNT+33+01975489'UNH+01975490+INVOIC:D:96A:UN:EAN008'BGM+380+01975490+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975490'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780755380664:EN'IMD+L+009+:::McDermott, Andy'IMD+L+050+:::The Valhalla prophecy'QTY+47:1'GIR+001+34148009564730:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2818/74528'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+2++9780755380664:EN'IMD+L+009+:::McDermott, Andy'IMD+L+050+:::The Valhalla prophecy'QTY+47:1'GIR+001+34148009564748:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2818/74529'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+3++9780857204028:EN'IMD+L+009+:::Fleming, Leah'IMD+L+050+:::The postcard'QTY+47:1'GIR+001+34148009564722:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74544'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+4++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564755:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74589'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+5++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564763:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74590'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+6++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564771:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74591'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+7++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564789:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74592'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+8++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564797:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74593'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:8'MOA+129:35.260'MOA+9:35.260'TAX+7+VAT+++:::0+Z'MOA+125:35.260'MOA+124:0'UNT+145+01975490'UNH+01975491+INVOIC:D:96A:UN:EAN008'BGM+380+01975491+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975491'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9781471132193:EN'IMD+L+009+:::Carter, Chris'IMD+L+050+:::An evil mind'QTY+47:1'GIR+001+34148009564821:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2831/74996'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+2++9781472208682:EN'IMD+L+009+:::Brown, Benita'IMD+L+050+:::Counting the days'QTY+47:1'GIR+001+34148009564805:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:11.39'MOA+52:8.6'PRI+AAA:11.39'PRI+AAB:19.99'RFF+LI:2831/75006'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:8.6'TAX+7+VAT+++:::0+Z'LIN+3++9781472208682:EN'IMD+L+009+:::Brown, Benita'IMD+L+050+:::Counting the days'QTY+47:1'GIR+001+34148009564813:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:11.39'MOA+52:8.6'PRI+AAA:11.39'PRI+AAB:19.99'RFF+LI:2831/75007'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:8.6'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:3'MOA+129:30.180'MOA+9:30.180'TAX+7+VAT+++:::0+Z'MOA+125:30.180'MOA+124:0'UNT+65+01975491'UNH+01975492+INVOIC:D:96A:UN:EAN008'BGM+380+01975492+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975492'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780241957479:EN'IMD+L+009+:::Brook, Rhidian'IMD+L+050+:::The aftermath'QTY+47:1'GIR+001+34148009564839:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2894/77394'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:1'MOA+129:4.550'MOA+9:4.550'TAX+7+VAT+++:::0+Z'MOA+125:4.550'MOA+124:0'UNT+33+01975492'UNH+01975493+INVOIC:D:96A:UN:EAN008'BGM+380+01975493+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975493'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564946:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79232'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+2++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564953:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79233'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+3++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564961:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79234'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+4++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564979:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79276'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+5++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564987:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79277'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+6++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564995:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79278'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+7++9780349002071:EN'IMD+L+009+:::Cast, P. C.'IMD+L+050+:::Kalona s fall'QTY+47:1'GIR+001+34148009564920:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/78995'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+8++9780349002071:EN'IMD+L+009+:::Cast, P. C.'IMD+L+050+:::Kalona s fall'QTY+47:1'GIR+001+34148009564938:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/78996'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+9++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565026:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79301'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+10++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565034:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79302'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+11++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565042:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79303'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+12++9781405268028:EN'IMD+L+009+:::Loser, Barry'IMD+L+050+:::Barry Loser and the holiday of doo'QTY+47:1'GIR+001+34148009565000:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/79304'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+13++9781405268028:EN'IMD+L+009+:::Loser, Barry'IMD+L+050+:::Barry Loser and the holiday of doo'QTY+47:1'GIR+001+34148009565018:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/79305'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+14++9781405269094:EN'IMD+L+009+:::Monks, Lydia'IMD+L+050+:::Mungo Monkey goes to school'QTY+47:1'GIR+001+34148009565067:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2971/79307'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+15++9781405269094:EN'IMD+L+009+:::Monks, Lydia'IMD+L+050+:::Mungo Monkey goes to school'QTY+47:1'GIR+001+34148009565075:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2971/79308'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+16++9781407132846:EN'IMD+L+009+:::Simmons, Jo'IMD+L+050+:::A brotherly bother'QTY+47:1'GIR+001+34148009565117:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79333'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+17++9781407132846:EN'IMD+L+009+:::Simmons, Jo'IMD+L+050+:::A brotherly bother'QTY+47:1'GIR+001+34148009565125:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79334'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+18++9781407142944:EN'IMD+L+009+:::Zucker, Jonny'IMD+L+050+:::The fleas who fight crime'QTY+47:1'GIR+001+34148009565158:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79359'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+19++9781407142944:EN'IMD+L+009+:::Zucker, Jonny'IMD+L+050+:::The fleas who fight crime'QTY+47:1'GIR+001+34148009565166:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79360'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+20++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009564847:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79372'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+21++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009564854:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79373'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+22++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009564870:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79374'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+23++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009564888:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79375'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+24++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009564862:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79378'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+25++9781408330104:EN'IMD+L+009+:::Brownlow, Michael'IMD+L+050+:::Ten little princesses'QTY+47:1'GIR+001+34148009564912:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:6.83'MOA+52:5.16'PRI+AAA:6.83'PRI+AAB:11.99'RFF+LI:2971/79379'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.16'TAX+7+VAT+++:::0+Z'LIN+26++9781408333136:EN'IMD+L+009+:::Meadows, Daisy'IMD+L+050+:::Destiny the pop star fairy'QTY+47:1'GIR+001+34148009565059:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79380'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+27++9781444910216:EN'IMD+L+009+:::Bently, Peter'IMD+L+050+:::The cat, the mouse and the runaway'QTY+47:1'GIR+001+34148009564896:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79404'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+28++9781444910216:EN'IMD+L+009+:::Bently, Peter'IMD+L+050+:::The cat, the mouse and the runaway'QTY+47:1'GIR+001+34148009564904:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79405'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+29++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565083:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79408'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+30++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565091:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79409'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+31++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565109:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79410'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+32++9781781716441:EN'IMD+L+009+:::Smallman, Steve'IMD+L+050+:::Goldilocks'QTY+47:1'GIR+001+34148009565141:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:5.69'MOA+52:4.3'PRI+AAA:5.69'PRI+AAB:9.99'RFF+LI:2971/79433'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:4.3'TAX+7+VAT+++:::0+Z'LIN+33++9781781716465:EN'IMD+L+009+:::Smallman, Steve'IMD+L+050+:::Blow your nose, big bad wolf'QTY+47:1'GIR+001+34148009565133:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:5.69'MOA+52:4.3'PRI+AAA:5.69'PRI+AAB:9.99'RFF+LI:2971/79434'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:4.3'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:33'MOA+129:131.910'MOA+9:131.910'TAX+7+VAT+++:::0+Z'MOA+125:131.910'MOA+124:0'UNT+545+01975493'UNH+01975494+INVOIC:D:96A:UN:EAN008'BGM+380+01975494+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975494'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009565174:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81414'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+2++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009565182:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81415'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+3++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565240:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81416'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+4++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565257:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81417'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+5++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565265:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81418'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+6++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565190:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81424'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+7++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565208:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81425'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+8++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565216:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81426'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+9++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565224:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81427'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+10++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565232:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81428'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:10'MOA+129:28.4'MOA+9:28.4'TAX+7+VAT+++:::0+Z'MOA+125:28.4'MOA+124:0'UNT+177+01975494'UNZ+6+337023'




#!/usr/bin/perl
use strict;
use warnings;
use FindBin qw( $Bin );

use Test::More tests => 19;

BEGIN { use_ok('Koha::Edifact') }

my $invoice_file = "$Bin/BLSINV337023.CEI";

my $invoice = Koha::Edifact->new( { filename => $invoice_file, } );

isa_ok( $invoice, 'Koha::Edifact' );
my $x                 = $invoice->interchange_header('sender');
my $control_reference = '337023';
is( $x, '5013546025078', "sender returned" );

$x = $invoice->interchange_header('recipient');
is( $x, '5013546121974', "recipient returned" );
$x = $invoice->interchange_header('datetime');
is( $x->[0], '140729', "datetime returned" );
$x = $invoice->interchange_header('interchange_control_reference');
is( $x, $control_reference, "interchange_control_reference returned" );

$x = $invoice->interchange_header('application_reference');
is( $x, 'INVOIC', "application_reference returned" );
$x = $invoice->interchange_trailer('interchange_control_count');
is( $x, 6, "interchange_control_count returned" );

my $messages = $invoice->message_array();

# check inv number from BGM

my $msg_count = @{$messages};
is( $msg_count, 6, 'correct message count returned' );

is( $messages->[0]->message_type, 'INVOIC', 'Message shows correct type' );

my $expected_date = '20140729';
is( $messages->[0]->message_date,
    $expected_date, 'Message date correctly returned' );
is( $messages->[0]->tax_point_date,
    $expected_date, 'Tax point date correctly returned' );

my $expected_invoicenumber = '01975490';

my $invoicenumber = $messages->[1]->docmsg_number();

is( $messages->[0]->buyer_ean,    '5013546121974', 'Buyer ean correct' );
is( $messages->[0]->supplier_ean, '5013546025078', 'Supplier ean correct' );

is( $invoicenumber, $expected_invoicenumber,
    'correct invoicenumber extracted' );

my $lines = $messages->[1]->lineitems();

my $num_lines = @{$lines};

is( $num_lines, 8, "Correct number of lineitems returned" );

# sample invoice was from an early version where order was formatted basketno/ordernumber
my $expected_ordernumber = '2818/74593';

my $ordernumber = $lines->[7]->ordernumber;

is( $ordernumber, $expected_ordernumber, 'correct ordernumber returned' );

my $lineprice = $lines->[7]->price_net;

is( $lineprice, 4.55, 'correct net line price returned' );

my $tax = $lines->[7]->tax;

is( $tax, 0, 'correct tax amount returned' );




#!/usr/bin/perl
use strict;
use warnings;
use FindBin qw( $Bin );

use Test::More tests => 27;

BEGIN { use_ok('Koha::Edifact') }

my $filename = "$Bin/prquotes_73050_20140430.CEQ";

my $quote = Koha::Edifact->new( { filename => $filename, } );

isa_ok( $quote, 'Koha::Edifact' );

my $x = $quote->interchange_header('sender');
is( $x, '5013546027856', "sender returned" );

$x = $quote->interchange_header('recipient');
is( $x, '5030670137480', "recipient returned" );
$x = $quote->interchange_header('datetime');
is( $x->[0], '140430', "datetime returned" );
my $control_reference = 'EDIQ2857763';
$x = $quote->interchange_header('interchange_control_reference');
is( $x, $control_reference, "interchange_control_reference returned" );

$x = $quote->interchange_header('application_reference');
is( $x, 'QUOTES', "application_reference returned" );

$x = $quote->interchange_trailer('interchange_control_count');
is( $x, 1, "interchange_control_count returned" );

my $msgs      = $quote->message_array();
my $msg_count = @{$msgs};
is( $msg_count, 1, "correct message count returned" );
my $m = $msgs->[0];

is( $m->message_type, 'QUOTES', "Message shows correct type" );
is( $m->message_reference_number,
    'MQ09791', "Message reference number returned" );
is( $m->docmsg_number, 'Q741588',  "Message docmsg number returned" );
is( $m->message_date,  '20140430', "Message date returned" );

my $lin = $m->lineitems();

my $num_lines = @{$lin};
is( $num_lines, 18, 'Correct number of lines in message' );

my $test_line = $lin->[-1];

is( $test_line->line_item_number, 18, 'correct line number returned' );
is( $test_line->item_number_id, '9780273761006', 'correct ean returned' );
is( $test_line->quantity, 1, 'quantity returned' );

my $test_title = 'International business [electronic resource]';
my $marcrec    = $test_line->marc_record;
isa_ok( $marcrec, 'MARC::Record' );

my $title = $test_line->title();

# also tests components are concatenated
is( $title, $test_title, "Title returned" );

# problems currently with the record (needs leader ??)
#is( $marcrec->title(), $test_title, "Title returned from marc");
my $test_author = q{Rugman, Alan M.};
is( $test_line->author,           $test_author,        "Author returned" );
is( $test_line->publisher,        'Pearson Education', "Publisher returned" );
is( $test_line->publication_date, q{2012.},            "Pub. date returned" );
#
# Test data encoded in GIR
#
my $stock_category = $test_line->girfield('stock_category');
is( $stock_category, 'EBOOK', "stock_category returned" );
my $branch = $test_line->girfield('branch');
is( $branch, 'ELIB', "branch returned" );
my $fund_allocation = $test_line->girfield('fund_allocation');
is( $fund_allocation, '660BOO_2013', "fund_allocation returned" );
my $collection_code = $test_line->girfield('collection_code');
is( $collection_code, 'EBOO', "collection_code returned" );

#my $shelfmark = $test_line->girfield('shelfmark');
#my $classification = $test_line->girfield('classification');

## text the free_text returned from the line
my $test_line_2 = $lin->[12];

my $ftx_string = 'E*610.72* - additional items';

is( $test_line_2->free_text, $ftx_string, "ftx note retrieved" );




#!/usr/bin/perl
use strict;
use warnings;
use FindBin qw( $Bin );

use Test::More tests => 6;

BEGIN { use_ok('Koha::Edifact::Order') }


# The following tests are for internal methods but they could
# error spectacularly so yest
# Check that quoting is done correctly
#
my $processed_text =
  Koha::Edifact::Order::encode_text(q{string containing ?,',:,+});

cmp_ok(
    $processed_text, 'eq',
    q{string containing ??,?',?:,?+},
    'Outgoing text correctly quoted'
);

# extend above test to test chunking in imd_segment
#
my $code           = '010';
my $data_to_encode = $processed_text;

my @segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );

my $testseg = "IMD+L+010+:::$processed_text";
$testseg .= q{'};    # add segment terminator

cmp_ok( $segs[0], 'eq', $testseg, 'IMD segment correctly formed' );

$data_to_encode = 'A' x 35;
$data_to_encode .= 'B' x 35;
$data_to_encode .= 'C' x 10;

@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );

cmp_ok(
    $segs[0],
    'eq',
q{IMD+L+010+:::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA:BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB'},
    'IMD segment correctly chunked'
);
cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC'},
    'IMD segment correctly split across segments' );

$data_to_encode .= '??';

# this used to cause an infinite loop
@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'},
    'IMD segment deals with quoted character at end' );

(-)a/t/prquotes_73050_20140430.CEQ (-1 / +1 lines)

Line 0 Link Here

UNA:+.? 'UNB+UNOC:3+5013546027856+5030670137480+140430:1849+EDIQ2857763++QUOTES'UNH+MQ09791+QUOTES:D:96A:UN:EAN002'BGM+31C+Q741588+9'DTM+137:20140430:102'CUX+2:GBP:12'NAD+BY+5030670137480::9'NAD+SU+5013546027856::9'LIN+1++9780191652028:EN'IMD+L+010+:::Fisher, Miles.'IMD+L+050+:::Heart disease and diabetes [electro:nic resource]'IMD+L+100+:::2nd ed.'IMD+L+110+:::Oxford'IMD+L+120+:::Oxford University Press'IMD+L+170+:::2012.'IMD+L+180+:::xv, 156 p.'IMD+L+190+:::Oxford diabetes library'IMD+L+230+:::616.12'IMD+L+240+:::RC660'IMD+L+300+:::Previous ed.?: 2009.'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:79.42:DI'RFF+QLI:2857763'LIN+2++9781461414759:EN'IMD+L+010+:::Vlodaver, Zeev.'IMD+L+050+:::Coronary heart disease [electronic :resource]'IMD+L+110+:::New York ,London'IMD+L+120+:::Springer'IMD+L+170+:::2012.'IMD+L+180+:::xv, 540 p.'IMD+L+230+:::616.123'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:161.87:DI'RFF+QLI:2857785'LIN+3++9780199793662:EN'IMD+L+010+:::Yaffe, Kristine,'IMD+L+050+:::Chronic medical disease and cogniti:ve aging [electronic resource]'IMD+L+110+:::New York'IMD+L+120+:::Oxford University Press'IMD+L+170+:::2013'IMD+L+180+:::xv, 298 pages'IMD+L+230+:::616.044'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:165.53:DI'RFF+QLI:2857810'LIN+4++9781446258637:EN'IMD+L+010+:::Lupton, Deborah.'IMD+L+050+:::Medicine as culture [electronic res:ource]'IMD+L+100+:::3rd ed.'IMD+L+110+:::Los Angeles ,London'IMD+L+120+:::SAGE'IMD+L+170+:::2012.'IMD+L+180+:::xii, 195 p.'IMD+L+230+:::306.461'IMD+L+300+:::Previous ed.?: 2003.'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:94.8:DI'RFF+QLI:2857839'LIN+5++9780203113974:EN'IMD+L+010+:::Magdalinski, Tara,'IMD+L+050+:::Study skills for sport studies [ele:ctronic resource]'IMD+L+180+:::xv, 250 pages'IMD+L+230+:::371.30281'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:171:DI'RFF+QLI:2857913'LIN+6++9781450453080:EN'IMD+L+010+:::Hausswirth, Christophe,'IMD+L+050+:::Recovery for performance in sport [:electronic resource]'IMD+L+180+:::xiii, 281 pages'IMD+L+230+:::617.03'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:212.4:DI'RFF+QLI:2857919'LIN+7++9780203807279:EN'IMD+L+010+:::Lebed, Felix,'IMD+L+050+:::Complexity and control in team spor:ts [electronic resource]'IMD+L+180+:::xx, 223 pages'IMD+L+190+:::Routledge research in sport and exe:rcise science ;'IMD+L+191+:::6'IMD+L+230+:::306.483'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:153:DI'RFF+QLI:2858034'LIN+8++9780415691055:EN'IMD+L+010+:::Smith, Mark'IMD+L+050+:::Practical Skills in Sport and Exerc:ise Science'IMD+L+120+:::Taylor & Francis'IMD+L+170+:::2014'QTY+1:4'GIR+001+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+003+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+004+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:24.99:DI'RFF+QLI:2858105'LIN+9++9781450434324:EN'IMD+L+010+:::Hoffman, Shirl J.,'IMD+L+050+:::Introduction to kinesiology'IMD+L+100+:::Fourth edition.'IMD+L+110+:::Champaign'IMD+L+120+:::Human Kinetics Publishers'IMD+L+170+:::2013'IMD+L+180+:::xvi, 529 pages'IMD+L+230+:::612.76'IMD+L+300+:::Previous edition?: 2009.'QTY+1:3'GIR+001+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+003+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:67.5:DI'RFF+QLI:2858153'LIN+10++9780702049293:EN'IMD+L+010+:::Norris, Christopher M.'IMD+L+050+:::Managing sports injuries [electroni:c resource]'IMD+L+100+:::4th ed.'IMD+L+110+:::Edinburgh'IMD+L+120+:::Churchill Livingstone'IMD+L+170+:::2011.'IMD+L+180+:::421 p.'IMD+L+230+:::617.1027'IMD+L+240+:::RD97'IMD+L+300+:::Rev. ed. of?: Sports injuries / Chr:istopher M. Norris. 3rd ed. 2004.'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:275.23:DI'RFF+QLI:2858165'LIN+11++9781292034874:EN'IMD+L+010+:::Bledsoe, Bryan E.,'IMD+L+050+:::Paramedic care [electronic resource:]'IMD+L+080+:::Volume 5,'IMD+L+100+:::Pearson new international edition.'IMD+L+180+:::ii, 422 pages'IMD+L+190+:::Pearson custom library'IMD+L+230+:::616.025'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:41.99:DI'RFF+QLI:2858217'LIN+12++9781292021645:EN'IMD+L+010+:::Bledsoe, Bryan E.,'IMD+L+050+:::Paramedic care'IMD+L+080+:::Volume 5,'IMD+L+100+:::Pearson new international edition.'IMD+L+110+:::Harlow'IMD+L+120+:::Pearson Education'IMD+L+170+:::2013'IMD+L+180+:::ii, 422 pages'IMD+L+190+:::Pearson custom library'IMD+L+230+:::616.025'QTY+1:5'GIR+001+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+002+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+003+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+004+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+005+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'PRI+AAE:52.99:DI'RFF+QLI:2858231'LIN+13++9781446253083:EN'IMD+L+010+:::Green, Judith'IMD+L+050+:::Qualitative Methods for Health Rese:arch'IMD+L+100+:::Third Edition'IMD+L+110+:::London'IMD+L+120+:::SAGE Publications ?: SAGE Publicati:ons Ltd'IMD+L+170+:::2013'IMD+L+180+:::376 p.'IMD+L+190+:::Introducing Qualitative Methods ser:ies'IMD+L+230+:::610.721'IMD+L+300+:::The third edition of this bestselli:ng title is packed full of real wor'QTY+1:2'GIR+001+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+610.72:LCL+MAIN:LSQ'GIR+002+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+610.72:LCL+MAIN:LSQ'FTX+LIN++2:10B:28+E*610.72* - additional items'PRI+AAE:75:DI'RFF+QLI:2858253'LIN+14++9780273757726:EN'IMD+L+010+:::Jim Blythe.'IMD+L+050+:::Essentials of marketing'IMD+L+120+:::Pearson Education'QTY+1:1'GIR+001+ELIB:LLO+660BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:74.98:DI'RFF+QLI:2858398'LIN+15++9780745681726:EN'IMD+L+010+:::Selwyn, Ben,'IMD+L+050+:::The global development crisis [elec:tronic resource]'IMD+L+180+:::viii, 248 pages'IMD+L+230+:::338.9'IMD+L+240+:::HD75'IMD+L+300+:::This book challenges the assumption: that a ?'free?' global market will'QTY+1:1'GIR+001+ELIB:LLO+400BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:66:DI'RFF+QLI:2858545'LIN+16++9781412992077:EN'IMD+L+010+:::McMichael, Philip.'IMD+L+050+:::Development and social change'IMD+L+100+:::5th ed.'IMD+L+110+:::Los Angeles'IMD+L+120+:::SAGE'IMD+L+170+:::c2012.'IMD+L+180+:::xxi, 383 p.'IMD+L+190+:::Sociology for a New Century Series'IMD+L+230+:::306.309'IMD+L+240+:::HC79.E44'IMD+L+300+:::Revised and updated Fifth Edition o:f this popular critical exploration'QTY+1:1'GIR+001+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:49.99:DI'RFF+QLI:2858547'LIN+17++9780230213111:EN'IMD+L+010+:::Brown, Chris,'IMD+L+050+:::Understanding international relatio:ns'IMD+L+100+:::4th ed.'IMD+L+110+:::Basingstoke'IMD+L+120+:::Palgrave Macmillan'IMD+L+170+:::c2009.'IMD+L+180+:::xi, 321 p.'IMD+L+230+:::327'IMD+L+240+:::JZ1242'IMD+L+300+:::Previous ed.?: 2005.'QTY+1:2'GIR+001+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:27.99:DI'RFF+QLI:2858938'LIN+18++9780273761006:EN'IMD+L+010+:::Rugman, Alan M.'IMD+L+050+:::International business [electronic :resource]'IMD+L+100+:::6th ed.'IMD+L+110+:::Harlow'IMD+L+120+:::Pearson Education'IMD+L+170+:::2012.'IMD+L+180+:::xxxii,  765 p.'IMD+L+230+:::658.049'IMD+L+300+:::First published by McGraw-Hill, 199:5.'QTY+1:1'GIR+001+ELIB:LLO+660BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:114.97:DI'RFF+QLI:2858954'UNS+S'CNT+2:18'UNT+248+MQ09791'UNZ+1+EDIQ2857763'

Return to bug 7736

Lines 3119-3124 CREATE TABLE aqorders_transfers ( Link Here

(-)a/installer/data/mysql/kohastructure.sql (-1 / +70 lines)
3119	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;	3119	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3120		3120
3121	--	3121	--
		3122	-- Table structure for table vendor_edi_accounts
		3123	--
		3124
		3125	DROP TABLE IF EXISTS vendor_edi_accounts;
		3126	CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
		3127	id int(11) NOT NULL auto_increment,
		3128	description text NOT NULL,
		3129	host varchar(40),
		3130	username varchar(40),
		3131	password varchar(40),
		3132	last_activity date,
		3133	vendor_id int(11) references aqbooksellers( id ),
		3134	download_directory text,
		3135	upload_directory text,
		3136	san varchar(20),
		3137	id_code_qualifier varchar(3) default '14',
		3138	transport varchar(6) default 'FTP',
		3139	quotes_enabled tinyint(1) not null default 0,
		3140	invoices_enabled tinyint(1) not null default 0,
		3141	orders_enabled tinyint(1) not null default 0,
		3142	shipment_budget integer(11) references aqbudgets( budget_id ),
		3143	PRIMARY KEY (id),
		3144	KEY vendorid (vendor_id),
		3145	KEY shipmentbudget (shipment_budget),
		3146	CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		3147	CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
		3148	) ENGINE=InnoDB DEFAULT CHARSET=utf8;
		3149
		3150	--
		3151	-- Table structure for table edifact_messages
		3152	--
		3153
		3154	DROP TABLE IF EXISTS edifact_messages;
		3155	CREATE TABLE IF NOT EXISTS edifact_messages (
		3156	id int(11) NOT NULL auto_increment,
		3157	message_type varchar(10) NOT NULL,
		3158	transfer_date date,
		3159	vendor_id int(11) references aqbooksellers( id ),
		3160	edi_acct integer references vendor_edi_accounts( id ),
		3161	status text,
		3162	basketno int(11) references aqbasket( basketno),
		3163	raw_msg text,
		3164	filename text,
		3165	deleted boolean not null default 0,
		3166	PRIMARY KEY (id),
		3167	KEY vendorid ( vendor_id),
		3168	KEY ediacct (edi_acct),
		3169	KEY basketno ( basketno),
		3170	CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		3171	CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
		3172	CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
		3173	) ENGINE=InnoDB DEFAULT CHARSET=utf8;
		3174
		3175	--
3122	-- Table structure for table aqinvoices	3176	-- Table structure for table aqinvoices
3123	--	3177	--
3124		3178
Lines 3132-3141 CREATE TABLE aqinvoices ( Link Here
3132	closedate date default NULL, -- invoice close date, NULL means the invoice is open	3186	closedate date default NULL, -- invoice close date, NULL means the invoice is open
3133	shipmentcost decimal(28,6) default NULL, -- shipment cost	3187	shipmentcost decimal(28,6) default NULL, -- shipment cost
3134	shipmentcost_budgetid int(11) default NULL, -- foreign key to aqbudgets, link the shipment cost to a budget	3188	shipmentcost_budgetid int(11) default NULL, -- foreign key to aqbudgets, link the shipment cost to a budget
		3189	message_id int(11) default NULL, -- foreign key to edifact invoice message
3135	PRIMARY KEY (invoiceid),	3190	PRIMARY KEY (invoiceid),
3136	CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,	3191	CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3137	CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
3138	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;	3192	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
		3193	CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE,
		3194	CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL
		3195	) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3139		3196
3140		3197
3141	--	3198	--
Lines 3503-3508 CREATE TABLE items_search_fields ( Link Here
3503	ON DELETE SET NULL ON UPDATE CASCADE	3560	ON DELETE SET NULL ON UPDATE CASCADE
3504	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;	3561	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3505		3562
		3563	--
		3564	-- Table structure for table 'edifact_ean'
		3565	--
		3566
		3567	DROP TABLE IF EXISTS edifact_ean;
		3568	CREATE TABLE IF NOT EXISTS edifact_ean (
		3569	branchcode varchar(10) not null references branches (branchcode),
		3570	ean varchar(15) NOT NULL,
		3571	id_code_qualifier varchar(3) NOT NULL default '14',
		3572	CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
		3573	) ENGINE=InnoDB DEFAULT CHARSET=utf8;
		3574
3506	/!40103 SET TIME_ZONE=@OLD_TIME_ZONE /;	3575	/!40103 SET TIME_ZONE=@OLD_TIME_ZONE /;
3507	/!40101 SET SQL_MODE=@OLD_SQL_MODE /;	3576	/!40101 SET SQL_MODE=@OLD_SQL_MODE /;
3508	/!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS /;	3577	/!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS /;

Lines 9729-9734 if ( CheckVersion($DBversion) ) { Link Here

(-)a/installer/data/mysql/updatedatabase.pl (+78 lines)
9729	\|);	9729	\|);
9730		9730
9731	print "Upgrade to $DBversion done (Bug 12601 - Add new foreign key aqorders.budget_id" . ( ( $number_of_orders_not_linked->[0] > 0 ) ? ' WARNING: temporary budget and fund have been created (search for "BACKUP_TMP"). At least one of your order was not linked to a budget' : '' ) . ")\n";	9731	print "Upgrade to $DBversion done (Bug 12601 - Add new foreign key aqorders.budget_id" . ( ( $number_of_orders_not_linked->[0] > 0 ) ? ' WARNING: temporary budget and fund have been created (search for "BACKUP_TMP"). At least one of your order was not linked to a budget' : '' ) . ")\n";
		9732	$DBversion = "3.19.00.XXX";
		9733	if( CheckVersion($DBversion) ){
		9734
		9735	my $sql=<<'VEA_END';
		9736	CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
		9737	id int(11) NOT NULL auto_increment,
		9738	description text NOT NULL,
		9739	host varchar(40),
		9740	username varchar(40),
		9741	password varchar(40),
		9742	last_activity date,
		9743	vendor_id int(11) references aqbooksellers( id ),
		9744	download_directory text,
		9745	upload_directory text,
		9746	san varchar(20),
		9747	id_code_qualifier varchar(3) default '14',
		9748	transport varchar(6) default 'FTP',
		9749	quotes_enabled tinyint(1) not null default 0,
		9750	invoices_enabled tinyint(1) not null default 0,
		9751	orders_enabled tinyint(1) not null default 0,
		9752	shipment_budget integer(11) references aqbudgets( budget_id ),
		9753	PRIMARY KEY (id),
		9754	KEY vendorid (vendor_id),
		9755	KEY shipmentbudget (shipment_budget),
		9756	CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		9757	CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
		9758	) ENGINE=InnoDB DEFAULT CHARSET=utf8
		9759	VEA_END
		9760
		9761	$dbh->do($sql);
		9762
		9763	$sql=<<'EM_END';
		9764	CREATE TABLE IF NOT EXISTS edifact_messages (
		9765	id int(11) NOT NULL auto_increment,
		9766	message_type varchar(10) NOT NULL,
		9767	transfer_date date,
		9768	vendor_id int(11) references aqbooksellers( id ),
		9769	edi_acct integer references vendor_edi_accounts( id ),
		9770	status text,
		9771	basketno int(11) REFERENCES aqbasket( basketno),
		9772	raw_msg text,
		9773	filename text,
		9774	deleted boolean not null default 0,
		9775	PRIMARY KEY (id),
		9776	KEY vendorid ( vendor_id),
		9777	KEY ediacct (edi_acct),
		9778	KEY basketno ( basketno),
		9779	CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		9780	CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
		9781	CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
		9782	) ENGINE=InnoDB DEFAULT CHARSET=utf8
		9783	EM_END
		9784
		9785	$dbh->do($sql);
		9786
		9787	$dbh->do('ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id )');
		9788
		9789	$dbh->do(
		9790	'ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL'
		9791	);
		9792
		9793	$sql=<<'EAN_END';
		9794	CREATE TABLE IF NOT EXISTS edifact_ean (
		9795	branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode),
9796	ean varchar(15) NOT NULL,
9797	id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14',
9798	CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
9799	) ENGINE=InnoDB DEFAULT CHARSET=utf8
9800	EAN_END
9801
9802	$dbh->do($sql);
9803	$dbh->do("INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages', 'free')");
9804	$dbh->do(
9805	q{INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions')}
9806	);
9807
9808	print "Upgrade to $DBversion done (Bug 7736 DB Changes for Edifact Processing ( Quote, Order and Invoice))\n";
9809	>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
9732	SetVersion($DBversion);	9810	SetVersion($DBversion);
9733	}	9811	}
9734		9812

Line 0 Link Here

(-)a/Koha/EDI.pm (+541 lines)
		1	package Koha::EDI;
		2
		3	# Copyright 2014 PTFS-Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it
		8	# under the terms of the GNU General Public License as published by
		9	# the Free Software Foundation; either version 3 of the License, or
		10	# (at your option) any later version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but
		13	# WITHOUT ANY WARRANTY; without even the implied warranty of
		14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		15	# GNU General Public License for more details.
		16	#
		17	# You should have received a copy of the GNU General Public License
		18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		19
		20	use strict;
		21	use warnings;
		22	use base qw(Exporter);
		23	use Carp;
		24	use English qw{ -no_match_vars };
		25	use Business::ISBN;
		26	use DateTime;
		27	use C4::Context;
		28	use Koha::Database;
		29	use C4::Acquisition qw( NewBasket AddInvoice ModReceiveOrder );
		30	use C4::Items qw(AddItem);
		31	use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
		32	use Koha::Edifact::Order;
		33	use Koha::Edifact;
		34	use Log::Log4perl;
		35
		36	our $VERSION = 1.1;
		37	our @EXPORT_OK =
		38	qw( process_quote process_invoice create_edi_order get_edifact_ean );
		39
		40	sub create_edi_order {
		41	my $parameters = shift;
		42	my $basketno = $parameters->{basketno};
		43	my $ean = $parameters->{ean};
		44	my $branchcode = $parameters->{branchcode};
		45	my $noingest = $parameters->{noingest};
		46	$ean \|\|= C4::Context->preference('EDIfactEAN');
		47	if ( !$basketno \|\| !$ean ) {
		48	carp 'create_edi_order called with no basketno or ean';
		49	return;
		50	}
		51
		52	my $database = Koha::Database->new();
		53	my $schema = $database->schema();
		54
		55	my @orderlines = $schema->resultset('Aqorder')->search(
		56	{
		57	basketno => $basketno,
		58	orderstatus => 'new',
		59	}
		60	)->all;
		61
		62	my $vendor = $schema->resultset('VendorEdiAccount')->search(
		63	{
		64	vendor_id => $orderlines[0]->basketno->booksellerid->id,
65	}
66	)->single;
67
68	my $ean_search_keys = { ean => $ean, };
69	if ($branchcode) {
70	$ean_search_keys->{branchcode} = $branchcode;
71	}
72	my $ean_obj =
73	$schema->resultset('EdifactEan')->search($ean_search_keys)->single;
74
75	my $edifact = Koha::Edifact::Order->new(
76	{ orderlines => \@orderlines, vendor => $vendor, ean => $ean_obj } );
77	if ( !$edifact ) {
78	return;
79	}
80
81	my $order_file = $edifact->encode();
82
83	# ingest result
84	if ($order_file) {
85	if ($noingest) { # allows scripts to produce test files
86	return $order_file;
87	}
88	my $order = {
89	message_type => 'ORDERS',
90	raw_msg => $order_file,
91	vendor_id => $vendor->vendor_id,
92	status => 'Pending',
93	basketno => $basketno,
94	filename => $edifact->filename(),
95	transfer_date => $edifact->msg_date_string(),
96	edi_acct => $vendor->id,
97
98	};
99	$schema->resultset('EdifactMessage')->create($order);
100	return 1;
101	}
102
103	return;
104	}
105
106	sub process_invoice {
107	my $invoice_message = shift;
108	my $database = Koha::Database->new();
109	my $schema = $database->schema();
110	my $vendor_acct;
111	my $logger = Log::Log4perl->get_logger();
112	my $edi =
113	Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
114	my $messages = $edi->message_array();
115	if ( @{$messages} ) {
116
117	# BGM contains an invoice number
118	foreach my $msg ( @{$messages} ) {
119	my $invoicenumber = $msg->docmsg_number();
120	my $shipmentcharge = $msg->shipment_charge();
121	my $msg_date = $msg->message_date;
122	my $tax_date = $msg->tax_point_date;
123	if ( !defined $tax_date \|\| $tax_date !~ m/^\d{8}/xms ) {
124	$tax_date = $msg_date;
125	}
126
127	my $vendor_ean = $msg->supplier_ean;
128	if ( !defined $vendor_acct \|\| $vendor_ean ne $vendor_acct->san ) {
129	$vendor_acct = $schema->resultset('VendorEdiAccount')->search(
130	{
131	san => $vendor_ean,
132	}
133	)->single;
134	}
135	if ( !$vendor_acct ) {
136	carp
137	"Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
138	next;
139	}
140	$invoice_message->edi_acct( $vendor_acct->id );
141	$logger->trace("Adding invoice:$invoicenumber");
142	my $invoiceid = AddInvoice(
143	invoicenumber => $invoicenumber,
144	booksellerid => $invoice_message->vendor_id,
145	shipmentdate => $msg_date,
146	billingdate => $tax_date,
147	shipmentcost => $shipmentcharge,
148	shipmentcost_budgetid => $vendor_acct->shipment_budget,
149	message_id => $invoice_message->id,
150	);
151	$logger->trace("Added as invoiceno :$invoiceid");
152	my $lines = $msg->lineitems();
153
154	foreach my $line ( @{$lines} ) {
155	my $ordernumber = $line->ordernumber;
156	$logger->trace( "Receipting order:$ordernumber Qty: ",
157	$line->quantity );
158
159	# handle old basketno/ordernumber references
160	if ( $ordernumber =~ m{\d+\/(\d+)}xms ) {
161	$ordernumber = $1;
162	}
163	my $order = $schema->resultset('Aqorder')->find($ordernumber);
164
165	# ModReceiveOrder does not validate that $ordernumber exists validate here
166	if ($order) {
167	ModReceiveOrder(
168	{
169	biblionumber => $order->biblionumber,
170	ordernumber => $ordernumber,
171	quantityreceived => $line->quantity,
172	cost => $line->price_net,
173	invoiceid => $invoicenumber,
174	datereceived => $msg_date,
175	received_itemnumbers => [],
176	}
177	);
178	}
179	else {
180	$logger->error(
181	"No order found for $ordernumber Invoice:$invoicenumber"
182	);
183	next;
184	}
185
186	}
187
188	}
189	}
190
191	$invoice_message->status('received');
192	$invoice_message->update; # status and basketno link
193	return;
194	}
195
196	# called on messages with status 'new'
197	sub process_quote {
198	my $quote = shift;
199
200	my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
201	my $messages = $edi->message_array();
202	my $process_errors = 0;
203	my $logger = Log::Log4perl->get_logger();
204	my $database = Koha::Database->new();
205	my $schema = $database->schema();
206
207	if ( @{$messages} && $quote->vendor_id ) {
208	my $basketno =
209	NewBasket( $quote->vendor_id, 0, $quote->filename, q{}, q{} . q{} );
210	$quote->basketno($basketno);
211	$logger->trace("Created basket :$basketno");
212	for my $msg ( @{$messages} ) {
213	my $items = $msg->lineitems();
214	my $refnum = $msg->message_refno;
215
216	for my $item ( @{$items} ) {
217	if ( !quote_item( $schema, $item, $quote, $basketno ) ) {
218	++$process_errors;
219	}
220	}
221	}
222	}
223	my $status = 'received';
224	if ($process_errors) {
225	$status = 'error';
226	}
227
228	$quote->status($status);
229	$quote->update; # status and basketno link
230
231	return;
232	}
233
234	sub quote_item {
235	my ( $schema, $item, $quote, $basketno ) = @_;
236
237	# create biblio record
238	my $logger = Log::Log4perl->get_logger();
239	my $bib_hash = {
240	'biblioitems.cn_source' => 'ddc',
241	'items.cn_source' => 'ddc',
242	'items.notforloan' => -1,
243	'items.cn_sort' => q{},
244	};
245	my $item_hash = {
246	cn_source => 'ddc',
247	notforloan => -1,
248	cn_dort => q{},
249	};
250	$bib_hash->{'biblio.seriestitle'} = $item->series;
251
252	$bib_hash->{'biblioitems.publishercode'} = $item->publisher;
253	$bib_hash->{'biblioitems.publicationyear'} =
254	$bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
255
256	$bib_hash->{'biblio.title'} = $item->title;
257	$bib_hash->{'biblio.author'} = $item->author;
258	$bib_hash->{'biblioitems.isbn'} = $item->item_number_id;
259	$bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
260	$item_hash->{booksellerid} = $quote->vendor_id;
261	$item_hash->{price} = $item_hash->{replacementprice} = $item->price;
262	$item_hash->{itype} = $item->girfield('stock_category');
263	$item_hash->{location} = $item->girfield('collection_code');
264
265	my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
266
267	if ( !$budget ) {
268	carp 'Skipping line with no budget info';
269	$logger->trace('line skipped for invalid budget');
270	return;
271	}
272
273	my $note = {};
274
275	my $shelfmark =
276	$item->girfield('shelfmark') \|\| $item->girfield('classification') \|\| q{};
277	$item_hash->{itemcallnumber} = $shelfmark;
278	my $branch = $item->girfield('branch');
279	$item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
280	for my $key ( keys %{$bib_hash} ) {
281	if ( !defined $bib_hash->{$key} ) {
282	delete $bib_hash->{$key};
283	}
284	}
285	my $bib_record = TransformKohaToMarc($bib_hash);
286
287	$logger->trace( 'Checking db for matches with ', $item->item_number_id() );
288	my $bib = _check_for_existing_bib( $item->item_number_id() );
289	if ( !defined $bib ) {
290	$bib = {};
291	( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
292	AddBiblio( $bib_record, q{} );
293	$logger->trace("New biblio added $bib->{biblionumber}");
294	}
295	else {
296	$logger->trace("Match found: $bib->{biblionumber}");
297	}
298
299	my $order_note = $item->{free_text};
300	$order_note \|\|= q{};
301	if ( !$basketno ) {
302	$logger->error('Skipping order creation no basketno');
303	return;
304	}
305
306	# database definitions should set some of these defaults but dont
307	my $order_hash = {
308	biblionumber => $bib->{biblionumber},
309	entrydate => DateTime->now( time_zone => 'local' )->ymd(),
310	quantity => $item->quantity,
311	basketno => $basketno,
312	listprice => $item->price,
313	quantityreceived => 0,
314
315	# notes => $order_note, becane internalnote in 3.15
316	order_internalnote => $order_note,
317	rrp => $item->price,
318	ecost => _discounted_price( $quote->vendor->discount, $item->price ),
319	budget_id => $budget->budget_id,
320	uncertainprice => 0,
321	sort1 => q{},
322	sort2 => q{},
323	supplierreference => $item->reference,
324	};
325	if ( $item->girfield('servicing_instruction') ) {
326
327	# not in 3.14 !!!
328	$order_hash->{order_vendornote} =
329	$item->girfield('servicing_instruction');
330	}
331	if ( $item->internal_notes() ) {
332	if ( $order_hash->{order_internalnote} ) { # more than ''
333	$order_hash->{order_internalnote} .= q{ };
334	}
335
336	$order_hash->{order_internalnote} .= $item->internal_notes;
337	}
338
339	my $new_order = $schema->resultset('Aqorder')->create($order_hash);
340	my $o = $new_order->ordernumber();
341	$logger->trace("Order created :$o");
342
343	# should be done by database settings
344	$new_order->parent_ordernumber( $new_order->ordernumber() );
345	$new_order->update();
346
347	if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
348	my $itemnumber;
349	( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber ) =
350	AddItem( $item_hash, $bib->{biblionumber} );
351	$logger->trace("Added item:$itemnumber");
352	$schema->resultset('AqordersItem')->create(
353	{
354	ordernumber => $new_order->ordernumber,
355	itemnumber => $itemnumber,
356	}
357	);
358
359	if ( $item->quantity > 1 ) {
360	my $occurence = 1;
361	while ( $occurence < $item->quantity ) {
362	my $new_item = {
363	notforloan => -1,
364	cn_sort => q{},
365	cn_source => 'ddc',
366	price => $item->price,
367	replacementprice => $item->price,
368	itype => $item->girfield( 'stock_category', $occurence ),
369	location =>
370	$item->girfield( 'collection_code', $occurence ),
371	itemcallnumber => $item->girfield( 'shelfmark', $occurence )
372	\|\| $item->girfield( 'classification', $occurence ),
373	holdingbranch => $item->girfield( 'branch', $occurence ),
374	homebranch => $item->girfield( 'branch', $occurence ),
375	};
376	( undef, undef, $itemnumber ) =
377	AddItem( $new_item, $bib->{biblionumber} );
378	$logger->trace("New item $itemnumber added");
379	$schema->resultset('AqordersItem')->create(
380	{
381	ordernumber => $new_order->ordernumber,
382	itemnumber => $itemnumber,
383	}
384	);
385	++$occurence;
386	}
387	}
388
389	}
390	return 1;
391	}
392
393	sub get_edifact_ean {
394
395	my $dbh = C4::Context->dbh;
396
397	my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
398
399	return $eans->[0];
400	}
401
402	# We should not need to have a routine to do this here
403	sub _discounted_price {
404	my ( $discount, $price ) = @_;
405	return $price - ( ( $discount * $price ) / 100 );
406	}
407
408	sub _check_for_existing_bib {
409	my $isbn = shift;
410
411	my $search_isbn = $isbn;
412	$search_isbn =~ s/^\s*/%/xms;
413	$search_isbn =~ s/\s*$/%/xms;
414	my $dbh = C4::Context->dbh;
415	my $sth = $dbh->prepare(
416	'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
417	);
418	my $tuple_arr =
419	$dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
420	if ( @{$tuple_arr} ) {
421	return $tuple_arr->[0];
422	}
423	else {
424	undef $search_isbn;
425	$isbn =~ s/\-//xmsg;
426	if ( $isbn =~ m/(\d{13})/xms ) {
427	my $b_isbn = Business::ISBN->new($1);
428	if ( $b_isbn && $b_isbn->is_valid ) {
429	$search_isbn = $b_isbn->as_isbn10->as_string( [] );
430	}
431
432	}
433	elsif ( $isbn =~ m/(\d{9}[xX]\|\d{10})/xms ) {
434	my $b_isbn = Business::ISBN->new($1);
435	if ( $b_isbn && $b_isbn->is_valid ) {
436	$search_isbn = $b_isbn->as_isbn13->as_string( [] );
437	}
438
439	}
440	if ($search_isbn) {
441	$search_isbn = "%$search_isbn%";
442	$tuple_arr =
443	$dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
444	if ( @{$tuple_arr} ) {
445	return $tuple_arr->[0];
446	}
447	}
448	}
449	return;
450	}
451
452	# returns a budget obj or undef
453	# fact we need this shows what a mess Acq API is
454	sub _get_budget {
455	my ( $schema, $budget_code ) = @_;
456
457	# db does not ensure budget code is unque
458	return $schema->resultset('Aqbudget')->single(
459	{
460	budget_code => $budget_code,
461	}
462	);
463	}
464
465	1;
466	__END__
467
468	=head1 NAME
469	Koha::EDI
470
471	=head1 SYNOPSIS
472
473	Module exporting subroutines used in EDI processing for Koha
474
475	=head1 DESCRIPTION
476
477	Subroutines called by batch processing to handle Edifact
478	messages of various types and related utilities
479
480	=head1 BUGS
481
482	These routines should really be methods of some object.
483	get_edifact_ean is a stopgap which should be replaced
484
485	=head1 SUBROUTINES
486
487	=head2 process_quote
488
489	process_quote(quote_message);
490
491	passed a message object for a quote, parses it creating an order basket
492	and orderlines in the database
493	updates the message's status to received in the database and adds the
494	link to basket
495
496	=head2 process_invoice
497
498	process_invoice(invoice_message)
499
500	passed a message object for an invoice, add the contained invoices
501	and update the orderlines referred to in the invoice
502	As an Edifact invoice is in effect a despatch note this receipts the
503	appropriate quantities in the orders
504
505
506	=head2 create_edi_order
507
508	create_edi_order( { parameter_hashref } )
509
510	parameters must include basketno and ean
511
512	branchcode can optionally be passed
513
514	returns 1 on success undef otherwise
515
516	if the parameter noingest is set the formatted order is returned
517	and not saved in the database. This functionality is intended for debugging only
518
519	=head2 get_edifact_ean
520
521
522	=head2 quote_item
523
524	quote_item(lineitem, quote_message);
525
526	Called by process_quote to handle an individual lineitem
527	Generate the biblios and items if required and orderline linking to them
528
529	=head1 AUTHOR
530
531	Colin Campbell <colin.campbell@ptfs-europe.com>
532
533
534	=head1 COPYRIGHT
535
536	Copyright 2014, PTFS-Europe Ltd
537	This program is free software, You may redistribute it under
538	under the terms of the GNU General Public License
539
540
541	=cut

Line 0 Link Here

(-)a/Koha/Edifact.pm (+335 lines)
		1	package Koha::Edifact;
		2
		3	# Copyright 2014 PTFS-Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it
		8	# under the terms of the GNU General Public License as published by
		9	# the Free Software Foundation; either version 3 of the License, or
		10	# (at your option) any later version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but
		13	# WITHOUT ANY WARRANTY; without even the implied warranty of
		14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		15	# GNU General Public License for more details.
		16	#
		17	# You should have received a copy of the GNU General Public License
		18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		19
		20	use strict;
		21	use warnings;
		22	use File::Slurp;
		23	use Carp;
		24	use Encode qw( from_to );
		25	use Koha::Edifact::Segment;
		26	use Koha::Edifact::Message;
		27
		28	my $separator = {
		29	component => q{\:},
		30	data => q{\+},
		31	decimal => q{.},
		32	release => q{\?},
		33	reserved => q{ },
		34	segment => q{\'},
		35	};
		36
		37	sub new {
		38	my ( $class, $param_hashref ) = @_;
		39	my $transmission;
		40	my $self = ();
		41
		42	if ( $param_hashref->{filename} ) {
		43	if ( $param_hashref->{transmission} ) {
		44	carp
		45	"Cannot instantiate $class : both filename and transmission passed";
		46	return;
		47	}
		48	$transmission = read_file( $param_hashref->{filename} );
		49	}
		50	else {
		51	$transmission = $param_hashref->{transmission};
		52	}
		53	$self->{transmission} = _init($transmission);
		54
		55	bless $self, $class;
		56	return $self;
		57	}
		58
		59	sub interchange_header {
		60	my ( $self, $field ) = @_;
		61
		62	my %element = (
		63	sender => 1,
		64	recipient => 2,
65	datetime => 3,
66	interchange_control_reference => 4,
67	application_reference => 6,
68	);
69	if ( !exists $element{$field} ) {
70	carp "No interchange header field $field available";
71	return;
72	}
73	my $data = $self->{transmission}->[0]->elem( $element{$field} );
74	return $data;
75	}
76
77	sub interchange_trailer {
78	my ( $self, $field ) = @_;
79	my $trailer = $self->{transmission}->[-1];
80	if ( $field eq 'interchange_control_count' ) {
81	return $trailer->elem(0);
82	}
83	elsif ( $field eq 'interchange_control_reference' ) {
84	return $trailer->elem(1);
85	}
86	carp "Trailer field $field not recognized";
87	return;
88	}
89
90	sub new_data_iterator {
91	my $self = shift;
92	my $offset = 0;
93	while ( $self->{transmission}->[$offset]->tag() ne 'UNH' ) {
94	++$offset;
95	if ( $offset == @{ $self->{transmission} } ) {
96	carp 'Cannot find message start';
97	return;
98	}
99	}
100	$self->{data_iterator} = $offset;
101	return 1;
102	}
103
104	sub next_segment {
105	my $self = shift;
106	if ( defined $self->{data_iterator} ) {
107	my $seg = $self->{transmission}->[ $self->{data_iterator} ];
108	if ( $seg->tag eq 'UNH' ) {
109
110	$self->{msg_type} = $seg->elem( 1, 0 );
111	}
112	elsif ( $seg->tag eq 'LIN' ) {
113	$self->{msg_type} = 'detail';
114	}
115
116	if ( $seg->tag ne 'UNZ' ) {
117	$self->{data_iterator}++;
118	}
119	else {
120	$self->{data_iterator} = undef;
121	}
122	return $seg;
123	}
124	return;
125	}
126
127	# for debugging return whole transmission
128	sub get_transmission {
129	my $self = shift;
130
131	return $self->{transmission};
132	}
133
134	sub message_type {
135	my $self = shift;
136	return $self->{msg_type};
137	}
138
139	sub _init {
140	my $msg = shift;
141	if ( !$msg ) {
142	return;
143	}
144	if ( $msg =~ s/^UNA(.{6})// ) {
145	if ( service_string_advice($1) ) {
146	return segmentize($msg);
147
148	}
149	return;
150	}
151	else {
152	my $s = substr $msg, 10;
153	croak "File does not start with a Service string advice :$s";
154	}
155	}
156
157	# return an array of message data which will be used to
158	# create Message objects
159	sub message_array {
160	my $self = shift;
161
162	# return an array of array_refs 1 ref to a message
163	my $msg_arr = [];
164	my $msg = [];
165	my $in_msg = 0;
166	foreach my $seg ( @{ $self->{transmission} } ) {
167	if ( $seg->tag eq 'UNH' ) {
168	$in_msg = 1;
169	push @{$msg}, $seg;
170	}
171	elsif ( $seg->tag eq 'UNT' ) {
172	$in_msg = 0;
173	if ( @{$msg} ) {
174	push @{$msg_arr}, Koha::Edifact::Message->new($msg);
175	$msg = [];
176	}
177	}
178	elsif ($in_msg) {
179	push @{$msg}, $seg;
180	}
181	}
182	return $msg_arr;
183	}
184
185	#
186	# internal parsing routines used in _init
187	#
188	sub service_string_advice {
189	my $ssa = shift;
190
191	# At present this just validates that the ssa
192	# is standard Edifact
193	# TBD reset the seps if non standard
194	if ( $ssa ne q{:+.? '} ) {
195	carp " Non standard Service String Advice [$ssa]";
196	return;
197	}
198
199	# else use default separators
200	return 1;
201	}
202
203	sub segmentize {
204	my $raw = shift;
205
206	# In practice edifact uses latin-1 but check
207	# Transport now converts to utf-8 on ingest
208	# Do not convert here
209	#my $char_set = 'iso-8859-1';
210	#if ( $raw =~ m/^UNB[+]UNO(.)/ ) {
211	# $char_set = msgcharset($1);
212	#}
213	#from_to( $raw, $char_set, 'utf8' );
214
215	my $re = qr{
216	(?> # dont backtrack into this group
217	[?]. # either the escape character
218	# followed by any other character
219	\| # or
220	[^'?] # a character that is neither escape
221	# nor split
222	)+
223	}x;
224	my @segmented;
225	while ( $raw =~ /($re)/g ) {
226	push @segmented, Koha::Edifact::Segment->new( { seg_string => $1 } );
227	}
228	return \@segmented;
229	}
230
231	sub msgcharset {
232	my $code = shift;
233	if ( $code =~ m/^[^ABCDEF]$/ ) {
234	$code = 'default';
235	}
236	my %encoding_map = (
237	A => 'ascii',
238	B => 'ascii',
239	C => 'iso-8859-1',
240	D => 'iso-8859-1',
241	E => 'iso-8859-1',
242	F => 'iso-8859-1',
243	default => 'iso-8859-1',
244	);
245	return $encoding_map{$code};
246	}
247
248	1;
249	__END__
250
251	=head1 NAME
252	Koha::Edifact
253
254	=head1 SYNOPSIS
255
256	=head1 DESCRIPTION
257
258	Koha module for parsing Edifact messages
259
260	=head1 BUGS
261
262
263	=head1 SUBROUTINES
264
265	=head2 new
266
267	my $e = Koha::Edifact->new( { filename => 'myfilename' } );
268	or
269	my $e = Koha::Edifact->new( { transmission => $msg_variable } );
270
271	instantiate the Edifact parser, requires either to be passed an in-memory
272	edifact message as transmission or a filename which it will read on creation
273
274	=head2 interchange_header
275
276	will return the data in the header field designated by the parameter
277	specified. Valid parameters are: 'sender', 'recipient', 'datetime',
278	'interchange_control_reference', and 'application_reference'
279
280	=head2 interchange_trailer
281
282	called either with the string 'interchange_control_count' or
283	'interchange_control_reference' will return the corresponding field from
284	the interchange trailer
285
286	=head2 new_data_iterator
287
288	Sets the object's data_iterator to point to the UNH segment
289	=head2 next_segment
290
291	Returns the next segment pointed to by the data_iterator. Increments the
292	data_iterator member or destroys it if segment UNZ has been reached
293
294	=head2 get_transmission
295
296	This method is useful in debugg:ing. Call on an Edifact it returns
297	the object's transmission member
298
299	=head2 message_type
300
301	return the object's message type
302
303	=head2 message_array
304
305	return an array of Message objects contained in the Edifact transmission
306
307	=head1 Internal Methods
308
309	=head2 service_string_advice
310
311	Examines the Service String Advice returns 1 if the default separartors are in use
312	undef otherwise
313
314	=head2 segmentize
315
316	takes a raw Edifact message and returns a reference to an array of
317	its segments
318
319	=head2 msgcharset
320
321	Return the character set the message was encoded in. The default is iso-8859-1
322
323	=head1 AUTHOR
324
325	Colin Campbell <colin.campbell@ptfs-europe.com>
326
327
328	=head1 COPYRIGHT
329
330	Copyright 2014, PTFS-Europe Ltd
331	This program is free software, You may redistribute it under
332	under the terms of the GNU General Public License
333
334
335	=cut

Line 0 Link Here

(-)a/Koha/Edifact/Line.pm (+577 lines)
		1	package Koha::Edifact::Line;
		2
		3	# Copyright 2014 PTFS-Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it
		8	# under the terms of the GNU General Public License as published by
		9	# the Free Software Foundation; either version 3 of the License, or
		10	# (at your option) any later version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but
		13	# WITHOUT ANY WARRANTY; without even the implied warranty of
		14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		15	# GNU General Public License for more details.
		16	#
		17	# You should have received a copy of the GNU General Public License
		18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		19
		20	use strict;
		21	use warnings;
		22
		23	use MARC::Record;
		24	use MARC::Field;
		25	use Carp;
		26
		27	sub new {
		28	my ( $class, $data_array_ref ) = @_;
		29	my $self = _parse_lines($data_array_ref);
		30
		31	bless $self, $class;
		32	return $self;
		33	}
		34
		35	# helper routine used by constructor
		36	# creates the hashref used as a data structure by the Line object
		37
		38	sub _parse_lines {
		39	my $aref = shift;
		40
		41	my $lin = shift @{$aref};
		42
		43	my $d = {
		44	line_item_number => $lin->elem(0),
		45	item_number_id => $lin->elem( 2, 0 ),
		46	additional_product_ids => [],
		47	};
		48	my @item_description;
		49
		50	foreach my $s ( @{$aref} ) {
		51	if ( $s->tag eq 'PIA' ) {
		52	push @{ $d->{additional_product_ids} },
		53	{
		54	function_code => $s->elem(0),
		55	item_number => $s->elem( 1, 0 ),
		56	number_type => $s->elem( 1, 1 ),
		57	};
		58	}
		59	elsif ( $s->tag eq 'IMD' ) {
		60	push @item_description, $s;
		61	}
		62	elsif ( $s->tag eq 'QTY' ) {
		63	$d->{quantity} = $s->elem( 0, 1 );
		64	}
65	elsif ( $s->tag eq 'DTM' ) {
66	$d->{avaiability_date} = $s->elem( 0, 1 );
67	}
68	elsif ( $s->tag eq 'GIR' ) {
69
70	# we may get a Gir for each copy if QTY > 1
71	if ( !$d->{GIR} ) {
72	$d->{GIR} = [];
73	}
74	push @{ $d->{GIR} }, extract_gir($s);
75
76	}
77	elsif ( $s->tag eq 'FTX' ) {
78
79	my $type = $s->elem(1);
80	if ( $type eq 'LNO' ) { # Ingrams Oasis Internal Notes field
81	$type = 'internal_notes';
82	}
83	else {
84	$type = 'free_text';
85	}
86
87	my $ftx = $s->elem(3);
88	if ( ref $ftx eq 'ARRAY' ) { # it comes in 70 character components
89	$ftx = join ' ', @{$ftx};
90	}
91	if ( exists $d->{$type} ) { # we can only catenate repeats
92	$d->{$type} .= q{ };
93	$d->{$type} .= $ftx;
94	}
95	else {
96	$d->{$type} = $ftx;
97	}
98	}
99	elsif ( $s->tag eq 'MOA' ) {
100
101	$d->{monetary_amount} = $s->elem( 0, 1 );
102	}
103	elsif ( $s->tag eq 'PRI' ) {
104
105	$d->{price} = $s->elem( 0, 1 );
106	}
107	elsif ( $s->tag eq 'RFF' ) {
108	my $qualifier = $s->elem( 0, 0 );
109	if ( $qualifier eq 'QLI' ) { # Suppliers unique quotation linenumber
110	$d->{reference} = $s->elem( 0, 1 );
111	}
112	elsif ( $qualifier eq 'LI' ) { # Buyer's unique orderline number
113	$d->{ordernumber} = $s->elem( 0, 1 );
114	}
115	}
116	}
117	$d->{item_description} = _format_item_description(@item_description);
118	$d->{segs} = $aref;
119
120	return $d;
121	}
122
123	sub _format_item_description {
124	my @imd = @_;
125	my $bibrec = {};
126
127	# IMD : +Type code 'L' + characteristic code 3 char + Description in comp 3 & 4
128	foreach my $imd (@imd) {
129	my $type_code = $imd->elem(0);
130	my $ccode = $imd->elem(1);
131	my $desc = $imd->elem( 2, 3 );
132	if ( $imd->elem( 2, 4 ) ) {
133	$desc .= $imd->elem( 2, 4 );
134	}
135	if ( $type_code ne 'L' ) {
136	carp
137	"Only handles text item descriptions at present: code=$type_code";
138	next;
139	}
140	if ( exists $bibrec->{$ccode} ) {
141	$bibrec->{$ccode} .= q{ };
142	$bibrec->{$ccode} .= $desc;
143	}
144	else {
145	$bibrec->{$ccode} = $desc;
146	}
147	}
148	return $bibrec;
149	}
150
151	sub marc_record {
152	my $self = shift;
153	my $b = $self->{item_description};
154
155	my $bib = MARC::Record->new();
156
157	my @spec;
158	my @fields;
159	if ( exists $b->{'010'} ) {
160	@spec = qw( 100 a 011 c 012 b 013 d 014 e );
161	push @fields, new_field( $b, [ 100, 1, q{ } ], @spec );
162	}
163	if ( exists $b->{'020'} ) {
164	@spec = qw( 020 a 021 c 022 b 023 d 024 e );
165	push @fields, new_field( $b, [ 700, 1, q{ } ], @spec );
166	}
167
168	# corp conf
169	if ( exists $b->{'030'} ) {
170	push @fields, $self->corpcon(1);
171	}
172	if ( exists $b->{'040'} ) {
173	push @fields, $self->corpcon(7);
174	}
175	if ( exists $b->{'050'} ) {
176	@spec = qw( '050' a '060' b '065' c );
177	push @fields, new_field( $b, [ 245, 1, 0 ], @spec );
178	}
179	if ( exists $b->{100} ) {
180	@spec = qw( 100 a 101 b);
181	push @fields, new_field( $b, [ 250, q{ }, q{ } ], @spec );
182	}
183	@spec = qw( 110 a 120 b 170 c );
184	my $f = new_field( $b, [ 260, q{ }, q{ } ], @spec );
185	if ($f) {
186	push @fields, $f;
187	}
188	@spec = qw( 180 a 181 b 182 c 183 e);
189	$f = new_field( $b, [ 300, q{ }, q{ } ], @spec );
190	if ($f) {
191	push @fields, $f;
192	}
193	if ( exists $b->{190} ) {
194	@spec = qw( 190 a);
195	push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
196	}
197
198	if ( exists $b->{200} ) {
199	@spec = qw( 200 a);
200	push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
201	}
202	if ( exists $b->{210} ) {
203	@spec = qw( 210 a);
204	push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
205	}
206	if ( exists $b->{300} ) {
207	@spec = qw( 300 a);
208	push @fields, new_field( $b, [ 500, q{ }, q{ } ], @spec );
209	}
210	if ( exists $b->{310} ) {
211	@spec = qw( 310 a);
212	push @fields, new_field( $b, [ 520, q{ }, q{ } ], @spec );
213	}
214	if ( exists $b->{320} ) {
215	@spec = qw( 320 a);
216	push @fields, new_field( $b, [ 521, q{ }, q{ } ], @spec );
217	}
218	if ( exists $b->{260} ) {
219	@spec = qw( 260 a);
220	push @fields, new_field( $b, [ 600, q{ }, q{ } ], @spec );
221	}
222	if ( exists $b->{270} ) {
223	@spec = qw( 270 a);
224	push @fields, new_field( $b, [ 650, q{ }, q{ } ], @spec );
225	}
226	if ( exists $b->{280} ) {
227	@spec = qw( 280 a);
228	push @fields, new_field( $b, [ 655, q{ }, q{ } ], @spec );
229	}
230
231	# class
232	if ( exists $b->{230} ) {
233	@spec = qw( 230 a);
234	push @fields, new_field( $b, [ '082', q{ }, q{ } ], @spec );
235	}
236	if ( exists $b->{240} ) {
237	@spec = qw( 240 a);
238	push @fields, new_field( $b, [ '084', q{ }, q{ } ], @spec );
239	}
240	$bib->insert_fields_ordered(@fields);
241
242	return $bib;
243	}
244
245	sub corpcon {
246	my ( $self, $level ) = @_;
247	my $test_these = {
248	1 => [ '033', '032', '034' ],
249	7 => [ '043', '042', '044' ],
250	};
251	my $conf = 0;
252	foreach my $t ( @{ $test_these->{$level} } ) {
253	if ( exists $self->{item_description}->{$t} ) {
254	$conf = 1;
255	}
256	}
257	my $tag;
258	my @spec;
259	my ( $i1, $i2 ) = ( q{ }, q{ } );
260	if ($conf) {
261	$tag = ( $level * 100 ) + 11;
262	if ( $level == 1 ) {
263	@spec = qw( 030 a 031 e 032 n 033 c 034 d);
264	}
265	else {
266	@spec = qw( 040 a 041 e 042 n 043 c 044 d);
267	}
268	}
269	else {
270	$tag = ( $level * 100 ) + 10;
271	if ( $level == 1 ) {
272	@spec = qw( 030 a 031 b);
273	}
274	else {
275	@spec = qw( 040 a 041 b);
276	}
277	}
278	return new_field( $self->{item_description}, [ $tag, $i1, $i2 ], @spec );
279	}
280
281	sub new_field {
282	my ( $b, $tag_ind, @sfd_elem ) = @_;
283	my @sfd;
284	while (@sfd_elem) {
285	my $e = shift @sfd_elem;
286	my $c = shift @sfd_elem;
287	if ( exists $b->{$e} ) {
288	push @sfd, $c, $b->{$e};
289	}
290	}
291	if (@sfd) {
292	my $field = MARC::Field->new( @{$tag_ind}, @sfd );
293	return $field;
294	}
295	return;
296	}
297
298	# Accessor methods to line data
299
300	sub item_number_id {
301	my $self = shift;
302	return $self->{item_number_id};
303	}
304
305	sub line_item_number {
306	my $self = shift;
307	return $self->{line_item_number};
308	}
309
310	sub additional_product_ids {
311	my $self = shift;
312	return $self->{additional_product_ids};
313	}
314
315	sub item_description {
316	my $self = shift;
317	return $self->{item_description};
318	}
319
320	sub monetary_amount {
321	my $self = shift;
322	return $self->{monetary_amount};
323	}
324
325	sub quantity {
326	my $self = shift;
327	return $self->{quantity};
328	}
329
330	sub price {
331	my $self = shift;
332	return $self->{price};
333	}
334
335	sub reference {
336	my $self = shift;
337	return $self->{reference};
338	}
339
340	sub ordernumber {
341	my $self = shift;
342	return $self->{ordernumber};
343	}
344
345	sub free_text {
346	my $self = shift;
347	return $self->{free_text};
348	}
349
350	sub internal_notes {
351	my $self = shift;
352	return $self->{internal_notes};
353	}
354
355	# item_desription_fields accessors
356
357	sub title {
358	my $self = shift;
359	my $titlefield = q{050};
360	if ( exists $self->{item_description}->{$titlefield} ) {
361	return $self->{item_description}->{$titlefield};
362	}
363	return;
364	}
365
366	sub author {
367	my $self = shift;
368	my $field = q{010};
369	if ( exists $self->{item_description}->{$field} ) {
370	return $self->{item_description}->{$field};
371	}
372	return;
373	}
374
375	sub series {
376	my $self = shift;
377	my $field = q{190};
378	if ( exists $self->{item_description}->{$field} ) {
379	return $self->{item_description}->{$field};
380	}
381	return;
382	}
383
384	sub publisher {
385	my $self = shift;
386	my $field = q{120};
387	if ( exists $self->{item_description}->{$field} ) {
388	return $self->{item_description}->{$field};
389	}
390	return;
391	}
392
393	sub publication_date {
394	my $self = shift;
395	my $field = q{170};
396	if ( exists $self->{item_description}->{$field} ) {
397	return $self->{item_description}->{$field};
398	}
399	return;
400	}
401
402	sub girfield {
403	my ( $self, $field, $occ ) = @_;
404
405	# defaults to occurence 0 returns undef if occ requested > occs
406	if ( defined $occ && $occ > @{ $self->{GIR} } ) {
407	return;
408	}
409	$occ \|\|= 0;
410	return $self->{GIR}->[$occ]->{$field};
411	}
412
413	sub extract_gir {
414	my $s = shift;
415	my %qmap = (
416	LAC => 'barcode',
417	LCL => 'classification',
418	LFN => 'fund_allocation',
419	LLN => 'loan_category',
420	LLO => 'branch',
421	LSM => 'shelfmark',
422	LSQ => 'collection_code',
423	LST => 'stock_category',
424	LVT => 'servicing_instruction',
425	LCO => 'item_unique_id',
426	);
427
428	my $set_qualifier = $s->elem( 0, 0 ); # copy number
429	my $gir_element = { copy => $set_qualifier, };
430	my $element = 1;
431	while ( my $e = $s->elem($element) ) {
432	++$element;
433	if ( exists $qmap{ $e->[1] } ) {
434	my $qualifier = $qmap{ $e->[1] };
435	$gir_element->{$qualifier} = $e->[0];
436	}
437	else {
438
439	carp "Unrecognized GIR code : $e->[1] for $e->[0]";
440	}
441	}
442	return $gir_element;
443	}
444
445	# mainly for invoice processing amt_ will derive from MOA price_ from PRI and tax_ from TAX/MOA pairsn
446	sub moa_amt {
447	my ( $self, $qualifier ) = @_;
448	foreach my $s ( @{ $self->{segs} } ) {
449	if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) {
450	return $s->elem( 0, 1 );
451	}
452	}
453	return;
454	}
455
456	sub amt_discount {
457	my $self = shift;
458	return $self->moa_amt('52');
459	}
460
461	sub amt_prepayment {
462	my $self = shift;
463	return $self->moa_amt('113');
464	}
465
466	# total including allowances & tax
467	sub amt_total {
468	my $self = shift;
469	return $self->moa_amt('128');
470	}
471
472	sub amt_unitprice {
473	my $self = shift;
474	return $self->moa_amt('146');
475	}
476
477	# item amount after allowances excluding tax
478	sub amt_lineitem {
479	my $self = shift;
480	return $self->moa_amt('146');
481	}
482
483	sub pri_price {
484	my ( $self, $price_qualifier ) = @_;
485	foreach my $s ( @{ $self->{segs} } ) {
486	if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) {
487	return {
488	price => $s->elem( 0, 1 ),
489	type => $s->elem( 0, 2 ),
490	type_qualifier => $s->elem( 0, 3 ),
491	};
492	}
493	}
494	return;
495	}
496
497	# unit price that will be chaged excl tax
498	sub price_net {
499	my $self = shift;
500	my $p = $self->pri_price('AAA');
501	if ( defined $p ) {
502	return $p->{price};
503	}
504	return;
505	}
506
507	# unit price excluding all allowances, charges and taxes
508	sub price_gross {
509	my $self = shift;
510	my $p = $self->pri_price('AAB');
511	if ( defined $p ) {
512	return $p->{price};
513	}
514	return;
515	}
516
517	# information price incl tax excluding allowances, charges
518	sub price_info {
519	my $self = shift;
520	my $p = $self->pri_price('AAE');
521	if ( defined $p ) {
522	return $p->{price};
523	}
524	return;
525	}
526
527	# information price incl tax,allowances, charges
528	sub price_info_inclusive {
529	my $self = shift;
530	my $p = $self->pri_price('AAE');
531	if ( defined $p ) {
532	return $p->{price};
533	}
534	return;
535	}
536
537	sub tax {
538	my $self = shift;
539	return $self->moa_amt('124');
540	}
541
542	1;
543	__END__
544
545	=head1 NAME
546	Koha::Edifact::Line
547
548	=head1 SYNOPSIS
549
550	Class to abstractly handle a Line in an Edifact Transmission
551
552	=head1 DESCRIPTION
553
554	Allows access to Edifact line elements by name
555
556	=head1 BUGS
557
558
559	=head1 Methods
560
561	=head2 new
562
563	Called with an array ref of segments constituting the line
564
565	=head1 AUTHOR
566
567	Colin Campbell <colin.campbell@ptfs-europe.com>
568
569
570	=head1 COPYRIGHT
571
572	Copyright 2014, PTFS-Europe Ltd
573	This program is free software, You may redistribute it under
574	under the terms of the GNU General Public License
575
576
577	=cut

Line 0 Link Here

(-)a/Koha/Edifact/Message.pm (+255 lines)
		1	package Koha::Edifact::Message;
		2
		3	# Copyright 2014 PTFS-Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it
		8	# under the terms of the GNU General Public License as published by
		9	# the Free Software Foundation; either version 3 of the License, or
		10	# (at your option) any later version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but
		13	# WITHOUT ANY WARRANTY; without even the implied warranty of
		14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		15	# GNU General Public License for more details.
		16	#
		17	# You should have received a copy of the GNU General Public License
		18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		19
		20	use strict;
		21	use warnings;
		22
		23	use Koha::Edifact::Line;
		24
		25	sub new {
		26	my ( $class, $data_array_ref ) = @_;
		27	my $header = shift @{$data_array_ref};
		28	my $bgm = shift @{$data_array_ref};
		29	my $msg_function = $bgm->elem(2);
		30	my $dtm = [];
		31	while ( $data_array_ref->[0]->tag eq 'DTM' ) {
		32	push @{$dtm}, shift @{$data_array_ref};
		33	}
		34
		35	my $self = {
		36	function => $msg_function,
		37	header => $header,
		38	bgm => $bgm,
		39	message_reference_number => $header->elem(0),
		40	dtm => $dtm,
		41	datasegs => $data_array_ref,
		42	};
		43
		44	bless $self, $class;
		45	return $self;
		46	}
		47
		48	sub message_refno {
		49	my $self = shift;
		50	return $self->{message_reference_number};
		51	}
		52
		53	sub function {
		54	my $self = shift;
		55	my $msg_function = $self->{bgm}->elem(2);
		56	if ( $msg_function == 9 ) {
		57	return 'original';
		58	}
		59	elsif ( $msg_function == 7 ) {
		60	return 'retransmission';
		61	}
		62	return;
		63	}
		64
65	sub message_reference_number {
66	my $self = shift;
67	return $self->{header}->elem(0);
68	}
69
70	sub message_type {
71	my $self = shift;
72	return $self->{header}->elem( 1, 0 );
73	}
74
75	sub message_code {
76	my $self = shift;
77	return $self->{bgm}->elem( 0, 0 );
78	}
79
80	sub docmsg_number {
81	my $self = shift;
82	return $self->{bgm}->elem(1);
83	}
84
85	sub message_date {
86	my $self = shift;
87
88	# usually the first if not only dtm
89	foreach my $d ( @{ $self->{dtm} } ) {
90	if ( $d->elem( 0, 0 ) eq '137' ) {
91	return $d->elem( 0, 1 );
92	}
93	}
94	return; # this should not happen
95	}
96
97	sub tax_point_date {
98	my $self = shift;
99	if ( $self->message_type eq 'INVOIC' ) {
100	foreach my $d ( @{ $self->{dtm} } ) {
101	if ( $d->elem( 0, 0 ) eq '131' ) {
102	return $d->elem( 0, 1 );
103	}
104	}
105	}
106	return;
107	}
108
109	sub expiry_date {
110	my $self = shift;
111	if ( $self->message_type eq 'QUOTES' ) {
112	foreach my $d ( @{ $self->{dtm} } ) {
113	if ( $d->elem( 0, 0 ) eq '36' ) {
114	return $d->elem( 0, 1 );
115	}
116	}
117	}
118	return;
119	}
120
121	sub shipment_charge {
122	my $self = shift;
123
124	# A large number of different charges can be expressed at invoice and
125	# item level but the only one koha takes cognizance of is shipment
126	# should we wrap all invoice level charges into it??
127	if ( $self->message_type eq 'INVOIC' ) {
128	my $delivery = 0;
129	my $amt = 0;
130	foreach my $s ( @{ $self->{datasegs} } ) {
131	if ( $s->tag eq 'LIN' ) {
132	last;
133	}
134	if ( $s->tag eq 'ALC' ) {
135	if ( $s->elem(0) eq 'C' ) { # Its a charge
136	if ( $s->elem( 4, 0 ) eq 'DL' ) { # delivery charge
137	$delivery = 1;
138	}
139	}
140	next;
141	}
142	if ( $s->tag eq 'MOA' ) {
143	$amt += $s->elem( 0, 1 );
144	}
145	}
146	return $amt;
147	}
148	return;
149	}
150
151	# return NAD fields
152
153	sub buyer_ean {
154	my $self = shift;
155	foreach my $s ( @{ $self->{datasegs} } ) {
156	if ( $s->tag eq 'LIN' ) {
157	last;
158	}
159	if ( $s->tag eq 'NAD' ) {
160	my $qualifier = $s->elem(0);
161	if ( $qualifier eq 'BY' ) {
162	return $s->elem( 1, 0 );
163	}
164	}
165	}
166	return;
167	}
168
169	sub supplier_ean {
170	my $self = shift;
171	foreach my $s ( @{ $self->{datasegs} } ) {
172	if ( $s->tag eq 'LIN' ) {
173	last;
174	}
175	if ( $s->tag eq 'NAD' ) {
176	my $qualifier = $s->elem(0);
177	if ( $qualifier eq 'SU' ) {
178	return $s->elem( 1, 0 );
179	}
180	}
181	}
182	return;
183
184	}
185
186	sub lineitems {
187	my $self = shift;
188	if ( $self->{quotation_lines} ) {
189	return $self->{quotation_lines};
190	}
191	else {
192	my $items = [];
193	my $item_arr = [];
194	foreach my $seg ( @{ $self->{datasegs} } ) {
195	my $tag = $seg->tag;
196	if ( $tag eq 'LIN' ) {
197	if ( @{$item_arr} ) {
198	push @{$items}, Koha::Edifact::Line->new($item_arr);
199	}
200	$item_arr = [$seg];
201	next;
202	}
203	elsif ( $tag =~ m/^(UNS\|CNT\|UNT)$/sxm ) {
204	if ( @{$item_arr} ) {
205	push @{$items}, Koha::Edifact::Line->new($item_arr);
206	}
207	last;
208	}
209	else {
210	if ( @{$item_arr} ) {
211	push @{$item_arr}, $seg;
212	}
213	}
214	}
215	$self->{quotation_lines} = $items;
216	return $items;
217	}
218	}
219
220	1;
221	__END__
222
223	=head1 NAME
224	Koha::Edifact::Message
225
226	=head1 SYNOPSIS
227
228
229	=head1 DESCRIPTION
230
231	Class modelling an Edifact Message for parsing
232
233	=head1 BUGS
234
235
236	=head1 METHODS
237
238	=head2 new
239
240	Passed an array of segments extracts message level info
241	and parses lineitems as Line objects
242
243	=head1 AUTHOR
244
245	Colin Campbell <colin.campbell@ptfs-europe.com>
246
247
248	=head1 COPYRIGHT
249
250	Copyright 2014, PTFS-Europe Ltd
251	This program is free software, You may redistribute it under
252	under the terms of the GNU General Public License
253
254
255	=cut

Line 0 Link Here

(-)a/Koha/Edifact/Segment.pm (+210 lines)
		1	package Koha::Edifact::Segment;
		2
		3	# Copyright 2014 PTFS-Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it
		8	# under the terms of the GNU General Public License as published by
		9	# the Free Software Foundation; either version 3 of the License, or
		10	# (at your option) any later version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but
		13	# WITHOUT ANY WARRANTY; without even the implied warranty of
		14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		15	# GNU General Public License for more details.
		16	#
		17	# You should have received a copy of the GNU General Public License
		18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		19
		20	use strict;
		21	use warnings;
		22
		23	sub new {
		24	my ( $class, $parm_ref ) = @_;
		25	my $self = {};
		26	if ( $parm_ref->{seg_string} ) {
		27	$self = _parse_seg( $parm_ref->{seg_string} );
		28	}
		29
		30	bless $self, $class;
		31	return $self;
		32	}
		33
		34	sub tag {
		35	my $self = shift;
		36	return $self->{tag};
		37	}
		38
		39	# return specified element may be data or an array ref if components
		40	sub elem {
		41	my ( $self, $element_number, $component_number ) = @_;
		42	if ( $element_number < @{ $self->{elem_arr} } ) {
		43
		44	my $e = $self->{elem_arr}->[$element_number];
		45	if ( defined $component_number ) {
		46	if ( ref $e eq 'ARRAY' ) {
		47	if ( $component_number < @{$e} ) {
		48	return $e->[$component_number];
		49	}
		50	}
		51	elsif ( $component_number == 0 ) {
		52
		53	# a string could be an element with a single component
		54	return $e;
		55	}
		56	return;
		57	}
		58	else {
		59	return $e;
		60	}
		61	}
		62	return; #element undefined ( out of range
		63	}
		64
65	sub element {
66	my ( $self, @params ) = @_;
67
68	return $self->elem(@params);
69	}
70
71	sub as_string {
72	my $self = shift;
73
74	my $string = $self->{tag};
75	foreach my $e ( @{ $self->{elem_arr} } ) {
76	$string .= q\|+\|;
77	if ( ref $e eq 'ARRAY' ) {
78	$string .= join q{:}, @{$e};
79	}
80	else {
81	$string .= $e;
82	}
83	}
84
85	return $string;
86	}
87
88	# parse a string into fields
89	sub _parse_seg {
90	my $s = shift;
91	my $e = {
92
93	# raw => $s,
94	tag => substr( $s, 0, 3 ),
95	elem_arr => _get_elements( substr( $s, 3 ) ),
96	};
97	return $e;
98	}
99
100	##
101	# String parsing
102	#
103
104	sub _get_elements {
105	my $seg = shift;
106
107	$seg =~ s/^[+]//; # dont start with a dummy element`
108	my @elem_array = map { _components($_) } split /(?<![?])[+]/, $seg;
109
110	return \@elem_array;
111	}
112
113	sub _components {
114	my $element = shift;
115	my @c = split /(?<![?])[:]/, $element;
116	if ( @c == 1 ) { # single element return a string
117	return de_escape( $c[0] );
118	}
119	@c = map { de_escape($_) } @c;
120	return \@c;
121	}
122
123	sub de_escape {
124	my $string = shift;
125
126	# remove escaped characters from the component string
127	$string =~ s/[?]([:?+'])/$1/g;
128	return $string;
129	}
130	1;
131	__END__
132
133	=head1 NAME
134	Koha::Edifact::Segment
135
136	=head1 SYNOPSIS
137
138
139	=head1 DESCRIPTION
140
141	Used by Koha::Edifact to represent segments in a parsed Edifact message
142
143
144	=head1 BUGS
145
146
147	=head1 METHODS
148
149	=head2 new
150
151	my $s = Koha::Edifact::Segment->new( { seg_string => $raw });
152
153	passed a string representation of the segment, parses it
154	and retums a Segment object
155
156	=head2 tag
157
158	returns the three character segment tag
159
160	=head2 elem
161
162	$data = $s->elem($element_number, $component_number)
163	return the contents of a specified element and if specified
164	component of that element
165
166	=head2 element
167
168	syntactic sugar this wraps the rlem method in a fuller name
169
170	=head2 as_string
171
172	returns a string representation of the segment
173
174	=head2 _parse_seg
175
176	passed a string representation of a segment returns a hash ref with
177	separate tag and data elements
178
179	=head2 _get_elements
180
181	passed the data portion of a segment, splits it into elements, passing each to
182	components to further parse them. Returns a reference to an array of
183	elements
184
185	=head2 _components
186
187	Passed a string element splits it into components and returns a reference
188	to an array of components, if only one component is present that is returned
189	directly.
190	quote characters are removed from the components
191
192	=head2 de_escape
193
194	Removes Edifact escapes from the passed string and returns the modified
195	string
196
197
198	=head1 AUTHOR
199
200	Colin Campbell <colin.campbell@ptfs-europe.com>
201
202
203	=head1 COPYRIGHT
204
205	Copyright 2014, PTFS-Europe Ltd
206	This program is free software, You may redistribute it under
207	under the terms of the GNU General Public License
208
209
210	=cut

Line 0 Link Here

(-)a/Koha/Edifact/Transport.pm (+470 lines)
		1	package Koha::Edifact::Transport;
		2
		3	# Copyright 2014 PTFS-Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it
		8	# under the terms of the GNU General Public License as published by
		9	# the Free Software Foundation; either version 3 of the License, or
		10	# (at your option) any later version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but
		13	# WITHOUT ANY WARRANTY; without even the implied warranty of
		14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		15	# GNU General Public License for more details.
		16	#
		17	# You should have received a copy of the GNU General Public License
		18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		19
		20	use strict;
		21	use warnings;
		22	use DateTime;
		23	use Carp;
		24	use English qw{ -no_match_vars };
		25	use Net::FTP;
		26	use Net::SFTP::Foreign;
		27	use File::Slurp;
		28	use File::Copy;
		29	use File::Basename qw( fileparse );
		30	use File::Spec;
		31	use Koha::Database;
		32	use Encode qw( from_to );
		33
		34	sub new {
		35	my ( $class, $account_id ) = @_;
		36	my $database = Koha::Database->new();
		37	my $schema = $database->schema();
		38	my $acct = $schema->resultset('VendorEdiAccount')->find($account_id);
		39	my $self = {
		40	account => $acct,
		41	schema => $schema,
		42	working_dir => File::Spec->tmpdir(), #temporary work directory
		43	transfer_date => DateTime->now( time_zone => 'local' ),
		44	};
		45
		46	bless $self, $class;
		47	return $self;
		48	}
		49
		50	sub working_directory {
		51	my ( $self, $new_value ) = @_;
		52	if ($new_value) {
		53	$self->{working_directory} = $new_value;
		54	}
		55	return $self->{working_directory};
		56	}
		57
		58	sub download_messages {
		59	my ( $self, $message_type ) = @_;
		60	$self->{message_type} = $message_type;
		61
		62	my @retrieved_files;
		63
		64	if ( $self->{account}->transport eq 'SFTP' ) {
65	@retrieved_files = $self->sftp_download();
66	}
67	elsif ( $self->{account}->transport eq 'FILE' ) {
68	@retrieved_files = $self->file_download();
69	}
70	else { # assume FTP
71	@retrieved_files = $self->ftp_download();
72	}
73	return @retrieved_files;
74	}
75
76	sub upload_messages {
77	my ( $self, @messages ) = @_;
78	if (@messages) {
79	if ( $self->{account}->transport eq 'SFTP' ) {
80	$self->sftp_upload(@messages);
81	}
82	elsif ( $self->{account}->transport eq 'FILE' ) {
83	$self->file_upload(@messages);
84	}
85	else { # assume FTP
86	$self->ftp_upload(@messages);
87	}
88	}
89	return;
90	}
91
92	sub file_download {
93	my $self = shift;
94	my @downloaded_files;
95
96	my $file_ext = _get_file_ext( $self->{message_type} );
97
98	my $dir = $self->{account}->download_directory; # makes code more readable
99	# C = ready to retrieve E = Edifact
100	my $msg_hash = $self->message_hash();
101	if ( opendir my $dh, $dir ) {
102	my @file_list = readdir $dh;
103	closedir $dh;
104	foreach my $filename (@file_list) {
105
106	if ( $filename =~ m/[.]$file_ext$/ ) {
107	if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
108	}
109	else {
110	carp "copy of $filename failed";
111	next;
112	}
113	push @downloaded_files, $filename;
114	my $processed_name = $filename;
115	substr $processed_name, -3, 1, 'E';
116	move( "$dir/$filename", "$dir/$processed_name" );
117	}
118	}
119	$self->ingest( $msg_hash, @downloaded_files );
120	}
121	else {
122	carp "Cannot open $dir";
123	return;
124	}
125	return @downloaded_files;
126	}
127
128	sub sftp_download {
129	my $self = shift;
130
131	my $file_ext = _get_file_ext( $self->{message_type} );
132
133	# C = ready to retrieve E = Edifact
134	my $msg_hash = $self->message_hash();
135	my @downloaded_files;
136	my $sftp = Net::SFTP::Foreign->new(
137	$self->{account}->host,
138	{
139	user => $self->{account}->user,
140	password => $self->{account}->password,
141	timeout => 10,
142	}
143	);
144	if ( $sftp->error ) {
145	return $self->_abort_download( undef,
146	'Unable to connect to remote host: ' . $sftp->error );
147	}
148	$sftp->setcwd( $self->{account}->download_directory )
149	or return $self->_abort_download( $sftp,
150	"Cannot change remote dir : $sftp->error" );
151	my $file_list = $sftp->ls()
152	or return $self->_abort_download( $sftp,
153	"cannot get file list from server: $sftp->error" );
154	foreach my $filename ( @{$file_list} ) {
155
156	if ( $filename =~ m/[.]$file_ext$/ ) {
157	$sftp->get( $filename, "$self->{working_dir}/$filename" );
158	if ( $sftp->error ) {
159	$self->_abort_download( $sftp,
160	"Error retrieving $filename: $sftp->error" );
161	last;
162	}
163	push @downloaded_files, $filename;
164	my $processed_name = $filename;
165	substr $processed_name, -3, 1, 'E';
166	$sftp->rename( $filename, $processed_name );
167	}
168	}
169	$sftp->disconnect;
170	$self->ingest( $msg_hash, @downloaded_files );
171
172	return @downloaded_files;
173	}
174
175	sub ingest {
176	my ( $self, $msg_hash, @downloaded_files ) = @_;
177	foreach my $f (@downloaded_files) {
178	$msg_hash->{filename} = $f;
179	my $file_content =
180	read_file( "$self->{working_dir}/$f", binmode => ':raw' );
181	if ( !defined $file_content ) {
182	carp "Unable to read download file $f";
183	next;
184	}
185	from_to( $file_content, 'iso-8859-1', 'utf8' );
186	$msg_hash->{raw_msg} = $file_content;
187	$self->{schema}->resultset('EdifactMessage')->create($msg_hash);
188	}
189	return;
190	}
191
192	sub ftp_download {
193	my $self = shift;
194
195	my $file_ext = _get_file_ext( $self->{message_type} );
196
197	# C = ready to retrieve E = Edifact
198
199	my $msg_hash = $self->message_hash();
200	my @downloaded_files;
201	my $ftp = Net::FTP->new(
202	$self->{account}->host,
203	Timeout => 10,
204	Passive => 1
205	)
206	or return $self->_abort_download( undef,
207	"Cannot connect to $self->{account}->host: $EVAL_ERROR" );
208	$ftp->login( $self->{account}->username, $self->{account}->password )
209	or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
210	$ftp->cwd( $self->{account}->download_directory )
211	or return $self->_abort_download( $ftp,
212	"Cannot change remote dir : $ftp->message()" );
213	my $file_list = $ftp->ls()
214	or
215	return $self->_abort_download( $ftp, 'cannot get file list from server' );
216
217	foreach my $filename ( @{$file_list} ) {
218
219	if ( $filename =~ m/[.]$file_ext$/ ) {
220
221	if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
222	$self->_abort_download( $ftp,
223	"Error retrieving $filename: $ftp->message" );
224	last;
225	}
226
227	push @downloaded_files, $filename;
228	my $processed_name = $filename;
229	substr $processed_name, -3, 1, 'E';
230	$ftp->rename( $filename, $processed_name );
231	}
232	}
233	$ftp->quit;
234
235	$self->ingest( $msg_hash, @downloaded_files );
236
237	return @downloaded_files;
238	}
239
240	sub ftp_upload {
241	my ( $self, @messages ) = @_;
242	my $ftp = Net::FTP->new(
243	$self->{account}->host,
244	Timeout => 10,
245	Passive => 1
246	)
247	or return $self->_abort_download( undef,
248	"Cannot connect to $self->{account}->host: $EVAL_ERROR" );
249	$ftp->login( $self->{account}->username, $self->{account}->password )
250	or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
251	$ftp->cwd( $self->{account}->upload_directory )
252	or return $self->_abort_download( $ftp,
253	"Cannot change remote dir : $ftp->message()" );
254	foreach my $m (@messages) {
255	my $content = $m->raw_msg;
256	if ($content) {
257	open my $fh, '<', \$content;
258	if ( $ftp->put( $fh, $m->filename ) ) {
259	close $fh;
260	$m->transfer_date( $self->{transfer_date} );
261	$m->status('sent');
262	$m->update;
263	}
264	else {
265	# error in transfer
266
267	}
268	}
269	}
270
271	$ftp->quit;
272	return;
273	}
274
275	sub sftp_upload {
276	my ( $self, @messages ) = @_;
277	my $sftp = Net::SFTP::Foreign->new(
278	$self->{account}->host,
279	{
280	user => $self->{account}->user,
281	password => $self->{account}->password,
282	timeout => 10,
283	}
284	);
285	$sftp->die_on_error("Cannot ssh to $self->{account}->host");
286	$sftp->cwd( $self->{account}->upload_directory );
287	$sftp->die_on_error('Cannot change to remote dir');
288	foreach my $m (@messages) {
289	my $content = $m->raw_msg;
290	if ($content) {
291	open my $fh, '<', \$content;
292	if ( $sftp->put( $fh, $m->filename ) ) {
293	close $fh;
294	$m->transfer_date( $self->{transfer_date} );
295	$m->status('sent');
296	$m->update;
297	}
298	else {
299	# error in transfer
300
301	}
302	}
303	}
304
305	# sftp will be closed on object destructor
306	return;
307	}
308
309	sub file_upload {
310	my ( $self, @messages ) = @_;
311	my $dir = $self->{account}->upload_directory;
312	if ( -d $dir ) {
313	foreach my $m (@messages) {
314	my $content = $m->raw_msg;
315	if ($content) {
316	my $filename = $m->filename;
317	my $new_filename = "$dir/$filename";
318	if ( open my $fh, '>', $new_filename ) {
319	print {$fh} $content;
320	close $fh;
321	$m->transfer_date( $self->{transfer_date} );
322	$m->status('sent');
323	$m->update;
324	}
325	else {
326	carp "Could not transfer $m->filename : $ERRNO";
327	next;
328	}
329	}
330	}
331	}
332	else {
333	carp "Upload directory $dir does not exist";
334	}
335	return;
336	}
337
338	sub _abort_download {
339	my ( $self, $handle, $log_message ) = @_;
340
341	my $a = $self->{account}->description;
342
343	$handle->abort();
344	$log_message .= ": $a";
345	carp $log_message;
346
347	#returns undef i.e. an empty array
348	return;
349	}
350
351	sub _get_file_ext {
352	my $type = shift;
353
354	# Extension format
355	# 1st char Status C = Ready For pickup A = Completed E = Extracted
356	# 2nd Char Standard E = Edifact
357	# 3rd Char Type of message
358	my %file_types = (
359	QUOTE => 'CEQ',
360	INVOICE => 'CEI',
361	ALL => 'CE.',
362	);
363	if ( exists $file_types{$type} ) {
364	return $file_types{$type};
365	}
366	return 'XXXX'; # non matching type
367	}
368
369	sub message_hash {
370	my $self = shift;
371	my $msg = {
372	message_type => $self->{message_type},
373	vendor_id => $self->{account}->vendor_id,
374	edi_acct => $self->{account}->id,
375	status => 'new',
376	deleted => 0,
377	transfer_date => $self->{transfer_date}->ymd(),
378	};
379
380	return $msg;
381	}
382
383	1;
384	__END__
385
386	=head1 NAME
387	Koha::Edifact::Transport
388
389	=head1 SYNOPSIS
390
391	my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id );
392	$downlod->download_messages('QUOTE');
393
394
395	=head1 DESCRIPTION
396
397	Module that handles Edifact download and upload transport
398	currently can use sftp or ftp
399	Or FILE to access a local directory (useful for testing)
400
401	=head1 BUGS
402
403
404	=head1 METHODS
405
406	=head2 new
407
408	Creates an object of Edifact::Transport requires to be passed the id
409	identifying the relevant edi vendor account
410
411	=head2 working_directory
412
413	getter and setter for the working_directory attribute
414
415	=head2 download_messages
416
417	called with the message type to download will perform the download
418	using the appropriate transport method
419
420	=head2 upload_messages
421
422	passed an array of messages will upload them to the supplier site
423
424	=head2 sftp_download
425
426	called by download_messages to perform the download using SFTP
427
428	=head2 ingest
429
430	loads downloaded files into the database
431
432	=head2 ftp_download
433
434	called by download_messages to perform the download using FTP
435
436	=head2 ftp_upload
437
438	called by upload_messages to perform the upload using ftp
439
440	=head2 sftp_upload
441
442	called by upload_messages to perform the upload using sftp
443
444	=head2 _abort_download
445
446	internal routine to halt operation on error and supply a stacktrace
447
448	=head2 _get_file_ext
449
450	internal method returning standard suffix for file names
451	according to message type
452
453	=head2 set_transport_direct
454
455	sets the direct ingest flag so that the object reads files from
456	the local file system useful in debugging
457
458	=head1 AUTHOR
459
460	Colin Campbell <colin.campbell@ptfs-europe.com>
461
462
463	=head1 COPYRIGHT
464
465	Copyright 2014, PTFS-Europe Ltd
466	This program is free software, You may redistribute it under
467	under the terms of the GNU General Public License
468
469
470	=cut

Lines 263-268 __PACKAGE__->belongs_to( Link Here

(-)a/Koha/Schema/Result/Aqbasket.pm (-2 / +17 lines)
263	},	263	},
264	);	264	);
265		265
		266	=head2 edifact_messages
		267
		268	Type: has_many
		269
		270	Related object: L<Koha::Schema::Result::EdifactMessage>
		271
		272	=cut
		273
		274	__PACKAGE__->has_many(
		275	"edifact_messages",
		276	"Koha::Schema::Result::EdifactMessage",
		277	{ "foreign.basketno" => "self.basketno" },
		278	{ cascade_copy => 0, cascade_delete => 0 },
		279	);
		280
266	=head2 borrowernumbers	281	=head2 borrowernumbers
267		282
268	Type: many_to_many	283	Type: many_to_many
Lines 274-281 Composing rels: L</aqbasketusers> -> borrowernumber Link Here
274	__PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber");	289	__PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber");
275		290
276		291
277	# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55	292	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
278	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:pT+YFf9nfD/dmBuE4RNCFw	293	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:tsMzwP7eofOR27sfZSTqFQ
279		294
280		295
281	# You can replace this text with custom content, and it will be preserved on regeneration	296	# You can replace this text with custom content, and it will be preserved on regeneration

Lines 227-244 __PACKAGE__->has_many( Link Here

(-)a/Koha/Schema/Result/Aqbudget.pm (+19 lines)
227	{ cascade_copy => 0, cascade_delete => 0 },	227	{ cascade_copy => 0, cascade_delete => 0 },
228	);	228	);
229		229
		230	<<<<<<< HEAD
230	=head2 aqorders	231	=head2 aqorders
231		232
232	Type: has_many	233	Type: has_many
233		234
234	Related object: L<Koha::Schema::Result::Aqorder>	235	Related object: L<Koha::Schema::Result::Aqorder>
		236	=======
		237	=head2 vendor_edi_accounts
		238
		239	Type: has_many
		240
		241	Related object: L<Koha::Schema::Result::VendorEdiAccount>
		242	>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
235		243
236	=cut	244	=cut
237		245
238	__PACKAGE__->has_many(	246	__PACKAGE__->has_many(
		247	<<<<<<< HEAD
239	"aqorders",	248	"aqorders",
240	"Koha::Schema::Result::Aqorder",	249	"Koha::Schema::Result::Aqorder",
241	{ "foreign.budget_id" => "self.budget_id" },	250	{ "foreign.budget_id" => "self.budget_id" },
		251	=======
		252	"vendor_edi_accounts",
		253	"Koha::Schema::Result::VendorEdiAccount",
		254	{ "foreign.shipment_budget" => "self.budget_id" },
		255	>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
242	{ cascade_copy => 0, cascade_delete => 0 },	256	{ cascade_copy => 0, cascade_delete => 0 },
243	);	257	);
244		258
Lines 253-260 Composing rels: L</aqbudgetborrowers> -> borrowernumber Link Here
253	__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");	267	__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");
254		268
255		269
		270	<<<<<<< HEAD
256	# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-02-05 15:20:11	271	# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-02-05 15:20:11
257	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:733+8NRE5Ip/30URBcJsbA	272	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:733+8NRE5Ip/30URBcJsbA
		273	=======
		274	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
		275	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:Ieg4SfRCek9KwaDyUKmoWA
		276	>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
258		277
259		278
260	# You can replace this text with custom content, and it will be preserved on regeneration	279	# You can replace this text with custom content, and it will be preserved on regeneration

Lines 397-402 __PACKAGE__->might_have( Link Here

(-)a/Koha/Schema/Result/Branch.pm (-3 / +18 lines)
397	{ cascade_copy => 0, cascade_delete => 0 },	397	{ cascade_copy => 0, cascade_delete => 0 },
398	);	398	);
399		399
		400	=head2 edifact_eans
		401
		402	Type: has_many
		403
		404	Related object: L<Koha::Schema::Result::EdifactEan>
		405
		406	=cut
		407
		408	__PACKAGE__->has_many(
		409	"edifact_eans",
		410	"Koha::Schema::Result::EdifactEan",
		411	{ "foreign.branchcode" => "self.branchcode" },
		412	{ cascade_copy => 0, cascade_delete => 0 },
		413	);
		414
400	=head2 hold_fill_targets	415	=head2 hold_fill_targets
401		416
402	Type: has_many	417	Type: has_many
Lines 513-521 Composing rels: L</branchrelations> -> categorycode Link Here
513	__PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode");	528	__PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode");
514		529
515		530
516	# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-11-06 15:26:36	531	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-11-26 11:08:29
517	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:CGNPB/MkGLOihDThj43/4A	532	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FjNI9OEpa5OKfwwCkggu0w
518		533
519		534
520	# You can replace this text with custom content, and it will be preserved on regeneration	535	# You can replace this text with custom code or comments, and it will be preserved on regeneration
521	1;	536	1;

Line 0 Link Here

(-)a/Koha/Schema/Result/EdifactEan.pm (+91 lines)
		1	use utf8;
		2	package Koha::Schema::Result::EdifactEan;
		3
		4	# Created by DBIx::Class::Schema::Loader
		5	# DO NOT MODIFY THE FIRST PART OF THIS FILE
		6
		7	=head1 NAME
		8
		9	Koha::Schema::Result::EdifactEan
		10
		11	=cut
		12
		13	use strict;
		14	use warnings;
		15
		16	use base 'DBIx::Class::Core';
		17
		18	=head1 TABLE: C<edifact_ean>
		19
		20	=cut
		21
		22	__PACKAGE__->table("edifact_ean");
		23
		24	=head1 ACCESSORS
		25
		26	=head2 branchcode
		27
		28	data_type: 'varchar'
		29	is_foreign_key: 1
		30	is_nullable: 0
		31	size: 10
		32
		33	=head2 ean
		34
		35	data_type: 'varchar'
		36	is_nullable: 0
		37	size: 15
		38
		39	=head2 id_code_qualifier
		40
		41	data_type: 'varchar'
		42	default_value: 14
		43	is_nullable: 0
		44	size: 3
		45
		46	=cut
		47
		48	__PACKAGE__->add_columns(
		49	"branchcode",
		50	{ data_type => "varchar", is_foreign_key => 1, is_nullable => 0, size => 10 },
		51	"ean",
		52	{ data_type => "varchar", is_nullable => 0, size => 15 },
		53	"id_code_qualifier",
		54	{ data_type => "varchar", default_value => 14, is_nullable => 0, size => 3 },
		55	);
		56
		57	=head1 RELATIONS
		58
		59	=head2 branchcode
		60
		61	Type: belongs_to
		62
		63	Related object: L<Koha::Schema::Result::Branch>
		64
65	=cut
66
67	__PACKAGE__->belongs_to(
68	"branchcode",
69	"Koha::Schema::Result::Branch",
70	{ branchcode => "branchcode" },
71	{ is_deferrable => 1, on_delete => "RESTRICT", on_update => "RESTRICT" },
72	);
73
74
75	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
76	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:s5Z9txnCIqGyvOj02EOtdQ
77
78
79	# You can replace this text with custom code or comments, and it will be preserved on regeneration
80	__PACKAGE__->belongs_to('branch',
81	"Koha::Schema::Result::Branch",
82	{ 'branchcode' => 'branchcode' },
83	{
84	is_deferrable => 1,
85	join_type => 'LEFT',
86	on_delete => 'CASCADE',
87	on_update => 'CASCADE',
88	},
89	);
90
91	1;

Line 0 Link Here

(-)a/Koha/Schema/Result/EdifactMessage.pm (+202 lines)
		1	use utf8;
		2	package Koha::Schema::Result::EdifactMessage;
		3
		4	# Created by DBIx::Class::Schema::Loader
		5	# DO NOT MODIFY THE FIRST PART OF THIS FILE
		6
		7	=head1 NAME
		8
		9	Koha::Schema::Result::EdifactMessage
		10
		11	=cut
		12
		13	use strict;
		14	use warnings;
		15
		16	use base 'DBIx::Class::Core';
		17
		18	=head1 TABLE: C<edifact_messages>
		19
		20	=cut
		21
		22	__PACKAGE__->table("edifact_messages");
		23
		24	=head1 ACCESSORS
		25
		26	=head2 id
		27
		28	data_type: 'integer'
		29	is_auto_increment: 1
		30	is_nullable: 0
		31
		32	=head2 message_type
		33
		34	data_type: 'varchar'
		35	is_nullable: 0
		36	size: 10
		37
		38	=head2 transfer_date
		39
		40	data_type: 'date'
		41	datetime_undef_if_invalid: 1
		42	is_nullable: 1
		43
		44	=head2 vendor_id
		45
		46	data_type: 'integer'
		47	is_foreign_key: 1
		48	is_nullable: 1
		49
		50	=head2 edi_acct
		51
		52	data_type: 'integer'
		53	is_foreign_key: 1
		54	is_nullable: 1
		55
		56	=head2 status
		57
		58	data_type: 'text'
		59	is_nullable: 1
		60
		61	=head2 basketno
		62
		63	data_type: 'integer'
		64	is_foreign_key: 1
65	is_nullable: 1
66
67	=head2 raw_msg
68
69	data_type: 'text'
70	is_nullable: 1
71
72	=head2 filename
73
74	data_type: 'text'
75	is_nullable: 1
76
77	=head2 deleted
78
79	data_type: 'tinyint'
80	default_value: 0
81	is_nullable: 0
82
83	=cut
84
85	__PACKAGE__->add_columns(
86	"id",
87	{ data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
88	"message_type",
89	{ data_type => "varchar", is_nullable => 0, size => 10 },
90	"transfer_date",
91	{ data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 },
92	"vendor_id",
93	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
94	"edi_acct",
95	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
96	"status",
97	{ data_type => "text", is_nullable => 1 },
98	"basketno",
99	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
100	"raw_msg",
101	{ data_type => "text", is_nullable => 1 },
102	"filename",
103	{ data_type => "text", is_nullable => 1 },
104	"deleted",
105	{ data_type => "tinyint", default_value => 0, is_nullable => 0 },
106	);
107
108	=head1 PRIMARY KEY
109
110	=over 4
111
112	=item * L</id>
113
114	=back
115
116	=cut
117
118	__PACKAGE__->set_primary_key("id");
119
120	=head1 RELATIONS
121
122	=head2 aqinvoices
123
124	Type: has_many
125
126	Related object: L<Koha::Schema::Result::Aqinvoice>
127
128	=cut
129
130	__PACKAGE__->has_many(
131	"aqinvoices",
132	"Koha::Schema::Result::Aqinvoice",
133	{ "foreign.message_id" => "self.id" },
134	{ cascade_copy => 0, cascade_delete => 0 },
135	);
136
137	=head2 basketno
138
139	Type: belongs_to
140
141	Related object: L<Koha::Schema::Result::Aqbasket>
142
143	=cut
144
145	__PACKAGE__->belongs_to(
146	"basketno",
147	"Koha::Schema::Result::Aqbasket",
148	{ basketno => "basketno" },
149	{
150	is_deferrable => 1,
151	join_type => "LEFT",
152	on_delete => "RESTRICT",
153	on_update => "RESTRICT",
154	},
155	);
156
157	=head2 edi_acct
158
159	Type: belongs_to
160
161	Related object: L<Koha::Schema::Result::VendorEdiAccount>
162
163	=cut
164
165	__PACKAGE__->belongs_to(
166	"edi_acct",
167	"Koha::Schema::Result::VendorEdiAccount",
168	{ id => "edi_acct" },
169	{
170	is_deferrable => 1,
171	join_type => "LEFT",
172	on_delete => "RESTRICT",
173	on_update => "RESTRICT",
174	},
175	);
176
177	=head2 vendor
178
179	Type: belongs_to
180
181	Related object: L<Koha::Schema::Result::Aqbookseller>
182
183	=cut
184
185	__PACKAGE__->belongs_to(
186	"vendor",
187	"Koha::Schema::Result::Aqbookseller",
188	{ id => "vendor_id" },
189	{
190	is_deferrable => 1,
191	join_type => "LEFT",
192	on_delete => "RESTRICT",
193	on_update => "RESTRICT",
194	},
195	);
196
197
198	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46
199	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:aOMWguyzdK9caRRecsuTmQ
200
201
202	1;

Line 0 Link Here

(-)a/Koha/Schema/Result/MsgInvoice.pm (+115 lines)
		1	use utf8;
		2	package Koha::Schema::Result::MsgInvoice;
		3
		4	# Created by DBIx::Class::Schema::Loader
		5	# DO NOT MODIFY THE FIRST PART OF THIS FILE
		6
		7	=head1 NAME
		8
		9	Koha::Schema::Result::MsgInvoice
		10
		11	=cut
		12
		13	use strict;
		14	use warnings;
		15
		16	use base 'DBIx::Class::Core';
		17
		18	=head1 TABLE: C<msg_invoice>
		19
		20	=cut
		21
		22	__PACKAGE__->table("msg_invoice");
		23
		24	=head1 ACCESSORS
		25
		26	=head2 mi_id
		27
		28	data_type: 'integer'
		29	is_auto_increment: 1
		30	is_nullable: 0
		31
		32	=head2 msg_id
		33
		34	data_type: 'integer'
		35	is_foreign_key: 1
		36	is_nullable: 1
		37
		38	=head2 invoiceid
		39
		40	data_type: 'integer'
		41	is_foreign_key: 1
		42	is_nullable: 1
		43
		44	=cut
		45
		46	__PACKAGE__->add_columns(
		47	"mi_id",
		48	{ data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
		49	"msg_id",
		50	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
		51	"invoiceid",
		52	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
		53	);
		54
		55	=head1 PRIMARY KEY
		56
		57	=over 4
		58
		59	=item * L</mi_id>
		60
		61	=back
		62
		63	=cut
		64
65	__PACKAGE__->set_primary_key("mi_id");
66
67	=head1 RELATIONS
68
69	=head2 invoiceid
70
71	Type: belongs_to
72
73	Related object: L<Koha::Schema::Result::Aqinvoice>
74
75	=cut
76
77	__PACKAGE__->belongs_to(
78	"invoiceid",
79	"Koha::Schema::Result::Aqinvoice",
80	{ invoiceid => "invoiceid" },
81	{
82	is_deferrable => 1,
83	join_type => "LEFT",
84	on_delete => "RESTRICT",
85	on_update => "RESTRICT",
86	},
87	);
88
89	=head2 msg
90
91	Type: belongs_to
92
93	Related object: L<Koha::Schema::Result::EdifactMessage>
94
95	=cut
96
97	__PACKAGE__->belongs_to(
98	"msg",
99	"Koha::Schema::Result::EdifactMessage",
100	{ id => "msg_id" },
101	{
102	is_deferrable => 1,
103	join_type => "LEFT",
104	on_delete => "RESTRICT",
105	on_update => "RESTRICT",
106	},
107	);
108
109
110	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
111	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:F1jqlEH57dpxn2Pvm/vPGA
112
113
114	# You can replace this text with custom code or comments, and it will be preserved on regeneration
115	1;

Line 0 Link Here

(-)a/Koha/Schema/Result/VendorEdiAccount.pm (+233 lines)
		1	use utf8;
		2	package Koha::Schema::Result::VendorEdiAccount;
		3
		4	# Created by DBIx::Class::Schema::Loader
		5	# DO NOT MODIFY THE FIRST PART OF THIS FILE
		6
		7	=head1 NAME
		8
		9	Koha::Schema::Result::VendorEdiAccount
		10
		11	=cut
		12
		13	use strict;
		14	use warnings;
		15
		16	use base 'DBIx::Class::Core';
		17
		18	=head1 TABLE: C<vendor_edi_accounts>
		19
		20	=cut
		21
		22	__PACKAGE__->table("vendor_edi_accounts");
		23
		24	=head1 ACCESSORS
		25
		26	=head2 id
		27
		28	data_type: 'integer'
		29	is_auto_increment: 1
		30	is_nullable: 0
		31
		32	=head2 description
		33
		34	data_type: 'text'
		35	is_nullable: 0
		36
		37	=head2 host
		38
		39	data_type: 'varchar'
		40	is_nullable: 1
		41	size: 40
		42
		43	=head2 username
		44
		45	data_type: 'varchar'
		46	is_nullable: 1
		47	size: 40
		48
		49	=head2 password
		50
		51	data_type: 'varchar'
		52	is_nullable: 1
		53	size: 40
		54
		55	=head2 last_activity
		56
		57	data_type: 'date'
		58	datetime_undef_if_invalid: 1
		59	is_nullable: 1
		60
		61	=head2 vendor_id
		62
		63	data_type: 'integer'
		64	is_foreign_key: 1
65	is_nullable: 1
66
67	=head2 download_directory
68
69	data_type: 'text'
70	is_nullable: 1
71
72	=head2 upload_directory
73
74	data_type: 'text'
75	is_nullable: 1
76
77	=head2 san
78
79	data_type: 'varchar'
80	is_nullable: 1
81	size: 20
82
83	=head2 id_code_qualifier
84
85	data_type: 'varchar'
86	default_value: 14
87	is_nullable: 1
88	size: 3
89
90	=head2 transport
91
92	data_type: 'varchar'
93	default_value: 'FTP'
94	is_nullable: 1
95	size: 6
96
97	=head2 quotes_enabled
98
99	data_type: 'tinyint'
100	default_value: 0
101	is_nullable: 0
102
103	=head2 invoices_enabled
104
105	data_type: 'tinyint'
106	default_value: 0
107	is_nullable: 0
108
109	=head2 orders_enabled
110
111	data_type: 'tinyint'
112	default_value: 0
113	is_nullable: 0
114
115	=head2 shipment_budget
116
117	data_type: 'integer'
118	is_foreign_key: 1
119	is_nullable: 1
120
121	=cut
122
123	__PACKAGE__->add_columns(
124	"id",
125	{ data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
126	"description",
127	{ data_type => "text", is_nullable => 0 },
128	"host",
129	{ data_type => "varchar", is_nullable => 1, size => 40 },
130	"username",
131	{ data_type => "varchar", is_nullable => 1, size => 40 },
132	"password",
133	{ data_type => "varchar", is_nullable => 1, size => 40 },
134	"last_activity",
135	{ data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 },
136	"vendor_id",
137	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
138	"download_directory",
139	{ data_type => "text", is_nullable => 1 },
140	"upload_directory",
141	{ data_type => "text", is_nullable => 1 },
142	"san",
143	{ data_type => "varchar", is_nullable => 1, size => 20 },
144	"id_code_qualifier",
145	{ data_type => "varchar", default_value => 14, is_nullable => 1, size => 3 },
146	"transport",
147	{ data_type => "varchar", default_value => "FTP", is_nullable => 1, size => 6 },
148	"quotes_enabled",
149	{ data_type => "tinyint", default_value => 0, is_nullable => 0 },
150	"invoices_enabled",
151	{ data_type => "tinyint", default_value => 0, is_nullable => 0 },
152	"orders_enabled",
153	{ data_type => "tinyint", default_value => 0, is_nullable => 0 },
154	"shipment_budget",
155	{ data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
156	);
157
158	=head1 PRIMARY KEY
159
160	=over 4
161
162	=item * L</id>
163
164	=back
165
166	=cut
167
168	__PACKAGE__->set_primary_key("id");
169
170	=head1 RELATIONS
171
172	=head2 edifact_messages
173
174	Type: has_many
175
176	Related object: L<Koha::Schema::Result::EdifactMessage>
177
178	=cut
179
180	__PACKAGE__->has_many(
181	"edifact_messages",
182	"Koha::Schema::Result::EdifactMessage",
183	{ "foreign.edi_acct" => "self.id" },
184	{ cascade_copy => 0, cascade_delete => 0 },
185	);
186
187	=head2 shipment_budget
188
189	Type: belongs_to
190
191	Related object: L<Koha::Schema::Result::Aqbudget>
192
193	=cut
194
195	__PACKAGE__->belongs_to(
196	"shipment_budget",
197	"Koha::Schema::Result::Aqbudget",
198	{ budget_id => "shipment_budget" },
199	{
200	is_deferrable => 1,
201	join_type => "LEFT",
202	on_delete => "RESTRICT",
203	on_update => "RESTRICT",
204	},
205	);
206
207	=head2 vendor
208
209	Type: belongs_to
210
211	Related object: L<Koha::Schema::Result::Aqbookseller>
212
213	=cut
214
215	__PACKAGE__->belongs_to(
216	"vendor",
217	"Koha::Schema::Result::Aqbookseller",
218	{ id => "vendor_id" },
219	{
220	is_deferrable => 1,
221	join_type => "LEFT",
222	on_delete => "RESTRICT",
223	on_update => "RESTRICT",
224	},
225	);
226
227
228	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-10-02 17:14:15
229	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:6Yp5lyH2ld4lrmaM0OeYcw
230
231
232	# You can replace this text with custom code or comments, and it will be preserved on regeneration
233	1;

Lines 56-61 use C4::Budgets qw/ConvertCurrency/; Link Here

(-)a/acqui/basketgroup.pl (+17 lines)
56	use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;	56	use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;
57	use C4::Branch qw/GetBranches/;	57	use C4::Branch qw/GetBranches/;
58	use C4::Members qw/GetMember/;	58	use C4::Members qw/GetMember/;
		59	use Koha::EDI qw/create_edi_order get_edifact_ean/;
59		60
60	use Koha::Acquisition::Bookseller;	61	use Koha::Acquisition::Bookseller;
61		62
Lines 208-219 sub printbasketgrouppdf{ Link Here
208		209
209	}	210	}
210		211
		212	sub generate_edifact_orders {
		213	my $basketgroupid = shift;
		214	my $baskets = GetBasketsByBasketgroup($basketgroupid);
		215	my $ean = get_edifact_ean();
		216
		217	for my $basket ( @{$baskets} ) {
		218	create_edi_order( { ean => $ean, basketno => $basket->{basketno}, } );
		219	}
		220	return;
		221	}
		222
211	my $op = $input->param('op') \|\| 'display';	223	my $op = $input->param('op') \|\| 'display';
212	# possible values of $op :	224	# possible values of $op :
213	# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup	225	# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
214	# - mod_basket : modify an individual basket of the basketgroup	226	# - mod_basket : modify an individual basket of the basketgroup
215	# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list	227	# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
216	# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list	228	# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
		229	# - ediprint : generate edi order messages for the baskets in the group
217	# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list	230	# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
218	# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list	231	# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
219	# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list	232	# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list
Lines 372-377 if ( $op eq "add" ) { Link Here
372	$redirectpath .= "&listclosed=1" if $closedbg ;	385	$redirectpath .= "&listclosed=1" if $closedbg ;
373	print $input->redirect($redirectpath );	386	print $input->redirect($redirectpath );
374		387
		388	} elsif ( $op eq 'ediprint') {
		389	my $basketgroupid = $input->param('basketgroupid');
		390	generate_edifact_orders( $basketgroupid );
		391	exit;
375	}else{	392	}else{
376	# no param : display the list of all basketgroups for a given vendor	393	# no param : display the list of all basketgroups for a given vendor
377	my $basketgroups = &GetBasketgroups($booksellerid);	394	my $basketgroups = &GetBasketgroups($booksellerid);

Line 0 Link Here

(-)a/acqui/edi_ean.pl (+64 lines)
	1	#!/usr/bin/perl
	2
	3	# Copyright 2012 Mark Gavillet & PTFS Europe Ltd
	4	#
	5	# This file is part of Koha.
	6	#
	7	# Koha is free software; you can redistribute it and/or modify it under the
	8	# terms of the GNU General Public License as published by the Free Software
	9	# Foundation; either version 2 of the License, or (at your option) any later
	10	# version.
	11	#
	12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
	13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	15	#
	16	# You should have received a copy of the GNU General Public License along
	17	# with Koha; if not, write to the Free Software Foundation, Inc.,
	18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	19
	20	# This is an awkward construct and should probably be totally replaced
	21	# but as all sites so far are single ordering ean its not clear what we should
	22	# replace it with
	23	#
	24	use strict;
	25	use warnings;
	26
	27	use C4::Auth;
	28	use C4::Koha;
	29	use C4::Output;
	30	use Koha::Database;
	31	use CGI;
	32	my $schema = Koha::Database->new()->schema();
	33
	34	my @eans = $schema->resultset('EdifactEan')->search(
	35	{},
	36	{
	37	join => 'branch',
	38	}
	39	);
	40	my $query = CGI->new();
	41	my $basketno = $query->param('basketno');
	42
	43	if ( @eans == 1 ) {
	44	my $ean = $eans[0]->ean;
	45	print $query->redirect(
	46	"/cgi-bin/koha/acqui/basket.pl?basketno=$basketno&op=ediorder&ean=$ean"
	47	);
	48	}
	49	else {
	50	my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
	51	{
	52	template_name => 'acqui/edi_ean.tt',
	53	query => $query,
	54	type => 'intranet',
	55	authnotrequired => 0,
	56	flagsrequired => { acquisition => 'order_manage' },
	57	debug => 1,
	58	}
	59	);
	60	$template->param( eans => \@eans );
	61	$template->param( basketno => $basketno );
	62
	63	output_html_with_http_headers( $query, $cookie, $template->output );
	64	}

Line 0 Link Here

(-)a/acqui/edifactmsgs.pl (+55 lines)
	1	#!/usr/bin/perl
	2
	3	# Copyright 2014 PTFS Europe Ltd.
	4	# This file is part of Koha.
	5	#
	6	# Koha is free software; you can redistribute it and/or modify it under the
	7	# terms of the GNU General Public License as published by the Free Software
	8	# Foundation; either version 2 of the License, or (at your option) any later
	9	# version.
	10	#
	11	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
	12	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	13	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License along
	16	# with Koha; if not, write to the Free Software Foundation, Inc.,
	17	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	18
	19	use strict;
	20	use warnings;
	21
	22	use CGI;
	23	use Koha::Database;
	24	use C4::Koha;
	25	use C4::Auth;
	26	use C4::Output;
	27
	28	my $q = CGI->new;
	29	my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
	30	{
	31	template_name => 'acqui/edifactmsgs.tt',
	32	query => $q,
	33	type => 'intranet',
	34	authnotrequired => 0,
	35	flagsrequired => { acquisition => 'manage_edi' },
	36	debug => 1,
	37	}
	38	);
	39
	40	my $schema = Koha::Database->new()->schema();
	41
	42	my @msgs = $schema->resultset('EdifactMessage')->search(
	43	{
	44	deleted => 0,
	45	},
	46	{
	47	join => 'vendor',
	48	order_by => { -desc => 'transfer_date' },
	49	}
	50
	51	)->all;
	52
	53	$template->param( messages => \@msgs );
	54
	55	output_html_with_http_headers( $q, $cookie, $template->output );

Line 0 Link Here

(-)a/acqui/edimsg.pl (+72 lines)
		1	#!/usr/bin/perl
		2
		3	# Copyright 2014 PTFS Europe Ltd.
		4	# This file is part of Koha.
		5	#
		6	# Koha is free software; you can redistribute it and/or modify it under the
		7	# terms of the GNU General Public License as published by the Free Software
		8	# Foundation; either version 2 of the License, or (at your option) any later
		9	# version.
		10	#
		11	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		12	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		13	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License along
		16	# with Koha; if not, write to the Free Software Foundation, Inc.,
		17	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		18
		19	use strict;
		20	use warnings;
		21
		22	use CGI;
		23	use Koha::Database;
		24	use C4::Koha;
		25	use C4::Auth;
		26	use C4::Output;
		27
		28	my $q = CGI->new;
		29	my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
		30	{
		31	template_name => 'acqui/edimsg.tt',
		32	query => $q,
		33	type => 'intranet',
		34	authnotrequired => 0,
		35	flagsrequired => { acquisition => 'manage_edi' },
		36	debug => 1,
		37	}
		38	);
		39	my $msg_id = $q->param('id');
		40	my $schema = Koha::Database->new()->schema();
		41
		42	my $msg = $schema->resultset('EdifactMessage')->find($msg_id);
		43	if ($msg) {
		44	my $transmission = $msg->raw_msg;
		45
		46	my @segments = segmentize($transmission);
		47	$template->param( segments => \@segments );
		48	}
		49	else {
		50	$template->param( no_message => 1 );
		51	}
		52
		53	output_html_with_http_headers( $q, $cookie, $template->output );
		54
		55	sub segmentize {
		56	my $raw = shift;
		57
		58	my $re = qr{
		59	(?> # dont backtrack into this group
		60	[?]. # either the escape character
		61	# followed by any other character
		62	\| # or
		63	[^'?] # a character that is neither escape
		64	# nor split
65	)+
66	}x;
67	my @segmented;
68	while ( $raw =~ /($re)/g ) {
69	push @segmented, "$1'";
70	}
71	return @segmented;
72	}

Line 0 Link Here

(-)a/admin/edi_accounts.pl (+153 lines)
		1	#!/usr/bin/perl
		2
		3	# Copyright 2011,2014 Mark Gavillet & PTFS Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use strict;
		21	use warnings;
		22	use CGI;
		23	use C4::Auth;
		24	use C4::Output;
		25	use Koha::Database;
		26
		27	my $input = CGI->new();
		28
		29	my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
		30	{
		31	template_name => 'admin/edi_accounts.tt',
		32	query => $input,
		33	type => 'intranet',
		34	authnotrequired => 0,
		35	flagsrequired => { acquisition => 'edi_manage' },
		36	}
		37	);
		38
		39	my $op = $input->param('op');
		40	$op \|\|= 'display';
		41	my $schema = Koha::Database->new()->schema();
		42
		43	if ( $op eq 'acct_form' ) {
		44	show_account();
		45	$template->param( acct_form => 1 );
		46	my @vendors = $schema->resultset('Aqbookseller')->search(
		47	undef,
		48	{
		49	columns => [ 'name', 'id' ],
		50	order_by => { -asc => 'name' }
		51	}
		52	);
		53	$template->param( vendors => \@vendors );
		54	$template->param(
		55	code_qualifiers => [
		56	{
		57	code => '14',
		58	description => 'EAN International',
		59	},
		60	{
		61	code => '31B',
		62	description => 'US SAN Agency',
		63	},
		64	{
65	code => '91',
66	description => 'Assigned by supplier',
67	},
68	{
69	code => '92',
70	description => 'Assigned by buyer',
71	},
72	]
73	);
74
75	}
76	elsif ( $op eq 'delete_confirm' ) {
77	show_account();
78	$template->param( delete_confirm => 1 );
79	}
80	else {
81	if ( $op eq 'save' ) {
82
83	# validate & display
84	my $id = $input->param('id');
85	my $fields = {
86	description => $input->param('description'),
87	host => $input->param('host'),
88	username => $input->param('username'),
89	password => $input->param('password'),
90	vendor_id => $input->param('vendor_id'),
91	upload_directory => $input->param('upload_directory'),
92	download_directory => $input->param('download_directory'),
93	san => $input->param('san'),
94	transport => $input->param('transport'),
95	quotes_enabled => defined $input->param('quotes_enabled'),
96	invoices_enabled => defined $input->param('invoices_enabled'),
97	orders_enabled => defined $input->param('orders_enabled'),
98	id_code_qualifier => $input->param('id_code_qualifier'),
99	};
100
101	if ($id) {
102	$schema->resultset('VendorEdiAccount')->search(
103	{
104	id => $id,
105	}
106	)->update_all($fields);
107	}
108	else { # new record
109	$schema->resultset('VendorEdiAccount')->create($fields);
110	}
111	}
112	elsif ( $op eq 'delete_confirmed' ) {
113
114	$schema->resultset('VendorEdiAccount')
115	->search( { id => $input->param('id'), } )->delete_all;
116	}
117
118	# we do a default dispaly after deletes and saves
119	# as well as when thats all you want
120	$template->param( display => 1 );
121	my @ediaccounts = $schema->resultset('VendorEdiAccount')->search(
122	{},
123	{
124	join => 'vendor',
125	}
126	);
127	$template->param( ediaccounts => \@ediaccounts );
128	}
129
130	output_html_with_http_headers( $input, $cookie, $template->output );
131
132	sub get_account {
133	my $id = shift;
134
135	my $account = $schema->resultset('VendorEdiAccount')->find($id);
136	if ($account) {
137	return $account;
138	}
139
140	# passing undef will default to add
141	return;
142	}
143
144	sub show_account {
145	my $acct_id = $input->param('id');
146	if ($acct_id) {
147	my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id);
148	if ($acct) {
149	$template->param( account => $acct );
150	}
151	}
152	return;
153	}

Line 0 Link Here

(-)a/admin/edi_ean_accounts.pl (+158 lines)
		1	#!/usr/bin/perl
		2
		3	# Copyright 2012, 2014 Mark Gavillet & PTFS Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use strict;
		21	use warnings;
		22	use CGI;
		23	use C4::Auth;
		24	use C4::Output;
		25	use Koha::Database;
		26
		27	my $input = CGI->new();
		28
		29	my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
		30	{
		31	template_name => 'admin/edi_ean_accounts.tt',
		32	query => $input,
		33	type => 'intranet',
		34	authnotrequired => 0,
		35	flagsrequired => { acquisition => 'edi_manage' },
		36	}
		37	);
		38
		39	my $schema = Koha::Database->new()->schema();
		40	my $op = $input->param('op');
		41	$op \|\|= 'display';
		42
		43	if ( $op eq 'ean_form' ) {
		44	show_ean();
		45	$template->param( ean_form => 1 );
		46	my @branches = $schema->resultset('Branch')->search(
		47	undef,
		48	{
		49	columns => [ 'branchcode', 'branchname' ],
		50	order_by => 'branchname',
		51	}
		52	);
		53	$template->param( branches => \@branches );
		54	$template->param(
		55	code_qualifiers => [
		56	{
		57	code => '14',
		58	description => 'EAN International',
		59	},
		60	{
		61	code => '31B',
		62	description => 'US SAN Agency',
		63	},
		64	{
65	code => '91',
66	description => 'Assigned by supplier',
67	},
68	{
69	code => '92',
70	description => 'Assigned by buyer',
71	},
72	]
73	);
74
75	}
76	elsif ( $op eq 'delete_confirm' ) {
77	show_ean();
78	$template->param( delete_confirm => 1 );
79	}
80	else {
81	if ( $op eq 'save' ) {
82	my $change = $input->param('oldean');
83	if ($change) {
84	editsubmit();
85	}
86	else {
87	addsubmit();
88	}
89	}
90	elsif ( $op eq 'delete_confirmed' ) {
91	delsubmit();
92	}
93	my @eans = $schema->resultset('EdifactEan')->search(
94	{},
95	{
96	join => 'branch',
97	}
98	);
99	$template->param( display => 1 );
100	$template->param( eans => \@eans );
101	}
102
103	output_html_with_http_headers( $input, $cookie, $template->output );
104
105	sub delsubmit {
106	my $ean = $schema->resultset('EdifactEan')->find(
107	{
108	branchcode => $input->param('branchcode'),
109	ean => $input->param('ean')
110	}
111	);
112	$ean->delete;
113	return;
114	}
115
116	sub addsubmit {
117
118	my $new_ean = $schema->resultset('EdifactEan')->new(
119	{
120	branchcode => $input->param('branchcode'),
121	ean => $input->param('ean'),
122	id_code_qualifier => $input->param('id_code_qualifier'),
123	}
124	);
125	$new_ean->insert();
126	return;
127	}
128
129	sub editsubmit {
130	$schema->resultset('EdifactEan')->search(
131	{
132	branchcode => $input->param('oldbranchcode'),
133	ean => $input->param('oldean'),
134	}
135	)->update_all(
136	{
137	branchcode => $input->param('branchcode'),
138	ean => $input->param('ean'),
139	id_code_qualifier => $input->param('id_code_qualifier'),
140	}
141	);
142	return;
143	}
144
145	sub show_ean {
146	my $branchcode = $input->param('branchcode');
147	my $ean = $input->param('ean');
148	if ( $branchcode && $ean ) {
149	my $e = $schema->resultset('EdifactEan')->find(
150	{
151	ean => $ean,
152	branchcode => $branchcode,
153	}
154	);
155	$template->param( ean => $e );
156	}
157	return;
158	}

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt (+38 lines)
	1	[% INCLUDE 'doc-head-open.inc' %]
	2	<title>Koha &rsaquo; Acquisitions &rsaquo; Basket ([% basketno %])</title>
	3	[% INCLUDE 'doc-head-close.inc' %]
	4
	5	</head>
	6	<body>
	7	[% INCLUDE 'header.inc' %]
	8	[% INCLUDE 'acquisitions-search.inc' %]
	9
	10	<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a> &rsaquo; Basket ([% basketno %])</div>
	11
	12	<div id="doc3" class="yui-t2">
	13
	14	<div id="bd">
	15	<div id="yui-main">
	16	<div class="yui-b">
	17
	18	<h2>Identify the branch account submitting the EDI order</h2>
	19	<br />
	20	<form action="/cgi-bin/koha/acqui/basket.pl" method="get">
	21	<p>Select ordering branch account: </p>
	22	<select id="ean" name="ean">
	23	[% FOREACH eanacct IN eans %]
	24	<option value="[% eanacct.ean %]">[% eanacct.branch.branchname %] ([% eanacct.ean %])</option>
	25	[% END %]
	26	</select>
	27	<br />
	28	<input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
	29	<input type="hidden" value="ediorder" name="op" />
	30	<input type="submit" value="Send EDI order" />
	31	</form>
	32	</div>
	33	</div>
	34	<div class="yui-b">
	35	[% INCLUDE 'acquisitions-menu.inc' %]
	36	</div>
	37	</div>
	38	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt (+86 lines)
		1	[% INCLUDE 'doc-head-open.inc' %]
		2	<title>Koha &rsaquo; Acquisitions</title>
		3	<link rel="stylesheet" type="text/css" href="[% themelang %]/css/datatables.css" />
		4	[% INCLUDE 'doc-head-close.inc' %]
		5	[% INCLUDE 'datatables.inc' %]
		6	<script type="text/javascript">
		7	$(document).ready(function() {
		8	$('#edi_msgs').dataTable($.extend(true, {}, dataTablesDefaults, {
		9	'aaSorting': [[1, "desc" ]],
		10	'sPaginationType': "four_button"
		11	}));
		12	});
		13	</script>
		14
		15	</head>
		16	<body id="acq_edifactmsgs" class="acq">
		17	[% INCLUDE 'header.inc' %]
		18	[% INCLUDE 'acquisitions-search.inc' %]
		19	<div id="breadcrumbs">
		20	<a href="/cgi-bin/koha/mainpage.pl">Home</a>
		21	&rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a>
		22	&rsaquo; <a href="/cgi-bin/koha/acqui/edifactmsgs.pl">Edifact Messages</a>
		23	</div>
		24
		25	<div id="doc3" class="yui-t2">
		26
		27	<div id="bd">
		28	<div id="yui-main">
		29	<div class="yui-b">
		30
		31
		32	<h1>Edifact Messages</h1>
		33	<div id="acqui_edifactmsgs">
		34
		35
		36	<table id="edi_msgs">
		37	<thead>
		38	<th>Type</th>
		39	<th>Transferred</th>
		40	<th>Status</th>
		41	<th>Vendor</th>
		42	<th>Details</th>
		43	<th>Filename</th>
		44	<th> </th>
		45	</thead>
		46	<tbody>
		47	[% FOREACH msg IN messages %]
		48	<tr>
		49	<td>[% msg.message_type %]</td>
		50	<td>[% msg.transfer_date %]</td>
		51	<td>[% msg.status %]</td>
		52	<td>
		53	<a href="/cgi-bin/koha/acqui/supplier.pl?booksellerid=[% msg.vendor_id %]"</a>
		54	[% msg.vendor.name %]
		55	</td>
		56	<td>
		57	[% IF msg.message_type == 'QUOTE' \|\| msg.message_type == 'ORDERS' %]
		58	[% IF msg.basketno %]
		59	<a href="/cgi-bin/koha/acqui/basket.pl?basketno=[% msg.basketno.basketno %]">
		60	Basket: [% msg.basketno.basketno %]
		61	</a>
		62	[% END %]
		63	[% ELSE %]
		64	<!-- Assuming invoices -->
65	<a href="/cgi-bin/koha/acqui/invoices.pl?message_id=[% msg.id %]">
66	Invoices
67	</a>
68	[% END %]
69	</td>
70	</td>
71	<td>[% msg.filename %]</td>
72	<td><a class="popup" target="_blank" title="View Message" href="/cgi-bin/koha/acqui/edimsg.pl?id=[% msg.id %]"</a>View Message</td>
73	</tr>
74	[% END %]
75
76	</tbody>
77	</table>
78
79	</div>
80	</div>
81	</div>
82	<div class="yui-b">
83	[% INCLUDE 'acquisitions-menu.inc' %]
84	</div>
85	</div>
86	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt (+265 lines)
		1	[% INCLUDE 'doc-head-open.inc' %]
		2	<title>Koha &rsaquo; Administration &rsaquo; EDI accounts
		3	[% IF acct_form %]
		4	[% IF account %]
		5	’ Modify account
		6	[% ELSE %]
		7	’ Add new account
		8	[% END %]
		9	[% END %]
		10	[% IF delete_confirm %]
		11	’ Confirm deletion of account
		12	[% END %]
		13	</title>
		14	[% INCLUDE 'doc-head-close.inc' %]
		15	</head>
		16	<body id="admin_edi_acct" class="admin">
		17	[% INCLUDE 'header.inc' %]
		18	[% INCLUDE 'cat-search.inc' %]
		19
		20	<div id="breadcrumbs">
		21	<a href="/cgi-bin/koha/mainpage.pl">Home</a>
		22	&rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a>
		23	&rsaquo; <a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI accounts</a>
		24	[% IF acct_form %]
		25	[% IF account %]
		26	&rsaquo; Modify account
		27	[% ELSE %]
		28	&rsaquo; Add new account
		29	[% END %]
		30	[% ELSIF delete_confirm %]
		31	&rsaquo; Confirm deletion of account
		32	[% ELSE %]
		33	&rsaquo; Accounts
		34	[% END %]
		35	</div>
		36
		37	<div id="doc3" class="yui-t2">
		38
		39	<div id="bd">
		40	<div id="yui-main">
		41	<div class="yui-b">
		42	[% IF display %]
		43	<div id="toolbar" class="btn-toolbar">
		44	<a class="btn btn-small" id="newediacct" href="/cgi-bin/koha/admin/edi_accounts.pl?op=acct_form">
		45	<i class="icon-plus"></i>
		46	New account
		47	</a>
		48	</div>
		49	[% END %]
		50
		51	[% IF acct_form %]
		52	<form action="/cgi-bin/koha/admin/edi_accounts.pl" name="Actform" method="post">
		53	<input type="hidden" name="op" value="save" />
		54	[% IF account %]
		55	<input type="hidden" name="id" value="[% account.id %]" />
		56	[% END %]
		57	<fieldset class="rows">
		58	<legend>
		59	[% IF account %]
		60	Modify account
		61	[% ELSE %]
		62	New account
		63	[% END %]
		64	</legend>
65
66	<ol>
67	<li>
68	<label for="vendor_id">Vendor: </label>
69	<select name="vendor_id" id="vendor_id">
70	[% FOREACH vendor IN vendors %]
71	[% IF account.vendor_id == vendor.id %]
72	<option value="[% vendor.id %]" selected="selected">[% vendor.name %]</option>
73	[% ELSE %]
74	<option value="[% vendor.id %]">[% vendor.name %]</option>
75	[% END %]
76	[% END %]
77	</select>
78	</li>
79	<li>
80	<label for="description">Description: </label>
81	<input type="text" name="description" id="description" size="20" maxlength="90" value="[% account.description %]" />
82	</li>
83	<li>
84	[% transport_types = [
85	'FTP', 'SFTP', 'FILE'
86	]
87	%]
88	<label for="transport">Transport: </label>
89	<select name="transport" title="valid types of transport are FTP and SFTP"
90	id="transport">
91	[% FOREACH transport_type IN transport_types %]
92	[% IF transport_type == account.transport %]
93	<option value="[% transport_type %]" selected="selected">[% transport_type %]</option>
94	[% ELSE %]
95	<option value="[% transport_type %]">[% transport_type %]</option>
96	[% END %]
97	[% END %]
98	</select>
99	</li>
100	<li>
101	<label for="host">Remote host: </label>
102	<input type="text" name="host" id="host" size="20" maxlength="90" value="[% account.host %]" />
103	</li>
104	<li>
105	<label for="username">Username: </label>
106	<input type="text" name="username" id="username" size="20" maxlength="90" value="[% account.username %]" />
107	</li>
108	<li>
109	<label for="password">Password: </label>
110	<input type="text" name="password" id="password" size="20" maxlength="90" value="[% account.password %]" />
111	</li>
112	<li>
113	<label for="download_directory">Download directory: </label>
114	<input type="text" name="download_directory" id="download_directory" size="20" maxlength="90"
115	title="The download directory specifies the directory on the ftpsite from which we download quotes and invoices"
116	value="[% account.download_directory %]" />
117	</li>
118	<li>
119	<label for="upload_directory">Upload directory: </label>
120	<input type="text" name="upload_directory" id="upload_directory" size="20" maxlength="90"
121	title="The upload directory specifies the directory on the ftp site to which we upload orders"
122	value="[% account.upload_directory %]" />
123	</li>
124	<li>
125	<label for="id_code_qualifier">Qualifier:</label>
126	<select name="id_code_qualifier" id="id_code_qualifier">
127	[% FOREACH qualifier IN code_qualifiers %]
128	[% IF qualifier.code == account.id_code_qualifier %]
129	<option value="[% qualifier.code %]" selected="selected">
130	[% qualifier.description %]
131	</option>
132	[% ELSE %]
133	<option value="[% qualifier.code %]">
134	[% qualifier.description %]
135	</option>
136	[% END %]
137	[% END %]
138	</select>
139	</li>
140	<li>
141	<label for="san">SAN: </label>
142	<input type="text" name="san" id="san" size="20" maxlength="90" value="[% account.san %]" />
143	</li>
144	<li>
145	<label for="quotes_enabled">Quotes enabled: </label>
146	<input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" [% IF account.quotes_enabled %]checked[% END %] />
147	</li>
148	<li>
149	<label for="orders_enabled">Orders enabled: </label>
150	<input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" [% IF account.orders_enabled %]checked[% END %] />
151	</li>
152	<li>
153	<label for="invoices_enabled">Invoices enabled: </label>
154	<input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" [% IF account.invoices_enabled %]checked[% END %] />
155	</li>
156	</ol>
157	</fieldset>
158
159	<fieldset class="action">
160	<input type="submit" value="Submit" />
161	<a href="/cgi-bin/koha/admin/edi_accounts.pl" class="cancel">Cancel</a>
162	</fieldset>
163	</form>
164
165	[% END %]
166	[% IF delete_confirm %]
167	<div class="dialog alert">
168	<h3>Delete this account?</h3>
169	<table>
170	<tr>
171	<th>Vendor</th>
172	<td>[% account.vendor %]</td>
173	</tr>
174	<tr>
175	<th>Description</th>
176	<td>[% account.description %]</td>
177	</tr>
178	<tr>
179	<th>SAN</th>
180	<td>[% account.san %]</td>
181	</tr>
182	<tr>
183	<th>Last activity</th>
184	<td>[% account.last_activity %]</td>
185	</tr>
186	</table>
187	<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="post">
188	<table>
189	</table>
190	<input type="hidden" name="op" value="delete_confirmed" />
191	<input type="hidden" name="id" value="[% account.id %]" />
192	<input type="submit" class="approve" value="Yes, Delete" />
193	</form>
194	<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="get">
195	<input type="submit" class="deny" value="No, do not Delete" />
196	</form>
197	[% END %]
198	[% IF display %]
199	<h2>Vendor EDI accounts</h2>
200
201	<table>
202	<tr>
203	<th>ID</th>
204	<th>Vendor</th>
205	<th>Description</th>
206	<th>Transport</th>
207	<th>Remote host</th>
208	<th>Username</th>
209	<th>Password</th>
210	<th>Download Directory</th>
211	<th>Upload Directory</th>
212	<th>id_code_type</th>
213	<th>id_code</th>
214	<th>Quotes</th>
215	<th>Orders</th>
216	<th>Invoices</th>
217	<th>Last activity</th>
218	<th>Actions</th>
219	</tr>
220	[% FOREACH account IN ediaccounts %]
221	[% IF loop.even %]<tr>
222	[% ELSE %]<tr class="highlight">
223	[% END %]
224	<td>[% account.id %]</td>
225	<td><a href="/cgi-bin/koha/acqui/supplier.pl?supplierid=[% account.vendor_id %]">[% account.vendor.name %]</a></td>
226	<td>[% account.description %]</td>
227	<td>[% account.transport %]</td>
228	<td>[% account.host %]</td>
229	<td>[% account.username %]</td>
230	<td>[% IF account.password %]xxxxx[% END %]</td>
231	<td>[% account.download_directory %]</td>
232	<td>[% account.upload_directory %]</td>
233	<td>[% account.id_code_qualifier %]</td>
234	<td>[% account.san %]</td>
235	[% IF account.quotes_enabled %]
236	<td>Y</td>
237	[% ELSE %]
238	<td></td>
239	[% END %]
240	[% IF account.orders_enabled %]
241	<td>Y</td>
242	[% ELSE %]
243	<td></td>
244	[% END %]
245	[% IF account.invoices_enabled %]
246	<td>Y</td>
247	[% ELSE %]
248	<td></td>
249	[% END %]
250	<td>[% account.last_activity %]</td>
251	<td align="center">
252	<a href="/cgi-bin/koha/admin/edi_accounts.pl?op=acct_form&id=[% account.id %]">Edit</a> \| <a href="/cgi-bin/koha/admin/edi_accounts.pl?op=delete_confirm&id=[% account.id %]">Delete</a>
253	</td>
254	</tr>
255	[% END %]
256	</table>
257	[% END %]
258
259	</div>
260	</div>
261	<div class="yui-b">
262	[% INCLUDE 'admin-menu.inc' %]
263	</div>
264	</div>
265	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

(-)a/misc/cronjobs/edi_cron.pl (+111 lines)
		1	#!/usr/bin/perl
		2	#
		3	# Copyright 2013,2014 PTFS Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 2 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use warnings;
		21	use strict;
		22
		23	# Handles all the edi processing for a site
		24	# loops through the vendor_edifact records and uploads and downloads
		25	# edifact files id the appropriate type is enabled
		26	# downloaded quotes and invoices are processed here
		27	# can be run as frequently as required
		28
		29	use C4::Context;
		30	use Log::Log4perl qw(:easy);
		31	use Koha::Database;
		32	use Koha::EDI qw( process_quote process_invoice);
		33	use Koha::Edifact::Transport;
		34
		35	my $logdir = C4::Context->logdir;
		36
		37	# logging set to trace as this may be what you
		38	# want on implementation
		39	Log::Log4perl->easy_init(
		40	{
		41	level => $TRACE,
		42	file => ">>$logdir/editrace.log",
		43	}
		44	);
		45
		46	my $schema = Koha::Database->new()->schema();
		47
		48	my @edi_accts = $schema->resultset('VendorEdiAccount')->all();
		49
		50	my $logger = Log::Log4perl->get_logger();
		51
		52	for my $acct (@edi_accts) {
		53	if ( $acct->quotes_enabled ) {
		54	my $downloader = Koha::Edifact::Transport->new( $acct->id );
		55	$downloader->download_messages('QUOTE');
		56
		57	#update vendor last activity
		58	}
		59
		60	if ( $acct->invoices_enabled ) {
		61	my $downloader = Koha::Edifact::Transport->new( $acct->id );
		62	$downloader->download_messages('INVOICE');
		63
		64	#update vendor last activity
65	}
66	if ( $acct->orders_enabled ) {
67
68	# select pending messages
69	my @pending_orders = $schema->resultset('EdifactMessage')->search(
70	{
71	message_type => 'ORDERS',
72	vendor_id => $acct->vendor_id,
73	status => 'Pending',
74	}
75	);
76	my $uploader = Koha::Edifact::Transport->new( $acct->id );
77	$uploader->upload_messages(@pending_orders);
78	}
79	}
80
81	# process any downloaded quotes
82
83	my @downloaded_quotes = $schema->resultset('EdifactMessage')->search(
84	{
85	message_type => 'QUOTE',
86	status => 'new',
87	}
88	)->all;
89
90	foreach my $quote_file (@downloaded_quotes) {
91	my $filename = $quote_file->filename;
92	$logger->trace("Processing quote $filename");
93	process_quote($quote_file);
94	}
95
96	# process any downloaded invoices
97
98	my @downloaded_invoices = $schema->resultset('EdifactMessage')->search(
99	{
100	message_type => 'INVOICE',
101	status => 'new',
102	}
103	)->all;
104
105	foreach my $invoice (@downloaded_invoices) {
106	my $filename = $invoice->filename();
107	$logger->trace("Processing invoice $filename");
108	process_invoice($invoice);
109	}
110
111	exit 0;

Line 0 Link Here

(-)a/t/EdiInvoice.t (+75 lines)
		1	#!/usr/bin/perl
		2	use strict;
		3	use warnings;
		4	use FindBin qw( $Bin );
		5
		6	use Test::More tests => 19;
		7
		8	BEGIN { use_ok('Koha::Edifact') }
		9
		10	my $invoice_file = "$Bin/BLSINV337023.CEI";
		11
		12	my $invoice = Koha::Edifact->new( { filename => $invoice_file, } );
		13
		14	isa_ok( $invoice, 'Koha::Edifact' );
		15	my $x = $invoice->interchange_header('sender');
		16	my $control_reference = '337023';
		17	is( $x, '5013546025078', "sender returned" );
		18
		19	$x = $invoice->interchange_header('recipient');
		20	is( $x, '5013546121974', "recipient returned" );
		21	$x = $invoice->interchange_header('datetime');
		22	is( $x->[0], '140729', "datetime returned" );
		23	$x = $invoice->interchange_header('interchange_control_reference');
		24	is( $x, $control_reference, "interchange_control_reference returned" );
		25
		26	$x = $invoice->interchange_header('application_reference');
		27	is( $x, 'INVOIC', "application_reference returned" );
		28	$x = $invoice->interchange_trailer('interchange_control_count');
		29	is( $x, 6, "interchange_control_count returned" );
		30
		31	my $messages = $invoice->message_array();
		32
		33	# check inv number from BGM
		34
		35	my $msg_count = @{$messages};
		36	is( $msg_count, 6, 'correct message count returned' );
		37
		38	is( $messages->[0]->message_type, 'INVOIC', 'Message shows correct type' );
		39
		40	my $expected_date = '20140729';
		41	is( $messages->[0]->message_date,
		42	$expected_date, 'Message date correctly returned' );
		43	is( $messages->[0]->tax_point_date,
		44	$expected_date, 'Tax point date correctly returned' );
		45
		46	my $expected_invoicenumber = '01975490';
		47
		48	my $invoicenumber = $messages->[1]->docmsg_number();
		49
		50	is( $messages->[0]->buyer_ean, '5013546121974', 'Buyer ean correct' );
		51	is( $messages->[0]->supplier_ean, '5013546025078', 'Supplier ean correct' );
		52
		53	is( $invoicenumber, $expected_invoicenumber,
		54	'correct invoicenumber extracted' );
		55
		56	my $lines = $messages->[1]->lineitems();
		57
		58	my $num_lines = @{$lines};
		59
		60	is( $num_lines, 8, "Correct number of lineitems returned" );
		61
		62	# sample invoice was from an early version where order was formatted basketno/ordernumber
		63	my $expected_ordernumber = '2818/74593';
		64
65	my $ordernumber = $lines->[7]->ordernumber;
66
67	is( $ordernumber, $expected_ordernumber, 'correct ordernumber returned' );
68
69	my $lineprice = $lines->[7]->price_net;
70
71	is( $lineprice, 4.55, 'correct net line price returned' );
72
73	my $tax = $lines->[7]->tax;
74
75	is( $tax, 0, 'correct tax amount returned' );

Line 0 Link Here

(-)a/t/Edifact.t (+90 lines)
		1	#!/usr/bin/perl
		2	use strict;
		3	use warnings;
		4	use FindBin qw( $Bin );
		5
		6	use Test::More tests => 27;
		7
		8	BEGIN { use_ok('Koha::Edifact') }
		9
		10	my $filename = "$Bin/prquotes_73050_20140430.CEQ";
		11
		12	my $quote = Koha::Edifact->new( { filename => $filename, } );
		13
		14	isa_ok( $quote, 'Koha::Edifact' );
		15
		16	my $x = $quote->interchange_header('sender');
		17	is( $x, '5013546027856', "sender returned" );
		18
		19	$x = $quote->interchange_header('recipient');
		20	is( $x, '5030670137480', "recipient returned" );
		21	$x = $quote->interchange_header('datetime');
		22	is( $x->[0], '140430', "datetime returned" );
		23	my $control_reference = 'EDIQ2857763';
		24	$x = $quote->interchange_header('interchange_control_reference');
		25	is( $x, $control_reference, "interchange_control_reference returned" );
		26
		27	$x = $quote->interchange_header('application_reference');
		28	is( $x, 'QUOTES', "application_reference returned" );
		29
		30	$x = $quote->interchange_trailer('interchange_control_count');
		31	is( $x, 1, "interchange_control_count returned" );
		32
		33	my $msgs = $quote->message_array();
		34	my $msg_count = @{$msgs};
		35	is( $msg_count, 1, "correct message count returned" );
		36	my $m = $msgs->[0];
		37
		38	is( $m->message_type, 'QUOTES', "Message shows correct type" );
		39	is( $m->message_reference_number,
		40	'MQ09791', "Message reference number returned" );
		41	is( $m->docmsg_number, 'Q741588', "Message docmsg number returned" );
		42	is( $m->message_date, '20140430', "Message date returned" );
		43
		44	my $lin = $m->lineitems();
		45
		46	my $num_lines = @{$lin};
		47	is( $num_lines, 18, 'Correct number of lines in message' );
		48
		49	my $test_line = $lin->[-1];
		50
		51	is( $test_line->line_item_number, 18, 'correct line number returned' );
		52	is( $test_line->item_number_id, '9780273761006', 'correct ean returned' );
		53	is( $test_line->quantity, 1, 'quantity returned' );
		54
		55	my $test_title = 'International business [electronic resource]';
		56	my $marcrec = $test_line->marc_record;
		57	isa_ok( $marcrec, 'MARC::Record' );
		58
		59	my $title = $test_line->title();
		60
		61	# also tests components are concatenated
		62	is( $title, $test_title, "Title returned" );
		63
		64	# problems currently with the record (needs leader ??)
65	#is( $marcrec->title(), $test_title, "Title returned from marc");
66	my $test_author = q{Rugman, Alan M.};
67	is( $test_line->author, $test_author, "Author returned" );
68	is( $test_line->publisher, 'Pearson Education', "Publisher returned" );
69	is( $test_line->publication_date, q{2012.}, "Pub. date returned" );
70	#
71	# Test data encoded in GIR
72	#
73	my $stock_category = $test_line->girfield('stock_category');
74	is( $stock_category, 'EBOOK', "stock_category returned" );
75	my $branch = $test_line->girfield('branch');
76	is( $branch, 'ELIB', "branch returned" );
77	my $fund_allocation = $test_line->girfield('fund_allocation');
78	is( $fund_allocation, '660BOO_2013', "fund_allocation returned" );
79	my $collection_code = $test_line->girfield('collection_code');
80	is( $collection_code, 'EBOO', "collection_code returned" );
81
82	#my $shelfmark = $test_line->girfield('shelfmark');
83	#my $classification = $test_line->girfield('classification');
84
85	## text the free_text returned from the line
86	my $test_line_2 = $lin->[12];
87
88	my $ftx_string = 'E610.72 - additional items';
89
90	is( $test_line_2->free_text, $ftx_string, "ftx note retrieved" );

Line 0 Link Here

(-)a/t/Ediorder.t (+56 lines)
	1	#!/usr/bin/perl
	2	use strict;
	3	use warnings;
	4	use FindBin qw( $Bin );
	5
	6	use Test::More tests => 6;
	7
	8	BEGIN { use_ok('Koha::Edifact::Order') }
	9
	10
	11	# The following tests are for internal methods but they could
	12	# error spectacularly so yest
	13	# Check that quoting is done correctly
	14	#
	15	my $processed_text =
	16	Koha::Edifact::Order::encode_text(q{string containing ?,',:,+});
	17
	18	cmp_ok(
	19	$processed_text, 'eq',
	20	q{string containing ??,?',?:,?+},
	21	'Outgoing text correctly quoted'
	22	);
	23
	24	# extend above test to test chunking in imd_segment
	25	#
	26	my $code = '010';
	27	my $data_to_encode = $processed_text;
	28
	29	my @segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
	30
	31	my $testseg = "IMD+L+010+:::$processed_text";
	32	$testseg .= q{'}; # add segment terminator
	33
	34	cmp_ok( $segs[0], 'eq', $testseg, 'IMD segment correctly formed' );
	35
	36	$data_to_encode = 'A' x 35;
	37	$data_to_encode .= 'B' x 35;
	38	$data_to_encode .= 'C' x 10;
	39
	40	@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
	41
	42	cmp_ok(
	43	$segs[0],
	44	'eq',
	45	q{IMD+L+010+:::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA:BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB'},
	46	'IMD segment correctly chunked'
	47	);
	48	cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC'},
	49	'IMD segment correctly split across segments' );
	50
	51	$data_to_encode .= '??';
	52
	53	# this used to cause an infinite loop
	54	@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
	55	cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'},
	56	'IMD segment deals with quoted character at end' );