You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

70 lines
1.5 KiB

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