perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/lib/Apache Status.pm
Date Sat, 15 Nov 2003 22:08:14 GMT
stas        2003/11/15 14:08:14

  Modified:    lib/Apache Status.pm
  Log:
  not tabs are wanted in mp2 source
  
  Revision  Changes    Path
  1.16      +108 -108  modperl-2.0/lib/Apache/Status.pm
  
  Index: Status.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/Apache/Status.pm,v
  retrieving revision 1.15
  retrieving revision 1.16
  diff -u -u -r1.15 -r1.16
  --- Status.pm	15 Nov 2003 21:57:28 -0000	1.15
  +++ Status.pm	15 Nov 2003 22:08:14 -0000	1.16
  @@ -43,7 +43,7 @@
       rgysubs   => "Compiled Registry Scripts",
       symdump   => "Symbol Table Dump",
       inh_tree  => "Inheritance Tree",
  -    isa_tree  => "ISA Tree",	
  +    isa_tree  => "ISA Tree",
       env       => "Environment",
       sig       => "Signal Handlers",
       myconfig  => "Perl Configuration",
  @@ -126,18 +126,18 @@
   
       header($r);
       if (defined &$sub) {
  -	$r->print(@{ &{$sub}($r, $newQ->($r)) });
  +        $r->print(@{ &{$sub}($r, $newQ->($r)) });
       }
       elsif ($qs and %{$qs."::"}) {
  -	$r->print(symdump($r, $newQ->($r), $qs));
  +        $r->print(symdump($r, $newQ->($r), $qs));
       }
       else {
  -	my $uri = $r->uri;
  -	$r->print('<p>');
  -	$r->print(
  - 	    map { qq[<a href="$uri?$_">$status{$_}</a><br>\n] } keys %status
  +        my $uri = $r->uri;
  +        $r->print('<p>');
  +        $r->print(
  +            map { qq[<a href="$uri?$_">$status{$_}</a><br>\n] } keys
%status
           );
  -	$r->print('</p>');
  +        $r->print('</p>');
       }
       $r->print("</body></html>");
   
  @@ -182,7 +182,7 @@
   
       return install_hint("Devel::Symdump") unless has($r, "symdump");
   
  -    my $meth = lc($r->dir_config("StatusRdump")) eq "on" 
  +    my $meth = lc($r->dir_config("StatusRdump")) eq "on"
           ? "rnew" : "new";
       my $sob = Devel::Symdump->$meth($package);
       return $sob->Apache::Status::as_HTML($package, $r, $q);
  @@ -207,9 +207,9 @@
       my @retval = qw(<table>);
       my @list = mod_perl::hooks();
       for my $hook (sort @list) {
  -	my $on_off = 
  -	  mod_perl::hook($hook) ? "<b>Enabled</b>" : "<i>Disabled</i>";
  -	push @retval, "<tr><td>$hook</td><td>$on_off</td></tr>\n";
  +        my $on_off = 
  +            mod_perl::hook($hook) ? "<b>Enabled</b>" : "<i>Disabled</i>";
  +        push @retval, "<tr><td>$hook</td><td>$on_off</td></tr>\n";
       }
       push @retval, qw(</table>);
       \@retval;
  @@ -227,16 +227,16 @@
       );
   
       foreach my $file (sort keys %INC) {
  -	local $^W = 0;
  -	next if $file =~ m:^/:;
  -	next unless $file =~ m:\.pm:;
  -	next unless $INC{$file}; #e.g. fake Apache/TieHandle.pm
  -
  -	no strict 'refs';
  -	(my $module = $file) =~ s,/,::,g;
  -	$module =~ s,\.pm$,,;
  -	my $v = ${"$module\:\:VERSION"} || '0.00';
  -	push @retval, (
  +        local $^W = 0;
  +        next if $file =~ m:^/:;
  +        next unless $file =~ m:\.pm:;
  +        next unless $INC{$file}; #e.g. fake Apache/TieHandle.pm
  +
  +        no strict 'refs';
  +        (my $module = $file) =~ s,/,::,g;
  +        $module =~ s,\.pm$,,;
  +        my $v = ${"$module\:\:VERSION"} || '0.00';
  +        push @retval, (
               "<tr>", 
               (map "<td>$_</td>", 
                   qq(<a href="$uri?$module">$module</a>),
  @@ -258,8 +258,8 @@
       );
   
       foreach my $file (sort keys %INC) {
  -	next if $file =~ m:\.(pm|al|ix)$:;
  -	push @retval, 
  +        next if $file =~ m:\.(pm|al|ix)$:;
  +        push @retval, 
               qq(<tr><td>$file</td><td>$INC{$file}</td></tr>\n);
       }
       push @retval, "</table>";
  @@ -356,15 +356,15 @@
   sub status_sig {
       ["<pre>",
        (map {
  -	 my $val = $SIG{$_} || "";
  -	 if ($val and ref $val eq "CODE") {
  +         my $val = $SIG{$_} || "";
  +         if ($val and ref $val eq "CODE") {
                # XXX: 2.0 doesn't have Apache::Symbol
  -	     if (my $cv = Apache::Symbol->can('sv_name')) {
  -		 $val = "\\&".  $cv->($val);
  -	     }
  -	 }
  -	 "$_ = $val\n" }
  -     sort keys %SIG),
  +             if (my $cv = Apache::Symbol->can('sv_name')) {
  +                 $val = "\\&".  $cv->($val);
  +             }
  +         }
  +         "$_ = $val\n" }
  +      sort keys %SIG),
        "</pre>"];
   }
   
  @@ -477,8 +477,8 @@
       my $script = $r->location;
       my @retval;
       for (qw(exec slow)) {
  -	my $exp = "$b_terse_exp{$_} order";
  -	push @retval,
  +        my $exp = "$b_terse_exp{$_} order";
  +        push @retval,
               qq(\n<a href="$script/$_/$name?noh_b_terse">Syntax Tree Dump ($exp)</a>\n);
       }
       join '', @retval;
  @@ -507,8 +507,8 @@
       my $script = $r->location;
       my @retval;
       for (qw(exec slow)) {
  -	my $exp = "$b_terse_exp{$_} order";
  -	push @retval,
  +        my $exp = "$b_terse_exp{$_} order";
  +        push @retval,
               qq(\n<a href="$script/$_/$name?noh_b_terse_size">Syntax Tree Size ($exp)</a>\n);
       }
       join '', @retval;
  @@ -554,29 +554,29 @@
   
       my $nlen = 0;
       my @keys = map {
  -	$nlen = length > $nlen ? length : $nlen;
  -	$_;
  +        $nlen = length > $nlen ? length : $nlen;
  +        $_;
       } (sort { $subs->{$b}->{size} <=> $subs->{$a}->{size} } keys %$subs);
   
       my $clen = length $subs->{$keys[0]}->{count};
       my $slen = length $subs->{$keys[0]}->{size};
   
       for my $name (@keys) {
  -	my $stats = $subs->{$name};
  -	if ($name =~ /^my /) {
  -	    $r->printf("%-${nlen}s %${slen}d bytes\n", $name, $stats->{size});
  -	}
  -	elsif ($name =~ /^\*(\w+)\{(\w+)\}/) {
  -	    my $link = qq(<a href="$script/$package\::$1/$2?data_dump">);
  -	    $r->printf("$link%-${nlen}s</a> %${slen}d bytes\n", 
  -                $name, $stats->{size});
  -	}
  -	else {
  -	    my $link = 
  +        my $stats = $subs->{$name};
  +        if ($name =~ /^my /) {
  +            $r->printf("%-${nlen}s %${slen}d bytes\n", $name, $stats->{size});
  +        }
  +        elsif ($name =~ /^\*(\w+)\{(\w+)\}/) {
  +            my $link = qq(<a href="$script/$package\::$1/$2?data_dump">);
  +            $r->printf("$link%-${nlen}s</a> %${slen}d bytes\n", 
  +                       $name, $stats->{size});
  +        }
  +        else {
  +            my $link = 
                   qq(<a href="$script/slow/$package\::$name?noh_b_terse_size">);
  -	    $r->printf("$link%-${nlen}s</a> %${slen}d bytes | %${clen}d OPs\n",
  -                $name, $stats->{size}, $stats->{count});
  -	}
  +            $r->printf("$link%-${nlen}s</a> %${slen}d bytes | %${clen}d OPs\n",
  +                       $name, $stats->{size}, $stats->{count});
  +        }
       }
   }
   
  @@ -598,7 +598,7 @@
       my $name = (split "/", $r->uri)[-1];
       $r->print("Deparse of $name\n\n");
       my $deparse = B::Deparse->new(split /\s+/, 
  -				  $r->dir_config('StatusDeparseOptions')||"");
  +                                  $r->dir_config('StatusDeparseOptions')||"");
       my $body = $deparse->coderef2text(\&{$name});
       $r->print("sub $name $body");
   }
  @@ -621,7 +621,7 @@
       my $name = (split "/", $r->uri)[-1];
       $r->print("Fathom Score of $name\n\n");
       my $fathom = B::Fathom->new(split /\s+/, 
  -				$r->dir_config('StatusFathomOptions')||"");
  +                                $r->dir_config('StatusFathomOptions')||"");
       $r->print($fathom->fathom(\&{$name}));
   }
   
  @@ -670,8 +670,8 @@
   $Apache::Status::BGraphCache ||= 0;
   if ($Apache::Status::BGraphCache) {
       Apache->push_handlers(PerlChildExitHandler => sub {
  -			      unlink keys %Apache::Status::BGraphCache;
  -			  });
  +        unlink keys %Apache::Status::BGraphCache;
  +    });
   }
   
   sub b_graph_link {
  @@ -690,8 +690,8 @@
   
       untie *STDOUT;
   
  -    my $dir = $r->server_root_relative(
  -        $r->dir_config("GraphDir") || "logs/b_graphs");
  +    my $dir = 
  +        $r->server_root_relative($r->dir_config("GraphDir") || "logs/b_graphs");
   
       mkdir $dir, 0755 unless -d $dir;
   
  @@ -701,26 +701,26 @@
       my $file = "$dir/$thing.$$.gif";
   
       unless (-e $file) {
  -	tie *STDOUT, "B::Graph", $r, $file;
  -	B::Graph::compile("-$type", $thing)->();
  -	(tied *STDOUT)->{graph}->close;
  +        tie *STDOUT, "B::Graph", $r, $file;
  +        B::Graph::compile("-$type", $thing)->();
  +        (tied *STDOUT)->{graph}->close;
       }
   
       if (-s $file) {
  -	local *FH;
  -	open FH, $file or die "Can't open $file: $!";
  -	$r->content_type("image/gif");
  -	$r->send_fd(\*FH);
  +        local *FH;
  +        open FH, $file or die "Can't open $file: $!";
  +        $r->content_type("image/gif");
  +        $r->send_fd(\*FH);
       }
       else {
  -	$r->content_type("text/plain");
  -	$r->print("Graph of $thing failed!\n");
  +        $r->content_type("text/plain");
  +        $r->print("Graph of $thing failed!\n");
       }
       if ($Apache::Status::BGraphCache) {
  -	$Apache::Status::BGraphCache{$file}++;
  +        $Apache::Status::BGraphCache{$file}++;
       }
       else {
  -	unlink $file;
  +        unlink $file;
       }
   
       0;
  @@ -730,10 +730,10 @@
       my($class, $r, $file) = @_;
   
       if ($file =~ /^([^<>|;]+)$/) {
  -	$file = $1;
  -    } 
  +        $file = $1;
  +    }
       else {
  -	die "TAINTED data in THING=> ($file)";
  +        die "TAINTED data in THING=> ($file)";
       }
   
       $ENV{PATH} = join ":", qw{/usr/bin /usr/local/bin};
  @@ -745,8 +745,8 @@
       $pipe->autoflush(1);
   
       return bless {
  -	graph => $pipe,
  -	r => $r,
  +                  graph => $pipe,
  +                  r     => $r,
       }, $class;
   }
   
  @@ -770,43 +770,43 @@
       my @methods = sort keys %{$self->{'AUTOLOAD'}};
   
       if ($is_main) { 
  -	@methods = grep { $_ ne "packages" } @methods;
  -	unshift @methods, "packages";
  +        @methods = grep { $_ ne "packages" } @methods;
  +        unshift @methods, "packages";
       }
   
       for my $type (@methods) {
  -	(my $dtype = uc $type) =~ s/E?S$//;
  -	push @m, "<tr><td valign=\"top\"><b>$type</b></td>";
  -	my @line = ();
  -
  -	for (sort $self->_partdump(uc $type)) {
  -	    s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64)/eg; 
  -
  -	    if ($type eq "scalars") {
  -		no strict 'refs';
  -		next unless defined eval { $$_ };
  -	    }
  -
  -	    if ($type eq "packages") {
  -		push @line, qq(<a href="$uri?$_">$_</a>);
  -	    }
  -	    elsif ($type eq "functions") {
  -		if (has($r, "b")) {
  -		    push @line, qq(<a href="$uri/$_/$dtype?cv_dump">$_</a>);
  -		}
  -		else {
  -		    push @line, $_;
  -		}
  -	    }
  -	    elsif ($do_dump and $can_dump{$type}) {
  -		next if /_</;
  -		push @line, qq(<a href="$uri/$_/$dtype?data_dump">$_</a>);
  -	    }
  -	    else {
  -		push @line, $_;
  -	    }
  -	}
  -	push @m, "<td>" . join(", ", @line) . "</td></tr>\n";
  +        (my $dtype = uc $type) =~ s/E?S$//;
  +        push @m, "<tr><td valign=\"top\"><b>$type</b></td>";
  +        my @line = ();
  +
  +        for (sort $self->_partdump(uc $type)) {
  +            s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64)/eg; 
  +
  +            if ($type eq "scalars") {
  +                no strict 'refs';
  +                next unless defined eval { $$_ };
  +            }
  +
  +            if ($type eq "packages") {
  +                push @line, qq(<a href="$uri?$_">$_</a>);
  +            }
  +            elsif ($type eq "functions") {
  +                if (has($r, "b")) {
  +                    push @line, qq(<a href="$uri/$_/$dtype?cv_dump">$_</a>);
  +                }
  +                else {
  +                    push @line, $_;
  +                }
  +            }
  +            elsif ($do_dump and $can_dump{$type}) {
  +                next if /_</;
  +                push @line, qq(<a href="$uri/$_/$dtype?data_dump">$_</a>);
  +            }
  +            else {
  +                push @line, $_;
  +            }
  +        }
  +        push @m, "<td>" . join(", ", @line) . "</td></tr>\n";
       }
       push @m, "</table>";
   
  
  
  

Mime
View raw message