Skip to content
Snippets Groups Projects
Commit 978e22a1 authored by Andreas Romeyke's avatar Andreas Romeyke
Browse files

Merge branch 'feature_logbased_statistics'

parents 5d11287b 822be5c4
Branches
Tags
No related merge requests found
Hide whitespace changes
Inline Side-by-side
dist.ini
+ 1
− 1
View file @ 978e22a1
......@@ -4,6 +4,6 @@ license = Perl_5
copyright_holder = Andreas Romeyke
copyright_year = 2021
version = 0.001
version = 0.002
[@Basic]
lib/SLUB/LZA/Rosetta/TA.pm
+ 48
− 6
View file @ 978e22a1
......@@ -7,14 +7,20 @@ use YAML qw(LoadFile);
use LWP::UserAgent;
use Carp qw( croak );
use feature qw(say);
use Regexp::Optimizer;
use IO::Zlib;
our %config;
my $home = path( $ENV{'HOME'} );
if ($home->is_dir() && !$home->is_rootdir) {
my $config_path = $home->child('.config')->child('ta-tool.rc');
our $config_file = $config_path;
if ($config_path->is_file) {
%config = YAML::LoadFile($config_path);
BEGIN{
my $home = path($ENV{'HOME'});
if ($home->is_dir() && !$home->is_rootdir) {
my $config_path = $home->child('.config')->child('ta-tool.rc');
our $config_file = $config_path;
if ($config_path->is_file) {
if (1) { say "DEBUG: loading config from '$config_file'"; }
%config = YAML::LoadFile($config_path);
}
}
}
......@@ -60,4 +66,40 @@ sub sru_search {
}
sub scan_log {
my $date_rx=shift;
my $level_rx=shift;
my $match_rx=shift;
my $output_filter=shift;
# open dir from config{$logdir}
# for all files matching server.log*; do
# read lines
# filter lines
# return
my $directory = path($config{logdir});
my $search_rxo = Regexp::Optimizer->new->optimize(qr/^$date_rx [^ ]* $level_rx (.*?)$match_rx(.*?)$/);
for ($directory->children( qr/^server.log/ )) {
my $file = $_;
if (!$file->is_file) { next; }
my $fh;
if ($file =~ m/\.gz$/) {
$fh = IO::Zlib->new("$file", "rb");
} else {
$fh = $file->openr;
}
if (defined $fh) {
while(<$fh>) {
chomp;
if (! m/$search_rxo/) {
#print "no match for '$_'";
next;
}
my $line = $output_filter->( $_ );
say $line;
}
}
undef $fh;
}
}
1;
lib/SLUB/LZA/Rosetta/TA/Command/init.pm
+ 3
− 1
View file @ 978e22a1
......@@ -10,7 +10,8 @@ sub description {"Initialize $0, preparing config"}
sub opt_spec {
return(
["verbose|v" => "enable verbose output"],
["rosettahost|r=s" => "host", {required=>1}],
["rosettahost|r=s" => "host adress where Rosetta runs", {required=>1}],
["logdir|l=s" => "logdir where rosetta stores it server log files", {required=>1}],
);
}
sub validate_args {
......@@ -23,6 +24,7 @@ sub execute {
my ($self, $opt, $args) = @_;
my %config;
$config{host} = $opt->{rosettahost};
$config{logdir} = $opt->{logdir};
if (defined $SLUB::LZA::Rosetta::TA::config_file) {
if (defined $opt->{verbose}) {
say "store config in $SLUB::LZA::Rosetta::TA::config_file";
......
lib/SLUB/LZA/Rosetta/TA/Command/log.pm 0 → 100644
+ 192
− 0
View file @ 978e22a1
package SLUB::LZA::Rosetta::TA::Command::log;
use strict;
use warnings;
use feature qw(say);
use Regexp::Optimizer;
use DateTime;
use DateTime::Format::DateParse;
use Text::CSV_PP;
use SLUB::LZA::Rosetta::TA -command;
sub abstract {"grep server log of Rosetta based Archival Information System";}
my $description=<<"DESCR";
Searches logfiles of Rosetta-based AIS
Examples:
* What are the error messages in last 24 hours?
$0 log --level error --last-24h
* What are error and warning messages between 2022-01-01 and 2022-02-01?
$0 log --level error --level warning --fromdate 2022-ß1-01 --todate 2021-02-ß1
* Are there lines with regex "match"?
$0 log --match "match"
DESCR
sub description {
"$description"
}
sub opt_spec {
return(
["verbose|v" => "enable verbose output"],
["outputfilter" => hidden => {one_of => [
["colorize|c" => "colorize output"],
["csv" => "use csv output"],
]}],
["datemode" => hidden => {one_of => [
["last-24h" => "search within last 24h"],
["fromdate=s" => "search starting with date"],
["todate=s" => "search ending with date"],
] } ],
["level=s@" => "levels to search for. Levels could be: 'error', 'warn', 'info', debug. You could use multiple levels by repeating"],
["match=s" => "perl regex to search for" => {default=>".*"}],
);
}
sub validate_date {
my $self = shift;
my $datestr = shift;
return ($datestr =~ m/^20[0123][0-9]-[0-1][0-9]-[0-3][0-9]$/);
}
sub validate_args {
my ($self, $opt, $args) = @_;
# no args allowed but options!
$self->usage_error("No args allowed") if @$args;
if (defined $opt->fromdate
and defined $opt->last_24h
and $opt->last_24h == 1
) {
$self->usage_error("--last-24h and --fromdate not combinable");
}
if (defined $opt->todate
and defined $opt->last_24h
and $opt->last_24h == 1
) {
$self->usage_error("--last-24h and --todate not combinable");
}
# check dates
if (defined $opt->fromdate && !$self->validate_date($opt->fromdate)) {
$self->usage_error("--fromdate $opt->{fromdate} not a valid date");
}
if (defined $opt->todate && !$self->validate_date($opt->todate)) {
$self->usage_error("--todate $opt->{todate} not a valid date");
}
# TODO: check levels
1;
}
sub create_regex_last24h {
my $dt = DateTime->now;
my $todate = $dt->ymd;
my $fromdate= $dt->subtract( hours => 24)->ymd;
my $rxo = Regexp::Optimizer->new->optimize(qr/$fromdate|$todate/);
return $rxo;
}
sub create_regex_from_to {
my $from=shift // "2000-01-01";
my $to=shift // "2059-12-31";
my $dt_from = DateTime::Format::DateParse->parse_datetime("$from");
my $dt_to = DateTime::Format::DateParse->parse_datetime("$to");
my @date_tmo_s;
for (my $dt = $dt_from; $dt->epoch() <= $dt_to->epoch; $dt->add(days => 1) ) {
push @date_tmo_s, $dt->ymd;
}
my $date_rx_string = join("|", @date_tmo_s);
my $rxo = Regexp::Optimizer->new->optimize(qr/$date_rx_string/);
return $rxo;
}
{
my $bred = "\e[1;31m";
my $red = "\e[31m";
my $green = "\e[32m";
my $blue = "\e[34m";
my $bblue = "\e[1;34m";
my $gray = "\e[90m]";
my $reversed = "\e[7m";
my $reset = "\e[0m";
my $back_yellow = "\e[103m";
my $back_cyan = "\e[45m";
my $datetime_rx=qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d,\d\d\d/;
sub colorize {
my $line = shift;
my $opt = shift;
my $match_rx = shift;
# patterns in common interest:
$line =~ s/^($datetime_rx)/${blue}$1${reset}/;
if ($opt->{match} ne ".*") {
$line =~ s/( (DEBUG|INFO|WARN|ERROR) .*?)($match_rx)/$1${reversed}$3${reset}/; # order important!
}
$line =~ s/ (DEBUG) / ${gray}$1${reset} /
|| $line =~ s/ (INFO) / ${green}$1${reset} /
|| $line =~ s/ (WARN) / ${red}$1${reset} /
|| $line =~ s/ (ERROR) / ${bred}$1${reset} /;
$line =~ s/(SIP ?\d+)/${back_yellow}$1${reset}/;
$line =~ s/(IE ?\d+)/${back_yellow}$1${reset}/;
$line =~ s/(dc.identifier)/${back_cyan}$1${reset}/;
return $line;
}
}
{
my $csv;
sub csv {
my $line = shift;
my $opt = shift;
my $match_rx = shift;
my $ret;
if (!defined $csv) {
$csv = Text::CSV_PP->new(
{
sep_char => ";",
}
);
$ret=join(";", qw(date time level where msg))."\n";
}
my $date_rx=qr/\d\d\d\d-\d\d-\d\d/;
my $time_rx=qr/\d\d:\d\d:\d\d,\d\d\d/;
my $level_rx=qr/DEBUG|INFO|WARN|ERROR/;
my $where_rx=qr/\[.*?\]/;
my $msg_rx=qr/.*$/;
$line =~ m/^($date_rx) ($time_rx) ($level_rx) ($where_rx) ($msg_rx)/;
$csv->combine($1, $2, $3, $4, $5);
$ret.= $csv->string;
}
}
sub execute {
my ($self, $opt, $args) = @_;
# create date_rx if provided by CLI
my $date_rx=qr/[^ ]*/;
if (defined $opt->last_24h and $opt->last_24h == 1) {
$date_rx=create_regex_last24h();
} elsif (defined $opt->datemode
and (
$opt->datemode eq "todate"
or $opt->datemode eq "fromdate"
)
) {
$date_rx=create_regex_from_to($opt->fromdate, $opt->todate);
}
# create level_rx if multiple levels provided by CLI
my $level_rx=qr/(DEBUG|INFO|WARN|ERROR)/;
if (defined $opt->level) {
my $rx_string = join("|", map {uc} @{ $opt->level });
$level_rx = Regexp::Optimizer->new->optimize(qr/$rx_string/);
}
my $match_rx=qr{$opt->{match}};
# prepare output filter
my $output_filter=sub { $_[0]; };
if (defined $opt->colorize) {
$output_filter = sub { colorize($_[0], $opt, $match_rx); };
} elsif (defined $opt->csv) {
$output_filter = sub { csv($_[0], $opt, $match_rx); };
}
SLUB::LZA::Rosetta::TA::scan_log($date_rx, $level_rx, $match_rx, $output_filter);
}
1;
\ No newline at end of file
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

DE: Impressum · Datenschutzerklärung | EN: Legal Notice · Privacy Policy