PageRenderTime 17ms CodeModel.GetById 13ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/libs/perl/Choicetool/Base/Debug.pm

#
Perl | 81 lines | 43 code | 16 blank | 22 comment | 4 complexity | 47534c176bb190c9cd1f2caabe181954 MD5 | raw file
 1# -*- perl -*-
 2
 3#
 4# Debug.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::Debug;
24
25use 5.8.0;
26
27use warnings;
28use strict;
29use diagnostics;
30
31use Carp;
32#use POSIX qw(&exit EXIT_FAILURE EXIT_SUCCESS);
33
34use Choicetool::Autoconfig;
35
36BEGIN {
37    use Exporter ();
38    our ($VERSION, @ISA, @EXPORT);
39
40    @ISA    = qw(Exporter);
41    @EXPORT = qw(&bug
42                 &assert
43                 &missing);
44}
45
46sub bug ($)
47{
48    my $string = shift;
49
50    print STDERR "\n";
51    if (defined($string)) {
52        print STDERR "Bug hit: " . $string . "\n";
53    } else {
54        print STDERR "Bug hit\n";
55    }
56    print STDERR
57        "Please report the problem to "                   .
58        "<" . $Choicetool::Autoconfig::PACKAGE_BUGREPORT . ">\n";
59    print STDERR "\n";
60
61    confess(); # From Carp module
62
63    # We must exit with a different exit code that a generic error (which is 1)
64    exit 88;
65}
66
67sub assert ($)
68{
69    my $expression = shift;
70
71    if ($expression == 0) {
72        bug("Assertion failed !!!");
73    }
74}
75
76sub missing ()
77{
78    bug("Missing code");
79}
80
811;