File Coverage

blib/lib/App/HL7/Compare/Exception.pm
Criterion Covered Total %
statement 20 31 64.5
branch 0 4 0.0
condition n/a
subroutine 7 9 77.7
pod 0 2 0.0
total 27 46 58.7


line stmt bran cond sub pod time code
1             package App::HL7::Compare::Exception;
2             $App::HL7::Compare::Exception::VERSION = '0.002';
3 4     4   53 use v5.10;
  4         14  
4 4     4   20 use strict;
  4         8  
  4         96  
5 4     4   20 use warnings;
  4         8  
  4         121  
6              
7 4     4   24 use Moo;
  4         20  
  4         23  
8 4     4   1522 use Mooish::AttributeBuilder -standard;
  4         65  
  4         56  
9 4     4   497 use Types::Standard qw(Str Maybe ArrayRef);
  4         10  
  4         25  
10              
11             use overload
12 4         40 q{""} => "to_string",
13 4     4   7045 fallback => 1;
  4         8  
14              
15             has param 'message' => (
16             isa => Str,
17             );
18              
19             has field 'caller' => (
20             isa => Maybe [ArrayRef],
21             default => sub {
22             for my $call_level (1 .. 10) {
23             my ($package, $file, $line) = caller $call_level;
24             if (defined $package && $package !~ /^App::HL7::Compare/) {
25             return [$package, $file, $line];
26             }
27             }
28             return undef;
29             },
30             );
31              
32             sub raise
33             {
34 0     0 0   my ($self, $error) = @_;
35              
36 0 0         if (defined $error) {
37 0           $self = $self->new(message => $error);
38             }
39              
40 0           die $self;
41             }
42              
43             sub to_string
44             {
45 0     0 0   my ($self) = @_;
46              
47 0           my $raised = $self->message;
48 0           $raised =~ s/\s+\z//;
49              
50 0           my $caller = $self->caller;
51 0 0         if (defined $caller) {
52 0           $raised .= ' (raised at ' . $caller->[1] . ', line ' . $caller->[2] . ')';
53             }
54              
55 0           return "An error occured in HL7 subroutines: $raised";
56             }
57              
58             1;
59