[Koha-cvs] koha/offlineCirc offlineCirc.pl processKOC.pl [dev_week]

[Kyle Hall]

CVSROOT:        /sources/koha
Module name:    koha
Branch:         dev_week
Changes by:     Kyle Hall <kylemhall>   08/06/23 17:49:56

Added files:
        offlineCirc    : offlineCirc.pl processKOC.pl 

Log message:
        Koha integrated perl version of the Koha Offline Circulation server 
side script

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/offlineCirc/offlineCirc.pl?cvsroot=koha&only_with_tag=dev_week&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/offlineCirc/processKOC.pl?cvsroot=koha&only_with_tag=dev_week&rev=1.1.2.1

Patches:
Index: offlineCirc.pl
===================================================================
RCS file: offlineCirc.pl
diff -N offlineCirc.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ offlineCirc.pl      23 Jun 2008 17:49:56 -0000      1.1.2.1
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+use strict;
+use CGI;
+use C4::Auth;
+use C4::Bull;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Context;
+use HTML::Template;
+
+my $query = new CGI;
+my $title = $query->param('title');
+my $ISSN = $query->param('ISSN');
+my $biblionumber = $query->param('biblionumber');
+my @subscriptions = getsubscriptions($title,$ISSN,$biblionumber);
+my ($template, $loggedinuser, $cookie)
+= get_template_and_user({template_name => "offlineCirc/offlineCirc.tmpl",
+                               query => $query,
+                               type => "intranet",
+                               authnotrequired => 1,
+                               debug => 1,
+                               });
+
+$template->param(
+               intranetcolorstylesheet => 
C4::Context->preference("intranetcolorstylesheet"),
+               intranetstylesheet => 
C4::Context->preference("intranetstylesheet"),
+               IntranetNav => C4::Context->preference("IntranetNav"),
+       );
+output_html_with_http_headers $query, $cookie, $template->output;

