Kumara - predecessor to Koha
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

631 lines
16 KiB

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