1# Verilog - Verilog Perl Interface
2# See copyright, etc in below POD section.
3######################################################################
4
5package Verilog::Netlist::Logger;
6require Exporter;
7use vars qw($VERSION);
8use strict;
9
10$VERSION = '3.478';
11
12# We don't use Verilog::Netlist::Subclass, as this is called from it!
13
14######################################################################
15#### Constructors
16
17sub new {
18    my $class = shift;
19    my $self = {
20	_warnings => 0,
21	_errors	=> 0,
22	_error_unlink_files => {},
23	@_
24    };
25    bless $self, $class;
26    return $self;
27}
28
29######################################################################
30#### Accessors
31
32sub errors {
33    my $self = shift;
34    $self->{_errors} = shift if $#_>=0;
35    return $self->{_errors};
36}
37sub warnings {
38    my $self = shift;
39    $self->{_warnings} = shift if $#_>=0;
40    return $self->{_warnings};
41}
42
43######################################################################
44#### Error Handling
45
46sub info {
47    my $self = shift;
48    my $objref = shift;
49    CORE::warn "-Info: ".$objref->fileline.": ".join('',@_);
50}
51
52sub warn {
53    my $self = shift;
54    my $objref = shift;
55    CORE::warn "%Warning: ".$objref->fileline.": ".join('',@_);
56    $self->warnings($self->warnings+1);
57}
58
59sub error {
60    my $self = shift;
61    my $objref = shift;
62    CORE::warn "%Error: ".$objref->fileline.": ".join('',@_);
63    $self->errors($self->errors+1);
64}
65
66sub exit_if_error {
67    my $self = shift;
68    my %params = @_;
69    my $allow = $params{allow} || "";
70    if ($self->errors || ($self->warnings && $allow !~ /warning/)) {
71	CORE::warn "Exiting due to errors\n";
72	exit(10);
73    }
74    return ($self->errors + $self->warnings);
75}
76
77sub unlink_if_error {
78    my $self = shift;
79    $self->{_error_unlink_files}{$_[0]} = 1;
80}
81
82sub error_unlink {
83    my $self = shift;
84    foreach my $file (keys %{$self->{_error_unlink_files}}) {
85	unlink $file;
86	delete $self->{_error_unlink_files}{$file};
87    }
88}
89
90sub DESTROY {
91    my $self = shift;
92    my $has_err = $? || $self->errors || $self->warnings;
93    if ($has_err) {
94	$self->error_unlink;
95    }
96}
97
98######################################################################
99#### Package return
1001;
101__END__
102
103=pod
104
105=head1 NAME
106
107Verilog::Netlist::Logger - Error collection and reporting
108
109=head1 SYNOPSIS
110
111  use Verilog::Netlist::Logger;
112
113  ...
114
115  my $self = Verilog::Netlist::Logger->new();
116  $self->info("We're here\n");
117  $self->warn("Things look bad\n");
118  $self->error("Things are even worse\n");
119  $self->exit_if_error();
120
121=head1 DESCRIPTION
122
123The Verilog::Netlist::Logger is used to report all errors detected by
124Verilog::Netlist::* structures.  By default, Verilog::Netlist creates a new
125Logger object, and passes it down to all contained objects.  Users may
126create their own logger objects to catch or otherwise handle error
127messages.
128
129=head1 MEMBER FUNCTIONS
130
131=over 4
132
133=item $self->error(object, I<Text...>)
134
135Print an error about the object in a standard format.  The object must have
136a fileline method.
137
138=item $self->exit_if_error([allow=>'warning'])
139
140Exits the program if any errors were detected.  Optionally specify
141allow=>'warning' to ignore warnings.
142
143=item $self->info(I<Text...>)
144
145Print an informational about the object in a standard format.  The object
146must have a fileline method.
147
148=item $self->lineno()
149
150The line number the entity was created on.
151
152=item $self->unlink_if_error(I<filename>)
153
154Requests the given file be deleted if any errors are detected when the
155Logger object is destroyed.  Used for temporary files.
156
157=item $self->warn(I<Text...>)
158
159Print a warning about the object in a standard format.  The object must
160have a fileline method.
161
162=back
163
164=head1 DISTRIBUTION
165
166Verilog-Perl is part of the L<https://www.veripool.org/> free Verilog EDA
167software tool suite.  The latest version is available from CPAN and from
168L<https://www.veripool.org/verilog-perl>.
169
170Copyright 2000-2021 by Wilson Snyder.  This package is free software; you
171can redistribute it and/or modify it under the terms of either the GNU
172Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.
173
174=head1 AUTHORS
175
176Wilson Snyder <wsnyder@wsnyder.org>
177
178=head1 SEE ALSO
179
180L<Verilog-Perl>,
181L<Verilog::Netlist>,
182L<Verilog::Netlist::Subclass>
183
184=cut
185