Attachment #36738 for bug #7736

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

Lines 2493-2498 sub GetInvoices { Link Here

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

Lines 742-747 our $PERL_DEPS = { Link Here

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




package Koha::EDI;

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

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

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

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

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

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

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

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

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

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

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

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

    return;
}

sub process_invoice {
    my $invoice_message = shift;
    my $schema          = $invoice_message->schema;
    $invoice_message->status('processing');
    $invoice_message->update;
    my $vendor_acct;
    my $logger = Log::Log4perl->get_logger();
    my $edi =
      Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
    my $messages = $edi->message_array();

    if ( @{$messages} ) {

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

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

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

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

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

            }

        }
    }

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

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

    $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         = $quote->schema;

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

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

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

    return;
}

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

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

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

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

    my $note = {};

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

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

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

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

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

    if ( $item->girfield('servicing_instruction') ) {

        # not in 3.14 !!!
        $order_hash->{order_vendornote} =
          $item->girfield('servicing_instruction');
    }

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

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

    my $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;

    if ( !$skip ) {

        # $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 $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' ) {
            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,
                }
            );
        }
    }

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

                ++$occurence;
            }

            # 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 ),
                        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];
    }
    else {
        undef $search_isbn;
        $isbn =~ s/\-//xmsg;
        if ( $isbn =~ m/(\d{13})/xms ) {
            my $b_isbn = Business::ISBN->new($1);
            if ( $b_isbn && $b_isbn->is_valid ) {
                $search_isbn = $b_isbn->as_isbn10->as_string( [] );
            }

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

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

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

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

1;
__END__

=head1 NAME

Koha::EDI

=head1 SYNOPSIS

   Module exporting subroutines used in EDI processing for Koha

=head1 DESCRIPTION

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

=head1 BUGS

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

=head1 SUBROUTINES

=head2 process_quote

    process_quote(quote_message);

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

=head2 process_invoice

    process_invoice(invoice_message)

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


=head2 create_edi_order

    create_edi_order( { parameter_hashref } )

    parameters must include basketno and ean

    branchcode can optionally be passed

    returns 1 on success undef otherwise

    if the parameter noingest is set the formatted order is returned
    and not saved in the database. This functionality is intended for debugging only
e
    my $database       = Koha::Database->new();

=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

=head1 AUTHOR

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


=head1 COPYRIGHT

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


=cut




package Koha::Edifact;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    return $self->{transmission};
}

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

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

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

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

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

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

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

    # else use default separators
    return 1;
}

sub segmentize {
    my $raw = shift;

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

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

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

1;
__END__

=head1 NAME

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 it returns
     the object's transmission member

=head2 message_type

     return the object's message type

=head2 message_array

     return an array of Message objects contained in the Edifact transmission

=head1 Internal Methods

=head2 service_string_advice

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

=head2 segmentize

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

=head2 msgcharset

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

=head1 AUTHOR

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


=head1 COPYRIGHT

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


=cut




package Koha::Edifact::Line;

# Copyright 2014, 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 MARC::Record;
use MARC::Field;
use Carp;

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

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

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

sub _parse_lines {
    my $aref = shift;

    my $lin = shift @{$aref};

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

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

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

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

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

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

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

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

    return $d;
}

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

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

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

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

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

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

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

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

    return $bib;
}

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

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

# Accessor methods to line data

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

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

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

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

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

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

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

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

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

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

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

# item_desription_fields accessors

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

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

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

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

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

sub 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 ) = @_;

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

