Attachment #49037 for bug #7736

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

Lines 2478-2483 sub GetInvoices { Link Here

(-)a/C4/Acquisition.pm (-1 / +5 lines)
2478	push @bind_strs, " borrowers.branchcode = ? ";	2478	push @bind_strs, " borrowers.branchcode = ? ";
2479	push @bind_args, $args{branchcode};	2479	push @bind_args, $args{branchcode};
2480	}	2480	}
		2481	if($args{message_id}) {
		2482	push @bind_strs, " aqinvoices.message_id = ? ";
		2483	push @bind_args, $args{message_id};
		2484	}
2481		2485
2482	$query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;	2486	$query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2483	$query .= " GROUP BY aqinvoices.invoiceid ";	2487	$query .= " GROUP BY aqinvoices.invoiceid ";
Lines 2602-2608 sub AddInvoice { Link Here
2602	return unless(%invoice and $invoice{invoicenumber});	2606	return unless(%invoice and $invoice{invoicenumber});
2603		2607
2604	my @columns = qw(invoicenumber booksellerid shipmentdate billingdate	2608	my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2605	closedate shipmentcost shipmentcost_budgetid);	2609	closedate shipmentcost shipmentcost_budgetid message_id);
2606		2610
2607	my @set_strs;	2611	my @set_strs;
2608	my @set_args;	2612	my @set_args;

Lines 787-792 our $PERL_DEPS = { Link Here

(-)a/C4/Installer/PerlDependencies.pm (+10 lines)
787	'required' => '0',	787	'required' => '0',
788	'min_ver' => '0.56',	788	'min_ver' => '0.56',
789	},	789	},
		790	'Net::SFTP::Foreign' => {
		791	'usage' => 'Edifact',
		792	'required' => '0',
		793	'min_ver' => '1.73',
		794	},
		795	'Text::Unidecode' => {
		796	'usage' => 'Edifact',
		797	'required' => '0',
		798	'min_ver' => '0.04',
		799	},
790	};	800	};
791		801
792	1;	802	1;




package Koha::EDI;

# Copyright 2014,2015 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 utf8;
use Carp;
use English qw{ -no_match_vars };
use Business::ISBN;
use DateTime;
use C4::Context;
use Koha::Database;
use C4::Acquisition qw( NewBasket CloseBasket ModOrder);
use C4::Suggestions qw( ModSuggestion );
use C4::Items qw(AddItem);
use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
use Koha::Edifact::Order;
use Koha::Edifact;
use Log::Log4perl;
use Text::Unidecode;

our $VERSION = 1.1;
our @EXPORT_OK =
  qw( process_quote process_invoice process_ordrsp 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 $schema = Koha::Database->new()->schema();

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

    if ( !@orderlines ) {
        carp "No orderlines for basket $basketno";
        return;
    }

    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 $dbh     = C4::Context->dbh;
    my $arr_ref = $dbh->selectcol_arrayref(
'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
        {}, $basketno
    );
    my $response = @{$arr_ref} ? 1 : 0;

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

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

    # ingest result
    if ($order_file) {
        my $m = unidecode($order_file);  # remove diacritics and non-latin chars
        if ($noingest) {                 # allows scripts to produce test files
            return $m;
        }
        my $order = {
            message_type  => 'ORDERS',
            raw_msg       => $m,
            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_ordrsp {
    my $response_message = shift;
    $response_message->status('processing');
    $response_message->update;
    my $schema = Koha::Database->new()->schema();
    my $logger = Log::Log4perl->get_logger();
    my $vendor_acct;
    my $edi =
      Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
    my $messages = $edi->message_array();

    if ( @{$messages} ) {
        foreach my $msg ( @{$messages} ) {
            my $lines = $msg->lineitems();
            foreach my $line ( @{$lines} ) {
                my $ordernumber = $line->ordernumber();

       # action cancelled:change_requested:no_action:accepted:not_found:recorded
                my $action = $line->action_notification();
                if ( $action eq 'cancelled' ) {
                    my $reason = $line->coded_orderline_text();
                    ModOrder(
                        {
                            ordernumber             => $ordernumber,
                            cancellationreason      => $reason,
                            orderstatus             => 'cancelled',
                            datecancellationprinted => DateTime->now()->ymd(),
                        }
                    );
                }
                else {    # record order as due with possible further info

                    my $report     = $line->coded_orderline_text();
                    my $date_avail = $line->availability_date();
                    $report ||= q{};
                    if ($date_avail) {
                        $report .= " Available: $date_avail";
                    }
                    ModOrder(
                        {
                            ordernumber      => $ordernumber,
                            suppliers_report => $report,
                        }
                    );
                }
            }
        }
    }

    $response_message->status('received');
    $response_message->update;
    return;
}

sub process_invoice {
    my $invoice_message = shift;
    $invoice_message->status('processing');
    $invoice_message->update;
    my $schema = Koha::Database->new()->schema();
    my $logger = Log::Log4perl->get_logger();
    my $vendor_acct;
    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 $new_invoice = $schema->resultset('Aqinvoice')->create(
                {
                    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,
                }
            );
            my $invoiceid = $new_invoice->invoiceid;
            $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 );

                my $order = $schema->resultset('Aqorder')->find($ordernumber);

      # ModReceiveOrder does not validate that $ordernumber exists validate here
                if ($order) {

                    # check suggestions
                    my $s = $schema->resultset('Suggestion')->search(
                        {
                            biblionumber => $order->biblionumber->biblionumber,
                        }
                    )->single;
                    if ($s) {
                        ModSuggestion(
                            {
                                suggestionid => $s->suggestionid,
                                STATUS       => 'AVAILABLE',
                            }
                        );
                    }

                    my $price = _get_invoiced_price($line);

                    if ( $order->quantity > $line->quantity ) {
                        my $ordered = $order->quantity;

                        # part receipt
                        $order->orderstatus('partial');
                        $order->quantity( $ordered - $line->quantity );
                        $order->update;
                        my $received_order = $order->copy(
                            {
                                ordernumber      => undef,
                                quantity         => $line->quantity,
                                quantityreceived => $line->quantity,
                                orderstatus      => 'complete',
                                unitprice        => $price,
                                invoiceid        => $invoiceid,
                                datereceived     => $msg_date,
                            }
                        );
                        transfer_items( $schema, $line, $order,
                            $received_order );
                        receipt_items( $schema, $line,
                            $received_order->ordernumber );
                    }
                    else {    # simple receipt all copies on order
                        $order->quantityreceived( $line->quantity );
                        $order->datereceived($msg_date);
                        $order->invoiceid($invoiceid);
                        $order->unitprice($price);
                        $order->orderstatus('complete');
                        $order->update;
                        receipt_items( $schema, $line, $ordernumber );
                    }
                }
                else {
                    $logger->error(
                        "No order found for $ordernumber Invoice:$invoicenumber"
                    );
                    next;
                }

            }

        }
    }

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

sub _get_invoiced_price {
    my $line  = shift;
    my $price = $line->price_net;
    if ( !defined $price ) {  # no net price so generate it from lineitem amount
        $price = $line->amt_lineitem;
        if ( $price and $line->quantity > 1 ) {
            $price /= $line->quantity;    # div line cost by qty
        }
    }
    return $price;
}

sub receipt_items {
    my ( $schema, $inv_line, $ordernumber ) = @_;
    my $logger   = Log::Log4perl->get_logger();
    my $quantity = $inv_line->quantity;

    # itemnumber is not a foreign key ??? makes this a bit cumbersome
    my @item_links = $schema->resultset('AqordersItem')->search(
        {
            ordernumber => $ordernumber,
        }
    );
    my %branch_map;
    foreach my $ilink (@item_links) {
        my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
        if ( !$item ) {
            my $i = $ilink->itemnumber;
            $logger->warn(
                "Cannot find aqorder item for $i :Order:$ordernumber");
            next;
        }
        my $b = $item->homebranch->branchcode;
        if ( !exists $branch_map{$b} ) {
            $branch_map{$b} = [];
        }
        push @{ $branch_map{$b} }, $item;
    }
    my $gir_occurence = 0;
    while ( $gir_occurence < $quantity ) {
        my $branch = $inv_line->girfield( 'branch', $gir_occurence );
        my $item = shift @{ $branch_map{$branch} };
        if ($item) {
            my $barcode = $inv_line->girfield( 'barcode', $gir_occurence );
            if ( $barcode && !$item->barcode ) {
                my $rs = $schema->resultset('Item')->search(
                    {
                        barcode => $barcode,
                    }
                );
                if ( $rs->count > 0 ) {
                    $logger->warn("Barcode $barcode is a duplicate");
                }
                else {

                    $logger->trace("Adding barcode $barcode");
                    $item->barcode($barcode);
                }
            }

            $item->update;
        }
        else {
            $logger->warn("Unmatched item at branch:$branch");
        }
        ++$gir_occurence;
    }
    return;

}

sub transfer_items {
    my ( $schema, $inv_line, $order_from, $order_to ) = @_;

    # Transfer x items from the orig order to a completed partial order
    my $quantity = $inv_line->quantity;
    my $gocc     = 0;
    my %mapped_by_branch;
    while ( $gocc < $quantity ) {
        my $branch = $inv_line->girfield( 'branch', $gocc );
        if ( !exists $mapped_by_branch{$branch} ) {
            $mapped_by_branch{$branch} = 1;
        }
        else {
            $mapped_by_branch{$branch}++;
        }
        ++$gocc;
    }
    my $logger = Log::Log4perl->get_logger();
    my $o1     = $order_from->ordernumber;
    my $o2     = $order_to->ordernumber;
    $logger->warn("transferring $quantity copies from order $o1 to order $o2");

    my @item_links = $schema->resultset('AqordersItem')->search(
        {
            ordernumber => $order_from->ordernumber,
        }
    );
    foreach my $ilink (@item_links) {
        my $ino      = $ilink->itemnumber;
        my $item     = $schema->resultset('Item')->find( $ilink->itemnumber );
        my $i_branch = $item->homebranch;
        if ( exists $mapped_by_branch{$i_branch}
            && $mapped_by_branch{$i_branch} > 0 )
        {
            $ilink->ordernumber( $order_to->ordernumber );
            $ilink->update;
            --$quantity;
            --$mapped_by_branch{$i_branch};
            $logger->warn("Transferred item $item");
        }
        else {
            $logger->warn("Skipped item $item");
        }
        if ( $quantity < 1 ) {
            last;
        }
    }

    return;
}

