Move $debug_allowed to CGI as a real constant and modify all debug() calls

with a if DEBUG so that perl can possibly optimise them away completly

diff --git a/cgi-bin/dispatcher.pl b/cgi-bin/dispatcher.pl
index 3873c4996efbb442b519a3a6caaf04a93a6572c6..a4b3e3960aec19ab46735e4d6bd9b977549211ee 100755 (executable)
--- a/cgi-bin/dispatcher.pl
+++ b/cgi-bin/dispatcher.pl
@@ -54,9 +54,7 @@ if ($ARGV[0] && ($ARGV[0] eq 'php')) {
 
 my $pet0 = new Benchmark;
 my $tet0 = new Benchmark;
-# use this to disable debugging in production mode completly
-my $debug_allowed = 1;
-my $debug = $debug_allowed && $input->param("debug");
+my $debug = DEBUG && $input->param("debug");
 $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
 $Packages::CGI::debug = $debug;
 
@@ -192,14 +190,14 @@ my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
 my $locale = get_locale($opts{lang});
 my $charset = get_charset($opts{lang});
 setlocale ( LC_ALL, $locale )
-    or do { debug( "couldn't set locale $locale, using default" );
+    or do { debug( "couldn't set locale $locale, using default" ) if DEBUG;
            setlocale( LC_ALL, get_locale() )
                or do {
-                   debug( "couldn't set default locale either" );
+                   debug( "couldn't set default locale either" ) if DEBUG;
                    setlocale( LC_ALL, "C" );
                };
        };
-debug( "locale=$locale charset=$charset", 2 );
+debug( "locale=$locale charset=$charset", 2 ) if DEBUG;
 
 $opts{h_suites} = { map { $_ => 1 } @suites };
 $opts{h_sections} = { map { $_ => 1 } @sections };
@@ -220,7 +218,7 @@ if ($opts{searchon} eq 'contents' or $opts{searchon} eq 'filenames') {
 
 my $pet1 = new Benchmark;
 my $petd = timediff($pet1, $pet0);
-debug( "Parameter evaluation took ".timestr($petd) );
+debug( "Parameter evaluation took ".timestr($petd) ) if DEBUG;
 
 print $input->header( -charset => $charset );
 
@@ -252,7 +250,7 @@ print $menu||'';
 print_errors();
 print_hints();
 print_msgs();
-print_debug();
+print_debug() if DEBUG;
 print_notes();
 
 unless (@Packages::CGI::fatal_errors) {

diff --git a/lib/Packages/CGI.pm b/lib/Packages/CGI.pm
index e15e510f017edd512b27cb53426825844a524be4..66b442d79b4ec295e45020e31fb2732e95b79702 100644 (file)
--- a/lib/Packages/CGI.pm
+++ b/lib/Packages/CGI.pm
@@ -4,8 +4,10 @@ use Exporter;
 our @ISA = qw( Exporter );
 our @EXPORT = qw( fatal_error error hint debug msg note
                  print_errors print_hints print_debug print_msgs
-                 print_notes );
+                 print_notes DEBUG );
 
+# define this to 0 in production mode
+use constant DEBUG => 1;
 our $debug = 0;
 
 our (@fatal_errors, @errors, @debug, @msgs, @hints, @notes);

diff --git a/lib/Packages/Config.pm b/lib/Packages/Config.pm
index 0645d5833cdefe4cfbefd6050e55319b88112ad0..538e912e855a965485eeffde8f4c9d8353f5befb 100644 (file)
--- a/lib/Packages/Config.pm
+++ b/lib/Packages/Config.pm
@@ -60,7 +60,7 @@ sub init {
            @ARCHITECTURES = split(/\s+/, $1) if /^\s*architectures="?([^\"]*)"?\s*$/o;
        }
        close (C);
-       debug( "read config ($modtime > $config_read_time)" );
+       debug( "read config ($modtime > $config_read_time)" ) if DEBUG;
        $config_read_time = $modtime;
     }
     $DBDIR = "$TOPDIR/files/db";

diff --git a/lib/Packages/DB.pm b/lib/Packages/DB.pm
index e959f60298182b33c722bd5bf1af680f64fae538..0c0ebdc2288a24f2196f75dc395e41036c1f9388 100644 (file)
--- a/lib/Packages/DB.pm
+++ b/lib/Packages/DB.pm
@@ -42,7 +42,7 @@ sub init {
        O_RDONLY, 0666, $DB_BTREE
            or die "couldn't tie postfix db $DBDIR/source_postfixes.db: $!";
 
-       debug( "tied databases ($dbmodtime > $db_read_time)" );
+       debug( "tied databases ($dbmodtime > $db_read_time)" ) if DEBUG;
        $db_read_time = $dbmodtime;
     }
 }

diff --git a/lib/Packages/DoSearch.pm b/lib/Packages/DoSearch.pm
index 64160c13b52183081957b38f45749242adb636ad..776b288fd9745169e84582b15fa3a2db85c1ec6d 100644 (file)
--- a/lib/Packages/DoSearch.pm
+++ b/lib/Packages/DoSearch.pm
@@ -81,10 +81,10 @@ sub do_search {
     }
     
 #    use Data::Dumper;
-#    debug( join( "", Dumper( \@results, \@non_results )) );
+#    debug( join( "", Dumper( \@results, \@non_results )) ) if DEBUG;
     my $st1 = new Benchmark;
     my $std = timediff($st1, $st0);
-    debug( "Search took ".timestr($std) );
+    debug( "Search took ".timestr($std) ) if DEBUG;
     
     my $suite_wording = $suites_enc eq "all" ? "all suites"
        : "suite(s) <em>$suites_enc</em>";

diff --git a/lib/Packages/DoSearchContents.pm b/lib/Packages/DoSearchContents.pm
index cbca011230b39c8e18763d1989d3032f3d4da904..e86fc789783ef06dcecd7e9442535db7530f4c78 100644 (file)
--- a/lib/Packages/DoSearchContents.pm
+++ b/lib/Packages/DoSearchContents.pm
@@ -99,7 +99,7 @@ sub do_search_contents {
     
        my $st1 = new Benchmark;
        my $std = timediff($st1, $st0);
-       debug( "Search took ".timestr($std) );
+       debug( "Search took ".timestr($std) ) if DEBUG;
     }
     
     my $suite_wording = $suites_enc eq "all" ? "all suites"
@@ -164,7 +164,7 @@ sub searchfile
     my ($results, $kw, $nres, $reverses) = @_;
 
     my ($key, $value) = ($kw, "");
-    debug( "searchfile: kw=$kw", 1 );
+    debug( "searchfile: kw=$kw", 1 ) if DEBUG;
     for (my $status = $reverses->seq($key, $value, R_CURSOR);
        $status == 0;
        $status =  $reverses->seq( $key, $value, R_NEXT)) {
@@ -172,7 +172,7 @@ sub searchfile
        # FIXME: what's the most efficient "is prefix of" thingy? We only want to know
        # whether $kw is or is not a prefix of $key
        last unless index($key, $kw) == 0;
-       debug( "found $key", 2 );
+       debug( "found $key", 2 ) if DEBUG;
 
        my @hits = split /\0/o, $value;
        push @$results, [ scalar reverse($key), @hits ];

diff --git a/lib/Packages/DoShow.pm b/lib/Packages/DoShow.pm
index b375977a0b8628abf0059c404c169d2dfe114f54..08eb376d236ddb237999af2258cae7048eabb64d 100644 (file)
--- a/lib/Packages/DoShow.pm
+++ b/lib/Packages/DoShow.pm
@@ -97,7 +97,7 @@ sub do_show {
            } else {
                unless ($opts->{source}) {
                    for my $entry (@results) {
-                       debug( join(":", @$entry), 1 );
+                       debug( join(":", @$entry), 1 ) if DEBUG;
                        my (undef, $archive, undef, $arch, $section, $subsection,
                            $priority, $version, $provided_by) = @$entry;
                        
@@ -106,7 +106,7 @@ sub do_show {
                            $data{package} = $pkg;
                            $data{architecture} = $arch;
                            $data{version} = $version;
-                           $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 );
+                           $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 ) if DEBUG;
                        } else {
                            $page->add_provided_by([split /\s+/, $provided_by]);
                        }
@@ -116,14 +116,14 @@ sub do_show {
                        $version = $page->{newest};
                        my $source = $page->get_newest( 'source' );
                        $archive = $page->get_newest( 'archive' );
-                       debug( "find source package: source=$source", 1);
+                       debug( "find source package: source=$source", 1) if DEBUG;
                        my $src_data = $sources_all{"$archive $suite $source"};
                        $page->add_src_data( $source, $src_data )
                            if $src_data;
 
                        my $st1 = new Benchmark;
                        my $std = timediff($st1, $st0);
-                       debug( "Data search and merging took ".timestr($std) );
+                       debug( "Data search and merging took ".timestr($std) ) if DEBUG;
 
                        my $did = $page->get_newest( 'description' );
                        $section = $page->get_newest( 'section' );
@@ -288,19 +288,19 @@ sub do_show {
                    } # else (unless $page->is_virtual)
                } else { # unless $opts->{source}
                    for my $entry (@results) {
-                       debug( join(":", @$entry), 1 );
+                       debug( join(":", @$entry), 1 ) if DEBUG;
                        my (undef, $archive, undef, $section, $subsection,
                            $priority, $version) = @$entry;
                        
                        my $data = $sources_all{"$archive $suite $pkg"};
                        $page->merge_data($pkg, $suite, $archive, $data)
-                           or debug( "Merging $pkg $version FAILED", 2 );
+                           or debug( "Merging $pkg $version FAILED", 2 ) if DEBUG;
                    }
                    $version = $page->{version};
 
                    my $st1 = new Benchmark;
                    my $std = timediff($st1, $st0);
-                   debug( "Data search and merging took ".timestr($std) );
+                   debug( "Data search and merging took ".timestr($std) ) if DEBUG;
 
                    $archive = $page->get_newest( 'archive' );
                    $section = $page->get_newest( 'section' );
@@ -426,7 +426,7 @@ sub do_show {
     }
 
 #    use Data::Dumper;
-#    debug( "Final page object:\n".Dumper($page), 3 );
+#    debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
 
     my $title = $opts->{source} ?
        _g( "Details of source package <em>%s</em> in %s" ) :

diff --git a/lib/Packages/HTML.pm b/lib/Packages/HTML.pm
index 859467a9da06daf65cf19497c5fc2d5cb9ab6b00..28dbb76e64a0a7c4759ae80432dce98fd83b076b 100644 (file)
--- a/lib/Packages/HTML.pm
+++ b/lib/Packages/HTML.pm
@@ -249,7 +249,7 @@ sub print_deps {
     my $one_archive = @{$opts->{archive}} > 1 ? '': $opts->{archive}[0];
 
 #    use Data::Dumper;
-#    debug( "print_deps called:\n".Dumper( $pkg, $relations, \$type ), 3 );
+#    debug( "print_deps called:\n".Dumper( $pkg, $relations, \$type ), 3 ) if DEBUG;
 
     foreach my $rel (@$relations) {
        my $is_old_pkgs = $rel->[0];

diff --git a/lib/Packages/Page.pm b/lib/Packages/Page.pm
index c2aff059ff468ac324fb00e6ae98c4ba4d188bff..c3e20d24e94393580d6209ea46f93e4cb1014e42 100644 (file)
--- a/lib/Packages/Page.pm
+++ b/lib/Packages/Page.pm
@@ -107,10 +107,10 @@ sub merge_package {
     ($data->{package} && $data->{version} && $data->{architecture}) || return;
     $self->{package} ||= $data->{package};
     ($self->{package} eq $data->{package}) || return;
-    debug( "merge package $data->{package}/$data->{version}/$data->{architecture} into $self (".($self->{newest}||'').")", 2 );
+    debug( "merge package $data->{package}/$data->{version}/$data->{architecture} into $self (".($self->{newest}||'').")", 2 ) if DEBUG;
 
     unless ($self->{newest}) {
-       debug( "package $data->{package}/$data->{version}/$data->{architecture} is first to merge", 3 );
+       debug( "package $data->{package}/$data->{version}/$data->{architecture} is first to merge", 3 ) if DEBUG;
        foreach my $key (@TAKE_NEWEST) {
            $self->{data}{$key} = $data->{$key};
        }
@@ -126,7 +126,7 @@ sub merge_package {
         return 1;
     }
 
-    debug( "package $data->{package}/$data->{version}/$data->{architecture} is subsequent merge", 3 );
+    debug( "package $data->{package}/$data->{version}/$data->{architecture} is subsequent merge", 3 ) if DEBUG;
     my $is_newest;
     if ($is_newest =
        (version_cmp( $data->{version}, $self->{newest} ) > 0)) {
@@ -135,7 +135,7 @@ sub merge_package {
            $self->{data}{$key} = $data->{$key};
        }
     }
-    debug( "is_newest= ".($is_newest||0), 3 );
+    debug( "is_newest= ".($is_newest||0), 3 ) if DEBUG;
     if (!$self->{versions}{$data->{architecture}}
        || $is_newest
        || (version_cmp( $data->{version},
@@ -221,14 +221,14 @@ sub get_dep_field {
     foreach my $a ( @architectures ) {
        next unless exists $self->{dep_fields}{$a}{$dep_field};
        my ($a_deps_norm, $a_deps) = @{$self->{dep_fields}{$a}{$dep_field}};
-#      debug( "get_dep_field: $dep_field/$a: ".Dumper($a_deps_norm,$a_deps), 3 );
+#      debug( "get_dep_field: $dep_field/$a: ".Dumper($a_deps_norm,$a_deps), 3 ) if DEBUG;
        for ( my $i=0; $i < @$a_deps; $i++ ) { # splitted by ,      
            $dep_pkgs{$a_deps_norm->[$i]} = $a_deps->[$i];
            $arch_deps{$a}{$a_deps_norm->[$i]}++;
        }
     }
     @architectures = sort keys %arch_deps;
- #   debug( "get_dep_field called:\n ".Dumper( \%dep_pkgs, \%arch_deps ), 3 );
+ #   debug( "get_dep_field called:\n ".Dumper( \%dep_pkgs, \%arch_deps ), 3 ) if DEBUG;
     
     my @deps;
     if ( %dep_pkgs ) {

diff --git a/lib/Packages/Search.pm b/lib/Packages/Search.pm
index 931747c618ed84b4863f9d3a183fbff349983835..d04f44a3992507509be58892b857da7c9a693196 100644 (file)
--- a/lib/Packages/Search.pm
+++ b/lib/Packages/Search.pm
@@ -78,7 +78,7 @@ sub parse_params {
     my %params_ret = ( values => {}, errors => {} );
     my %params;
     if ($USE_PAGED_MODE) {
-        debug( "Use PAGED_MODE", 2 );
+        debug( "Use PAGED_MODE", 2 ) if DEBUG;
         %params = %$params_def;
         foreach (keys %page_params) {
             delete $params{$_};
@@ -90,7 +90,7 @@ sub parse_params {
 
     foreach my $param ( keys %params ) {
        
-       debug( "Param <strong>$param</strong>", 2 );
+       debug( "Param <strong>$param</strong>", 2 ) if DEBUG;
 
        my $p_value_orig = $cgi->param($param);
 
@@ -104,11 +104,11 @@ sub parse_params {
 
        my @p_value = ($p_value_orig);
 
-       debug( "Value (Orig) ".($p_value_orig||""), 2 );
+       debug( "Value (Orig) ".($p_value_orig||""), 2 ) if DEBUG;
 
        if ($params_def->{$param}{array} && defined $p_value_orig) {
            @p_value = split /$params_def->{$param}{array}/, $p_value_orig;
-           debug( "Value (Array Split) ". join('##',@p_value), 2 );
+           debug( "Value (Array Split) ". join('##',@p_value), 2 ) if DEBUG;
        }
 
        if ($params_def->{$param}{match} && defined $p_value_orig) {
@@ -118,7 +118,7 @@ sub parse_params {
        }
        @p_value = grep { defined $_ } @p_value;
 
-       debug( "Value (Match) ". join('##',@p_value), 2 );
+       debug( "Value (Match) ". join('##',@p_value), 2 ) if DEBUG;
 
        unless (@p_value) {
            if (defined $params{$param}{default}) {
@@ -130,7 +130,7 @@ sub parse_params {
            }
        }
 
-       debug( "Value (Default) ". join('##',@p_value), 2 );
+       debug( "Value (Default) ". join('##',@p_value), 2 ) if DEBUG;
        my @p_value_no_replace = @p_value;
 
        if ($params{$param}{replace} && @p_value) {
@@ -152,7 +152,7 @@ sub parse_params {
            }
        }
        
-       debug( "Value (Final) ". join('##',@p_value), 2 );
+       debug( "Value (Final) ". join('##',@p_value), 2 ) if DEBUG;
 
        if ($params_def->{$param}{array}) {
            $params_ret{values}{$param} = {
@@ -198,7 +198,7 @@ sub end {
     my $params = shift;
 
     use Data::Dumper;
-    debug( "end: ".Dumper($params) );
+    debug( "end: ".Dumper($params) ) if DEBUG;
     my $page = $params->{page}
     || DEFAULT_PAGE;
     my $res_per_page = $params->{number}
@@ -343,12 +343,12 @@ sub read_entry_all {
     my $result = $hash->{$key} || '';
     foreach (split /\000/o, $result) {
        my @data = split ( /\s/o, $_, 8 );
-       debug( "Considering entry ".join( ':', @data), 2);
+       debug( "Considering entry ".join( ':', @data), 2) if DEBUG;
        if ($opts->{h_archives}{$data[0]} && $opts->{h_suites}{$data[1]}
            && ($opts->{h_archs}{$data[2]} || $data[2] eq 'all'
                || $data[2] eq 'virtual')
            && ($opts->{h_sections}{$data[3]} || $data[3] eq 'v')) {
-           debug( "Using entry ".join( ':', @data), 2);
+           debug( "Using entry ".join( ':', @data), 2) if DEBUG;
            push @$results, [ $key, @data ];
        } else {
            push @$non_results, [ $key, @data ];
@@ -368,21 +368,21 @@ sub read_entry_simple {
     my (@data_fuzzy, @data_virtual, @data_fuzzy_virtual);
     foreach (split /\000/o, $result) {
        my @data = split ( /\s/o, $_, 8 );
-       debug( "Considering entry ".join( ':', @data), 2);
+       debug( "Considering entry ".join( ':', @data), 2) if DEBUG;
        if ($data[1] eq $suite) {
            if ($archives->{$data[0]}
                && ($data[2] ne 'virtual')) {
-               debug( "Using entry ".join( ':', @data), 2);
+               debug( "Using entry ".join( ':', @data), 2) if DEBUG;
                return \@data;
            } elsif ($archives->{$data[0]}) {
-               debug( "Virtual entry ".join( ':', @data), 2);
+               debug( "Virtual entry ".join( ':', @data), 2) if DEBUG;
                @data_virtual = @data;
            } elsif (($data[0] eq 'us')
                     && ($data[2] ne 'virtual')) {
-               debug( "Fuzzy entry ".join( ':', @data), 2);
+               debug( "Fuzzy entry ".join( ':', @data), 2) if DEBUG;
                @data_fuzzy = @data;
            } elsif ($data[0] eq 'us') {
-               debug( "Virtual fuzzy entry ".join( ':', @data), 2);
+               debug( "Virtual fuzzy entry ".join( ':', @data), 2) if DEBUG;
                @data_fuzzy_virtual = @data;
            }
        } 
@@ -394,14 +394,14 @@ sub read_entry_simple {
 sub read_src_entry_all {
     my ($hash, $key, $results, $non_results, $opts) = @_;
     my $result = $hash->{$key} || '';
-    debug( "read_src_entry_all: key=$key", 1);
+    debug( "read_src_entry_all: key=$key", 1) if DEBUG;
     foreach (split /\000/o, $result) {
        my @data = split ( /\s/o, $_, 6 );
-       debug( "Considering entry ".join( ':', @data), 2);
+       debug( "Considering entry ".join( ':', @data), 2) if DEBUG;
        if ($opts->{h_archives}{$data[0]}
            && $opts->{h_suites}{$data[1]}
            && $opts->{h_sections}{$data[2]}) {
-           debug( "Using entry ".join( ':', @data), 2);
+           debug( "Using entry ".join( ':', @data), 2) if DEBUG;
            push @$results, [ $key, @data ];
        } else {
            push @$non_results, [ $key, @data ];
@@ -424,12 +424,12 @@ sub do_names_search {
     $postfixes->seq( $key, $prefixes, R_CURSOR );
     while (index($key, $keyword) >= 0) {
        if ($prefixes =~ /^\001(\d+)/o) {
-           debug( "$key has too many hits", 2 );
+           debug( "$key has too many hits", 2 ) if DEBUG;
            $too_many_hits += $1;
        } else {
            foreach (split /\000/o, $prefixes) {
                $_ = '' if $_ eq '^';
-               debug( "add word $_$key", 2);
+               debug( "add word $_$key", 2) if DEBUG;
                $pkgs{$_.$key}++;
            }
        }
@@ -466,13 +466,13 @@ sub do_fulltext_search {
     while (<DESC>) {
        /^(\d+)/;
        my $nr = $1;
-       debug( "Matched line $_", 2);
+       debug( "Matched line $_", 2) if DEBUG;
        my $result = $did2pkg->{$nr};
        foreach (split /\000/o, $result) {
            my @data = split /\s/, $_, 3;
-#          debug ("Considering $data[0], arch = $data[2]", 3);
+#          debug ("Considering $data[0], arch = $data[2]", 3) if DEBUG;
 #          next unless $data[2] eq 'all' || $opts->{h_archs}{$data[2]};
-#          debug ("Ok", 3);
+#          debug ("Ok", 3) if DEBUG;
            $numres++ unless $tmp_results{$data[0]}++;
        }
        last if $numres > 100;
@@ -494,11 +494,11 @@ sub find_binaries {
     foreach (split /\000/o, $bins) {
        my @data = split /\s/, $_, 5;
 
-       debug( "find_binaries: considering @data", 3 );
+       debug( "find_binaries: considering @data", 3 ) if DEBUG;
        if (($data[0] eq $archive)
            && ($data[1] eq $suite)) {
            $bins{$data[2]}++;
-           debug( "find_binaries: using @data", 3 );
+           debug( "find_binaries: using @data", 3 ) if DEBUG;
        }
     }
 

diff --git a/lib/Packages/SrcPage.pm b/lib/Packages/SrcPage.pm
index 3d513d77cedbf5b861e4693be7e2b00c9e0dae11..a10a2c2364cf2b7d54b28d9771935dd85d192664 100644 (file)
--- a/lib/Packages/SrcPage.pm
+++ b/lib/Packages/SrcPage.pm
@@ -31,11 +31,11 @@ sub merge_package {
     ($data->{package} && $data->{suite} && $data->{archive}) || return;
     $self->{package} ||= $data->{package};
     ($self->{package} eq $data->{package}) || return;
-    debug( "merge package $data->{package}/$data->{version} into $self (".($self->{version}||'').")", 2 );
+    debug( "merge package $data->{package}/$data->{version} into $self (".($self->{version}||'').")", 2 ) if DEBUG;
 
     if (!$self->{version}
        || (version_cmp( $data->{version}, $self->{version} ) > 0)) {
-       debug( "added package is newer, replacing old information" );
+       debug( "added package is newer, replacing old information" ) if DEBUG;
 
        $self->{data} = $data;