=head3 TransferOrder

    my $newordernumber = TransferOrder($ordernumber, $basketno);

Transfer an order line to a basket.

Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered

to BOOKSELLER on DATE' and create new order with internal note

'Transfered from BOOKSELLER on DATE'.

Move all attached items to the new order.

Received orders cannot be transfered.

Return the ordernumber of created order.

=cut

sub TransferOrder {

    my ($ordernumber, $basketno) = @_;

    return unless $ordernumber or $basketno;

    my $order = GetOrder( $ordernumber );

    return if $order->{datereceived};

    my $today = C4::Dates->new()->output("iso");

    my $query = qq{

        SELECT aqbooksellers.name

        FROM aqorders

            LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno

            LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id

        WHERE aqorders.ordernumber = ?

    };

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

    my $sth = $dbh->prepare($query);

    $sth->execute($ordernumber);

    my ($booksellerfromname) = $sth->fetchrow_array;

    $query = qq{

        SELECT aqbooksellers.name

        FROM aqbasket

            LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id

        WHERE aqbasket.basketno = ?

    };

    $sth = $dbh->prepare($query);

    $sth->execute($basketno);

    my ($booksellertoname) = $sth->fetchrow_array;

    $query = qq{

        UPDATE aqorders

        SET datecancellationprinted = CAST(NOW() AS date),

            internalnotes = ?

        WHERE ordernumber = ?

    };

    $sth = $dbh->prepare($query);

    $sth->execute("Cancelled and transfered to $booksellertoname on $today", $ordernumber);

    delete $order->{'ordernumber'};

    $order->{'basketno'} = $basketno;

    $order->{'internalnotes'} = "Transfered from $booksellerfromname on $today";

    my $newordernumber;

    (undef, $newordernumber) = NewOrder($order);

    $query = qq{

        UPDATE aqorders_items

        SET ordernumber = ?

        WHERE ordernumber = ?

    };

    $sth = $dbh->prepare($query);

    $sth->execute($newordernumber, $ordernumber);

    return $newordernumber;

}

#!/usr/bin/perl

# Script to move an order from a bookseller to another

# Copyright 2011 BibLibre SARL

#

# This file is part of Koha.

#

# Koha is free software; you can redistribute it and/or modify it under the

# terms of the GNU General Public License as published by the Free Software

# Foundation; either version 2 of the License, or (at your option) any later

# version.

#

# Koha is distributed in the hope that it will be useful, but WITHOUT ANY

# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR

# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

#

# You should have received a copy of the GNU General Public License along

# with Koha; if not, write to the Free Software Foundation, Inc.,

# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;

use CGI;

use C4::Auth;

use C4::Output;

use C4::Context;

use C4::Acquisition;

use C4::Bookseller qw/GetBookSellerFromId GetBookSeller/;

use C4::Members;

use C4::Dates qw/format_date_in_iso/;

use Date::Calc qw/Today/;

my $input = new CGI;

my ( $template, $loggedinuser, $cookie ) = get_template_and_user(

    {   template_name   => "acqui/transferorder.tmpl",

        query           => $input,

        type            => "intranet",

        authnotrequired => 1,

        flagsrequired   => { acquisition => 'order_manage' },

        debug           => 1,

    }

);

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

my $bookselleridfrom    = $input->param('bookselleridfrom');

my $ordernumber     = $input->param('ordernumber');

my $bookselleridto  = $input->param('bookselleridto');

my $basketno        = $input->param('basketno');

my $op              = $input->param('op');

my $query           = $input->param('query');

my $order = GetOrder($ordernumber);

if($order) {

    my $basket = GetBasket($order->{basketno});

    $bookselleridfrom = $basket->{booksellerid} if $basket;

}

my $booksellerfrom = GetBookSellerFromId($bookselleridfrom);

my $booksellerfromname;

if($booksellerfrom){

    $booksellerfromname = $booksellerfrom->{name};

}

my $booksellerto = GetBookSellerFromId($bookselleridto);

