[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Koha-cvs] koha t/BookShelves.t tools/breeding.pl tools/cl...
|
From: |
paul poulain |
|
Subject: |
[Koha-cvs] koha t/BookShelves.t tools/breeding.pl tools/cl... |
|
Date: |
Fri, 09 Mar 2007 15:47:55 +0000 |
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/03/09 15:47:55
Added files:
t : BookShelves.t
tools : breeding.pl cleanborrowers.pl inventory.pl
itemslost.pl viewlog.pl
Log message:
rel_3_0 moved to HEAD (introducing new files)
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/t/BookShelves.t?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/tools/breeding.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/tools/cleanborrowers.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/tools/inventory.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/tools/itemslost.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/tools/viewlog.pl?cvsroot=koha&rev=1.2
Patches:
Index: t/BookShelves.t
===================================================================
RCS file: t/BookShelves.t
diff -N t/BookShelves.t
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ t/BookShelves.t 9 Mar 2007 15:47:55 -0000 1.2
@@ -0,0 +1,159 @@
+#!/usr/bin/perl
+
+#
+# This file is a test script for C4::BookShelves.pm
+# Author : Antoine Farnault, address@hidden
+#
+
+use Test;
+use strict;
+use C4::Context;
+
+# Making 30 tests.
+BEGIN { plan tests => 30 }
+
+# Getting some borrowers from database.
+my $dbh = C4::Context->dbh;
+my $query = qq/
+ SELECT borrowernumber
+ FROM borrowers
+ LIMIT 10
+/;
+my $sth = $dbh->prepare($query);
+$sth->execute;
+my @borrowers;
+while(my $borrower = $sth->fetchrow){
+ push @borrowers, $borrower;
+}
+
+# Getting some itemnumber from database
+my $query = qq/
+ SELECT itemnumber
+ FROM items
+ LIMIT 10
+/;
+my $sth = $dbh->prepare($query);
+$sth->execute;
+my @items;
+while(my $item = $sth->fetchrow){
+ push @items, $item;
+}
+
+# Getting some biblionumbers from database
+my $query = qq/
+ SELECT biblionumber
+ FROM biblio
+ LIMIT 10
+/;
+my $sth = $dbh->prepare($query);
+$sth->execute;
+my @biblionumbers;
+while(my $biblionumber = $sth->fetchrow){
+ push @biblionumbers, $biblionumber;
+}
+
+# ---
+my $delete_bookshelf = qq/
+ DELETE FROM bookshelf WHERE 1
+/;
+my $delete_bookshelfcontent =qq/
+ DELETE FROM shelfcontents WHERE 1
+/;
+
+my $sth = $dbh->prepare($delete_bookshelf);
+$sth->execute;
+my $sth = $dbh->prepare($delete_bookshelfcontent);
+$sth->execute;
+# ---
+
+#----------------------------------------------------------------------#
+#
+# TESTS START HERE
+#
+#----------------------------------------------------------------------#
+
+use C4::BookShelves;
+my $version = C4::BookShelves->VERSION;
+print "\n----------Testing C4::BookShelves version ".$version."--------\n";
+
+ok($version); # First test: the module is loaded & the version is readable.
+
+
+#-----------------------TEST AddShelf function------------------------#
+# usage : $shelfnumber = &AddShelf( $shelfname, $owner, $category);
+
+# creating 10 good shelves.
+my @shelves;
+for(my $i=0; $i<10;$i++){
+ my $ShelfNumber = AddShelf("Shelf_".$i,$borrowers[$i],int(rand(3))+1);
+ die "test Not ok, remove some shelves before" if ($ShelfNumber == -1);
+ ok($ShelfNumber); # Shelf creation successful;
+ push @shelves, $ShelfNumber if ok($ShelfNumber);
+}
+
+ok(10,scalar @shelves); # 10 shelves in @shelves;
+
+# try to create some shelf which already exists.
+for(my $i=0;$i<10;$i++){
+ my $badNumShelf = AddShelf("Shelf_".int(rand(9)),'','');
+ ok(-1,$badNumShelf); # AddShelf returns -1 if name already exist.
+}
+
+#-----------TEST AddToShelf & &AddToShelfFromBiblio & GetShelfContents &
DelFromShelf functions--------------#
+# usage : &AddToShelf($itemnumber, $shelfnumber);
+# usage : $itemlist = &GetShelfContents($shelfnumber);
+# usage : $itemlist = GetShelfContents($shelfnumber);
+
+for(my $i=0; $i<10;$i++){
+ my $item = $items[int(rand(9))];
+ my $shelfnumber = $shelves[int(rand(9))];
+
+ my $itemlistBefore = GetShelfContents($shelfnumber);
+ AddToShelf($item,$shelfnumber);
+ my $itemlistAfter = GetShelfContents($shelfnumber);
+ ok(scalar @$itemlistBefore,scalar (@$itemlistAfter - 1)); # the item has
been successfuly added.
+
+
+ # same thing with AddToShelfFromBiblio
+ my $biblionumber = $biblionumbers[int(rand(10))];
+ &AddToShelfFromBiblio($biblionumber, $shelfnumber);
+ my $AfterAgain = GetShelfContents($shelfnumber);
+ ok(scalar @$itemlistAfter, scalar (@$AfterAgain -1));
+}
+
+#-----------------------TEST ModShelf & GetShelf
functions------------------------#
+# usage : ModShelf($shelfnumber, $shelfname, $owner, $category )
+# usage : (shelfnumber,shelfname,owner,category) = GetShelf($shelfnumber);
+
+for(my $i=0; $i<10;$i++){
+ my $rand = int(rand(9));
+ my $numA = $shelves[$rand];
+ my $nameA = "NewName_".$rand;
+ my $ownerA = $borrowers[$rand];
+ my $categoryA = int(rand(3))+1;
+
+ ModShelf($numA,$nameA,$ownerA,$categoryA);
+ my ($numB,$nameB,$ownerB,$categoryB) = GetShelf($numA);
+
+ ok($numA,$numB);
+ ok($nameA,$nameB);
+ ok($ownerB,$ownerA);
+ ok($categoryA,$categoryB);
+}
+
+#-----------------------TEST DelShelf & DelFromShelf
functions------------------------#
+# usage : ($status) = &DelShelf($shelfnumber);
+# usage : &DelFromShelf( $itemnumber, $shelfnumber);
+
+for(my $i=0; $i<10;$i++){
+ my $shelfnumber = $shelves[$i];
+ my $status = DelShelf($shelfnumber);
+ if($status){
+ my $items = GetShelfContents($shelfnumber);
+ ok($status,scalar @$items);
+ foreach (@$items){ # delete all the item in this shelf
+ DelFromShelf($_{'itemnumber'},$shelfnumber);
+ }
+ ok(DelShelf($shelfnumber));
+ }
+}
Index: tools/breeding.pl
===================================================================
RCS file: tools/breeding.pl
diff -N tools/breeding.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tools/breeding.pl 9 Mar 2007 15:47:55 -0000 1.2
@@ -0,0 +1,227 @@
+#!/usr/bin/perl
+
+# $Id: breeding.pl,v 1.2 2007/03/09 15:47:55 tipaul Exp $
+
+# Script for handling import of MARC data into Koha db
+# and Z39.50 lookups
+
+# Koha library project www.koha.org
+
+# Licensed under the GPL
+
+
+# Copyright 2000-2002 Katipo Communications
+#
+# 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;
+
+# standard or CPAN modules used
+use CGI;
+use DBI;
+
+# Koha modules used
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Input;
+use C4::Biblio;
+use MARC::File::USMARC;
+
+use C4::Output;
+use C4::Auth;
+use C4::Breeding;
+
+#------------------
+# Constants
+
+my $includes = C4::Context->config('includes') ||
+ "/usr/local/www/hdl/htdocs/includes";
+
+# HTML colors for alternating lines
+my $lc1='#dddddd';
+my $lc2='#ddaaaa';
+
+#-------------
+#-------------
+# Initialize
+
+my $userid=$ENV{'REMOTE_USER'};
+
+my $input = new CGI;
+my $dbh = C4::Context->dbh;
+
+my $uploadmarc=$input->param('uploadmarc');
+my $overwrite_biblio = $input->param('overwrite_biblio');
+my $filename = $input->param('filename');
+my $syntax = $input->param('syntax');
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "tools/breeding.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {tools => 1},
+ debug => 1,
+ });
+
+$template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'},
+ uploadmarc => $uploadmarc);
+if ($uploadmarc && length($uploadmarc)>0) {
+ my $marcrecord='';
+ while (<$uploadmarc>) {
+ $marcrecord.=$_;
+ }
+ my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported) =
ImportBreeding($marcrecord,$overwrite_biblio,$filename,$syntax,int(rand(99999)));
+
+ $template->param(imported => $imported,
+ alreadyindb =>
$alreadyindb,
+ alreadyinfarm =>
$alreadyinfarm,
+ notmarcrecord =>
$notmarcrecord,
+ total =>
$imported+$alreadyindb+$alreadyinfarm+$notmarcrecord,
+ );
+
+}
+
+output_html_with_http_headers $input, $cookie, $template->output;
+my $menu;
+my $file;
+
+
+#---------------
+# log cleared, as marcimport is (almost) rewritten from scratch.
+# $Log: breeding.pl,v $
+# Revision 1.2 2007/03/09 15:47:55 tipaul
+# rel_3_0 moved to HEAD (introducing new files)
+#
+# Revision 1.1.2.3 2006/12/22 17:13:49 tipaul
+# removing "management" permission, that is useless (replaced by tools & admin)
+#
+# Revision 1.1.2.2 2006/12/18 16:35:20 toins
+# removing use HTML::Template from *.pl.
+#
+# Revision 1.1.2.1 2006/09/26 13:35:33 toins
+# breeding.pl moving from import/ to tools/
+#
+# Revision 1.5.2.1 2006/09/26 13:10:35 toins
+# script was writed 2 times on the same file !
+#
+# Revision 1.5 2006/07/04 14:36:52 toins
+# Head & rel_2_2 merged
+#
+# Revision 1.4 2005/05/04 08:52:13 tipaul
+# synch'ing 2.2 and head
+#
+# Revision 1.2.4.1 2005/04/07 10:10:52 tipaul
+# copying processz3950queue from 2.0 branch. The 2.2 version misses an
important fix
+#
+# Revision 1.2 2003/10/06 09:10:38 slef
+# Removing config info from z3950*sh and using C4::Context in
processz3950queue (Fixed bug 39)
+#
+# Revision 1.1 2003/06/04 13:46:25 tipaul
+# moving breeding farm import to parameters page (GUI) and to new import/
directory (code structure)
+#
+# Revision 1.33 2003/04/29 16:48:36 tipaul
+# really proud of this commit :-)
+# z3950 search and import seems to works fine.
+# Let me explain how :
+# * a "search z3950" button is added in the addbiblio template.
+# * when clicked, a popup appears and z3950/search.pl is called
+# * z3950/search.pl calls addz3950search in the DB
+# * the z3950 daemon retrieve the records and stores them in z3950results AND
in marc_breeding table.
+# * as long as there as searches pending, the popup auto refresh every 2
seconds, and says how many searches are pending.
+# * when the user clicks on a z3950 result => the parent popup is called with
the requested biblio, and auto-filled
+#
+# Note :
+# * character encoding support : (It's a nightmare...) In the z3950servers
table, a "encoding" column has been added. You can put "UNIMARC" or "USMARC" in
this column. Depending on this, the char_decode in C4::Biblio.pm replaces
marc-char-encode by an iso 8859-1 encoding. Note that in the breeding import
this value has been added too, for a better support.
+# * the marc_breeding and z3950* tables have been modified : they have an
encoding column and the random z3950 number is stored too for convenience =>
it's the key I use to list only requested biblios in the popup.
+#
+# Revision 1.32 2003/04/22 12:22:54 tipaul
+# 1st draft for z3950 client import.
+# moving Breeding farm script to a perl package C4/Breeding.pm
+#
+# Revision 1.31 2003/02/19 01:01:07 wolfpac444
+# Removed the unecessary $dbh argument from being passed.
+# Resolved a few minor FIXMEs.
+#
+# Revision 1.30 2003/02/02 07:18:38 acli
+# Moved C4/Charset.pm to C4/Interface/CGI/Output.pm
+#
+# Create output_html_with_http_headers function to contain the "print $query
+# ->header(-type => guesstype...),..." call. This is in preparation for
+# non-HTML output (e.g., text/xml) and charset conversion before output in
+# the future.
+#
+# Created C4/Interface/CGI/Template.pm to hold convenience functions specific
+# to the CGI interface using HTML::Template
+#
+# Modified moremembers.pl to make the "sex" field localizable for languages
+# where M and F doesn't make sense
+#
+# Revision 1.29 2003/01/28 15:28:31 tipaul
+# removing use MARC::Charset
+# Was a buggy test
+#
+# Revision 1.28 2003/01/28 15:00:31 tipaul
+# user can now search in breeding farm with isbn/issn or title. Title/name are
stored in breeding farm and showed when a search is done
+#
+# Revision 1.27 2003/01/26 23:21:49 acli
+# Handle non-latin1 charsets
+#
+# Revision 1.26 2003/01/23 12:26:41 tipaul
+# upgrading import in breeding farm (you can now search on ISBN or on title)
AND character encoding.
+#
+# Revision 1.25 2003/01/21 08:13:50 tipaul
+# character encoding ISO646 => 8859-1, first draft
+#
+# Revision 1.24 2003/01/14 16:41:17 tipaul
+# bugfix : use gettemplate_and_user instead of gettemplate.
+# fix a blank screen in 1.3.3 in "import in breeding farm"
+#
+# Revision 1.23 2003/01/06 13:06:28 tipaul
+# removing trailing #
+#
+# Revision 1.22 2002/11/12 15:58:43 tipaul
+# road to 1.3.2 :
+# * many bugfixes
+# * adding value_builder : you can map a subfield in the
marc_subfield_structure to a sub stored in "value_builder" directory. In this
directory you can create screen used to build values with any method. In this
commit is a 1st draft of the builder for 100$a unimarc french subfield, which
is composed of 35 digits, with 12 differents values (only the 4th first are
provided for instance)
+#
+# Revision 1.21 2002/10/22 15:50:23 tipaul
+# road to 1.3.2 : adding a biblio in MARC format.
+# seems to work a few.
+# still to do :
+# * manage html checks (mandatory subfields...)
+# * add list of acceptable values (authorities)
+# * manage ## in MARC format
+# * manage correctly repeatable fields
+# and probably a LOT of bugfixes
+#
+# Revision 1.20 2002/10/16 12:46:19 arensb
+# Added a FIXME comment.
+#
+# Revision 1.19 2002/10/15 10:14:44 tipaul
+# road to 1.3.2. Full rewrite of marcimport.pl.
+# The acquisition system in MARC version will work like this :
+# * marcimport will put marc records into a "breeding farm" table.
+# * when the user want to add a biblio, he enters first the ISBN/ISSN of the
biblio. koha searches into breeding farm and if the record exists, it is shown
to the user to help him adding the biblio. When the biblio is added, it's
deleted from the breeding farm.
+#
+# This commit :
+# * modify acqui.simple home page (addbooks.pl)
+# * adds import into breeding farm
+#
+# Please note that :
+# * z3950 functionnality is dropped from "marcimport" will be added somewhere
else.
+# * templates are in a new acqui.simple sub directory, and the marcimport
template directory will become obsolete soon.I think this is more logic
+#
Index: tools/cleanborrowers.pl
===================================================================
RCS file: tools/cleanborrowers.pl
diff -N tools/cleanborrowers.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tools/cleanborrowers.pl 9 Mar 2007 15:47:55 -0000 1.2
@@ -0,0 +1,165 @@
+#!/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
+#
+# Written by Antoine Farnault address@hidden on Nov. 2006.
+
+# $Id: cleanborrowers.pl,v 1.2 2007/03/09 15:47:55 tipaul Exp $
+
+=head1 cleanborrowers.pl
+
+This script allows to do 2 things.
+
+=over 2
+
+=item * Anonymise the borrowers' issues if issue is older than a given date.
see C<datefilter1>.
+
+=item * Delete the borrowers who has not borrowered since a given date. see
C<datefilter2>.
+
+=back
+
+=cut
+
+use strict;
+use CGI;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+
+
+use C4::Members; # GetBorrowersWhoHavexxxBorrowed.
+use C4::Circulation::Circ2; # AnonymiseIssueHistory.
+use Date::Calc qw/Date_to_Days Today/;
+
+my $cgi = new CGI;
+
+# Fetch the paramater list as a hash in scalar context:
+# * returns paramater list as tied hash ref
+# * we can edit the values by changing the key
+# * multivalued CGI paramaters are returned as a packaged string separated by
"\0" (null)
+my $params = $cgi->Vars;
+
+my $filterdate1; # the date which filter on issue history.
+my $filterdate2; # the date which filter on borrowers last issue.
+
+# getting the template
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "tools/cleanborrowers.tmpl",
+ query => $cgi,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { tools => 1, catalogue => 1 },
+ }
+);
+
+if ( $params->{'step2'} ) {
+ $filterdate1 = $params->{'filterdate1'};
+ $filterdate2 = $params->{'filterdate2'};
+ my $checkbox = $params->{'checkbox'};
+
+ my $totalDel;
+ if ($checkbox eq "borrower") {
+ $filterdate1 = $params->{'filterdate1'};
+ my $membersToDelete =
GetBorrowersWhoHaveNotBorrowedSince($filterdate1);
+ $totalDel = scalar @$membersToDelete;
+ }
+
+ my $totalAno;
+ if ($checkbox eq "issue") {
+ $filterdate2 = $params->{'filterdate2'};
+ my $membersToAnonymize =
+ GetBorrowersWithIssuesHistoryOlderThan($filterdate2);
+ $totalAno = scalar @$membersToAnonymize;
+ }
+
+ $template->param(
+ step2 => 1,
+ totalToDelete => $totalDel,
+ totalToAnonymize => $totalAno,
+ filterdate1 => $filterdate1,
+ filterdate2 => $filterdate2
+ );
+
+ #writing the template
+ output_html_with_http_headers $cgi, $cookie, $template->output;
+ exit;
+}
+
+if ( $params->{'step3'} ) {
+ $filterdate1 = $params->{'filterdate1'};
+ $filterdate2 = $params->{'filterdate2'};
+ my $do_delete = $params->{'do_delete'};
+ my $do_anonym = $params->{'do_anonym'};
+
+ my ( $totalDel, $totalAno, $radio ) = ( 0, 0, 0 );
+
+ # delete members
+ if ($do_delete) {
+ my $membersToDelete =
GetBorrowersWhoHaveNotBorrowedSince($filterdate1);
+ $totalDel = scalar(@$membersToDelete);
+ $radio = $params->{'radio'};
+ if ( $radio eq 'trash' ) {
+ my $i;
+ for ( $i = 0 ; $i < $totalDel ; $i++ ) {
+ DeleteBorrower( $membersToDelete->[$i]->{'borrowernumber'} );
+ }
+ }
+ else { # delete completly.
+ my $i;
+ for ( $i = 0 ; $i < $totalDel ; $i++ ) {
+
DelBorrowerCompletly($membersToDelete->[$i]->{'borrowernumber'});
+ }
+ }
+ $template->param(
+ do_delete => '1',
+ TotalDel => $totalDel
+ );
+ }
+
+ # Anonymising all members
+ if ($do_anonym) {
+ $totalAno = AnonymiseIssueHistory($filterdate2);
+ $template->param(
+ filterdate1 => $filterdate2,
+ do_anonym => '1',
+ );
+ }
+
+ $template->param(
+ step3 => '1',
+ trash => ( $radio eq "trash" ) ? (1) : (0),
+ );
+
+ #writing the template
+ output_html_with_http_headers $cgi, $cookie, $template->output;
+ exit;
+}
+
+#default value set to the template are the 'CNIL' value.
+my ( $year, $month, $day ) = &Today();
+my $tmpyear = $year - 1;
+my $tmpmonth = $month - 3;
+$filterdate1 = $year . "-" . $tmpmonth . "-" . $day;
+$filterdate2 = $tmpyear . "-" . $month . "-" . $day;
+
+$template->param(
+ step1 => '1',
+ filterdate1 => $filterdate1,
+ filterdate2 => $filterdate2
+);
+
+#writing the template
+output_html_with_http_headers $cgi, $cookie, $template->output;
Index: tools/inventory.pl
===================================================================
RCS file: tools/inventory.pl
diff -N tools/inventory.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tools/inventory.pl 9 Mar 2007 15:47:55 -0000 1.2
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+
+# Copyright 2000-2002 Katipo Communications
+#
+# 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;
+use CGI;
+use C4::Auth;
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Circulation::Circ2;
+use C4::Date;
+use C4::Koha;
+use C4::Branch; # GetBranches
+
+my $input = new CGI;
+my $minlocation=$input->param('minlocation') || 'A';
+my $maxlocation=$input->param('maxlocation');
+$maxlocation=$minlocation.'Z' unless $maxlocation;
+my $datelastseen = $input->param('datelastseen');
+$datelastseen = format_date_in_iso($datelastseen);
+my $offset = $input->param('offset');
+my $markseen = $input->param('markseen');
+$offset=0 unless $offset;
+my $pagesize = $input->param('pagesize');
+$pagesize=50 unless $pagesize;
+my $uploadbarcodes = $input->param('uploadbarcodes');
+my $branchcode = $input->param('branchcode');
+my $op = $input->param('op');
+# warn "uploadbarcodes : ".$uploadbarcodes;
+
+my ($template, $borrowernumber, $cookie)
+ = get_template_and_user({template_name => "tools/inventory.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {tools => 1},
+ debug => 1,
+ });
+
+my $branches = GetBranches();
+my @branch_loop;
+push @branch_loop, {value => "", branchname => "All Branches", };
+for my $branch_hash (keys %$branches) {
+ push @branch_loop, {value => "$branch_hash",
+ branchname =>
$branches->{$branch_hash}->{'branchname'},
+ selected => ($branch_hash eq $branchcode?1:0)};
+}
+$template->param(branchloop => address@hidden,);
+
+$template->param(minlocation => $minlocation,
+ maxlocation => $maxlocation,
+ offset => $offset,
+ pagesize => $pagesize,
+ datelastseen => $datelastseen,
+ intranetcolorstylesheet =>
C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet =>
C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+if ($uploadbarcodes && length($uploadbarcodes)>0){
+ my $dbh=C4::Context->dbh;
+ my $date=format_date($input->param('setdate'));
+ $date = format_date("today") unless $date;
+# warn "$date";
+ my $strsth="update items set (datelastseen = $date) where items.barcode
=?";
+ my $qupdate = $dbh->prepare($strsth);
+ my $strsth="select * from issues, items where
items.itemnumber=issues.itemnumber and items.barcode =? and issues.returndate
is null";
+ my $qonloan = $dbh->prepare($strsth);
+ my $strsth="select * from items where items.barcode =? and
issues.wthdrawn=1";
+ my $qwthdrawn = $dbh->prepare($strsth);
+ my @errorloop;
+ my $count=0;
+ while (my $barcode=<$uploadbarcodes>){
+ chomp $barcode;
+# warn "$barcode";
+ if ($qwthdrawn->execute($barcode) &&$qwthdrawn->rows){
+ push @errorloop, {'barcode'=>$barcode,'ERR_WTHDRAWN'=>1};
+ }else{
+ $qupdate->execute($barcode);
+ $count += $qupdate->rows;
+# warn "$count";
+ if ($count){
+ $qonloan->execute($barcode);
+ if ($qonloan->rows){
+ my $data = $qonloan->fetchrow_hashref;
+ my ($doreturn, $messages, $iteminformation, $borrower)
=returnbook($barcode, $data->{homebranch});
+ if ($doreturn){push @errorloop,
{'barcode'=>$barcode,'ERR_ONLOAN_RET'=>1}}
+ else {push @errorloop,
{'barcode'=>$barcode,'ERR_ONLOAN_NOT_RET'=>1}}
+ }
+ } else {
+ push @errorloop, {'barcode'=>$barcode,'ERR_BARCODE'=>1};
+ }
+ }
+ }
+ $qupdate->finish;
+ $qonloan->finish;
+ $qwthdrawn->finish;
+ $template->param(date=>$date,Number=>$count);
+# $template->param(errorfile=>$errorfile) if ($errorfile);
+ $template->param(errorloop=>address@hidden) if (@errorloop);
+}else{
+ if ($markseen) {
+ foreach my $field ($input->param) {
+ if ($field =~ /SEEN-(.*)/) {
+ &itemseen($1);
+ }
+ }
+ }
+ if ($op) {
+ my $res =
C4::Circulation::Circ2::GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$branchcode,$offset,$pagesize);
+ $template->param(loop =>$res,
+ nextoffset => ($offset+$pagesize),
+ prevoffset => ($offset?$offset-$pagesize:0),
+ );
+ }
+}
+output_html_with_http_headers $input, $cookie, $template->output;
+
+# Local Variables:
+# tab-width: 8
+# End:
Index: tools/itemslost.pl
===================================================================
RCS file: tools/itemslost.pl
diff -N tools/itemslost.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tools/itemslost.pl 9 Mar 2007 15:47:55 -0000 1.2
@@ -0,0 +1,97 @@
+#!/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
+
+#$Id: itemslost.pl,v 1.2 2007/03/09 15:47:55 tipaul Exp $
+
+=head1 itemslost
+
+This script displays lost items.
+
+=cut
+
+use strict;
+use CGI;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Circulation::Circ2; # GetLostItems
+use C4::Koha; # GetItemTypes
+use C4::Branch; # GetBranches
+
+my $query = new CGI;
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "tools/itemslost.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { tools => 1 },
+ debug => 1,
+ }
+);
+
+my $params = $query->Vars;
+
+if ( $params->{'get_items'} ) {
+ my $orderbyfilter = $params->{'orderbyfilter'} || undef;
+ my $branchfilter = $params->{'branchfilter'} || undef;
+ my $barcodefilter = $params->{'barcodefilter'} || undef;
+ my $itemtypesfilter = $params->{'itemtypesfilter'} || undef;
+
+ my %where;
+ $where{homebranch} = $branchfilter if defined $branchfilter;
+ $where{barcode} = $barcodefilter if defined $barcodefilter;
+ $where{itemtype} = $itemtypesfilter if defined $itemtypesfilter;
+
+ my $items = GetLostItems( \%where, $orderbyfilter );
+ $template->param(
+ total => scalar @$items,
+ itemsloop => $items
+ );
+}
+
+# getting all branches.
+my $branches = GetBranches;
+my $branch = C4::Context->userenv->{"branchname"};
+my @branchloop;
+foreach my $thisbranch ( keys %$branches ) {
+ my $selected = 1 if $thisbranch eq $branch;
+ my %row = (
+ value => $thisbranch,
+ selected => $selected,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+}
+
+# getting all itemtypes
+my $itemtypes = &GetItemTypes();
+my @itemtypesloop;
+foreach my $thisitemtype ( sort keys %$itemtypes ) {
+ my %row = (
+ value => $thisitemtype,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypesloop, \%row;
+}
+
+$template->param(
+ branchloop => address@hidden,
+ itemtypeloop => address@hidden,
+);
+
+# writing the template
+output_html_with_http_headers $query, $cookie, $template->output;
Index: tools/viewlog.pl
===================================================================
RCS file: tools/viewlog.pl
diff -N tools/viewlog.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tools/viewlog.pl 9 Mar 2007 15:47:55 -0000 1.2
@@ -0,0 +1,144 @@
+#!/usr/bin/perl
+
+# $Id: viewlog.pl,v 1.2 2007/03/09 15:47:55 tipaul Exp $
+
+# Copyright 2000-2002 Katipo Communications
+#
+# 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;
+use C4::Auth;
+use CGI;
+use C4::Context;
+use C4::Koha;
+use C4::Interface::CGI::Output;
+use C4::Log;
+use Date::Manip;
+
+=head1 viewlog.pl
+
+plugin that shows a stats on borrowers
+
+=cut
+
+my $input = new CGI;
+my $do_it = $input->param('do_it');
+my $module = $input->param("module");
+my $user = $input->param("user");
+my $action = $input->param("action");
+my $object = $input->param("object");
+my $info = $input->param("info");
+my $datefrom = $input->param("from");
+my $dateto = $input->param("to");
+my $basename = $input->param("basename");
+my $mime = $input->param("MIME");
+my $del = $input->param("sep");
+my $output = $input->param("output") || "screen";
+
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => "tools/viewlog.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { tools => 1 },
+ debug => 1,
+ }
+);
+
+if ($do_it) {
+
+ my $results =
GetLogs($datefrom,$dateto,$user,$module,$action,$object,$info);
+ my $total = scalar @$results;
+
+ if ( $output eq "screen" ) {
+
+ # Printing results to screen
+ $template->param (
+ total => $total,
+ $module => 1,
+ looprow => $results,
+ do_it => 1,
+ datefrom => $datefrom,
+ dateto => $dateto,
+ user => $user,
+ module => $module,
+ object => $object,
+ action => $action,
+ info => $info,
+ );
+ output_html_with_http_headers $input, $cookie, $template->output;
+ exit;
+ }
+ else {
+
+ # Printing to a csv file
+ print $input->header(
+ -type => 'application/vnd.sun.xml.calc',
+ -attachment => "$basename.csv",
+ -filename => "$basename.csv"
+ );
+ my $sep;
+ $sep = C4::Context->preference("delimiter");
+
+ foreach my $line (@$results) {
+ if ( $module eq "catalogue" ) {
+ print $line->{timestamp} . $sep;
+ print $line->{firstname} . $sep;
+ print $line->{surname} . $sep;
+ print $line->{action} . $sep;
+ print $line->{info} . $sep;
+ print $line->{title} . $sep;
+ print $line->{author} . $sep;
+ }
+ }
+
+ exit;
+ }
+}
+else {
+ my $dbh = C4::Context->dbh;
+ my @values;
+ my %labels;
+ my %select;
+ my $req;
+
+ my @mime = ( C4::Context->preference("MIME") );
+
+ my $CGIextChoice = CGI::scrolling_list(
+ -name => 'MIME',
+ -id => 'MIME',
+ -values => address@hidden,
+ -size => 1,
+ -multiple => 0
+ );
+
+ my @dels = ( C4::Context->preference("delimiter") );
+ my $CGIsepChoice = CGI::scrolling_list(
+ -name => 'sep',
+ -id => 'sep',
+ -values => address@hidden,
+ -size => 1,
+ -multiple => 0
+ );
+
+ $template->param(
+ total => 0,
+ CGIextChoice => $CGIextChoice,
+ CGIsepChoice => $CGIsepChoice
+ );
+ output_html_with_http_headers $input, $cookie, $template->output;
+}
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Koha-cvs] koha t/BookShelves.t tools/breeding.pl tools/cl...,
paul poulain <=