Initial revision
[wip/koha-chris_n.git] / 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)