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 use C4::Format;
  23 use C4::InterfaceCDK;
  24 use strict;
  25 use Cdk;
  26
  27 require Exporter;
  28 use DBI;
  29 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  30
  31 # set the version for version checking
  32 $VERSION = 0.01;
  33
  34 @ISA = qw(Exporter);
  35 @EXPORT = qw(&FindBiblioScreen &SelectBiblio &MakeReserveScreen);
  36 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  37
  38 # your exported package globals go here,
  39 # as well as any optionally exported functions
  40
  41 @EXPORT_OK   = qw($Var1 %Hashit);
  42 # non-exported package globals go here
  43 use vars qw(@more $stuff);
  44
  45 # initalize package globals, first exported ones
  46
  47 my $Var1   = '';
  48 my %Hashit = ();
  49
  50 # then the others (which are still accessible as $Some::Module::stuff)
  51 my $stuff  = '';
  52 my @more   = ();
  53
  54 # all file-scoped lexicals must be created before
  55 # the functions below that use them.
  56
  57 # file-private lexicals go here
  58 my $priv_var    = '';
  59 my %secret_hash = ();
  60
  61 # here's a file-private function as a closure,
  62 # callable as &$priv_func;  it cannot be prototyped.
  63 my $priv_func = sub {
  64   # stuff goes here.
  65 };
  66
  67 # make all your functions, whether exported or not;
  68
  69 sub FindBiblioScreen {
  70   my ($env,$title,$numflds,$flds,$fldlns)=@_;
  71   my $titlepanel = titlepanel($env,"Reserves","Find a title");
  72   #my @coltitles=("a","b");
  73   my @rowtitles;
  74   my $nflds =@$flds;
  75   my $ow = 0;
  76   while ($ow < $nflds) {
  77     @rowtitles[$ow]=@$flds[$ow];
  78     $ow++;
  79   }
  80   my @coltitles = ("");
  81   my @coltypes  = ("UMIXED");
  82   my @colwidths = (40);
  83   my $entrymatrix = new Cdk::Matrix (
  84     'ColTitles'=> \@coltitles,
  85     'RowTitles'=> \@rowtitles,
  86     'ColWidths'=> \@colwidths,
  87     'ColTypes'=>  \@coltypes,
  88     'Vrows'=>     7,
  89     'Vcols'=>     1,
  90     'RowSpace'=>  0);
  91   #$entrymatrix->set('BoxCell'=>"FALSE");
  92   #$entrymatrix->draw();
  93   $entrymatrix->inject('Input'=>"KEY_DOWN");
  94   my $reason;
  95   my ($rows,$cols,$info) = $entrymatrix->activate();
  96   my @responses;
  97   if (!defined $rows) {
  98      $reason = "Circ";
  99   } else {
 100      my $i = 0;
 101      while ($i < $numflds) {
 102         $responses[$i] =$info->[$i][0];
 103         $i++;
 104      }
 105   }
 106   return($reason,@responses);
 107 }
 108
 109 sub SelectBiblio {
 110   my ($env,$count,$entries) = @_;
 111   my $titlepanel = titlepanel($env,"Reserves","Select title");
 112   my $biblist = new Cdk::Alphalist('Title'=>"Select a Title",
 113      'List'=>\@$entries,'Height' => 22,'Width' => 76,
 114      'Ypos'=>1);
 115   my $selection = $biblist->activate();
 116   my $reason;
 117   my $result;
 118   if (!defined $selection) {
 119      $reason="Circ";
 120   } else {
 121      $result=$selection;
 122   }
 123   return($reason,$result);
 124 }
 125
 126 sub MakeReserveScreen {
 127   my ($env,$bibliorec,$bitems,$branches) = @_;
 128   my $titlepanel = titlepanel($env,"Reserves","Create Reservation");
 129   my $line = fmtstr($env,$bibliorec->{'title'},"L72");
 130   my $authlen = length($bibliorec->{'author'});
 131   my $testlen = length($bibliorec->{'title'}) + $authlen;
 132   if ($testlen < 72) {
 133      $line = substr($line,0,71-$authlen)." ".$bibliorec->{'author'};
 134      $line = fmtstr($env,$line,"L72");
 135   } else {
 136      my $split = int(($testlen-72)*0.7);
 137      $line = substr($line,0,72+$split-$authlen)." ".$bibliorec->{'author'};
 138      $line = fmtstr($env,$line,"L72");
 139   }
 140   my @book = ($line);
 141   my $bookpanel = new Cdk::Label ('Message' =>\@book,
 142       'Ypos'=>"2");
 143   $bookpanel->draw();
 144   my $branchlist =  new Cdk::Radio('Title'=>"Collection Branch",
 145      'List'=>\@$branches,
 146      'Xpos'=>"20",'Ypos'=>"5",'Width'=>"18",'Height'=>"6");
 147   $branchlist->draw();
 148   my $i = 0;
 149   my $brcnt = @$branches;
 150   my $brdef = 0;
 151   while (($brdef == 0) && ($i < $brcnt)) {
 152     my $brcode = substr(@$branches[$i],0,2);
 153     my $brtest = fmtstr($env,$env->{'branchcode'},"L2");
 154     if ($brcode eq $brtest) {
 155       $brdef = 1
 156     } else {
 157       $branchlist->inject('Input'=>"KEY_DOWN");
 158       $i++;
 159     }
 160   }
 161   $branchlist->inject('Input'=>" ");
 162   my @constraintlist = ("Any item","Only Selected","Except Selected");
 163   my $constrainttype = new Cdk::Radio('Title'=>"Reserve Constraints",
 164      'List'=>\@constraintlist,
 165      'Xpos'=>"54",'Ypos'=>"5",'Width'=>"17",'Height'=>"6");
 166   $constrainttype->draw();
 167   my $numbit   = @$bitems;
 168   my @itemarr;
 169   my $i;
 170   while ($i < $numbit) {
 171      my $bitline = @$bitems[$i];
 172      my @blarr = split("\t",$bitline);
 173      my $line = @blarr[1]." ".@blarr[2];
 174      if (@blarr[3] > 0) {
 175        my $line = $line.@blarr[3];
 176      }
 177      my $line = $line.@blarr[4]." ".@blarr[5];
 178      $line = fmtstr($env,$line,"L40");
 179      #$bitx{$line} = @blarr[0];
 180      $itemarr[$i]=$line;
 181      $i++;
 182   }
 183   my @sel = ("Y ","N ");
 184   my $itemlist = new Cdk::Selection('Title'=>"Items Held",
 185      'List'=>\@itemarr,'Choices'=>\@sel,
 186      'Xpos'=>"1",'Ypos'=>"12",'Width'=>"70",'Height'=>"8");
 187   $itemlist->draw();
 188   my $borrowerentry = new Cdk::Entry('Label'=>"",'Title'=>"Borrower",
 189      'Max'=>"11",'Width'=>"11",
 190      'Xpos'=>"2",'Ypos'=>"5",
 191      'Type'=>"UMIXED");
 192   borrbind($env,$borrowerentry);
 193   # $borrowentry->bind('Key'=>"KEY_TAB",'Function'=>sub {$x = act($scroll1);});
 194   my $complete = 0;
 195   my $reason = "";
 196   my @answers;
 197   while ($complete == 0) {
 198     my $borrowercode = $borrowerentry->activate();
 199     if (!defined $borrowercode) {
 200       $reason="Circ";
 201       $complete = 1;
 202       @answers[0] = ""
 203     } else {
 204       @answers[0] = $borrowercode;
 205       if ($borrowercode ne "") { $complete = 1; };
 206       while ($complete == 1) {
 207         my $x = $branchlist->activate();
 208         if (!defined $x) {
 209           $complete = 0;
 210           @answers[1] = "";
 211         } else {
 212           my @brline = split(" ",@$branches[$x]);
 213           @answers[1] = @brline[0];
 214           $complete = 2;
 215           $answers[2] = "a";
 216           $answers[3] = "";
 217           while ($complete == 2) {
 218             if ($numbit > 1) {
 219               my @constarr = ("a", "o", "e");
 220               my $constans = $constrainttype->activate();
 221               if (!defined $constans) {
 222                 $complete = 1;  # go back a step
 223               } else {
 224                 @answers[2] = $constarr[$constans];
 225                 $complete = 3;
 226                 if ($answers[2] ne "a") {
 227                   while ($complete == 3) {
 228                     my @itemans = $itemlist->activate();
 229                     if (!defined @itemans) {
 230                       $complete = 2; # go back a step
 231                     } else {
 232                       $complete = 4;
 233                       my $no_ans = @itemans;
 234                       my @items;
 235                       my $cnt = @itemans;
 236                       my $i = 0;
 237                       my $j = 0;
 238                       while ($i < $cnt) {
 239                         if ($itemans[$i] == 0) {
 240                           my $bitline = @$bitems[$i];
 241                           my @blarr = split("\t",$bitline);
 242                           @items[$j] = @blarr[0];
 243                           $j++;
 244                         }
 245                         $i++;
 246                       }
 247                       @answers[3] = \@items;
 248                     }
 249                   }
 250                 }
 251               }
 252             } else {
 253               $complete = 3;
 254             }
 255           }
 256         }
 257       }
 258     }
 259   }
 260   return ($reason,@answers);
 261 }
 262 END { }       # module clean-up code here (global destructor)