File Coverage

File:C4/Debug.pm
Coverage:68.5%

linestmtbrancondsubtimecode
1package 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
61
61
61
18953
201
2174
use strict;
21
61
61
61
428
198
2543
use warnings;
22
23
61
61
61
374
204
3377
use Exporter;
24
25# use CGI;
26
61
61
61
398
174
6784
use vars qw($VERSION @ISA @EXPORT $debug $cgi_debug);
27# use vars qw(@EXPORT_OK %EXPORT_TAGS);
28
29BEGIN {
30
61
301
        $VERSION = 1.00; # set the version for version checking
31
61
837
        @ISA = qw(Exporter);
32
61
13610
        @EXPORT = qw($debug $cgi_debug);
33        # @EXPOR_OK = qw();
34        # %EXPORT_TAGS = ( all=>[qw($debug $cgi_debug)], );
35}
36
37BEGIN {
38        # this stuff needs a begin block too, since dependencies might alter their compilations
39        # for example, adding DataDumper
40
41
61
1340
        $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
61
746
        $cgi_debug = $ENV{KOHA_CGI_DEBUG} || 0;
50
61
689
        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
61
453
        unless ($debug =~ /^\d$/) {
58
0
0
                warn "Invalid \$debug value attempted: $debug";
59
0
0
                $debug=1;
60        }
61
61
1702
        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
731;