view release on metacpan or  search on metacpan

lib/Apache2/Tail.pm  view on Meta::CPAN

    my $q = new CGI($r);

    my $tail_cnt = $q->param('n') || $class->tail_cnt($r);

    $r->content_type('text/html');

    my $tail = File::Tail->new(
                               name   => $error_log,
                               tail   => $tail_cnt,
                               nowait => 1,
                              );

    $class->print_header($r);

    while (my $line = $tail->read) {

        my ($date, $level, $client, $msg);
        if ($line =~
            m{\[(.*?)\]\s*\[(.*?)\]\s*(\[client\s*(.*?)\]\s*)?(.*)})
        {
            $level  = $2;
            $date   = $1;
            $client = $4;
            $msg    = $5;
            $msg =~ s/\\t/    /g;
        }

        next unless $date;

        $r->print(<<"EOF");
<tr class="$level"><td class="timestamp">$date</td><td class="vhost">$name</td><td class="loglevel">$level</td><td class="client">$client</td><td class="message">$msg</td></tr>
EOF
        last if --$tail_cnt <= 0;
    }

    $class->print_footer($r);

    return Apache2::Const::OK;
}

sub style {
    my ($class, $r) = @_;
    
    if (my $user_style = $r->dir_config($class . '::CSS')) {
        return qq(<link rel="stylesheet" type="text/css" href="$user_style">);
    }
    else {
        return <<'EOF';
<style type="text/css">

body {
    font-family:    'Courier New', courier, monospace;
    font-size:      8pt;
    line-height:    10pt;
    color:          #333333;
}

td {
    padding:            .25em;
    align:              top;
    background-color:   #eee;
}

td.timestamp {
    font-size:      8pt;
    text-align:     center;
    width:          130px;
}

tr.warn td {
    background-color: #FFE79F;
}

tr.error td {
    background-color: #FFCCCC;
}

tr.notice td {
    background-color: #DFE7FF;
}

.vhost {
    font-style:     italic;
}

.loglevel {
    text-align:     center;
}

tr.info td.loglevel {

}

tr.notice td.loglevel {
    color:          #00C;
    font-weight:    bold;
} 

tr.debug td.loglevel{

}

tr.warn td.loglevel {
    font-weight:    bold;
    color:          #FF803E;
}

tr.error td.loglevel {
    color:          #F00;
    font-weight:    bold;
}

.client {
    color:          #333333;
}

.message {
    padding-left:   .5em;
}

tr.error td.message, tr.warn td.message, tr.notice td.message {
    font-weight:    bold;
}

</style>
EOF
    }
}

sub print_footer {
    my ($class, $r) = @_;
    $r->print(<<'EOF');
</table></body></html>
EOF
}

sub print_header {
    my ($class, $r) = @_;