112 lines
3.0 KiB
Perl
Executable File
112 lines
3.0 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# $OpenBSD: portslogger,v 1.5 2001/07/26 14:53:53 espie Exp $
|
|
# Copyright (c) 2001 Marc Espie. All rights reserved.
|
|
# Redistribution and use in source and binary forms, with or without
|
|
# modification, are permitted provided that the following conditions
|
|
# are met:
|
|
# 1. Redistributions of code must retain the above copyright
|
|
# notice, this list of conditions and the following disclaimer.
|
|
# 2. Neither the name of OpenBSD nor the names of its contributors
|
|
# may be used to endorse or promote products derived from this software
|
|
# without specific prior written permission.
|
|
#
|
|
# THIS SOFTWARE IS PROVIDED BY ITS AUTHOR AND THE OpenBSD project ``AS IS'' AND
|
|
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
# ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
|
|
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
# SUCH DAMAGE.
|
|
|
|
# This critter recognizes context switch changes in the ports tree
|
|
# and logs its output accordingly, as a kind of `super-tee'
|
|
|
|
{
|
|
package Logger;
|
|
@ISA=qw(IO::File);
|
|
|
|
use File::Path;
|
|
use IO::File;
|
|
use File::Temp qw/tempfile/;
|
|
|
|
our $directory;
|
|
our %temps;
|
|
|
|
|
|
sub setdir
|
|
{
|
|
$directory = shift;
|
|
mkpath $directory;
|
|
die "No logging directory" unless -d $directory;
|
|
}
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my $name = shift;
|
|
$name = "$directory/$name.log";
|
|
my $self = IO::File::new($class, $name, '>>');
|
|
if (!$self) {
|
|
if (defined $temps{$name}) {
|
|
$self = IO::File::new($class, $temps{$name}, '>>');
|
|
} else {
|
|
($self, $temps{$name}) = tempfile(SUFFIX => '.log') or
|
|
die "Can't create any logfile";
|
|
print STDERR "*** Couldn't open $name, \n";
|
|
print STDERR "*** using ".$temps{$name}." instead\n";
|
|
bless $self, $class;
|
|
}
|
|
}
|
|
$self->print("+++ ", `date`);
|
|
$self->autoflush(1);
|
|
return $self;
|
|
}
|
|
|
|
sub close
|
|
{
|
|
my $self = shift;
|
|
print $self "--- ", `date`;
|
|
$self->SUPER::close();
|
|
}
|
|
|
|
sub DESTROY
|
|
{
|
|
my $self = shift;
|
|
$self->close();
|
|
}
|
|
}
|
|
|
|
Logger::setdir(shift);
|
|
|
|
my $logfile = undef;
|
|
my $ncontext = undef;
|
|
|
|
my $context;
|
|
|
|
while (<>) {
|
|
if (m/^\=\=\=\>\s+(?:(?:Extracting|Applying distribution patches|\
|
|
Patching|Configuring|Building|Faking installation|Building package|\
|
|
Deinstalling|Cleaning|Dist cleaning|Checking files|\
|
|
Registering installation)\s+for\s+(.*)|\
|
|
Returning to build of\s+(.*)|Installing\s+(.*?)\s+from)/o) {
|
|
$ncontext = "$1$2$3"; # XXX only one alternative matches
|
|
chomp $ncontext;
|
|
if ($ncontext ne $context) {
|
|
$context = $ncontext;
|
|
$logfile = new Logger $context;
|
|
}
|
|
}
|
|
unless (defined $context) {
|
|
$context = default;
|
|
$logfile = new Logger 'default';
|
|
}
|
|
$logfile->print($_);
|
|
print;
|
|
}
|
|
|