sub extract_gir {
    my $s    = shift;
    my %qmap = (
        LAC => 'barcode',
        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');
}

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

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

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

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

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

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

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

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

1;
__END__

=head1 NAME

Koha::Edifact::Line

=head1 SYNOPSIS

  Class to abstractly handle a Line in an Edifact Transmission

=head1 DESCRIPTION

  Allows access to Edifact line elements by name

=head1 BUGS

  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, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




package Koha::Edifact::Message;

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

use strict;
use warnings;

use Koha::Edifact::Line;

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

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

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

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

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

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

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

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

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

sub message_date {
    my $self = shift;

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

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

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

sub shipment_charge {
    my $self = shift;

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

# return NAD fields

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

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

}

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

1;
__END__

=head1 NAME

Koha::Edifact::Message

=head1 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, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License

=cut




package Koha::Edifact::Order;

use strict;
use warnings;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sub initial_service_segments {
    my $self = shift;

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

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

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

sub interchange_header {
    my $self = shift;

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

    $hdr .= $separator;

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

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

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

sub user_data_message_segments {
    my $self = shift;

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

    $self->order_msg_header();

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

    $self->message_trailer();

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

sub message_trailer {
    my $self = shift;

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

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

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

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

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

    return $trailer;
}

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

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

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

sub message_header {
    my $self = shift;

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

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

sub interchange_trailer {
    my $self = shift;

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

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

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

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

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

    # repeat for for other relevant parties

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

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

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

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

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

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

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

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

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

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

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

    # IMD biblio description
    if ($use_marc_based_description) {

        # get marc from biblioitem->marc

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

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

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

        foreach my $item (@linked_itemnumbers) {
            my $i_obj = $schema->resultset('Item')->find( $item->itemnumber );
            if ( defined $i_obj ) {
                push @items, $i_obj;
            }
        }
    }
    else {
        my $item_hash = {
            itemtype  => $biblioitem->itemtype,
            shelfmark => $biblioitem->cn_class,
        };
        my $branch = $orderline->basketno->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);

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

    return;
}

# ??? Use the IMD MARC
sub marc_based_description {

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

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

    my @itm = ();

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

    return @itm;
}

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

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

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

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

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

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

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

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

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

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

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

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

sub message_date_segment {
    my $dt = shift;

    # qualifier:message_date:format_code

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

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

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

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

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

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

    return "+$identification:$qualifier";
}

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

1;
__END__

=head1 NAME

Koha::Edifact::Order

=head1 SYNOPSIS

Format an Edifact Order message from a Koha basket

=head1 DESCRIPTION

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

=head1 BUGS

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

=head1 METHODS

=head2 new

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

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

=head2 filename

   my $filename = $edi_order->filename()

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

=head2 encode

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

   Encodes the basket as a valid edifact message ready for transmission

=head2 initial_service_segments

    Creates the service segments which begin the message

=head2 interchange_header

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

=head2 user_data_message_segments

    Include message data within the encoded message

=head2 message_trailer

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

=head2 trailing_service_segments

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

   Returns the unique interchange control reference as a 14 digit number

=head2 message_reference

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

=head2 message_header

    Commences a new message

=head2 interchange_trailer

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

=head2 order_msg_header

    Formats the message header segments

=head2 beginning_of_message

    Returns the BGM segment which includes the Koha basket number

=head2 name_and_address

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

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

=head2 order_line

    Creates the message segments wncoding an order line

=head2 marc_based_description

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

=head2 item_description

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

=head2 imd_segment

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

=head2 gir_segments

    Add item level information

=head2 add_gir_identity_number

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

=head2 add_seg

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

=head2 lin_segment

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

=head2 additional_product_id

    Add a PIA segment for an additional product id

=head2 message_date_segment

    Passed a DateTime object returns a correctly formatted DTM segment

=head2 _const

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

=head2 _interchange_sr_identifier

    Format sender and receipient identifiers for use in the interchange header

=head2 encode_text

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

=head2 msg_date_string

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

=head1 AUTHOR

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


=head1 COPYRIGHT

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


=cut




package Koha::Edifact::Segment;

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

use strict;
use warnings;

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

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

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

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

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

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

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

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

sub as_string {
    my $self = shift;

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

    return $string;
}

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

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

##
# String parsing
#

sub _get_elements {
    my $seg = shift;

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

    return \@elem_array;
}

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

sub de_escape {
    my $string = shift;

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

=head1 NAME

Koha::Edifact::Segment - 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, PTFS-Europe Ltd
   This program is free software, You may redistribute it under
   under the terms of the GNU General Public License


=cut




package Koha::Edifact::Transport;

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

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

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

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

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

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

    my @retrieved_files;

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

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

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

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

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

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

sub sftp_download {
    my $self = shift;

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

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

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

    return @downloaded_files;
}

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

sub ftp_download {
    my $self = shift;

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

    # C = ready to retrieve E = Edifact

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

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

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

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

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

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

    return @downloaded_files;
}

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

            }
        }
    }

    $ftp->quit;
    return;
}

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

            }
        }
    }

    # sftp will be closed on object destructor
    return;
}

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

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

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

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

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

