Edit

IABSD.fr/ports/infrastructure/lib/DPB/Logger.pm

Branch :

  • Show log

    Commit

  • Author : espie
    Date : 2017-06-20 15:46:18
    Hash : 9b273824
    Message : move redirect to UserProxy and introduce write_error. redirect is only called thru a user, so have the error message be more helpful in telling which user can't perform the redirect. likewise, write_error should tell which user is involved. don't wrap redirect_fh in run_as, because we're not opening any new file.

  • infrastructure/lib/DPB/Logger.pm
  • # ex:ts=8 sw=4:
    # $OpenBSD: Logger.pm,v 1.25 2017/06/20 15:46:18 espie Exp $
    #
    # Copyright (c) 2010-2013 Marc Espie <espie@openbsd.org>
    #
    # Permission to use, copy, modify, and distribute this software for any
    # purpose with or without fee is hereby granted, provided that the above
    # copyright notice and this permission notice appear in all copies.
    #
    # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
    # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
    # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
    # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
    # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
    # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
    # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
    
    use strict;
    use warnings;
    use DPB::User;
    
    package DPB::Logger;
    our @ISA = (qw(DPB::UserProxy));
    use File::Path;
    use File::Basename;
    use IO::File;
    
    sub new
    {
    	my ($class, $state) = @_;
    	if (!defined $state->{log_user}) {
    		die "Too early";
    	}
    	bless {logdir => $state->logdir, user => $state->{log_user}, 
    	    clean => $state->opt('c')}, $class;
    }
    
    sub logfile
    {
    	my ($self, $name) = @_;
    	my $log = "$self->{logdir}/$name.log";
    	$self->make_path(File::Basename::dirname($log));
    	return $log;
    }
    
    sub _open
    {
    	my ($self, $mode, $name) = @_;
    	my $log = $self->logfile($name);
    	my $fh = $self->open($mode, $log);
    	if (defined $fh) {
    		return $fh;
    	} else {
    		$self->write_error($log);
    	}
    }
    
    sub append
    {
    	die if @_ > 2;
    	my ($self, $name) = @_;
    	return $self->_open('>>', $name);
    }
    
    sub create
    {
    	my ($self, $name) = @_;
    	return $self->_open('>', $name);
    }
    
    sub log_pkgpath
    {
    	my ($self, $v) = @_;
    	return $self->logfile("/paths/".$v->fullpkgpath);
    }
    
    sub testlog_pkgpath
    {
    	my ($self, $v) = @_;
    	return $self->logfile("/tests/".$v->fullpkgpath);
    }
    
    sub log_pkgname
    {
    	my ($self, $v) = @_;
    	if ($v->has_fullpkgname) {
    		return $self->logfile("/packages/".$v->fullpkgname);
    	} else {
    		return $self->logfile("/nopkgname/".$v->fullpkgpath);
    	}
    }
    
    sub link
    {
    	my ($self, $a, $b) = @_;
    	$self->run_as(
    	    sub {
    		if ($self->{clean}) {
    			unlink($b);
    		}
    		my $src = File::Spec->catfile(
    		    File::Spec->abs2rel($self->{logdir}, 
    		    File::Basename::dirname($b)),
    		    File::Spec->abs2rel($a, $self->{logdir}));
    		symlink($src, $b);
    	    });
    }
    
    sub make_logs
    {
    	my ($self, $v) = @_;
    	my $log = $self->log_pkgpath($v);
    	if ($self->{clean}) {
    		$self->unlink($log);
    	}
    	my $fh = $self->open(">>", $log);
    	DPB::Util->die_bang($self->user->user. " can't write to $log") 
    	    unless defined $fh;
    	for my $w ($v->build_path_list) {
    		$self->link($log, $self->log_pkgname($w));
    	}
    	return ($log, $fh);
    }
    
    sub make_test_logs
    {
    	my ($self, $v) = @_;
    	my $log = $self->testlog_pkgpath($v);
    	if ($self->{clean}) {
    		$self->unlink($log);
    	}
    }
    
    sub log_error
    {
    	my ($self, $v, @messages) = @_;
    	my ($log, $fh) = $self->make_logs($v);
    	for my $msg (@messages) {
    		print $fh $msg, "\n";
    	}
    	$v->print_parent($fh);
    }
    
    sub make_distlogs
    {
    	my ($self, $f) = @_;
    	return $self->logfile("/dist/".$f->{name});
    }
    
    sub make_log_link
    {
    	my ($self, $v) = @_;
    	$self->run_as(
    	    sub {
    		my $file = $self->log_pkgname($v);
    		# we were built, but we don't link, so try the main pkgpath.
    		if (!-e $file) {
    			my $mainlog = $self->log_pkgpath(DPB::PkgPath->new($v->pkgpath_and_flavors));
    			if (-e $mainlog) {
    				$self->link($mainlog, $file);
    			}
    			# okay, so it was built through another flavor, 
    			# don't bother for now, 
    			# it will all solve itself eventually
    		}
    		$self->link($file, $self->log_pkgpath($v));
    	    });
    }
    
    1;