koha-curses/circ.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id$
   4
   5 # Copyright 2005 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 strict;
  23 use lib '/usr/local/koha/intranet/modules';
  24 use Curses::UI;
  25 use C4::Circulation::Circ2;
  26 use C4::Members;
  27 use C4::Print;
  28 use C4::Context;
  29
  30 my $cui = new Curses::UI( -color_support => 1 );
  31
  32 my @menu = (
  33     {
  34         -label   => 'File',
  35         -submenu => [
  36             { -label => 'Issues   ^I', -value => \&issues },
  37             { -label => 'Returns  ^R', -value => \&returns },
  38             { -label => 'Exit     ^Q', -value => \&exit_dialog }
  39         ]
  40     },
  41     {
  42         -label   => 'Parameters',
  43         -submenu => [
  44             { -label => 'Branch',  -value => \&changebranch },
  45             { -label => 'Printer', -value => \&changeprinter }
  46         ]
  47     },
  48 );
  49
  50 my $menu = $cui->add(
  51     'menu', 'Menubar',
  52     -menu => \@menu,
  53     -fg   => "blue",
  54 );
  55
  56 my $win1 = $cui->add(
  57     'win1', 'Window',
  58     -border => 1,
  59     -y      => 1,
  60     -bfg    => 'red',
  61     -width  => 40,
  62 );
  63
  64 my $win2 = $cui->add(
  65     'win2', 'Window',
  66     -border => 1,
  67     -y      => 1,
  68     -x      => 40,
  69     -height => 10,
  70     -bfg    => 'red',
  71 );
  72
  73 my $win3 = $cui->add(
  74     'win3', 'Window',
  75     -border => 1,
  76     -y      => 11,
  77     -x      => 40,
  78     -height => 10,
  79     -bfg    => 'red',
  80 );
  81
  82 my $texteditor = $win1->add( "text", "TextEditor",
  83     -text =>
  84       "This is the first cut of a \ncirculations system using Curses::UI\n"
  85       . "Use the menus (or the keyboard\nshortcuts) to choose issues or \nreturns"
  86 );
  87
  88 $cui->set_binding( sub { $menu->focus() }, "\cX" );
  89 $cui->set_binding( \&exit_dialog, "\cQ" );
  90 $cui->set_binding( \&issues,      "\cI" );
  91 $cui->set_binding( \&returns,     "\cR" );
  92
  93 $texteditor->focus();
  94 $cui->mainloop();
  95
  96 my %env;
  97
  98 sub exit_dialog() {
  99     my $return = $cui->dialog(
 100         -message => "Do you really want to quit?",
 101         -title   => "Are you sure???",
 102         -buttons => [ 'yes', 'no' ],
 103
 104     );
 105
 106     exit(0) if $return;
 107 }
 108
 109 sub returns {
 110     my $barcode = $cui->question(
 111         -title    => 'Returns',
 112         -question => 'Barcode'
 113     );
 114     my $branch = 'MAIN';
 115
 116     if ($barcode) {
 117         my ( $returned, $messages, $iteminformation, $borrower ) =
 118           returnbook( $barcode, $branch );
 119         if ( $borrower && $borrower->{'borrowernumber'} ) {
 120             $borrower =
 121               getpatroninformation( \%env, $borrower->{'borrowernumber'}, 0 );
 122             $win1->delete('borrowerdata');
 123             my $borrowerdata = $win1->add(
 124                 'borrowerdata', 'TextViewer',
 125                 -text => "Cardnumber: $borrower->{'cardnumber'}\n"
 126                   . "Name: $borrower->{'title'} $borrower->{'firstname'} $borrower->{'surname'}\n"
 127
 128             );
 129
 130             $borrowerdata->focus();
 131         }
 132         else {
 133             $cui->error( -message => 'That item isnt on loan' );
 134         }
 135     }
 136 }
 137
 138 sub issues {
 139
 140     # this routine does the actual issuing
 141
 142     my $borrowernumber;
 143     my $borrowerlist;
 144
 145    # the librarian can overide system issue date, need to fetch values from them
 146     my $year;
 147     my $month;
 148     my $day;
 149
 150     $win1->delete('text');
 151
 152     # get a cardnumber or a name
 153     my $cardnumber = $cui->question(
 154         -title    => 'Issues',
 155         -question => 'Cardnumber'
 156     );
 157
 158     # search for that borrower
 159     my ( $count, $borrowers ) =
 160       BornameSearch( \%env, $cardnumber, 'cardnumber', 'web' );
 161     my @borrowers = @$borrowers;
 162     if ( $#borrowers == -1 ) {
 163         $cui->error( -message =>
 164               'No borrowers match that name or cardnumber please try again.' );
 165     }
 166     elsif ( $#borrowers == 0 ) {
 167         $borrowernumber = $borrowers[0]->{'borrowernumber'};
 168     }
 169     else {
 170         $borrowerlist = \@borrowers;
 171     }
 172
 173     if ($borrowernumber) {
 174
 175         # if we have one single borrower, we can start issuing
 176         doissues( $borrowernumber, \%env, $year, $month, $day );
 177     }
 178     elsif ($borrowerlist) {
 179
 180         # choose from a list then start issuing
 181         my @borrowernumbers;
 182         my %borrowernames;
 183         foreach my $bor (@$borrowerlist) {
 184             push @borrowernumbers, $bor->{'borrowernumber'};
 185             $borrowernames{ $bor->{'borrowernumber'} } =
 186               "$bor->{'cardnumber'} $bor->{'firstname'} $bor->{surname}";
 187         }
 188         $win1->delete('mypopupbox');
 189         my $popupbox = $win1->add(
 190             'mypopupbox', 'Popupmenu',
 191             -values   => [@borrowernumbers],
 192             -labels   => \%borrowernames,
 193             -onchange => \&dolistissues,
 194         );
 195
 196         $popupbox->focus();
 197     }
 198     else {
 199     }
 200 }
 201
 202 sub dolistissues {
 203     my $list           = shift;
 204     my $borrowernumber = $list->get();
 205     doissues($borrowernumber);
 206 }
 207
 208 sub doissues {
 209     my ( $borrowernumber, $env, $year, $month, $day ) = @_;
 210     my $datedue;
 211
 212     my $borrower = getpatroninformation( $env, $borrowernumber, 0 );
 213     $win1->delete('borrowerdata');
 214     my $borrowerdata = $win1->add( 'borrowerdata', 'TextViewer',
 215         -text => "Cardnumber: $borrower->{'cardnumber'}\n"
 216           . "Name: $borrower->{'title'} $borrower->{'firstname'} $borrower->{'surname'}"
 217     );
 218
 219     $borrowerdata->focus();
 220
 221     $win3->delete('pastissues');
 222     my $issueslist = getissues($borrower);
 223     my $oldissues;
 224     foreach my $it ( keys %$issueslist ) {
 225         $oldissues .=
 226           $issueslist->{$it}->{'barcode'}
 227           . " $issueslist->{$it}->{'title'} $issueslist->{$it}->{'date_due'}\n";
 228
 229     }
 230
 231     my $pastissues =
 232       $win3->add( 'pastissues', 'TextViewer', -text => $oldissues, );
 233     $pastissues->focus();
 234
 235     $win2->delete('currentissues');
 236     my $currentissues =
 237       $win2->add( 'currentissues', 'TextViewer',
 238         -text => "Todays issues go here", );
 239     $currentissues->focus();
 240
 241     # go into a loop issuing until a blank barcode is given
 242     while ( my $barcode = $cui->question( -question => 'Barcode' ) ) {
 243         my $issues;
 244         my $issueconfirmed;
 245         my ( $error, $question ) =
 246           canbookbeissued( $env, $borrower, $barcode, $year, $month, $day );
 247         my $noerror    = 1;
 248         my $noquestion = 1;
 249         foreach my $impossible ( keys %$error ) {
 250             $cui->error( -message => $impossible );
 251             $noerror = 0;
 252         }
 253         if ($noerror) {
 254
 255             # no point asking confirmation questions if we cant issue
 256             foreach my $needsconfirmation ( keys %$question ) {
 257                 $noquestion     = 0;
 258                 $issueconfirmed = $cui->dialog(
 259                     -message =>
 260 "$needsconfirmation $question->{$needsconfirmation} Issue anyway?",
 261                     -title   => "Confirmation",
 262                     -buttons => [ 'yes', 'no' ],
 263
 264                 );
 265
 266             }
 267         }
 268         if ( $noerror && ( $noquestion || $issueconfirmed ) ) {
 269             issuebook( $env, $borrower, $barcode, $datedue );
 270             $issues .= "$barcode";
 271             $win2->delete('currentissues');
 272             $currentissues =
 273               $win2->add( 'currentissues', 'TextViewer', -text => $issues, );
 274
 275         }
 276
 277     }
 278
 279     # finished issuing
 280     my $printconfirm = $cui->dialog(
 281         -message => "Print a slip for this borrower?",
 282         -title   => "Print Slip",
 283         -buttons => [ 'yes', 'no' ],
 284
 285     );
 286     if ($printconfirm) {
 287         printslip( $env, $borrowernumber );
 288     }
 289 }
 290
 291 sub changebranch {
 292     my $dbh = C4::Context->dbh();
 293     my $sth = $dbh->prepare('SELECT * FROM branches');
 294     $sth->execute();
 295     my @branches;
 296     while ( my $data = $sth->fetchrow_hashref() ) {
 297         push @branches, $data->{'branchcode'};
 298     }
 299     $sth->finish;
 300     $win1->delete('text');
 301     $win1->delete('mypopupbox');
 302     my $popupbox = $win1->add(
 303         'mypopupbox', 'Popupmenu',
 304         -values   => [@branches],
 305         -onchange => \&setbranch,
 306     );
 307     $popupbox->focus();
 308 }
 309
 310 sub changeprinter {
 311     my $dbh = C4::Context->dbh();
 312     my $sth = $dbh->prepare('SELECT * FROM printers');
 313     $sth->execute();
 314     my @printers;
 315     while ( my $data = $sth->fetchrow_hashref() ) {
 316         push @printers, $data->{'printqueue'};
 317     }
 318     $sth->finish;
 319     $win1->delete('text');
 320     $win1->delete('mypopupbox');
 321     my $popupbox = $win1->add(
 322         'mypopupbox', 'Popupmenu',
 323         -values   => [@printers],
 324         -onchange => \&setprinter,
 325     );
 326     $popupbox->focus();
 327
 328 }
 329
 330 sub setbranch {
 331     my $list   = shift;
 332     my $branch = $list->get();
 333     $env{'branch'} = $branch;
 334 }
 335
 336 sub setprinter {
 337     my $list    = shift;
 338     my $printer = $list->get();
 339     $env{'printer'} = $printer;
 340 }