@@ -, +, @@ --- 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(-) --- a/C4/Auth.pm +++ a/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; } --- a/C4/Auth_with_cas.pm +++ a/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; } } --- a/C4/Auth_with_ldap.pm +++ a/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) ); --- a/C4/Auth_with_shibboleth.pm +++ a/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 { --- a/C4/CourseReserves.pm +++ a/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 --- a/C4/Koha.pm +++ a/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; --- a/C4/Languages.pm +++ a/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 --- a/C4/MarcModificationTemplates.pm +++ a/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; --- a/C4/Members.pm +++ a/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); --- a/C4/Members/Statistics.pm +++ a/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); --- a/C4/Patroncards/Patroncard.pm +++ a/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$//; --- a/C4/SIP/ILS.pm +++ a/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. --- a/C4/SIP/ILS/Transaction/FeePayment.pm +++ a/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 { --- a/C4/SIP/Sip/Checksum.pm +++ a/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 } --- a/C4/Service.pm +++ a/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; } --- a/Koha/Cache.pm +++ a/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 --- a/Koha/Cache/Object.pm +++ a/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'} ) ) --- a/Koha/SimpleMARC.pm +++ a/Koha/SimpleMARC.pm @@ -42,8 +42,6 @@ our @EXPORT = qw( ); -our $debug = 0; - =head1 NAME SimpleMARC - Perl module for making simple MARC record alterations. --- a/Koha/XSLT/Base.pm +++ a/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 --- a/catalogue/detail.pl +++ a/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") ) { --- a/catalogue/image.pl +++ a/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; } } } --- a/cataloguing/value_builder/barcode.pl +++ a/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||; --- a/cataloguing/value_builder/barcode_manual.pl +++ a/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||; --- a/circ/hold-transfer-slip.pl +++ a/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, } ); --- a/circ/transfer-slip.pl +++ a/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, } ); --- a/fix-perl-path.PL +++ a/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'; --- a/installer/data/mysql/updatedatabase.pl +++ a/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, --- a/koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-shelves.tt +++ a/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 %] --- a/labels/label-edit-batch.pl +++ a/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 ); --- a/labels/label-manage.pl +++ a/labels/label-manage.pl @@ -20,8 +20,6 @@ use Modern::Perl; -use vars qw($debug); - use CGI qw ( -utf8 ); use Data::Dumper; --- a/members/memberentry.pl +++ a/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 --- a/members/moremember.pl +++ a/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'); --- a/members/patronimage.pl +++ a/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 --- a/members/printslip.pl +++ a/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'); --- a/misc/cronjobs/staticfines.pl +++ a/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( --- a/misc/maintenance/UNIMARC_sync_date_created_with_marc_biblio.pl +++ a/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 ? --- a/misc/migration_tools/koha-svc.pl +++ a/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 ) { --- a/offline_circ/enqueue_koc.pl +++ a/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'; --- a/offline_circ/process_koc.pl +++ a/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, --- a/opac/opac-image.pl +++ a/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; } } } --- a/opac/opac-search.pl +++ a/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 --- a/patroncards/edit-batch.pl +++ a/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); --- a/patroncards/manage.pl +++ a/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); --- a/t/Auth.t +++ a/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'; --- a/t/db_dependent/00-strict.t +++ a/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) { --- a/t/db_dependent/Circulation/dateexpiry.t +++ a/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 { --- a/t/db_dependent/Context.t +++ a/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->{$_}, --- a/tools/scheduler.pl +++ a/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; --- a/tools/upload-cover-image.pl +++ a/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'"; --