233 lines
6.7 KiB
Perl
Executable file
233 lines
6.7 KiB
Perl
Executable file
package C4::Interface::ReserveentCDK; #asummes C4/Interface/ReserveCDK
|
|
|
|
#uses Newt
|
|
|
|
# Copyright 2000-2002 Katipo Communications
|
|
#
|
|
# 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., 59 Temple Place,
|
|
# Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
# FIXME - I'm pretty sure that this, along with the rest of the
|
|
# CDK-based stuff, is obsolete.
|
|
|
|
use C4::Format;
|
|
use C4::InterfaceCDK;
|
|
use strict;
|
|
use Cdk;
|
|
|
|
require Exporter;
|
|
use DBI;
|
|
use vars qw($VERSION @ISA @EXPORT);
|
|
|
|
# set the version for version checking
|
|
$VERSION = 0.01;
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(&FindBiblioScreen &SelectBiblio &MakeReserveScreen);
|
|
|
|
sub FindBiblioScreen {
|
|
my ($env,$title,$numflds,$flds,$fldlns)=@_;
|
|
my $titlepanel = titlepanel($env,"Reserves","Find a title");
|
|
#my @coltitles=("a","b");
|
|
my @rowtitles;
|
|
my $nflds =@$flds;
|
|
my $ow = 0;
|
|
while ($ow < $nflds) {
|
|
@rowtitles[$ow]=@$flds[$ow];
|
|
$ow++;
|
|
}
|
|
my @coltitles = ("");
|
|
my @coltypes = ("UMIXED");
|
|
my @colwidths = (40);
|
|
my $entrymatrix = new Cdk::Matrix (
|
|
'ColTitles'=> \@coltitles,
|
|
'RowTitles'=> \@rowtitles,
|
|
'ColWidths'=> \@colwidths,
|
|
'ColTypes'=> \@coltypes,
|
|
'Vrows'=> 7,
|
|
'Vcols'=> 1,
|
|
'RowSpace'=> 0);
|
|
#$entrymatrix->set('BoxCell'=>"FALSE");
|
|
#$entrymatrix->draw();
|
|
$entrymatrix->inject('Input'=>"KEY_DOWN");
|
|
my $reason;
|
|
my ($rows,$cols,$info) = $entrymatrix->activate();
|
|
my @responses;
|
|
if (!defined $rows) {
|
|
$reason = "Circ";
|
|
} else {
|
|
my $i = 0;
|
|
while ($i < $numflds) {
|
|
$responses[$i] =$info->[$i][0];
|
|
$i++;
|
|
}
|
|
}
|
|
return($reason,@responses);
|
|
}
|
|
|
|
sub SelectBiblio {
|
|
my ($env,$count,$entries) = @_;
|
|
my $titlepanel = titlepanel($env,"Reserves","Select title");
|
|
my $biblist = new Cdk::Alphalist('Title'=>"Select a Title",
|
|
'List'=>\@$entries,'Height' => 22,'Width' => 76,
|
|
'Ypos'=>1);
|
|
my $selection = $biblist->activate();
|
|
my $reason;
|
|
my $result;
|
|
if (!defined $selection) {
|
|
$reason="Circ";
|
|
} else {
|
|
$result=$selection;
|
|
}
|
|
return($reason,$result);
|
|
}
|
|
|
|
sub MakeReserveScreen {
|
|
my ($env,$bibliorec,$bitems,$branches) = @_;
|
|
my $titlepanel = titlepanel($env,"Reserves","Create Reservation");
|
|
my $line = fmtstr($env,$bibliorec->{'title'},"L72");
|
|
my $authlen = length($bibliorec->{'author'});
|
|
my $testlen = length($bibliorec->{'title'}) + $authlen;
|
|
if ($testlen < 72) {
|
|
$line = substr($line,0,71-$authlen)." ".$bibliorec->{'author'};
|
|
$line = fmtstr($env,$line,"L72");
|
|
} else {
|
|
my $split = int(($testlen-72)*0.7);
|
|
$line = substr($line,0,72+$split-$authlen)." ".$bibliorec->{'author'};
|
|
$line = fmtstr($env,$line,"L72");
|
|
}
|
|
my @book = ($line);
|
|
my $bookpanel = new Cdk::Label ('Message' =>\@book,
|
|
'Ypos'=>"2");
|
|
$bookpanel->draw();
|
|
my $branchlist = new Cdk::Radio('Title'=>"Collection Branch",
|
|
'List'=>\@$branches,
|
|
'Xpos'=>"20",'Ypos'=>"5",'Width'=>"18",'Height'=>"6");
|
|
$branchlist->draw();
|
|
my $i = 0;
|
|
my $brcnt = @$branches;
|
|
my $brdef = 0;
|
|
while (($brdef == 0) && ($i < $brcnt)) {
|
|
my $brcode = substr(@$branches[$i],0,2);
|
|
my $brtest = fmtstr($env,$env->{'branchcode'},"L2");
|
|
if ($brcode eq $brtest) {
|
|
$brdef = 1
|
|
} else {
|
|
$branchlist->inject('Input'=>"KEY_DOWN");
|
|
$i++;
|
|
}
|
|
}
|
|
$branchlist->inject('Input'=>" ");
|
|
my @constraintlist = ("Any item","Only Selected","Except Selected");
|
|
my $constrainttype = new Cdk::Radio('Title'=>"Reserve Constraints",
|
|
'List'=>\@constraintlist,
|
|
'Xpos'=>"54",'Ypos'=>"5",'Width'=>"17",'Height'=>"6");
|
|
$constrainttype->draw();
|
|
my $numbit = @$bitems;
|
|
my @itemarr;
|
|
my $i;
|
|
while ($i < $numbit) {
|
|
my $bitline = @$bitems[$i];
|
|
my @blarr = split("\t",$bitline);
|
|
my $line = @blarr[1]." ".@blarr[2];
|
|
if (@blarr[3] > 0) {
|
|
my $line = $line.@blarr[3];
|
|
}
|
|
my $line = $line.@blarr[4]." ".@blarr[5];
|
|
$line = fmtstr($env,$line,"L40");
|
|
#$bitx{$line} = @blarr[0];
|
|
$itemarr[$i]=$line;
|
|
$i++;
|
|
}
|
|
my @sel = ("Y ","N ");
|
|
my $itemlist = new Cdk::Selection('Title'=>"Items Held",
|
|
'List'=>\@itemarr,'Choices'=>\@sel,
|
|
'Xpos'=>"1",'Ypos'=>"12",'Width'=>"70",'Height'=>"8");
|
|
$itemlist->draw();
|
|
my $borrowerentry = new Cdk::Entry('Label'=>"",'Title'=>"Borrower",
|
|
'Max'=>"11",'Width'=>"11",
|
|
'Xpos'=>"2",'Ypos'=>"5",
|
|
'Type'=>"UMIXED");
|
|
borrbind($env,$borrowerentry);
|
|
# $borrowentry->bind('Key'=>"KEY_TAB",'Function'=>sub {$x = act($scroll1);});
|
|
my $complete = 0;
|
|
my $reason = "";
|
|
my @answers;
|
|
while ($complete == 0) {
|
|
my $borrowercode = $borrowerentry->activate();
|
|
if (!defined $borrowercode) {
|
|
$reason="Circ";
|
|
$complete = 1;
|
|
@answers[0] = ""
|
|
} else {
|
|
@answers[0] = $borrowercode;
|
|
if ($borrowercode ne "") { $complete = 1; };
|
|
while ($complete == 1) {
|
|
my $x = $branchlist->activate();
|
|
if (!defined $x) {
|
|
$complete = 0;
|
|
@answers[1] = "";
|
|
} else {
|
|
my @brline = split(" ",@$branches[$x]);
|
|
@answers[1] = @brline[0];
|
|
$complete = 2;
|
|
$answers[2] = "a";
|
|
$answers[3] = "";
|
|
while ($complete == 2) {
|
|
if ($numbit > 1) {
|
|
my @constarr = ("a", "o", "e");
|
|
my $constans = $constrainttype->activate();
|
|
if (!defined $constans) {
|
|
$complete = 1; # go back a step
|
|
} else {
|
|
@answers[2] = $constarr[$constans];
|
|
$complete = 3;
|
|
if ($answers[2] ne "a") {
|
|
while ($complete == 3) {
|
|
my @itemans = $itemlist->activate();
|
|
if (!defined @itemans) {
|
|
$complete = 2; # go back a step
|
|
} else {
|
|
$complete = 4;
|
|
my $no_ans = @itemans;
|
|
my @items;
|
|
my $cnt = @itemans;
|
|
my $i = 0;
|
|
my $j = 0;
|
|
while ($i < $cnt) {
|
|
if ($itemans[$i] == 0) {
|
|
my $bitline = @$bitems[$i];
|
|
my @blarr = split("\t",$bitline);
|
|
@items[$j] = @blarr[0];
|
|
$j++;
|
|
}
|
|
$i++;
|
|
}
|
|
@answers[3] = \@items;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
$complete = 3;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return ($reason,@answers);
|
|
}
|
|
END { } # module clean-up code here (global destructor)
|