gitea
/
Koha-clms
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Bug 28572: Remove C4::Debug 

We are using Koha::Logger when it makes sense to keep the info,
otherwise we simply remove it

Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>

Bug 28572: Replace missing occurrence in misc/admin/koha-preferences

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
This commit is contained in:
Jonathan Druart 2021-06-18 11:25:16 +02:00
parent 6f204fdf96
commit 3fe837bc74
97 changed files with 92 additions and 592 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C4/Acquisition.pm
View File

@ -22,11 +22,9 @@ use Modern::Perl;
use Carp;
use Text::CSV_XS;
use C4::Context;
use C4::Debug;
use C4::Suggestions;
use C4::Biblio;
use C4::Contract;
use C4::Debug;
use C4::Log qw(logaction);
use C4::Templates qw(gettemplate);
use Koha::DateUtils qw( dt_from_string output_pref );

1
C4/Auth_with_cas.pm
View File

@ -20,7 +20,6 @@ package C4::Auth_with_cas;
use strict;
use warnings;
use C4::Debug;
use C4::Context;
use Koha::AuthUtils qw(get_script_name);
use Authen::CAS::Client;

1
C4/Auth_with_ldap.pm
View File

@ -20,7 +20,6 @@ package C4::Auth_with_ldap;
use Modern::Perl;
use Carp;
use C4::Debug;
use C4::Context;
use C4::Members::Messaging;
use C4::Auth qw(checkpw_internal);

1
C4/Auth_with_shibboleth.pm
View File

@ -19,7 +19,6 @@ package C4::Auth_with_shibboleth;
use Modern::Perl;
use C4::Debug;
use C4::Context;
use Koha::AuthUtils qw(get_script_name);
use Koha::Database;

21
C4/Barcodes.pm
View File

