Initial revision
[wip/koha-chris_n.git] / C4 / InterfaceCDK.pm
1
2 package C4::InterfaceCDK; #asummes C4/InterfaceCDK
3
4 #uses Newt
5 use C4::Format;
6 use strict;
7 use Cdk;
8 use Date::Manip;
9 use C4::Accounts;
10 use C4::Circulation::Borrissues;
11 use C4::Circulation::Renewals;
12 #use C4::Circulation;
13
14 require Exporter;
15 use DBI;
16 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
17   
18 # set the version for version checking
19 $VERSION = 0.01;
20     
21 @ISA = qw(Exporter);
22 @EXPORT = qw(&dialog &startint &endint &output &clearscreen &pause &helptext
23 &textbox &menu &issuewindow &msg_yn &msg_ny &borrower_dialog &debug_msg &error_msg
24 &info_msg &selborrower &returnwindow &logondialog &borrowerwindow &titlepanel
25 &borrbind &borrfill &preeborr &borrowerbox &brmenu &prmenu);
26 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
27                   
28 # your exported package globals go here,
29 # as well as any optionally exported functions
30
31 @EXPORT_OK   = qw($Var1 %Hashit);
32 # non-exported package globals go here
33 use vars qw(@more $stuff);
34         
35 # initalize package globals, first exported ones
36
37 my $Var1   = '';
38 my %Hashit = ();
39                     
40 # then the others (which are still accessible as $Some::Module::stuff)
41 my $stuff  = '';
42 my @more   = ();
43         
44 # all file-scoped lexicals must be created before
45 # the functions below that se them.
46                 
47 # file-private lexicals go here
48 my $priv_var    = '';
49 my %secret_hash = ();
50
51 #defining keystrokes used for screens
52 my $key_tab  = chr(9);
53 my $key_ctlr = chr(18);
54 my $lastval = $key_ctlr;
55
56 # here's a file-private function as a closure,
57 # callable as &$priv_func;  it cannot be prototyped.
58 my $priv_func = sub {
59   # stuff goes here.
60 };
61                                                     
62 # make all your functions, whether exported or not;
63 sub suspend_cb {
64
65 }
66       
67 sub startint {
68   my ($env,$msg)=@_;
69   Cdk::init();
70 }
71
72 sub menu {
73   my ($env,$type,$title,@items)=@_;
74   $env->{'sysarea'}="Menu";
75   my $titlebar=titlepanel($env,"Koha","Main Menu");
76   my $reason;
77   my $data;
78   my @mitems;
79   my $x = 0;
80   while ($items[$x] ne "") {
81     $mitems[$x]="<C>".$items[$x];
82     $x++;
83   }  
84   if ($type eq 'console'){
85     my $menucnt = @items;
86     my $menu = new Cdk::Scroll ('Title'=>"  ",
87       'List'=>\@mitems,
88       'Height'=> $menucnt+4,
89       'Width'=> 26);
90     # Activate the object.         
91     my ($menuItem) = $menu->activate();
92     # Check the results.
93     undef $menu;
94     if (!defined $menuItem) {      
95       $data = "Quit";
96     }
97     else { 
98       $data = $items[$menuItem];
99     }
100   }
101   return($reason,$data);
102   # end of menu
103 }
104
105   
106 sub clearscreen { 
107 }
108
109 sub pause {
110  
111 }
112
113 sub output {
114   my($left,$top,$msg)=@_;
115   my @outm;
116   $outm[0]=$msg;
117   my $output = new Cdk::Label ('Message' =>\@outm,
118     'Ypos'=>$top, 'Xpos'=>$left, 'Box'=>0);
119   $output->draw();
120   return $output;
121 }
122
123 sub helptext {
124   my ($text)=@_;
125   my $helptext = output(1,24,$text);
126   return $helptext;
127 }
128
129
130 sub titlepanel{
131   my ($env,$title,$title2)=@_;
132   my @header;
133   @header[0] = fmtstr($env,$title,"L24");
134   @header[0] = @header[0].fmtstr($env,
135     $env->{'branchname'}."-".$env->{'queue'},"C28");
136   @header[0] = @header[0].fmtstr($env,$title2,"R24");
137   my $label = new Cdk::Label ('Message' =>\@header,'Ypos'=>0,'Xpos'=>0);
138   $label->draw();
139   return $label;
140   }
141
142 sub msg_yn {
143   my ($env,$text1,$text2)=@_;
144   # Create the dialog buttons.
145   my @buttons = ("Yes", "No");
146   my @mesg = ("<C>$text1", "<C>$text2");
147   # Create the dialog object.
148   my $dialog = new Cdk::Dialog ('Message' => \@mesg, 'Buttons' => \@buttons);
149   my $resp = $dialog->activate();
150   my $response = "Y";
151   if ($resp == 1) {
152     $response = "N";
153   }
154   undef $dialog;
155   return $response;
156 }
157 sub msg_ny {
158   my ($env,$text1,$text2)=@_;
159   # Cdk::init();
160   # Create the dialog buttons.
161   my @buttons = ("No", "Yes");
162   my @mesg = ("<C>$text1", "<C>$text2");
163   # Create the dialog object.
164   my $dialog = new Cdk::Dialog ('Message' => \@mesg, 'Buttons' => \@buttons);
165   my $resp = $dialog->activate();
166   my $response = "N";
167   if ($resp == 1) {
168     $response = "Y";
169   }
170   undef $dialog;
171   return $response;
172 }
173
174 sub debug_msg {
175   my ($env,$text)=@_;
176   if ($env->{'telnet'} eq "Y") {
177     popupLabel (["Debug </R>$text"]);
178 #  } else {
179 #    print "****DEBUG $text****";
180   }  
181   return();
182 }
183
184 sub error_msg {
185   my ($env,$text)=@_;
186   popupLabel (["<C>Error </R>$text"]);
187   return();
188 }
189
190 sub info_msg {
191   my ($env,$text)=@_;
192   popupLabel ([$text]);
193   return();
194 }
195
196 sub endint {
197   Cdk::end();
198 }
199
200
201 sub brmenu {
202   my ($env,$brrecs)=@_;
203   $env->{'sysarea'}="Menu";
204   my $titlebar=titlepanel($env,"Koha","Select branch");
205   my @mitems;
206   my $x = 0;
207   while (@$brrecs[$x] ne "") {
208     my $brrec =@$brrecs[$x]; 
209     $mitems[$x]=fmtstr($env,$brrec->{'branchcode'},"L6");
210     $mitems[$x]=$mitems[$x].fmtstr($env,$brrec->{'branchname'},"L20");
211     $x++;
212   }  
213   my $menu = new Cdk::Scroll ('Title'=>"  ",
214       'List'=>\@mitems,
215       'Height'=> 16,
216       'Width'=> 30);
217   # Activate the object.         
218   my ($menuItem) = $menu->activate();
219   # Check the results.
220   if (defined $menuItem) {      
221     my $brrec = @$brrecs[$menuItem];
222     $env->{'branchcode'} = $brrec->{'branchcode'};
223     $env->{'branchname'} = $brrec->{'branchname'};
224   }
225   undef $menu;
226   undef $titlebar;
227   return();
228   
229 }
230
231 sub prmenu {
232   my ($env,$prrecs)=@_;
233   $env->{'sysarea'}="Menu";
234   my $titlebar=titlepanel($env,"Koha","Select printer");
235   my @mitems;
236   my $x = 0;
237   while (@$prrecs[$x] ne "") {
238     my $prrec =@$prrecs[$x]; 
239     $mitems[$x]=fmtstr($env,$prrec->{'printername'},"L20");
240     $x++;
241   }  
242   my $menu = new Cdk::Scroll ('Title'=>"  ",
243       'List'=>\@mitems,
244       'Height'=> 16,
245       'Width'=> 30);
246   # Activate the object.         
247   my ($menuItem) = $menu->activate();
248   undef $menu;
249   undef $titlebar;
250   # Check the results.
251   if (defined $menuItem) {      
252     my $prrec = @$prrecs[$menuItem];
253     $env->{'queue'} = $prrec->{'printqueue'};
254     $env->{'printtype'} = $prrec->{'printtype'};
255   }
256   return();
257   
258 }
259
260
261 sub borrower_dialog {
262   my ($env)=@_;
263   my $result;
264   my $borrower;
265   my $book;
266   my @coltitles = ("Borrower","Item");
267   my @rowtitles = (" ");
268   my @coltypes  = ("UMIXED","UMIXED");
269   my @colwidths = (12,12);
270   my $matrix = new Cdk::Matrix (
271      'ColTitles'=> \@coltitles,
272      'RowTitles'=> \@rowtitles, 
273      'ColWidths'=> \@colwidths,
274      'ColTypes'=>  \@coltypes,
275      'Vrows'=>     1, 
276      'Vcols'=>     2);
277   borrbind($env,$matrix);
278   #$matrix->draw();
279   my ($rows,$cols,$info) = $matrix->activate(); 
280   if ((!defined $rows) && ($info->[0][0] eq "")) { 
281     $result = "Circ";
282   } else {
283     $borrower = $info->[0][0];
284     $book     = $info->[0][1];
285   }
286   $matrix->erase();
287   $matrix->unregister();
288   undef $matrix;
289   Cdk::refreshCdkScreen();
290   return ($borrower,$result,$book);
291 }
292
293 sub selborrower {
294   my ($env,$dbh,$borrows,$bornums)=@_;
295   my $result;
296   my $label = "Select a borrower";
297   my $scroll = new Cdk::Scroll ('Title'=>$label,
298     'List'=>\@$borrows,'Height'=>15,'Width'=>60);
299   my $returnValue = $scroll->activate ();
300   if (!defined $returnValue) {
301     #$result = "Circ";
302   } else {  
303     $result = substr(@$borrows[$returnValue],0,9);
304   }
305   $scroll->erase();
306   #$scroll->unregister();
307   undef $scroll;
308   Cdk::refreshCdkScreen();
309   return $result;
310 }
311
312 sub issuewindow {
313   my ($env,$title,$dbh,$items1,$items2,$borrower,$amountowing,$odues)=@_;
314   my @functs=("Due Date","Renewals","Payments","Print","Current","Previous");
315   my $titlepanel = titlepanel($env,"Issues","Issue an Item");
316   my $scroll2 = new Cdk::Scroll ('Title'=>"Previous Issues",
317     'List'=>\@$items1,'Height'=> 8,'Width'=>78,'Ypos'=>18);
318   my $scroll1 = new Cdk::Scroll ('Title'=>"Current Issues",
319     'List'=>\@$items2,'Height'=> 8,'Width'=>78,'Ypos'=>9);
320   my $funcmenu = new Cdk::Scroll ('Title'=>"",
321     'List'=>\@functs,'Height'=>5,'Width'=>12,'Ypos'=>3,'Xpos'=>28);
322   my $loanlength = new Cdk::Entry('Label'=>"Due Date:      ",
323     'Max'=>"30",'Width'=>"11",
324     'Xpos'=>0,'Ypos'=>5,'Type'=>"UMIXED");
325   my $x = 0;
326   while ($x < length($env->{'loanlength'})) {
327      $loanlength->inject('Input'=>substr($env->{'loanlength'},$x,1));
328      $x++;
329   }
330   my $borrbox = borrowerbox($env,$borrower,$amountowing);
331   my $entryBox = new Cdk::Entry('Label'=>"Item Barcode:  ",
332      'Max'=>"11",'Width'=>"11",
333      'Xpos'=>"0",'Ypos'=>3,'Type'=>"UMIXED");
334   $scroll2->draw();
335   $scroll1->draw();
336   $funcmenu->draw();
337   $loanlength->draw(); 
338   $borrbox->draw();   
339   #$env->{'loanlength'} = "";
340   #debug_msg($env,"clear len");
341   my $x;
342   my $barcode;
343   $entryBox->preProcess ('Function' => 
344     sub{prebook(@_,$env,$dbh,$funcmenu,$entryBox,$loanlength,
345     $scroll1,$scroll2,$borrower,$amountowing,$odues);});
346   $barcode = $entryBox->activate();
347   my $reason;
348   if (!defined $barcode) {
349     $reason="Finished user"
350   }
351   $borrbox->erase();
352   $entryBox->erase();
353   $scroll2->erase();
354   $scroll1->erase();
355   $funcmenu->erase();
356   $loanlength->erase();
357   undef $titlepanel;
358   undef $borrbox;
359   undef $entryBox;
360   undef $scroll2;
361   undef $scroll1;
362   undef $funcmenu;
363   undef $loanlength;
364   Cdk::refreshCdkScreen();
365   #debug_msg($env,"exiting");    
366   return $barcode,$reason;
367 }  
368 sub actfmenu {
369   my ($env,$dbh,$funcmenu,$entryBox,$loanlength,$scroll1,
370     $scroll2,$borrower,$amountowing,$odues) = @_;
371   my $funct =  $funcmenu->activate();
372   if (!defined $funct) {
373   } elsif ($funct == 0 ) {
374     actloanlength ($env,$entryBox,$loanlength,$scroll1,$scroll2);
375   } elsif ($funct == 1 ) { 
376     $entryBox->erase();
377     $scroll1->erase();
378     $scroll2->erase();
379     $loanlength->erase();
380     $funcmenu->erase();
381     #debug_msg($env,"");
382     C4::Circulation::Renewals::bulkrenew($env,$dbh,
383       $borrower->{'borrowernumber'},$amountowing,$borrower,$odues);
384   } elsif ($funct == 2 ) {
385     $entryBox->erase();
386     $scroll1->erase();
387     $scroll2->erase();
388     $loanlength->erase();
389     $funcmenu->erase();
390     C4::Accounts::reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},
391     $amountowing,$borrower,$odues);
392   } elsif ($funct == 3 ) {
393     C4::Circulation::Borrissues::printallissues ($env,$borrower);
394   } elsif ($funct == 4 ) {
395     actscroll1 ($env,$entryBox,$loanlength,$scroll1,$scroll2);
396   } elsif ($funct == 5 ) {
397     actscroll2 ($env,$entryBox,$loanlength,$scroll1,$scroll2);
398   }
399   Cdk::refreshCdkScreen();
400   $entryBox->unregister();
401   $entryBox->register();
402   return
403 }  
404 sub actscroll1 {
405   my ($env,$entryBox,$loanlength,$scroll1,$scroll2) = @_;
406   $scroll1->activate();
407   return 1;
408 }
409 sub actscroll2 {
410   my ($env,$entryBox,$loanlength,$scroll1,$scroll2) = @_;
411   $scroll2->activate();
412   return 1;
413 }
414 sub actloanlength {
415   my ($env,$entryBox,$loanlength,$scroll1,$scroll2) = @_;
416   my $validdate = "N";
417   while ($validdate eq "N") {
418     my $loanlength = $loanlength->activate();
419     if (!defined $loanlength) {
420       $env->{'loanlength'} = "";
421       $validdate = "Y";
422     } elsif ($loanlength eq "") {
423       $env->{'loanlength'} = "";
424       $validdate = "Y";
425     } else {    
426       my $date = ParseDate($loanlength);
427       if ( $date > ParseDate('today')){
428         $validdate="Y";
429         my $fdate = substr($date,0,4).'-'.substr($date,4,2).'-'.substr($date,6,2);
430         #debug_msg($env,"$date $fdate");
431         $env->{'loanlength'} = $fdate;
432       } else { 
433         error_msg($env,"Invalid date"); 
434       }
435     }
436   }  
437   return;
438 }
439
440 sub prebook {
441   my ($input,$env,$dbh,$funcmenu,$entryBox,$loanlength,
442     $scroll1,$scroll2,$borrower,$amountowing,$odues)= @_;
443   if ($input eq $key_tab) {    
444     actfmenu ($env,$dbh,$funcmenu,$entryBox,$loanlength,$scroll1,
445        $scroll2,$borrower,$amountowing,$odues);
446     return 0;
447   }
448   return 1;
449 }
450                                                           
451 sub borrowerbox {
452   my ($env,$borrower,$amountowing,$odues) = @_;
453   my @borrinfo;
454   my $amountowing = fmtdec($env,$amountowing,"42");
455   my $line = "$borrower->{'cardnumber'} ";
456   $line = $line."$borrower->{'surname'}, ";
457   $line = $line."$borrower->{'title'} $borrower->{'firstname'}";
458   $borrinfo[0]=$line;
459   $line = "$borrower->{'streetaddress'}, $borrower->{'city'}";
460   $borrinfo[1]=$line;
461   $line = "$borrower->{'categorycode'}";
462   if ($borrower->{'gonenoaddress'} == 1) {
463     $line = $line." </R>GNA<!R>";
464   }
465   if ($borrower->{'lost'} == 1) {
466     $line = $line." </R>LOST<!R>";
467   }
468   if ($odues > 0) {
469     $line = $line." </R>ODUE<!R>";
470   }     
471   if ($borrower->{'borrowernotes'} ne "" ) {
472     $line = $line." </R>NOTES<!R>";
473   }
474   if ($amountowing > 0) {
475     $line = $line." </B>\$$amountowing";
476   }
477   $borrinfo[2]=$line;
478   if ($borrower->{'borrowernotes'} ne "" ) {
479     $borrinfo[3]=substr($borrower->{'borrowernotes'},0,40);     
480   }
481   my $borrbox = new Cdk::Label ('Message' =>\@borrinfo,
482     'Ypos'=>3, 'Xpos'=>"RIGHT");
483   return $borrbox;
484 }
485
486 sub returnwindow {
487   my ($env,$title,$item,$items,$borrower,$amountowing,$odues,$dbh,$resp)=@_;
488   #debug_msg($env,$borrower);
489   my $titlepanel = titlepanel($env,"Returns","Scan Item");
490   my @functs=("Payments","Renewal");
491   my $funcmenu = new Cdk::Scroll ('Title'=>"",
492      'List'=>\@functs,'Height'=>5,'Width'=>12,'Ypos'=>3,'Xpos'=>16);
493   my $returnlist = new Cdk::Scroll ('Title'=>"Items Returned",
494      'List'=>\@$items,'Height'=> 12,'Width'=>74,'Ypos'=>10,'Xpos'=>1);
495   $returnlist->draw();
496   $funcmenu->draw();
497   my $borrbox;
498   if ($borrower->{'cardnumber'} ne "") {    
499     $borrbox = borrowerbox($env,$borrower,$amountowing);  
500     $borrbox->draw();
501   } else {
502     if ($resp ne "") {
503       my @text;
504       @text[0] = $resp;
505       $borrbox = new Cdk::Label ('Message' =>\@text, 'Ypos'=>3, 'Xpos'=>"RIGHT");
506       $borrbox->draw();
507     }
508   }  
509   my $bookentry  =  new Cdk::Entry('Label'=>" ",
510      'Max'=>"11",'Width'=>"11",
511      'Xpos'=>"2",'Ypos'=>"3",'Title'=>"Item Barcode",
512      'Type'=>"UMIXED");
513   $bookentry->preProcess ('Function' =>sub{preretbook(@_,$env,$dbh,
514      $funcmenu,$bookentry,$borrower,$amountowing,
515      $odues,$titlepanel,$borrbox,$returnlist);});
516   my $barcode = $bookentry->activate();
517   my $reason;
518   if (!defined $barcode) {
519     $barcode="";
520     $reason="Circ";
521     $bookentry->erase();
522     $funcmenu->erase();
523     if ($borrbox ne "") {$borrbox->erase();}
524     $returnlist->erase();
525   } else {
526     $reason="";
527   }
528   undef $bookentry;
529   undef $funcmenu;
530   undef $borrbox;
531   undef $returnlist;
532   undef $titlepanel;
533   return($reason,$barcode);
534   }
535
536 sub preretbook {
537   my ($input,$env,$dbh,$funcmenu,$bookentry,$borrower,
538   $amountowing,$odues,$titlepanel,$borrbox,$returnlist)=@_;
539   if ($input eq $key_tab) {
540     actrfmenu($env,$dbh,$funcmenu,$bookentry,$borrower,
541     $amountowing,$odues,$titlepanel,$borrbox,$returnlist);
542     return 0;
543   }
544   return 1;
545   }
546
547 sub actrfmenu {
548   my ($env,$dbh,$funcmenu,$bookentry,$borrower,
549     $amountowing,$odues,$titlepanel,$borrbox,$returnlist)= @_;
550   my $funct =  $funcmenu->activate();
551   #debug_msg($env,"funtion $funct");
552   if (!defined $funct) {
553   } elsif ($funct == 1 ) {
554     if ($borrower->{'borrowernumber'} ne "") {
555        $funcmenu->erase();
556        $bookentry->erase();
557        $titlepanel->erase();
558        $borrbox->erase();
559        $returnlist->erase();
560        C4::Circulation::Renewals::bulkrenew($env,$dbh,
561        $borrower->{'borrowernumber'},$amountowing,$borrower,$odues);
562        Cdk::refreshCdkScreen();
563        $funcmenu->draw();
564        $bookentry->draw();
565        $titlepanel->draw();
566        $borrbox->draw();
567        $returnlist->draw();
568     }
569   } elsif ($funct == 0 ) {
570     if ($borrower->{'borrowernumber'} ne "") {
571        $funcmenu->erase();
572        $bookentry->erase();
573        $titlepanel->erase();
574        $borrbox->erase();
575        $returnlist->erase();
576        C4::Accounts::reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},
577        $amountowing,$borrower,$odues);
578        $funcmenu->draw();
579        $bookentry->draw();
580        $titlepanel->draw();
581        $borrbox->draw();
582        $returnlist->draw();
583        #Cdk::refreshCdkScreen();
584     }
585   } 
586 }
587   
588 sub act {
589   my ($obj) = @_;
590   my $ans = $obj->activate();
591   return $ans;
592   }
593
594 sub borrbind {
595   my ($env,$entry) = @_; 
596   my $lastborr = $env->{"bcard"};
597   $entry->preProcess ('Function' => sub {preborr (@_, $env,$entry);});
598 }
599
600 sub preborr {
601   my ($input,$env, $entry) = @_;
602   if ($env->{"bcard"} ne "") {
603 #     error_msg($env,"hi there");  
604     if ($input eq $lastval) {
605 #        error_msg($env,"its a ctrl-r");  
606       borfill($env,$entry);
607       return 0;
608     }
609   } 
610   return 1;
611 }  
612   
613   
614 sub borfill {
615   my ($env,$entry) = @_;
616   error_msg($env,"in borfill: $env->{'bcard'}");
617   my $lastborr = $env->{"bcard"};
618   my $i = 1;
619   $entry->inject('Input'=>$lastborr);
620   while ($i < 9) {
621 #    my $temp=substr($lastborr,$i,1);
622 #    $entry->inject('Input'=>$temp);
623     $i++;
624   }
625    
626 }
627                                
628 END { }       # module clean-up code here (global destructor)
629
630