From f27f1fcc5bffc0696f694e962eb40dbb0c554855 Mon Sep 17 00:00:00 2001 From: Frank Lichtenheld Date: Wed, 22 Feb 2006 20:20:37 +0000 Subject: [PATCH] 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 --- cgi-bin/dispatcher.pl | 14 ++++----- lib/Packages/CGI.pm | 4 ++- lib/Packages/Config.pm | 2 +- lib/Packages/DB.pm | 2 +- lib/Packages/DoSearch.pm | 4 +-- lib/Packages/DoSearchContents.pm | 6 ++-- lib/Packages/DoShow.pm | 16 +++++----- lib/Packages/HTML.pm | 2 +- lib/Packages/Page.pm | 12 ++++---- lib/Packages/Search.pm | 50 ++++++++++++++++---------------- lib/Packages/SrcPage.pm | 4 +-- 11 files changed, 58 insertions(+), 58 deletions(-) diff --git a/cgi-bin/dispatcher.pl b/cgi-bin/dispatcher.pl index 3873c49..a4b3e39 100755 --- 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 e15e510..66b442d 100644 --- 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 0645d58..538e912 100644 --- 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 e959f60..0c0ebdc 100644 --- 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 64160c1..776b288 100644 --- 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) $suites_enc"; diff --git a/lib/Packages/DoSearchContents.pm b/lib/Packages/DoSearchContents.pm index cbca011..e86fc78 100644 --- 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 b375977..08eb376 100644 --- 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 %s in %s" ) : diff --git a/lib/Packages/HTML.pm b/lib/Packages/HTML.pm index 859467a..28dbb76 100644 --- 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 c2aff05..c3e20d2 100644 --- 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 931747c..d04f44a 100644 --- 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 $param", 2 ); + debug( "Param $param", 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 () { /^(\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 3d513d7..a10a2c2 100644 --- 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; -- 2.39.2