From 3d0599dbb61083014528f86d31d1a95f76daad0c Mon Sep 17 00:00:00 2001
From: Andreas Romeyke <andreas.romeyke@slub-dresden.de>
Date: Thu, 10 Nov 2022 13:50:05 +0100
Subject: [PATCH] - added Regexp::Optimizer - added IO::Zlib - fixed loading of
config at begin - added scan_log()
---
lib/SLUB/LZA/Rosetta/TA.pm | 54 +++++++++++++++++++++++++++++++++-----
1 file changed, 48 insertions(+), 6 deletions(-)
diff --git a/lib/SLUB/LZA/Rosetta/TA.pm b/lib/SLUB/LZA/Rosetta/TA.pm
index d575169..54baa04 100644
--- a/lib/SLUB/LZA/Rosetta/TA.pm
+++ b/lib/SLUB/LZA/Rosetta/TA.pm
@@ -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;
--
GitLab