PageRenderTime 37ms CodeModel.GetById 14ms app.highlight 19ms RepoModel.GetById 1ms app.codeStats 0ms

/libs/perl/Choicetool/Base/Trace.pm

#
Perl | 156 lines | 98 code | 38 blank | 20 comment | 5 complexity | 54abde4d58098f7cb36d6519b5c138a3 MD5 | raw file
  1# -*- perl -*-
  2
  3#
  4# Trace.pm
  5#
  6# Copyright (C) 2008, 2009 Francesco Salvestrini
  7#
  8# This program is free software; you can redistribute it and/or modify
  9# it under the terms of the GNU General Public License as published by
 10# the Free Software Foundation; either version 2 of the License, or
 11# (at your option) any later version.
 12#
 13# This program is distributed in the hope that it will be useful,
 14# but WITHOUT ANY WARRANTY; without even the implied warranty of
 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 16# GNU General Public License for more details.
 17#
 18# You should have received a copy of the GNU General Public License along
 19# with this program; if not, write to the Free Software Foundation, Inc.,
 20# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 21#
 22
 23package Choicetool::Base::Trace;
 24
 25use 5.8.0;
 26
 27use warnings;
 28use strict;
 29use diagnostics;
 30
 31use Choicetool::Base::Debug;
 32
 33BEGIN {
 34    use Exporter ();
 35    our ($VERSION, @ISA, @EXPORT);
 36
 37    @ISA    = qw(Exporter);
 38    @EXPORT = qw(&trace_prefix_set
 39                 &error
 40                 &warning &warning_set &warning_get
 41                 &verbose &verbose_set &verbose_get &verbose_inc
 42                 &debug   &debug_set   &debug_get   &debug_inc);
 43}
 44
 45my $trace_prefix = "";
 46my $verbose_mode = 0;
 47my $debug_mode   = 0;
 48my $warning_mode = "none";
 49
 50sub trace_prefix_set ($)
 51{
 52    my $string = shift;
 53
 54    assert(defined($string));
 55
 56    $trace_prefix = $string;
 57}
 58
 59sub error ($)
 60{
 61    my $string = shift;
 62
 63    assert(defined($string));
 64
 65    print $trace_prefix . ": " . $string . "\n";
 66}
 67
 68sub warning_set ($)
 69{
 70    my $string = shift;
 71
 72    $warning_mode = $string;
 73}
 74
 75sub warning_get ()
 76{
 77    return $warning_mode;
 78}
 79
 80sub warning ($)
 81{
 82    my $string = shift;
 83
 84    assert($warning_mode ne "");
 85    assert(defined($string));
 86
 87    if ($warning_mode eq "none") {
 88        return;
 89    }
 90
 91    print $trace_prefix . ": " . $string . "\n";
 92}
 93
 94sub verbose_set ($)
 95{
 96    my $value = shift;
 97
 98    assert($value >= 0);
 99
100    $verbose_mode = $value;
101}
102
103sub verbose_inc ()
104{
105    $verbose_mode = $verbose_mode + 1;
106}
107
108sub verbose_get ()
109{
110    return $verbose_mode;
111}
112
113sub verbose ($)
114{
115    my $string = shift;
116
117    assert(defined($string));
118    assert($verbose_mode >= 0);
119
120    if ($verbose_mode != 0) {
121        print $trace_prefix . ": " . $string . "\n";
122    }
123}
124
125sub debug_set ($)
126{
127    my $value = shift;
128
129    assert($value >= 0);
130
131    $debug_mode = $value;
132}
133
134sub debug_inc ()
135{
136    $debug_mode = $debug_mode + 1;
137}
138
139sub debug_get ()
140{
141    return $debug_mode;
142}
143
144sub debug ($)
145{
146    my $string = shift;
147
148    assert(defined($string));
149    assert($debug_mode >= 0);
150
151    if ($debug_mode != 0) {
152        print $trace_prefix . ": " . $string . "\n";
153    }
154}
155
1561;