aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ManaTools/Shared
diff options
context:
space:
mode:
authorMaarten Vanraes <alien@mageia.org>2016-05-05 14:57:18 +0200
committerMaarten Vanraes <alien@mageia.org>2016-05-08 09:52:46 +0200
commit6afe0e3ed77f5dc9d94c46613e55d05b45c25327 (patch)
treedc8a38e818bf51df9ba0f57f0fd4f82c3b539442 /lib/ManaTools/Shared
parent846b5b02e6cfa0157d842c4a255968abacdb5b6c (diff)
downloadmanatools-6afe0e3ed77f5dc9d94c46613e55d05b45c25327.tar
manatools-6afe0e3ed77f5dc9d94c46613e55d05b45c25327.tar.gz
manatools-6afe0e3ed77f5dc9d94c46613e55d05b45c25327.tar.bz2
manatools-6afe0e3ed77f5dc9d94c46613e55d05b45c25327.tar.xz
manatools-6afe0e3ed77f5dc9d94c46613e55d05b45c25327.zip
Logging: add ability to trace to STDERR
Diffstat (limited to 'lib/ManaTools/Shared')
-rw-r--r--lib/ManaTools/Shared/Logging.pm65
1 files changed, 65 insertions, 0 deletions
diff --git a/lib/ManaTools/Shared/Logging.pm b/lib/ManaTools/Shared/Logging.pm
index 6104f860..8d9b7ffa 100644
--- a/lib/ManaTools/Shared/Logging.pm
+++ b/lib/ManaTools/Shared/Logging.pm
@@ -91,6 +91,22 @@ has 'loc' => (
}
);
+has 'lastcaller' => (
+ is => 'ro',
+ isa => 'Ref',
+ required => 0,
+ init_arg => undef,
+ default => sub {
+ return \[];
+ }
+);
+
+has 'trace' => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 0,
+);
+
#=============================================================
=head2 new
@@ -183,6 +199,55 @@ sub R {
my $s = shift;
Sys::Syslog::syslog($syslog, $s);
+
+ if ($self->trace()) {
+ my $last = ${$self->lastcaller()};
+ my $current = [];
+
+ # build $current trace
+ my $lastfile = '';
+ my $lastline = 0;
+ my $i = 0;
+ while (my @call = caller($i)) {
+ my $call = [];
+ @{$call} = @call;
+ if ($call[0] ne 'ManaTools::Shared::Logging' && $call[3] !~ m/::[RPDIWE]$/) {
+ unshift @{$current}, $call;
+ }
+ else {
+ $lastfile = $call[1];
+ $lastline = $call[2];
+ }
+ $i = $i + 1;
+ }
+
+ # get equal min length of both
+ my $l = 0;
+ while ($l < scalar(@{$last}) && $l < scalar(@{$current}) && $last->[$l]->[1] eq $current->[$l]->[1] && $last->[$l]->[2] == $current->[$l]->[2]) {
+ $l = $l + 1;
+ }
+
+ # loop down to common lines
+ $i = scalar(@{$last});
+ $i = 0 if ($i < 0);
+ while ($i > $l) {
+ $i = $i - 1;
+ printf STDERR "(%5s):%". ($i + 1) ."s} // %s(): %s:%d\n", '-----', ' ', $last->[$i]->[3], $last->[$i]->[1], $last->[$i]->[2];
+ }
+
+ # loop back up to current line
+ $l = scalar(@{$current});
+ while ($i < $l) {
+ printf STDERR "(%5s):%". ($i + 1) ."s%s() %s:%d {\n", '-----', ' ', $current->[$i]->[3], $current->[$i]->[1], $current->[$i]->[2];
+ $i = $i + 1;
+ }
+
+ # print current trace message
+ printf STDERR "(%5s):%". ($i + 1) ."s%s in %s:%d\n", $syslog, ' ', $s, $lastfile, $lastline;
+
+ # set last trace to current
+ ${$self->lastcaller()} = $current;
+ }
}
#=============================================================