sub process_quote {
    my $quote = shift;

    $quote->status('processing');
    $quote->update;

    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 $schema         = Koha::Database->new()->schema();
    my $message_count  = 0;
    my @added_baskets;    # if auto & multiple baskets need to order all

    if ( @{$messages} && $quote->vendor_id ) {
        foreach my $msg ( @{$messages} ) {
            ++$message_count;
            my $basketno =
              NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
                q{} . q{} );
            push @added_baskets, $basketno;
            if ( $message_count > 1 ) {
                my $m_filename = $quote->filename;
                $m_filename .= "_$message_count";
                $schema->resultset('EdifactMessage')->create(
                    {
                        message_type  => $quote->message_type,
                        transfer_date => $quote->transfer_date,
                        vendor_id     => $quote->vendor_id,
                        edi_acct      => $quote->edi_acct,
                        status        => 'recmsg',
                        basketno      => $basketno,
                        raw_msg       => q{},
                        filename      => $m_filename,
                    }
                );
            }
            else {
                $quote->basketno($basketno);
            }
            $logger->trace("Created basket :$basketno");
            my $items  = $msg->lineitems();
            my $refnum = $msg->message_refno;

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

    $quote->status($status);
    $quote->update;    # status and basketno link
                       # Do we automatically generate orders for this vendor
    my $v = $schema->resultset('VendorEdiAccount')->search(
        {
            vendor_id => $quote->vendor_id,
        }
    )->single;
    if ( $v->auto_orders ) {
        for my $b (@added_baskets) {
            create_edi_order(
                {

                    basketno => $b,
                }
            );
            CloseBasket($b);
        }
    }

    return;
}

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

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

    # create biblio record
    my $logger = Log::Log4perl->get_logger();
    if ( !$basketno ) {
        $logger->error('Skipping order creation no basketno');
        return;
    }
    $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 = {};
        my $bib_record = _create_bib_from_quote( $item, $quote );
        ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
          AddBiblio( $bib_record, q{} );
        $logger->trace("New biblio added $bib->{biblionumber}");
    }
    else {
        $logger->trace("Match found: $bib->{biblionumber}");
    }

    # Create an orderline
    my $order_note = $item->{orderline_free_text};
    $order_note ||= q{};
    my $order_quantity = $item->quantity();
    my $gir_count      = $item->number_of_girs();
    $order_quantity ||= 1;    # quantity not necessarily present
    if ( $gir_count > 1 ) {
        if ( $gir_count != $order_quantity ) {
            $logger->error(
                "Order for $order_quantity items, $gir_count segments present");
        }
        $order_quantity = 1;    # attempts to create an orderline for each gir
    }

    # database definitions should set some of these defaults but dont
    my $order_hash = {
        biblionumber       => $bib->{biblionumber},
        entrydate          => DateTime->now( time_zone => 'local' )->ymd(),
        basketno           => $basketno,
        listprice          => $item->price,
        quantity           => $order_quantity,
        quantityreceived   => 0,
        order_vendornote   => q{},
        order_internalnote => $order_note,
        rrp                => $item->price,
        ecost => _discounted_price( $quote->vendor->discount, $item->price ),
        uncertainprice => 0,
        sort1          => q{},
        sort2          => q{},
    };

    # suppliers references
    if ( $item->reference() ) {
        $order_hash->{suppliers_reference_number}    = $item->reference;
        $order_hash->{suppliers_reference_qualifier} = 'QLI';
    }
    elsif ( $item->orderline_reference_number() ) {
        $order_hash->{suppliers_reference_number} =
          $item->orderline_reference_number;
        $order_hash->{suppliers_reference_qualifier} = 'SLI';
    }
    if ( $item->item_number_id ) {    # suppliers ean
        $order_hash->{line_item_id} = $item->item_number_id;
    }

    if ( $item->girfield('servicing_instruction') ) {
        my $occ = 0;
        my $txt = q{};
        my $si;
        while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
            if ($occ) {
                $txt .= q{: };
            }
            $txt .= $si;
            ++$occ;
        }
        $order_hash->{order_vendornote} = $txt;
    }

    if ( $item->internal_notes() ) {
        if ( $order_hash->{order_internalnote} ) {    # more than ''
            $order_hash->{order_internalnote} .= q{ };
        }
        $order_hash->{order_internalnote} .= $item->internal_notes;
    }

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

    my $skip = '0';
    if ( !$budget ) {
        if ( $item->quantity > 1 ) {
            carp 'Skipping line with no budget info';
            $logger->trace('girfield skipped for invalid budget');
            $skip++;
        }
        else {
            carp 'Skipping line with no budget info';
            $logger->trace('orderline skipped for invalid budget');
            return;
        }
    }

    my %ordernumber;
    my %budgets;
    my $item_hash;

    if ( !$skip ) {
        $order_hash->{budget_id} = $budget->budget_id;
        my $first_order = $schema->resultset('Aqorder')->create($order_hash);
        my $o           = $first_order->ordernumber();
        $logger->trace("Order created :$o");

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

        # add to $budgets to prevent duplicate orderlines
        $budgets{ $budget->budget_id } = '1';

        # record ordernumber against budget
        $ordernumber{ $budget->budget_id } = $o;

        if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
            $item_hash = _create_item_from_quote( $item, $quote );

            my $created = 0;
            while ( $created < $order_quantity ) {
                my $itemnumber;
                ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber )
                  = AddItem( $item_hash, $bib->{biblionumber} );
                $logger->trace("Added item:$itemnumber");
                $schema->resultset('AqordersItem')->create(
                    {
                        ordernumber => $first_order->ordernumber,
                        itemnumber  => $itemnumber,
                    }
                );
                ++$created;
            }
        }
    }

    if ( $order_quantity == 1 && $item->quantity > 1 ) {
        my $occurence = 1;    # occ zero already added
        while ( $occurence < $item->quantity ) {

            # check budget code
            $budget = _get_budget( $schema,
                $item->girfield( 'fund_allocation', $occurence ) );

            if ( !$budget ) {
                my $bad_budget =
                  $item->girfield( 'fund_allocation', $occurence );
                carp 'Skipping line with no budget info';
                $logger->trace(
                    "girfield skipped for invalid budget:$bad_budget");
                ++$occurence;    ## lets look at the next one not this one again
                next;
            }

            # add orderline for NEW budget in $budgets
            if ( !exists $budgets{ $budget->budget_id } ) {

                # $order_hash->{quantity} = 1; by default above
                # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here

                $order_hash->{budget_id} = $budget->budget_id;

                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();

                # add to $budgets to prevent duplicate orderlines
                $budgets{ $budget->budget_id } = '1';

                # record ordernumber against budget
                $ordernumber{ $budget->budget_id } = $o;

                if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
                    if ( !defined $item_hash ) {
                        $item_hash = _create_item_from_quote( $item, $quote );
                    }
                    my $new_item = {
                        itype =>
                          $item->girfield( 'stock_category', $occurence ),
                        location =>
                          $item->girfield( 'collection_code', $occurence ),
                        itemcallnumber =>
                          $item->girfield( 'shelfmark', $occurence )
                          || $item->girfield( 'classification', $occurence )
                          || title_level_class($item),
                        holdingbranch =>
                          $item->girfield( 'branch', $occurence ),
                        homebranch => $item->girfield( 'branch', $occurence ),
                    };
                    if ( $new_item->{itype} ) {
                        $item_hash->{itype} = $new_item->{itype};
                    }
                    if ( $new_item->{location} ) {
                        $item_hash->{location} = $new_item->{location};
                    }
                    if ( $new_item->{itemcallnumber} ) {
                        $item_hash->{itemcallnumber} =
                          $new_item->{itemcallnumber};
                    }
                    if ( $new_item->{holdingbranch} ) {
                        $item_hash->{holdingbranch} =
                          $new_item->{holdingbranch};
                    }
                    if ( $new_item->{homebranch} ) {
                        $item_hash->{homebranch} = $new_item->{homebranch};
                    }

                    my $itemnumber;
                    ( undef, undef, $itemnumber ) =
                      AddItem( $item_hash, $bib->{biblionumber} );
                    $logger->trace("New item $itemnumber added");
                    $schema->resultset('AqordersItem')->create(
                        {
                            ordernumber => $new_order->ordernumber,
                            itemnumber  => $itemnumber,
                        }
                    );
                }

                ++$occurence;
            }

            # increment quantity in orderline for EXISTING budget in $budgets
            else {
                my $row = $schema->resultset('Aqorder')->find(
                    {
                        ordernumber => $ordernumber{ $budget->budget_id }
                    }
                );
                if ($row) {
                    my $qty = $row->quantity;
                    $qty++;
                    $row->update(
                        {
                            quantity => $qty,
                        }
                    );
                }

                if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
                    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 )
                          || $item_hash->{itemcallnumber},
                        holdingbranch =>
                          $item->girfield( 'branch', $occurence ),
                        homebranch => $item->girfield( 'branch', $occurence ),
                    };
                    my $itemnumber;
                    ( undef, undef, $itemnumber ) =
                      AddItem( $new_item, $bib->{biblionumber} );
                    $logger->trace("New item $itemnumber added");
                    $schema->resultset('AqordersItem')->create(
                        {
                            ordernumber => $ordernumber{ $budget->budget_id },
                            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];
    }
    elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
        my $tarr = $dbh->selectall_arrayref(
'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
            { Slice => {} },
            $isbn
        );
        if ( @{$tarr} ) {
            return $tarr->[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 ) = @_;
    my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
        {
            budget_period_active => 1,
        }
    );

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

# try to get title level classification from incoming quote
sub title_level_class {
    my ($item)         = @_;
    my $class          = q{};
    my $default_scheme = C4::Context->preference('DefaultClassificationSource');
    if ( $default_scheme eq 'ddc' ) {
        $class = $item->dewey_class();
    }
    elsif ( $default_scheme eq 'lcc' ) {
        $class = $item->lc_class();
    }
    if ( !$class ) {
        $class =
             $item->girfield('shelfmark')
          || $item->girfield('classification')
          || q{};
    }
    return $class;
}

