1# ex:ts=8 sw=4:
| 1# ex:ts=8 sw=4:
|
2# $OpenBSD: Log.pm,v 1.9 2014/07/27 22:17:33 espie Exp $
| 2# $OpenBSD: Log.pm,v 1.10 2023/06/13 09:07:17 espie Exp $
|
3# 4# Copyright (c) 2007-2010 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17# 18
| 3# 4# Copyright (c) 2007-2010 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17# 18
|
19use strict; 20use warnings;
| 19use v5.36;
|
21 22package OpenBSD::Log; 23
| 20 21package OpenBSD::Log; 22
|
24sub new
| 23sub new($class, $printer)
|
25{
| 24{
|
26 my ($class, $printer) = @_;
| |
27 bless { p => $printer }, $class; 28} 29
| 25 bless { p => $printer }, $class; 26} 27
|
30sub set_context
| 28sub set_context($self, $context)
|
31{
| 29{
|
32 my ($self, $context) = @_;
| |
33 $self->{context} = $context; 34} 35
| 30 $self->{context} = $context; 31} 32
|
36sub messages
| 33sub messages($self)
|
37{
| 34{
|
38 my $self = shift;
| |
39 $self->{context} //= "???"; 40 return $self->{messages}{$self->{context}} //= []; 41} 42
| 35 $self->{context} //= "???"; 36 return $self->{messages}{$self->{context}} //= []; 37} 38
|
43sub errmessages
| 39sub errmessages($self)
|
44{
| 40{
|
45 my $self = shift;
| |
46 $self->{context} //= "???"; 47 return $self->{errmessages}{$self->{context}} //= []; 48} 49
| 41 $self->{context} //= "???"; 42 return $self->{errmessages}{$self->{context}} //= []; 43} 44
|
50sub f
| 45sub f($self, @p)
|
51{
| 46{
|
52 my $self = shift; 53 $self->{p}->f(@_);
| 47 $self->{p}->f(@p);
|
54} 55
| 48} 49
|
56sub print
| 50sub print($self, @p)
|
57{
| 51{
|
58 my $self = shift; 59 push(@{$self->messages}, $self->f(@_));
| 52 push(@{$self->messages}, $self->f(@p));
|
60} 61
| 53} 54
|
62sub say
| 55sub say($self, @p)
|
63{
| 56{
|
64 my $self = shift; 65 push(@{$self->messages}, $self->f(@_)."\n");
| 57 push(@{$self->messages}, $self->f(@p)."\n");
|
66} 67
| 58} 59
|
68sub errprint
| 60sub errprint($self, @p)
|
69{
| 61{
|
70 my $self = shift; 71 push(@{$self->errmessages}, $self->f(@_));
| 62 push(@{$self->errmessages}, $self->f(@p));
|
72} 73
| 63} 64
|
74sub errsay
| 65sub errsay($self, @p)
|
75{
| 66{
|
76 my $self = shift; 77 push(@{$self->errmessages}, $self->f(@_)."\n");
| 67 push(@{$self->errmessages}, $self->f(@p)."\n");
|
78} 79
| 68} 69
|
80sub specialsort
| 70sub specialsort(@p)
|
81{
| 71{
|
82 return ((sort grep { /^\-/ } @_), (sort grep { /^\+/} @_), 83 (sort grep { !/^[\-+]/ } @_));
| 72 return ((sort grep { /^\-/ } @p), (sort grep { /^\+/} @p), 73 (sort grep { !/^[\-+]/ } @p));
|
84} 85
| 74} 75
|
86sub dump
| 76sub dump($self)
|
87{
| 77{
|
88 my $self = shift;
| |
89 for my $ctxt (specialsort keys %{$self->{errmessages}}) { 90 my $msgs = $self->{errmessages}{$ctxt}; 91 if (@$msgs > 0) { 92 $self->{p}->errsay("--- #1 -------------------", $ctxt); 93 $self->{p}->_errprint(@$msgs); 94 } 95 } 96 $self->{errmessages} = {}; 97 for my $ctxt (specialsort keys %{$self->{messages}}) { 98 my $msgs = $self->{messages}{$ctxt}; 99 if (@$msgs > 0) { 100 $self->{p}->say("--- #1 -------------------", $ctxt); 101 $self->{p}->_print(@$msgs); 102 } 103 } 104 $self->{messages} = {}; 105} 106
| 78 for my $ctxt (specialsort keys %{$self->{errmessages}}) { 79 my $msgs = $self->{errmessages}{$ctxt}; 80 if (@$msgs > 0) { 81 $self->{p}->errsay("--- #1 -------------------", $ctxt); 82 $self->{p}->_errprint(@$msgs); 83 } 84 } 85 $self->{errmessages} = {}; 86 for my $ctxt (specialsort keys %{$self->{messages}}) { 87 my $msgs = $self->{messages}{$ctxt}; 88 if (@$msgs > 0) { 89 $self->{p}->say("--- #1 -------------------", $ctxt); 90 $self->{p}->_print(@$msgs); 91 } 92 } 93 $self->{messages} = {}; 94} 95
|
107sub fatal
| 96sub fatal($self, @p)
|
108{
| 97{
|
109 my $self = shift;
| |
110 if (defined $self->{context}) {
| 98 if (defined $self->{context}) {
|
111 $self->{p}->_fatal($self->{context}, ":", $self->f(@_));
| 99 $self->{p}->_fatal($self->{context}, ":", $self->f(@p));
|
112 } 113
| 100 } 101
|
114 $self->{p}->_fatal($self->f(@_));
| 102 $self->{p}->_fatal($self->f(@p));
|
115} 116
| 103} 104
|
117sub system
| 105sub system($self, @p)
|
118{
| 106{
|
119 my $self = shift; 120 if (open(my $grab, "-|", @_)) {
| 107 if (open(my $grab, "-|", @p)) {
|
121 while (<$grab>) { 122 $self->{p}->_print($_); 123 } 124 if (!close $grab) { 125 $self->{p}->say("system(#1) failed: #2 #3",
| 108 while (<$grab>) { 109 $self->{p}->_print($_); 110 } 111 if (!close $grab) { 112 $self->{p}->say("system(#1) failed: #2 #3",
|
126 join(", ", @_), $!,
| 113 join(", ", @p), $!,
|
127 $self->{p}->child_error); 128 } 129 return $?; 130 } else { 131 $self->{p}->say("system(#1) was not run: #2 #3",
| 114 $self->{p}->child_error); 115 } 116 return $?; 117 } else { 118 $self->{p}->say("system(#1) was not run: #2 #3",
|
132 join(", ", @_), $!, $self->{p}->child_error);
| 119 join(", ", @p), $!, $self->{p}->child_error);
|
133 } 134} 135 1361;
| 120 } 121} 122 1231;
|