| File: | C4/Debug.pm | 
| Coverage: | 68.5% | 
| line | stmt | bran | cond | sub | time | code | 
|---|---|---|---|---|---|---|
| 1 | package C4::Debug; | |||||
| 2 | ||||||
| 3 | # Copyright 2000-2002 Katipo Communications | |||||
| 4 | # | |||||
| 5 | # This file is part of Koha. | |||||
| 6 | # | |||||
| 7 | # Koha is free software; you can redistribute it and/or modify it under the | |||||
| 8 | # terms of the GNU General Public License as published by the Free Software | |||||
| 9 | # Foundation; either version 2 of the License, or (at your option) any later | |||||
| 10 | # version. | |||||
| 11 | # | |||||
| 12 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | |||||
| 13 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | |||||
| 14 | # A PARTICULAR PURPOSE. See the GNU General Public License for more details. | |||||
| 15 | # | |||||
| 16 | # You should have received a copy of the GNU General Public License along | |||||
| 17 | # with Koha; if not, write to the Free Software Foundation, Inc., | |||||
| 18 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |||||
| 19 | ||||||
| 20 | 120 120 120  | 45356 518 4582  | use strict; | |||
| 21 | 120 120 120  | 1011 503 5449  | use warnings; | |||
| 22 | ||||||
| 23 | 120 120 120  | 814 401 6541  | use Exporter; | |||
| 24 | ||||||
| 25 | # use CGI; | |||||
| 26 | 120 120 120  | 758 358 13231  | use vars qw($VERSION @ISA @EXPORT $debug $cgi_debug); | |||
| 27 | # use vars qw(@EXPORT_OK %EXPORT_TAGS); | |||||
| 28 | ||||||
| 29 | BEGIN { | |||||
| 30 | 120  | 593  | $VERSION = 1.00; # set the version for version checking | |||
| 31 | 120  | 1522  | @ISA = qw(Exporter); | |||
| 32 | 120  | 28260  | @EXPORT = qw($debug $cgi_debug); | |||
| 33 | # @EXPOR_OK = qw(); | |||||
| 34 | # %EXPORT_TAGS = ( all=>[qw($debug $cgi_debug)], ); | |||||
| 35 | } | |||||
| 36 | ||||||
| 37 | BEGIN { | |||||
| 38 | # this stuff needs a begin block too, since dependencies might alter their compilations | |||||
| 39 | # for example, adding DataDumper | |||||
| 40 | ||||||
| 41 | 120  | 2947  | $debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0; | |||
| 42 | ||||||
| 43 | # CGI->new conflicts w/ some upload functionality, | |||||
| 44 | # since we would get the "first" CGI object here. | |||||
| 45 | # Instead we have to parse for ourselves if we want QUERY_STRING triggers. | |||||
| 46 | # my $query = CGI->new(); # conflicts! | |||||
| 47 | # $cgi_debug = $ENV{KOHA_CGI_DEBUG} || $query->param('debug') || 0; | |||||
| 48 | ||||||
| 49 | 120  | 1217  | $cgi_debug = $ENV{KOHA_CGI_DEBUG} || 0; | |||
| 50 | 120  | 1619  | unless ($cgi_debug or not $ENV{QUERY_STRING}) { | |||
| 51 | 0  | 0  | foreach (split /\&/, $ENV{QUERY_STRING}) { | |||
| 52 | 0  | 0  | /^debug\=(.+)$/ or next; | |||
| 53 | 0  | 0  | $cgi_debug = $1; | |||
| 54 | 0  | 0  | last; | |||
| 55 | } | |||||
| 56 | } | |||||
| 57 | 120  | 1483  | unless ($debug =~ /^\d$/) { | |||
| 58 | 0  | 0  | warn "Invalid \$debug value attempted: $debug"; | |||
| 59 | 0  | 0  | $debug=1; | |||
| 60 | } | |||||
| 61 | 120  | 3737  | unless ($cgi_debug =~ /^\d$/) { | |||
| 62 | 0  | $debug and | ||||
| 63 | warn "Invalid \$cgi_debug value attempted: $cgi_debug"; | |||||
| 64 | 0  | $cgi_debug=1; | ||||
| 65 | } | |||||
| 66 | } | |||||
| 67 | ||||||
| 68 | # sub import { | |||||
| 69 | # print STDERR __PACKAGE__ . " (Debug) import @_\n"; | |||||
| 70 | # C4::Debug->export_to_level(1, @_); | |||||
| 71 | # } | |||||
| 72 | ||||||
| 73 | 1; | |||||