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

Bug 28606: Remove $DEBUG and $ENV{DEBUG} 

We should remove the debug statements or use Koha::Logger when we want
to keep it.

Test plan:
Confirm that occurrences of remaining occurrences of DEBUG need to be
kept (historical scripts for instance)
Confirm that the occurrences removed by this patch can be removed
Confirm that the occurrences replaced by Koha::Logger are correct

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

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Looks good to me, noting a few minor points on BZ.

JD amended patch: replace "warn #Finished" with "#warn Finished", and
put the statement on a single line

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
This commit is contained in:
Jonathan Druart 2021-06-22 12:54:15 +02:00
parent feb09b1cc2
commit 41a8005d10
49 changed files with 64 additions and 302 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
C4/Auth.pm
View File

@ -32,6 +32,7 @@ use C4::Templates; # to get the template
use C4::Languages;
use C4::Search::History;
use Koha;
use Koha::Logger;
use Koha::Caches;
use Koha::AuthUtils qw(get_script_name hash_password);
use Koha::Checkouts;
@ -50,7 +51,7 @@ use Net::CIDR;
use C4::Log qw/logaction/;
# use utf8;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $ldap $cas $caslogout);
BEGIN {
sub psgi_env { any { /^psgi\./ } keys %ENV }
@ -62,7 +63,6 @@ BEGIN {
C4::Context->set_remote_address;
$debug = $ENV{DEBUG};
@ISA = qw(Exporter);
@EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
@EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
@ -763,7 +763,7 @@ sub _version_check {
# remove the 3 last . to have a Perl number
$kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
$debug and print STDERR "kohaversion : $kohaversion\n";
Koha::Logger->get->debug("kohaversion : $kohaversion");
if ( $version < $kohaversion ) {
my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
if ( $type ne 'opac' ) {
@ -806,7 +806,6 @@ sub _timeout_syspref {
sub checkauth {
my $query = shift;
$debug and warn "Checking Auth";
# Get shibboleth login attribute
my $shib = C4::Context->config('useshibboleth') && shib_ok();
@ -893,7 +892,7 @@ sub checkauth {
$session->param('desk_id'), $session->param('desk_name'),
$session->param('register_id'), $session->param('register_name')
);
$debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
Koha::Logger->get->debug(sprintf "AUTH_SESSION: (%s)\t%s %s - %s", map { $session->param($_) } qw(cardnumber firstname surname branch));
$ip = $session->param('ip');
$lasttime = $session->param('lasttime');
$userid = $s_userid;
@ -906,7 +905,6 @@ sub checkauth {
#if a user enters an id ne to the id in the current session, we need to log them in...
#first we need to clear the anonymous session...
$debug and warn "query id = $q_userid but session id = $s_userid";
$anon_search_history = $session->param('search_history');
$session->delete();
$session->flush;
@ -1143,25 +1141,16 @@ sub checkauth {
my $sth = $dbh->prepare("$select where userid=?");
$sth->execute($userid);
unless ( $sth->rows ) {
$debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
$sth = $dbh->prepare("$select where cardnumber=?");
$sth->execute($cardnumber);
unless ( $sth->rows ) {
$debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
$sth->execute($userid);
unless ( $sth->rows ) {
$debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
}
}
}
if ( $sth->rows ) {
( $borrowernumber, $firstname, $surname, $userflags,
$branchcode, $branchname, $emailaddress ) = $sth->fetchrow;
$debug and print STDERR "AUTH_3 results: " .
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
} else {
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
}
# launch a sequence to check if we have a ip for the branch, i
@ -1236,7 +1225,6 @@ sub checkauth {
$session->param( 'shibboleth', $shibSuccess );
$session->param( 'register_id', $register_id );
$session->param( 'register_name', $register_name );
$debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map { $session->param($_) } qw(cardnumber firstname surname branch);
}
$session->param('cas_ticket', $cas_ticket) if $cas_ticket;
C4::Context->set_userenv(
@ -1253,7 +1241,6 @@ sub checkauth {
# $return: 0 = invalid user
# reset to anonymous session
else {
$debug and warn "Login failed, resetting anonymous session...";
if ($userid) {
$info{'invalid_username_or_password'} = 1;
C4::Context->_unset_userenv($sessionID);
@ -1266,9 +1253,7 @@ sub checkauth {
} # END if ( $q_userid
elsif ( $type eq "opac" ) {
# if we are here this is an anonymous session; add public lists to it and a few other items...
# anonymous sessions are created only for the OPAC
$debug and warn "Initiating an anonymous session...";
# setting a couple of other session vars...
$session->param( 'ip', $session->remote_addr() );
@ -1589,7 +1574,6 @@ sub check_api_auth {
# Proxy CAS auth
if ( $cas && $query->param('PT') ) {
my $retuserid;
$debug and print STDERR "## check_api_auth - checking CAS\n";
# In case of a CAS authentication, we use the ticket instead of the password
my $PT = $query->param('PT');
@ -1905,7 +1889,6 @@ sub checkpw {
if ( $patron and $patron->account_locked ) {
# Nothing to check, account is locked
} elsif ($ldap && defined($password)) {
$debug and print STDERR "## checkpw - checking LDAP\n";
my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH
if ( $retval == 1 ) {
@return = ( $retval, $retcard, $retuserid );
@ -1914,7 +1897,6 @@ sub checkpw {
$check_internal_as_fallback = 1 if $retval == 0;
} elsif ( $cas && $query && $query->param('ticket') ) {
$debug and print STDERR "## checkpw - checking CAS\n";
# In case of a CAS authentication, we use the ticket instead of the password
my $ticket = $query->param('ticket');
@ -1933,8 +1915,6 @@ sub checkpw {
# time around.
elsif ( $shib && $shib_login && !$password ) {
$debug and print STDERR "## checkpw - checking Shibboleth\n";
# In case of a Shibboleth authentication, we expect a shibboleth user attribute
# (defined under shibboleth mapping in koha-conf.xml) to contain the login of the
# shibboleth-authenticated user
@ -2240,7 +2220,7 @@ sub in_iprange {
if (scalar @allowedipranges > 0) {
my @rangelist;
eval { @rangelist = Net::CIDR::range2cidr(@allowedipranges); }; return 0 if $@;
eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || ( $ENV{DEBUG} && warn 'cidrlookup failed for ' . join(' ',@rangelist) );
eval { $result = Net::CIDR::cidrlookup($ENV{'REMOTE_ADDR'}, @rangelist) } || Koha::Logger->get->warn('cidrlookup failed for ' . join(' ',@rangelist) );
}
return $result ? 1 : 0;
}

27
C4/Auth_with_cas.pm
View File

@ -27,12 +27,12 @@ use CGI qw ( -utf8 );
use FindBin;
use YAML::XS;
use Koha::Logger;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
BEGIN {
require Exporter;
$debug = $ENV{DEBUG};
@ISA = qw(Exporter);
@EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url logout_if_required);
}
@ -99,14 +99,12 @@ sub login_cas_url {
# Checks for password correctness
# In our case : is there a ticket, is it valid and does it match one of our users ?
sub checkpw_cas {
$debug and warn "checkpw_cas";
my ($dbh, $ticket, $query, $type) = @_;
my $retnumber;
my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
# If we got a ticket
if ($ticket) {
$debug and warn "Got ticket : $ticket";
# We try to validate it
my $val = $cas->service_validate($uri, $ticket );
@ -115,7 +113,6 @@ sub checkpw_cas {
if ( $val->is_success() ) {
my $userid = $val->user();
$debug and warn "User CAS authenticated as: $userid";
# we should store the CAS ticekt too, we need this for single logout https://apereo.github.io/cas/4.2.x/protocol/CAS-Protocol-Specification.html#233-single-logout
@ -134,13 +131,14 @@ sub checkpw_cas {
}
# If we reach this point, then the user is a valid CAS user, but not a Koha user
$debug and warn "User $userid is not a valid Koha user";
Koha::Logger->get->info("User $userid is not a valid Koha user");
} else {
$debug and warn "Problem when validating ticket : $ticket";
$debug and warn "Authen::CAS::Client::Response::Error: " . $val->error() if $val->is_error();
$debug and warn "Authen::CAS::Client::Response::Failure: " . $val->message() if $val->is_failure();
$debug and warn Data::Dumper::Dumper($@) if $val->is_error() or $val->is_failure();
my $logger = Koha::Logger->get;
$logger->debug("Problem when validating ticket : $ticket");
$logger->debug("Authen::CAS::Client::Response::Error: " . $val->error()) if $val->is_error();
$logger->debug("Authen::CAS::Client::Response::Failure: " . $val->message()) if $val->is_failure();
$logger->debug(Data::Dumper::Dumper($@)) if $val->is_error() or $val->is_failure();
return 0;
}
}
@ -149,7 +147,6 @@ sub checkpw_cas {
# Proxy CAS auth
sub check_api_auth_cas {
$debug and warn "check_api_auth_cas";
my ($dbh, $PT, $query, $type) = @_;
my $retnumber;
my ( $cas, $uri ) = _get_cas_and_service($query, undef, $type);
@ -162,10 +159,6 @@ sub check_api_auth_cas {
if ( $r->is_success ) {
# We've got a username !
$debug and warn "User authenticated as: ", $r->user, "\n";
$debug and warn "Proxied through:\n";
$debug and warn " $_\n" for $r->proxies;
my $userid = $r->user;
# we should store the CAS ticket too, we need this for single logout https://apereo.github.io/cas/4.2.x/protocol/CAS-Protocol-Specification.html#233-single-logout
@ -186,10 +179,10 @@ sub check_api_auth_cas {
}
# If we reach this point, then the user is a valid CAS user, but not a Koha user
$debug and warn "User $userid is not a valid Koha user";
Koha::Logger->get->info("User $userid is not a valid Koha user");
} else {
$debug and warn "Proxy Ticket authentication failed";
Koha::Logger->get->debug("Proxy Ticket authentication failed");
return 0;
}
}

41
C4/Auth_with_ldap.pm
View File

@ -29,7 +29,7 @@ use List::MoreUtils qw( any );
use Net::LDAP;
use Net::LDAP::Filter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
BEGIN {
require Exporter;
@ -60,9 +60,9 @@ $ldapname = $ldap->{user} ;
$ldappassword = $ldap->{pass} ;
our %mapping = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of || (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9
my @mapkeys = keys %mapping;
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n";
#warn "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n";
@mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n";
#warn "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n";
my %categorycode_conversions;
my $default_categorycode;
@ -119,7 +119,6 @@ sub checkpw_ldap {
return 0;
}
#$debug and $db->debug(5);
my $userldapentry;
# first, LDAP authentication
@ -208,7 +207,7 @@ sub checkpw_ldap {
if (( $borrowernumber and $config{update} ) or
(!$borrowernumber and $config{replicate}) ) {
%borrower = ldap_entry_2_hash($userldapentry,$userid);
$debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
#warn "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n";
}
if ($borrowernumber) {
@ -265,21 +264,18 @@ sub ldap_entry_2_hash {
my %borrower = ( cardnumber => shift );
my %memberhash;
$userldapentry->exists('uid'); # This is bad, but required! By side-effect, this initializes the attrs hash.
if ($debug) {
foreach (keys %$userldapentry) {
print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
}
}
#foreach (keys %$userldapentry) {
# print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
#}
my $x = $userldapentry->{attrs} or return;
foreach (keys %$x) {
$memberhash{$_} = join ' ', @{$x->{$_}};
$debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
#warn sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
}
$debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n",
"Referencing \%mapping with ", scalar(keys %mapping), " keys\n";
#warn "Finished \%memberhash has ", scalar(keys %memberhash), " keys\n", "Referencing \%mapping with ", scalar(keys %mapping), " keys\n";
foreach my $key (keys %mapping) {
my $data = $memberhash{ lc($mapping{$key}->{is}) }; # Net::LDAP returns all names in lowercase
$debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
#warn "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data;
unless (defined $data) {
$data = $mapping{$key}->{content} || undef;
}
@ -304,7 +300,7 @@ sub ldap_entry_2_hash {
$sth->execute( uc($borrower{'categorycode'}) );
unless ( my $row = $sth->fetchrow_hashref ) {
my $default = $mapping{'categorycode'}->{content};
$debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid};
#warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid};
$borrower{'categorycode'} = $default
}
@ -318,12 +314,12 @@ sub exists_local {
my $sth = $dbh->prepare("$select WHERE userid=?"); # was cardnumber=?
$sth->execute($arg);
$debug and printf STDERR "Userid '$arg' exists_local? %s\n", $sth->rows;
#warn "Userid '$arg' exists_local? %s\n", $sth->rows;
($sth->rows == 1) and return $sth->fetchrow;
$sth = $dbh->prepare("$select WHERE cardnumber=?");
$sth->execute($arg);
$debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
#warn "Cardnumber '$arg' exists_local? %s\n", $sth->rows;
($sth->rows == 1) and return $sth->fetchrow;
return 0;
}
@ -358,7 +354,7 @@ sub _do_changepassword {
}
my $digest = hash_password($password);
$debug and print STDERR "changing local password for borrowernumber=$borrowerid to '$digest'\n";
#warn "changing local password for borrowernumber=$borrowerid to '$digest'\n";
Koha::Patrons->find($borrowerid)->set_password({ password => $password, skip_validation => 1 });
my ($ok, $cardnum) = checkpw_internal(C4::Context->dbh, $userid, $password);
@ -382,7 +378,7 @@ sub update_local {
while ( my $attribute_type = $attribute_types->next ) {
my $code = $attribute_type->code;
@keys = grep { $_ ne $code } @keys;
$debug and printf STDERR "ignoring extended patron attribute '%s' in update_local()\n", $code;
#warn "ignoring extended patron attribute '%s' in update_local()\n", $code;
}
}
@ -391,11 +387,8 @@ sub update_local {
join(',', map {"$_=?"} @keys) .
"\nWHERE borrowernumber=? ";
my $sth = $dbh->prepare($query);
if ($debug) {
print STDERR $query, "\n",
join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys;
print STDERR "\nuserid = $userid\n";
}
#warn $query, "\n", join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys;
#warn "\nuserid = $userid\n";
$sth->execute(
((map {$borrower->{$_}} @keys), $borrowerid)
);

47
C4/Auth_with_shibboleth.pm
View File

@ -28,11 +28,12 @@ use Carp;
use CGI;
use List::MoreUtils qw(any);
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
use Koha::Logger;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
BEGIN {
require Exporter;
$debug = $ENV{DEBUG};
@ISA = qw(Exporter);
@EXPORT =
qw(shib_ok logout_shib login_shib_url checkpw_shib get_login_shib);
@ -83,10 +84,8 @@ sub get_login_shib {
my $matchAttribute = $config->{mapping}->{ $config->{matchpoint} }->{is};
if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
$debug and warn $matchAttribute . " value: " . $ENV{"HTTP_".uc($matchAttribute)};
return $ENV{"HTTP_".uc($matchAttribute)} || '';
} else {
$debug and warn $matchAttribute . " value: " . $ENV{$matchAttribute};
return $ENV{$matchAttribute} || '';
}
}
@ -94,18 +93,16 @@ sub get_login_shib {
# Checks for password correctness
# In our case : does the given attribute match one of our users ?
sub checkpw_shib {
$debug and warn "checkpw_shib";
my ( $match ) = @_;
my $config = _get_shib_config();
$debug and warn "User Shibboleth-authenticated as: $match";
# Does the given shibboleth attribute value ($match) match a valid koha user ?
my $borrowers = Koha::Patrons->search( { $config->{matchpoint} => $match } );
if ( $borrowers->count > 1 ){
# If we have more than 1 borrower the matchpoint is not unique
# we cannot know which patron is the correct one, so we should fail
$debug and warn "There are several users with $config->{matchpoint} of $match, matchpoints must be unique";
Koha::Logger->get->warn("There are several users with $config->{matchpoint} of $match, matchpoints must be unique");
return 0;
}
my $borrower = $borrowers->next;
@ -120,7 +117,7 @@ sub checkpw_shib {
return _autocreate( $config, $match );
} else {
# If we reach this point, the user is not a valid koha user
$debug and warn "User with $config->{matchpoint} of $match is not a valid Koha user";
Koha::Logger->get->info("There are several users with $config->{matchpoint} of $match, matchpoints must be unique");
return 0;
}
}
@ -163,28 +160,20 @@ sub _get_uri {
my $protocol = "https://";
my $interface = C4::Context->interface;
$debug and warn "shibboleth interface: " . $interface;
my $uri;
if ( $interface eq 'intranet' ) {
my $uri =
$interface eq 'intranet'
? C4::Context->preference('staffClientBaseURL')
: C4::Context->preference('OPACBaseURL');
$uri = C4::Context->preference('staffClientBaseURL') // '';
if ($uri eq '') {
$debug and warn 'staffClientBaseURL not set!';
}
} else {
$uri = C4::Context->preference('OPACBaseURL') // '';
if ($uri eq '') {
$debug and warn 'OPACBaseURL not set!';
}
}
$uri or Koha::Logger->get->warn("Syspref staffClientBaseURL or OPACBaseURL not set!"); # FIXME We should die here
$uri ||= "";
if ($uri =~ /(.*):\/\/(.*)/) {
my $oldprotocol = $1;
if ($oldprotocol ne 'https') {
$debug
and warn
'Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!';
Koha::Logger->get->warn('Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!');
}
$uri = $2;
}
@ -217,18 +206,16 @@ sub _get_shib_config {
my $config = C4::Context->config('shibboleth');
if ( !$config ) {
carp 'shibboleth config not defined' if $debug;
Koha::Logger->get->warn('shibboleth config not defined');
return 0;
}
if ( $config->{matchpoint}
&& defined( $config->{mapping}->{ $config->{matchpoint} }->{is} ) )
{
if ($debug) {
warn "koha borrower field to match: " . $config->{matchpoint};
warn "shibboleth attribute to match: "
. $config->{mapping}->{ $config->{matchpoint} }->{is};
}
my $logger = Koha::Logger->get;
$logger->debug("koha borrower field to match: " . $config->{matchpoint});
$logger->debug("shibboleth attribute to match: " . $config->{mapping}->{ $config->{matchpoint} }->{is});
return $config;
}
else {

32
C4/CourseReserves.pm
View File

@ -27,7 +27,7 @@ use Koha::Course::Instructors;
use Koha::Course::Items;
use Koha::Course::Reserves;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG @FIELDS);
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS @FIELDS);
BEGIN {
require Exporter;
@ -55,7 +55,6 @@ BEGIN {
);
%EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
$DEBUG = 0;
@FIELDS = ( 'itype', 'ccode', 'homebranch', 'holdingbranch', 'location' );
}
@ -81,7 +80,6 @@ This module deals with course reserves.
sub GetCourse {
my ($course_id) = @_;
warn whoami() . "( $course_id )" if $DEBUG;
my $course = Koha::Courses->find( $course_id );
return unless $course;
@ -108,7 +106,6 @@ sub GetCourse {
sub ModCourse {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $dbh = C4::Context->dbh;
@ -158,7 +155,6 @@ sub ModCourse {
sub GetCourses {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my @query_keys;
my @query_values;
@ -241,7 +237,6 @@ sub DelCourse {
sub EnableOrDisableCourseItems {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $course_id = $params{'course_id'};
my $enabled = $params{'enabled'} || 0;
@ -290,7 +285,6 @@ sub EnableOrDisableCourseItems {
sub EnableOrDisableCourseItem {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $ci_id = $params{'ci_id'};
@ -329,8 +323,6 @@ sub EnableOrDisableCourseItem {
sub GetCourseInstructors {
my ($course_id) = @_;
warn "C4::CourseReserves::GetCourseInstructors( $course_id )"
if $DEBUG;
my $query = "
SELECT * FROM borrowers
@ -359,7 +351,6 @@ sub GetCourseInstructors {
sub ModCourseInstructors {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $course_id = $params{'course_id'};
my $mode = $params{'mode'};
@ -420,7 +411,6 @@ sub ModCourseInstructors {
sub GetCourseItem {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $ci_id = $params{'ci_id'};
my $itemnumber = $params{'itemnumber'};
@ -459,7 +449,6 @@ sub GetCourseItem {
sub ModCourseItem {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $itemnumber = $params{'itemnumber'};
@ -493,7 +482,6 @@ sub ModCourseItem {
sub _AddCourseItem {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
$params{homebranch} ||= undef; # Can't be empty string, FK constraint
$params{holdingbranch} ||= undef; # Can't be empty string, FK constraint
@ -520,7 +508,6 @@ sub _AddCourseItem {
sub _UpdateCourseItem {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $ci_id = $params{'ci_id'};
my $course_item = $params{'course_item'};
@ -581,7 +568,6 @@ sub _UpdateCourseItem {
sub _RevertFields {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $ci_id = $params{'ci_id'};
@ -617,7 +603,6 @@ sub _RevertFields {
sub _SwapAllFields {
my ( $ci_id, $enabled ) = @_;
warn "C4::CourseReserves::_SwapFields( $ci_id )" if $DEBUG;
my $course_item = Koha::Course::Items->find( $ci_id );
my $item = Koha::Items->find( $course_item->itemnumber );
@ -675,7 +660,6 @@ sub _SwapAllFields {
sub GetCourseItems {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $course_id = $params{'course_id'};
my $itemnumber = $params{'itemnumber'};
@ -714,7 +698,6 @@ sub GetCourseItems {
sub DelCourseItem {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $ci_id = $params{'ci_id'};
@ -740,7 +723,6 @@ sub DelCourseItem {
sub GetCourseReserve {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $cr_id = $params{'cr_id'};
my $course_id = $params{'course_id'};
@ -779,7 +761,6 @@ sub GetCourseReserve {
sub ModCourseReserve {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $course_id = $params{'course_id'};
my $ci_id = $params{'ci_id'};
@ -836,7 +817,6 @@ sub ModCourseReserve {
sub GetCourseReserves {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $course_id = $params{'course_id'};
my $ci_id = $params{'ci_id'};
@ -897,7 +877,6 @@ sub GetCourseReserves {
sub DelCourseReserve {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $cr_id = $params{'cr_id'};
@ -932,7 +911,6 @@ sub DelCourseReserve {
sub GetItemCourseReservesInfo {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $itemnumber = $params{'itemnumber'};
@ -967,7 +945,6 @@ sub GetItemCourseReservesInfo {
sub CountCourseReservesForItem {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $ci_id = $params{'ci_id'};
my $itemnumber = $params{'itemnumber'};
@ -1005,7 +982,6 @@ sub CountCourseReservesForItem {
sub SearchCourses {
my (%params) = @_;
warn identify_myself(%params) if $DEBUG;
my $term = $params{'term'};
@ -1076,12 +1052,6 @@ sub stringify_params {
return "( $string )";
}
sub identify_myself {
my (%params) = @_;
return whowasi() . stringify_params(%params);
}
1;
=head1 AUTHOR

5
C4/Koha.pm
View File

@ -30,7 +30,7 @@ use Koha::MarcSubfieldStructures;
use Business::ISBN;
use Business::ISSN;
use autouse 'Data::cselectall_arrayref' => qw(Dumper);
use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
use vars qw(@ISA @EXPORT @EXPORT_OK);
BEGIN {
require Exporter;
@ -57,9 +57,7 @@ BEGIN {
&GetVariationsOfISSNs
&NormalizeISSN
$DEBUG
);
$DEBUG = 0;
}
=head1 NAME
@ -249,7 +247,6 @@ sub getImageSets {
my @imagesets = (); # list of hasrefs of image set data to pass to template
my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
foreach my $imagesubdir ( @subdirectories ) {
warn $imagesubdir if $DEBUG;
my @imagelist = (); # hashrefs of image info
my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
my $imagesetactive = 0;

3
C4/Languages.pm
View File

@ -28,7 +28,7 @@ use List::MoreUtils qw( any );
use C4::Context;
use Koha::Caches;
use Koha::Cache::Memory::Lite;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
BEGIN {
require Exporter;
@ -40,7 +40,6 @@ BEGIN {
&getAllLanguages
);
@EXPORT_OK = qw(getFrameworkLanguages getTranslatedLanguages getAllLanguages getLanguages get_bidi regex_lang_subtags language_get_description accept_language getlanguage);
$DEBUG = 0;
}
=head1 NAME

17
C4/MarcModificationTemplates.pm
View File

@ -28,8 +28,6 @@ use Koha::DateUtils;
use vars qw(@ISA @EXPORT);
use constant DEBUG => 0;
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw(
@ -75,7 +73,6 @@ files telling Koha what fields to insert data into.
sub GetModificationTemplates {
my ( $template_id ) = @_;
warn("C4::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT * FROM marc_modification_templates ORDER BY name");
@ -182,8 +179,6 @@ sub GetModificationTemplateAction {
sub GetModificationTemplateActions {
my ( $template_id ) = @_;
warn( "C4::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT * FROM marc_modification_template_actions WHERE template_id = ? ORDER BY ordering");
$sth->execute( $template_id );
@ -193,8 +188,6 @@ sub GetModificationTemplateActions {
push( @actions, $action );
}
warn( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
return @actions;
}
@ -236,11 +229,6 @@ sub AddModificationTemplateAction {
$description
) = @_;
warn( "C4::MarcModificationTemplates::AddModificationTemplateAction( $template_id, $action,
$field_number, $from_field, $from_subfield, $field_value, $to_field, $to_subfield,
$to_regex_search, $to_regex_replace, $to_regex_modifiers, $conditional, $conditional_field, $conditional_subfield, $conditional_comparison,
$conditional_value, $conditional_regex, $description )" ) if DEBUG;
$conditional ||= undef;
$conditional_comparison ||= undef;
$conditional_regex ||= '0';
@ -481,7 +469,6 @@ sub MoveModificationTemplateAction {
sub ModifyRecordsWithTemplate {
my ( $template_id, $batch ) = @_;
warn( "C4::MarcModificationTemplates::ModifyRecordsWithTemplate( $template_id, $batch )" ) if DEBUG;
while ( my $record = $batch->next() ) {
ModifyRecordWithTemplate( $template_id, $record );
@ -499,8 +486,6 @@ sub ModifyRecordsWithTemplate {
sub ModifyRecordWithTemplate {
my ( $template_id, $record ) = @_;
warn( "C4::MarcModificationTemplates::ModifyRecordWithTemplate( $template_id, $record )" ) if DEBUG;
warn( "Unmodified Record:\n" . $record->as_formatted() ) if DEBUG >= 10;
my $current_date = dt_from_string()->ymd();
my $branchcode = '';
@ -705,8 +690,6 @@ sub ModifyRecordWithTemplate {
});
}
}
warn( $record->as_formatted() ) if DEBUG >= 10;
}
return;

5
C4/Members.pm
View File

@ -44,10 +44,9 @@ use Koha::List::Patron;
use Koha::Patrons;
use Koha::Patron::Categories;
our (@ISA,@EXPORT,@EXPORT_OK,$debug);
our (@ISA,@EXPORT,@EXPORT_OK);
BEGIN {
$debug = $ENV{DEBUG} || 0;
require Exporter;
@ISA = qw(Exporter);
#Get data
@ -450,8 +449,6 @@ sub GetBorrowersToExpunge {
push( @query_params, $anonymous_patron );
}
warn $query if $debug;
my $sth = $dbh->prepare($query);
if (scalar(@query_params)>0){
$sth->execute(@query_params);

3
C4/Members/Statistics.pm
View File

@ -26,10 +26,9 @@ use Modern::Perl;
use C4::Context;
our ( @ISA, @EXPORT, @EXPORT_OK, $debug );
our ( @ISA, @EXPORT, @EXPORT_OK );
BEGIN {
$debug = $ENV{DEBUG} || 0;
require Exporter;
@ISA = qw(Exporter);

1
C4/Patroncards/Patroncard.pm
View File

@ -260,7 +260,6 @@ sub draw_text {
while (1) {
# $line =~ m/^.*(\s\b.*\b\s*|\s&|\<\b.*\b\>)$/; # original regexp... can be removed after dev stage is over
$line =~ m/^.*(\s.*\s*|\s&|\<.*\>)$/;
warn sprintf('Line wrap failed. DEBUG INFO: Data: \'%s\'\n Method: C4::Patroncards->draw_text Additional Information: Line wrap regexp failed. (Please file in this information in a bug report at http://bugs.koha-community.org', $line) and last WRAP_LINES if !$1;
$trim = $1 . $trim;
#Sanitize the input into this regular expression so regex metacharacters are escaped as literal values (https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=22429)
$line =~ s/\Q$1\E$//;

6
C4/SIP/ILS.pm
View File

@ -19,8 +19,6 @@ use C4::SIP::ILS::Transaction::Hold;
use C4::SIP::ILS::Transaction::Renew;
use C4::SIP::ILS::Transaction::RenewAll;
my $debug = 0;
my %supports = (
'magnetic media' => 1,
'security inhibit' => 0,
@ -46,7 +44,6 @@ sub new {
my ($class, $institution) = @_;
my $type = ref($class) || $class;
my $self = {};
$debug and warn "new ILS: INSTITUTION: " . Dumper($institution);
siplog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
$self->{institution} = $institution;
return bless $self, $type;
@ -54,13 +51,11 @@ sub new {
sub find_patron {
my $self = shift;
$debug and warn "ILS: finding patron";
return C4::SIP::ILS::Patron->new(@_);
}
sub find_item {
my $self = shift;
$debug and warn "ILS: finding item";
return C4::SIP::ILS::Item->new(@_);
}
@ -155,7 +150,6 @@ sub checkout {
else {
$circ->do_checkout($account);
if ( $circ->ok ) {
$debug and warn "circ is ok";
# If the item is already associated with this patron, then
# we're renewing it.

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

@ -25,8 +25,6 @@ use Koha::Account::Lines;
use parent qw(C4::SIP::ILS::Transaction);
our $debug = 0;
my %fields = ();
sub new {

5
C4/SIP/Sip/Checksum.pm
View File

@ -6,7 +6,6 @@ use warnings;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(checksum verify_cksum);
our $debug = 0;
sub checksum {
my $pkt = shift;
@ -18,9 +17,7 @@ sub verify_cksum {
my $cksum;
my $shortsum;
if ($pkt =~ /AZ(....)$/) {
$debug and warn "verify_cksum: sum ($1) detected";
} else {
unless ($pkt =~ /AZ(....)$/) {
warn "verify_cksum: no sum detected";
return 0; # No checksum at end
}

7
C4/Service.pm
View File

@ -47,12 +47,6 @@ use C4::Output qw( :ajax );
use C4::Output::JSONStream;
use JSON;
our $debug;
BEGIN {
$debug = $ENV{DEBUG} || 0;
}
our ( $query, $cookie );
sub _output {
@ -257,7 +251,6 @@ sub dispatch {
next ROUTE if ( !defined( $query->param ( $param ) ) );
}
$debug and warn "Using $path";
$handler->( @match );
return;
}

11
Koha/Cache.pm
View File

@ -73,8 +73,6 @@ sub new {
my $subnamespace = $params->{subnamespace} // '';
$ENV{DEBUG} && carp "Default caching system: $self->{'default_type'}";
$self->{'timeout'} ||= 0;
# Should we continue to support MEMCACHED ENV vars?
$self->{'namespace'} ||= $ENV{MEMCACHED_NAMESPACE};
@ -92,8 +90,6 @@ sub new {
$self->{'cache'} = $self->{'memcached_cache'};
}
$ENV{DEBUG} && carp "Selected caching system: " . ($self->{'cache'} // 'none');
return
bless $self,
$class;
@ -104,11 +100,6 @@ sub _initialize_memcached {
return unless @servers;
$ENV{DEBUG}
&& carp "Memcached server settings: "
. join( ', ', @servers )
. " with "
. $self->{'namespace'};
# Cache::Memcached::Fast::Safe doesn't allow a default expire time to be set
# so we force it on setting.
my $memcached = Cache::Memcached::Fast::Safe->new(
@ -177,7 +168,6 @@ sub set_in_cache {
my $cache = $options->{cache} || 'cache';
croak "No key" unless $key;
$ENV{DEBUG} && carp "set_in_cache for $key";
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
my $expiry = $options->{expiry};
@ -245,7 +235,6 @@ sub get_from_cache {
my $unsafe = $options->{unsafe} || 0;
$key =~ s/[\x00-\x20]/_/g;
croak "No key" unless $key;
$ENV{DEBUG} && carp "get_from_cache for $key";
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
# Return L1 cache value if exists

4
Koha/Cache/Object.pm
View File

@ -81,10 +81,6 @@ sub TIESCALAR {
sub FETCH {
my ( $self, $index ) = @_;
$ENV{DEBUG}
&& $index
&& carp "Retrieving cached hash member $index of $self->{'key'}";
my $now = time;
if ( !( $self->{'inprocess'} && defined( $self->{'value'} ) )

2
Koha/SimpleMARC.pm
View File

@ -42,8 +42,6 @@ our @EXPORT = qw(
);
our $debug = 0;
=head1 NAME
SimpleMARC - Perl module for making simple MARC record alterations.

3
Koha/XSLT/Base.pm
View File

@ -66,8 +66,7 @@ Koha::XSLT::Base - Facilitate use of XSLT transformations
=head2 print_warns
If set, print error messages to STDERR. False by default. Looks at the
DEBUG environment variable too.
If set, print error messages to STDERR. False by default.
=head1 ERROR CODES

2
catalogue/detail.pl
View File

@ -502,8 +502,6 @@ $template->param(
searchid => scalar $query->param('searchid'),
);
# $debug and $template->param(debug_display => 1);
# Lists
if (C4::Context->preference("virtualshelves") ) {

3
catalogue/image.pl
View File

@ -33,7 +33,6 @@ use Koha::Exceptions;
$| = 1;
my $DEBUG = 0;
my $data = CGI->new;
my $imagenumber;
@ -73,8 +72,6 @@ if ( C4::Context->preference("LocalCoverImages") ) {
my $cover_images = $biblio->cover_images;
if ( $cover_images->count ) {
$image = $cover_images->next;
} else {
warn "No images for this biblio" if $DEBUG;
}
}
}

3
cataloguing/value_builder/barcode.pl
View File

@ -29,8 +29,6 @@ use Koha::DateUtils;
use Algorithm::CheckDigits;
my $DEBUG = 0;
my $builder = sub {
my ( $params ) = @_;
my $function_name = $params->{id};
@ -44,7 +42,6 @@ my $builder = sub {
my $nextnum;
my $scr;
my $autoBarcodeType = C4::Context->preference("autoBarcode");
warn "Barcode type = $autoBarcodeType" if $DEBUG;
if ((not $autoBarcodeType) or $autoBarcodeType eq 'OFF') {
# don't return a value unless we have the appropriate syspref set
return q|<script></script>|;

3
cataloguing/value_builder/barcode_manual.pl
View File

@ -27,8 +27,6 @@ use C4::Barcodes::ValueBuilder;
use C4::Biblio qw/GetMarcFromKohaField/;
use Koha::DateUtils;
my $DEBUG = 0;
my $builder = sub {
my ( $params ) = @_;
my $function_name = $params->{id};
@ -45,7 +43,6 @@ my $builder = sub {
my $nextnum;
my $scr;
my $autoBarcodeType = C4::Context->preference("autoBarcode");
warn "Barcode type = $autoBarcodeType" if $DEBUG;
if ((not $autoBarcodeType) or $autoBarcodeType eq 'OFF') {
# don't return a value unless we have the appropriate syspref set
return q|<script></script>|;

7
circ/hold-transfer-slip.pl
View File

@ -25,12 +25,6 @@ use CGI qw ( -utf8 );
use C4::Auth qw/:DEFAULT get_session/;
use C4::Reserves;
use vars qw($debug);
BEGIN {
$debug = $ENV{DEBUG} || 0;
}
my $input = CGI->new;
my $sessionID = $input->cookie("CGISESSID");
my $session = get_session($sessionID);
@ -43,7 +37,6 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
query => $input,
type => "intranet",
flagsrequired => { circulate => "circulate_remaining_permissions" },
debug => $debug,
}
);

7
circ/transfer-slip.pl
View File

@ -26,12 +26,6 @@ use CGI qw ( -utf8 );
use C4::Auth qw/:DEFAULT get_session/;
use C4::Circulation;
use vars qw($debug);
BEGIN {
$debug = $ENV{DEBUG} || 0;
}
my $input = CGI->new;
my $sessionID = $input->cookie("CGISESSID");
my $session = get_session($sessionID);
@ -46,7 +40,6 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
query => $input,
type => "intranet",
flagsrequired => { circulate => "circulate_remaining_permissions" },
debug => $debug,
}
);

2
fix-perl-path.PL
View File

@ -20,7 +20,7 @@ use ExtUtils::MakeMaker::Config;
use Tie::File;
my $basedir = (shift);
my $DEBUG = exists $ENV{'DEBUG'} ? $ENV{'DEBUG'} : 0;
my $DEBUG = 0;
$DEBUG = 1 if $basedir eq 'test';

2
installer/data/mysql/updatedatabase.pl
View File

@ -50,8 +50,6 @@ use File::Slurp;
# FIXME - The user might be installing a new database, so can't rely
# on /etc/koha.conf anyway.
my $debug = 0;
my (
$sth,
$query,

4
koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-shelves.tt
View File

@ -817,10 +817,6 @@
<input type="hidden" name="format" id="download_format" value="" />
</form>
<!-- DEBUG -->
<div id="debug"></div>
<!-- /DEBUG -->
[% INCLUDE 'opac-bottom.inc' %]
[% BLOCK jsinclude %]
[% Asset.js("lib/hc-sticky.js") | $raw %]

1
labels/label-edit-batch.pl
View File

@ -19,7 +19,6 @@
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use Modern::Perl;
use vars qw($debug);
use CGI qw ( -utf8 );

2
labels/label-manage.pl
View File

@ -20,8 +20,6 @@
use Modern::Perl;
use vars qw($debug);
use CGI qw ( -utf8 );
use Data::Dumper;

14
members/memberentry.pl
View File

@ -49,14 +49,7 @@ use Koha::Token;
use Email::Valid;
use Koha::SMS::Providers;
use vars qw($debug);
BEGIN {
$debug = $ENV{DEBUG} || 0;
}
my $input = CGI->new;
($debug) or $debug = $input->param('debug') || 0;
my %data;
my $dbh = C4::Context->dbh;
@ -66,7 +59,6 @@ my ($template, $loggedinuser, $cookie)
query => $input,
type => "intranet",
flagsrequired => {borrowers => 'edit_borrowers'},
debug => ($debug) ? 1 : 0,
});
my $borrowernumber = $input->param('borrowernumber');
@ -319,8 +311,7 @@ if ( ( defined $newdata{'userid'} && $newdata{'userid'} eq '' ) || $check_Borrow
$newdata{'userid'} = $data{'userid'};
}
}
$debug and warn join "\t", map {"$_: $newdata{$_}"} qw(dateofbirth dateenrolled dateexpiry);
my $extended_patron_attributes;
if ($op eq 'save' || $op eq 'insert'){
@ -363,7 +354,6 @@ if ($op eq 'save' || $op eq 'insert'){
if (C4::Context->preference("IndependentBranches")) {
unless ( C4::Context->IsSuperLibrarian() ){
$debug and print STDERR " $newdata{'branchcode'} : ".$userenv->{flags}.":".$userenv->{branch};
unless (!$newdata{'branchcode'} || $userenv->{branch} eq $newdata{'branchcode'}){
push @errors, "ERROR_branch";
}
@ -444,7 +434,6 @@ if ( defined $sms ) {
### Error checks should happen before this line.
$nok = $nok || scalar(@errors);
if ((!$nok) and $nodouble and ($op eq 'insert' or $op eq 'save')){
$debug and warn "$op dates: " . join "\t", map {"$_: $newdata{$_}"} qw(dateofbirth dateenrolled dateexpiry);
my $success;
if ($op eq 'insert'){
# we know it's not a duplicate borrowernumber or there would already be an error
@ -818,7 +807,6 @@ if (C4::Context->preference('EnhancedMessagingPreferences')) {
}
$template->param( "show_guarantor" => ( $category_type =~ /A|I|S|X/ ) ? 0 : 1 ); # associate with step to know where you are
$debug and warn "memberentry step: $step";
$template->param(%data);
$template->param( "step_$step" => 1) if $step; # associate with step to know where u are
$template->param( step => $step ) if $step; # associate with step to know where u are

8
members/moremember.pl
View File

@ -44,15 +44,7 @@ use Koha::Patron::Files;
use Koha::Token;
use Koha::Checkouts;
use vars qw($debug);
BEGIN {
$debug = $ENV{DEBUG} || 0;
}
my $input = CGI->new;
$debug or $debug = $input->param('debug') || 0;
my $print = $input->param('print');

4
members/patronimage.pl
View File

@ -30,7 +30,6 @@ use Koha::Patron::Images;
$|=1;
my $DEBUG = 0;
my $query = CGI->new;
my $borrowernumber;
@ -63,9 +62,6 @@ if ($query->param('borrowernumber')) {
$borrowernumber = shift;
}
warn "Borrowernumber passed in: $borrowernumber" if $DEBUG;
my $patron_image = Koha::Patron::Images->find($borrowernumber);
# NOTE: Never dump the contents of $imagedata->{'patronimage'} via a warn to a log or nasty

10
members/printslip.pl
View File

@ -41,20 +41,10 @@ use C4::Members;
use C4::Koha;
use Koha::DateUtils;
#use Smart::Comments;
#use Data::Dumper;
use vars qw($debug);
BEGIN {
$debug = $ENV{DEBUG} || 0;
}
my $input = CGI->new;
my $sessionID = $input->cookie("CGISESSID");
my $session = get_session($sessionID);
$debug or $debug = $input->param('debug') || 0;
my $print = $input->param('print');
my $error = $input->param('error');

2
misc/cronjobs/staticfines.pl
View File

@ -59,7 +59,7 @@ my $delay;
my $useborrowerlibrary;
my $borrowernumberlimit;
my $borrowersalreadyapplied; # hashref of borrowers for whom we already applied the fine, so it's only applied once
my $debug = $ENV{'DEBUG'} || 0;
my $debug = 0;
my $bigdebug = 0;
GetOptions(

2
misc/maintenance/UNIMARC_sync_date_created_with_marc_biblio.pl
View File

@ -38,7 +38,7 @@ GetOptions(
'date-created-marc|c:s' => \$date_created_marc,
'date-modified-marc|m:s' => \$date_modified_marc,
);
my $debug = $ENV{DEBUG};
my $debug = 0; # FIXME pass an option for that?
$verbose = 1 if $debug;
# display help ?

2
misc/migration_tools/koha-svc.pl
View File

@ -30,7 +30,7 @@ if ( $#ARGV >= 3 && ! caller ) { # process command-line params only if not calle
url => $url,
user => $user,
password => $password,
debug => $ENV{DEBUG},
debug => 0,
);
if ( ! $file ) {

2
offline_circ/enqueue_koc.pl
View File

@ -37,8 +37,6 @@ use Koha::Items;
use Date::Calc qw( Add_Delta_Days Date_to_Days );
use constant DEBUG => 0;
# this is the file version number that we're coded against.
my $FILE_VERSION = '1.0';

2
offline_circ/process_koc.pl
View File

@ -266,7 +266,7 @@ sub kocIssueItem {
undef, # branch
undef, # datedue - let AddRenewal calculate it automatically
$circ->{'date'}, # issuedate
) unless ($DEBUG);
) unless (DEBUG);
push @output, {
renew => 1,

3
opac/opac-image.pl
View File

@ -32,7 +32,6 @@ use Koha::CoverImages;
$| = 1;
my $DEBUG = 0;
my $data = CGI->new;
my $imagenumber;
@ -72,8 +71,6 @@ if ( C4::Context->preference("OPACLocalCoverImages") ) {
my $cover_images = $biblio->cover_images;
if ( $cover_images->count ) {
$image = $cover_images->next;
} else {
warn "No images for this biblio" if $DEBUG;
}
}
}

1
opac/opac-search.pl
View File

@ -632,7 +632,6 @@ if ($tag) {
my $taglist = get_tags({term=>$tag, approved=>1});
$results_hashref->{biblioserver}->{hits} = scalar (@$taglist);
my @marclist = map { C4::Biblio::GetXmlBiblio( $_->{biblionumber} ) } @$taglist;
$DEBUG and printf STDERR "taglist (%s biblionumber)\nmarclist (%s records)\n", scalar(@$taglist), scalar(@marclist);
$results_hashref->{biblioserver}->{RECORDS} = \@marclist;
# FIXME: tag search and standard search should work together, not exclusively
# FIXME: Because search and standard search don't work together OpacHiddenItems

1
patroncards/edit-batch.pl
View File

@ -20,7 +20,6 @@
use Modern::Perl;
use vars qw($debug);
use CGI qw ( -utf8 );
use autouse 'Data::Dumper' => qw(Dumper);

1
patroncards/manage.pl
View File

@ -19,7 +19,6 @@
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use Modern::Perl;
use vars qw($debug);
use CGI qw ( -utf8 );
use autouse 'Data::Dumper' => qw(Dumper);

6
t/Auth.t
View File

@ -16,7 +16,7 @@
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use Modern::Perl;
use Test::More tests => 13;
use Test::More tests => 12;
use Test::Warn;
use C4::Auth qw / in_iprange /;
@ -35,7 +35,3 @@ ok(!in_iprange("127.0.0.1 8.8.8.8 192.168.2.1/24 192.168.3.1/24 192.168.1.1-192.
ok(in_iprange(""), "blank list given, no preference set - implies everything goes through.");
ok(in_iprange(), "no list given, no preference set - implies everything goes through.");
ok(in_iprange("192.168.1.1/36"), 'simple invalid ip range/36 with remote ip in it');
$ENV{DEBUG} = 1;
warning_like { in_iprange("192.168.1.1/36") }
qr/cidrlookup failed for/,
'noisy simple invalid ip range/36 with remote ip in it';

3
t/db_dependent/00-strict.t
View File

@ -44,9 +44,6 @@ if ( $ENV{KOHA_PROVE_CPUS} ) {
$ncpu = Sys::CPU::cpu_count();
}
print "Using $ncpu CPUs...\n"
if $ENV{DEBUG};
my $pm = Parallel::ForkManager->new($ncpu);
foreach my $d (@dirs) {

2
t/db_dependent/Circulation/dateexpiry.t
View File

@ -32,8 +32,6 @@ $schema->storage->txn_begin;
my $builder = t::lib::TestBuilder->new();
$ENV{ DEBUG } = 0;
my $patron_category = $builder->build({ source => 'Category', value => { category_type => 'P', enrolmentfee => 0 } });
subtest 'Tests for CanBookBeIssued related to dateexpiry' => sub {

4
t/db_dependent/Context.t
View File

@ -4,13 +4,12 @@ use Modern::Perl;
use Test::More;
use Test::MockModule;
use vars qw($debug $koha $dbh $config $ret);
use vars qw($koha $dbh $config $ret);
use t::lib::Mocks;
use Koha::Database;
BEGIN {
$debug = $ENV{DEBUG} || 0;
# Note: The overall number of tests may vary by configuration.
# First we need to check your environmental variables
@ -55,7 +54,6 @@ my @keys = keys %$koha;
my $width = 0;
if (ok(@keys)) {
$width = (sort {$a <=> $b} map {length} @keys)[-1];
$debug and diag "widest key is $width";
}
foreach (sort @keys) {
ok(exists $koha->{$_},

9
tools/scheduler.pl
View File

@ -26,12 +26,6 @@ use CGI qw ( -utf8 );
use C4::Output;
use Koha::DateUtils;;
use vars qw($debug);
BEGIN {
$debug = $ENV{DEBUG} || 0;
}
my $input = CGI->new;
my $base;
@ -115,7 +109,4 @@ $template->param( 'savedreports' => $reports );
$template->param( JOBS => \@jobloop );
my $time = localtime(time);
$template->param( 'time' => $time );
$template->param(
debug => $debug,
);
output_html_with_http_headers $input, $cookie, $template->output;

3
tools/upload-cover-image.pl
View File

@ -51,8 +51,6 @@ use Koha::Items;
use Koha::UploadedFiles;
use C4::Log;
my $debug = 1;
my $input = CGI->new;
my $fileID = $input->param('uploadedfileid');
@ -161,7 +159,6 @@ if ($fileID) {
: ( $line =~ /,/ ) ? ","
: "";
#$debug and warn "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'";