From 41a8005d1013815d312089c00e9e5464768e1332 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 Signed-off-by: Martin Renvoize Signed-off-by: Marcel de Rooy 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 --- C4/Auth.pm | 30 ++---------- C4/Auth_with_cas.pm | 27 ++++------- C4/Auth_with_ldap.pm | 41 +++++++--------- 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(+), 302 deletions(-) diff --git a/C4/Auth.pm b/C4/Auth.pm index 4a7ced06c8..8e49f53673 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 82d1b383fb..855766bd0f 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 eb61824cd7..296f4099eb 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,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) ); diff --git a/C4/Auth_with_shibboleth.pm b/C4/Auth_with_shibboleth.pm index ef0da6aa6d..e3af9eb9d8 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 1c08ad4d5e..2a6e5545d5 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 c08ee6ad44..8388005a17 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 8042bcdf3f..58cf16c185 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 50d26a04ae..a82dcbaed5 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 c52f18add8..c2ef801294 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 4f640bad20..e8c5d1fcdc 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 12a5ce36a3..6482198d32 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 112eb201c3..13509cc6bd 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 47f868627e..7748b1a1d8 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 c2b1e6b0df..cba51a5c22 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 bdb2ba17ff..790f147f07 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 c22fd4efae..ec153baff9 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 954e51ab6d..f232541b37 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 8b2fc651c4..995e392123 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 84fe8d5806..7b6134994f 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 0ba37e7253..c282ecf6b8 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 58358a78c4..62e1ebb7ca 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 bf5b0739dd..6a7b6222be 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 91c5f186a8..907ce3d482 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 c0a3b6ea4c..5d21f3d23a 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 1cbc98e092..b0b6ba437e 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 2adfa35faa..f9db358e5a 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 7b33b383a2..d31ec08766 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 83c0758bdc..9c1e19047d 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 687402d99f..c263bc4bab 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 2dbbbb3815..05d57c973c 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 da8a324c78..cb5bbf9a3f 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 cbe3652f94..e84d60c448 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 42a82b9283..da62b87553 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 58a41adeb7..3fcaf21813 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 e31537925a..0966cb6134 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 5e0cd37fcc..23ac37ec28 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 facad63bcd..24326c19c8 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 7ca5699f2e..a6e3b0871d 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 ce2c6c5524..ba61c77534 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 73426912b9..56cf552eb8 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 b03b6d0fbe..cde8b6e555 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 a3dcd2df2d..7cab1a7cd3 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 456713c34c..a2e9546428 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 5157b94682..a02f45b008 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 c1074b204b..74212e8f8a 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 9a668947e1..599abfa93d 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 532f6cae70..433510b2cb 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 4e1d5d3feb..b6a39532cc 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 74fd67a3e7..84fc4a416d 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.39.5