File Coverage

blib/lib/Verilog/Netlist/Logger.pm

Criterion	Covered	Total	%
statement	24	45	53.3
branch	4	8	50.0
condition	4	11	36.3
subroutine	7	12	58.3
pod	5	9	55.5
total	44	85	51.7

# Verilog - Verilog Perl Interface
# See copyright, etc in below POD section.
######################################################################

package Verilog::Netlist::Logger;
require Exporter;
use vars qw($VERSION);
use strict;

$VERSION = '3.480';

# We don't use Verilog::Netlist::Subclass, as this is called from it!

######################################################################
#### Constructors

sub new {
    my $class = shift;
    my $self = {
	_warnings => 0,
	_errors	=> 0,
	_error_unlink_files => {},
	@_
    };
    bless $self, $class;
    return $self;
}

######################################################################
#### Accessors

sub errors {
    my $self = shift;
    $self->{_errors} = shift if $#_>=0;
    return $self->{_errors};
}
sub warnings {
    my $self = shift;
    $self->{_warnings} = shift if $#_>=0;
    return $self->{_warnings};
}

######################################################################
#### Error Handling

sub info {
    my $self = shift;
    my $objref = shift;
    CORE::warn "-Info: ".$objref->fileline.": ".join('',@_);
}

sub warn {
    my $self = shift;
    my $objref = shift;
    CORE::warn "%Warning: ".$objref->fileline.": ".join('',@_);
    $self->warnings($self->warnings+1);
}

sub error {
    my $self = shift;
    my $objref = shift;
    CORE::warn "%Error: ".$objref->fileline.": ".join('',@_);
    $self->errors($self->errors+1);
}

sub exit_if_error {
    my $self = shift;
    my %params = @_;
    my $allow = $params{allow} || "";
    if ($self->errors || ($self->warnings && $allow !~ /warning/)) {
	CORE::warn "Exiting due to errors\n";
	exit(10);
    }
    return ($self->errors + $self->warnings);
}

sub unlink_if_error {
    my $self = shift;
    $self->{_error_unlink_files}{$_[0]} = 1;
}

sub error_unlink {
    my $self = shift;
    foreach my $file (keys %{$self->{_error_unlink_files}}) {
	unlink $file;
	delete $self->{_error_unlink_files}{$file};
    }
}

sub DESTROY {
    my $self = shift;
    my $has_err = $? || $self->errors || $self->warnings;
    if ($has_err) {
	$self->error_unlink;
    }
}

######################################################################
#### Package return
1;
__END__