C4/Interface/ReserveentCDK.pm

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