sub _get_file_ext {
    my $type = shift;

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

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

    return $msg;
}

1;
__END__

=head1 NAME

Koha::Edifact::Transport

=head1 SYNOPSIS

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


=head1 DESCRIPTION

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


=head1 METHODS

=head2 new

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

=head2 working_directory

    getter and setter for the working_directory attribute

=head2 download_messages

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

=head2 upload_messages

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

=head2 sftp_download

   called by download_messages to perform the download using SFTP

=head2 ingest

   loads downloaded files into the database

=head2 ftp_download

   called by download_messages to perform the download using FTP

=head2 ftp_upload

  called by upload_messages to perform the upload using ftp

=head2 sftp_upload

  called by upload_messages to perform the upload using sftp

=head2 _abort_download

   internal routine to halt operation on error and supply a stacktrace

=head2 _get_file_ext

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

=head2 set_transport_direct

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

=head1 AUTHOR

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


=head1 COPYRIGHT

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


=cut




  },
);

=head2 edifact_messages

Type: has_many

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

=cut

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

=head2 borrowernumbers

Type: many_to_many

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


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


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

Lines 311-316 __PACKAGE__->has_many( Link Here

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




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

=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




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

=head2 edifact_eans

Type: has_many

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

=cut

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

=head2 hold_fill_targets

Type: has_many

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


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


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




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

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

=head1 NAME

Koha::Schema::Result::EdifactEan

=cut

use strict;
use warnings;

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

=head1 TABLE: C<edifact_ean>

=cut

__PACKAGE__->table("edifact_ean");

=head1 ACCESSORS

=head2 branchcode

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

=head2 ean

  data_type: 'varchar'
  is_nullable: 0
  size: 15

=head2 id_code_qualifier

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

=cut

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

=head1 RELATIONS

=head2 branchcode

Type: belongs_to

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

=cut

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


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


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

1;




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

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

=head1 NAME

Koha::Schema::Result::EdifactMessage

=cut

use strict;
use warnings;

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

=head1 TABLE: C<edifact_messages>

=cut

__PACKAGE__->table("edifact_messages");

=head1 ACCESSORS

=head2 id

  data_type: 'integer'
  is_auto_increment: 1
  is_nullable: 0

=head2 message_type

  data_type: 'varchar'
  is_nullable: 0
  size: 10

=head2 transfer_date

  data_type: 'date'
  datetime_undef_if_invalid: 1
  is_nullable: 1

=head2 vendor_id

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=head2 edi_acct

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=head2 status

  data_type: 'text'
  is_nullable: 1

=head2 basketno

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=head2 raw_msg

  data_type: '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 shipment_budget

  data_type: 'integer'
  is_foreign_key: 1
  is_nullable: 1

=cut

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

=head1 PRIMARY KEY

=over 4

=item * L</id>

=back

=cut

__PACKAGE__->set_primary_key("id");

=head1 RELATIONS

=head2 edifact_messages

Type: has_many

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

=cut

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

=head2 shipment_budget

Type: belongs_to

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

=cut

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

=head2 vendor

Type: belongs_to

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

=cut

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


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


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

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

(-)a/acqui/basket.pl (+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		74
72	my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(	75	my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
Lines 83-88 my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( Link Here
83	my $basket = GetBasket($basketno);	86	my $basket = GetBasket($basketno);
84	$booksellerid = $basket->{booksellerid} unless $booksellerid;	87	$booksellerid = $basket->{booksellerid} unless $booksellerid;
85	my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });	88	my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
		89	my $schema = Koha::Database->new()->schema();
		90	my $rs = $schema->resultset('VendorEdiAccount')->search(
		91	{ vendor_id => $booksellerid, } );
		92	$template->param( ediaccount => ($rs->count > 0));
86		93
87	unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {	94	unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
88	$template->param(	95	$template->param(
Lines 236-241 if ( $op eq 'delete_confirm' ) { Link Here
236	} elsif ($op eq 'reopen') {	243	} elsif ($op eq 'reopen') {
237	ReopenBasket($query->param('basketno'));	244	ReopenBasket($query->param('basketno'));
238	print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})	245	print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
		246	}
		247	elsif ( $op eq 'ediorder' ) {
		248	edi_close_and_order()
239	} elsif ( $op eq 'mod_users' ) {	249	} elsif ( $op eq 'mod_users' ) {
240	my $basketusers_ids = $query->param('basketusers_ids');	250	my $basketusers_ids = $query->param('basketusers_ids');
241	my @basketusers = split( /:/, $basketusers_ids );	251	my @basketusers = split( /:/, $basketusers_ids );
Lines 511-513 sub get_order_infos { Link Here
511	}	521	}
512		522
513	output_html_with_http_headers $query, $cookie, $template->output;	523	output_html_with_http_headers $query, $cookie, $template->output;
		524
		525
		526	sub edi_close_and_order {
		527	my $confirm = $query->param('confirm') \|\| $confirm_pref eq '2';
		528	if ($confirm) {
		529	my $edi_params = {
		530	basketno => $basketno,
		531	ean => $ean,
		532	};
		533	if ( $basket->{branch} ) {
		534	$edi_params->{branchcode} = $basket->{branch};
		535	}
		536	if ( create_edi_order($edi_params) ) {
		537	#$template->param( edifile => 1 );
		538	}
		539	CloseBasket($basketno);
		540
		541	# if requested, create basket group, close it and attach the basket
		542	if ( $query->param('createbasketgroup') ) {
		543	my $branchcode;
		544	if ( C4::Context->userenv
		545	and C4::Context->userenv->{'branch'}
		546	and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" )
		547	{
		548	$branchcode = C4::Context->userenv->{'branch'};
		549	}
		550	my $basketgroupid = NewBasketgroup(
		551	{
		552	name => $basket->{basketname},
		553	booksellerid => $booksellerid,
		554	deliveryplace => $branchcode,
		555	billingplace => $branchcode,
		556	closed => 1,
		557	}
		558	);
		559	ModBasket(
		560	{
		561	basketno => $basketno,
		562	basketgroupid => $basketgroupid
		563	}
		564	);
		565	print $query->redirect(
		566	"/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1"
		567	);
		568	}
		569	else {
		570	print $query->redirect(
		571	"/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid"
		572	);
		573	}
		574	exit;
		575	}
		576	else {
		577	$template->param(
		578	edi_confirm => 1,
		579	booksellerid => $booksellerid,
		580	basketno => $basket->{basketno},
		581	basketname => $basket->{basketname},
		582	basketgroupname => $basket->{basketname},
		583	);
		584	if ($ean) {
		585	$template->param( ean => $ean );
		586	}
		587
588	}
589	return;
590	}




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 @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 61-66 my $author = $input->param('author'); Link Here

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




#!/usr/bin/perl

# Copyright 2011,2014 Mark Gavillet & PTFS Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 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'),
            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;
}

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

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




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

--
-- Table structure for table vendor_edi_accounts
--

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

--
-- Table structure for table edifact_messages
--

DROP TABLE IF EXISTS edifact_messages;
CREATE TABLE IF NOT EXISTS edifact_messages (
  id int(11) NOT NULL auto_increment,
  message_type varchar(10) NOT NULL,
  transfer_date date,
  vendor_id int(11) references aqbooksellers( id ),
  edi_acct  integer references vendor_edi_accounts( id ),
  status text,
  basketno int(11) references aqbasket( basketno),
  raw_msg 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 COLLATE=utf8_unicode_ci;

--
-- Table structure for table aqinvoices
--


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


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

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

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

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

Lines 112-117 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here

(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
112	('DisplayOPACiconsXSLT','1','','If ON, displays the format, audience, and material type icons in XSLT MARC21 results and detail pages in the OPAC.','YesNo'),	112	('DisplayOPACiconsXSLT','1','','If ON, displays the format, audience, and material type icons in XSLT MARC21 results and detail pages in the OPAC.','YesNo'),
113	('dontmerge','1',NULL,'If ON, modifying an authority record will not update all associated bibliographic records immediately, ask your system administrator to enable the merge_authorities.pl cron job','YesNo'),	113	('dontmerge','1',NULL,'If ON, modifying an authority record will not update all associated bibliographic records immediately, ask your system administrator to enable the merge_authorities.pl cron job','YesNo'),
114	('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),	114	('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
		115	('EDIInvoicesShippingBudget',NULL,NULL,'The budget code used to allocate shipping charges to when processing EDI Invoice messages','free'),
115	('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'),	116	('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'),
116	('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'),	117	('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'),
117	('EnableOpacSearchHistory','1','YesNo','Enable or disable opac search history',''),	118	('EnableOpacSearchHistory','1','YesNo','Enable or disable opac search history',''),




    SetVersion($DBversion);
}

$DBversion = "3.19.00.XXX";
if( CheckVersion($DBversion) ){

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

    $dbh->do($sql);

    $sql=<<'EM_END';
CREATE TABLE IF NOT EXISTS edifact_messages (
  id int(11) NOT NULL auto_increment,
  message_type varchar(10) NOT NULL,
  transfer_date date,
  vendor_id int(11) references aqbooksellers( id ),
  edi_acct  integer references vendor_edi_accounts( id ),
  status text,
  basketno int(11) REFERENCES aqbasket( basketno),
  raw_msg 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
EM_END

    $dbh->do($sql);

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

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

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

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

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

=head1 FUNCTIONS

=head2 TableExists($table)

Lines 9-12 Link Here

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

Lines 54-59 Link Here

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

Lines 55-60 Link Here

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

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

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




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

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

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

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

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

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




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

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

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

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


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


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

</tbody>
</table>

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




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

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

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

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

Lines 91-96 Link Here

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




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

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

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

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

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

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

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

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

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

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




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

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

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

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

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

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

  </ol>
  </fieldset>

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

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

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

Lines 107-112 Link Here

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




#!/usr/bin/perl
#
# Copyright 2013,2014 PTFS Europe Ltd
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 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;

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

use C4::Context;
use Log::Log4perl qw(:easy);
use Koha::Database;
use Koha::EDI qw( process_quote process_invoice);
use Koha::Edifact::Transport;
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');

        #update vendor last activity
    }

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

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

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

# process any downloaded quotes

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

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

# process any downloaded invoices

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

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

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: $!");
    trucate $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;
}

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

Line 0 Link Here

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




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

use Test::More tests => 19;

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

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

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

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

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

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

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

# check inv number from BGM

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

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

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

my $expected_invoicenumber = '01975490';

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

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

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

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

my $num_lines = @{$lines};

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

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

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

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

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

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

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

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




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

use Test::More tests => 27;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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




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

use Test::More tests => 6;

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


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

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

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

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

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

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

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

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

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

$data_to_encode .= '??';

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

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

Line 0 Link Here

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

Return to bug 7736

Lines 3120-3125 CREATE TABLE aqorders_transfers ( Link Here

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

Lines 9804-9809 if ( CheckVersion($DBversion) ) { Link Here

(-)a/installer/data/mysql/updatedatabase.pl (+80 lines)
9804	SetVersion($DBversion);	9804	SetVersion($DBversion);
9805	}	9805	}
9806		9806
		9807	$DBversion = "3.19.00.XXX";
		9808	if( CheckVersion($DBversion) ){
		9809
		9810	my $sql=<<'VEA_END';
		9811	CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
		9812	id int(11) NOT NULL auto_increment,
		9813	description text NOT NULL,
		9814	host varchar(40),
		9815	username varchar(40),
		9816	password varchar(40),
		9817	last_activity date,
		9818	vendor_id int(11) references aqbooksellers( id ),
		9819	download_directory text,
		9820	upload_directory text,
		9821	san varchar(20),
		9822	id_code_qualifier varchar(3) default '14',
		9823	transport varchar(6) default 'FTP',
		9824	quotes_enabled tinyint(1) not null default 0,
		9825	invoices_enabled tinyint(1) not null default 0,
		9826	orders_enabled tinyint(1) not null default 0,
		9827	shipment_budget integer(11) references aqbudgets( budget_id ),
		9828	PRIMARY KEY (id),
		9829	KEY vendorid (vendor_id),
		9830	KEY shipmentbudget (shipment_budget),
		9831	CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		9832	CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
		9833	) ENGINE=InnoDB DEFAULT CHARSET=utf8
		9834	VEA_END
		9835
		9836	$dbh->do($sql);
		9837
		9838	$sql=<<'EM_END';
		9839	CREATE TABLE IF NOT EXISTS edifact_messages (
		9840	id int(11) NOT NULL auto_increment,
		9841	message_type varchar(10) NOT NULL,
		9842	transfer_date date,
		9843	vendor_id int(11) references aqbooksellers( id ),
		9844	edi_acct integer references vendor_edi_accounts( id ),
		9845	status text,
		9846	basketno int(11) REFERENCES aqbasket( basketno),
		9847	raw_msg mediumtext,
		9848	filename text,
		9849	deleted boolean not null default 0,
		9850	PRIMARY KEY (id),
		9851	KEY vendorid ( vendor_id),
		9852	KEY ediacct (edi_acct),
		9853	KEY basketno ( basketno),
		9854	CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
		9855	CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
		9856	CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
		9857	) ENGINE=InnoDB DEFAULT CHARSET=utf8
		9858	EM_END
		9859
		9860	$dbh->do($sql);
		9861
		9862	$dbh->do('ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id )');
		9863
		9864	$dbh->do(
		9865	'ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL'
		9866	);
		9867
		9868	$sql=<<'EAN_END';
		9869	CREATE TABLE IF NOT EXISTS edifact_ean (
		9870	branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode),
9871	ean varchar(15) NOT NULL,
9872	id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14',
9873	CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
9874	) ENGINE=InnoDB DEFAULT CHARSET=utf8
9875	EAN_END
9876
9877	$dbh->do($sql);
9878	$dbh->do("INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages', 'free')");
9879	$dbh->do(
9880	q{INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions')}
9881	);
9882
9883	print "Upgrade to $DBversion done (Bug 7736 DB Changes for Edifact Processing ( Quote, Order and Invoice))\n";
9884	SetVersion($DBversion);
9885	}
9886
9807	=head1 FUNCTIONS	9887	=head1 FUNCTIONS
9808		9888
9809	=head2 TableExists($table)	9889	=head2 TableExists($table)

Line 0 Link Here

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

Line 0 Link Here

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

Line 0 Link Here

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

Line 0 Link Here

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

Line 0 Link Here

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

Line 0 Link Here

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

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

Line 0 Link Here

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

Line 0 Link Here

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

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

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

Line 0 Link Here

(-)a/acqui/edi_ean.pl (+64 lines)
	1	#!/usr/bin/perl
	2
	3	# Copyright 2012 Mark Gavillet & PTFS Europe Ltd
	4	#
	5	# This file is part of Koha.
	6	#
	7	# Koha is free software; you can redistribute it and/or modify it under the
	8	# terms of the GNU General Public License as published by the Free Software
	9	# Foundation; either version 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 (+55 lines)
	1	#!/usr/bin/perl
	2
	3	# Copyright 2014 PTFS Europe Ltd.
	4	# This file is part of Koha.
	5	#
	6	# Koha is free software; you can redistribute it and/or modify it under the
	7	# terms of the GNU General Public License as published by the Free Software
	8	# Foundation; either version 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
	42	my @msgs = $schema->resultset('EdifactMessage')->search(
	43	{
	44	deleted => 0,
	45	},
	46	{
	47	join => 'vendor',
	48	order_by => { -desc => 'transfer_date' },
	49	}
	50
	51	)->all;
	52
	53	$template->param( messages => \@msgs );
	54
	55	output_html_with_http_headers( $q, $cookie, $template->output );

Line 0 Link Here

(-)a/acqui/edimsg.pl (+72 lines)
		1	#!/usr/bin/perl
		2
		3	# Copyright 2014 PTFS Europe Ltd.
		4	# This file is part of Koha.
		5	#
		6	# Koha is free software; you can redistribute it and/or modify it under the
		7	# terms of the GNU General Public License as published by the Free Software
		8	# Foundation; either version 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 (+153 lines)
		1	#!/usr/bin/perl
		2
		3	# Copyright 2011,2014 Mark Gavillet & PTFS Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 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	id_code_qualifier => $input->param('id_code_qualifier'),
99	};
100
101	if ($id) {
102	$schema->resultset('VendorEdiAccount')->search(
103	{
104	id => $id,
105	}
106	)->update_all($fields);
107	}
108	else { # new record
109	$schema->resultset('VendorEdiAccount')->create($fields);
110	}
111	}
112	elsif ( $op eq 'delete_confirmed' ) {
113
114	$schema->resultset('VendorEdiAccount')
115	->search( { id => $input->param('id'), } )->delete_all;
116	}
117
118	# we do a default dispaly after deletes and saves
119	# as well as when thats all you want
120	$template->param( display => 1 );
121	my @ediaccounts = $schema->resultset('VendorEdiAccount')->search(
122	{},
123	{
124	join => 'vendor',
125	}
126	);
127	$template->param( ediaccounts => \@ediaccounts );
128	}
129
130	output_html_with_http_headers( $input, $cookie, $template->output );
131
132	sub get_account {
133	my $id = shift;
134
135	my $account = $schema->resultset('VendorEdiAccount')->find($id);
136	if ($account) {
137	return $account;
138	}
139
140	# passing undef will default to add
141	return;
142	}
143
144	sub show_account {
145	my $acct_id = $input->param('id');
146	if ($acct_id) {
147	my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id);
148	if ($acct) {
149	$template->param( account => $acct );
150	}
151	}
152	return;
153	}