sub _create_bib_from_quote {

    #TBD we should flag this for updating from an external source
    #As biblio (&biblioitems) has no candidates flag in order
    my ( $item, $quote ) = @_;
    my $itemid = $item->item_number_id;
    my $defalt_classification_source =
      C4::Context->preference('DefaultClassificationSource');
    my $bib_hash = {
        'biblioitems.cn_source' => $defalt_classification_source,
        'items.cn_source'       => $defalt_classification_source,
        'items.notforloan'      => -1,
        'items.cn_sort'         => 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');

    # If we have a 13 digit id we are assuming its an ean
    # (it may also be an isbn or issn)
    if ( $itemid =~ /^\d{13}$/ ) {
        $bib_hash->{'biblioitems.ean'} = $itemid;
        if ( $itemid =~ /^977/ ) {
            $bib_hash->{'biblioitems.issn'} = $itemid;
        }
    }
    for my $key ( keys %{$bib_hash} ) {
        if ( !defined $bib_hash->{$key} ) {
            delete $bib_hash->{$key};
        }
    }
    return TransformKohaToMarc($bib_hash);

}

sub _create_item_from_quote {
    my ( $item, $quote ) = @_;
    my $defalt_classification_source =
      C4::Context->preference('DefaultClassificationSource');
    my $item_hash = {
        cn_source  => $defalt_classification_source,
        notforloan => -1,
        cn_sort    => q{},
    };
    $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 $note = {};

    $item_hash->{itemcallnumber} =
         $item->girfield('shelfmark')
      || $item->girfield('classification')
      || title_level_class($item);

    my $branch = $item->girfield('branch');
    $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
    return $item_hash;
}

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

    no meaningful return value

=head2 process_ordrsp

     process_ordrsp(ordrsp_message)

     passed a message object for a supplier response, process the contents
     If an orderline is cancelled cancel the corresponding orderline in koha
     otherwise record the supplier message against it

     no meaningful return value

=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 receipt_items

    receipt_items( schema_obj, invoice_line, ordernumber)

    receipts the items recorded on this invoice line

    no meaningful return

=head2 transfer_items

    transfer_items(schema, invoice_line, originating_order, receiving_order)

    Transfer the items covered by this invoice line from their original
    order to another order recording the partial fulfillment of the original
    order

    no meaningful return

=head2 get_edifact_ean

    $ean = get_edifact_ean();

    routine to return the 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

     Returns 1 on success undef on error

     Most usual cause of error is a line with no or incorrect budget codes
     which woild cause order creation to abort
     If other correct lines exist these are processed and the erroneous line os logged

=head2 title_level_class

      classmark = title_level_class(edi_item)

      Trys to return a title level classmark from a quote message line
      Will return a dewey or lcc classmark if one exists according to the
      value in DefaultClassificationSource syspref

      If unable to returns the shelfmark or classification from the GIR segment

      If all else fails returns empty string

=head2 _create_bib_from_quote

       marc_record_obj = _create_bib_from_quote(lineitem, quote)

       Returns a MARC::Record object based on the  info in the quote's lineitem

=head2 _create_item_from_quote

       item_hashref = _create_item_from_quote( lineitem, quote)

       returns a hashref representing the item fields specified in the quote

=head2 _get_invoiced_price

      _get_invoiced_price(line_object)

      Returns the net price or an equivalent calculated from line cost / qty

=head2 _discounted_price

      ecost = _discounted_price(discount, item_price)

      utility subroutine to return a price calculated from the
      vendors discount and quoted price

=head2 _check_for_existing_bib

     (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)

     passed an isbn or ean attempts to locate a match bib
     On success returns biblionumber and biblioitemnumber
     On failure returns undefined/an empty list

=head2 _get_budget

     b = _get_budget(schema_obj, budget_code)

     Returns the Aqbudget object for the active budget given the passed budget_code
     or undefined if one does not exist

=head1 AUTHOR

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


=head1 COPYRIGHT

   Copyright 2014,2015 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,2015 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 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

Edifact - Edifact message handler

=head1 DESCRIPTION

   Koha module for parsing Edifact messages

=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 object
     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 _init

  Called by the constructor to do the parsing of the transmission

=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

    We preserve this info but will have converted to utf-8 on ingest

=head1 AUTHOR

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


=head1 COPYRIGHT

   Copyright 2014,2015, 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, 2015 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 utf8;

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 $id     = $lin->elem( 2, 0 );    # may be undef in ordrsp
    my $action = $lin->elem( 1, 0 );
    my $d      = {
        line_item_number       => $lin->elem(0),
        action_notification    => $action,
        item_number_id         => $id,
        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' ) {
            if ( $s->elem( 0, 0 ) eq '44' ) {
                $d->{availability_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);
            }
            else {
                my $gir = extract_gir($s);
                if ( $gir->{copy} ) {    # may have to merge
                    foreach my $g ( @{ $d->{GIR} } ) {
                        if ( $gir->{copy} eq $g->{copy} ) {
                            foreach my $field ( keys %{$gir} ) {
                                if ( !exists $g->{$field} ) {
                                    $g->{$field} = $gir->{$field};
                                }
                            }
                            undef $gir;
                            last;
                        }
                    }
                    if ( defined $gir ) {
                        push @{ $d->{GIR} }, $gir;
                    }
                }
            }
        }
        elsif ( $s->tag eq 'FTX' ) {

            my $type  = $s->elem(0);
            my $ctype = 'coded_free_text';
            if ( $type eq 'LNO' ) {    # Ingrams Oasis Internal Notes field
                $type  = 'internal_notes';
                $ctype = 'coded_internal_note';
            }
            elsif ( $type eq 'LIN' ) {
                $type  = 'orderline_free_text';
                $ctype = 'coded_orderline_text';
            }
            elsif ( $type eq 'SUB' ) {
                $type = 'coded_substitute_text';
            }
            else {
                $type = 'free_text';
            }

            my $coded_text = $s->elem(2);
            if ( ref $coded_text eq 'ARRAY' && $coded_text->[0] ) {
                $d->{$ctype}->{table} = $coded_text->[1];
                $d->{$ctype}->{code}  = $coded_text->[0];
            }

            my $ftx = $s->elem(3);
            if ( ref $ftx eq 'ARRAY' ) {   # it comes in 70 character components
                $ftx = join q{ }, @{$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 reference
                $d->{reference} = $s->elem( 0, 1 );
            }
            elsif ( $qualifier eq 'LI' ) {    # Buyer's unique orderline number
                $d->{ordernumber} = $s->elem( 0, 1 );
            }
            elsif ( $qualifier eq 'SLI' )
            {    # Suppliers unique order line reference number
                $d->{orderline_reference_number} = $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 action_notification {
    my $self = shift;
    my $a    = $self->{action_notification};
    if ($a) {
        $a = _translate_action($a);    # return the associated text string
    }
    return $a;
}

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 orderline_reference_number {
    my $self = shift;
    return $self->{orderline_reference_number};
}

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

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

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

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

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

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

sub coded_orderline_text {
    my $self  = shift;
    my $code  = $self->{coded_orderline_text}->{code};
    my $table = $self->{coded_orderline_text}->{table};
    my $txt;
    if ( $table eq '8B' || $table eq '7B' ) {
        $txt = translate_8B($code);
    }
    elsif ( $table eq '12B' ) {
        $txt = translate_12B($code);
    }
    if ( !$txt || $txt eq 'no match' ) {
        $txt = $code;
    }
    return $txt;
}

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

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

# This will take a standard code as returned
# by (orderline|substitue)-free_text (FTX seg LIN)
# and expand it useing EditEUR code list 8B
sub translate_8B {
    my ($code) = @_;

    # list 7B is a subset of this
    my %code_list_8B = (
        AB => 'Publication abandoned',
        AD => 'Apply direct',
        AU => 'Publisher address unknown',
        CS => 'Status uncertain',
        FQ => 'Only available abroad',
        HK => 'Paperback OP: Hardback available',
        IB => 'In stock',
        IP => 'In print and in stock at publisher',
        MD => 'Manufactured on demand',
        NK => 'Item not known',
        NN => 'We do not supply this item',
        NP => 'Not yet published',
        NQ => 'Not stocked',
        NS => 'Not sold separately',
        OB => 'Temporarily out of stock',
        OF => 'This format out of print: other format available',
        OP => 'Out of print',
        OR => 'Out pf print; New Edition coming',
        PK => 'Hardback out of print: paperback available',
        PN => 'Publisher no longer in business',
        RE => 'Awaiting reissue',
        RF => 'refer to other publisher or distributor',
        RM => 'Remaindered',
        RP => 'Reprinting',
        RR => 'Rights restricted: cannot supply in this market',
        SD => 'Sold',
        SN => 'Our supplier cannot trace',
        SO => 'Pack or set not available: single items only',
        ST => 'Stocktaking: temporarily unavailable',
        TO => 'Only to order',
        TU => 'Temporarily unavailable',
        UB => 'Item unobtainable from our suppliers',
        UC => 'Unavailable@ reprint under consideration',
    );

    if ( exists $code_list_8B{$code} ) {
        return $code_list_8B{$code};
    }
    else {
        return 'no match';
    }
}

sub translate_12B {
    my ($code) = @_;

    my %code_list_12B = (
        100 => 'Order line accepted',
        101 => 'Price query: orderline will be held awaiting customer response',
        102 =>
          'Discount query: order line will be held awaiting customer response',
        103 => 'Minimum order value not reached: order line will be held',
        104 =>
'Firm order required: order line will be held awaiting customer response',
        110 => 'Order line accepted, substitute product will be supplied',
        200 => 'Order line not accepted',
        201 => 'Price query: order line not accepted',
        202 => 'Discount query: order line not accepted',
        203 => 'Minimum order value not reached: order line not accepted',
        205 => 'Order line not accepted: quoted promotion is invalid',
        206 => 'Order line not accepted: quoted promotion has ended',
        207 =>
          'Order line not accepted: customer ineligible for quoted promotion',
        210 => 'Order line not accepted: substitute product is offered',
        220 => 'Oustanding order line cancelled: reason unspecified',
        221 => 'Oustanding order line cancelled: past order expiry date',
        222 => 'Oustanding order line cancelled by customer request',
        223 => 'Oustanding order line cancelled: unable to supply',
        300 => 'Order line passed to new supplier',
        301 => 'Order line passed to secondhand department',
        400 => 'Backordered - awaiting supply',
        401 => 'On order from our supplier',
        402 => 'On order from abroad',
        403 => 'Backordered, waiting to reach minimum order value',
        404 => 'Despatched from our supplier, awaiting delivery',
        405 => 'Our supplier sent wrong item(s), re-ordered',
        406 => 'Our supplier sent short, re-ordered',
        407 => 'Our supplier sent damaged item(s), re-ordered',
        408 => 'Our supplier sent imperfect item(s), re-ordered',
        409 => 'Our supplier cannot trace order, re-ordered',
        410 => 'Ordered item(s) being processed by bookseller',
        411 =>
'Ordered item(s) being processed by bookseller, awaiting customer action',
        412 => 'Order line held awaiting customer instruction',
        500 => 'Order line on hold - contact customer service',
        800 => 'Order line already despatched',
        900 => 'Cannot trace order line',
        901 => 'Order line held: note title change',
        902 => 'Order line held: note availability date delay',
        903 => 'Order line held: note price change',
        999 => 'Temporary hold: order action not yet determined',
    );

    if ( exists $code_list_12B{$code} ) {
        return $code_list_12B{$code};
    }
    else {
        return 'no match';
    }
}

# 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} ) {
        my $a              = $self->{item_description}->{$field};
        my $forename_field = q{011};
        if ( exists $self->{item_description}->{$forename_field} ) {
            $a .= ', ';
            $a .= $self->{item_description}->{$forename_field};
        }
        return $a;
    }
    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 dewey_class {
    my $self  = shift;
    my $field = q{230};
    if ( exists $self->{item_description}->{$field} ) {
        return $self->{item_description}->{$field};
    }
    return;
}

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

sub girfield {
    my ( $self, $field, $occ ) = @_;
    if ( $self->number_of_girs ) {

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

sub number_of_girs {
    my $self = shift;
    if ( $self->{GIR} ) {

        my $qty = @{ $self->{GIR} };

        return $qty;
    }
    else {
        return 0;
    }
}

sub extract_gir {
    my $s    = shift;
    my %qmap = (
        LAC => 'barcode',
        LAF => 'first_accession_number',
        LAL => 'last_accession_number',
        LCL => 'classification',
        LCO => 'item_unique_id',
        LCV => 'copy_value',
        LFH => 'feature_heading',
        LFN => 'fund_allocation',
        LFS => 'filing_suffix',
        LLN => 'loan_category',
        LLO => 'branch',
        LLS => 'label_sublocation',
        LQT => 'part_order_quantity',
        LRS => 'record_sublocation',
        LSM => 'shelfmark',
        LSQ => 'collection_code',
        LST => 'stock_category',
        LSZ => 'size_code',
        LVC => 'coded_servicing_instruction',
        LVT => 'servicing_instruction',
    );

    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');
}

# Used to give price in currency other than that given in price
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('203');
}

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');
}

sub availability_date {
    my $self = shift;
    if ( exists $self->{availability_date} ) {
        return $self->{availability_date};
    }
    return;
}

# return text string representing action code
sub _translate_action {
    my $code   = shift;
    my %action = (
        2  => 'cancelled',
        3  => 'change_requested',
        4  => 'no_action',
        5  => 'accepted',
        10 => 'not_found',
        24 => 'recorded',           # Order accepted but a change notified
    );
    if ( $code && exists $action{$code} ) {
        return $action{$code};
    }
    return $code;

}
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

  None documented at present

=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,2015  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,2015 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 utf8;

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 DESCRIPTION

Class modelling an Edifact Message for parsing

=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,2015 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;
use utf8;

# Copyright 2014,2015 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 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;

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};
        $self->{is_response} = $parameter_hashref->{is_response};

        # 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,
        $self->{recipient}->san,
        $self->{is_response}
      );

    # 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 $supplier_san        = shift;
    my $response            = shift;
    my $document_message_no = sprintf '%011d', $basketno;

  # Peters & Bolinda use the BIC recommendation to use 22V a code not in Edifact
  # If the order is in response to a quote
    my %bic_sans = (
        '5013546025065' => 'Peters',
        '9377779308820' => 'Bolinda',
    );

    #    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';
    if ( exists $bic_sans{$supplier_san} && $response ) {
        return "BGM+22V+$document_message_no+9$seg_terminator";
    }

    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};
    if ( !$orderline->biblionumber )
    {                        # cannot generate an orderline without a bib record
        return;
    }
    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

    my $id_string = $orderline->line_item_id;

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

    # PIA isbn or other id
    my @identifiers;
    foreach my $id ( $biblioitem->ean, $biblioitem->issn, $biblioitem->isbn ) {
        if ( $id && $id ne $id_string ) {
            push @identifiers, $id;
        }
    }
    $self->add_seg( additional_product_id( join( ' ', @identifiers ) ) );

    #  biblio 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->deliveryplace;
        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);

    # RFF : suppliers unique quotation reference number
    if ( $orderline->suppliers_reference_number ) {
        $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier,
          ':', $orderline->suppliers_reference_number, $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;
}

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, $item_number_id ) = @_;

    if ($item_number_id) {
        $item_number_id = "++${item_number_id}:EN";
    }
    else {
        $item_number_id = q||;
    }

    return "LIN+$line_number$item_number_id$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) {
        $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 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,2015,2016 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,2016 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 utf8;

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 = {
        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 - Class foe Edifact Segments

=head1 DESCRIPTION

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


=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,2016, 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,2015 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 utf8;
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(
        host     => $self->{account}->host,
        user     => $self->{account}->username,
        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 $file ( @{$file_list} ) {
        my $filename = $file->{filename};

        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->atomic_rename( $filename, $processed_name );
            my $ret = $sftp->rename( $filename, $processed_name );
            if ( !$ret ) {
                $self->_abort_download( $sftp,
                    "Error renaming $filename: $sftp->error" );
                last;
            }

        }
    }
    $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(
        host     => $self->{account}->host,
        user     => $self->{account}->username,
        password => $self->{account}->password,
        timeout  => 10,
    );
    $sftp->die_on_error("Cannot ssh to $self->{account}->host");
    $sftp->setcwd( $self->{account}->upload_directory )
      or return $self->_abort_download( $sftp,
        "Cannot change remote dir : $sftp->error" );
    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;

    if ($handle) {
        $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',
        ORDRSP  => 'CEA',
        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 );
$downlowd->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 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,2015 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 (-3 / +33 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-360 __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.07042 @ 2016-03-09 15:14:35	385	# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-03-10 19:36:24
356	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:JPswQh/s5S4nZnUzMckLnw	386	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:mNH0CKfuRQqoOLXieV43DQ
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 code or comments, and it will be preserved on regeneration
360	1;	390	1;




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

=head2 vendor_edi_accounts

Type: has_many

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

=cut

__PACKAGE__->has_many(
  "vendor_edi_accounts",
  "Koha::Schema::Result::VendorEdiAccount",
  { "foreign.shipment_budget" => "self.budget_id" },
  { cascade_copy => 0, cascade_delete => 0 },
);

=head2 borrowernumbers

Type: many_to_many

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


# Created by DBIx::Class::Schema::Loader v0.07033 @ 2015-03-04 10:26:49
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:E4J/D0+2j0/8JZd0YRnoeA


# 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




  is_nullable: 1
  size: 16

=head2 line_item_id

  data_type: 'varchar'
  is_nullable: 1
  size: 35

=head2 suppliers_reference_number

  data_type: 'varchar'
  is_nullable: 1
  size: 35

=head2 suppliers_reference_qualifier

  data_type: 'varchar'
  is_nullable: 1
  size: 3

=head2 suppliers_report

  data_type: 'text'
  is_nullable: 1

=cut

__PACKAGE__->add_columns(

    is_nullable => 1,
    size => 16,
  },
  "line_item_id",
  { data_type => "varchar", is_nullable => 1, size => 35 },
  "suppliers_reference_number",
  { data_type => "varchar", is_nullable => 1, size => 35 },
  "suppliers_reference_qualifier",
  { data_type => "varchar", is_nullable => 1, size => 3 },
  "suppliers_report",
  { data_type => "text", is_nullable => 1 },
);

=head1 PRIMARY KEY

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


# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-03-10 19:38:20
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:2kQhxUE0pZ3PpwOqGtvB+g


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




  { 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 ee_id

  data_type: 'integer'
  extra: {unsigned => 1}
  is_auto_increment: 1
  is_nullable: 0

=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(
  "ee_id",
  {
    data_type => "integer",
    extra => { unsigned => 1 },
    is_auto_increment => 1,
    is_nullable => 0,
  },
  "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 PRIMARY KEY

=over 4

=item * L</ee_id>

=back

=cut

__PACKAGE__->set_primary_key("ee_id");

=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.07042 @ 2015-06-12 10:22:04
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:WWcMBSXeuzgCPqM0KMxfBg


# 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: 'mediumtext'
  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 => "mediumtext", 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 @ 2015-02-25 10:41:36
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:l4h8AsG2RJupxXQcEw8yzQ


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 responses_enabled

  data_type: 'tinyint'
  default_value: 0
  is_nullable: 0

=head2 auto_orders

  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 },
  "responses_enabled",
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
  "auto_orders",
  { 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.07042 @ 2015-08-19 11:41:15
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:0CgJuFAItI71dfSG88NWhg


# 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 (+77 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	my $duplinbatch = $query->param('duplinbatch');	74	my $duplinbatch = $query->param('duplinbatch');
72		75
Lines 84-89 my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( Link Here
84	my $basket = GetBasket($basketno);	87	my $basket = GetBasket($basketno);
85	$booksellerid = $basket->{booksellerid} unless $booksellerid;	88	$booksellerid = $basket->{booksellerid} unless $booksellerid;
86	my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });	89	my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
		90	my $schema = Koha::Database->new()->schema();
		91	my $rs = $schema->resultset('VendorEdiAccount')->search(
		92	{ vendor_id => $booksellerid, } );
		93	$template->param( ediaccount => ($rs->count > 0));
87		94
88	unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {	95	unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
89	$template->param(	96	$template->param(
Lines 196-201 if ( $op eq 'delete_confirm' ) { Link Here
196	} elsif ($op eq 'reopen') {	203	} elsif ($op eq 'reopen') {
197	ReopenBasket($query->param('basketno'));	204	ReopenBasket($query->param('basketno'));
198	print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})	205	print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
		206	}
		207	elsif ( $op eq 'ediorder' ) {
		208	edi_close_and_order()
199	} elsif ( $op eq 'mod_users' ) {	209	} elsif ( $op eq 'mod_users' ) {
200	my $basketusers_ids = $query->param('users_ids');	210	my $basketusers_ids = $query->param('users_ids');
201	my @basketusers = split( /:/, $basketusers_ids );	211	my @basketusers = split( /:/, $basketusers_ids );
Lines 468-470 sub get_order_infos { Link Here
468	}	478	}
469		479
470	output_html_with_http_headers $query, $cookie, $template->output;	480	output_html_with_http_headers $query, $cookie, $template->output;
		481
		482
		483	sub edi_close_and_order {
		484	my $confirm = $query->param('confirm') \|\| $confirm_pref eq '2';
		485	if ($confirm) {
		486	my $edi_params = {
		487	basketno => $basketno,
		488	ean => $ean,
		489	};
		490	if ( $basket->{branch} ) {
		491	$edi_params->{branchcode} = $basket->{branch};
		492	}
		493	if ( create_edi_order($edi_params) ) {
		494	#$template->param( edifile => 1 );
		495	}
		496	CloseBasket($basketno);
		497
		498	# if requested, create basket group, close it and attach the basket
		499	if ( $query->param('createbasketgroup') ) {
		500	my $branchcode;
		501	if ( C4::Context->userenv
		502	and C4::Context->userenv->{'branch'}
		503	and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" )
		504	{
		505	$branchcode = C4::Context->userenv->{'branch'};
		506	}
		507	my $basketgroupid = NewBasketgroup(
		508	{
		509	name => $basket->{basketname},
		510	booksellerid => $booksellerid,
		511	deliveryplace => $branchcode,
		512	billingplace => $branchcode,
		513	closed => 1,
		514	}
		515	);
		516	ModBasket(
		517	{
		518	basketno => $basketno,
		519	basketgroupid => $basketgroupid
		520	}
		521	);
		522	print $query->redirect(
		523	"/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1"
		524	);
		525	}
		526	else {
		527	print $query->redirect(
		528	"/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid"
		529	);
		530	}
		531	exit;
		532	}
		533	else {
		534	$template->param(
		535	edi_confirm => 1,
		536	booksellerid => $booksellerid,
		537	basketno => $basket->{basketno},
		538	basketname => $basket->{basketname},
		539	basketgroupname => $basket->{basketname},
		540	);
		541	if ($ean) {
		542	$template->param( ean => $ean );
		543	}
		544
545	}
546	return;
547	}




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 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, 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 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, 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 $cmd    = $q->param('op');
if ( $cmd && $cmd == 'delete' ) {
    my $id  = $q->param->('message_id');
    my $msg = $schema->resultset('EdifactMessage')->find($id);
    $msg->deleted(1);
    $msg->update;
}

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 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, 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 62-67 my $author = $input->param('author'); Link Here

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




#!/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 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, 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'),
            responses_enabled  => defined $input->param('responses_enabled'),
            auto_orders        => defined $input->param('auto_orders'),
            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 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, 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;
}




-- Holds details for vendors supplying goods by EDI
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,
  responses_enabled tinyint(1) not null default 0,
  auto_orders 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;

-- Hold the actual edifact messages with links to associated baskets
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 mediumtext,
  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;

-- invoices link back to the edifact message it was generated from
ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id );

-- clean up link on deletes
ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL;

-- Hold the supplier ids from quotes for ordering
-- although this is an EAN-13 article number the standard says 35 characters ???
ALTER TABLE aqorders ADD COLUMN line_item_id varchar(35);

-- The suppliers unique reference usually a quotation line number ('QLI')
-- Otherwise Suppliers unique orderline reference ('SLI')
ALTER TABLE aqorders ADD COLUMN suppliers_reference_number varchar(35);
ALTER TABLE aqorders ADD COLUMN suppliers_reference_qualifier varchar(3);
ALTER TABLE aqorders ADD COLUMN suppliers_report text;

-- hold the EAN/SAN used in ordering
CREATE TABLE IF NOT EXISTS edifact_ean (
  ee_id integer(11) unsigned not null auto_increment primary key,
  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;

-- Syspref budget to hold shipping costs
INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages',  'free');

-- Add a permission for managing EDI
INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions');

Lines 3111-3116 CREATE TABLE `aqorders` ( -- information related to the basket line items Link Here

(-)a/installer/data/mysql/kohastructure.sql (+76 lines)
3111	`subscriptionid` int(11) default NULL, -- links this order line to a subscription (subscription.subscriptionid)	3111	`subscriptionid` int(11) default NULL, -- links this order line to a subscription (subscription.subscriptionid)
3112	parent_ordernumber int(11) default NULL, -- ordernumber of parent order line, or same as ordernumber if no parent	3112	parent_ordernumber int(11) default NULL, -- ordernumber of parent order line, or same as ordernumber if no parent
3113	`orderstatus` varchar(16) default 'new', -- the current status for this line item. Can be 'new', 'ordered', 'partial', 'complete' or 'cancelled'	3113	`orderstatus` varchar(16) default 'new', -- the current status for this line item. Can be 'new', 'ordered', 'partial', 'complete' or 'cancelled'
		3114	line_item_id varchar(35) default NULL, -- Supplier's article id for Edifact orderline
		3115	suppliers_reference_number varchar(35) default NULL, -- Suppliers unique edifact quote ref
		3116	suppliers_reference_qualifier varchar(3) default NULL, -- Type of number above usually 'QLI'
		3117	`suppliers_report` text COLLATE utf8_unicode_ci, -- reports received from suppliers
3114	PRIMARY KEY (`ordernumber`),	3118	PRIMARY KEY (`ordernumber`),
3115	KEY `basketno` (`basketno`),	3119	KEY `basketno` (`basketno`),
3116	KEY `biblionumber` (`biblionumber`),	3120	KEY `biblionumber` (`biblionumber`),
Lines 3169-3174 CREATE TABLE aqorders_transfers ( Link Here
3169	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;	3173	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3170		3174
3171	--	3175	--
		3176	-- Table structure for table vendor_edi_accounts
		3177	--
		3178
		3179	DROP TABLE IF EXISTS vendor_edi_accounts;
		3180	CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
		3181	id int(11) NOT NULL auto_increment,
		3182	description text NOT NULL,
		3183	host varchar(40),
		3184	username varchar(40),
		3185	password varchar(40),
		3186	last_activity date,
		3187	vendor_id int(11) references aqbooksellers( id ),
		3188	download_directory text,
		3189	upload_directory text,
		3190	san varchar(20),
		3191	id_code_qualifier varchar(3) default '14',
		3192	transport varchar(6) default 'FTP',
		3193	quotes_enabled tinyint(1) not null default 0,
		3194	invoices_enabled tinyint(1) not null default 0,
		3195	orders_enabled tinyint(1) not null default 0,
		3196	responses_enabled tinyint(1) NOT NULL DEFAULT '0',
		3197	auto_orders tinyint(1) NOT NULL DEFAULT '0',
		3198	shipment_budget integer(11) references aqbudgets( budget_id ),
		3199	PRIMARY KEY (id),
		3200	KEY vendorid (vendor_id),
		3201	KEY shipmentbudget (shipment_budget),
		3202	CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		3203	CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
		3204	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
		3205
		3206	--
		3207	-- Table structure for table edifact_messages
		3208	--
		3209
		3210	DROP TABLE IF EXISTS edifact_messages;
		3211	CREATE TABLE IF NOT EXISTS edifact_messages (
		3212	id int(11) NOT NULL auto_increment,
		3213	message_type varchar(10) NOT NULL,
		3214	transfer_date date,
		3215	vendor_id int(11) references aqbooksellers( id ),
		3216	edi_acct integer references vendor_edi_accounts( id ),
		3217	status text,
		3218	basketno int(11) references aqbasket( basketno),
		3219	raw_msg mediumtext,
		3220	filename text,
		3221	deleted boolean not null default 0,
		3222	PRIMARY KEY (id),
		3223	KEY vendorid ( vendor_id),
		3224	KEY ediacct (edi_acct),
		3225	KEY basketno ( basketno),
		3226	CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		3227	CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
		3228	CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
		3229	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
		3230
		3231	--
3172	-- Table structure for table aqinvoices	3232	-- Table structure for table aqinvoices
3173	--	3233	--
3174		3234
Lines 3182-3189 CREATE TABLE aqinvoices ( Link Here
3182	closedate date default NULL, -- invoice close date, NULL means the invoice is open	3242	closedate date default NULL, -- invoice close date, NULL means the invoice is open
3183	shipmentcost decimal(28,6) default NULL, -- shipment cost	3243	shipmentcost decimal(28,6) default NULL, -- shipment cost
3184	shipmentcost_budgetid int(11) default NULL, -- foreign key to aqbudgets, link the shipment cost to a budget	3244	shipmentcost_budgetid int(11) default NULL, -- foreign key to aqbudgets, link the shipment cost to a budget
		3245	message_id int(11) default NULL, -- foreign key to edifact invoice message
3185	PRIMARY KEY (invoiceid),	3246	PRIMARY KEY (invoiceid),
3186	CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,	3247	CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
		3248	CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL,
3187	CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE	3249	CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
3188	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;	3250	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3189		3251
Lines 3645-3650 CREATE TABLE audio_alerts ( Link Here
3645	KEY precedence (precedence)	3707	KEY precedence (precedence)
3646	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;	3708	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3647		3709
		3710	--
		3711	-- Table structure for table 'edifact_ean'
		3712	--
		3713
		3714	DROP TABLE IF EXISTS edifact_ean;
		3715	CREATE TABLE IF NOT EXISTS edifact_ean (
		3716	ee_id int(11) NOT NULL AUTO_INCREMENT,
		3717	branchcode varchar(10) not null references branches (branchcode),
		3718	ean varchar(15) NOT NULL,
		3719	id_code_qualifier varchar(3) NOT NULL default '14',
		3720	PRIMARY KEY (ee_id),
		3721	CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
		3722	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
		3723
3648	/!40103 SET TIME_ZONE=@OLD_TIME_ZONE /;	3724	/!40103 SET TIME_ZONE=@OLD_TIME_ZONE /;
3649	/!40101 SET SQL_MODE=@OLD_SQL_MODE /;	3725	/!40101 SET SQL_MODE=@OLD_SQL_MODE /;
3650	/!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS /;	3726	/!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS /;

Lines 131-136 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here

(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
131	('DumpTemplateVarsIntranet', '0', NULL , 'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.', 'YesNo'),	131	('DumpTemplateVarsIntranet', '0', NULL , 'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.', 'YesNo'),
132	('DumpTemplateVarsOpac', '0', NULL , 'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.', 'YesNo'),	132	('DumpTemplateVarsOpac', '0', NULL , 'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.', 'YesNo'),
133	('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),	133	('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
		134	('EDIInvoicesShippingBudget',NULL,NULL,'The budget code used to allocate shipping charges to when processing EDI Invoice messages','free'),
134	('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'),	135	('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'),
135	('EnableAdvancedCatalogingEditor','0','','Enable the Rancor advanced cataloging editor','YesNo'),	136	('EnableAdvancedCatalogingEditor','0','','Enable the Rancor advanced cataloging editor','YesNo'),
136	('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'),	137	('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'),

Lines 28-33 INSERT INTO permissions (module_bit, code, description) VALUES Link Here

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

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 55-60 Link Here

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

Lines 51-56 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt (-1 / +37 lines)
51	window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes');	51	window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes');
52	}	52	}
53		53
		54	function confirm_ediorder() {
		55	var is_confirmed = confirm(_("Are you sure you want to close this basket and generate an Edifact order?"));
		56	if (is_confirmed) {
		57	window.location = "[% script_name %]?op=edi_confirm&basketno=[% basketno %]";
		58	}
		59	}
		60
54	//]]>	61	//]]>
55	</script>	62	</script>
56	[% ELSE %]	63	[% ELSE %]
Lines 157-163 Link Here
157	</div>	164	</div>
158	[% ELSE %]	165	[% ELSE %]
159	<div class="yui-b">	166	<div class="yui-b">
160	[% UNLESS ( confirm_close ) %]	167	[% IF !confirm_close && !edi_confirm %]
161	[% UNLESS ( selectbasketg ) %]	168	[% UNLESS ( selectbasketg ) %]
162	[% UNLESS ( closedate ) %]	169	[% UNLESS ( closedate ) %]
163	<div id="toolbar" class="btn-toolbar">	170	<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="fa fa-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="fa fa-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 392-397 Link Here
392	<th>GST %</th>	402	<th>GST %</th>
393	<th>GST</th>	403	<th>GST</th>
394	<th>Fund</th>	404	<th>Fund</th>
		405	<th>Supplier report</th>
395	[% IF ( active ) %]	406	[% IF ( active ) %]
396	[% UNLESS ( closedate ) %]	407	[% UNLESS ( closedate ) %]
397	<th>Modify</th>	408	<th>Modify</th>
Lines 415-420 Link Here
415	<th> </th>	426	<th> </th>
416	<th>[% foot_loo.gstvalue \| $Price %]</th>	427	<th>[% foot_loo.gstvalue \| $Price %]</th>
417	<th> </th>	428	<th> </th>
		429	<th> </th>
418	[% IF ( active ) %]	430	[% IF ( active ) %]
419	[% UNLESS ( closedate ) %]	431	[% UNLESS ( closedate ) %]
420	<th> </th>	432	<th> </th>
Lines 436-441 Link Here
436	<th> </th>	448	<th> </th>
437	<th>[% total_gstvalue \| $Price %]</th>	449	<th>[% total_gstvalue \| $Price %]</th>
438	<th> </th>	450	<th> </th>
		451	<th> </th>
439	[% IF ( active ) %]	452	[% IF ( active ) %]
440	[% UNLESS ( closedate ) %]	453	[% UNLESS ( closedate ) %]
441	<th> </th>	454	<th> </th>
Lines 509-514 Link Here
509	<td class="number">[% books_loo.gstrate * 100 \| $Price %]</td>	522	<td class="number">[% books_loo.gstrate * 100 \| $Price %]</td>
510	<td class="number [% IF books_loo.gstvalue.search(zero_regex) %]error[% END %]">[% books_loo.gstvalue \| $Price %]</td>	523	<td class="number [% IF books_loo.gstvalue.search(zero_regex) %]error[% END %]">[% books_loo.gstvalue \| $Price %]</td>
511	<td>[% books_loo.budget_name %]</td>	524	<td>[% books_loo.budget_name %]</td>
		525	<td>[% books_loo.suppliers_report %]</td>
512	[% IF ( active ) %]	526	[% IF ( active ) %]
513	[% UNLESS ( closedate ) %]	527	[% UNLESS ( closedate ) %]
514	<td>	528	<td>
Lines 670-675 Link Here
670	</form>	684	</form>
671	</div>	685	</div>
672	[% END %]	686	[% END %]
		687	[% IF edi_confirm %]
		688	<div id="closebasket_needsconfirmation" class="dialog alert">
		689
		690	<form action="/cgi-bin/koha/acqui/basket.pl" class="confirm">
		691	<h1>Are you sure you want to generate an edifact order and close basket [% basketname\|html %]?</h1>
		692	[% IF CAN_user_acquisition_group_manage %]
		693	<p>
		694	<label for="createbasketgroup">Attach this basket to a new basket group with the same name</label>
		695	<input type="checkbox" id="createbasketgroup" name="createbasketgroup"/>
		696	</p>
		697	[% END %]
		698	<input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
		699	<input type="hidden" value="ediorder" name="op" />
		700	<input type="hidden" name="ean" value="[% ean %]" />
		701	<input type="hidden" name="booksellerid" value="[% booksellerid %]" />
		702	<input type="hidden" name="confirm" value="1" />
		703	<input type="hidden" name="basketgroupname" value="[% basketgroupname %]" />
		704	<input type="submit" class="approve" value="Yes, close (Y)" accesskey="y" />
		705	<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;" />
		706	</form>
		707	</div>
		708	[% END %]
673	</div>	709	</div>
674	[% END %][%# IF (cannot_manage_basket) %]	710	[% END %][%# IF (cannot_manage_basket) %]
675	</div>	711	</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="fa fa-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="fa fa-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="fa fa-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="fa fa-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="fa fa-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="fa fa-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="fa fa-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="fa fa-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>
<th>Action</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>
<td>
<a href="/cgi-bin/koha/acqui/edifactmsgs.pl?op=delete&amp;message_id=[% msg.id %]">Delete</a>
</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 97-102 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (+5 lines)
97		97
98	<dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>	98	<dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>
99	<dd>Define funds within your budgets</dd>	99	<dd>Define funds within your budgets</dd>
		100
		101	<dt><a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI Accounts</a></dt>
		102	<dd>Manage vendor EDI accounts for import/export</dd>
		103	<dt><a href="/cgi-bin/koha/admin/edi_ean_accounts.pl">EDI EANs</a></dt>
		104	<dd>Manage Branch EDI EANs</dd>
100	</dl>	105	</dl>
101		106
102	<h3>Additional parameters</h3>	107	<h3>Additional parameters</h3>




[% 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>
      [% IF account.quotes_enabled %]
     <input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" checked />
      [% ELSE %]
     <input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" />
      [% END %]
  </li>
  <li>
     <label for="orders_enabled">Orders enabled: </label>
[% IF account.orders_enabled %]
     <input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" checked />
[% ELSE %]
     <input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" />
[% END %]
  </li>
  <li>
     <label for="invoices_enabled">Invoices enabled: </label>
[% IF account.invoices_enabled %]
     <input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" checked />
[% ELSE %]
     <input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" />
[% END %]
  </li>
  <li>
     <label for="responses_enabled">Responses enabled: </label>
[% IF account.responses_enabled %]
     <input type="checkbox" name="responses_enabled" id="responses_enabled" value="[% account.responses_enabled %]" checked />
[% ELSE %]
     <input type="checkbox" name="responses_enabled" id="responses_enabled" value="[% account.responses_enabled %]" />
[% END %]
  </li>
  <li>
     <label for="auto_orders">Automatic ordring (Quotes generate orders without staff intervention): </label>
[% IF account.auto_orders %]
     <input type="checkbox" name="auto_orders" id="auto_orders" value="[% account.auto_orders %]" checked />
[% ELSE %]
     <input type="checkbox" name="auto_orders" id="auto_orders" value="[% account.auto_orders %]" />
[% 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>
</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>Responses</th>
       <th>Auto ordering</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>N</td>
      [% END %]
      [% IF account.orders_enabled %]
         <td>Y</td>
      [% ELSE %]
         <td>N</td>
      [% END %]
      [% IF account.invoices_enabled %]
         <td>Y</td>
      [% ELSE %]
         <td>N</td>
      [% END %]
      [% IF account.responses_enabled %]
         <td>Y</td>
      [% ELSE %]
         <td>N</td>
      [% END %]
      [% IF account.auto_orders %]
         <td>Y</td>
      [% ELSE %]
         <td>N</td>
      [% END %]
      <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 104-109 Link Here

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




#!/usr/bin/perl
#
# Copyright 2013,2014,2015 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use warnings;
use strict;
use utf8;

# Handles all the edi processing for a site
# loops through the vendor_edifact records and uploads and downloads
# edifact files if the appropriate type is enabled
# downloaded quotes, invoices and responses are processed here
# if orders are enabled and present they are generated and sent
# can be run as frequently as required
# log messages are appended to logdir/editrace.log

use C4::Context;
use Log::Log4perl qw(:easy);
use Koha::Database;
use Koha::EDI qw( process_quote process_invoice process_ordrsp);
use Koha::Edifact::Transport;
use Fcntl qw( :DEFAULT :flock :seek );

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",
    }
);

# we dont have a lock dir in context so use the logdir
my $pidfile = "$logdir/edicron.pid";

my $pid_handle = check_pidfile();

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');

    }

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

    }
    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);
    }
    if ( $acct->responses_enabled ) {
        my $downloader = Koha::Edifact::Transport->new( $acct->id );
        $downloader->download_messages('ORDRSP');
    }
}

# 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);
}

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

foreach my $response (@downloaded_responses) {
    my $filename = $response->filename();
    $logger->trace("Processing order response $filename");
    process_ordrsp($response);
}

if ( close $pid_handle ) {
    unlink $pidfile;
    exit 0;
}
else {
    $logger->error("Error on pidfile close: $!");
    exit 1;
}

sub check_pidfile {

    # sysopen my $fh, $pidfile, O_EXCL | O_RDWR or log_exit "$0 already running"
    sysopen my $fh, $pidfile, O_RDWR | O_CREAT
      or log_exit("$0: open $pidfile: $!");
    flock $fh => LOCK_EX or log_exit("$0: flock $pidfile: $!");

    sysseek $fh, 0, SEEK_SET or log_exit("$0: sysseek $pidfile: $!");
    truncate $fh, 0 or log_exit("$0: truncate $pidfile: $!");
    print $fh "$$\n" or log_exit("$0: print $pidfile: $!");

    return $fh;
}

sub log_exit {
    my $error = shift;
    $logger->error($error);

    exit 1;
}




#!/usr/bin/perl
use strict;
use warnings;

use C4::Context;

# this script will remove those older than 5 days
my $tmpdir = '/tmp';
#
opendir( my $dh, $tmpdir) || die "Cannot open $tmpdir : $!";

my @files_in_tmp = grep { /\.CE[IQ]$/ && -f "$tmpdir/$_" } readdir($dh);
closedir $dh;


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

my $query =<<'ENDSQL';
select filename from edifact_messages
where message_type IN ('QUOTE','INVOICE')
and datediff( CURDATE(), transfer_date ) > 5
ENDSQL

my $ingested;

@{$ingested} = $dbh->selectcol_arrayref($query);

my %ingested_hash = map { $_ => 1 } @{$ingested};

my @delete_list;

foreach (@files_in_tmp) {
    if ( exists $ingested_hash{$_} ) {
        push @delete_list, $_;
    }
}

if ( @delete_list ) {
    chdir $tmpdir;
    unlink @delete_list;
}




#!/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/edi_testfiles/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 => 34;

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

my $filename = "$Bin/edi_testfiles/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->orderline_free_text, $ftx_string, "ftx note retrieved" );

my $filename2 = "$Bin/edi_testfiles/QUOTES_413514.CEQ";

my $q2 = Koha::Edifact->new( { filename => $filename2, } );
my $messages = $q2->message_array();

my $orderlines = $messages->[0]->lineitems();

my $ol = $orderlines->[0];

my $y = $ol->girfield( 'copy_value', 5 );

is( $y, undef, 'No extra item generated' );

$y = $ol->girfield( 'copy_value', 1 );
is( $y, '16.99', 'Copy Price returned' );

$y = $ol->girfield( 'classification', 4 );
is( $y, '914.1061', 'Copy classification returned' );

$y = $ol->girfield( 'fund_allocation', 4 );
is( $y, 'REF', 'Copy fund returned' );

$y = $ol->girfield( 'branch', 4 );
is( $y, 'SOU', 'Copy Branch returned' );

$y = $ol->girfield( 'collection_code', 4 );
is( $y, 'ANF', 'Collection code returned' );

$y = $ol->girfield( 'stock_category', 4 );
is( $y, 'RS', 'Copy stock category returned' );




#!/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' );




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

use Test::More tests => 16;

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

my $filedir = "$Bin/edi_testfiles";

my @files = map { "$filedir/$_" }
  ( 'ordrsp1.CEA', 'ordrsp2.CEA', 'ordrsp3.CEA', 'ordrsp4.CEA' );

my @responses;
for my $filename (@files) {

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

    isa_ok( $order_response, 'Koha::Edifact' );
    push @responses, $order_response;
}

# tests on file 1
# Order accepted with amendments
my $order_response = $responses[0];

my $msg       = $order_response->message_array();
my $no_of_msg = @{$msg};
is( $no_of_msg, 1, "Correct number of messages returned" );

isa_ok( $msg->[0], 'Koha::Edifact::Message' );

my $lines = $msg->[0]->lineitems();

my $no_of_lines = @{$lines};

is( $no_of_lines, 3, "Correct number of orderlines returned" );

#
is( $lines->[0]->ordernumber(), 'P28837', 'Line 1 correct ordernumber' );
is(
    $lines->[0]->coded_orderline_text(),
    'Not yet published',
    'NP returned and translated'
);

is( $lines->[1]->ordernumber(), 'P28838', 'Line 2 correct ordernumber' );
is( $lines->[1]->action_notification(),
    'cancelled', 'Cancelled action returned' );
is( $lines->[1]->coded_orderline_text(),
    'Out of print', 'OP returned and translated' );

is( $lines->[2]->ordernumber(), 'P28846', 'Line 3 correct ordernumber' );
is( $lines->[2]->action_notification(),
    'recorded', 'Accepted with change action returned' );

is( $lines->[0]->availability_date(), '19971120',
    'Availability date returned' );

(-)a/t/edi_testfiles/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'

(-)a/t/edi_testfiles/QUOTES_413514.CEQ (+1 lines)

Line 0 Link Here

UNA:+.? 'UNB+UNOC:3+5013546027173+5013546132093+150928:1811+413514+ASKEDI:+QUOTES++++'UNH+413514001+QUOTES:D:96A:UN:EAN002'BGM+31C::28+SO314841+9'DTM+137:20150928:102'CUX+2:GBP:12'NAD+BY+5013546132093::9'NAD+SU+5013546027173::9'LIN+1++9780749577216:EN'PIA+5+0749577215:IB'IMD+L+050+:::AA hotel guide 2016'IMD+L+120+:::AA Publishing'IMD+L+170+:::2015'IMD+L+180+:::688'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:5'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+914.1061:LCL'GIR+001+16.99:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+914.1061:LCL'GIR+002+16.99:LCV'GIR+003+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+914.1061:LCL'GIR+003+16.99:LCV'GIR+004+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+914.1061:LCL'GIR+004+16.99:LCV'GIR+005+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+914.1061:LCL'GIR+005+16.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:16.99'RFF+QLI:SO3148410001'LIN+2++9780857111739:EN'PIA+5+0857111736:IB'IMD+L+050+:::BNF 69'IMD+L+060+:::British national formulary'IMD+L+120+:::Pharmaceutical Press'IMD+L+170+:::2015'IMD+L+180+:::1184'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:2'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+615.1341:LCL'GIR+001+39.99:LCV'GIR+002+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+615.1341:LCL'GIR+002+39.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:39.99'RFF+QLI:SO3148410002'LIN+3++9780749474805:EN'PIA+5+0749474807:IB'IMD+L+050+:::British qualifications 2016'IMD+L+060+:::a complete guide to professional, v:ocational & academic qualifications'IMD+L+060+::: in the United Kingdom'IMD+L+120+:::KoganPage'IMD+L+170+:::2015'IMD+L+180+:::576'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:2'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+378.013:LCL'GIR+001+69.99:LCV'GIR+002+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+378.013:LCL'GIR+002+69.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:69.99'RFF+QLI:SO3148410003'LIN+4++9781909319776:EN'PIA+5+1909319775:IB'IMD+L+050+:::Careers 2016'IMD+L+120+:::Trotman'IMD+L+170+:::2015'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:6'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+331.702:LCL'GIR+001+45.00:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+331.702:LCL'GIR+002+45.00:LCV'GIR+003+RS:LST+ANF:LSQ+FOR:LLO+REF:LFN+331.702:LCL'GIR+003+45.00:LCV'GIR+004+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+331.702:LCL'GIR+004+45.00:LCV'GIR+005+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+331.702:LCL'GIR+005+45.00:LCV'GIR+006+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+331.702:LCL'GIR+006+45.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:45.00'RFF+QLI:SO3148410004'LIN+5++9781910715024:EN'PIA+5+1910715026:IB'IMD+L+010+:::Child Poverty Action Group'IMD+L+050+:::Council Tax Handbook'IMD+L+120+:::CPAG'IMD+L+170+:::2015'IMD+L+180+:::305'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+344.4203 CHI:LCL'GIR+001+22.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:22.00'RFF+QLI:SO3148410005'LIN+6++9780715110973:EN'PIA+5+0715110977:IB'IMD+L+050+:::Crockford?'s clerical directory 2016:-2017'IMD+L+060+:::a directory of the clergy of the Ch:urch of England, the Church in Wale'IMD+L+060+:::s, the Scottish Episcopal Church, t:he Church of Ireland'IMD+L+120+:::Church House Publishing'IMD+L+170+:::2015'IMD+L+180+:::1280'IMD+L+220+:::Hbk'IMD+L+250+:::AN'QTY+1:2'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+283.0254:LCL'GIR+001+70.00:LCV'GIR+002+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+283.0254:LCL'GIR+002+70.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:70.00'RFF+QLI:SO3148410006'LIN+7++9781908232236:EN'PIA+5+1908232234:IB'IMD+L+010+:::Newton'IMD+L+011+:::Elizabeth'IMD+L+050+:::Dods Parliamentary Companion'IMD+L+120+:::Dod?'s Parliamentary Communications'IMD+L+170+:::2015'IMD+L+180+:::1488'IMD+L+220+:::Hbk'IMD+L+250+:::AN'QTY+1:2'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+325.00:LCV'GIR+002+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+325.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:325.00'RFF+QLI:SO3148410007'LIN+8++9780851015699:EN'PIA+5+0851015697:IB'IMD+L+050+:::Hudson?'s historic houses & gardens'IMD+L+120+:::Hudson?'s Media'IMD+L+170+:::2015'IMD+L+180+:::500'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+914.1048:LCL'GIR+001+16.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:16.99'RFF+QLI:SO3148410008'LIN+9++9781784720292:EN'PIA+5+1784720291:IB'IMD+L+010+:::Miller'IMD+L+011+:::Judith'IMD+L+050+:::Miller?'s antiques handbook & price :guide 2016/2017'IMD+L+120+:::Mitchell Beazley'IMD+L+170+:::2015'IMD+L+180+:::648'IMD+L+190+:::Miller?'s Antiques Handbook & Price :Guide'IMD+L+220+:::Hbk'IMD+L+250+:::AN'QTY+1:6'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+745.1075 MIL:LCL'GIR+001+30.00:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+745.1075 MIL:LCL'GIR+002+30.00:LCV'GIR+003+RS:LST+ANF:LSQ+FOR:LLO+REF:LFN+745.1075 MIL:LCL'GIR+003+30.00:LCV'GIR+004+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+745.1075 MIL:LCL'GIR+004+30.00:LCV'GIR+005+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+745.1075 MIL:LCL'GIR+005+30.00:LCV'GIR+006+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+745.1075 MIL:LCL'GIR+006+30.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:30.00'RFF+QLI:SO3148410009'LIN+10++9781440245244:EN'PIA+5+144024524X:IB'IMD+L+010+:::Cuhaj'IMD+L+011+:::George S.'IMD+L+020+:::Michael'IMD+L+021+:::Thomas'IMD+L+050+:::Standard Catalog of World Coins, 18:01-1900'IMD+L+120+:::F&W Publications Inc'IMD+L+170+:::2015'IMD+L+180+:::1296'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:5'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+58.99:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+58.99:LCV'GIR+003+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+58.99:LCV'GIR+004+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+58.99:LCV'GIR+005+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+58.99:LCV'FTX+LIN++3:10B:28'PRI+AAE:58.99'RFF+QLI:SO3148410010'LIN+11++9781910715048:EN'PIA+5+1910715042:IB'IMD+L+010+:::Child Poverty Action Group'IMD+L+050+:::Student Support and Benefits Handbo:ok'IMD+L+120+:::CPAG'IMD+L+170+:::2015'IMD+L+180+:::356'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+20.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:20.00'RFF+QLI:SO3148410011'LIN+12++9781910715055:EN'PIA+5+1910715050:IB'IMD+L+010+:::Child Poverty Action Group'IMD+L+050+:::Universal Credit'IMD+L+060+:::What You Need to Know'IMD+L+120+:::CPAG'IMD+L+170+:::2015'IMD+L+180+:::304'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:6'GIR+001+RS:LST+ANF:LSQ+BOO:LLO+REF:LFN+15.00:LCV'GIR+002+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+15.00:LCV'GIR+003+RS:LST+ANF:LSQ+FOR:LLO+REF:LFN+15.00:LCV'GIR+004+RS:LST+ANF:LSQ+MAG:LLO+REF:LFN+15.00:LCV'GIR+005+RS:LST+ANF:LSQ+NET:LLO+REF:LFN+15.00:LCV'GIR+006+RS:LST+ANF:LSQ+SOU:LLO+REF:LFN+15.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:15.00'RFF+QLI:SO3148410012'LIN+13++9781472904706:EN'PIA+5+1472904702:IB'IMD+L+050+:::Who?'s who 2016'IMD+L+120+:::Bloomsbury'IMD+L+170+:::2015'IMD+L+180+:::2624'IMD+L+190+:::Who?'s Who'IMD+L+220+:::Hbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+920.009:LCL'GIR+001+280.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:280.00'RFF+QLI:SO3148410013'LIN+14++9781906035730:EN'PIA+5+1906035733:IB'IMD+L+010+:::Warrick'IMD+L+011+:::Laura'IMD+L+050+:::Willings Press Guide 2016 (set of 2: vols)'IMD+L+060+:::UK & Ireland and World News Media'IMD+L+120+:::Cision'IMD+L+170+:::2015'IMD+L+220+:::Pbk'IMD+L+250+:::AN'QTY+1:1'GIR+001+RS:LST+ANF:LSQ+CRO:LLO+REF:LFN+525.00:LCV'FTX+LIN++3:10B:28'PRI+AAE:525.00'RFF+QLI:SO3148410014'UNS+S'CNT+2:14'UNT+264+413514001'UNZ+1+413514'

(-)a/t/edi_testfiles/ordrsp1.CEA (+1 lines)

Line 0 Link Here

UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857776++ORDRSP'UNH+ME001234+ORDRSP:D:96A:UN:EAN005'BGM+231+R967634+4'DTM+137:19971028:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'CUX+2:GBP:9'LIN+1+24'PIA+5+0316907235:IB'QTY+21:2'QTY+83:2'DTM+44:19971120:102'FTX+LIN++NP:8B:28'PRI+AAE:15.99:CA:SRP'RFF+LI:P28837'LIN+2+2'PIA+5+0856674427:IB'QTY+21:1'FTX+LIN++OP:8B:28'RFF+LI:P28838'LIN+3+24'PIA+5+0870701436:IB'PIA+3+0870701428:IB'QTY+21:1'FTX+LIN++OP:8B:28'PRI+AAE:25:CA:SRP'RFF+LI:P28846'UNS+S'CNT+2:3'UNT+29+ME001234'UNZ+1+EDIQ2857776'

(-)a/t/edi_testfiles/ordrsp2.CEA (+1 lines)

Line 0 Link Here

UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857775++ORDRSP'UNH+ME001235+ORDRSP:D:96A:UN:EAN005'BGM+231+R967635+27'DTM+137:19971028:102'FTX+GEN++ACS:9B:28'RFF+ON:H67209'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'UNS+S'CNT+2:0'UNT+10+ME001235'UNZ+1+EDIQ2857775'

(-)a/t/edi_testfiles/ordrsp3.CEA (+1 lines)

Line 0 Link Here

UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857774++ORDRSP'UNH+ME001236+ORDRSP:D:96A:UN:EAN005'BGM+23C+R967635+4'DTM+137:20010624:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'LIN+1+4'PIA+5+00076511236:IB'QTY+21:3’GIR+001+5346:LCO+1000431:LAC+FIC:LFN+AN:LLO'GIR+002+5347:LCO+1000432:LAC+FIC:LFN+AN:LLO'GIR+003+5348:LCO+1000433:LAC+FIC:LFN+BB:LLO'RFF+LI:0190045'LIN+2+4’PIA+5+0863183913:IB'QTY+21:1'GIR+001+6210:LCO+1000434:LAC+FIC:LFN+BB:LLO+398:LCL'GIR+001+JON:LFS+14DAY:LLN'RFF+LI:0190056'UNS+S'CNT+2:2'UNT+21:ME001236'UNZ+1+EDIQ2857774'

(-)a/t/edi_testfiles/ordrsp4.CEA (+1 lines)

Line 0 Link Here

UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857773++ORDRSP'UNH+ME001345+ORDRSP:D:96A:UN:EAN005'BGM+23C+F964312+4'DTM+137:20010430:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'LIN+1+4'PIA+5+0007107781:IB'QTY+21:4'GIR+L01+214365:LAC+214366:LAC+DA:LLO+920:LCL+SEC:LFS'GIR+L01+NFIC:LFS'GIR+L02+214367:LAC+214368:LAC+FG:LLO+920:LCL+SEC:LFS'GIR+L02+NFIC:LFS'RFF+LI:0184364’LOC+7+BR1::92'QTY+11:2'LOC+20+FG::92'QTY+11:2'UNS+S'CNT+2:1'UNT+20:ME001345'UNZ+1+EDIQ2857773'

(-)a/t/edi_testfiles/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

Line 0 Link Here

(-)a/Koha/Edifact.pm (+337 lines)
		1	package Koha::Edifact;
		2
		3	# Copyright 2014,2015 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 objects
158	sub message_array {
159	my $self = shift;
160
161	# return an array of array_refs 1 ref to a message
162	my $msg_arr = [];
163	my $msg = [];
164	my $in_msg = 0;
165	foreach my $seg ( @{ $self->{transmission} } ) {
166	if ( $seg->tag eq 'UNH' ) {
167	$in_msg = 1;
168	push @{$msg}, $seg;
169	}
170	elsif ( $seg->tag eq 'UNT' ) {
171	$in_msg = 0;
172	if ( @{$msg} ) {
173	push @{$msg_arr}, Koha::Edifact::Message->new($msg);
174	$msg = [];
175	}
176	}
177	elsif ($in_msg) {
178	push @{$msg}, $seg;
179	}
180	}
181	return $msg_arr;
182	}
183
184	#
185	# internal parsing routines used in _init
186	#
187	sub service_string_advice {
188	my $ssa = shift;
189
190	# At present this just validates that the ssa
191	# is standard Edifact
192	# TBD reset the seps if non standard
193	if ( $ssa ne q{:+.? '} ) {
194	carp " Non standard Service String Advice [$ssa]";
195	return;
196	}
197
198	# else use default separators
199	return 1;
200	}
201
202	sub segmentize {
203	my $raw = shift;
204
205	# In practice edifact uses latin-1 but check
206	# Transport now converts to utf-8 on ingest
207	# Do not convert here
208	#my $char_set = 'iso-8859-1';
209	#if ( $raw =~ m/^UNB[+]UNO(.)/ ) {
210	# $char_set = msgcharset($1);
211	#}
212	#from_to( $raw, $char_set, 'utf8' );
213
214	my $re = qr{
215	(?> # dont backtrack into this group
216	[?]. # either the escape character
217	# followed by any other character
218	\| # or
219	[^'?] # a character that is neither escape
220	# nor split
221	)+
222	}x;
223	my @segmented;
224	while ( $raw =~ /($re)/g ) {
225	push @segmented, Koha::Edifact::Segment->new( { seg_string => $1 } );
226	}
227	return \@segmented;
228	}
229
230	sub msgcharset {
231	my $code = shift;
232	if ( $code =~ m/^[^ABCDEF]$/ ) {
233	$code = 'default';
234	}
235	my %encoding_map = (
236	A => 'ascii',
237	B => 'ascii',
238	C => 'iso-8859-1',
239	D => 'iso-8859-1',
240	E => 'iso-8859-1',
241	F => 'iso-8859-1',
242	default => 'iso-8859-1',
243	);
244	return $encoding_map{$code};
245	}
246
247	1;
248	__END__
249
250	=head1 NAME
251
252	Edifact - Edifact message handler
253
254	=head1 DESCRIPTION
255
256	Koha module for parsing Edifact messages
257
258	=head1 SUBROUTINES
259
260	=head2 new
261
262	my $e = Koha::Edifact->new( { filename => 'myfilename' } );
263	or
264	my $e = Koha::Edifact->new( { transmission => $msg_variable } );
265
266	instantiate the Edifact parser, requires either to be passed an in-memory
267	edifact message as transmission or a filename which it will read on creation
268
269	=head2 interchange_header
270
271	will return the data in the header field designated by the parameter
272	specified. Valid parameters are: 'sender', 'recipient', 'datetime',
273	'interchange_control_reference', and 'application_reference'
274
275	=head2 interchange_trailer
276
277	called either with the string 'interchange_control_count' or
278	'interchange_control_reference' will return the corresponding field from
279	the interchange trailer
280
281	=head2 new_data_iterator
282
283	Sets the object's data_iterator to point to the UNH segment
284
285	=head2 next_segment
286
287	Returns the next segment pointed to by the data_iterator. Increments the
288	data_iterator member or destroys it if segment UNZ has been reached
289
290	=head2 get_transmission
291
292	This method is useful in debugg:ing. Call on an Edifact object
293	it returns the object's transmission member
294
295	=head2 message_type
296
297	return the object's message type
298
299	=head2 message_array
300
301	return an array of Message objects contained in the Edifact transmission
302
303	=head1 Internal Methods
304
305	=head2 _init
306
307	Called by the constructor to do the parsing of the transmission
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	We preserve this info but will have converted to utf-8 on ingest
324
325	=head1 AUTHOR
326
327	Colin Campbell <colin.campbell@ptfs-europe.com>
328
329
330	=head1 COPYRIGHT
331
332	Copyright 2014,2015, PTFS-Europe Ltd
333	This program is free software, You may redistribute it under
334	under the terms of the GNU General Public License
335
336
337	=cut

Line 0 Link Here

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

Line 0 Link Here

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

Line 0 Link Here

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

(-)a/Koha/Schema/Result/Aqbudget.pm (-2 / +17 lines)
257	{ cascade_copy => 0, cascade_delete => 0 },	257	{ cascade_copy => 0, cascade_delete => 0 },
258	);	258	);
259		259
		260	=head2 vendor_edi_accounts
		261
		262	Type: has_many
		263
		264	Related object: L<Koha::Schema::Result::VendorEdiAccount>
		265
		266	=cut
		267
		268	__PACKAGE__->has_many(
		269	"vendor_edi_accounts",
		270	"Koha::Schema::Result::VendorEdiAccount",
		271	{ "foreign.shipment_budget" => "self.budget_id" },
		272	{ cascade_copy => 0, cascade_delete => 0 },
		273	);
		274
260	=head2 borrowernumbers	275	=head2 borrowernumbers
261		276
262	Type: many_to_many	277	Type: many_to_many
Lines 268-275 Composing rels: L</aqbudgetborrowers> -> borrowernumber Link Here
268	__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");	283	__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");
269		284
270		285
271	# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-02-09 15:51:54	286	# Created by DBIx::Class::Schema::Loader v0.07033 @ 2015-03-04 10:26:49
272	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:SZKnWPCMNFUm/TzeBxeDZA	287	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:E4J/D0+2j0/8JZd0YRnoeA
273		288
274		289
275	# You can replace this text with custom content, and it will be preserved on regeneration	290	# You can replace this text with custom content, and it will be preserved on regeneration

Lines 228-233 __PACKAGE__->table("aqorders"); Link Here

(-)a/Koha/Schema/Result/Aqorder.pm (-3 / +34 lines)
228	is_nullable: 1	228	is_nullable: 1
229	size: 16	229	size: 16
230		230
		231	=head2 line_item_id
		232
		233	data_type: 'varchar'
		234	is_nullable: 1
		235	size: 35
		236
		237	=head2 suppliers_reference_number
		238
		239	data_type: 'varchar'
		240	is_nullable: 1
		241	size: 35
		242
		243	=head2 suppliers_reference_qualifier
		244
		245	data_type: 'varchar'
		246	is_nullable: 1
		247	size: 3
		248
		249	=head2 suppliers_report
		250
		251	data_type: 'text'
		252	is_nullable: 1
		253
231	=cut	254	=cut
232		255
233	__PACKAGE__->add_columns(	256	__PACKAGE__->add_columns(
Lines 311-316 __PACKAGE__->add_columns( Link Here
311	is_nullable => 1,	334	is_nullable => 1,
312	size => 16,	335	size => 16,
313	},	336	},
		337	"line_item_id",
		338	{ data_type => "varchar", is_nullable => 1, size => 35 },
		339	"suppliers_reference_number",
		340	{ data_type => "varchar", is_nullable => 1, size => 35 },
		341	"suppliers_reference_qualifier",
		342	{ data_type => "varchar", is_nullable => 1, size => 3 },
		343	"suppliers_report",
		344	{ data_type => "text", is_nullable => 1 },
314	);	345	);
315		346
316	=head1 PRIMARY KEY	347	=head1 PRIMARY KEY
Lines 513-521 Composing rels: L</aqorder_users> -> borrowernumber Link Here
513	__PACKAGE__->many_to_many("borrowernumbers", "aqorder_users", "borrowernumber");	544	__PACKAGE__->many_to_many("borrowernumbers", "aqorder_users", "borrowernumber");
514		545
515		546
516	# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-03-09 15:14:35	547	# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-03-10 19:38:20
517	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:somjoqKl7W2FYfhmgw4LQQ	548	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:2kQhxUE0pZ3PpwOqGtvB+g
518		549
519		550
520	# You can replace this text with custom content, and it will be preserved on regeneration	551	# You can replace this text with custom code or comments, and it will be preserved on regeneration
521	1;	552	1;

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

Lines 54-59 use CGI qw ( -utf8 ); Link Here

(-)a/acqui/basketgroup.pl (+17 lines)
54	use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;	54	use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;
55	use C4::Branch qw/GetBranches/;	55	use C4::Branch qw/GetBranches/;
56	use C4::Members qw/GetMember/;	56	use C4::Members qw/GetMember/;
		57	use Koha::EDI qw/create_edi_order get_edifact_ean/;
57		58
58	use Koha::Acquisition::Bookseller;	59	use Koha::Acquisition::Bookseller;
59		60
Lines 206-217 sub printbasketgrouppdf{ Link Here
206		207
207	}	208	}
208		209
		210	sub generate_edifact_orders {
		211	my $basketgroupid = shift;
		212	my $baskets = GetBasketsByBasketgroup($basketgroupid);
		213	my $ean = get_edifact_ean();
		214
		215	for my $basket ( @{$baskets} ) {
		216	create_edi_order( { ean => $ean, basketno => $basket->{basketno}, } );
		217	}
		218	return;
		219	}
		220
