File Coverage

blib/lib/Error/Mimetic.pm
Criterion Covered Total %
statement 35 35 100.0
branch 6 12 50.0
condition 1 3 33.3
subroutine 6 6 100.0
pod 3 3 100.0
total 51 59 86.4


line stmt bran cond sub pod time code
1             =pod
2            
3             =head1 NAME
4            
5             Error::Mimetic - The error class definition for Crypt::Mimetic(3) (see Error(3) module)
6            
7             =head1 DESCRIPTION
8            
9             This module is a part of Crypt::Mimetic(3) distribution.
10            
11             This module extends I.
12            
13             =cut
14            
15             package Error::Mimetic;
16 1     1   5 use Error;
  1         1  
  1         5  
17 1     1   52 use strict;
  1         2  
  1         42  
18 1     1   5 use vars qw($VERSION);
  1         2  
  1         508  
19             $VERSION = '0.02';
20            
21             =pod
22            
23             =head1 CLASS INTERFACE
24            
25             See Error(3) for details about methods not described below
26            
27             =cut
28            
29             @Error::Mimetic::ISA = qw(Error::Simple);
30            
31             =pod
32            
33             =head2 CONSTRUCTORS
34            
35             Error::Mimetic constructor takes 3 arguments:
36             the first is the error description, the second are details and the last
37             is the type: C (default) or C.
38            
39             =cut
40            
41             sub new {
42 2     2 1 22 my ($self, $text, $details, $type) = @_;
43 2         14 my $s = $self->SUPER::new($text,0);
44 2         2176 $s->{'-object'} = $details;
45 2         9 $s->{'-type'} = "error";
46 2 50       8 $s->{'-type'} = $type if $type;
47 2         7 return $s;
48             }
49            
50             =pod
51            
52             =head2 OVERLOAD METHODS
53            
54             =over 4
55            
56             =item string I ()
57            
58             A method that converts the object into a string.
59            
60             If I<$Error::Debug> is == 0, then only description is printed.
61            
62             If I<$Error::Debug> is > 0, then details are printed after description.
63            
64             If I<$Error::Debug> is > 1, then description, details and informations about files and lines where error raised are printed.
65            
66             =cut
67            
68             sub stringify {
69 2     2 1 14 my $self = shift;
70 2         5 my $cache = $self->{'-cache'};
71 2 50       7 return $cache if $cache;
72 2         6 my $obj = $self->{'-object'};
73 2 50       9 $self->{'-text'} .= ".\n" unless $Error::Debug > 1;
74 2         14 my $s = $self->SUPER::stringify;
75 2 50 33     49 if ($Error::Debug > 0 && $obj) {
76 2         14 my @lines = split /\n/, $obj;
77 2         7 chomp(@lines);
78 2         4 $obj = $lines[0];
79 2         5 chomp $s;
80 2         5 $s .= " - $obj";
81 2         5 chomp $s;
82 2 50       6 if ($Error::Debug < 2) {
83 2 50       21 $s =~ s/ at (\S+) line (\d+)(\.)*$//s ||
84             $s =~ s/ at \(.*?\) line (\d+)(\.)*$//s;
85             }
86 2         576 $s .= "\n";
87             }
88 2         7 $self->{'-cache'} = $s;
89 2         177 return $s;
90             }
91            
92             =pod
93            
94             =head2 OBJECT METHODS
95            
96             =item string I ()
97            
98             Return error type: C (default) or C.
99            
100             =cut
101            
102             sub type {
103 4     4 1 149 my $self = shift;
104 4         13 return $self->{'-type'};
105             }
106            
107             1;
108             __END__