Index: processKOC.pl
===================================================================
RCS file: processKOC.pl
diff -N processKOC.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ processKOC.pl       23 Jun 2008 17:49:56 -0000      1.1.2.1
@@ -0,0 +1,162 @@
+#!/usr/bin/perl
+
+use strict;
+use CGI;
+use CGI::Carp qw ( fatalsToBrowser );
+use File::Basename;
+use Date::Calc qw ( Add_Delta_Days );
+
+use C4::Auth;
+use C4::Bull;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Circulation::Circ2;
+use C4::Context;
+use C4::Search;
+use C4::Stats;
+use C4::Accounts2;
+
+use HTML::Template;
+
+use constant DEBUG => 0;
+
+our $query = new CGI;
+
+my ($template, $loggedinuser, $cookie)
+  = get_template_and_user( { template_name => "offlineCirc/processKOC.tmpl",
+                               query => $query,
+                               type => "intranet",
+                               authnotrequired => 1,
+                               debug => 1,
+                               });
+
+## 'Local' globals.
+our $dbh = C4::Context->dbh();
+
+our $branchcode = $query->cookie('branch');
+our @output; ## For storing messages to be displayed to the user
+
+$query::POST_MAX = 1024 * 10000;
+
+my $file = $query->param("kocfile");
+$file=~m/^.*(\\|\/)(.*)/; # strip the remote path and keep the filename 
+my $name = $file; 
+
+my $header = <$file>;
+
+while ( my $line = <$file> ) {
+  my ( $type, $cardnumber, $barcode, $datetime ) = split( /\t/, $line );
+  ( $datetime ) = split( /\+/, $datetime );
+  my ( $date ) = split( / /, $datetime );
+
+  my $circ;
+  $circ->{ 'type' } = $type;
+  $circ->{ 'cardnumber' } = $cardnumber;
+  $circ->{ 'barcode' } = $barcode;
+  $circ->{ 'datetime' } = $datetime;
+  $circ->{ 'date' } = $date;
+  
+  if ( $circ->{ 'type' } eq 'issue' ) {
+    kocIssueItem( $circ );
+  } elsif ( $circ->{ 'type' } eq 'return' ) {
+    kocReturnItem( $circ );
+  } elsif ( $circ->{ 'type' } eq 'payment' ) {
+    kocMakePayment( $circ );
+  }
+}
+
+$template->param(
+               intranetcolorstylesheet => 
C4::Context->preference("intranetcolorstylesheet"),
+               intranetstylesheet => 
C4::Context->preference("intranetstylesheet"),
+               IntranetNav => C4::Context->preference("IntranetNav"),
+
+                messages => address@hidden,
+       );
+output_html_with_http_headers $query, $cookie, $template->output;
+
+sub kocIssueItem {
+  my ( $circ ) = @_;
+
+  my $borrower = getpatroninformation( my $env, my $barcode,  $circ->{ 
'cardnumber' } );
+  my $item = getiteminformation( my $env, my $something, $circ->{ 'barcode' } 
);    
+
+  my $issuingrule = getIssuingRule( $borrower->{ 'categorycode' }, $item->{ 
'itemtype' }, $branchcode );
+  my $issuelength = $issuingrule->{ 'issuelength' };
+  my ( $year, $month, $day ) = split( /-/, $circ->{'date'} );
+  ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, $issuelength 
);
+  my $date_due = "$year-$month-$day";
+  if ( $item->{ 'date_due' } ) { ## Item is currently checked out to another 
person.
+    my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND 
returndate IS NULL" );
+    $sth->execute( $item->{'itemnumber'} );
+    my $issue = $sth->fetchrow_hashref();
+
+    if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## 
Issued to this person already, renew it.
+      my $renewals = $issue->{'renewals'} + 1;
+      my $sth = $dbh->prepare('UPDATE issues SET renewals = ?, lastreneweddate 
= ?, date_due = ? WHERE borrowernumber = ? AND itemnumber = ? AND returndate IS 
NULL');
+      $sth->execute( $renewals, $circ->{'date'}, $date_due, 
$borrower->{'borrowernumber'}, $item->{'itemnumber'} ) unless ( DEBUG );
+      $sth->finish();  
+
+      UpdateStats( my $env, $branchcode, 'renew', my $amount, my $other, 
$item->{ 'itemnumber' }, $item->{ 'itemtype' }, $borrower->{'borrowernumber'} ) 
unless ( DEBUG );
+      push( @output, { message => "Renewed $item->{ 'title' } ( $item->{ 
'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( 
$borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
+
+    } else { 
+      if ( $item->{ 'issue_date' } < $circ->{ 'date' } ) { ## Current issue to 
a different persion is older than this issue, return and issue. FIXME: Should 
compare to date of issue, not date_due
+        push( @output, { message => "$item->{ 'title' } ( $item->{'barcode'} ) 
currently issued, returning item.\n" } );
+        ## returnbook() should be replaced with a custom function, as it will 
make the return date today, should be before the issue date of the current circ
+        returnbook( $circ->{ 'barcode' }, $branchcode ) unless ( DEBUG );
+
+        ## ISSUE ITEM ## FIXME: Should be moved to a seperate function
+        ## FIXME: Update Koha API and use it instead
+        my $sth = $dbh->prepare( "INSERT INTO `issues` ( `borrowernumber`, 
`itemnumber`, `date_due`, `branchcode`, `issuingbranch`, `returndate`, 
`lastreneweddate`, `return`, `renewals`, `timestamp`, `issue_date` )
+                               VALUES ( ?, ?, ?, ?, ?, NULL, NULL, NULL, NULL, 
NOW(), ? )" );
+        $sth->execute( $borrower->{ 'borrowernumber' }, $item->{ 'itemnumber' 
}, $date_due, $branchcode, $branchcode, $circ->{'date'} ) unless ( DEBUG );
+        $sth->finish();
+        UpdateStats( my $env, $branchcode, 'issue', my $amount, my $other, 
$item->{ 'itemnumber' }, $item->{ 'itemtype' }, $borrower->{'borrowernumber'} ) 
unless ( DEBUG );
+        push( @output, { message => "Issued $item->{ 'title' } ( $item->{ 
'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( 
$borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
+
+      } else { ## Current issue is *newer* than this issue, write a 'returned' 
issue, as the item is most likely in the hands of someone else now.
+        ## This situation should only happen of the Offline Circ data is 
*really* old.
+        ## FIXME: write line to oldissues and statistics
+      }
+    
+    }
+  } else { ## Item is not checked out to anyone at the moment, go ahead and 
issue it
+    ## ISSUE ITEM ## FIXME: Duplicate code as above, should be moved to a 
separate function.
+    ## FIXME: Update Koha API and use it instead
+    my $sth = $dbh->prepare( "INSERT INTO `issues` ( `borrowernumber`, 
`itemnumber`, `date_due`, `branchcode`, `issuingbranch`, `returndate`, 
`lastreneweddate`, `return`, `renewals`, `timestamp`, `issue_date` )
+                           VALUES ( ?, ?, ?, ?, ?, NULL, NULL, NULL, NULL, 
NOW(), ? )" );
+    $sth->execute( $borrower->{ 'borrowernumber' }, $item->{ 'itemnumber' }, 
$date_due, $branchcode, $branchcode, $circ->{'date'} ) unless ( DEBUG );
+    $sth->finish();
+    UpdateStats( my $env, $branchcode, 'issue', my $amount, my $other, 
$item->{ 'itemnumber' }, $item->{ 'itemtype' }, $borrower->{'borrowernumber'} ) 
unless ( DEBUG );
+    push( @output, { message => "Issued $item->{ 'title' } ( $item->{ 
'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( 
$borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
+  }  
+}
+
+sub kocReturnItem {
+  my ( $circ ) = @_;
+  
+  my $item = getiteminformation( my $env, my $something, $circ->{ 'barcode' } 
);
+
+  ## FIXME: Is there a way to get the borrower of an item through the Koha API?
+  my $sth=$dbh->prepare( "SELECT borrowernumber FROM issues WHERE itemnumber = 
? AND returndate IS NULL");
+  $sth->execute( $item->{'itemnumber'} );
+  my ( $borrowernumber ) = $sth->fetchrow;
+  $sth->finish();
+  
+  ## FIXME: Should use Koha API when updated for past date returns
+  $sth = $dbh->prepare( 'UPDATE issues SET returndate = ? WHERE itemnumber = ? 
AND returndate IS NULL' );
+  $sth->execute( $circ->{'date'}, $item->{'itemnumber'} ) unless DEBUG;
+  $sth->finish();
+  
+  ## FIXME: Will need to move issue to oldissues table for Koha 3
+
+  UpdateStats( my $env, $branchcode, 'return', my $amount, my $other, $item->{ 
'itemnumber' }, $item->{ 'itemtype' }, $borrowernumber ) unless ( DEBUG );
+  push( @output, { message => "Returned $item->{ 'title' } ( $item->{ 
'barcode' } ) From borrower number $borrowernumber : $circ->{ 'datetime' }\n" } 
); 
+}
+
+sub kocMakePayment {
+  my ( $circ ) = @_;
+  my $borrower = getpatroninformation( my $env, my $barcode,  $circ->{ 
'cardnumber' } );
+  recordpayment( my $env, $borrower->{'borrowernumber'}, $circ->{'barcode'} );
+}
+