File Coverage

blib/lib/Apache2/Tail.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Apache2::Tail;
2              
3             our $VERSION = 0.03;
4              
5 1     1   821 use strict;
  1         3  
  1         39  
6 1     1   6 use warnings;
  1         1  
  1         36  
7              
8 1     1   511 use Apache2::RequestIO ();
  0            
  0            
9             use Apache2::RequestRec ();
10             use Apache2::ServerUtil ();
11             use Apache2::ServerRec ();
12             use File::Tail ();
13             use CGI;
14              
15             use Apache2::Const -compile => qw(OK);
16              
17             use constant TAIL_CNT => 25;
18              
19             sub handler : method {
20             my $class = shift;
21             my $r = shift;
22             my $s = $r->server;
23             my $name = $s->server_hostname;
24             my $error_log = $class->error_log($r);
25            
26             my $q = new CGI($r);
27              
28             my $tail_cnt = $q->param('n') || $class->tail_cnt($r);
29              
30             $r->content_type('text/html');
31              
32             my $tail = File::Tail->new(
33             name => $error_log,
34             tail => $tail_cnt,
35             nowait => 1,
36             );
37              
38             $class->print_header($r);
39              
40             while (my $line = $tail->read) {
41              
42             my ($date, $level, $client, $msg);
43             if ($line =~
44             m{\[(.*?)\]\s*\[(.*?)\]\s*(\[client\s*(.*?)\]\s*)?(.*)})
45             {
46             $level = $2;
47             $date = $1;
48             $client = $4;
49             $msg = $5;
50             $msg =~ s/\\t/    /g;
51             }
52              
53             next unless $date;
54              
55             $r->print(<<"EOF");
56            
$date$name$level$client$msg
57             EOF
58             last if --$tail_cnt <= 0;
59             }
60              
61             $class->print_footer($r);
62              
63             return Apache2::Const::OK;
64             }
65              
66             sub style {
67             my ($class, $r) = @_;
68            
69             if (my $user_style = $r->dir_config($class . '::CSS')) {
70             return qq();
71             }
72             else {
73             return <<'EOF';
74            
151             EOF
152             }
153             }
154              
155             sub print_footer {
156             my ($class, $r) = @_;
157             $r->print(<<'EOF');
158            
159             EOF 160             } 161               162             sub print_header { 163             my ($class, $r) = @_; 164             165             my $style = $class->style($r); 166               167             $r->print(<<"EOF"); 168             169             170             171             Apache2::Tail $VERSION 172             $style 173             174             175            
176             EOF
177             }
178              
179             sub tail_cnt {
180             my ($class, $r) = @_;
181             return $r->dir_config($class . '::Count') || TAIL_CNT();
182             }
183              
184             sub error_log {
185             my ($class, $r) = @_;
186             my $s = $r->server;
187             return $r->dir_config($class . '::ErrorLog')
188             || Apache2::ServerUtil::server_root_relative($r->pool,
189             $s->error_fname);
190              
191             }
192              
193             42;
194              
195             __END__