C4/Interface/ReserveentCDK.pm

   1 package C4::Interface::ReserveentCDK; #asummes C4/Interface/ReserveCDK
   2
   3 #uses Newt
   4
   5 # Copyright 2000-2002 Katipo Communications
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 2 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along with
  19 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  20 # Suite 330, Boston, MA  02111-1307 USA
  21
  22 # FIXME - I'm pretty sure that this, along with the rest of the
  23 # CDK-based stuff, is obsolete.
  24
  25 use C4::Format;
  26 use C4::InterfaceCDK;
  27 use strict;
  28 use Cdk;
  29
  30 require Exporter;
  31 use DBI;
  32 use vars qw($VERSION @ISA @EXPORT);
  33
  34 # set the version for version checking
  35 $VERSION = 0.01;
  36
  37 @ISA = qw(Exporter);
  38 @EXPORT = qw(&FindBiblioScreen &SelectBiblio &MakeReserveScreen);
  39
  40 sub FindBiblioScreen {
  41   my ($env,$title,$numflds,$flds,$fldlns)=@_;
  42   my $titlepanel = titlepanel($env,"Reserves","Find a title");
  43   #my @coltitles=("a","b");
  44   my @rowtitles;
  45   my $nflds =@$flds;
  46   my $ow = 0;
  47   while ($ow < $nflds) {
  48     @rowtitles[$ow]=@$flds[$ow];
  49     $ow++;
  50   }
  51   my @coltitles = ("");
  52   my @coltypes  = ("UMIXED");
  53   my @colwidths = (40);
  54   my $entrymatrix = new Cdk::Matrix (
  55     'ColTitles'=> \@coltitles,
  56     'RowTitles'=> \@rowtitles,
  57     'ColWidths'=> \@colwidths,
  58     'ColTypes'=>  \@coltypes,
  59     'Vrows'=>     7,
  60     'Vcols'=>     1,
  61     'RowSpace'=>  0);
  62   #$entrymatrix->set('BoxCell'=>"FALSE");
  63   #$entrymatrix->draw();
  64   $entrymatrix->inject('Input'=>"KEY_DOWN");
  65   my $reason;
  66   my ($rows,$cols,$info) = $entrymatrix->activate();
  67   my @responses;
  68   if (!defined $rows) {
  69      $reason = "Circ";
  70   } else {
  71      my $i = 0;
  72      while ($i < $numflds) {
  73         $responses[$i] =$info->[$i][0];
  74         $i++;
  75      }
  76   }
  77   return($reason,@responses);
  78 }
  79
  80 sub SelectBiblio {
  81   my ($env,$count,$entries) = @_;
  82   my $titlepanel = titlepanel($env,"Reserves","Select title");
  83   my $biblist = new Cdk::Alphalist('Title'=>"Select a Title",
  84      'List'=>\@$entries,'Height' => 22,'Width' => 76,
  85      'Ypos'=>1);
  86   my $selection = $biblist->activate();
  87   my $reason;
  88   my $result;
  89   if (!defined $selection) {
  90      $reason="Circ";
  91   } else {
  92      $result=$selection;
  93   }
  94   return($reason,$result);
  95 }
  96
  97 sub MakeReserveScreen {
  98   my ($env,$bibliorec,$bitems,$branches) = @_;
  99   my $titlepanel = titlepanel($env,"Reserves","Create Reservation");
 100   my $line = fmtstr($env,$bibliorec->{'title'},"L72");
 101   my $authlen = length($bibliorec->{'author'});
 102   my $testlen = length($bibliorec->{'title'}) + $authlen;
 103   if ($testlen < 72) {
 104      $line = substr($line,0,71-$authlen)." ".$bibliorec->{'author'};
 105      $line = fmtstr($env,$line,"L72");
 106   } else {
 107      my $split = int(($testlen-72)*0.7);
 108      $line = substr($line,0,72+$split-$authlen)." ".$bibliorec->{'author'};
 109      $line = fmtstr($env,$line,"L72");
 110   }
 111   my @book = ($line);
 112   my $bookpanel = new Cdk::Label ('Message' =>\@book,
 113       'Ypos'=>"2");
 114   $bookpanel->draw();
 115   my $branchlist =  new Cdk::Radio('Title'=>"Collection Branch",
 116      'List'=>\@$branches,
 117      'Xpos'=>"20",'Ypos'=>"5",'Width'=>"18",'Height'=>"6");
 118   $branchlist->draw();
 119   my $i = 0;
 120   my $brcnt = @$branches;
 121   my $brdef = 0;
 122   while (($brdef == 0) && ($i < $brcnt)) {
 123     my $brcode = substr(@$branches[$i],0,2);
 124     my $brtest = fmtstr($env,$env->{'branchcode'},"L2");
 125     if ($brcode eq $brtest) {
 126       $brdef = 1
 127     } else {
 128       $branchlist->inject('Input'=>"KEY_DOWN");
 129       $i++;
 130     }
 131   }
 132   $branchlist->inject('Input'=>" ");
 133   my @constraintlist = ("Any item","Only Selected","Except Selected");
 134   my $constrainttype = new Cdk::Radio('Title'=>"Reserve Constraints",
 135      'List'=>\@constraintlist,
 136      'Xpos'=>"54",'Ypos'=>"5",'Width'=>"17",'Height'=>"6");
 137   $constrainttype->draw();
 138   my $numbit   = @$bitems;
 139   my @itemarr;
 140   my $i;
 141   while ($i < $numbit) {
 142      my $bitline = @$bitems[$i];
 143      my @blarr = split("\t",$bitline);
 144      my $line = @blarr[1]." ".@blarr[2];
 145      if (@blarr[3] > 0) {
 146        my $line = $line.@blarr[3];
 147      }
 148      my $line = $line.@blarr[4]." ".@blarr[5];
 149      $line = fmtstr($env,$line,"L40");
 150      #$bitx{$line} = @blarr[0];
 151      $itemarr[$i]=$line;
 152      $i++;
 153   }
 154   my @sel = ("Y ","N ");
 155   my $itemlist = new Cdk::Selection('Title'=>"Items Held",
 156      'List'=>\@itemarr,'Choices'=>\@sel,
 157      'Xpos'=>"1",'Ypos'=>"12",'Width'=>"70",'Height'=>"8");
 158   $itemlist->draw();
 159   my $borrowerentry = new Cdk::Entry('Label'=>"",'Title'=>"Borrower",
 160      'Max'=>"11",'Width'=>"11",
 161      'Xpos'=>"2",'Ypos'=>"5",
 162      'Type'=>"UMIXED");
 163   borrbind($env,$borrowerentry);
 164   # $borrowentry->bind('Key'=>"KEY_TAB",'Function'=>sub {$x = act($scroll1);});
 165   my $complete = 0;
 166   my $reason = "";
 167   my @answers;
 168   while ($complete == 0) {
 169     my $borrowercode = $borrowerentry->activate();
 170     if (!defined $borrowercode) {
 171       $reason="Circ";
 172       $complete = 1;
 173       @answers[0] = ""
 174     } else {
 175       @answers[0] = $borrowercode;
 176       if ($borrowercode ne "") { $complete = 1; };
 177       while ($complete == 1) {
 178         my $x = $branchlist->activate();
 179         if (!defined $x) {
 180           $complete = 0;
 181           @answers[1] = "";
 182         } else {
 183           my @brline = split(" ",@$branches[$x]);
 184           @answers[1] = @brline[0];
 185           $complete = 2;
 186           $answers[2] = "a";
 187           $answers[3] = "";
 188           while ($complete == 2) {
 189             if ($numbit > 1) {
 190               my @constarr = ("a", "o", "e");
 191               my $constans = $constrainttype->activate();
 192               if (!defined $constans) {
 193                 $complete = 1;  # go back a step
 194               } else {
 195                 @answers[2] = $constarr[$constans];
 196                 $complete = 3;
 197                 if ($answers[2] ne "a") {
 198                   while ($complete == 3) {
 199                     my @itemans = $itemlist->activate();
 200                     if (!defined @itemans) {
 201                       $complete = 2; # go back a step
 202                     } else {
 203                       $complete = 4;
 204                       my $no_ans = @itemans;
 205                       my @items;
 206                       my $cnt = @itemans;
 207                       my $i = 0;
 208                       my $j = 0;
 209                       while ($i < $cnt) {
 210                         if ($itemans[$i] == 0) {
 211                           my $bitline = @$bitems[$i];
 212                           my @blarr = split("\t",$bitline);
 213                           @items[$j] = @blarr[0];
 214                           $j++;
 215                         }
 216                         $i++;
 217                       }
 218                       @answers[3] = \@items;
 219                     }
 220                   }
 221                 }
 222               }
 223             } else {
 224               $complete = 3;
 225             }
 226           }
 227         }
 228       }
 229     }
 230   }
 231   return ($reason,@answers);
 232 }
 233 END { }       # module clean-up code here (global destructor)