209	my $op = $input->param('op') \|\| 'display';	221	my $op = $input->param('op') \|\| 'display';
210	# possible values of $op :	222	# possible values of $op :
211	# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup	223	# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
212	# - mod_basket : modify an individual basket of the basketgroup	224	# - mod_basket : modify an individual basket of the basketgroup
213	# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list	225	# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
214	# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list	226	# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
		227	# - ediprint : generate edi order messages for the baskets in the group
215	# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list	228	# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
216	# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list	229	# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
217	# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list	230	# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list
Lines 370-375 if ( $op eq "add" ) { Link Here
370	$redirectpath .= "&listclosed=1" if $closedbg ;	383	$redirectpath .= "&listclosed=1" if $closedbg ;
371	print $input->redirect($redirectpath );	384	print $input->redirect($redirectpath );
372		385
		386	} elsif ( $op eq 'ediprint') {
		387	my $basketgroupid = $input->param('basketgroupid');
		388	generate_edifact_orders( $basketgroupid );
		389	exit;
373	}else{	390	}else{
374	# no param : display the list of all basketgroups for a given vendor	391	# no param : display the list of all basketgroups for a given vendor
375	my $basketgroups = &GetBasketgroups($booksellerid);	392	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 3 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 (+62 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 3 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	my $cmd = $q->param('op');
	42	if ( $cmd && $cmd == 'delete' ) {
	43	my $id = $q->param->('message_id');
	44	my $msg = $schema->resultset('EdifactMessage')->find($id);
	45	$msg->deleted(1);
	46	$msg->update;
	47	}
	48
	49	my @msgs = $schema->resultset('EdifactMessage')->search(
	50	{
	51	deleted => 0,
	52	},
	53	{
	54	join => 'vendor',
	55	order_by => { -desc => 'transfer_date' },
	56	}
	57
	58	)->all;
	59
	60	$template->param( messages => \@msgs );
	61
	62	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 3 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 (+155 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 3 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	responses_enabled => defined $input->param('responses_enabled'),
99	auto_orders => defined $input->param('auto_orders'),
100	id_code_qualifier => $input->param('id_code_qualifier'),
101	};
102
103	if ($id) {
104	$schema->resultset('VendorEdiAccount')->search(
105	{
106	id => $id,
107	}
108	)->update_all($fields);
109	}
110	else { # new record
111	$schema->resultset('VendorEdiAccount')->create($fields);
112	}
113	}
114	elsif ( $op eq 'delete_confirmed' ) {
115
116	$schema->resultset('VendorEdiAccount')
117	->search( { id => $input->param('id'), } )->delete_all;
118	}
119
120	# we do a default dispaly after deletes and saves
121	# as well as when thats all you want
122	$template->param( display => 1 );
123	my @ediaccounts = $schema->resultset('VendorEdiAccount')->search(
124	{},
125	{
126	join => 'vendor',
127	}
128	);
129	$template->param( ediaccounts => \@ediaccounts );
130	}
131
132	output_html_with_http_headers( $input, $cookie, $template->output );
133
134	sub get_account {
135	my $id = shift;
136
137	my $account = $schema->resultset('VendorEdiAccount')->find($id);
138	if ($account) {
139	return $account;
140	}
141
142	# passing undef will default to add
143	return;
144	}
145
146	sub show_account {
147	my $acct_id = $input->param('id');
148	if ($acct_id) {
149	my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id);
150	if ($acct) {
151	$template->param( account => $acct );
152	}
153	}
154	return;
155	}

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 3 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/installer/data/mysql/atomicupdate/edifact.sql (+78 lines)
		1	-- Holds details for vendors supplying goods by EDI
		2	CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
		3	id int(11) NOT NULL auto_increment,
		4	description text NOT NULL,
		5	host varchar(40),
		6	username varchar(40),
		7	password varchar(40),
		8	last_activity date,
		9	vendor_id int(11) references aqbooksellers( id ),
		10	download_directory text,
		11	upload_directory text,
		12	san varchar(20),
		13	id_code_qualifier varchar(3) default '14',
		14	transport varchar(6) default 'FTP',
		15	quotes_enabled tinyint(1) not null default 0,
		16	invoices_enabled tinyint(1) not null default 0,
		17	orders_enabled tinyint(1) not null default 0,
		18	responses_enabled tinyint(1) not null default 0,
		19	auto_orders tinyint(1) not null default 0,
		20	shipment_budget integer(11) references aqbudgets( budget_id ),
		21	PRIMARY KEY (id),
		22	KEY vendorid (vendor_id),
		23	KEY shipmentbudget (shipment_budget),
		24	CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		25	CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
		26	) ENGINE=InnoDB DEFAULT CHARSET=utf8;
		27
		28	-- Hold the actual edifact messages with links to associated baskets
		29	CREATE TABLE IF NOT EXISTS edifact_messages (
		30	id int(11) NOT NULL auto_increment,
		31	message_type varchar(10) NOT NULL,
		32	transfer_date date,
		33	vendor_id int(11) references aqbooksellers( id ),
		34	edi_acct integer references vendor_edi_accounts( id ),
		35	status text,
		36	basketno int(11) REFERENCES aqbasket( basketno),
		37	raw_msg mediumtext,
		38	filename text,
		39	deleted boolean not null default 0,
		40	PRIMARY KEY (id),
		41	KEY vendorid ( vendor_id),
		42	KEY ediacct (edi_acct),
		43	KEY basketno ( basketno),
		44	CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		45	CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
		46	CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
		47	) ENGINE=InnoDB DEFAULT CHARSET=utf8;
		48
		49	-- invoices link back to the edifact message it was generated from
		50	ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id );
		51
		52	-- clean up link on deletes
		53	ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL;
		54
		55	-- Hold the supplier ids from quotes for ordering
		56	-- although this is an EAN-13 article number the standard says 35 characters ???
		57	ALTER TABLE aqorders ADD COLUMN line_item_id varchar(35);
		58
		59	-- The suppliers unique reference usually a quotation line number ('QLI')
		60	-- Otherwise Suppliers unique orderline reference ('SLI')
		61	ALTER TABLE aqorders ADD COLUMN suppliers_reference_number varchar(35);
		62	ALTER TABLE aqorders ADD COLUMN suppliers_reference_qualifier varchar(3);
		63	ALTER TABLE aqorders ADD COLUMN suppliers_report text;
		64