Line 0 Link Here

(-)a/admin/edi_ean_accounts.pl (+158 lines)
		1	#!/usr/bin/perl
		2
		3	# Copyright 2012, 2014 Mark Gavillet & PTFS Europe Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 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/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt (+38 lines)
	1	[% INCLUDE 'doc-head-open.inc' %]
	2	<title>Koha &rsaquo; Acquisitions &rsaquo; Basket ([% basketno %])</title>
	3	[% INCLUDE 'doc-head-close.inc' %]
	4
	5	</head>
	6	<body>
	7	[% INCLUDE 'header.inc' %]
	8	[% INCLUDE 'acquisitions-search.inc' %]
	9
	10	<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a> &rsaquo; Basket ([% basketno %])</div>
	11
	12	<div id="doc3" class="yui-t2">
	13
	14	<div id="bd">
	15	<div id="yui-main">
	16	<div class="yui-b">
	17
	18	<h2>Identify the branch account submitting the EDI order</h2>
	19	<br />
	20	<form action="/cgi-bin/koha/acqui/basket.pl" method="get">
	21	<p>Select ordering branch account: </p>
	22	<select id="ean" name="ean">
	23	[% FOREACH eanacct IN eans %]
	24	<option value="[% eanacct.ean %]">[% eanacct.branch.branchname %] ([% eanacct.ean %])</option>
	25	[% END %]
	26	</select>
	27	<br />
	28	<input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
	29	<input type="hidden" value="ediorder" name="op" />
	30	<input type="submit" value="Send EDI order" />
	31	</form>
	32	</div>
	33	</div>
	34	<div class="yui-b">
	35	[% INCLUDE 'acquisitions-menu.inc' %]
	36	</div>
	37	</div>
	38	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

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

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt (+277 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	</ol>
169	</fieldset>
170
171	<fieldset class="action">
172	<input type="submit" value="Submit" />
173	<a href="/cgi-bin/koha/admin/edi_accounts.pl" class="cancel">Cancel</a>
174	</fieldset>
175	</form>
176
177	[% END %]
178	[% IF delete_confirm %]
179	<div class="dialog alert">
180	<h3>Delete this account?</h3>
181	<table>
182	<tr>
183	<th>Vendor</th>
184	<td>[% account.vendor %]</td>
185	</tr>
186	<tr>
187	<th>Description</th>
188	<td>[% account.description %]</td>
189	</tr>
190	<tr>
191	<th>SAN</th>
192	<td>[% account.san %]</td>
193	</tr>
194	<tr>
195	<th>Last activity</th>
196	<td>[% account.last_activity %]</td>
197	</tr>
198	</table>
199	<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="post">
200	<table>
201	</table>
202	<input type="hidden" name="op" value="delete_confirmed" />
203	<input type="hidden" name="id" value="[% account.id %]" />
204	<input type="submit" class="approve" value="Yes, Delete" />
205	</form>
206	<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="get">
207	<input type="submit" class="deny" value="No, do not Delete" />
208	</form>
209	[% END %]
210	[% IF display %]
211	<h2>Vendor EDI accounts</h2>
212
213	<table>
214	<tr>
215	<th>ID</th>
216	<th>Vendor</th>
217	<th>Description</th>
218	<th>Transport</th>
219	<th>Remote host</th>
220	<th>Username</th>
221	<th>Password</th>
222	<th>Download Directory</th>
223	<th>Upload Directory</th>
224	<th>id_code_type</th>
225	<th>id_code</th>
226	<th>Quotes</th>
227	<th>Orders</th>
228	<th>Invoices</th>
229	<th>Last activity</th>
230	<th>Actions</th>
231	</tr>
232	[% FOREACH account IN ediaccounts %]
233	[% IF loop.even %]<tr>
234	[% ELSE %]<tr class="highlight">
235	[% END %]
236	<td>[% account.id %]</td>
237	<td><a href="/cgi-bin/koha/acqui/supplier.pl?supplierid=[% account.vendor_id %]">[% account.vendor.name %]</a></td>
238	<td>[% account.description %]</td>
239	<td>[% account.transport %]</td>
240	<td>[% account.host %]</td>
241	<td>[% account.username %]</td>
242	<td>[% IF account.password %]xxxxx[% END %]</td>
243	<td>[% account.download_directory %]</td>
244	<td>[% account.upload_directory %]</td>
245	<td>[% account.id_code_qualifier %]</td>
246	<td>[% account.san %]</td>
247	[% IF account.quotes_enabled %]
248	<td>Y</td>
249	[% ELSE %]
250	<td></td>
251	[% END %]
252	[% IF account.orders_enabled %]
253	<td>Y</td>
254	[% ELSE %]
255	<td></td>
256	[% END %]
257	[% IF account.invoices_enabled %]
258	<td>Y</td>
259	[% ELSE %]
260	<td></td>
261	[% END %]
262	<td>[% account.last_activity %]</td>
263	<td align="center">
264	<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>
265	</td>
266	</tr>
267	[% END %]
268	</table>
269	[% END %]
270
271	</div>
272	</div>
273	<div class="yui-b">
274	[% INCLUDE 'admin-menu.inc' %]
275	</div>
276	</div>
277	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

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

Line 0 Link Here

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

Line 0 Link Here

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

Line 0 Link Here

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