File Coverage

web/cgi-bin/yatt.lib/YATT/Exception.pm
Criterion Covered Total %
statement 36 50 72.0
branch 9 30 30.0
condition 0 18 0.0
subroutine 10 14 71.4
pod 0 7 0.0
total 55 119 46.2


line stmt bran cond sub pod time code
1             package YATT::Exception;
2 7     7   38 use strict;
  7         13  
  7         204  
3 7     7   37 use warnings qw(FATAL all NONFATAL misc);
  7         12  
  7         355  
4 7     7   38 use base qw(YATT::Class::Configurable);
  7         14  
  7         667  
5 7     7   36 BEGIN {require Exporter; *import = \&Exporter::import}
  7         171  
6              
7 7     7   36 use overload '""' => 'string';
  7         10  
  7         63  
8              
9             sub Exception () {__PACKAGE__}
10              
11             our @EXPORT_OK = qw(Exception is_normal_end can_retry);
12             our @EXPORT = @EXPORT_OK;
13              
14 7     7   2554 use YATT::LRXML::Node qw(stringify_node);
  7         15  
  7         781  
15              
16 7         63 use YATT::Fields qw(cf_normal cf_error
17             cf_caller
18             cf_other
19             cf_retry
20             cf_node_obj cf_node cf_file cf_line
21             cf_error_title
22             cf_error_fmt
23             cf_error_param
24             cf_original_error
25 7     7   45 );
  7         11  
26             # cf_phase cf_target
27              
28             sub title {
29 0     0 0 0 (my MY $err) = @_;
30 0 0       0 $err->{cf_error_title} || do {
31 0         0 my $msg = $err->simple;
32 0 0       0 $msg =~ s/[\(:\n].*// if defined $msg;
33 0         0 $msg;
34             };
35             }
36              
37             sub simple {
38 55     55 0 103 (my MY $err) = @_;
39 55 50       181 $err->{cf_error} || do {
40 55         99 my $msg = '';
41             $msg .= sprintf($err->{cf_error_fmt}
42 42 50       211 , map {defined $_ ? $_ : "(null)"}
43 55 50       246 map {$_ ? @$_ : ()} $err->{cf_error_param})
44 55 50       223 if $err->{cf_error_fmt};
45 55         243 $msg
46             };
47             }
48              
49             sub string {
50 55     55 0 295 (my MY $err) = @_;
51 55 50       220 $err->{cf_error} || do {
52 55         149 $err->simple . " " . $err->error_place . "\n";
53             };
54             }
55              
56             sub error_node {
57 0     0 0 0 (my MY $err) = @_;
58 0 0       0 $err->{cf_node} || do {
59 0 0       0 $err->{cf_node_obj} ? stringify_node($err->{cf_node_obj}) : ""
60             };
61             }
62              
63             sub error_place {
64 55     55 0 83 (my MY $err) = @_;
65 55         87 my $place = '';
66 55 100       222 $place .= "($err->{cf_node}), " if $err->{cf_node};
67 55 50       200 $place .= "at file $err->{cf_file}" if $err->{cf_file};
68 55 50       186 $place .= " line $err->{cf_line}" if $err->{cf_line};
69 55         565 $place;
70             }
71              
72             sub is_normal_end {
73 0     0 0   (my MY $err) = @_;
74             ref $err
75             and UNIVERSAL::isa($err, MY)
76             and not $err->{cf_error}
77 0 0 0       and $err->{cf_normal};
      0        
78             }
79              
80             sub can_retry {
81 0     0 0   (my MY $err) = @_;
82             return unless
83             ref $err
84             and UNIVERSAL::isa($err, MY)
85             and not $err->{cf_error}
86             and $err->{cf_retry}
87 0 0 0       and ref $err->{cf_retry} eq 'ARRAY';
      0        
      0        
      0        
88 0 0         wantarray ? @{$err->{cf_retry}} : $err->{cf_retry};
  0            
89             }
90              
91             1;