65	-- hold the EAN/SAN used in ordering
66	CREATE TABLE IF NOT EXISTS edifact_ean (
67	ee_id integer(11) unsigned not null auto_increment primary key,
68	branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode),
69	ean varchar(15) NOT NULL,
70	id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14',
71	CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
72	) ENGINE=InnoDB DEFAULT CHARSET=utf8;
73
74	-- Syspref budget to hold shipping costs
75	INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages', 'free');
76
77	-- Add a permission for managing EDI
78	INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions');

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 (+90 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	<th>Action</th>
		46	</thead>
		47	<tbody>
		48	[% FOREACH msg IN messages %]
		49	<tr>
		50	<td>[% msg.message_type %]</td>
		51	<td>[% msg.transfer_date %]</td>
		52	<td>[% msg.status %]</td>
		53	<td>
		54	<a href="/cgi-bin/koha/acqui/supplier.pl?booksellerid=[% msg.vendor_id %]"</a>
		55	[% msg.vendor.name %]
		56	</td>
		57	<td>
		58	[% IF msg.message_type == 'QUOTE' \|\| msg.message_type == 'ORDERS' %]
		59	[% IF msg.basketno %]
		60	<a href="/cgi-bin/koha/acqui/basket.pl?basketno=[% msg.basketno.basketno %]">
		61	Basket: [% msg.basketno.basketno %]
		62	</a>
		63	[% END %]
		64	[% ELSE %]
65	<!-- Assuming invoices -->
66	<a href="/cgi-bin/koha/acqui/invoices.pl?message_id=[% msg.id %]">
67	Invoices
68	</a>
69	[% END %]
70	</td>
71	</td>
72	<td>[% msg.filename %]</td>
73	<td><a class="popup" target="_blank" title="View Message" href="/cgi-bin/koha/acqui/edimsg.pl?id=[% msg.id %]"</a>View Message</td>
74	<td>
75	<a href="/cgi-bin/koha/acqui/edifactmsgs.pl?op=delete&message_id=[% msg.id %]">Delete</a>
76	</td>
77	</tr>
78	[% END %]
79
80	</tbody>
81	</table>
82
83	</div>
84	</div>
85	</div>
86	<div class="yui-b">
87	[% INCLUDE 'acquisitions-menu.inc' %]
88	</div>
89	</div>
90	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt (+299 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	[% IF account.quotes_enabled %]
147	<input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" checked />
148	[% ELSE %]
149	<input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" />
150	[% END %]
151	</li>
152	<li>
153	<label for="orders_enabled">Orders enabled: </label>
154	[% IF account.orders_enabled %]
155	<input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" checked />
156	[% ELSE %]
157	<input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" />
158	[% END %]
159	</li>
160	<li>
161	<label for="invoices_enabled">Invoices enabled: </label>
162	[% IF account.invoices_enabled %]
163	<input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" checked />
164	[% ELSE %]
165	<input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" />
166	[% END %]
167	</li>
168	<li>
169	<label for="responses_enabled">Responses enabled: </label>
170	[% IF account.responses_enabled %]
171	<input type="checkbox" name="responses_enabled" id="responses_enabled" value="[% account.responses_enabled %]" checked />
172	[% ELSE %]
173	<input type="checkbox" name="responses_enabled" id="responses_enabled" value="[% account.responses_enabled %]" />
174	[% END %]
175	</li>
176	<li>
177	<label for="auto_orders">Automatic ordring (Quotes generate orders without staff intervention): </label>
178	[% IF account.auto_orders %]
179	<input type="checkbox" name="auto_orders" id="auto_orders" value="[% account.auto_orders %]" checked />
180	[% ELSE %]
181	<input type="checkbox" name="auto_orders" id="auto_orders" value="[% account.auto_orders %]" />
182	[% END %]
183	</li>
184	</ol>
185	</fieldset>
186
187	<fieldset class="action">
188	<input type="submit" value="Submit" />
189	<a href="/cgi-bin/koha/admin/edi_accounts.pl" class="cancel">Cancel</a>
190	</fieldset>
191	</form>
192
193	[% END %]
194	[% IF delete_confirm %]
195	<div class="dialog alert">
196	<h3>Delete this account?</h3>
197	<table>
198	<tr>
199	<th>Vendor</th>
200	<td>[% account.vendor %]</td>
201	</tr>
202	<tr>
203	<th>Description</th>
204	<td>[% account.description %]</td>
205	</tr>
206	<tr>
207	<th>SAN</th>
208	<td>[% account.san %]</td>
209	</tr>
210	</table>
211	<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="post">
212	<table>
213	</table>
214	<input type="hidden" name="op" value="delete_confirmed" />
215	<input type="hidden" name="id" value="[% account.id %]" />
216	<input type="submit" class="approve" value="Yes, Delete" />
217	</form>
218	<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="get">
219	<input type="submit" class="deny" value="No, do not Delete" />
220	</form>
221	[% END %]
222	[% IF display %]
223	<h2>Vendor EDI accounts</h2>
224
225	<table>
226	<tr>
227	<th>ID</th>
228	<th>Vendor</th>
229	<th>Description</th>
230	<th>Transport</th>
231	<th>Remote host</th>
232	<th>Username</th>
233	<th>Password</th>
234	<th>Download Directory</th>
235	<th>Upload Directory</th>
236	<th>id_code_type</th>
237	<th>id_code</th>
238	<th>Quotes</th>
239	<th>Orders</th>
240	<th>Invoices</th>
241	<th>Responses</th>
242	<th>Auto ordering</th>
243	<th>Actions</th>
244	</tr>
245	[% FOREACH account IN ediaccounts %]
246	[% IF loop.even %]<tr>
247	[% ELSE %]<tr class="highlight">
248	[% END %]
249	<td>[% account.id %]</td>
250	<td><a href="/cgi-bin/koha/acqui/supplier.pl?supplierid=[% account.vendor_id %]">[% account.vendor.name %]</a></td>
251	<td>[% account.description %]</td>
252	<td>[% account.transport %]</td>
253	<td>[% account.host %]</td>
254	<td>[% account.username %]</td>
255	<td>[% IF account.password %]xxxxx[% END %]</td>
256	<td>[% account.download_directory %]</td>
257	<td>[% account.upload_directory %]</td>
258	<td>[% account.id_code_qualifier %]</td>
259	<td>[% account.san %]</td>
260	[% IF account.quotes_enabled %]
261	<td>Y</td>
262	[% ELSE %]
263	<td>N</td>
264	[% END %]
265	[% IF account.orders_enabled %]
266	<td>Y</td>
267	[% ELSE %]
268	<td>N</td>
269	[% END %]
270	[% IF account.invoices_enabled %]
271	<td>Y</td>
272	[% ELSE %]
273	<td>N</td>
274	[% END %]
275	[% IF account.responses_enabled %]
276	<td>Y</td>
277	[% ELSE %]
278	<td>N</td>
279	[% END %]
280	[% IF account.auto_orders %]
281	<td>Y</td>
282	[% ELSE %]
283	<td>N</td>
284	[% END %]
285	<td align="center">
286	<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>
287	</td>
288	</tr>
289	[% END %]
290	</table>
291	[% END %]
292
293	</div>
294	</div>
295	<div class="yui-b">
296	[% INCLUDE 'admin-menu.inc' %]
297	</div>
298	</div>
299	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

(-)a/misc/cronjobs/edi_cron.pl (+163 lines)
		1	#!/usr/bin/perl
		2	#
		3	# Copyright 2013,2014,2015 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 3 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	use utf8;
		23
		24	# Handles all the edi processing for a site
		25	# loops through the vendor_edifact records and uploads and downloads
		26	# edifact files if the appropriate type is enabled
		27	# downloaded quotes, invoices and responses are processed here
		28	# if orders are enabled and present they are generated and sent
		29	# can be run as frequently as required
		30	# log messages are appended to logdir/editrace.log
		31
		32	use C4::Context;
		33	use Log::Log4perl qw(:easy);
		34	use Koha::Database;
		35	use Koha::EDI qw( process_quote process_invoice process_ordrsp);
		36	use Koha::Edifact::Transport;
		37	use Fcntl qw( :DEFAULT :flock :seek );
		38
		39	my $logdir = C4::Context->logdir;
		40
		41	# logging set to trace as this may be what you
		42	# want on implementation
		43	Log::Log4perl->easy_init(
		44	{
		45	level => $TRACE,
		46	file => ">>$logdir/editrace.log",
		47	}
		48	);
		49
		50	# we dont have a lock dir in context so use the logdir
		51	my $pidfile = "$logdir/edicron.pid";
		52
		53	my $pid_handle = check_pidfile();
		54
		55	my $schema = Koha::Database->new()->schema();
		56
		57	my @edi_accts = $schema->resultset('VendorEdiAccount')->all();
		58
		59	my $logger = Log::Log4perl->get_logger();
		60
		61	for my $acct (@edi_accts) {
		62	if ( $acct->quotes_enabled ) {
		63	my $downloader = Koha::Edifact::Transport->new( $acct->id );
		64	$downloader->download_messages('QUOTE');
65
66	}
67
68	if ( $acct->invoices_enabled ) {
69	my $downloader = Koha::Edifact::Transport->new( $acct->id );
70	$downloader->download_messages('INVOICE');
71
72	}
73	if ( $acct->orders_enabled ) {
74
75	# select pending messages
76	my @pending_orders = $schema->resultset('EdifactMessage')->search(
77	{
78	message_type => 'ORDERS',
79	vendor_id => $acct->vendor_id,
80	status => 'Pending',
81	}
82	);
83	my $uploader = Koha::Edifact::Transport->new( $acct->id );
84	$uploader->upload_messages(@pending_orders);
85	}
86	if ( $acct->responses_enabled ) {
87	my $downloader = Koha::Edifact::Transport->new( $acct->id );
88	$downloader->download_messages('ORDRSP');
89	}
90	}
91
92	# process any downloaded quotes
93
94	my @downloaded_quotes = $schema->resultset('EdifactMessage')->search(
95	{
96	message_type => 'QUOTE',
97	status => 'new',
98	}
99	)->all;
100
101	foreach my $quote_file (@downloaded_quotes) {
102	my $filename = $quote_file->filename;
103	$logger->trace("Processing quote $filename");
104	process_quote($quote_file);
105	}
106
107	# process any downloaded invoices
108
109	my @downloaded_invoices = $schema->resultset('EdifactMessage')->search(
110	{
111	message_type => 'INVOICE',
112	status => 'new',
113	}
114	)->all;
115
116	foreach my $invoice (@downloaded_invoices) {
117	my $filename = $invoice->filename();
118	$logger->trace("Processing invoice $filename");
119	process_invoice($invoice);
120	}
121
122	my @downloaded_responses = $schema->resultset('EdifactMessage')->search(
123	{
124	message_type => 'ORDRSP',
125	status => 'new',
126	}
127	)->all;
128
129	foreach my $response (@downloaded_responses) {
130	my $filename = $response->filename();
131	$logger->trace("Processing order response $filename");
132	process_ordrsp($response);
133	}
134
135	if ( close $pid_handle ) {
136	unlink $pidfile;
137	exit 0;
138	}
139	else {
140	$logger->error("Error on pidfile close: $!");
141	exit 1;
142	}
143
144	sub check_pidfile {
145
146	# sysopen my $fh, $pidfile, O_EXCL \| O_RDWR or log_exit "$0 already running"
147	sysopen my $fh, $pidfile, O_RDWR \| O_CREAT
148	or log_exit("$0: open $pidfile: $!");
149	flock $fh => LOCK_EX or log_exit("$0: flock $pidfile: $!");
150
151	sysseek $fh, 0, SEEK_SET or log_exit("$0: sysseek $pidfile: $!");
152	truncate $fh, 0 or log_exit("$0: truncate $pidfile: $!");
153	print $fh "$$\n" or log_exit("$0: print $pidfile: $!");
154
155	return $fh;
156	}
157
158	sub log_exit {
159	my $error = shift;
160	$logger->error($error);
161
162	exit 1;
163	}

Line 0 Link Here

(-)a/misc/cronjobs/remove_temporary_edifiles.pl (+41 lines)
	1	#!/usr/bin/perl
	2	use strict;
	3	use warnings;
	4
	5	use C4::Context;
	6
	7	# this script will remove those older than 5 days
	8	my $tmpdir = '/tmp';
	9	#
	10	opendir( my $dh, $tmpdir) \|\| die "Cannot open $tmpdir : $!";
	11
	12	my @files_in_tmp = grep { /\.CE[IQ]$/ && -f "$tmpdir/$_" } readdir($dh);
	13	closedir $dh;
	14
	15
	16	my $dbh = C4::Context->dbh;
	17
	18	my $query =<<'ENDSQL';
	19	select filename from edifact_messages
	20	where message_type IN ('QUOTE','INVOICE')
	21	and datediff( CURDATE(), transfer_date ) > 5
	22	ENDSQL
	23
	24	my $ingested;
	25
	26	@{$ingested} = $dbh->selectcol_arrayref($query);
	27
	28	my %ingested_hash = map { $_ => 1 } @{$ingested};
	29
	30	my @delete_list;
	31
	32	foreach (@files_in_tmp) {
	33	if ( exists $ingested_hash{$_} ) {
	34	push @delete_list, $_;
	35	}
	36	}
	37
	38	if ( @delete_list ) {
	39	chdir $tmpdir;
	40	unlink @delete_list;
	41	}

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/edi_testfiles/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 (+121 lines)
		1	#!/usr/bin/perl
		2	use strict;
		3	use warnings;
		4	use FindBin qw( $Bin );
		5
		6	use Test::More tests => 34;
		7
		8	BEGIN { use_ok('Koha::Edifact') }
		9
		10	my $filename = "$Bin/edi_testfiles/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->orderline_free_text, $ftx_string, "ftx note retrieved" );
91
92	my $filename2 = "$Bin/edi_testfiles/QUOTES_413514.CEQ";
93
94	my $q2 = Koha::Edifact->new( { filename => $filename2, } );
95	my $messages = $q2->message_array();
96
97	my $orderlines = $messages->[0]->lineitems();
98
99	my $ol = $orderlines->[0];
100
101	my $y = $ol->girfield( 'copy_value', 5 );
102
103	is( $y, undef, 'No extra item generated' );
104
105	$y = $ol->girfield( 'copy_value', 1 );
106	is( $y, '16.99', 'Copy Price returned' );
107
108	$y = $ol->girfield( 'classification', 4 );
109	is( $y, '914.1061', 'Copy classification returned' );
110
111	$y = $ol->girfield( 'fund_allocation', 4 );
112	is( $y, 'REF', 'Copy fund returned' );
113
114	$y = $ol->girfield( 'branch', 4 );
115	is( $y, 'SOU', 'Copy Branch returned' );
116
117	$y = $ol->girfield( 'collection_code', 4 );
118	is( $y, 'ANF', 'Collection code returned' );
119
120	$y = $ol->girfield( 'stock_category', 4 );
121	is( $y, 'RS', 'Copy stock category returned' );

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' );

Line 0 Link Here

(-)a/t/Ediordrsp.t (+59 lines)
	1	#!/usr/bin/perl
	2	use strict;
	3	use warnings;
	4	use FindBin qw( $Bin );
	5
	6	use Test::More tests => 16;
	7
	8	BEGIN { use_ok('Koha::Edifact') }
	9
	10	my $filedir = "$Bin/edi_testfiles";
	11
	12	my @files = map { "$filedir/$_" }
	13	( 'ordrsp1.CEA', 'ordrsp2.CEA', 'ordrsp3.CEA', 'ordrsp4.CEA' );
	14
	15	my @responses;
	16	for my $filename (@files) {
	17
	18	my $order_response = Koha::Edifact->new( { filename => $filename, } );
	19
	20	isa_ok( $order_response, 'Koha::Edifact' );
	21	push @responses, $order_response;
	22	}
	23
	24	# tests on file 1
	25	# Order accepted with amendments
	26	my $order_response = $responses[0];
	27
	28	my $msg = $order_response->message_array();
	29	my $no_of_msg = @{$msg};
	30	is( $no_of_msg, 1, "Correct number of messages returned" );
	31
	32	isa_ok( $msg->[0], 'Koha::Edifact::Message' );
	33
	34	my $lines = $msg->[0]->lineitems();
	35
	36	my $no_of_lines = @{$lines};
	37
	38	is( $no_of_lines, 3, "Correct number of orderlines returned" );
	39
	40	#
	41	is( $lines->[0]->ordernumber(), 'P28837', 'Line 1 correct ordernumber' );
	42	is(
	43	$lines->[0]->coded_orderline_text(),
	44	'Not yet published',
	45	'NP returned and translated'
	46	);
	47
	48	is( $lines->[1]->ordernumber(), 'P28838', 'Line 2 correct ordernumber' );
	49	is( $lines->[1]->action_notification(),
	50	'cancelled', 'Cancelled action returned' );
	51	is( $lines->[1]->coded_orderline_text(),
	52	'Out of print', 'OP returned and translated' );
	53
	54	is( $lines->[2]->ordernumber(), 'P28846', 'Line 3 correct ordernumber' );
	55	is( $lines->[2]->action_notification(),
	56	'recorded', 'Accepted with change action returned' );
	57
	58	is( $lines->[0]->availability_date(), '19971120',
	59	'Availability date returned' );