File Coverage

blib/lib/HTTP/Exception/Base.pm
Criterion Covered Total %
statement 18 18 100.0
branch 4 4 100.0
condition 3 6 50.0
subroutine 7 7 100.0
pod 3 4 75.0
total 35 39 89.7


line stmt bran cond sub pod time code
1             package HTTP::Exception::Base;
2             $HTTP::Exception::Base::VERSION = '0.04007';
3 27     27   128 use strict;
  27         38  
  27         556  
4 27     27   89 use warnings;
  27         34  
  27         477  
5 27     27   92 use base 'Exception::Class::Base';
  27         30  
  27         9360  
6              
7             ################################################################################
8             # roll our own new, because of message
9             # error, message and status_message are synonyms
10             sub new {
11 708     708 1 348756 my $proto = shift;
12 708   33     2763 my $class = ref $proto || $proto;
13 708         1310 my %params = @_;
14 708 100       1453 $params{status_message} = delete $params{message} if (exists $params{message});
15              
16 708         2260 $class->SUPER::new(%params);
17             }
18              
19             ################################################################################
20             # used by Exception::Class for as_string
21 534     534 1 231501 sub full_message { shift->status_message }
22              
23             ################################################################################
24             # TODO default-value/required fields, maybe moose? but maybe a moose is too heavy
25             # but on the other hand, handmade accessors suck
26             sub status_message {
27 1157 100   1157 0 342156 $_[0]->{status_message} = $_[1] if (@_ > 1);
28 1157   66     5995 return $_[0]->{status_message} ||= $_[0]->_status_message;
29             }
30             *message = \&status_message;
31             *error = \&status_message;
32              
33             ################################################################################
34             # though Exception::Class::Base does have fields, the Fields-Accessor returns ()
35             # so no shift->SUPER::Fields is required
36 1221     1221 1 485061 sub Fields { qw(status_message) }
37              
38             1;
39              
40              
41             =head1 NAME
42              
43             HTTP::Exception::Base - Base Class for exception classes created by HTTP::Exception
44              
45             =head1 VERSION
46              
47             version 0.04007
48              
49             =head1 DESCRIPTION
50              
51             This Class is a Base class for exception classes created by HTTP::Exception.
52             It inherits from L. Please refer to the Documentation
53             of L for methods and accessors a HTTP::Exception inherits.
54              
55             You won't use this Class directly, so refer to L
56             and L. The methods and attributes this Class provides
57             over Exception::Class::Base are described there.
58              
59             =head1 AUTHOR
60              
61             Thomas Mueller, C<< >>
62              
63             =head1 BUGS
64              
65             Please report any bugs or feature requests to
66             C, or through the web interface at
67             L.
68             I will be notified, and then you'll automatically be notified of progress on
69             your bug as I make changes.
70              
71             =head1 SUPPORT
72              
73             You can find documentation for this module with the perldoc command.
74              
75             perldoc HTTP::Exception::Base
76              
77             You can also look for information at:
78              
79             =over 4
80              
81             =item * RT: CPAN's request tracker
82              
83             L
84              
85             =item * AnnoCPAN: Annotated CPAN documentation
86              
87             L
88              
89             =item * CPAN Ratings
90              
91             L
92              
93             =item * Search CPAN
94              
95             L
96              
97             =back
98              
99             =head1 LICENSE AND COPYRIGHT
100              
101             Copyright 2010 Thomas Mueller.
102              
103             This program is free software; you can redistribute it and/or modify it
104             under the terms of either: the GNU General Public License as published
105             by the Free Software Foundation; or the Artistic License.
106              
107             See http://dev.perl.org/licenses/ for more information.
108              
109              
110             =cut