@ -23,14 +23,12 @@ use warnings;
use Carp;
use C4::Context;
use C4::Debug;
use C4::Barcodes::hbyymmincr;
use C4::Barcodes::annual;
use C4::Barcodes::incremental;
use C4::Barcodes::EAN13;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use vars qw($debug $cgi_debug); # from C4::Debug, of course
use vars qw($max $prefformat);
BEGIN {
@ -73,11 +71,8 @@ sub value {
my $self = shift;
if (@_) {
my $value = shift;
if (defined $value) {
$debug and print STDERR " setting barcode value to $value\n";
} else {
warn "Error: UNDEF argument to value";
}
warn "Error: UNDEF argument to value"
unless defined $value;
$self->{value} = $value;
}
return $self->{value};
@ -96,16 +91,13 @@ sub parse { # return 3 parts of barcode: non-incrementing, incrementing, non-inc
carp "Barcode '$barcode' has no incrementing part!";
return ($barcode,undef,undef);
}
$debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
}
sub max {
my $self = shift;
if ($self->{is_max}) {
$debug and print STDERR "max taken from Barcodes value $self->value\n";
return $self->value;
}
$debug and print STDERR "Retrieving max database query.\n";
return $self->db_max;
}
sub db_max {
@ -123,7 +115,6 @@ sub next_value {
warn "No max barcode ($self->autoBarcode format) found. Using initial value.";
return $self->initial;
}
$debug and print STDERR "(current) max barcode found: $max\n";
my ($head,$incr,$tail) = $self->parse($max); # for incremental, you'd get ('',the_whole_barcode,'')
unless (defined $incr) {
warn "No incrementing part of barcode ($max) returned by parse.";
@ -135,11 +126,9 @@ sub next_value {
# Those should override next_value() to work accordingly.
$incr++;
$debug and warn "$incr";
$head = $self->process_head($head,$max,$specific);
$tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
my $next_value = $head . $incr . $tail;
$debug and print STDERR "( next ) max barcode found: $next_value\n";
return $next_value;
}
sub next {
@ -183,9 +172,6 @@ sub new {
my $class_or_object = shift;
my $type = ref($class_or_object) || $class_or_object;
my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
if ($from_obj) {
$debug and print STDERR "Building new(@_) from old Barcodes object\n";
}
my $autoBarcodeType = (@_) ? shift : $from_obj ? $class_or_object->autoBarcode : _prefformat;
$autoBarcodeType =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
unless ($autoBarcodeType) {
@ -196,7 +182,6 @@ sub new {
carp "The autoBarcode format '$autoBarcodeType' is unrecognized.";
return;
}
carp "autoBarcode format = $autoBarcodeType" if $debug;
my $self;
if ($autoBarcodeType eq 'OFF') {
$self = $class_or_object->default_self($autoBarcodeType);
@ -207,7 +192,6 @@ sub new {
$self = $class_or_object->new_object(@_);
$self->serial($class_or_object->serial + 1);
if ($class_or_object->is_max) {
$debug and print STDERR "old object was max: ", $class_or_object->value, "\n";
$self->previous($class_or_object);
$class_or_object->next($self);
$self->value($self->next_value($class_or_object->value));
@ -216,7 +200,6 @@ sub new {
$self->value($self->next_value);
}
} else {
$debug and print STDERR "trying to create new $autoBarcodeType\n";
$self = &{$types->{$autoBarcodeType}} (@_);
$self->value($self->next_value) and $self->is_max(1);
$self->serial(1);

3
C4/Barcodes/EAN13.pm
View File

@ -21,13 +21,11 @@ use strict;
use warnings;
use C4::Context;
use C4::Debug;
use Algorithm::CheckDigits;
use Carp;
use vars qw(@ISA);
use vars qw($debug $cgi_debug); # from C4::Debug, of course
BEGIN {
@ISA = qw(C4::Barcodes);
@ -50,7 +48,6 @@ sub process_tail {
my $ean = CheckDigits('ean');
my $full = $ean->complete($whole);
my $chk = $ean->checkdigit($full);
$debug && warn "# process_tail $tail -> $chk [$whole -> $full] $specific";
return $chk;
}

4
C4/Barcodes/annual.pm
View File

@ -23,12 +23,10 @@ use warnings;
use Carp;
use C4::Context;
use C4::Debug;
use Koha::DateUtils qw( output_pref dt_from_string );
use vars qw(@ISA);
use vars qw($debug $cgi_debug); # from C4::Debug, of course
use vars qw($width);
BEGIN {
@ -55,7 +53,6 @@ sub db_max {
my $year = substr($iso,0,4); # YYYY
$sth->execute("$year-%");
my $row = $sth->fetchrow_hashref;
warn "barcode db_max (annual format, year $year): $row->{barcode}" if $debug;
return $row->{barcode};
}
@ -71,7 +68,6 @@ sub parse {
carp "Barcode '$barcode' has no incrementing part!";
return ($barcode,undef,undef);
}
$debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
}
sub width {

10
C4/Barcodes/hbyymmincr.pm
View File

@ -22,14 +22,12 @@ use Modern::Perl;
use Carp;
use C4::Context;
use C4::Debug;
use Koha::DateUtils qw( dt_from_string output_pref );
use constant WIDTH => 4; # FIXME: too small for sizeable or multi-branch libraries?
use vars qw(@ISA);
use vars qw($debug $cgi_debug); # from C4::Debug, of course
BEGIN {
@ISA = qw(C4::Barcodes);
@ -42,7 +40,6 @@ sub db_max {
my $self = shift;
my $width = WIDTH;
my $query = "SELECT SUBSTRING(barcode,-$width) AS chunk, barcode FROM items WHERE barcode REGEXP ? ORDER BY chunk DESC LIMIT 1";
$debug and print STDERR "(hbyymmincr) db_max query: $query\n";
my $sth = C4::Context->dbh->prepare($query);
my ($iso);
if (@_) {
@ -64,7 +61,6 @@ sub db_max {
}
my ($row) = $sth->fetchrow_hashref;
my $max = $row->{barcode};
warn "barcode max (hbyymmincr format): $max" if $debug;
return ($max || 0);
}
@ -85,7 +81,6 @@ sub parse { # return 3 parts of barcode: non-incrementing, incrementing, non-i
carp "Barcode '$barcode' has no incrementing part!";
return ($barcode,undef,undef);
}
$debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
}
@ -111,7 +106,6 @@ sub process_head { # (self,head,whole,specific)
}
sub new_object {
$debug and warn "hbyymmincr: new_object called";
my $class_or_object = shift;
my $type = ref($class_or_object) || $class_or_object;
@ -127,10 +121,6 @@ sub new_object {
$self->branch( @_ ? shift : $from_obj ? $class_or_object->branch : '' );
warn "HBYYMM Barcode created with no branchcode, default is blank" if ( $self->branch() eq '' );
# take the branch from argument, or existing object, or default
use Data::Dumper;
$debug and print STDERR "(hbyymmincr) new_object: ", Dumper($self), "\n";
return $self;
}

7
C4/Biblio.pm
View File

@ -92,8 +92,8 @@ use C4::ClassSource;
use C4::Charset;
use C4::Linker;
use C4::OAI::Sets;
use C4::Debug;
use Koha::Logger;
use Koha::Caches;
use Koha::Authority::Types;
use Koha::Acquisition::Currencies;
@ -106,9 +106,6 @@ use Koha::SearchEngine::Indexer;
use Koha::Libraries;
use Koha::Util::MARC;
use vars qw($debug $cgi_debug);
=head1 NAME
C4::Biblio - cataloging management functions
@ -2498,7 +2495,7 @@ $server is authorityserver or biblioserver
sub ModZebra {
my ( $record_number, $op, $server ) = @_;
$debug && warn "ModZebra: updates requested for: $record_number $op $server\n";
Koha::Logger->get->debug("ModZebra: updates requested for: $record_number $op $server");
my $dbh = C4::Context->dbh;
# true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates

2
C4/Budgets.pm
View File

@ -22,7 +22,6 @@ use C4::Context;
use Koha::Database;
use Koha::Patrons;
use Koha::Acquisition::Invoice::Adjustments;
use C4::Debug;
use C4::Acquisition;
use vars qw(@ISA @EXPORT);
@ -510,7 +509,6 @@ sub GetBudgetHierarchy {
}
}
$query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
$debug && warn $query,join(",",@bind_params);
my $sth = $dbh->prepare($query);
$sth->execute(@bind_params);

8
C4/Charset.pm
View File

@ -17,15 +17,15 @@ package C4::Charset;
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use strict;
use warnings;
use Modern::Perl;
use MARC::Charset qw/marc8_to_utf8/;
use Text::Iconv;
use C4::Debug;
use Unicode::Normalize;
use Encode qw( decode encode is_utf8 );
use Koha::Logger;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
BEGIN {
@ -353,7 +353,7 @@ sub SetMarcUnicodeFlag {
$marc_record->insert_grouped_field(
MARC::Field->new( 100, '', '', "a" => $string ) );
}
$debug && warn "encodage: ", substr( $marc_record->subfield(100, 'a'), $encodingposition, 3 );
Koha::Logger->get->debug("encodage: ", substr( $marc_record->subfield(100, 'a'), $encodingposition, 3 ));
} else {
warn "Unrecognized marcflavour: $marc_flavour";
}

3
C4/Circulation.pm
View File

@ -34,7 +34,6 @@ use C4::Members;
use C4::Accounts;
use C4::ItemCirculationAlertPreference;
use C4::Message;
use C4::Debug;
use C4::Log; # logaction
use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
use C4::RotatingCollections qw(GetCollectionItemBranches);
@ -2293,8 +2292,6 @@ sub AddReturn {
(C4::Context->preference("UseBranchTransferLimits") and
! IsBranchTransferAllowed($branch, $returnbranch, $item->$BranchTransferLimitsType )
)) {
$debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s, %s)", $item->itemnumber,$branch, $returnbranch, $transfer_trigger;
$debug and warn "item: " . Dumper($item->unblessed);
ModItemTransfer($item->itemnumber, $branch, $returnbranch, $transfer_trigger, { skip_record_index => 1 });
$messages->{'WasTransfered'} = $returnbranch;
$messages->{'TransferTrigger'} = $transfer_trigger;

3
C4/ClassSplitRoutine/Dewey.pm
View File

@ -19,8 +19,6 @@ package C4::ClassSplitRoutine::Dewey;
use Modern::Perl;
use C4::Debug;
=head1 NAME
C4::ClassSplitRoutine::Dewey - Dewey call number split method
@ -66,7 +64,6 @@ sub split_callnumber {
push @lines, split /\s+/,
pop @lines
; # split the last piece into an arbitrary number of pieces at spaces
$debug and print STDERR "split_ddcn array: ", join( " | ", @lines ), "\n";
return @lines;
}

3
C4/ClassSplitRoutine/Generic.pm
View File

@ -19,8 +19,6 @@ package C4::ClassSplitRoutine::Generic;
use Modern::Perl;
use C4::Debug;
=head1 NAME
C4::ClassSplitRoutine::Generic - generic call number sorting key routine
@ -58,7 +56,6 @@ sub split_callnumber {
warn sprintf( 'regexp failed to match string: %s', $cn_item );
push( @lines, $cn_item );
}
$debug and print STDERR "split_ccn array: ", join( " | ", @lines ), "\n";
return @lines;
}

5
C4/ClassSplitRoutine/LCC.pm
View File

@ -20,7 +20,7 @@ package C4::ClassSplitRoutine::LCC;
use Modern::Perl;
use Library::CallNumber::LC;
use C4::Debug;
use Koha::Logger;
=head1 NAME
@ -45,12 +45,11 @@ sub split_callnumber {
# lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
my @lines = Library::CallNumber::LC->new($cn_item)->components();
unless (scalar @lines && defined $lines[0]) {
$debug and warn sprintf('regexp failed to match string: %s', $cn_item);
Koha::Logger->get->debug(sprintf('regexp failed to match string: %s', $cn_item));
@lines = $cn_item; # if no match, just use the whole string.
}
my $LastPiece = pop @lines;
push @lines, split /\s+/, $LastPiece if $LastPiece; # split the last piece into an arbitrary number of pieces at spaces
$debug and warn "split LCC array: ", join(" | ", @lines), "\n";
return @lines;
}

2
C4/ClassSplitRoutine/RegEx.pm
View File

@ -19,8 +19,6 @@ package C4::ClassSplitRoutine::RegEx;
use Modern::Perl;
use C4::Debug;
=head1 NAME
C4::ClassSplitRoutine::RegEx - regex call number sorting key routine

1
C4/Context.pm
View File

@ -44,7 +44,6 @@ use POSIX ();
use YAML::XS;
use ZOOM;
use C4::Debug;
use Koha::Caches;
use Koha::Config::SysPref;
use Koha::Config::SysPrefs;

2
C4/Creators/Batch.pm
View File

@ -6,8 +6,6 @@ use warnings;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
sub _check_params {
my $given_params = {};

2
C4/Creators/Layout.pm
View File

@ -6,10 +6,8 @@ use warnings;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
use C4::Creators::PDF;
# FIXME: Consider this style parameter verification instead...
# my %param = @_;
# for (keys %param)

2
C4/Creators/Lib.pm
View File

@ -23,7 +23,6 @@ use Storable qw(dclone);
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
BEGIN {
use base qw(Exporter);
@ -266,7 +265,6 @@ sub get_all_image_names {
my $image_names = [];
my $query = "SELECT image_name FROM creator_images";
my $sth = C4::Context->dbh->prepare($query);
# $sth->{'TraceLevel'} = 3 if $debug;
$sth->execute();
if ($sth->err) {
warn sprintf('Database returned the following error: %s', $sth->errstr);

1
C4/Creators/Profile.pm
View File

@ -6,7 +6,6 @@ use warnings;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
use C4::Creators::Lib qw(get_unit_values);

1
C4/Creators/Template.pm
View File

@ -6,7 +6,6 @@ use POSIX qw(ceil);
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
use C4::Creators::Profile;
use C4::Creators::Lib qw(get_unit_values);

183
C4/Debug.pm
View File

@ -1,183 +0,0 @@
package C4::Debug;
# 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 3 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, see <http://www.gnu.org/licenses>.
use strict;
use warnings;
use Exporter;
# use CGI qw ( -utf8 );
use vars qw(@ISA @EXPORT $debug $cgi_debug);
# use vars qw(@EXPORT_OK %EXPORT_TAGS);
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw($debug $cgi_debug);
# @EXPOR_OK = qw();
# %EXPORT_TAGS = ( all=>[qw($debug $cgi_debug)], );
}
BEGIN {
# this stuff needs a begin block too, since dependencies might alter their compilations
# for example, adding DataDumper
$debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0;
# CGI->new conflicts w/ some upload functionality,
# since we would get the "first" CGI object here.
# Instead we have to parse for ourselves if we want QUERY_STRING triggers.
# my $query = CGI->new(); # conflicts!
# $cgi_debug = $ENV{KOHA_CGI_DEBUG} || $query->param('debug') || 0;
$cgi_debug = $ENV{KOHA_CGI_DEBUG} || 0;
unless ($cgi_debug or not $ENV{QUERY_STRING}) {
foreach (split /\&/, $ENV{QUERY_STRING}) {
/^debug\=(.+)$/ or next;
$cgi_debug = $1;
last;
}
}
unless ($debug =~ /^\d$/) {
warn "Invalid \$debug value attempted: $debug";
$debug=1;
}
unless ($cgi_debug =~ /^\d$/) {
$debug and
warn "Invalid \$cgi_debug value attempted: $cgi_debug";
$cgi_debug=1;
}
}
# sub import {
# print STDERR __PACKAGE__ . " (Debug) import @_\n";
# C4::Debug->export_to_level(1, @_);
# }
1;
__END__
=head1 NAME
C4::Debug - Standardized, centralized, exported debug switches.
=head1 SYNOPSIS
use C4::Debug;
=head1 DESCRIPTION
The purpose of this module is to centralize some of the "switches" that turn debugging
off and on in Koha. Most often, this functionality will be provided via C4::Context.
C4::Debug is separate to preserve the relatively stable state of Context, and
because other code will use C4::Debug without invoking Context.
Although centralization is our intention,
for logical and security reasons, several approaches to debugging need to be
kept separate. Information useful to developers in one area will not necessarily
be useful or even available to developers in another area.
For example, the designer of template-influenced javascript my want to be able to
trigger javascript's alert function to display certain variable values, to verify
the template selection is being performed correctly. For this purpose the presence
of a javascript "debug" variable might be a good switch.
Meanwhile, where security coders (say, for LDAP Auth) will appreciate low level feedback about
Authentication transactions, an environmental system variable might be a good switch.
However, clearly we would not want to expose that same information (e.g., entire LDAP records)
to the web interface based on a javascript variable (even if it were possible)!
All that is a long way of saying THERE ARE SECURITY IMPLICATIONS to turning on
debugging in various parts of the system, so don't treat them all the same or confuse them.
=head1 VARIABLES / AREAS
=head2 $debug - System, general
The general purpose debug switch.
=head3 How to Set $debug:
=over
=item environmental variable DEBUG or KOHA_DEBUG. In bash, you might do:
export KOHA_DEBUG=1;
perl t/Auth.t;
=item Keep in mind that your webserver will not be running in the same environment as your shell.
However, for development purposes, the same effect can be had by using Apache's SET_ENV
command with ERROR_LOG enabled for your VirtualHost. Not intended for production systems.
=item You can force the value from perl directly, like:
use C4::Debug;
BEGIN { $C4::Debug::debug = 1; }
# now any other dependencies that also use C4::Debug will have debugging ON.
=back
=head2 $cgi_debug (CGI params) The web-based debug switch.
=head3 How to Set $cgi_debug:
=over
=item From a web browser, for example by supplying a non-zero debug parameter (1 to 9):
http://www.mylibrary.org/cgi-bin/koha/opac-search.pl?q=history&debug=1
=item Or in HTML, add a similar input parameter:
<input type="hidden" name="debug" value="1" />
=item Or from shell (or Apache), set KOHA_CGI_DEBUG.
=back
The former methods mean $cgi_debug is exposed. Do NOT use it to trigger any actions that you would
not allow a (potentially anonymous) end user to perform. Dumping sensitive data, directory listings, or
emailing yourself a test message would all be bad actions to tie to $cgi_debug.
=head1 OTHER SOURCES of Debug Switches
=head2 System Preferences
=cut
=head2 Database Debug
Debugging at the database level might be useful. Koha does not currently integrate any such
capability.
=head1 CONVENTIONS
Debug values range from 0 to 9. At zero (the default), debugging is off.
=head1 AUTHOR
Joe Atzberger
atz AT liblime DOT com
=head1 SEE ALSO
CGI(3)
C4::Context
=cut

3
C4/External/BakerTaylor.pm vendored
View File

@ -23,7 +23,6 @@ use LWP::Simple;
use HTTP::Request::Common;
use C4::Context;
use C4::Debug;
use Modern::Perl;
@ -91,9 +90,7 @@ sub availability {
($user and $pass) or return;
$isbn =~ s/(p|-)//g; # sanitize
my $url = "https://contentcafe2.btol.com/ContentCafe/InventoryAvailability.asmx/CheckInventory?UserID=$user&Password=$pass&Value=$isbn";
$debug and warn __PACKAGE__ . " request:\n$url\n";
my $content = get($url);
$debug and print STDERR $content, "\n";
warn "could not retrieve $url" unless $content;
my $xmlsimple = XML::Simple->new();
my $result = $xmlsimple->XMLin($content);

1
C4/Form/MessagingPreferences.pm
View File

@ -23,7 +23,6 @@ use warnings;
use CGI qw ( -utf8 );
use C4::Context;
use C4::Members::Messaging;
use C4::Debug;
use constant MAX_DAYS_IN_ADVANCE => 30;

26
C4/ImportExportFramework.pm
View File

@ -27,8 +27,7 @@ use Text::CSV_XS;
use List::MoreUtils qw(indexes);
use C4::Context;
use C4::Debug;
use Koha::Logger;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ -226,7 +225,7 @@ sub ExportFramework
}
};
if ($@) {
$debug and warn "Error ExportFramework $@\n";
Koha::Logger->get->warn("Error ExportFramework $@");
return 0;
}
}
@ -298,7 +297,7 @@ sub _export_table_csv
$$strCSV .= chr(10);
};
if ($@) {
$debug and warn "Error _export_table_csv $@\n";
Koha::Logger->get->warn("Error _export_table_csv $@");
return 0;
}
return 1;
@ -364,7 +363,7 @@ sub _export_table_ods
}
};
if ($@) {
$debug and warn "Error _export_table_ods $@\n";
Koha::Logger->get->warn("Error _export_table_ods $@");
return 0;
}
return 1;
@ -429,7 +428,7 @@ sub _export_table_excel
}
};
if ($@) {
$debug and warn "Error _export_table_excel $@\n";
Koha::Logger->get->warn("Error _export_table_excel $@");
return 0;
}
return 1;
@ -551,7 +550,7 @@ sub createODS
}
};
if ($@) {
$debug and warn "Error createODS $@\n";
Koha::Logger->get->warn("Error createODS $@");
} else {
# create ods file from tempdir directory
eval {
@ -676,11 +675,11 @@ sub ImportFramework
}
}
} else {
$debug and warn "Error ImportFramework couldn't create dom\n";
Koha::Logger->get->warn("Error ImportFramework couldn't create dom");
}
};
if ($@) {
$debug and warn "Error ImportFramework $@\n";
Koha::Logger->get->warn("Error ImportFramework $@");
} else {
if ($extension eq 'csv') {
close($dom) if ($dom);
@ -689,7 +688,7 @@ sub ImportFramework
}
unlink ($filename) if ($deleteFilename); # remove temporary file
} else {
$debug and warn "Error ImportFramework no conex to database or not readeable $filename\n";
Koha::Logger->get->warn("Error ImportFramework no conex to database or not readeable $filename");
}
if ($deleteFilename && $tempdir && -d $tempdir && -w $tempdir) {
eval {
@ -860,8 +859,7 @@ sub _processRow_DB
$sth->execute((@$dataFields, @$dataFields));
};
if ($@) {
warn $@;
$debug and warn "Error _processRow_DB $@\n";
Koha::Logger->get->warn("Error _processRow_DB $@");
} else {
$ok = 1;
}
@ -1011,7 +1009,7 @@ sub _import_table_ods
my $nodeR = $nodes[0]->firstChild;
return _processRows_Table($dbh, $frameworkcode, $nodeR, $table, $PKArray, 'ods', $fields2Delete);
} else {
$debug and warn "Error _import_table_ods there's not worksheet for $table\n";
Koha::Logger->get->warn("Error _import_table_ods there's not worksheet for $table");
}
return 0;
}#_import_table_ods
@ -1037,7 +1035,7 @@ sub _import_table_excel
}
}
} else {
$debug and warn "Error _import_table_excel there's not worksheet for $table\n";
Koha::Logger->get->warn("Error _import_table_excel there's not worksheet for $table");
}
return 0;
}#_import_table_excel

