File Coverage

blib/lib/Perlilog/PLerror.pm
Criterion Covered Total %
statement 7 32 21.8
branch 0 2 0.0
condition n/a
subroutine 2 11 18.1
pod 0 10 0.0
total 9 55 16.3


line stmt bran cond sub pod time code
1             #
2             # This file is part of the Perlilog project.
3             #
4             # Copyright (C) 2003, Eli Billauer
5             #
6             # This program is free software; you can redistribute it and/or modify
7             # it under the terms of the GNU General Public License as published by
8             # the Free Software Foundation; either version 2 of the License, or
9             # (at your option) any later version.
10             #
11             # This program is distributed in the hope that it will be useful,
12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14             # GNU General Public License for more details.
15             #
16             # You should have received a copy of the GNU General Public License
17             # along with this program; if not, write to the Free Software
18             # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19             #
20             # A copy of the license can be found in a file named "licence.txt", at the
21             # root directory of this project.
22             #
23              
24             package Perlilog::PLerror;
25 1     1   3 use strict 'vars';
  1         1  
  1         383  
26             require Exporter;
27              
28             @Perlilog::PLerror::ISA = ('Exporter');
29             @Perlilog::PLerror::EXPORT = qw(blow puke wiz wizreport fishy wrong say hint wink);
30             %Perlilog::PLerror::evalhash = ();
31             %Perlilog::PLerror::packhash = ();
32              
33             sub blow {
34 0     0 0 0 { local $@; require Perlilog::PLerrsys; } # XXX fix require to not clear $@?
  0         0  
  0         0  
35 0         0 my $err = &Perlilog::linebreak("@_");
36 0 0       0 die $err if $err =~ /\n$/;
37 0         0 chomp $err;
38 0         0 die "$err ".oneplace()."\n";
39             }
40              
41             sub puke {
42 0     0 0 0 { local $@; require Perlilog::PLerrsys; } # XXX fix require to not clear $@?
  0         0  
  0         0  
43 0         0 my ($chain, $err)=&stackdump(@_);
44 0         0 die(&Perlilog::linebreak($chain."\nError: $err"));
45             }
46              
47             sub wiz {
48 0     0 0 0 print &Perlilog::linebreak("@_");
49             }
50              
51             sub wizreport {
52 0     0 0 0 { local $@; require Perlilog::PLerrsys; } # XXX fix require to not clear $@?
  0         0  
  0         0  
53 0         0 my ($chain, $err)=&stackdump(@_);
54 0         0 die(&Perlilog::linebreak($chain."\nWiz report: $err"));
55             }
56              
57             sub fishy {
58 0     0 0 0 my $warn = &Perlilog::linebreak("@_");
59 0         0 chomp $warn;
60 0         0 warn "$warn\n";
61             }
62              
63             sub wrong {
64 0     0 0 0 die(&Perlilog::linebreak("@_")."\n");
65 0         0 $Perlilog::wrongflag=1;
66             }
67              
68             sub say {
69 0     0 0 0 print "@_";
70             }
71              
72       0 0   sub hint {
73             # print "@_";
74             }
75              
76             sub wink {
77 0     0 0 0 print "@_";
78             }
79              
80             sub register {
81 5     5 0 5 my $fname = shift;
82 5         13 my ($pack,$file,$line) = caller;
83 5         13 $Perlilog::PLerror::evalhash{$file}=[$pack,$fname,$line];
84 5         763 $Perlilog::PLerror::packhash{$pack}=$fname;
85             }
86              
87             1;