pyrox.dev
1package Logger;
2
3use strict;
4use Thread::Queue;
5use XML::Writer;
6
7sub new {
8 my ($class) = @_;
9
10 my $logFile = defined $ENV{LOGFILE} ? "$ENV{LOGFILE}" : "/dev/null";
11 my $log = new XML::Writer(OUTPUT => new IO::File(">$logFile"));
12
13 my $self = {
14 log => $log,
15 logQueue => Thread::Queue->new()
16 };
17
18 $self->{log}->startTag("logfile");
19
20 bless $self, $class;
21 return $self;
22}
23
24sub close {
25 my ($self) = @_;
26 $self->{log}->endTag("logfile");
27 $self->{log}->end;
28}
29
30sub drainLogQueue {
31 my ($self) = @_;
32 while (defined (my $item = $self->{logQueue}->dequeue_nb())) {
33 $self->{log}->dataElement("line", sanitise($item->{msg}), 'machine' => $item->{machine}, 'type' => 'serial');
34 }
35}
36
37sub maybePrefix {
38 my ($msg, $attrs) = @_;
39 $msg = $attrs->{machine} . ": " . $msg if defined $attrs->{machine};
40 return $msg;
41}
42
43sub nest {
44 my ($self, $msg, $coderef, $attrs) = @_;
45 print STDERR maybePrefix("$msg\n", $attrs);
46 $self->{log}->startTag("nest");
47 $self->{log}->dataElement("head", $msg, %{$attrs});
48 $self->drainLogQueue();
49 eval { &$coderef };
50 my $res = $@;
51 $self->drainLogQueue();
52 $self->{log}->endTag("nest");
53 die $@ if $@;
54}
55
56sub sanitise {
57 my ($s) = @_;
58 $s =~ s/[[:cntrl:]\xff]//g;
59 return $s;
60}
61
62sub log {
63 my ($self, $msg, $attrs) = @_;
64 chomp $msg;
65 print STDERR maybePrefix("$msg\n", $attrs);
66 $self->drainLogQueue();
67 $self->{log}->dataElement("line", $msg, %{$attrs});
68}
69
701;