my $booksellertoname;

if($booksellerto){

    $booksellertoname = $booksellerto->{name};

}

if( $basketno && $ordernumber) {

    # Transfer order and exit

    my $order = GetOrder( $ordernumber );

    my $basket = GetBasket($order->{basketno});

    my $booksellerfrom = GetBookSellerFromId($basket->{booksellerid});

    my $bookselleridfrom = $booksellerfrom->{id};

    TransferOrder($ordernumber, $basketno);

    my $referrer = $input->param('referrer');

    print $input->redirect($referrer);

    exit;

} elsif ( $bookselleridto && $ordernumber) {

    # Show open baskets for this bookseller

    my $order = GetOrder( $ordernumber );

    my $basketfrom = GetBasket( $order->{basketno} );

    my $booksellerfrom = GetBookSellerFromId( $basketfrom->{booksellerid} );

    $booksellerfromname = $booksellerfrom->{name};

    my $baskets = GetBasketsByBookseller( $bookselleridto );

    my $basketscount = scalar @$baskets;

    my @basketsloop = ();

    for( my $i = 0 ; $i < $basketscount ; $i++ ){

        my %line;

        %line = %{ $baskets->[$i] };

        my $createdby = GetMember(borrowernumber => $line{authorisedby});

        $line{createdby} = "$createdby->{surname}, $createdby->{firstname}";

        push @basketsloop, \%line unless $line{closedate};

    }

    $template->param(

        show_baskets => 1,

        basketsloop => \@basketsloop,

        basketfromname => $basketfrom->{basketname},

    );

} elsif ( $bookselleridfrom && !defined $ordernumber) {

    # Show pending orders

    my $pendingorders = GetPendingOrders($bookselleridfrom);

    my $orderscount = scalar @$pendingorders;

    my @ordersloop = ();

    for( my $i = 0 ; $i < $orderscount ; $i++ ){

        my %line;

        %line = %{ $pendingorders->[$i] };

        push @ordersloop, \%line;

    }

    $template->param(

        ordersloop  => \@ordersloop,

    );

} else {

    # Search for booksellers to transfer from/to

    $op = '' unless $op;

    if( $op eq "do_search" ) {

        my @booksellers = GetBookSeller($query);

        $template->param(

            query => $query,

            do_search => 1,

            booksellersloop => \@booksellers,

        );

    } else {

        $template->param(

            search_form => 1,

        );

    }

}

$template->param(

    bookselleridfrom    => $bookselleridfrom,

    booksellerfromname  => $booksellerfromname,

    bookselleridto      => $bookselleridto,

    booksellertoname    => $booksellertoname,

    ordernumber         => $ordernumber,

    basketno            => $basketno,

    referrer            => $input->param('referrer')

);

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

  internalnotes mediumtext DEFAULT NULL,

$DBversion = "XXX";

if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {

    $dbh->do(qq{

        ALTER TABLE aqorders

        ADD COLUMN internalnotes MEDIUMTEXT DEFAULT NULL AFTER notes

    });

    print "Upgrade to $DBversion done (Add internalnotes field in aqorders table)\n";

    SetVersion($DBversion);

}

                            <p>[% books_loo.internalnotes %]</p>

                                [% UNLESS (books_loo.order_received) %]

                                    <br />

                                    <a href="/cgi-bin/koha/acqui/transferorder.pl?ordernumber=[% books_loo.ordernumber %]&referrer=[% "/cgi-bin/koha/acqui/basket.pl?basketno=$basketno" | uri %]">Transfer</a>

                                [% END %]

                      <p>[% order.internalnotes %]</p>

                    <br />

                    <a href="/cgi-bin/koha/acqui/transferorder.pl?ordernumber=[% loop_order.ordernumber %]&amp;referrer=[% "/cgi-bin/koha/acqui/parcel.pl?booksellerid=$booksellerid&datereceived=$invoicedatereceived&invoice=$invoice" | uri %]">Transfer</a>