[Koha-cvs] koha circ/bookcount.pl circ/branchoverdues.pl c...
paul poulain
paul at koha-fr.org
Fri Mar 9 16:37:12 CET 2007
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/03/09 15:37:12
Added files:
circ : bookcount.pl branchoverdues.pl overdue.pl
stats.pl
export : export_filtered.pl export.pl marc.pl
Log message:
rel_3_0 moved to HEAD (introducing new files)
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/circ/bookcount.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/circ/branchoverdues.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/circ/overdue.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/circ/stats.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/export/export_filtered.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/export/export.pl?cvsroot=koha&rev=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/export/marc.pl?cvsroot=koha&rev=1.9
Patches:
Index: circ/bookcount.pl
===================================================================
RCS file: circ/bookcount.pl
diff -N circ/bookcount.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ circ/bookcount.pl 9 Mar 2007 15:37:12 -0000 1.2
@@ -0,0 +1,208 @@
+#!/usr/bin/perl
+
+# $Id: bookcount.pl,v 1.2 2007/03/09 15:37:12 tipaul Exp $
+
+#written 7/3/2002 by Finlay
+#script to display reports
+
+# 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::Context;
+use C4::Circulation::Circ2;
+use C4::Output;
+use C4::Koha;
+use C4::Auth;
+use C4::Branch; # GetBranches
+use C4::Biblio; # GetBiblioItemData
+use C4::Date;
+
+my $input = new CGI;
+my $itm = $input->param('itm');
+my $bi = $input->param('bi');
+my $biblionumber = $input->param('biblioitemnumber');
+my $branches = GetBranches;
+
+my $idata = itemdatanum($itm);
+my $data = GetBiblioItemData($bi);
+
+my $homebranch = $branches->{ $idata->{'homebranch'} }->{'branchname'};
+my $holdingbranch = $branches->{ $idata->{'holdingbranch'} }->{'branchname'};
+
+my ( $lastmove, $message ) = lastmove($itm);
+
+my $lastdate;
+my $count;
+if ( not $lastmove ) {
+ $lastdate = $message;
+ $count = issuessince( $itm, 0 );
+}
+else {
+ $lastdate = $lastmove->{'datearrived'};
+ $count = issuessince( $itm, $lastdate );
+}
+
+# make the page ...
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/bookcount.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ debug => 1,
+ }
+);
+
+my @branchloop;
+
+foreach my $branchcode ( keys %$branches ) {
+ my %linebranch;
+ $linebranch{issues} = issuesat( $itm, $branchcode );
+ my $date = lastseenat( $itm, $branchcode );
+ $linebranch{seen} = slashdate($date);
+ $linebranch{branchname} = $branches->{$branchcode}->{'branchname'};
+ push( @branchloop, \%linebranch );
+}
+
+$template->param(
+ biblionumber => $biblionumber,
+ title => $data->{'title'},
+ author => $data->{'author'},
+ barcode => $idata->{'barcode'},
+ biblioitemnumber => $bi,
+ homebranch => $homebranch,
+ holdingbranch => $holdingbranch,
+ lastdate => format_date($lastdate),
+ count => $count,
+ branchloop => \@branchloop,
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
+
+output_html_with_http_headers $input, $cookie, $template->output;
+
+
+sub itemdatanum {
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select * from items where itemnumber=?");
+ $sth->execute($itemnumber);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ($data);
+}
+
+sub lastmove {
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"select max(branchtransfers.datearrived) from branchtransfers where branchtransfers.itemnumber=?"
+ );
+ $sth->execute($itemnumber);
+ my ($date) = $sth->fetchrow_array;
+ return ( 0, "Item has no branch transfers record" ) if not $date;
+ $sth =
+ $dbh->prepare(
+"Select * from branchtransfers where branchtransfers.itemnumber=? and branchtransfers.datearrived=?"
+ );
+ $sth->execute( $itemnumber, $date );
+ my ($data) = $sth->fetchrow_hashref;
+ return ( 0, "Item has no branch transfers record" ) if not $data;
+ $sth->finish;
+ return ( $data, "" );
+}
+
+sub issuessince {
+ my ( $itemnumber, $date ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"Select count(*) from issues where issues.itemnumber=? and issues.timestamp > ?"
+ );
+ $sth->execute( $itemnumber, $date );
+ my $count = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ( $count->{'count(*)'} );
+}
+
+sub issuesat {
+ my ( $itemnumber, $brcd ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "Select count(*) from issues where itemnumber=? and branchcode = ?");
+ $sth->execute( $itemnumber, $brcd );
+ my ($count) = $sth->fetchrow_array;
+ $sth->finish;
+ return ($count);
+}
+
+sub lastseenat {
+ my ( $itm, $brc ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"Select max(timestamp) from issues where itemnumber=? and branchcode = ?"
+ );
+ $sth->execute( $itm, $brc );
+ my ($date1) = $sth->fetchrow_array;
+ $sth->finish;
+ $sth =
+ $dbh->prepare(
+"Select max(datearrived) from branchtransfers where itemnumber=? and tobranch = ?"
+ );
+ $sth->execute( $itm, $brc );
+ my ($date2) = $sth->fetchrow_array;
+ $sth->finish;
+
+ #FIXME: MJR thinks unsafe
+ $date2 =~ s/-//g;
+ $date2 =~ s/://g;
+ $date2 =~ s/ //g;
+ my $date;
+ if ( $date1 < $date2 ) {
+ $date = $date2;
+ }
+ else {
+ $date = $date1;
+ }
+ return ($date);
+}
+
+#####################################################
+# write date....
+sub slashdate {
+ my ($date) = @_;
+ if ( not $date ) {
+ return "never";
+ }
+ my ( $yr, $mo, $da, $hr, $mi ) = (
+ substr( $date, 0, 4 ),
+ substr( $date, 4, 2 ),
+ substr( $date, 6, 2 ),
+ substr( $date, 8, 2 ),
+ substr( $date, 10, 2 )
+ );
+ return "$hr:$mi " . format_date("$yr-$mo-$da");
+}
Index: circ/branchoverdues.pl
===================================================================
RCS file: circ/branchoverdues.pl
diff -N circ/branchoverdues.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ circ/branchoverdues.pl 9 Mar 2007 15:37:12 -0000 1.2
@@ -0,0 +1,170 @@
+#!/usr/bin/perl
+
+# $Id: branchoverdues.pl,v 1.2 2007/03/09 15:37:12 tipaul Exp $
+#
+# 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::Context;
+use CGI;
+use C4::Interface::CGI::Output;
+use C4::Auth;
+use C4::Date;
+use C4::Circulation::Circ2; # AddNotifyLine
+use C4::Koha; # GetDepartement...
+use Mail::Sendmail;
+use Getopt::Long;
+use Date::Calc qw/Today Today_and_Now Now/;
+
+=head1 branchoverdues.pl
+
+ this module is a new interface, allow to the librarian to check all items on overdues (based on the acountlines type 'FU' )
+ this interface is filtered by branches (automaticly), and by departement (optional) ....
+ all informations are stocked in the notifys BDD
+
+ FIXME for this time, we have only four methods to notify :
+ - mail : work with a batch programm
+ - letter : for us, the letters are generated by an open-office program
+ - phone : Simple method, when the method 'phone' is selected, we consider, that the borrower as been notified, and the notify send date is implemented
+ - considered lost : for us if the document is on the third overduelevel,
+
+ FIXME the methods are actually hardcoded for the levels : (maybe can be improved by a new possibility in overduerule)
+
+ level 1 : three methods are possible : - mail, letter, phone
+ level 2 : only one method is possible : - letter
+ level 3 : only methode is possible : - Considered Lost
+
+ the documents displayed on this interface, are checked on three points
+ - 1) the document must be on accountlines (Type 'FU')
+ - 2) item issues is not returned
+ - 3) this item as not been already notify
+
+=cut
+
+my $input = new CGI;
+my $theme = $input->param('theme'); # only used if allowthemeoverride is set
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/branchoverdues.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ debug => 1,
+ }
+);
+
+my $default = C4::Context->userenv->{'branch'};
+
+# Initate localtime
+my ( $year, $month, $day ) = &Today;
+my $todaysdate = join "-", ( $year, $month, $day );
+
+# Deal with the vars recept from the template
+my $borrowernumber = $input->param('borrowernumber');
+my $itemnumber = $input->param('itemnumber');
+my $method = $input->param('method');
+my $overduelevel = $input->param('overduelevel');
+my $notifyId = $input->param('notifyId');
+my $departement = $input->param('departement');
+
+# now create the line in bdd (notifys)
+if ( $input->param('action') eq 'add' ) {
+ my $addnotify =
+ AddNotifyLine( $borrowernumber, $itemnumber, $overduelevel, $method,
+ $notifyId );
+}
+
+# possibility to remove notify line
+if ( $input->param('action') eq 'remove' ) {
+ my $notify_date = $input->param('notify_date');
+ my $removenotify =
+ RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
+}
+
+my @overduesloop;
+my @todayoverduesloop;
+my $counter = 0;
+
+my @getoverdues = GetOverduesForBranch( $default, $departement );
+
+# filter by departement
+if ($departement) {
+ my ( $departementlib, $departementValue ) = GetDepartementLib($departement);
+ $template->param(
+ departement => $departementlib,
+ departementValue => $departementValue,
+ );
+}
+else {
+
+ # initiate the selector of departements .....
+ my @getdepartements = GetDepartements();
+ my @departementsloop;
+ foreach my $dpt (@getdepartements) {
+ my %departement;
+ $departement{'authorised_value'} = $dpt->{'authorised_value'};
+ $departement{'lib'} = $dpt->{'lib'};
+ push( @departementsloop, \%departement );
+ }
+ $template->param( departementsloop => \@departementsloop, );
+}
+
+# now display infos
+foreach my $num (@getoverdues) {
+
+ my %overdueforbranch;
+ $overdueforbranch{'date_due'} = format_date( $num->{'date_due'} );
+ $overdueforbranch{'title'} = $num->{'title'};
+ $overdueforbranch{'description'} = $num->{'description'};
+ $overdueforbranch{'barcode'} = $num->{'barcode'};
+ $overdueforbranch{'biblionumber'} = $num->{'biblionumber'};
+ $overdueforbranch{'borrowersurname'} = $num->{'surname'};
+ $overdueforbranch{'borrowerfirstname'} = $num->{'firstname'};
+ $overdueforbranch{'borrowerphone'} = $num->{'phone'};
+ $overdueforbranch{'borroweremail'} = $num->{'email'};
+ $overdueforbranch{'itemcallnumber'} = $num->{'itemcallnumber'};
+ $overdueforbranch{'borrowernumber'} = $num->{'borrowernumber'};
+ $overdueforbranch{'itemnumber'} = $num->{'itemnumber'};
+
+ # now we add on the template, the differents values of notify_level
+ if ( $num->{'notify_level'} eq '1' ) {
+ $overdueforbranch{'overdue1'} = 1;
+ $overdueforbranch{'overdueLevel'} = 1;
+ }
+
+ if ( $num->{'notify_level'} eq '2' ) {
+ $overdueforbranch{'overdue2'} = 1;
+ $overdueforbranch{'overdueLevel'} = 2;
+ }
+
+ if ( $num->{'notify_level'} eq '3' ) {
+ $overdueforbranch{'overdue3'} = 1;
+ $overdueforbranch{'overdueLevel'} = 3;
+ }
+ $overdueforbranch{'notify_id'} = $num->{'notify_id'};
+
+ push( @overduesloop, \%overdueforbranch );
+}
+
+# initiate the templates for the overdueloop
+$template->param(
+ overduesloop => \@overduesloop,
+ show_date => format_date($todaysdate),
+);
+
+output_html_with_http_headers $input, $cookie, $template->output;
Index: circ/overdue.pl
===================================================================
RCS file: circ/overdue.pl
diff -N circ/overdue.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ circ/overdue.pl 9 Mar 2007 15:37:12 -0000 1.2
@@ -0,0 +1,125 @@
+#!/usr/bin/perl
+
+# $Id: overdue.pl,v 1.2 2007/03/09 15:37:12 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::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use CGI;
+use C4::Auth;
+use C4::Date;
+
+my $input = new CGI;
+my $type = $input->param('type');
+
+my $theme = $input->param('theme'); # only used if allowthemeoverride is set
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/overdue.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { reports => 1 },
+ debug => 1,
+ }
+);
+my $duedate;
+my $borrowernumber;
+my $itemnum;
+my $data1;
+my $data2;
+my $data3;
+my $name;
+my $phone;
+my $email;
+my $biblionumber;
+my $title;
+my $author;
+my @datearr = localtime( time() );
+my $todaysdate =
+ ( 1900 + $datearr[5] ) . '-'
+ . sprintf( "%0.2d", ( $datearr[4] + 1 ) ) . '-'
+ . sprintf( "%0.2d", $datearr[3] );
+
+my $dbh = C4::Context->dbh;
+
+my $sth =
+ $dbh->prepare(
+ "select date_due,borrowernumber,itemnumber
+ from issues
+ where isnull(returndate) && date_due<? order by date_due,borrowernumber"
+ );
+$sth->execute($todaysdate);
+
+my @overduedata;
+while ( my $data = $sth->fetchrow_hashref ) {
+ $duedate = format_date($data->{'date_due'});
+ $borrowernumber = $data->{'borrowernumber'};
+ $itemnum = $data->{'itemnumber'};
+
+ my $sth1 =
+ $dbh->prepare(
+"select concat(firstname,' ',surname),phone,email from borrowers where borrowernumber=?"
+ );
+ $sth1->execute($borrowernumber);
+ $data1 = $sth1->fetchrow_hashref;
+ $name = $data1->{'concat(firstname,\' \',surname)'};
+ $phone = $data1->{'phone'};
+ $email = $data1->{'email'};
+ $sth1->finish;
+
+ my $sth2 =
+ $dbh->prepare("select biblionumber from items where itemnumber=?");
+ $sth2->execute($itemnum);
+ $data2 = $sth2->fetchrow_hashref;
+ $biblionumber = $data2->{'biblionumber'};
+ $sth2->finish;
+
+ my $sth3 =
+ $dbh->prepare("select title,author from biblio where biblionumber=?");
+ $sth3->execute($biblionumber);
+ $data3 = $sth3->fetchrow_hashref;
+ $title = $data3->{'title'};
+ $author = $data3->{'author'};
+ $sth3->finish;
+ push(
+ @overduedata,
+ {
+ duedate => $duedate,
+ borrowernumber => $borrowernumber,
+ itemnum => $itemnum,
+ name => $name,
+ phone => $phone,
+ email => $email,
+ biblionumber => $biblionumber,
+ title => $title,
+ author => $author
+ }
+ );
+}
+
+$template->param(
+ todaysdate => $todaysdate,
+ overdueloop => \@overduedata
+);
+
+output_html_with_http_headers $input, $cookie, $template->output;
Index: circ/stats.pl
===================================================================
RCS file: circ/stats.pl
diff -N circ/stats.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ circ/stats.pl 9 Mar 2007 15:37:12 -0000 1.2
@@ -0,0 +1,193 @@
+#!/usr/bin/perl
+
+# $Id: stats.pl,v 1.2 2007/03/09 15:37:12 tipaul Exp $
+
+#written 14/1/2000
+#script to display reports
+
+# 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::Output;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Context;
+use Date::Manip;
+use C4::Stats;
+
+my $input = new CGI;
+my $time = $input->param('time');
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/stats.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { reports => 1 },
+ debug => 1,
+ }
+);
+
+my $date;
+my $date2;
+if ( $time eq '' ) {
+ $template->param(notime => '1');
+ output_html_with_http_headers $input, $cookie, $template->output;
+ exit;
+}
+if ( $time eq 'yesterday' ) {
+ $date = ParseDate('yesterday');
+ $date2 = ParseDate('today');
+}
+if ( $time eq 'today' ) {
+ $date = ParseDate('today');
+ $date2 = ParseDate('tomorrow');
+}
+if ( $time eq 'daybefore' ) {
+ $date = ParseDate('2 days ago');
+ $date2 = ParseDate('yesterday');
+}
+if ( $time eq 'month' ) {
+ $date = ParseDate('1 month ago');
+ $date2 = ParseDate('today');
+ warn "d : $date // d2 : $date2";
+}
+if ( $time =~ /\// ) {
+ $date = ParseDate($time);
+ $date2 = ParseDateDelta('+ 1 day');
+ $date2 = DateCalc( $date, $date2 );
+}
+$date = UnixDate( $date, '%Y-%m-%d' );
+$date2 = UnixDate( $date2, '%Y-%m-%d' );
+warn "d : $date // d2 : $date2";
+my @payments = TotalPaid( $date, $date2 );
+my $count = @payments;
+my $total = 0;
+my $oldtime;
+my $totalw = 0;
+my @loop;
+my %row;
+my $i = 0;
+
+while ( $i < $count ) {
+ warn " pay : " . $payments[$i]{'timestamp'};
+ my $time = $payments[$i]{'datetime'};
+ my $payments = $payments[$i]{'value'};
+ my $charge = 0;
+ my @temp = split( / /, $payments[$i]{'datetime'} );
+ my $date = $temp[0];
+ my @charges =
+ getcharges( $payments[$i]{'borrowernumber'}, $payments[$i]{'timestamp'} );
+ my $count = @charges;
+ my $temptotalf = 0;
+ my $temptotalr = 0;
+ my $temptotalres = 0;
+ my $temptotalren = 0;
+ my $temptotalw = 0;
+
+ for ( my $i2 = 0 ; $i2 < $count ; $i2++ ) {
+ $charge += $charges[$i2]->{'amount'};
+ %row = (
+ name => $charges[$i2]->{'description'},
+ type => $charges[$i2]->{'accounttype'},
+ time => $charges[$i2]->{'timestamp'},
+ amount => $charges[$i2]->{'amount'},
+ branch => $charges[$i2]->{'amountoutstanding'}
+ );
+ push( @loop, \%row );
+ if ( $payments[$i]{'accountytpe'} ne 'W' ) {
+ if ( $charges[$i2]->{'accounttype'} eq 'Rent' ) {
+ $temptotalr +=
+ $charges[$i2]->{'amount'} -
+ $charges[$i2]->{'amountoutstanding'};
+ }
+ if ( $charges[$i2]->{'accounttype'} eq 'F'
+ || $charges[$i2]->{'accounttype'} eq 'FU'
+ || $charges[$i2]->{'accounttype'} eq 'FN' )
+ {
+ $temptotalf +=
+ $charges[$i2]->{'amount'} -
+ $charges[$i2]->{'amountoutstanding'};
+ }
+ if ( $charges[$i2]->{'accounttype'} eq 'Res' ) {
+ $temptotalres +=
+ $charges[$i2]->{'amount'} -
+ $charges[$i2]->{'amountoutstanding'};
+ }
+ if ( $charges[$i2]->{'accounttype'} eq 'R' ) {
+ $temptotalren +=
+ $charges[$i2]->{'amount'} -
+ $charges[$i2]->{'amountoutstanding'};
+ }
+ }
+ }
+ my $hour = substr( $payments[$i]{'timestamp'}, 8, 2 );
+ my $min = substr( $payments[$i]{'timestamp'}, 10, 2 );
+ my $sec = substr( $payments[$i]{'timestamp'}, 12, 2 );
+ my $time = "$hour:$min:$sec";
+ my $time2 = "$payments[$i]{'date'}";
+ my $branch = Getpaidbranch( $time2, $payments[$i]{'borrowernumber'} );
+ my $borrowernumber = $payments[$i]{'borrowernumber'};
+ my $oldtime = $payments[$i]{'timestamp'};
+ my $oldtype = $payments[$i]{'accounttype'};
+
+ while ($borrowernumber eq $payments[$i]{'borrowernumber'}
+ && $oldtype == $payments[$i]{'accounttype'}
+ && $oldtime eq $payments[$i]{'timestamp'} )
+ {
+ my $hour = substr( $payments[$i]{'timestamp'}, 8, 2 );
+ my $min = substr( $payments[$i]{'timestamp'}, 10, 2 );
+ my $sec = substr( $payments[$i]{'timestamp'}, 12, 2 );
+ my $time = "$hour:$min:$sec";
+ my $time2 = "$payments[$i]{'date'}";
+ my $branch = Getpaidbranch( $time2, $payments[$i]{'borrowernumber'} );
+ if ( $payments[$i]{'accounttype'} eq 'W' ) {
+ $totalw += $payments[$i]{'amount'};
+ }
+ else {
+ $payments[$i]{'amount'} = $payments[$i]{'amount'} * -1;
+ $total += $payments[$i]{'amount'};
+ }
+
+ %row = (
+ name => "<b>"
+ . $payments[$i]{'firstname'}
+ . $payments[$i]{'surname'} . "</b>",
+ type => $payments[$i]{'accounttype'},
+ time => $payments[$i]{'date'},
+ amount => $payments[$i]{'amount'},
+ branch => $branch
+ );
+ push( @loop, \%row );
+ $oldtype = $payments[$i]{'accounttype'};
+ $oldtime = $payments[$i]{'timestamp'};
+ $borrowernumber = $payments[$i]{'borrowernumber'};
+ $i++;
+ }
+}
+
+$template->param(
+ loop1 => \@loop,
+ totalw => $totalw,
+ total => $total
+);
+
+output_html_with_http_headers $input, $cookie, $template->output;
+
Index: export/export_filtered.pl
===================================================================
RCS file: export/export_filtered.pl
diff -N export/export_filtered.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ export/export_filtered.pl 9 Mar 2007 15:37:12 -0000 1.2
@@ -0,0 +1,69 @@
+#!/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
+
+## This script allows you to export a rel_2_2 bibliographic db in
+#MARC21 format from the command line.
+#
+
+use strict;
+require Exporter;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Output; # contains gettemplate
+use C4::Biblio;
+use CGI;
+use C4::Auth;
+
+my $outfile = $ARGV[0];
+open( OUT, ">$outfile" ) or die $!;
+my $query = new CGI;
+# my $StartingBiblionumber = $query->param("StartingBiblionumber");
+# my $EndingBiblionumber = $query->param("EndingBiblionumber");
+my $StartingBiblionumber = $ARGV[1];
+my $EndingBiblionumber = $ARGV[2];
+my $dbh = C4::Context->dbh;
+my $sth;
+
+warn "start ->".$StartingBiblionumber;
+warn "stop ->".$EndingBiblionumber;
+
+ my $query =
+ my $query = "
+ SELECT biblionumber
+ FROM biblioitems
+ WHERE biblionumber >=?
+ AND biblionumber <=?
+ AND NOT EXISTS (
+ SELECT DISTINCT (biblio_auth_number) FROM zebraqueue
+ WHERE ( biblioitems.biblionumber = zebraqueue.biblio_auth_number)
+ AND (zebraqueue.server = 'biblioserver'
+ OR zebraqueue.server = '')
+ )
+ ORDER BY biblionumber
+ ";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $StartingBiblionumber, $EndingBiblionumber );
+binmode(OUT, 'utf8');
+my $i = 0;
+while ( my ($biblionumber) = $sth->fetchrow ) {
+ my $record = GetMarcBiblio($biblionumber);
+ print $i++ . "\n";
+
+ print OUT $record->as_usmarc();
+}
+
+close(OUT);
Index: export/export.pl
===================================================================
RCS file: export/export.pl
diff -N export/export.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ export/export.pl 9 Mar 2007 15:37:12 -0000 1.3
@@ -0,0 +1,67 @@
+#!/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
+
+## This script allows you to export a rel_2_2 bibliographic db in
+#MARC21 format from the command line.
+#
+
+use strict;
+require Exporter;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Output; # contains gettemplate
+use C4::Biblio;
+use CGI;
+use C4::Auth;
+
+my $outfile = $ARGV[0];
+open( OUT, ">$outfile" ) or die $!;
+my $query = new CGI;
+my $StartingBiblionumber = $query->param("StartingBiblionumber");
+my $EndingBiblionumber = $query->param("EndingBiblionumber");
+my $dbh = C4::Context->dbh;
+my $sth;
+
+if ( $StartingBiblionumber && $EndingBiblionumber ) {
+ my $query =
+ "SELECT biblionumber
+ FROM biblioitems
+ WHERE biblionumber >=?
+ AND biblionumber <=?
+ ORDER BY biblionumber
+ ";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $StartingBiblionumber, $EndingBiblionumber );
+} else {
+ my $query = "
+ SELECT biblionumber
+ FROM biblioitems
+ ORDER BY biblionumber
+ ";
+ $sth = $dbh->prepare($query);
+ $sth->execute;
+}
+binmode(OUT, 'utf8');
+my $i = 0;
+while ( my ($biblionumber) = $sth->fetchrow ) {
+ my $record = GetMarcBiblio($biblionumber);
+ print $i++ . "\n";
+
+ print OUT $record->as_usmarc();
+}
+
+close(OUT);
Index: export/marc.pl
===================================================================
RCS file: export/marc.pl
diff -N export/marc.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ export/marc.pl 9 Mar 2007 15:37:12 -0000 1.9
@@ -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
+
+# $Id: marc.pl,v 1.9 2007/03/09 15:37:12 tipaul Exp $
+
+use C4::Branch; # GetBranches
+use strict;
+require Exporter;
+
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Output; # contains gettemplate
+use C4::Biblio;
+use CGI;
+use C4::Koha;
+
+my $query = new CGI;
+my $op=$query->param("op");
+my $dbh=C4::Context->dbh;
+
+if ($op eq "export") {
+ print $query->header( -type => 'application/octet-stream',
+ -attachment=>'koha.mrc');
+ my $StartingBiblionumber = $query->param("StartingBiblionumber");
+ my $EndingBiblionumber = $query->param("EndingBiblionumber");
+ my $format = $query->param("format");
+ my $branch = $query->param("branch");
+ my $start_callnumber = $query->param("start_callnumber");
+ my $end_callnumber = $query->param("end_callnumber");
+ my $limit = $query->param("limit");
+ my $strsth;
+ $strsth="select bibid from marc_biblio ";
+ if ($StartingBiblionumber && $EndingBiblionumber) {
+ $strsth.=" where biblionumber>=$StartingBiblionumber and biblionumber<=$EndingBiblionumber ";
+ }elsif ($format) {
+ if ($strsth=~/ where/){
+ $strsth=~s/ where (.*)/,biblioitems where biblioitems.biblionumber=marc_biblio.biblionumber and biblioitems.itemtype=\'$format\' and $1/;
+ }else {
+ $strsth.=",biblioitems where biblioitems.biblionumber=marc_biblio.biblionumber and biblioitems.itemtype=\'$format\'";
+ }
+ } elsif ($branch) {
+ if ($strsth=~/ where/){
+ $strsth=~s/ where (.*)/,items where items.biblionumber=marc_biblio.biblionumber and items.homebranch=\'$branch\' and $1/;
+ }else {
+ $strsth.=",items where items.biblionumber=marc_biblio.biblionumber and items.homebranch=\'$branch\'";
+ }
+ } elsif ($start_callnumber && $end_callnumber) {
+ $start_callnumber=~s/\*/\%/g;
+ $start_callnumber=~s/\?/\_/g;
+ $end_callnumber=~s/\*/\%/g;
+ $end_callnumber=~s/\?/\_/g;
+ if ($strsth=~/,items/){
+ $strsth.=" and items.itemcallnumber between \'$start_callnumber\' and \'$end_callnumber\'";
+ } else {
+ if ($strsth=~/ where/){
+ $strsth=~s/ where (.*)/,items where items.biblionumber=marc_biblio.biblionumber and items.itemcallnumber between \'$start_callnumber\' and \'$end_callnumber\' and $1/;
+ }else {
+ $strsth=~",items where items.biblionumber=marc_biblio.biblionumber and items.itemcallnumber between \'$start_callnumber\' and \'$end_callnumber\' ";
+ }
+ }
+ }
+ $strsth.=" order by marc_biblio.biblionumber ";
+ $strsth.= "LIMIT 0,$limit " if ($limit);
+ warn "requete marc.pl : ".$strsth;
+ my $req=$dbh->prepare($strsth);
+ $req->execute;
+ while (my ($bibid) = $req->fetchrow) {
+ my $record = GetMarcBiblio($bibid);
+
+ print $record->as_usmarc();
+ }
+} else {
+ my $sth=$dbh->prepare("Select itemtype,description from itemtypes order by description");
+ $sth->execute;
+ my @itemtype;
+ my %itemtypes;
+ push @itemtype, "";
+ $itemtypes{''} = "";
+ while (my ($value,$lib) = $sth->fetchrow_array) {
+ push @itemtype, $value;
+ $itemtypes{$value}=$lib;
+ }
+
+ my $CGIitemtype=CGI::scrolling_list( -name => 'format',
+ -values => \@itemtype,
+ -default => '',
+ -labels => \%itemtypes,
+ -size => 1,
+ -tabindex=>'',
+ -multiple => 0 );
+ $sth->finish;
+
+ my $branches = GetBranches;
+ 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;
+ }
+
+ my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "export/marc.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {tools => 1},
+ debug => 1,
+ });
+ $template->param(branchloop=>\@branchloop,
+ CGIitemtype=>$CGIitemtype,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+ output_html_with_http_headers $query, $cookie, $template->output;
+}
+
More information about the Koha-cvs
mailing list