Integrated version of the Koha Offline Circulation file uploader. It needs some testing and cleanup, but it works.
Signed-off-by: Andrew Moore <andrew.moore@liblime.com> Signed-off-by: Galen Charlton <galen.charlton@liblime.com>
This commit is contained in:
Kyle Hall
Galen Charlton
parent
19781ab1b3
commit
38cf1fd318
|
|
@ -63,9 +63,12 @@ BEGIN {
|
|||
&CanBookBeIssued
|
||||
&CanBookBeRenewed
|
||||
&AddIssue
|
||||
&ForceIssue
|
||||
&AddRenewal
|
||||
&ForceRenewal
|
||||
&GetRenewCount
|
||||
&GetItemIssue
|
||||
&GetOpenIssue
|
||||
&GetItemIssues
|
||||
&GetBorrowerIssues
|
||||
&GetIssuingCharges
|
||||
|
|
@ -78,6 +81,7 @@ BEGIN {
|
|||
# subs to deal with returns
|
||||
push @EXPORT, qw(
|
||||
&AddReturn
|
||||
&ForceReturn
|
||||
&MarkIssueReturned
|
||||
);
|
||||
|
||||
|
|
@ -1015,6 +1019,29 @@ sub AddIssue {
|
|||
}
|
||||
}
|
||||
|
||||
=head2 ForceIssue
|
||||
|
||||
ForceIssue()
|
||||
|
||||
Issues an item to a member, ignoring any problems that would normally dissallow the issue.
|
||||
|
||||
=cut
|
||||
|
||||
sub ForceIssue {
|
||||
my ( $borrowernumber, $itemnumber, $date_due, $branchcode, $date ) = @_;
|
||||
warn "ForceIssue( $borrowernumber, $itemnumber, $date_due, $branchcode, $date );";
|
||||
my $dbh = C4::Context->dbh;
|
||||
my $sth = $dbh->prepare( "INSERT INTO `issues` ( `borrowernumber`, `itemnumber`, `date_due`, `branchcode`, `issuingbranch`, `returndate`, `lastreneweddate`, `return`, `renewals`, `timestamp`, `issuedate` )
|
||||
VALUES ( ?, ?, ?, ?, ?, NULL, NULL, NULL, NULL, NOW(), ? )" );
|
||||
$sth->execute( $borrowernumber, $itemnumber, $date_due, $branchcode, $branchcode, $date );
|
||||
$sth->finish();
|
||||
|
||||
my $item = GetBiblioFromItemNumber( $itemnumber );
|
||||
|
||||
UpdateStats( $branchcode, 'issue', undef, undef, $itemnumber, $item->{ 'itemtype' }, $borrowernumber );
|
||||
}
|
||||
|
||||
|
||||
=head2 GetLoanLength
|
||||
|
||||
Get loan length for an itemtype, a borrower type and a branch
|
||||
|
|
@ -1437,6 +1464,51 @@ sub AddReturn {
|
|||
return ( $doreturn, $messages, $iteminformation, $borrower );
|
||||
}
|
||||
|
||||
=head2 ForceReturn
|
||||
|
||||
ForceReturn( $barcode, $date, $branchcode );
|
||||
|
||||
Returns an item is if it were returned on C<$date>.
|
||||
|
||||
This function is non-interactive and does not check for reserves.
|
||||
|
||||
C<$barcode> is the barcode of the item being returned.
|
||||
|
||||
C<$date> is the date of the actual return, in the format YYYY-MM-DD.
|
||||
|
||||
C<$branchcode> is the branchcode for the library the item was returned to.
|
||||
|
||||
=cut
|
||||
|
||||
sub ForceReturn {
|
||||
my ( $barcode, $date, $branchcode ) = @_;
|
||||
my $dbh = C4::Context->dbh;
|
||||
|
||||
my $item = GetBiblioFromItemNumber( undef, $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();
|
||||
|
||||
## Move the issue from issues to old_issues
|
||||
$sth = $dbh->prepare( "INSERT INTO old_issues ( SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL )" );
|
||||
$sth->execute( $item->{'itemnumber'} );
|
||||
$sth->finish();
|
||||
## Delete the row in issues
|
||||
$sth = $dbh->prepare( "DELETE FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
|
||||
$sth->execute( $item->{'itemnumber'} );
|
||||
$sth->finish();
|
||||
## Now set the returndate
|
||||
$sth = $dbh->prepare( 'UPDATE old_issues SET returndate = ? WHERE itemnumber = ? AND returndate IS NULL' );
|
||||
$sth->execute( $date, $item->{'itemnumber'} );
|
||||
$sth->finish();
|
||||
|
||||
UpdateStats( $branchcode, 'return', my $amount, my $other, $item->{ 'itemnumber' }, $item->{ 'itemtype' }, $borrowernumber );
|
||||
}
|
||||
|
||||
|
||||
=head2 MarkIssueReturned
|
||||
|
||||
=over 4
|
||||
|
|
@ -1677,6 +1749,28 @@ sub GetItemIssue {
|
|||
return ($data);
|
||||
}
|
||||
|
||||
=head2 GetOpenIssue
|
||||
|
||||
$issue = GetOpenIssue( $itemnumber );
|
||||
|
||||
Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
|
||||
|
||||
C<$itemnumber> is the item's itemnumber
|
||||
|
||||
Returns a hashref
|
||||
|
||||
=cut
|
||||
|
||||
sub GetOpenIssue {
|
||||
my ( $itemnumber ) = @_;
|
||||
|
||||
my $dbh = C4::Context->dbh;
|
||||
my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
|
||||
$sth->execute( $itemnumber );
|
||||
my $issue = $sth->fetchrow_hashref();
|
||||
return $issue;
|
||||
}
|
||||
|
||||
=head2 GetItemIssues
|
||||
|
||||
$issues = &GetItemIssues($itemnumber, $history);
|
||||
|
|
@ -1973,6 +2067,40 @@ sub AddRenewal {
|
|||
UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
|
||||
}
|
||||
|
||||
|
||||
=head2 ForceRenewal
|
||||
|
||||
ForRenewal( $itemnumber, $date, $date_due );
|
||||
|
||||
Renews an item for the given date. This function should only be used to update renewals that have occurred in the past.
|
||||
|
||||
C<$itemnumber> is the itemnumber of the item being renewed.
|
||||
|
||||
C<$date> is the date the renewal took place, in the format YYYY-MM-DD
|
||||
|
||||
C<$date_due> is the date the item is now due to be returned, in the format YYYY-MM-DD
|
||||
|
||||
=cut
|
||||
|
||||
sub ForceRenewal {
|
||||
my ( $itemnumber, $date, $date_due ) = @_;
|
||||
my $dbh = C4::Context->dbh;
|
||||
|
||||
my $sth = $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL");
|
||||
$sth->execute( $itemnumber );
|
||||
my $issue = $sth->fetchrow_hashref();
|
||||
$sth->finish();
|
||||
|
||||
|
||||
$sth = $dbh->prepare('UPDATE issues SET renewals = ?, lastreneweddate = ?, date_due = ? WHERE itemnumber = ? AND returndate IS NULL');
|
||||
$sth->execute( $issue->{'renewals'} + 1, $date, $date_due, $itemnumber );
|
||||
$sth->finish();
|
||||
|
||||
my $item = GetBiblioFromItemNumber( $itemnumber );
|
||||
UpdateStats( $issue->{'branchcode'}, 'renew', undef, undef, $itemnumber, $item->{ 'itemtype' }, $issue->{'borrowernumber'} );
|
||||
}
|
||||
|
||||
|
||||
sub GetRenewCount {
|
||||
# check renewal status
|
||||
my ($bornum,$itemno)=@_;
|
||||
|
|
|
|||
|
|
@ -43,6 +43,13 @@
|
|||
|
||||
</div>
|
||||
|
||||
|
||||
<div class="yui-u">
|
||||
<h5>Offline Circulation</h5>
|
||||
<ul>
|
||||
<li><a href="/cgi-bin/koha/offline_circ/upload_koc.pl">Offline Circulation File (.koc) Uploader</></li>
|
||||
</ul>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,19 @@
|
|||
<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->
|
||||
<title>Koha › Circulation › Offline Circulation File Processing</title>
|
||||
<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
|
||||
</head>
|
||||
<body>
|
||||
<!-- TMPL_INCLUDE NAME="header.inc" -->
|
||||
<!-- TMPL_INCLUDE NAME="circ-search.inc" -->
|
||||
|
||||
<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> › <a href="/cgi-bin/koha/circ/circulation-home.pl">Circulation</a> › Offline Circulation File Uplaod</div>
|
||||
|
||||
<h2>Koha Offline Circulation</h2>
|
||||
<p>Your data was processed. Here are the results.</p>
|
||||
|
||||
<!-- TMPL_LOOP NAME="messages" -->
|
||||
<p><!-- TMPL_VAR NAME="message" --></p>
|
||||
<!-- /TMPL_LOOP -->
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->
|
||||
<title>Koha › Circulation › Offline Circulation File Upload</title>
|
||||
<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
|
||||
</head>
|
||||
<body>
|
||||
<!-- TMPL_INCLUDE NAME="header.inc" -->
|
||||
<!-- TMPL_INCLUDE NAME="circ-search.inc" -->
|
||||
|
||||
<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> › <a href="/cgi-bin/koha/circ/circulation-home.pl">Circulation</a> › Offline Circulation File Uplaod</div>
|
||||
|
||||
<h2>Upload Offline Circulation Data</h2>
|
||||
<form action="process_koc.pl" method="post" enctype="multipart/form-data">
|
||||
<label for="userfile">Choose .koc File</label>
|
||||
<input type="file" name="kocfile" />
|
||||
|
||||
<br />
|
||||
|
||||
<input type="submit" value="Upload File"/>
|
||||
</form>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,171 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# 2008 Kyle Hall <kyle.m.hall@gmail.com>
|
||||
|
||||
# This file is part of Koha.
|
||||
#
|
||||
# Koha is free software; you can redistribute it and/or modify it under the
|
||||
# terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 2 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
|
||||
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
|
||||
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
|
||||
# Suite 330, Boston, MA 02111-1307 USA
|
||||
#
|
||||
|
||||
use strict;
|
||||
require Exporter;
|
||||
|
||||
use CGI;
|
||||
use C4::Output;
|
||||
use C4::Auth;
|
||||
use C4::Koha;
|
||||
use C4::Context;
|
||||
use C4::Biblio;
|
||||
use C4::Accounts;
|
||||
use C4::Circulation;
|
||||
use C4::Members;
|
||||
use C4::Stats;
|
||||
|
||||
use Date::Calc qw( Add_Delta_Days Date_to_Days );
|
||||
|
||||
use constant DEBUG => 0;
|
||||
|
||||
our $query = new CGI;
|
||||
|
||||
my ($template, $loggedinuser, $cookie)
|
||||
= get_template_and_user( { template_name => "offline_circ/process_koc.tmpl",
|
||||
query => $query,
|
||||
type => "intranet",
|
||||
authnotrequired => 1,
|
||||
debug => 1,
|
||||
});
|
||||
|
||||
## 'Local' globals.
|
||||
our $dbh = C4::Context->dbh();
|
||||
|
||||
our $branchcode = C4::Context->userenv->{branch};
|
||||
|
||||
warn "Branchcode: $branchcode";
|
||||
|
||||
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, $branchcode );
|
||||
} 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 => \@output,
|
||||
);
|
||||
output_html_with_http_headers $query, $cookie, $template->output;
|
||||
|
||||
sub kocIssueItem {
|
||||
my ( $circ, $branchcode ) = @_;
|
||||
|
||||
my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
|
||||
my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
|
||||
my $issue = GetItemIssue( $item->{'itemnumber'} );
|
||||
|
||||
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 ( $issue->{ 'date_due' } ) { ## Item is currently checked out to another person.
|
||||
warn "Item Currently Issued.";
|
||||
my $issue = GetOpenIssue( $item->{'itemnumber'} );
|
||||
|
||||
if ( $issue->{'borrowernumber'} eq $borrower->{'borrowernumber'} ) { ## Issued to this person already, renew it.
|
||||
warn "Item issued to this member already, renewing.";
|
||||
|
||||
my $renewals = $issue->{'renewals'} + 1;
|
||||
ForceRenewal( $item->{'itemnumber'}, $circ->{'date'}, $date_due ) unless ( DEBUG );
|
||||
|
||||
push( @output, { message => "Renewed $item->{ 'title' } ( $item->{ 'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( $borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
|
||||
|
||||
} else {
|
||||
warn "Item issued to a different member.";
|
||||
warn "Date of previous issue: $issue->{'issuedate'}";
|
||||
warn "Date of this issue: $circ->{'date'}";
|
||||
my ( $i_y, $i_m, $i_d ) = split( /-/, $issue->{'issuedate'} );
|
||||
my ( $c_y, $c_m, $c_d ) = split( /-/, $circ->{'date'} );
|
||||
|
||||
if ( Date_to_Days( $i_y, $i_m, $i_d ) < Date_to_Days( $c_y, $c_m, $c_d ) ) { ## Current issue to a different persion is older than this issue, return and issue.
|
||||
warn "Current issue to another member is older, returning and issuing";
|
||||
push( @output, { message => "$item->{ 'title' } ( $item->{'barcode'} ) currently issued, returning item.\n" } );
|
||||
## AddReturnk() 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
|
||||
AddReturn( $circ->{ 'barcode' }, $branchcode ) unless ( DEBUG );
|
||||
|
||||
ForceIssue( $borrower->{ 'borrowernumber' }, $item->{ 'itemnumber' }, $date_due, $branchcode, $circ->{'date'} ) 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.
|
||||
warn "Current issue to another member is newer. Doing nothing";
|
||||
## This situation should only happen of the Offline Circ data is *really* old.
|
||||
## FIXME: write line to old_issues and statistics
|
||||
}
|
||||
|
||||
}
|
||||
} else { ## Item is not checked out to anyone at the moment, go ahead and issue it
|
||||
ForceIssue( $borrower->{ 'borrowernumber' }, $item->{ 'itemnumber' }, $date_due, $branchcode, $circ->{'date'} ) unless ( DEBUG );
|
||||
push( @output, { message => "Issued $item->{ 'title' } ( $item->{ 'barcode' } ) to $borrower->{ 'firstname' } $borrower->{ 'surename' } ( $borrower->{'cardnumber'} ) : $circ->{ 'datetime' }\n" } );
|
||||
}
|
||||
}
|
||||
|
||||
sub kocReturnItem {
|
||||
my ( $circ ) = @_;
|
||||
ForceReturn( $circ->{'barcode'}, $circ->{'date'}, $branchcode );
|
||||
|
||||
my $item = GetBiblioFromItemNumber( undef, $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();
|
||||
|
||||
push( @output, { message => "Returned $item->{ 'title' } ( $item->{ 'barcode' } ) From borrower number $borrowernumber : $circ->{ 'datetime' }\n" } );
|
||||
}
|
||||
|
||||
sub kocMakePayment {
|
||||
my ( $circ ) = @_;
|
||||
my $borrower = GetMember( $circ->{ 'cardnumber' }, 'cardnumber' );
|
||||
recordpayment( my $env, $borrower->{'borrowernumber'}, $circ->{'barcode'} );
|
||||
}
|
||||
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# This file is part of Koha.
|
||||
#
|
||||
# Koha is free software; you can redistribute it and/or modify it under the
|
||||
# terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 2 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
|
||||
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
|
||||
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
|
||||
# Suite 330, Boston, MA 02111-1307 USA
|
||||
#
|
||||
|
||||
use strict;
|
||||
require Exporter;
|
||||
|
||||
use C4::Output;
|
||||
use C4::Auth;
|
||||
use C4::Koha;
|
||||
|
||||
use CGI;
|
||||
|
||||
my $query = new CGI;
|
||||
|
||||
my ($template, $loggedinuser, $cookie)
|
||||
= get_template_and_user({template_name => "offline_circ/upload_koc.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;
|
||||
Loading…
Reference in New Issue