From 3218d5ea84f721ef332f42a5fcb53529f4f0ba92 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Tue, 22 Jun 2021 12:54:15 +0200 Subject: [PATCH] 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 --- C4/Auth.pm | 30 ++---------- C4/Auth_with_cas.pm | 27 ++++------- C4/Auth_with_ldap.pm | 40 +++++++--------- C4/Auth_with_shibboleth.pm | 47 +++++++------------ C4/CourseReserves.pm | 32 +------------ C4/Koha.pm | 5 +- C4/Languages.pm | 3 +- C4/MarcModificationTemplates.pm | 17 ------- C4/Members.pm | 5 +- C4/Members/Statistics.pm | 3 +- C4/Patroncards/Patroncard.pm | 1 - C4/SIP/ILS.pm | 6 --- C4/SIP/ILS/Transaction/FeePayment.pm | 2 - C4/SIP/Sip/Checksum.pm | 5 +- C4/Service.pm | 7 --- Koha/Cache.pm | 11 ----- Koha/Cache/Object.pm | 4 -- Koha/SimpleMARC.pm | 2 - Koha/XSLT/Base.pm | 3 +- catalogue/detail.pl | 2 - catalogue/image.pl | 3 -- cataloguing/value_builder/barcode.pl | 3 -- cataloguing/value_builder/barcode_manual.pl | 3 -- circ/hold-transfer-slip.pl | 7 --- circ/transfer-slip.pl | 7 --- fix-perl-path.PL | 2 +- installer/data/mysql/updatedatabase.pl | 2 - .../bootstrap/en/modules/opac-shelves.tt | 4 -- labels/label-edit-batch.pl | 1 - labels/label-manage.pl | 2 - members/memberentry.pl | 14 +----- members/moremember.pl | 8 ---- members/patronimage.pl | 4 -- members/printslip.pl | 10 ---- misc/cronjobs/staticfines.pl | 2 +- ...MARC_sync_date_created_with_marc_biblio.pl | 2 +- misc/migration_tools/koha-svc.pl | 2 +- offline_circ/enqueue_koc.pl | 2 - offline_circ/process_koc.pl | 2 +- opac/opac-image.pl | 3 -- opac/opac-search.pl | 1 - patroncards/edit-batch.pl | 1 - patroncards/manage.pl | 1 - t/Auth.t | 6 +-- t/db_dependent/00-strict.t | 3 -- t/db_dependent/Circulation/dateexpiry.t | 2 - t/db_dependent/Context.t | 4 +- tools/scheduler.pl | 9 ---- tools/upload-cover-image.pl | 3 -- 49 files changed, 64 insertions(+), 301 deletions(-) diff --git a/C4/Auth.pm b/C4/Auth.pm index 4a7ced06c87..8e49f536739 100644 --- a/C4/Auth.pm +++ b/C4/Auth.pm @@ -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; } diff --git a/C4/Auth_with_cas.pm b/C4/Auth_with_cas.pm index 82d1b383fb7..855766bd0f7 100644 --- a/C4/Auth_with_cas.pm +++ b/C4/Auth_with_cas.pm @@ -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; } } diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index eb61824cd73..0dfae2b3741 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -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,19 @@ 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", + 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 +301,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 +315,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 +355,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 +379,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 +388,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) ); diff --git a/C4/Auth_with_shibboleth.pm b/C4/Auth_with_shibboleth.pm index ef0da6aa6d0..e3af9eb9d82 100644 --- a/C4/Auth_with_shibboleth.pm +++ b/C4/Auth_with_shibboleth.pm @@ -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 { diff --git a/C4/CourseReserves.pm b/C4/CourseReserves.pm index 1c08ad4d5e3..2a6e5545d59 100644 --- a/C4/CourseReserves.pm +++ b/C4/CourseReserves.pm @@ -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 diff --git a/C4/Koha.pm b/C4/Koha.pm index c08ee6ad448..8388005a172 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -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; diff --git a/C4/Languages.pm b/C4/Languages.pm index 8042bcdf3f1..58cf16c1857 100644 --- a/C4/Languages.pm +++ b/C4/Languages.pm @@ -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 diff --git a/C4/MarcModificationTemplates.pm b/C4/MarcModificationTemplates.pm index 50d26a04ae6..a82dcbaed53 100644 --- a/C4/MarcModificationTemplates.pm +++ b/C4/MarcModificationTemplates.pm @@ -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; diff --git a/C4/Members.pm b/C4/Members.pm index c52f18add85..c2ef8012945 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -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); diff --git a/C4/Members/Statistics.pm b/C4/Members/Statistics.pm index 4f640bad20e..e8c5d1fcdcd 100644 --- a/C4/Members/Statistics.pm +++ b/C4/Members/Statistics.pm @@ -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); diff --git a/C4/Patroncards/Patroncard.pm b/C4/Patroncards/Patroncard.pm index 12a5ce36a3a..6482198d322 100644 --- a/C4/Patroncards/Patroncard.pm +++ b/C4/Patroncards/Patroncard.pm @@ -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$//; diff --git a/C4/SIP/ILS.pm b/C4/SIP/ILS.pm index 112eb201c38..13509cc6bd5 100644 --- a/C4/SIP/ILS.pm +++ b/C4/SIP/ILS.pm @@ -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. diff --git a/C4/SIP/ILS/Transaction/FeePayment.pm b/C4/SIP/ILS/Transaction/FeePayment.pm index 47f868627e0..7748b1a1d8f 100644 --- a/C4/SIP/ILS/Transaction/FeePayment.pm +++ b/C4/SIP/ILS/Transaction/FeePayment.pm @@ -25,8 +25,6 @@ use Koha::Account::Lines; use parent qw(C4::SIP::ILS::Transaction); -our $debug = 0; - my %fields = (); sub new { diff --git a/C4/SIP/Sip/Checksum.pm b/C4/SIP/Sip/Checksum.pm index c2b1e6b0df9..37ee4b645ba 100644 --- a/C4/SIP/Sip/Checksum.pm +++ b/C4/SIP/Sip/Checksum.pm @@ -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 } diff --git a/C4/Service.pm b/C4/Service.pm index bdb2ba17ff1..790f147f073 100644 --- a/C4/Service.pm +++ b/C4/Service.pm @@ -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; } diff --git a/Koha/Cache.pm b/Koha/Cache.pm index c22fd4efaef..ec153baff9f 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -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 diff --git a/Koha/Cache/Object.pm b/Koha/Cache/Object.pm index 954e51ab6d5..f232541b378 100644 --- a/Koha/Cache/Object.pm +++ b/Koha/Cache/Object.pm @@ -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'} ) ) diff --git a/Koha/SimpleMARC.pm b/Koha/SimpleMARC.pm index 8b2fc651c4d..995e3921237 100644 --- a/Koha/SimpleMARC.pm +++ b/Koha/SimpleMARC.pm @@ -42,8 +42,6 @@ our @EXPORT = qw( ); -our $debug = 0; - =head1 NAME SimpleMARC - Perl module for making simple MARC record alterations. diff --git a/Koha/XSLT/Base.pm b/Koha/XSLT/Base.pm index 84fe8d5806f..7b6134994f0 100644 --- a/Koha/XSLT/Base.pm +++ b/Koha/XSLT/Base.pm @@ -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 diff --git a/catalogue/detail.pl b/catalogue/detail.pl index 0ba37e7253c..c282ecf6b87 100755 --- a/catalogue/detail.pl +++ b/catalogue/detail.pl @@ -502,8 +502,6 @@ $template->param( searchid => scalar $query->param('searchid'), ); -# $debug and $template->param(debug_display => 1); - # Lists if (C4::Context->preference("virtualshelves") ) { diff --git a/catalogue/image.pl b/catalogue/image.pl index 58358a78c42..62e1ebb7ca9 100755 --- a/catalogue/image.pl +++ b/catalogue/image.pl @@ -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; } } } diff --git a/cataloguing/value_builder/barcode.pl b/cataloguing/value_builder/barcode.pl index bf5b0739dd2..6a7b6222bed 100755 --- a/cataloguing/value_builder/barcode.pl +++ b/cataloguing/value_builder/barcode.pl @@ -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||; diff --git a/cataloguing/value_builder/barcode_manual.pl b/cataloguing/value_builder/barcode_manual.pl index 91c5f186a8b..907ce3d482d 100755 --- a/cataloguing/value_builder/barcode_manual.pl +++ b/cataloguing/value_builder/barcode_manual.pl @@ -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||; diff --git a/circ/hold-transfer-slip.pl b/circ/hold-transfer-slip.pl index c0a3b6ea4cc..5d21f3d23ab 100755 --- a/circ/hold-transfer-slip.pl +++ b/circ/hold-transfer-slip.pl @@ -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, } ); diff --git a/circ/transfer-slip.pl b/circ/transfer-slip.pl index 1cbc98e0922..b0b6ba437ec 100755 --- a/circ/transfer-slip.pl +++ b/circ/transfer-slip.pl @@ -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, } ); diff --git a/fix-perl-path.PL b/fix-perl-path.PL index 2adfa35faaa..f9db358e5a4 100644 --- a/fix-perl-path.PL +++ b/fix-perl-path.PL @@ -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'; diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index 5a604db32e4..95239e498af 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -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, diff --git a/koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-shelves.tt b/koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-shelves.tt index 83c0758bdcd..9c1e19047d7 100644 --- a/koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-shelves.tt +++ b/koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-shelves.tt @@ -817,10 +817,6 @@ - -
- - [% INCLUDE 'opac-bottom.inc' %] [% BLOCK jsinclude %] [% Asset.js("lib/hc-sticky.js") | $raw %] diff --git a/labels/label-edit-batch.pl b/labels/label-edit-batch.pl index 687402d99f0..c263bc4bab2 100755 --- a/labels/label-edit-batch.pl +++ b/labels/label-edit-batch.pl @@ -19,7 +19,6 @@ # along with Koha; if not, see . use Modern::Perl; -use vars qw($debug); use CGI qw ( -utf8 ); diff --git a/labels/label-manage.pl b/labels/label-manage.pl index 2dbbbb3815a..05d57c973c6 100755 --- a/labels/label-manage.pl +++ b/labels/label-manage.pl @@ -20,8 +20,6 @@ use Modern::Perl; -use vars qw($debug); - use CGI qw ( -utf8 ); use Data::Dumper; diff --git a/members/memberentry.pl b/members/memberentry.pl index da8a324c784..cb5bbf9a3f2 100755 --- a/members/memberentry.pl +++ b/members/memberentry.pl @@ -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 diff --git a/members/moremember.pl b/members/moremember.pl index cbe3652f94f..e84d60c4488 100755 --- a/members/moremember.pl +++ b/members/moremember.pl @@ -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'); diff --git a/members/patronimage.pl b/members/patronimage.pl index 42a82b92838..da62b875536 100755 --- a/members/patronimage.pl +++ b/members/patronimage.pl @@ -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 diff --git a/members/printslip.pl b/members/printslip.pl index 58a41adeb74..3fcaf218138 100755 --- a/members/printslip.pl +++ b/members/printslip.pl @@ -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'); diff --git a/misc/cronjobs/staticfines.pl b/misc/cronjobs/staticfines.pl index e31537925a6..0966cb6134a 100755 --- a/misc/cronjobs/staticfines.pl +++ b/misc/cronjobs/staticfines.pl @@ -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( diff --git a/misc/maintenance/UNIMARC_sync_date_created_with_marc_biblio.pl b/misc/maintenance/UNIMARC_sync_date_created_with_marc_biblio.pl index 5e0cd37fcc4..23ac37ec28f 100755 --- a/misc/maintenance/UNIMARC_sync_date_created_with_marc_biblio.pl +++ b/misc/maintenance/UNIMARC_sync_date_created_with_marc_biblio.pl @@ -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 ? diff --git a/misc/migration_tools/koha-svc.pl b/misc/migration_tools/koha-svc.pl index facad63bcdd..24326c19c82 100755 --- a/misc/migration_tools/koha-svc.pl +++ b/misc/migration_tools/koha-svc.pl @@ -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 ) { diff --git a/offline_circ/enqueue_koc.pl b/offline_circ/enqueue_koc.pl index 7ca5699f2ec..a6e3b0871d4 100755 --- a/offline_circ/enqueue_koc.pl +++ b/offline_circ/enqueue_koc.pl @@ -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'; diff --git a/offline_circ/process_koc.pl b/offline_circ/process_koc.pl index ce2c6c5524d..ba61c775344 100755 --- a/offline_circ/process_koc.pl +++ b/offline_circ/process_koc.pl @@ -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, diff --git a/opac/opac-image.pl b/opac/opac-image.pl index 73426912b9f..56cf552eb85 100755 --- a/opac/opac-image.pl +++ b/opac/opac-image.pl @@ -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; } } } diff --git a/opac/opac-search.pl b/opac/opac-search.pl index b03b6d0fbe6..cde8b6e555c 100755 --- a/opac/opac-search.pl +++ b/opac/opac-search.pl @@ -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 diff --git a/patroncards/edit-batch.pl b/patroncards/edit-batch.pl index a3dcd2df2d3..7cab1a7cd30 100755 --- a/patroncards/edit-batch.pl +++ b/patroncards/edit-batch.pl @@ -20,7 +20,6 @@ use Modern::Perl; -use vars qw($debug); use CGI qw ( -utf8 ); use autouse 'Data::Dumper' => qw(Dumper); diff --git a/patroncards/manage.pl b/patroncards/manage.pl index 456713c34c8..a2e9546428b 100755 --- a/patroncards/manage.pl +++ b/patroncards/manage.pl @@ -19,7 +19,6 @@ # along with Koha; if not, see . use Modern::Perl; -use vars qw($debug); use CGI qw ( -utf8 ); use autouse 'Data::Dumper' => qw(Dumper); diff --git a/t/Auth.t b/t/Auth.t index 5157b94682f..a02f45b0088 100755 --- a/t/Auth.t +++ b/t/Auth.t @@ -16,7 +16,7 @@ # along with Koha; if not, see . 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'; diff --git a/t/db_dependent/00-strict.t b/t/db_dependent/00-strict.t index c1074b204bc..74212e8f8a9 100755 --- a/t/db_dependent/00-strict.t +++ b/t/db_dependent/00-strict.t @@ -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) { diff --git a/t/db_dependent/Circulation/dateexpiry.t b/t/db_dependent/Circulation/dateexpiry.t index 9a668947e19..599abfa93df 100755 --- a/t/db_dependent/Circulation/dateexpiry.t +++ b/t/db_dependent/Circulation/dateexpiry.t @@ -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 { diff --git a/t/db_dependent/Context.t b/t/db_dependent/Context.t index 532f6cae70e..433510b2cb6 100755 --- a/t/db_dependent/Context.t +++ b/t/db_dependent/Context.t @@ -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->{$_}, diff --git a/tools/scheduler.pl b/tools/scheduler.pl index 4e1d5d3febc..b6a39532cc3 100755 --- a/tools/scheduler.pl +++ b/tools/scheduler.pl @@ -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; diff --git a/tools/upload-cover-image.pl b/tools/upload-cover-image.pl index 74fd67a3e75..84fc4a416df 100755 --- a/tools/upload-cover-image.pl +++ b/tools/upload-cover-image.pl @@ -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'"; -- 2.20.1