4
C4/Labels/Label.pm
View File

@ -10,7 +10,6 @@ use Data::Dumper;
use Text::Bidi qw( log2vis );
use C4::Context;
use C4::Debug;
use C4::Biblio;
use Koha::ClassSources;
use Koha::ClassSortRules;
@ -153,8 +152,6 @@ sub _get_barcode_data {
for my $field ( @fields ) {
if ($item->{$field}) {
push @data, $item->{$field};
} else {
$debug and warn sprintf("The '%s' field contains no data.", $field);
}
}
$datastring .= join ' ', @data;
@ -241,7 +238,6 @@ sub _BIBBAR {
my $barcode_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
my $line_spacer = ($self->{'font_size'} * 1); # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
$debug and warn "Label: llx $self->{'llx'}, lly $self->{'lly'}, Text: lly $text_lly, $line_spacer, Barcode: llx $barcode_llx, lly $barcode_lly, $barcode_width, $barcode_y_scale_factor\n";
return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
}

11
C4/Letters.pm
View File

@ -32,7 +32,6 @@ use C4::Members;
use C4::Log;
use C4::SMS;
use C4::Templates;
use C4::Debug;
use Koha::DateUtils;
use Koha::SMS::Providers;
@ -928,7 +927,7 @@ sub EnqueueLetter {
my $content = $params->{letter}->{content};
$content =~ s/\s+//g if(defined $content);
if ( not defined $content or $content eq '' ) {
warn "Trying to add an empty message to the message queue" if $debug;
Koha::Logger->get->info("Trying to add an empty message to the message queue");
return;
}
@ -1013,7 +1012,7 @@ sub SendQueuedMessages {
warn sprintf( 'sending %s message to patron: %s',
$message->{'message_transport_type'},
$message->{'borrowernumber'} || 'Admin' )
if $params->{'verbose'} or $debug;
if $params->{'verbose'};
# This is just begging for subclassing
next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
@ -1024,13 +1023,13 @@ sub SendQueuedMessages {
my $patron = Koha::Patrons->find( $message->{borrowernumber} );
my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
unless ( $sms_provider ) {
warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
_set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
next MESSAGE;
}
unless ( $patron->smsalertnumber ) {
_set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
next MESSAGE;
}
$message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
@ -1299,8 +1298,6 @@ sub _get_unsent_messages {
}
}
$debug and warn "_get_unsent_messages SQL: $statement";
$debug and warn "_get_unsent_messages params: " . join(',',@query_params);
my $sth = $dbh->prepare( $statement );
my $result = $sth->execute( @query_params );
return $sth->fetchall_arrayref({});

2
C4/Output.pm
View File

@ -100,8 +100,6 @@ sub pagination_bar {
$base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
$current_page = ($1) ? $1 : 1; # pull current page from param in URL, else default to 1
# $debug and # FIXME: use C4::Debug;
# warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1 2:$2 3:$3";
}
$base_url =~ s/($delim)+/$1/g; # compress duplicate delims
$base_url =~ s/$delim;//g; # remove empties

11
C4/Overdues.pm
View File

@ -31,7 +31,7 @@ use C4::Circulation;
use C4::Context;
use C4::Accounts;
use C4::Log; # logaction
use C4::Debug;
use Koha::Logger;
use Koha::DateUtils;
use Koha::Account::Lines;
use Koha::Account::Offsets;
@ -275,7 +275,6 @@ sub CalcFine {
$amount = $item->{replacementprice} if ( $issuing_rule->{cap_fine_to_replacement_price} && $item->{replacementprice} && $amount > $item->{replacementprice} );
$debug and warn sprintf("CalcFine returning (%s, %s, %s)", $amount, $units_minus_grace, $chargeable_units);
return ($amount, $units_minus_grace, $chargeable_units);
}
@ -522,8 +521,6 @@ sub UpdateFine {
my $amount = $params->{amount};
my $due = $params->{due} // q{};
$debug and warn "UpdateFine({ itemnumber => $itemnum, borrowernumber => $borrowernumber, due => $due, issue_id => $issue_id})";
unless ( $issue_id ) {
carp("No issue_id passed in!");
return;
@ -547,7 +544,7 @@ sub UpdateFine {
while (my $overdue = $overdues->next) {
if ( defined $overdue->issue_id && $overdue->issue_id == $issue_id && $overdue->status eq 'UNRETURNED' ) {
if ($accountline) {
$debug and warn "Not a unique accountlines record for issue_id $issue_id";
Koha::Logger->get->debug("Not a unique accountlines record for issue_id $issue_id"); # FIXME Do we really need to log that?
#FIXME Should we still count this one in total_amount ??
}
else {
@ -563,12 +560,12 @@ sub UpdateFine {
if ($accountline) {
if ( ( $amount - $accountline->amount ) > $maxIncrease ) {
my $new_amount = $accountline->amount + $maxIncrease;
$debug and warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
Koha::Logger->get->debug("Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached");
$amount = $new_amount;
}
}
elsif ( $amount > $maxIncrease ) {
$debug and warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $maxIncrease - MaxFine reached";
Koha::Logger->get->debug("Reducing fine for item $itemnum borrower $borrowernumber from $amount to $maxIncrease - MaxFine reached");
$amount = $maxIncrease;
}
}

3
C4/Patroncards/Lib.pm
View File

@ -20,10 +20,7 @@ package C4::Patroncards::Lib;
use strict;
use warnings;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
use C4::Debug;
BEGIN {
use base qw(Exporter);

1
C4/Reports.pm
View File

@ -22,7 +22,6 @@ use CGI qw ( -utf8 );
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use C4::Context;
use C4::Debug;
BEGIN {
require Exporter;

13
C4/Reports/Guided.pm
View File

@ -30,11 +30,11 @@ use Koha::DateUtils;
use Koha::Patrons;
use Koha::Reports;
use C4::Output;
use C4::Debug;
use C4::Log;
use Koha::Notice::Templates;
use C4::Letters;
use Koha::Logger;
use Koha::AuthorisedValues;
use Koha::Patron::Categories;
use Koha::SharedContent;
@ -550,7 +550,8 @@ sub execute_query {
}
$offset = 0 unless $offset;
$limit = 999999 unless $limit;
$debug and print STDERR "execute_query($sql, $offset, $limit)\n";
Koha::Logger->get->debug("Report - execute_query($sql, $offset, $limit)");
my ( $is_sql_valid, $errors ) = Koha::Report->new({ savedsql => $sql })->is_sql_valid;
return (undef, @{$errors}[0]) unless $is_sql_valid;
@ -571,9 +572,11 @@ sub execute_query {
# Grab offset/limit from user supplied LIMIT and drop the LIMIT so we can control pagination
($sql, $useroffset, $userlimit) = strip_limit($sql);
$debug and warn sprintf "User has supplied (OFFSET,) LIMIT = %s, %s",
$useroffset,
(defined($userlimit ) ? $userlimit : 'UNDEF');
Koha::Logger->get->debug(
sprintf "User has supplied (OFFSET,) LIMIT = %s, %s",
$useroffset, ( defined($userlimit) ? $userlimit : 'UNDEF' ) );
$offset += $useroffset;
if (defined($userlimit)) {
if ($offset + $limit > $userlimit ) {

2
C4/SIP/ILS/Item.pm
View File

@ -19,7 +19,6 @@ use C4::SIP::Sip qw(add_field);
use C4::Biblio;
use C4::Circulation;
use C4::Context;
use C4::Debug;
use C4::Items;
use C4::Members;
use C4::Reserves;
@ -372,7 +371,6 @@ sub available {
my ($self, $for_patron) = @_;
my $count = (defined $self->{pending_queue}) ? scalar @{$self->{pending_queue}} : 0;
my $count2 = (defined $self->{hold_attached} ) ? scalar @{$self->{hold_attached} } : 0;
$debug and print STDERR "availability check: pending_queue size $count, hold_attached size $count2\n";
if (defined($self->{borrowernumber})) {
($self->{borrowernumber} eq $for_patron) or return 0;
return ($count ? 0 : 1);

5
C4/SIP/ILS/Patron.pm
View File

@ -17,7 +17,6 @@ use Data::Dumper;
use C4::SIP::Sip qw(add_field maybe_add);
use C4::Debug;
use C4::Context;
use C4::Koha;
use C4::Members;
@ -53,7 +52,6 @@ sub new {
|| Koha::Patrons->find( { userid => $patron_id } );
}
$debug and warn "new Patron: " . Dumper($patron->unblessed) if $patron;
unless ($patron) {
siplog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
return;
@ -62,7 +60,6 @@ sub new {
my $pw = $kp->{password};
my $flags = C4::Members::patronflags( $kp );
my $debarred = $patron->is_debarred;
$debug and warn sprintf("Debarred = %s : ", ($debarred||'undef')); # Do we need more debug info here?
my ($day, $month, $year) = (localtime)[3,4,5];
my $today = sprintf '%04d-%02d-%02d', $year+1900, $month+1, $day;
my $expired = ($today gt $kp->{dateexpiry}) ? 1 : 0;
@ -134,7 +131,6 @@ sub new {
userid => $kp->{userid},
);
}
$debug and warn "patron fines: $ilspatron{fines} ... amountoutstanding: $kp->{amountoutstanding} ... CHARGES->amount: $flags->{CHARGES}->{amount}";
if ( $patron->is_debarred and $patron->debarredcomment ) {
$ilspatron{screen_msg} .= " -- " . $patron->debarredcomment;
@ -165,7 +161,6 @@ sub new {
$ilspatron{items} = \@barcodes;
$self = \%ilspatron;
$debug and warn Dumper($self);
siplog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
bless $self, $type;
return $self;

2
C4/SIP/ILS/Transaction/Checkin.pm
View File

@ -12,7 +12,6 @@ use strict;
use C4::SIP::ILS::Transaction;
use C4::Circulation;
use C4::Debug;
use C4::Items qw( ModItemTransfer );
use C4::Reserves qw( ModReserveAffect );
use Koha::DateUtils qw( dt_from_string );
@ -90,7 +89,6 @@ sub do_checkin {
my $checkin_blocked_by_holds = $holds_block_checkin && $item->biblio->holds->count;
$debug and warn "do_checkin() calling AddReturn($barcode, $branch)";
( $return, $messages, $issue, $borrower ) =
AddReturn( $barcode, $branch, undef, $return_date )
unless $human_required || $checkin_blocked_by_holds;

11
C4/SIP/ILS/Transaction/Checkout.pm
View File

@ -18,14 +18,10 @@ use C4::Context;
use C4::Circulation;
use C4::Members;
use C4::Reserves qw(ModReserveFill);
use C4::Debug;
use Koha::DateUtils;
use parent qw(C4::SIP::ILS::Transaction);
our $debug;
# Most fields are handled by the Transaction superclass
my %fields = (
security_inhibit => 0,
@ -40,8 +36,6 @@ sub new {
$self->{_permitted}->{$element} = $fields{$element};
}
@{$self}{keys %fields} = values %fields;
# $self->{'due'} = time() + (60*60*24*14); # two weeks hence
$debug and warn "new ILS::Transaction::Checkout : " . Dumper $self;
return bless $self, $class;
}
@ -54,7 +48,6 @@ sub do_checkout {
my $patron = Koha::Patrons->find($self->{patron}->{borrowernumber});
my $overridden_duedate; # usually passed as undef to AddIssue
my $prevcheckout_block_checkout = $account->{prevcheckout_block_checkout};
$debug and warn "do_checkout borrower: . " . $patron->borrowernumber;
my ($issuingimpossible, $needsconfirmation) = _can_we_issue($patron, $barcode, 0);
my $noerror=1; # If set to zero we block the issue
@ -77,7 +70,6 @@ sub do_checkout {
} elsif ($confirmation eq 'RESERVE_WAITING'
or $confirmation eq 'TRANSFERRED'
or $confirmation eq 'PROCESSING') {
$debug and warn "Item is on hold for another patron.";
$self->screen_msg("Item is on hold for another patron.");
$noerror = 0;
} elsif ($confirmation eq 'ISSUED_TO_ANOTHER') {
@ -123,13 +115,10 @@ sub do_checkout {
}
}
unless ($noerror) {
$debug and warn "cannot issue: " . Dumper($issuingimpossible) . "\n" . Dumper($needsconfirmation);
$self->ok(0);
return $self;
}
# can issue
$debug and warn sprintf("do_checkout: calling AddIssue(%s, %s, %s, 0)\n", $patron->borrowernumber, $barcode, $overridden_duedate)
. "w/ C4::Context->userenv: " . Dumper(C4::Context->userenv);
my $issue = AddIssue( $patron->unblessed, $barcode, $overridden_duedate, 0 );
$self->{due} = $self->duedatefromissue($issue, $itemnumber);

5
C4/Scrubber.pm
View File

@ -25,9 +25,6 @@ use Carp;
use HTML::Scrubber;
use C4::Context;
use C4::Debug;
my %scrubbertypes = (
default => {}, # place holder, default settings are below as fallbacks in call to constructor
@ -46,7 +43,6 @@ sub new {
if ( !exists $scrubbertypes{$type} ) {
croak "New called with unrecognized type '$type'";
}
$debug and carp "Building new Scrubber of type '$type'";
my $settings = $scrubbertypes{$type};
my $scrubber = HTML::Scrubber->new(
allow => exists $settings->{allow} ? $settings->{allow} : [],
@ -65,7 +61,6 @@ __END__
=head1 C4::Sanitize
Standardized wrapper with settings for building HTML::Scrubber tailored to various koha inputs.
More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
The default is to scrub everything, leaving no markup at all. This is compatible with the expectations
for Tags.

44
C4/Search.pm
View File

@ -26,8 +26,8 @@ use Lingua::Stem;
use XML::Simple;
use C4::XSLT;
use C4::Reserves; # GetReserveStatus
use C4::Debug;
use C4::Charset;
use Koha::Logger;
use Koha::AuthorisedValues;
use Koha::ItemTypes;
use Koha::Libraries;
@ -37,11 +37,7 @@ use URI::Escape;
use Business::ISBN;
use MARC::Record;
use MARC::Field;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
BEGIN {
$DEBUG = ($ENV{DEBUG}) ? 1 : 0;
}
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
=head1 NAME
@ -323,8 +319,7 @@ sub getRecords {
# if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
#$query_to_use = $simple_query if $scan;
warn $simple_query if ( $scan and $DEBUG );
Koha::Logger->get->debug($simple_query) if $scan;
# Check if we've got a query_type defined, if so, use it
eval {
@ -869,7 +864,8 @@ sub _build_stemmed_operand {
unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
$stemmed_operand .= " ";
}
warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
Koha::Logger->get->debug("STEMMED OPERAND: $stemmed_operand");
return $stemmed_operand;
}
@ -1186,7 +1182,6 @@ See verbose embedded documentation.
sub buildQuery {
my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
warn "---------\nEnter buildQuery\n---------" if $DEBUG;
my $query_desc;
@ -1351,7 +1346,6 @@ sub buildQuery {
$operand=join(" ",map{
(index($_,"*")>0?"$_":"$_*")
}split (/\s+/,$operand));
warn $operand if $DEBUG;
}
}
@ -1360,9 +1354,9 @@ sub buildQuery {
my( $nontruncated, $righttruncated, $lefttruncated,
$rightlefttruncated, $regexpr
) = _detect_truncation( $operand, $index );
warn
"TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
if $DEBUG;
Koha::Logger->get->debug(
"TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<");
# Apply Truncation
if (
@ -1395,14 +1389,14 @@ sub buildQuery {
}
}
$operand = $truncated_operand if $truncated_operand;
warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
Koha::Logger->get->debug("TRUNCATED OPERAND: >$truncated_operand<");
# Handle Stemming
my $stemmed_operand;
$stemmed_operand = _build_stemmed_operand($operand, $lang)
if $stemming;
warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
Koha::Logger->get->debug("STEMMED OPERAND: >$stemmed_operand<");
# Handle Field Weighting
my $weighted_operand;
@ -1412,7 +1406,7 @@ sub buildQuery {
$indexes_set = 1;
}
warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
Koha::Logger->get->debug("FIELD WEIGHTED OPERAND: >$weighted_operand<");
#Use relevance ranking when not using a weighted query (which adds relevance ranking of its own)
@ -1437,7 +1431,7 @@ sub buildQuery {
} #/if $operands
} # /for
}
warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
Koha::Logger->get->debug("QUERY BEFORE LIMITS: >$query<");
# add limits
my %group_OR_limits;
@ -1532,16 +1526,9 @@ sub buildQuery {
# append the limit to the query
$query .= " " . $limit;
# Warnings if DEBUG
if ($DEBUG) {
warn "QUERY:" . $query;
warn "QUERY CGI:" . $query_cgi;
warn "QUERY DESC:" . $query_desc;
warn "LIMIT:" . $limit;
warn "LIMIT CGI:" . $limit_cgi;
warn "LIMIT DESC:" . $limit_desc;
warn "---------\nLeave buildQuery\n---------";
}
Koha::Logger->get->debug(
sprintf "buildQuery returns\nQUERY:%s\nQUERY CGI:%s\nQUERY DESC:%s\nLIMIT:%s\nLIMIT CGI:%s\nLIMIT DESC:%s",
$query, $query_cgi, $query_desc, $limit, $limit_cgi, $limit_desc );
return (
undef, $query, $simple_query, $query_cgi,
@ -2198,7 +2185,6 @@ sub GetDistinctValues {
if ($fieldname=~/\./){
my ($table,$column)=split /\./, $fieldname;
my $dbh = C4::Context->dbh;
warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
my $sth = $dbh->prepare("select DISTINCT($column) as value, count(*) as cnt from $table ".($string?" where $column like \"$string%\"":"")."group by value order by $column ");
$sth->execute;
my $elements=$sth->fetchall_arrayref({});

6
C4/Serials.pm
View File

@ -27,7 +27,6 @@ use Date::Calc qw(:all);
use POSIX qw(strftime);
use C4::Biblio;
use C4::Log; # logaction
use C4::Debug;
use C4::Serials::Frequency;
use C4::Serials::Numberpattern;
use Koha::AdditionalFieldValues;
@ -197,7 +196,6 @@ sub GetSerialInformation {
#It is ASSUMED that GetMarcItem ALWAYS WORK...
#Maybe GetMarcItem should return values on failure
$debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
$itemprocessed->{'itemnumber'} = $itemnum->[0];
$itemprocessed->{'itemid'} = $itemnum->[0];
@ -266,7 +264,6 @@ sub GetSubscription {
WHERE subscription.subscriptionid = ?
);
$debug and warn "query : $query\nsubsid :$subscriptionid";
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $subscription = $sth->fetchrow_hashref;
@ -320,7 +317,6 @@ sub GetFullSubscription {
IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
serial.subscriptionid
|;
$debug and warn "GetFullSubscription query: $query";
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $subscriptions = $sth->fetchall_arrayref( {} );
@ -732,7 +728,6 @@ sub GetSerials2 {
. q|
ORDER BY publisheddate,serialid DESC
|;
$debug and warn "GetSerials2 query: $query";
my $sth = $dbh->prepare($query);
$sth->execute( $subscription, @$statuses );
my @serials;
@ -1575,7 +1570,6 @@ sub ReNewSubscription {
$sth = $dbh->prepare($query);
$sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
my $enddate = GetExpirationDate($subscriptionid);
$debug && warn "enddate :$enddate";
$query = qq|
UPDATE subscription
SET enddate=?

3
C4/Stats.pm
View File

@ -22,7 +22,6 @@ use Modern::Perl;
require Exporter;
use Carp;
use C4::Context;
use C4::Debug;
use Koha::DateUtils qw( dt_from_string );
use Koha::Statistics;
@ -30,8 +29,6 @@ use Koha::PseudonymizedTransactions;
use vars qw(@ISA @EXPORT);
our $debug;
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw(

2
C4/Suggestions.pm
View File

@ -23,7 +23,6 @@ use CGI qw ( -utf8 );
use C4::Context;
use C4::Output;
use C4::Debug;
use C4::Letters;
use C4::Biblio qw( GetMarcFromKohaField );
use Koha::DateUtils;
@ -210,7 +209,6 @@ sub SearchSuggestion {
push @query, q{ AND suggestions.archived = 0 };
}
$debug && warn "@query";
my $sth = $dbh->prepare("@query");
$sth->execute(@sql_params);
my @results;

32
C4/Tags.pm
View File

@ -24,7 +24,6 @@ use Carp;
use Exporter;
use C4::Context;
use C4::Debug;
use Module::Load::Conditional qw/check_install/;
#use Data::Dumper;
use constant TAG_FIELDS => qw(tag_id borrowernumber biblionumber term language date_created);
@ -55,23 +54,15 @@ BEGIN {
warn "Ignoring TagsExternalDictionary, because Lingua::Ispell is not installed.";
$ext_dict = q{};
}
if ($debug) {
require Data::Dumper;
import Data::Dumper qw(:DEFAULT);
print STDERR __PACKAGE__ . " external dictionary = " . ($ext_dict||'none') . "\n";
}
if ($ext_dict) {
require Lingua::Ispell;
import Lingua::Ispell qw(spellcheck add_word_lc);
$Lingua::Ispell::path = $ext_dict;
$debug and print STDERR "\$Lingua::Ispell::path = $Lingua::Ispell::path\n";
}
}
=head1 C4::Tags.pm - Support for user tagging of biblios.
More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
=cut
sub get_filters {
@ -100,7 +91,6 @@ sub approval_counts {
$sth->execute;
my $result = $sth->fetchrow_hashref();
$result->{approved_total} = $result->{approved_count} + $result->{rejected_count} + $result->{unapproved_count};
$debug and warn "counts returned: " . Dumper $result;
return $result;
}
@ -134,9 +124,6 @@ sub remove_tag {
($tag_id == $row->{tag_id}) or return 0;
my $tags = get_tags({term=>$row->{term}, biblionumber=>$row->{biblionumber}});
my $index = shift(@$tags);
$debug and print STDERR
sprintf "remove_tag: tag_id=>%s, biblionumber=>%s, weight=>%s, weight_total=>%s\n",
$row->{tag_id}, $row->{biblionumber}, $index->{weight}, $index->{weight_total};
if ($index->{weight} <= 1) {
delete_tag_index($row->{term},$row->{biblionumber});
} else {
@ -187,7 +174,6 @@ sub get_tag_rows {
my $limit = "";
my @exe_args = ();
foreach my $key (keys %$hash) {
$debug and print STDERR "get_tag_rows arg. '$key' = ", $hash->{$key}, "\n";
unless (length $key) {
carp "Empty argument key to get_tag_rows: ignoring!";
next;
@ -209,8 +195,6 @@ sub get_tag_rows {
}
}
my $query = TAG_SELECT . ($wheres||'') . $limit;
$debug and print STDERR "get_tag_rows query:\n $query\n",
"get_tag_rows query args: ", join(',', @exe_args), "\n";
my $sth = C4::Context->dbh->prepare($query);
if (@exe_args) {
$sth->execute(@exe_args);
@ -228,7 +212,6 @@ sub get_tags { # i.e., from tags_index
my $order = "";
my @exe_args = ();
foreach my $key (keys %$hash) {
$debug and print STDERR "get_tags arg. '$key' = ", $hash->{$key}, "\n";
unless (length $key) {
carp "Empty argument key to get_tags: ignoring!";
next;
@ -278,8 +261,6 @@ sub get_tags { # i.e., from tags_index
LEFT JOIN tags_approval
ON tags_index.term = tags_approval.term
" . ($wheres||'') . $order . $limit;
$debug and print STDERR "get_tags query:\n $query\n",
"get_tags query args: ", join(',', @exe_args), "\n";
my $sth = C4::Context->dbh->prepare($query);
if (@exe_args) {
$sth->execute(@exe_args);
@ -297,7 +278,6 @@ sub get_approval_rows { # i.e., from tags_approval
my $order = "";
my @exe_args = ();
foreach my $key (keys %$hash) {
$debug and print STDERR "get_approval_rows arg. '$key' = ", $hash->{$key}, "\n";
unless (length $key) {
carp "Empty argument key to get_approval_rows: ignoring!";
next;
@ -353,8 +333,6 @@ sub get_approval_rows { # i.e., from tags_approval
LEFT JOIN borrowers
ON tags_approval.approved_by = borrowers.borrowernumber ";
$query .= ($wheres||'') . $order . $limit;
$debug and print STDERR "get_approval_rows query:\n $query\n",
"get_approval_rows query args: ", join(',', @exe_args), "\n";
my $sth = C4::Context->dbh->prepare($query);
if (@exe_args) {
$sth->execute(@exe_args);
@ -442,7 +420,6 @@ sub remove_filter {
}
sub add_tag_approval { # or disapproval
$debug and warn "add_tag_approval(" . join(", ",map {defined($_) ? $_ : 'UNDEF'} @_) . ")";
my $term = shift or return;
my $query = "SELECT * FROM tags_approval WHERE term = ?";
my $sth = C4::Context->dbh->prepare($query);
@ -460,7 +437,6 @@ sub add_tag_approval { # or disapproval
} else {
$query = "INSERT INTO tags_approval (term,date_approved) VALUES (?,NOW())";
}
$debug and print STDERR "add_tag_approval query: $query\nadd_tag_approval args: (" . join(", ", @exe_args) . ")\n";
$sth = C4::Context->dbh->prepare($query);
$sth->execute(@exe_args);
return $sth->rows;
@ -472,7 +448,6 @@ sub mod_tag_approval {
my $term = shift or return;
my $approval = (scalar @_ ? shift : 1); # default is to approve
my $query = "UPDATE tags_approval SET approved_by=?, approved=?, date_approved=NOW() WHERE term = ?";
$debug and print STDERR "mod_tag_approval query: $query\nmod_tag_approval args: ($operator,$approval,$term)\n";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute($operator,$approval,$term);
}
@ -485,7 +460,6 @@ sub add_tag_index {
$sth->execute($term,$biblionumber);
($sth->rows) and return increment_weight($term,$biblionumber);
$query = "INSERT INTO tags_index (term,biblionumber) VALUES (?,?)";
$debug and print STDERR "add_tag_index query: $query\nadd_tag_index args: ($term,$biblionumber)\n";
$sth = C4::Context->dbh->prepare($query);
$sth->execute($term,$biblionumber);
return $sth->rows;
@ -548,10 +522,7 @@ sub add_tag { # biblionumber,term,[borrowernumber,approvernumber]
my $query = "INSERT INTO tags_all
(borrowernumber,biblionumber,term,date_created)
VALUES (?,?,?,NOW())";
$debug and print STDERR "add_tag query: $query\n",
"add_tag query args: ($borrowernumber,$biblionumber,$term)\n";
if (scalar @$rows) {
$debug and carp "Duplicate tag detected. Tag not added.";
return;
}
# add to tags_all regardless of approaval
@ -561,15 +532,12 @@ sub add_tag { # biblionumber,term,[borrowernumber,approvernumber]
# then
if (scalar @_) { # if arg remains, it is the borrowernumber of the approver: tag is pre-approved.
my $approver = shift;
$debug and print STDERR "term '$term' pre-approved by borrower #$approver\n";
add_tag_approval($term,$approver,1);
add_tag_index($term,$biblionumber,$approver);
} elsif (is_approved($term) >= 1) {
$debug and print STDERR "term '$term' approved by whitelist\n";
add_tag_approval($term,0,1);
add_tag_index($term,$biblionumber,1);
} else {
$debug and print STDERR "term '$term' NOT approved (yet)\n";
add_tag_approval($term);
add_tag_index($term,$biblionumber);
}

2
Koha/Patron/Files.pm
View File

@ -22,8 +22,6 @@ use Modern::Perl;
use C4::Context;
use C4::Output;
use C4::Debug;
=head1 NAME

1
acqui/acqui-home.pl
View File

@ -34,7 +34,6 @@ use C4::Output;
use C4::Acquisition;
use C4::Budgets;
use C4::Members;
use C4::Debug;
use Koha::Acquisition::Currencies;
use Koha::Patrons;
use Koha::Suggestions;

5
acqui/basket.pl
View File

@ -28,7 +28,6 @@ use CGI qw ( -utf8 );
use C4::Acquisition;
use C4::Budgets;
use C4::Contract;
use C4::Debug;
use C4::Biblio;
use C4::Items;
use C4::Suggestions;
@ -313,10 +312,6 @@ if ( $op eq 'list' ) {
# if new basket, pre-fill infos
$basket->{creationdate} = "" unless ( $basket->{creationdate} );
$basket->{authorisedby} = $loggedinuser unless ( $basket->{authorisedby} );
$debug
and warn sprintf
"loggedinuser: $loggedinuser; creationdate: %s; authorisedby: %s",
$basket->{creationdate}, $basket->{authorisedby};
my @basketusers_ids = GetBasketUsers($basketno);
my @basketusers;

1
acqui/histsearch.pl
View File

@ -54,7 +54,6 @@ use CGI qw ( -utf8 );
use C4::Auth; # get_template_and_user
use C4::Output;
use C4::Acquisition;
use C4::Debug;
use C4::Koha;
use Koha::AdditionalFields;
use Koha::DateUtils;

1
admin/aqbudgetperiods.pl
View File

@ -56,7 +56,6 @@ use C4::Auth;
use C4::Output;
use C4::Acquisition;
use C4::Budgets;
use C4::Debug;
use Koha::Acquisition::Currencies;
my $dbh = C4::Context->dbh;

1
admin/aqbudgets.pl
View File

@ -32,7 +32,6 @@ use C4::Budgets;
use C4::Context;
use C4::Output;
use C4::Koha;
use C4::Debug;
use Koha::Acquisition::Currencies;
use Koha::Patrons;

1
admin/aqplan.pl
View File

@ -33,7 +33,6 @@ use C4::Context;
use C4::Output;
use C4::Koha;
use C4::Auth;
use C4::Debug;
use Koha::Acquisition::Currencies;
our $input = CGI->new;

1
admin/clone-rules.pl
View File

@ -31,7 +31,6 @@ use C4::Context;
use C4::Output;
use C4::Auth;
use C4::Koha;
use C4::Debug;
use Koha::CirculationRules;
my $input = CGI->new;

3
admin/smart-rules.pl
View File

@ -23,7 +23,6 @@ use C4::Context;
use C4::Output;
use C4::Auth;
use C4::Koha;
use C4::Debug;
use Koha::DateUtils;
use Koha::Database;
use Koha::Logger;
@ -72,7 +71,6 @@ $cache->clear_from_cache( Koha::CirculationRules::GUESSED_ITEMTYPES_KEY );
if ($op eq 'delete') {
my $itemtype = $input->param('itemtype');
my $categorycode = $input->param('categorycode');
$debug and warn "deleting $1 $2 $branch";
Koha::CirculationRules->set_rules(
{
@ -289,7 +287,6 @@ elsif ($op eq 'add') {
my $cap_fine_to_replacement_price = ($input->param('cap_fine_to_replacement_price') || '') eq 'on';
my $note = $input->param('note');
my $decreaseloanholds = $input->param('decreaseloanholds') || undef;
$debug and warn "Adding $br, $bor, $itemtype, $fine, $maxissueqty, $maxonsiteissueqty, $cap_fine_to_replacement_price";
my $rules = {
maxissueqty => $maxissueqty,

1
admin/transport-cost-matrix.pl
View File

@ -23,7 +23,6 @@ use C4::Context;
use C4::Output;
use C4::Auth;
use C4::Koha;
use C4::Debug;
use C4::HoldsQueue qw(TransportCostMatrix UpdateTransportCostMatrix);
use Koha::Libraries;

1
circ/bookcount.pl
View File

@ -22,7 +22,6 @@
use Modern::Perl;
use CGI qw ( -utf8 );
use C4::Debug;
use C4::Context;
use C4::Circulation;
use C4::Output;

2
circ/branchoverdues.pl
View File

@ -24,7 +24,6 @@ use C4::Auth;
use C4::Overdues;
use C4::Biblio;
use C4::Koha;
use C4::Debug;
use Koha::DateUtils;
use Koha::BiblioFrameworks;
use Data::Dumper;
@ -62,7 +61,6 @@ my $location = $input->param('location');
my @overduesloop;
my @getoverdues = GetOverduesForBranch( $default, $location );
$debug and warn "HERE : $default / $location" . Dumper(@getoverdues);
# search for location authorised value
my ($tag,$subfield) = GetMarcFromKohaField( 'items.location' );
my $tagslib = &GetMarcStructure(1,'');

8
circ/overdue.pl
View File

@ -24,7 +24,6 @@ use C4::Context;
use C4::Output;
use CGI qw(-oldstyle_urls -utf8);
use C4::Auth;
use C4::Debug;
use Text::CSV_XS;
use Koha::DateUtils;
use DateTime;
@ -112,7 +111,6 @@ for my $attrcode (grep { /^patron_attr_filter_/ } $input->multi_param) {
if (my @attrvalues = grep { length($_) > 0 } $input->multi_param($attrcode)) {
$attrcode =~ s/^patron_attr_filter_//;
$cgi_attrcode_to_attrvalues{$attrcode} = \@attrvalues;
print STDERR ">>>param($attrcode)[@{[scalar @attrvalues]}] = '@attrvalues'\n" if $debug;
}
}
my $have_pattr_filter_data = keys(%cgi_attrcode_to_attrvalues) > 0;
@ -180,12 +178,6 @@ if (@patron_attr_filter_loop) {
last;
}
}
if ($debug) {
my $showkeep = $keep ? 'keep' : 'do NOT keep';
print STDERR ">>> patron $bn: $showkeep attributes: ";
for (sort keys %$pattrs) { my @a=map { "$_->[0]/$_->[1] " } @{$pattrs->{$_}}; print STDERR "attrcode $_ = [@a] " }
print STDERR "\n";
}
delete $borrowernumber_to_attributes{$bn} if !$keep;
}
}

1
circ/pendingreserves.pl
View File

@ -28,7 +28,6 @@ use C4::Context;
use C4::Output;
use CGI qw ( -utf8 );
use C4::Auth;
use C4::Debug;
use C4::Items qw( ModItemTransfer );
use C4::Reserves qw( ModReserveCancelAll );
use Koha::Biblios;

2
circ/reserveratios.pl
View File

@ -27,7 +27,6 @@ use POSIX qw( ceil );
use C4::Context;
use C4::Output;
use C4::Auth;
use C4::Debug;
use C4::Acquisition qw/GetOrdersByBiblionumber/;
use Koha::DateUtils;
use Koha::Acquisition::Baskets;
@ -84,7 +83,6 @@ if ($ratio <= 0) {
my $dbh = C4::Context->dbh;
my $sqldatewhere = "";
$debug and warn output_pref({ dt => $startdate, dateformat => 'iso', dateonly => 1 }) . "\n" . output_pref({ dt => $enddate, dateformat => 'iso', dateonly => 1 });
my @query_params = ();
$sqldatewhere .= " AND reservedate >= ?";

7
installer/data/mysql/backfill_statistics.pl
View File

@ -12,11 +12,9 @@ use Getopt::Long;
# Koha modules
use C4::Context;
use C4::Items;
use C4::Debug;
use Data::Dumper;
use vars qw($debug $dbh);
$dbh = C4::Context->dbh;
my $dbh = C4::Context->dbh;
sub get_counts() {
my $query = q(
@ -69,12 +67,10 @@ print "This operation may take a while.\n";
print "\nAttempting to populate missing data.\n";
my (@itemnumbers) = (scalar @ARGV) ? @ARGV : &itemnumber_array;
$debug and print "itemnumbers: ", Dumper(\@itemnumbers);
print "Number of distinct itemnumbers paired with NULL_ITEMTYPE: ", scalar(@itemnumbers), "\n";
my $query = "UPDATE statistics SET itemtype = ? WHERE itemnumber = ?";
my $update = $dbh->prepare($query);
# $debug and print "Update Query: $query\n";
foreach (@itemnumbers) {
my $item = Koha::Items->find($_);
unless ($item) {
@ -90,7 +86,6 @@ my $old_issues = $dbh->prepare("SELECT * FROM old_issues WHERE timestamp = ? AND
my $issues = $dbh->prepare("SELECT * FROM issues WHERE timestamp = ? AND itemnumber = ?");
$update = $dbh->prepare("UPDATE statistics SET borrowernumber = ? WHERE datetime = ? AND itemnumber = ?");
my $nullborrs = null_borrower_lines;
$debug and print Dumper($nullborrs);
foreach (@$nullborrs) {
$old_issues->execute($_->{datetime},$_->{itemnumber});
my $issue;

5
koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-review.tt
View File

@ -10,9 +10,6 @@
<div class="col order-first order-md-first order-lg-2">
<div id="userreview" class="maincontent">
<h1>Reviews</h1>
[% IF ( cgi_debug ) %]
<div class="debug">CGI debug is on.</div>
[% END %]
[% IF ( ERRORS ) %]
<div class="alert alert-warning">
[% FOREACH ERROR IN ERRORS %]
@ -42,7 +39,7 @@
<h2>Comments on <em>[% INCLUDE 'biblio-title.inc' %]</em></h2>
[% IF ( biblio.author ) %]<h3>[% biblio.author | html %]</h3>[% END %]
<form id="reviewf" action="/cgi-bin/koha/opac-review.pl[% IF ( cgi_debug ) %]?debug=1[% END %]" method="post">
<form id="reviewf" action="/cgi-bin/koha/opac-review.pl" method="post">
<legend class="sr-only">Comments</legend>
<input type="hidden" name="biblionumber" value="[% biblio.biblionumber | html %]" />
[% IF ( reviewid ) %]<input type="hidden" name="reviewid" value="[% reviewid | html %]" />[% END %]

1
labels/label-create-csv.pl
View File

@ -24,7 +24,6 @@ use CGI qw ( -utf8 );
use Text::CSV_XS;
use Data::Dumper;
use C4::Debug;
use C4::Creators;
use C4::Labels;

1
labels/label-create-pdf.pl
View File

@ -22,7 +22,6 @@ use Modern::Perl;
use CGI qw ( -utf8 );
use C4::Auth;
use C4::Debug;
use C4::Creators;
use C4::Labels;

1
labels/label-create-xml.pl
View File

@ -24,7 +24,6 @@ use CGI qw ( -utf8 );
use XML::Simple;
use Data::Dumper;
use C4::Debug;
use C4::Creators;
use C4::Labels;

13
labels/label-item-search.pl
View File

@ -18,7 +18,6 @@
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use Modern::Perl;
use vars qw($debug $cgi_debug);
use CGI qw ( -utf8 );
use List::Util qw( max min );
@ -30,21 +29,13 @@ use C4::Context;
use C4::Search qw(SimpleSearch);
use C4::Biblio qw(TransformMarcToKoha);
use C4::Creators::Lib qw(html_table);
use C4::Debug;
use Koha::Logger;
use Koha::DateUtils;
use Koha::Items;
use Koha::ItemTypes;
use Koha::SearchEngine::Search;
BEGIN {
$debug = $debug || $cgi_debug;
if ($debug) {
require Data::Dumper;
import Data::Dumper qw(Dumper);
}
}
my $query = CGI->new;
my $type = $query->param('type');
@ -102,7 +93,7 @@ if ( $op eq "do_search" ) {
$show_results = @{$marcresults};
}
else {
$debug and warn "ERROR label-item-search: no results from simple_search_compat";
Koha::Logger->get->warn("ERROR label-item-search: no results from simple_search_compat");
# leave $show_results undef
}

1
members/files.pl
View File

@ -24,7 +24,6 @@ use CGI qw ( -utf8 );
use C4::Auth;
use C4::Output;
use C4::Members;
use C4::Debug;
use Koha::DateUtils;
use Koha::Patrons;

12
misc/admin/koha-preferences
View File

@ -21,11 +21,13 @@
use Modern::Perl;
use Koha::Script;
use C4::Context;
use C4::Debug;
use C4::Log;
use Getopt::Long;
use Pod::Usage;
use YAML::XS;
use Koha::Logger;
our %NOT_SET_PREFS = map { $_, 1 } qw( Version );
=head1 NAME
@ -48,16 +50,10 @@ sub print_usage {
}
}
sub _debug {
my ( $message ) = @_;
print STDERR $message . "\n" if ( $C4::Debug::debug );
}
sub _set_preference {
my ( $preference, $value ) = @_;
_debug( "Setting $preference to $value" );
Koha::Logger->get->debug($message);
if ( $preference->{type} eq 'YesNo'
&& $value ne '0'

1
misc/cronjobs/gather_print_notices.pl
View File

@ -12,7 +12,6 @@ BEGIN {
use CGI qw( utf8 ); # NOT a CGI script, this is just to keep C4::Templates::gettemplate happy
use Koha::Script -cron;
use C4::Context;
use C4::Debug;
use C4::Letters;
use C4::Templates;
use File::Spec;

1
misc/cronjobs/serialsUpdate.pl
View File

@ -30,7 +30,6 @@ BEGIN {
use Koha::Script -cron;
use C4::Context;
use C4::Debug;
use C4::Serials;
use C4::Log;
use Koha::DateUtils;

1
misc/cronjobs/staticfines.pl
View File

@ -43,7 +43,6 @@ use C4::Circulation;
use C4::Overdues;
use C4::Calendar qw(); # don't need any exports from Calendar
use C4::Biblio;
use C4::Debug; # supplying $debug and $cgi_debug
use C4::Log;
use Getopt::Long;
use List::MoreUtils qw/none/;

2
misc/load_testing/benchmark_staff.pl
View File

@ -17,7 +17,6 @@ use LWP::UserAgent;
use Data::Dumper;
use HTTP::Cookies;
use C4::Context;
use C4::Debug;
use URI::Escape;
use Koha::Patrons;
@ -82,7 +81,6 @@ if( $resp->is_success and $resp->content =~ m|<status>ok</status>| ) {
$cookie = $cookie_jar->as_string;
unless ($short_print) {
print "Authentication successful\n";
print "Auth:\n $resp->content" if $debug;
}
} elsif ( $resp->is_success ) {
die "Authentication failure: bad login/password";

15
misc/migration_tools/bulkmarcimport.pl
View File

@ -22,7 +22,6 @@ use Koha::Script;
use C4::Context;
use C4::Biblio;
use C4::Koha;
use C4::Debug;
use C4::Charset;
use C4::Items;
use C4::MarcModificationTemplates;
@ -34,6 +33,7 @@ use Getopt::Long;
use IO::File;
use Pod::Usage;
use Koha::Logger;
use Koha::Biblios;
use Koha::SearchEngine;
use Koha::SearchEngine::Search;
@ -259,6 +259,7 @@ if ($logfile){
print $loghandle "id;operation;status\n";
}
my $logger = Koha::Logger->get;
my $schema = Koha::Database->schema;
$schema->txn_begin;
RECORD: while ( ) {
@ -317,7 +318,6 @@ RECORD: while ( ) {
require C4::Search;
my $query = build_query( $match, $record );
my $server = ( $authorities ? 'authorityserver' : 'biblioserver' );
$debug && warn $query;
my ( $error, $results, $totalhits ) = $searcher->simple_search_compat( $query, 0, 3, [$server] );
# changed to warn so able to continue with one broken record
if ( defined $error ) {
@ -325,7 +325,6 @@ RECORD: while ( ) {
printlog( { id => $id || $originalid || $match, op => "match", status => "ERROR" } ) if ($logfile);
next RECORD;
}
$debug && warn "$query $server : $totalhits";
if ( $results && scalar(@$results) == 1 ) {
my $marcrecord = C4::Search::new_record_from_zebra( $server, $results->[0] );
SetUTF8Flag($marcrecord);
@ -350,9 +349,9 @@ RECORD: while ( ) {
}
}
} elsif ( $results && scalar(@$results) > 1 ) {
$debug && warn "more than one match for $query";
$logger->debug("more than one match for $query");
} else {
$debug && warn "nomatch for $query";
$logger->debug("nomatch for $query");
}
}
if ($keepids && $originalid) {
@ -369,7 +368,7 @@ RECORD: while ( ) {
if ( length($stringfilter) == 3 ) {
foreach my $field ( $record->field($stringfilter) ) {
$record->delete_field($field);
$debug && warn "removed : ", $field->as_string;
$logger->debug("removed : ", $field->as_string);
}
} elsif ($stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/) {
my $removetag = $1;
@ -378,7 +377,7 @@ RECORD: while ( ) {
if ( ( $removetag > "010" ) && $removesubfield ) {
foreach my $field ( $record->field($removetag) ) {
$field->delete_subfield( code => "$removesubfield", match => $removematch );
$debug && warn "Potentially removed : ", $field->subfield($removesubfield);
$logger->debug("Potentially removed : ", $field->subfield($removesubfield));
}
}
}
@ -634,7 +633,7 @@ sub get_heading_fields{
if ($authtypes){
$headingfields = YAML::XS::LoadFile($authtypes);
$headingfields={C4::Context->preference('marcflavour')=>$headingfields};
$debug && warn Encode::decode_utf8(YAML::XS::Dump($headingfields));
$logger->debug(Encode::decode_utf8(YAML::XS::Dump($headingfields)));
}
unless ($headingfields){
$headingfields=$dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types",'auth_tag_to_report',{Slice=>{}});

1
opac/opac-discharge.pl
View File

@ -25,7 +25,6 @@ use CGI qw( -utf8 );
use C4::Context;
use C4::Output;
use C4::Log;
use C4::Debug;
use Koha::Patrons;
use Koha::Patron::Discharge;
use Koha::DateUtils;

1
opac/opac-ratings-ajax.pl
View File

@ -30,7 +30,6 @@ use CGI::Cookie; # need to check cookies before having CGI parse the POST reque
use C4::Auth qw(:DEFAULT check_cookie_auth);
use C4::Context;
use C4::Debug;
use C4::Output qw(:html :ajax pagination_bar);
use Koha::Ratings;

1
opac/opac-ratings.pl
View File

@ -30,7 +30,6 @@ use CGI qw ( -utf8 );
use C4::Auth;
use C4::Context;
use C4::Debug;
use Koha::Ratings;

1
opac/opac-reserve.pl
View File

@ -31,7 +31,6 @@ use C4::Output;
use C4::Context;
use C4::Members;
use C4::Overdues;
use C4::Debug;
use Koha::AuthorisedValues;
use Koha::Biblios;

2
opac/opac-review.pl
View File

@ -24,7 +24,6 @@ use C4::Koha;
use C4::Output;
use C4::Biblio;
use C4::Scrubber;
use C4::Debug;
use Koha::Biblios;
use Koha::DateUtils;
@ -93,7 +92,6 @@ if( !@errors && defined $review ) {
}
}
(@errors ) and $template->param( ERRORS=>\@errors);
($cgi_debug) and $template->param(cgi_debug=>1 );
$review = $clean;
$review ||= $savedreview->review if $savedreview;
$template->param(

1
opac/opac-search-history.pl
View File

@ -25,7 +25,6 @@ use C4::Context;
use C4::Output;
use C4::Log;
use C4::Items;
use C4::Debug;
use C4::Search::History;
use URI::Escape;

10
opac/opac-tags.pl
View File

@ -37,7 +37,6 @@ use CGI::Cookie; # need to check cookies before having CGI parse the POST reques
use C4::Auth qw(:DEFAULT check_cookie_auth);
use C4::Context;
use C4::Debug;
use C4::Output qw(:html :ajax );
use C4::Scrubber;
use C4::Biblio;
@ -47,6 +46,7 @@ use C4::XSLT;
use Data::Dumper;
use Koha::Logger;
use Koha::Biblios;
use Koha::CirculationRules;
@ -65,16 +65,12 @@ sub ajax_auth_cgi { # returns CGI object
my $input = CGI->new;
my $sessid = $cookies{'CGISESSID'}->value;
my ($auth_status, $auth_sessid) = check_cookie_auth($sessid, $needed_flags);
$debug and
print STDERR "($auth_status, $auth_sessid) = check_cookie_auth($sessid," . Dumper($needed_flags) . ")\n";
if ($auth_status ne "ok") {
output_with_http_headers $input, undef,
"window.alert('Your CGI session cookie ($sessid) is not current. " .
"Please refresh the page and try again.');\n", 'js';
exit 0;
}
$debug and print STDERR "AJAX request: " . Dumper($input),
"\n(\$auth_status,\$auth_sessid) = ($auth_status,$auth_sessid)\n";
return $input;
}
@ -91,7 +87,6 @@ foreach ($query->param) {
if (/^newtag(.*)/) {
my $biblionumber = $1;
unless ($biblionumber =~ /^\d+$/) {
$debug and warn "$_ references non numerical biblionumber '$biblionumber'";
push @errors, {+'badparam' => $_ };
push @globalErrorIndexes, $#errors;
next;
@ -106,7 +101,6 @@ my $add_op = (scalar(keys %newtags) + scalar(@deltags)) ? 1 : 0;
my ($template, $loggedinuser, $cookie);
if ($is_ajax) {
$loggedinuser = C4::Context->userenv->{'number'}; # must occur AFTER auth
$debug and print STDERR "op: $loggedinuser\n";
} else {
($template, $loggedinuser, $cookie) = get_template_and_user({
template_name => "opac-tags.tt",
@ -159,7 +153,7 @@ if (scalar @newtags_keys) {
} else {
push @errors, {failed_add_tag=>$clean_tag};
push @{$bibResults->{errors}}, {failed_add_tag=>$clean_tag};
$debug and warn "add_tag($biblionumber,$clean_tag,$loggedinuser...) returned bad result (" . (defined $result ? $result : 'UNDEF') .")";
Koha::Logger->get->warn("add_tag($biblionumber,$clean_tag,$loggedinuser...) returned bad result (" . (defined $result ? $result : 'UNDEF') .")");
}
}
$perBibResults->{$biblionumber} = $bibResults;

1
patroncards/create-pdf.pl
View File

@ -26,7 +26,6 @@ use POSIX qw(ceil);
use Storable qw(dclone);
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Debug;
use C4::Context;
use C4::Creators;
use C4::Patroncards;

1
patroncards/image-manage.pl
View File

@ -9,7 +9,6 @@ use POSIX qw(ceil);
use C4::Context;
use C4::Auth;
use C4::Output;
use C4::Debug;
use C4::Creators;
use C4::Patroncards;

1
plugins/plugins-home.pl
View File

@ -27,7 +27,6 @@ use LWP::Simple qw(get);
use Koha::Plugins;
use C4::Auth;
use C4::Output;
use C4::Debug;
use C4::Context;
my $plugins_enabled = C4::Context->config("enable_plugins");

1
plugins/plugins-uninstall.pl
View File

@ -26,7 +26,6 @@ use C4::Context;
use C4::Auth;
use C4::Output;
use C4::Members;
use C4::Debug;
use Koha::Plugins::Handler;
die("Koha plugins are disabled!") unless C4::Context->config("enable_plugins");

5
plugins/plugins-upload.pl
View File

@ -28,7 +28,7 @@ use C4::Context;
use C4::Auth;
use C4::Output;
use C4::Members;
use C4::Debug;
use Koha::Logger;
use Koha::Plugins;
my $plugins_enabled = C4::Context->config("enable_plugins");
@ -58,14 +58,11 @@ if ($plugins_enabled) {
$plugins_dir = ref($plugins_dir) eq 'ARRAY' ? $plugins_dir->[0] : $plugins_dir;
my $dirname = File::Temp::tempdir( CLEANUP => 1 );
$debug and warn "dirname = $dirname";
my $filesuffix;
$filesuffix = $1 if $uploadfilename =~ m/(\..+)$/i;
( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
$debug and warn "tempfile = $tempfile";
$errors{'NOTKPZ'} = 1 if ( $uploadfilename !~ /\.kpz$/i );
$errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
$errors{'NOWRITEPLUGINS'} = 1 unless ( -w $plugins_dir );

1
plugins/run.pl
View File

@ -24,7 +24,6 @@ use CGI qw ( -utf8 );
use Koha::Plugins::Handler;
use C4::Auth;
use C4::Output;
use C4::Debug;
use C4::Context;
my $plugins_enabled = C4::Context->config("enable_plugins");

10
reports/catalogue_out.pl
View File

@ -22,7 +22,6 @@ use CGI qw ( -utf8 );
use C4::Auth;
use C4::Context;
use C4::Debug;
use C4::Output;
# use Date::Manip; # TODO: add not borrowed since date X criteria
use Data::Dumper;
@ -102,7 +101,6 @@ sub calculate {
}
$strsth2 .= " GROUP BY $column ORDER BY $column "; # needed for count
push @loopfilter, { crit => 'SQL', sql => 1, filter => $strsth2 };
$debug and warn "catalogue_out SQL: " . $strsth2;
my $sth2 = $dbh->prepare($strsth2);
$sth2->execute;
@ -151,9 +149,7 @@ sub calculate {
}
$query .= " ORDER BY items.itemcallnumber DESC, barcode";
$query .= " LIMIT 0,$limit" if ($limit);
$debug and warn "SQL : $query";
# warn "SQL : $query";
push @loopfilter, { crit => 'SQL', sql => 1, filter => $query };
my $dbcalc = $dbh->prepare($query);
@ -185,12 +181,6 @@ sub calculate {
my (@temptable);
my $i = 0;
foreach my $cell ( @{ $tables{$tablename} } ) {
if ( 0 == $i++ and $debug ) {
my $dump = Dumper($cell);
$dump =~ s/\n/ /gs;
$dump =~ s/\s+/ /gs;
print STDERR "first cell for $tablename: $dump";
}
push @temptable, $cell;
}
my $count = scalar(@temptable);

1
reports/guided_reports.pl
View File

@ -27,7 +27,6 @@ use C4::Reports::Guided;
use Koha::Reports;
use C4::Auth qw/:DEFAULT get_session/;
use C4::Output;
use C4::Debug;
use C4::Context;
use Koha::Caches;
use C4::Log;

9
reports/issues_stats.pl
View File

@ -23,7 +23,6 @@ use CGI qw ( -utf8 );
use Date::Manip;
use C4::Auth;
use C4::Debug;
use C4::Context;
use C4::Koha;
use C4::Output;
@ -46,7 +45,6 @@ Plugin that shows circulation stats
=cut
# my $debug = 1; # override for now.
my $input = CGI->new;
my $fullreportname = "reports/issues_stats.tt";
my $do_it = $input->param('do_it');
@ -245,7 +243,6 @@ sub calculate {
push @loopfilter, { crit => "Select Month", filter => $monthsel } if ($monthsel);
my @linefilter;
$debug and warn "filtres " . join "|", @$filters;
my ( $colsource, $linesource ) = ('', '');
$linefilter[1] = @$filters[1] if ( $line =~ /datetime/ );
$linefilter[0] =
@ -337,7 +334,6 @@ sub calculate {
$strsth .= " AND $line LIKE ? ";
}
$strsth .= " group by $linefield order by $lineorder ";
$debug and warn $strsth;
push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strsth };
my $sth = $dbh->prepare($strsth);
if ( (@linefilter) and ($linefilter[0]) and ($linefilter[1]) ) {
@ -427,7 +423,6 @@ sub calculate {
}
$strsth2 .= " group by $colfield order by $colorder ";
$debug and warn $strsth2;
push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strsth2 };
my $sth2 = $dbh->prepare($strsth2);
if ( (@colfilter) and ($colfilter[0]) and ($colfilter[1]) ) {
@ -470,7 +465,6 @@ sub calculate {
my %table;
foreach my $row (@loopline) {
foreach my $col (@loopcol) {
$debug and warn " init table : $row->{rowtitle} ( $row->{rowtitle_display} ) / $col->{coltitle} ( $col->{coltitle_display} ) ";
table_set(\%table, $row->{rowtitle}, $col->{coltitle}, 0);
}
table_set(\%table, $row->{rowtitle}, 'totalrow', 0);
@ -568,13 +562,11 @@ sub calculate {
$strcalc .= " $colorder ";
}
($debug) and warn $strcalc;
my $dbcalc = $dbh->prepare($strcalc);
push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strcalc };
$dbcalc->execute;
my ( $emptycol, $emptyrow );
while ( my ( $row, $col, $value ) = $dbcalc->fetchrow ) {
($debug) and warn "filling table $row / $col / $value ";
unless ( defined $col ) {
$emptycol = 1;
}
@ -608,7 +600,6 @@ sub calculate {
my $total = 0;
foreach my $row (@looprow) {
$total += table_get(\%table, $row->{rowtitle}, $col->{coltitle}) || 0;
$debug and warn "value added " . table_get(\%table, $row->{rowtitle}, $col->{coltitle}) . "for line " . $row->{rowtitle};
}
push @loopfooter, { 'totalcol' => $total };
}

4
reports/reserves_stats.pl
View File

@ -22,7 +22,6 @@ use Modern::Perl;
use CGI qw ( -utf8 );
use C4::Auth;
use C4::Debug;
use C4::Context;
use C4::Koha;
use C4::Output;
@ -45,7 +44,6 @@ Plugin that shows reserve stats
=cut
# my $debug = 1; # override for now.
my $input = CGI->new;
my $fullreportname = "reports/reserves_stats.tt";
my $do_it = $input->param('do_it');
@ -248,7 +246,6 @@ sub calculate {
$strcalc .= " WHERE ".join(" AND ",@sqlwhere) if (@sqlwhere);
$strcalc .= " AND (".join(" OR ",@sqlor).")" if (@sqlor);
$strcalc .= " GROUP BY line, col )";
($debug) and print STDERR $strcalc;
my $dbcalc = $dbh->prepare($strcalc);
push @loopfilter, {crit=>'SQL =', sql=>1, filter=>$strcalc};
@sqlparams=(@sqlparams,@sqlorparams);
@ -284,7 +281,6 @@ sub calculate {
my $total = 0;
foreach my $row (@loopline) {
$total += $data->{$row}{$col}{calculation} if $data->{$row}{$col}{calculation};
$debug and warn "value added ".$$data{$row}{$col}{calculation}. "for line ".$row;
}
push @loopfooter, {'totalcol' => $total};
push @loopcol, {'coltitle' => $col,

2
serials/subscription-bib-search.pl
View File

@ -55,7 +55,6 @@ use C4::Context;
use C4::Output;
use C4::Search;
use C4::Biblio;
use C4::Debug;
use Koha::ItemTypes;
use Koha::SearchEngine;
@ -93,7 +92,6 @@ if ( $op eq "do_search" && $query ) {
my $op = 'and';
$query .= " $op $itype_or_itemtype:$itemtypelimit" if $itemtypelimit;
$query .= " $op ccode:$ccodelimit" if $ccodelimit;
$debug && warn $query;
$resultsperpage = $input->param('resultsperpage');
$resultsperpage = 20 if ( !defined $resultsperpage );

1
suggestion/suggestion.pl
View File

@ -27,7 +27,6 @@ use C4::Koha;
use C4::Budgets;
use C4::Search;
use C4::Members;
use C4::Debug;
use Koha::DateUtils qw( dt_from_string );
use Koha::AuthorisedValues;
use Koha::Acquisition::Currencies;

19
t/Debug.t
View File

@ -1,19 +0,0 @@
#!/usr/bin/perl
use Modern::Perl;
use Test::More tests => 7;
use vars qw($debug $cgi_debug);
BEGIN {
$ENV{'KOHA_CGI_DEBUG'}='2';
$ENV{'KOHA_DEBUG'}='5';
is($debug, undef," \$debug is undefined as expected.");
is($cgi_debug,undef,"\$cgi_debug is undefined as expected.");
use_ok('C4::Debug');
}
ok(defined $debug, " \$debug defined and imported.");
ok(defined $cgi_debug, "\$cgi_debug defined and imported.");
is($cgi_debug,2,"cgi_debug gets the ENV{'KOHA_CGI_DEBUG'}");
is($debug,5,"debug gets the ENV{'KOHA_DEBUG'}");

1
t/db_dependent/Search.t
View File

@ -19,7 +19,6 @@ use Modern::Perl;
use utf8;
use C4::Debug;
use C4::AuthoritiesMarc qw( SearchAuthorities );
use C4::XSLT;
require C4::Context;

1
t/db_dependent/Serials.t
View File

@ -8,7 +8,6 @@ use Modern::Perl;
use C4::Serials;
use C4::Serials::Frequency;
use C4::Serials::Numberpattern;
use C4::Debug;
use C4::Biblio;
use C4::Budgets;
use C4::Items;

8
tags/review.pl
View File

@ -30,7 +30,6 @@ use C4::Context;
use Koha::DateUtils;
# use C4::Koha;
use C4::Output qw(:html :ajax pagination_bar);
use C4::Debug;
use C4::Tags qw(get_tags get_approval_rows approval_counts whitelist blacklist is_approved);
my $script_name = "/cgi-bin/koha/tags/review.pl";
@ -42,23 +41,18 @@ sub ajax_auth_cgi { # returns CGI object
my $input = CGI->new;
my $sessid = $cookies{'CGISESSID'}->value;
my ($auth_status, $auth_sessid) = check_cookie_auth($sessid, $needed_flags);
$debug and
print STDERR "($auth_status, $auth_sessid) = check_cookie_auth($sessid," . Dumper($needed_flags) . ")\n";
if ($auth_status ne "ok") {
output_with_http_headers $input, undef,
"window.alert('Your CGI session cookie ($sessid) is not current. " .
"Please refresh the page and try again.');\n", 'js';
exit 0;
}
$debug and print STDERR "AJAX request: " . Dumper($input),
"\n(\$auth_status,\$auth_sessid) = ($auth_status,$auth_sessid)\n";
return $input;
}
if (is_ajax()) {
my $input = &ajax_auth_cgi($needed_flags);
my $operator = C4::Context->userenv->{'number'}; # must occur AFTER auth
$debug and print STDERR "op: " . Dumper($operator) . "\n";
my ($tag, $js_reply);
if ($tag = $input->param('test')) {
my $check = is_approved($tag);
@ -200,13 +194,11 @@ if ($filter = $input->param('approved_by')) { # borrowernumber from link
push @errors, {approved_by=>$filter};
}
}
$debug and print STDERR "filters: " . Dumper(\%filters);
my $tagloop = get_approval_rows(\%filters);
my $qstring = $input->query_string;
$qstring =~ s/([&;])*\blimit=\d+//; # remove pagination var
$qstring =~ s/^;+//; # remove leading delims
$qstring = "limit=$pagesize" . ($qstring ? '&amp;' . $qstring : '');
$debug and print STDERR "number of approval_rows: " . scalar(@$tagloop) . "rows\n";
(scalar @errors) and $template->param(message_loop=>\@errors);
$template->param(
offset => $offset, # req'd for EXPR

1
tools/batchMod.pl
View File

@ -31,7 +31,6 @@ use C4::Context;
use C4::Koha;
use C4::BackgroundJob;
use C4::ClassSource;
use C4::Debug;
use C4::Members;
use MARC::File::XML;
use List::MoreUtils qw/uniq/;

49
tools/picture-upload.pl
View File

@ -29,8 +29,8 @@ use C4::Context;
use C4::Auth;
use C4::Output;
use C4::Members;
use C4::Debug;
use Koha::Logger;
use Koha::Patrons;
use Koha::Patron::Images;
use Koha::Token;
@ -61,7 +61,8 @@ my $op = $input->param('op') || '';
# Other parts of this code could be optimized as well, I think. Perhaps the file upload could be done with YUI's upload
# coded. -fbcit
$debug and warn "Params are: filetype=$filetype, cardnumber=$cardnumber, borrowernumber=$borrowernumber, uploadfile=$uploadfilename";
our $logger = Koha::Logger->get;
$logger->debug("Params are: filetype=$filetype, cardnumber=$cardnumber, borrowernumber=$borrowernumber, uploadfile=$uploadfilename");
=head1 NAME
@ -78,8 +79,6 @@ Files greater than 100K will be refused. Images should be 140x200 pixels. If the
=cut
$debug and warn "Operation requested: $op";
my ( $total, $handled, $tempfile, $tfh );
our @counts = ();
our %errors = ();
@ -94,14 +93,12 @@ if ( ( $op eq 'Upload' ) && $uploadfile ) {
});
my $dirname = File::Temp::tempdir( CLEANUP => 1 );
$debug and warn "dirname = $dirname";
my $filesuffix;
if ( $uploadfilename =~ m/(\..+)$/i ) {
$filesuffix = $1;
}
( $tfh, $tempfile ) =
File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
$debug and warn "tempfile = $tempfile";
my ( @directories, $results );
$errors{'NOTZIP'} = 1
@ -134,7 +131,6 @@ if ( ( $op eq 'Upload' ) && $uploadfile ) {
while ( my $entry = readdir RECDIR ) {
push @directories, "$recursive_dir/$entry"
if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
$debug and warn "$recursive_dir/$entry";
}
closedir RECDIR;
}
@ -158,8 +154,8 @@ if ( ( $op eq 'Upload' ) && $uploadfile ) {
else {
my $filecount;
map { $filecount += $_->{count} } @counts;
$debug and warn "Total directories processed: $total";
$debug and warn "Total files processed: $filecount";
$logger->debug("Total directories processed: $total");
$logger->debug("Total files processed: $filecount");
$template->param(
TOTAL => $total,
HANDLED => $handled,
@ -205,12 +201,12 @@ else {
sub handle_dir {
my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
my ( %counts, %direrrors );
$debug and warn "Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix";
$logger->debug("Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix");
if ( $suffix =~ m/zip/i ) {
# If we were sent a zip file, process any included data/idlink.txt files
my ( $file, $filename );
undef $cardnumber;
$debug and warn "Passed a zip file.";
$logger->debug("Passed a zip file.");
opendir DIR, $dir;
while ( my $filename = readdir DIR ) {
$file = "$dir/$filename"
@ -227,11 +223,11 @@ sub handle_dir {
}
while ( my $line = <$fh> ) {
$debug and warn "Reading contents of $file";
$logger->debug("Reading contents of $file");
chomp $line;
$debug and warn "Examining line: $line";
$logger->debug("Examining line: $line");
my $delim = ( $line =~ /\t/ ) ? "\t" : ( $line =~ /,/ ) ? "," : "";
$debug and warn "Delimeter is \'$delim\'";
$logger->debug("Delimeter is \'$delim\'");
unless ( $delim eq "," || $delim eq "\t" ) {
warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
$direrrors{'DELERR'} = 1;
@ -242,7 +238,7 @@ sub handle_dir {
( $cardnumber, $filename ) = split $delim, $line;
$cardnumber =~ s/[\"\r\n]//g; # remove offensive characters
$filename =~ s/[\"\r\n\s]//g;
$debug and warn "Cardnumber: $cardnumber Filename: $filename";
$logger->debug("Cardnumber: $cardnumber Filename: $filename");
$source = "$dir/$filename";
%counts = handle_file( $cardnumber, $source, $template, %counts );
}
@ -258,7 +254,7 @@ sub handle_dir {
sub handle_file {
my ( $cardnumber, $source, $template, %count ) = @_;
$debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source";
$logger->debug("Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source");
$count{filenames} = () if !$count{filenames};
$count{source} = $source if !$count{source};
$count{count} = 0 unless exists $count{count};
@ -272,7 +268,7 @@ sub handle_file {
}
if ( $cardnumber && $source ) {
# Now process any imagefiles
$debug and warn "Source: $source";
$logger->debug("Source: $source");
my $size = ( stat($source) )[7];
if ( $size > 550000 ) {
# This check is necessary even with image resizing to avoid possible security/performance issues...
@ -299,10 +295,10 @@ sub handle_file {
# we will convert all to PNG which is lossless...
# Check the pixel size of the image we are about to import...
my ( $width, $height ) = $srcimage->getBounds();
$debug and warn "$filename is $width pix X $height pix.";
$logger->debug("$filename is $width pix X $height pix.");
if ( $width > 200 || $height > 300 ) {
# MAX pixel dims are 200 X 300...
$debug and warn "$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing...";
$logger->debug("$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing...");
# Percent we will reduce the image dimensions by...
my $percent_reduce;
if ( $width > 200 ) {
@ -317,31 +313,28 @@ sub handle_file {
sprintf( "%.0f", ( $width * $percent_reduce ) );
my $height_reduce =
sprintf( "%.0f", ( $height * $percent_reduce ) );
$debug
and warn "Reducing $filename by "
$logger->debug("Reducing $filename by "
. ( $percent_reduce * 100 )
. "\% or to $width_reduce pix X $height_reduce pix";
. "\% or to $width_reduce pix X $height_reduce pix");
#'1' creates true color image...
$image = GD::Image->new( $width_reduce, $height_reduce, 1 );
$image->copyResampled( $srcimage, 0, 0, 0, 0, $width_reduce,
$height_reduce, $width, $height );
$imgfile = $image->png();
$debug
and warn "$filename is "
$logger->debug("$filename is "
. length($imgfile)
. " bytes after resizing.";
. " bytes after resizing.");
undef $image;
undef $srcimage; # This object can get big...
}
else {
$image = $srcimage;
$imgfile = $image->png();
$debug
and warn "$filename is " . length($imgfile) . " bytes.";
$logger->debug("$filename is " . length($imgfile) . " bytes.");
undef $image;
undef $srcimage; # This object can get big...
}
$debug and warn "Image is of mimetype $mimetype";
$logger->debug("Image is of mimetype $mimetype");
if ($mimetype) {
my $patron = Koha::Patrons->find({ cardnumber => $cardnumber });
if ( $patron ) {

4
tools/viewlog.pl
View File

@ -28,7 +28,6 @@ use C4::Koha;
use C4::Output;
use C4::Items;
use C4::Serials;
use C4::Debug;
use C4::Search; # enabled_staff_search_views
use Koha::ActionLogs;
@ -37,7 +36,6 @@ use Koha::DateUtils;
use Koha::Items;
use Koha::Patrons;
use vars qw($debug $cgi_debug);
=head1 viewlog.pl
@ -47,7 +45,6 @@ plugin that shows stats
my $input = CGI->new;
$debug or $debug = $cgi_debug;
my $do_it = $input->param('do_it');
my @modules = $input->multi_param("modules");
my $user = $input->param("user") // '';
@ -87,7 +84,6 @@ if ( $src eq 'circ' ) {
}
$template->param(
debug => $debug,
C4::Search::enabled_staff_search_views,
subscriptionsnumber => ( $object ? CountSubscriptionFromBiblionumber($object) : 0 ),
object => $object,