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 );
use strict;
use warnings;
-use C4::Debug;
use C4::Context;
use Koha::AuthUtils qw(get_script_name);
use Authen::CAS::Client;
use Modern::Perl;
use Carp;
-use C4::Debug;
use C4::Context;
use C4::Members::Messaging;
use C4::Auth qw(checkpw_internal);
use Modern::Perl;
-use C4::Debug;
use C4::Context;
use Koha::AuthUtils qw(get_script_name);
use Koha::Database;
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 {
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};
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 {
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.";
# 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 {
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) {
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);
$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));
$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);
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);
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;
}
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 {
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};
}
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 {
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);
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 (@_) {
}
my ($row) = $sth->fetchrow_hashref;
my $max = $row->{barcode};
- warn "barcode max (hbyymmincr format): $max" if $debug;
return ($max || 0);
}
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 new_object {
- $debug and warn "hbyymmincr: new_object called";
my $class_or_object = shift;
my $type = ref($class_or_object) || $class_or_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;
}
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;
use Koha::Libraries;
use Koha::Util::MARC;
-use vars qw($debug $cgi_debug);
-
-
=head1 NAME
C4::Biblio - cataloging management functions
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
use Koha::Database;
use Koha::Patrons;
use Koha::Acquisition::Invoice::Adjustments;
-use C4::Debug;
use C4::Acquisition;
use vars qw(@ISA @EXPORT);
}
}
$query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
- $debug && warn $query,join(",",@bind_params);
my $sth = $dbh->prepare($query);
$sth->execute(@bind_params);
# 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 {
$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";
}
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);
(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;
use Modern::Perl;
-use C4::Debug;
-
=head1 NAME
C4::ClassSplitRoutine::Dewey - Dewey call number split method
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;
}
use Modern::Perl;
-use C4::Debug;
-
=head1 NAME
C4::ClassSplitRoutine::Generic - generic call number sorting key routine
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;
}
use Modern::Perl;
use Library::CallNumber::LC;
-use C4::Debug;
+use Koha::Logger;
=head1 NAME
# 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;
}
use Modern::Perl;
-use C4::Debug;
-
=head1 NAME
C4::ClassSplitRoutine::RegEx - regex call number sorting key routine
use YAML::XS;
use ZOOM;
-use C4::Debug;
use Koha::Caches;
use Koha::Config::SysPref;
use Koha::Config::SysPrefs;
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
-use C4::Debug;
-
sub _check_params {
my $given_params = {};
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)
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
-use C4::Debug;
BEGIN {
use base qw(Exporter);
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);
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
-use C4::Debug;
use C4::Creators::Lib qw(get_unit_values);
use autouse 'Data::Dumper' => qw(Dumper);
use C4::Context;
-use C4::Debug;
use C4::Creators::Profile;
use C4::Creators::Lib qw(get_unit_values);
+++ /dev/null
-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
-
use HTTP::Request::Common;
use C4::Context;
-use C4::Debug;
use Modern::Perl;
($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);
use CGI qw ( -utf8 );
use C4::Context;
use C4::Members::Messaging;
-use C4::Debug;
use constant MAX_DAYS_IN_ADVANCE => 30;
use List::MoreUtils qw(indexes);
use C4::Context;
-use C4::Debug;
-
+use Koha::Logger;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
}
};
if ($@) {
- $debug and warn "Error ExportFramework $@\n";
+ Koha::Logger->get->warn("Error ExportFramework $@");
return 0;
}
}
$$strCSV .= chr(10);
};
if ($@) {
- $debug and warn "Error _export_table_csv $@\n";
+ Koha::Logger->get->warn("Error _export_table_csv $@");
return 0;
}
return 1;
}
};
if ($@) {
- $debug and warn "Error _export_table_ods $@\n";
+ Koha::Logger->get->warn("Error _export_table_ods $@");
return 0;
}
return 1;
}
};
if ($@) {
- $debug and warn "Error _export_table_excel $@\n";
+ Koha::Logger->get->warn("Error _export_table_excel $@");
return 0;
}
return 1;
}
};
if ($@) {
- $debug and warn "Error createODS $@\n";
+ Koha::Logger->get->warn("Error createODS $@");
} else {
# create ods file from tempdir directory
eval {
}
}
} 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);
}
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 {
$sth->execute((@$dataFields, @$dataFields));
};
if ($@) {
- warn $@;
- $debug and warn "Error _processRow_DB $@\n";
+ Koha::Logger->get->warn("Error _processRow_DB $@");
} else {
$ok = 1;
}
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
}
}
} 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
use Text::Bidi qw( log2vis );
use C4::Context;
-use C4::Debug;
use C4::Biblio;
use Koha::ClassSources;
use Koha::ClassSortRules;
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;
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;
}
use C4::Log;
use C4::SMS;
use C4::Templates;
-use C4::Debug;
use Koha::DateUtils;
use Koha::SMS::Providers;
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;
}
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' ) {
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
}
}
- $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({});
$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
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;
$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);
}
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;
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 {
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;
}
}
use strict;
use warnings;
-use autouse 'Data::Dumper' => qw(Dumper);
-
use C4::Context;
-use C4::Debug;
BEGIN {
use base qw(Exporter);
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use C4::Context;
-use C4::Debug;
BEGIN {
require Exporter;
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;
}
$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;
# 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 ) {
use C4::Biblio;
use C4::Circulation;
use C4::Context;
-use C4::Debug;
use C4::Items;
use C4::Members;
use C4::Reserves;
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);
use C4::SIP::Sip qw(add_field maybe_add);
-use C4::Debug;
use C4::Context;
use C4::Koha;
use C4::Members;
|| 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;
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;
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;
$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;
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 );
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;
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,
$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;
}
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
} 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') {
}
}
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);
use HTML::Scrubber;
use C4::Context;
-use C4::Debug;
-
-
my %scrubbertypes = (
default => {}, # place holder, default settings are below as fallbacks in call to constructor
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} : [],
=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.
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;
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
# 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 {
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;
}
sub buildQuery {
my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
- warn "---------\nEnter buildQuery\n---------" if $DEBUG;
my $query_desc;
$operand=join(" ",map{
(index($_,"*")>0?"$_":"$_*")
}split (/\s+/,$operand));
- warn $operand if $DEBUG;
}
}
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 (
}
}
$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;
$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)
} #/if $operands
} # /for
}
- warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
+ Koha::Logger->get->debug("QUERY BEFORE LIMITS: >$query<");
# add limits
my %group_OR_limits;
# 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,
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({});
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;
#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];
WHERE subscription.subscriptionid = ?
);
- $debug and warn "query : $query\nsubsid :$subscriptionid";
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $subscription = $sth->fetchrow_hashref;
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( {} );
. q|
ORDER BY publisheddate,serialid DESC
|;
- $debug and warn "GetSerials2 query: $query";
my $sth = $dbh->prepare($query);
$sth->execute( $subscription, @$statuses );
my @serials;
$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=?
require Exporter;
use Carp;
use C4::Context;
-use C4::Debug;
use Koha::DateUtils qw( dt_from_string );
use Koha::Statistics;
use vars qw(@ISA @EXPORT);
-our $debug;
-
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw(
use C4::Context;
use C4::Output;
-use C4::Debug;
use C4::Letters;
use C4::Biblio qw( GetMarcFromKohaField );
use Koha::DateUtils;
push @query, q{ AND suggestions.archived = 0 };
}
- $debug && warn "@query";
my $sth = $dbh->prepare("@query");
$sth->execute(@sql_params);
my @results;
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);
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 {
$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;
}
($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 {
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;
}
}
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);
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;
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);
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;
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);
}
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);
} 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;
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);
}
$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;
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
# 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);
}
use C4::Context;
use C4::Output;
-use C4::Debug;
-
=head1 NAME
use C4::Acquisition;
use C4::Budgets;
use C4::Members;
-use C4::Debug;
use Koha::Acquisition::Currencies;
use Koha::Patrons;
use Koha::Suggestions;
use C4::Acquisition;
use C4::Budgets;
use C4::Contract;
-use C4::Debug;
use C4::Biblio;
use C4::Items;
use C4::Suggestions;
# 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;
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;
use C4::Output;
use C4::Acquisition;
use C4::Budgets;
-use C4::Debug;
use Koha::Acquisition::Currencies;
my $dbh = C4::Context->dbh;
use C4::Context;
use C4::Output;
use C4::Koha;
-use C4::Debug;
use Koha::Acquisition::Currencies;
use Koha::Patrons;
use C4::Output;
use C4::Koha;
use C4::Auth;
-use C4::Debug;
use Koha::Acquisition::Currencies;
our $input = CGI->new;
use C4::Output;
use C4::Auth;
use C4::Koha;
-use C4::Debug;
use Koha::CirculationRules;
my $input = CGI->new;
use C4::Output;
use C4::Auth;
use C4::Koha;
-use C4::Debug;
use Koha::DateUtils;
use Koha::Database;
use Koha::Logger;
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(
{
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,
use C4::Output;
use C4::Auth;
use C4::Koha;
-use C4::Debug;
use C4::HoldsQueue qw(TransportCostMatrix UpdateTransportCostMatrix);
use Koha::Libraries;
use Modern::Perl;
use CGI qw ( -utf8 );
-use C4::Debug;
use C4::Context;
use C4::Circulation;
use C4::Output;
use C4::Overdues;
use C4::Biblio;
use C4::Koha;
-use C4::Debug;
use Koha::DateUtils;
use Koha::BiblioFrameworks;
use Data::Dumper;
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,'');
use C4::Output;
use CGI qw(-oldstyle_urls -utf8);
use C4::Auth;
-use C4::Debug;
use Text::CSV_XS;
use Koha::DateUtils;
use DateTime;
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;
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;
}
}
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;
use C4::Context;
use C4::Output;
use C4::Auth;
-use C4::Debug;
use C4::Acquisition qw/GetOrdersByBiblionumber/;
use Koha::DateUtils;
use Koha::Acquisition::Baskets;
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 >= ?";
# 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(
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) {
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;
<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 %]
<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 %]
use Text::CSV_XS;
use Data::Dumper;
-use C4::Debug;
use C4::Creators;
use C4::Labels;
use CGI qw ( -utf8 );
use C4::Auth;
-use C4::Debug;
use C4::Creators;
use C4::Labels;
use XML::Simple;
use Data::Dumper;
-use C4::Debug;
use C4::Creators;
use C4::Labels;
# 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 );
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');
$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
}
use C4::Auth;
use C4::Output;
use C4::Members;
-use C4::Debug;
use Koha::DateUtils;
use Koha::Patrons;
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
}
}
-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'
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;
use Koha::Script -cron;
use C4::Context;
-use C4::Debug;
use C4::Serials;
use C4::Log;
use Koha::DateUtils;
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/;
use Data::Dumper;
use HTTP::Cookies;
use C4::Context;
-use C4::Debug;
use URI::Escape;
use Koha::Patrons;
$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";
use C4::Context;
use C4::Biblio;
use C4::Koha;
-use C4::Debug;
use C4::Charset;
use C4::Items;
use C4::MarcModificationTemplates;
use IO::File;
use Pod::Usage;
+use Koha::Logger;
use Koha::Biblios;
use Koha::SearchEngine;
use Koha::SearchEngine::Search;
print $loghandle "id;operation;status\n";
}
+my $logger = Koha::Logger->get;
my $schema = Koha::Database->schema;
$schema->txn_begin;
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 ) {
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);
}
}
} 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) {
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;
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));
}
}
}
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=>{}});
use C4::Context;
use C4::Output;
use C4::Log;
-use C4::Debug;
use Koha::Patrons;
use Koha::Patron::Discharge;
use Koha::DateUtils;
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;
use C4::Auth;
use C4::Context;
-use C4::Debug;
use Koha::Ratings;
use C4::Context;
use C4::Members;
use C4::Overdues;
-use C4::Debug;
use Koha::AuthorisedValues;
use Koha::Biblios;
use C4::Output;
use C4::Biblio;
use C4::Scrubber;
-use C4::Debug;
use Koha::Biblios;
use Koha::DateUtils;
}
}
(@errors ) and $template->param( ERRORS=>\@errors);
-($cgi_debug) and $template->param(cgi_debug=>1 );
$review = $clean;
$review ||= $savedreview->review if $savedreview;
$template->param(
use C4::Output;
use C4::Log;
use C4::Items;
-use C4::Debug;
use C4::Search::History;
use URI::Escape;
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;
use Data::Dumper;
+use Koha::Logger;
use Koha::Biblios;
use Koha::CirculationRules;
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 (/^newtag(.*)/) {
my $biblionumber = $1;
unless ($biblionumber =~ /^\d+$/) {
- $debug and warn "$_ references non numerical biblionumber '$biblionumber'";
push @errors, {+'badparam' => $_ };
push @globalErrorIndexes, $#errors;
next;
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",
} 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;
use Storable qw(dclone);
use autouse 'Data::Dumper' => qw(Dumper);
-use C4::Debug;
use C4::Context;
use C4::Creators;
use C4::Patroncards;
use C4::Context;
use C4::Auth;
use C4::Output;
-use C4::Debug;
use C4::Creators;
use C4::Patroncards;
use Koha::Plugins;
use C4::Auth;
use C4::Output;
-use C4::Debug;
use C4::Context;
my $plugins_enabled = C4::Context->config("enable_plugins");
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");
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");
$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 );
use Koha::Plugins::Handler;
use C4::Auth;
use C4::Output;
-use C4::Debug;
use C4::Context;
my $plugins_enabled = C4::Context->config("enable_plugins");
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;
}
$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;
}
$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);
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);
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;
use Date::Manip;
use C4::Auth;
-use C4::Debug;
use C4::Context;
use C4::Koha;
use C4::Output;
=cut
-# my $debug = 1; # override for now.
my $input = CGI->new;
my $fullreportname = "reports/issues_stats.tt";
my $do_it = $input->param('do_it');
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] =
$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]) ) {
}
$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]) ) {
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);
$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;
}
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 };
}
use CGI qw ( -utf8 );
use C4::Auth;
-use C4::Debug;
use C4::Context;
use C4::Koha;
use C4::Output;
=cut
-# my $debug = 1; # override for now.
my $input = CGI->new;
my $fullreportname = "reports/reserves_stats.tt";
my $do_it = $input->param('do_it');
$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);
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,
use C4::Output;
use C4::Search;
use C4::Biblio;
-use C4::Debug;
use Koha::ItemTypes;
use Koha::SearchEngine;
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 );
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;
+++ /dev/null
-#!/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'}");
use utf8;
-use C4::Debug;
use C4::AuthoritiesMarc qw( SearchAuthorities );
use C4::XSLT;
require C4::Context;
use C4::Serials;
use C4::Serials::Frequency;
use C4::Serials::Numberpattern;
-use C4::Debug;
use C4::Biblio;
use C4::Budgets;
use C4::Items;
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";
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);
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 ? '&' . $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
use C4::Koha;
use C4::BackgroundJob;
use C4::ClassSource;
-use C4::Debug;
use C4::Members;
use MARC::File::XML;
use List::MoreUtils qw/uniq/;
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;
# 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
=cut
-$debug and warn "Operation requested: $op";
-
my ( $total, $handled, $tempfile, $tfh );
our @counts = ();
our %errors = ();
});
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
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;
}
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,
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"
}
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;
( $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 );
}
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};
}
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...
# 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 ) {
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 ) {
use C4::Output;
use C4::Items;
use C4::Serials;
-use C4::Debug;
use C4::Search; # enabled_staff_search_views
use Koha::ActionLogs;
use Koha::Items;
use Koha::Patrons;
-use vars qw($debug $cgi_debug);
=head1 viewlog.pl
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") // '';
}
$template->param(
- debug => $debug,
C4::Search::enabled_staff_search_views,
subscriptionsnumber => ( $object ? CountSubscriptionFromBiblionumber($object) : 0 ),
object => $object,
projects / srvgit / commitdiff