File Coverage

blib/lib/Perl/Critic/Exception/AggregateConfiguration.pm
Criterion Covered Total %
statement 50 51 98.0
branch 9 12 75.0
condition n/a
subroutine 13 13 100.0
pod 6 6 100.0
total 78 82 95.1


line stmt bran cond sub pod time code
1             package Perl::Critic::Exception::AggregateConfiguration;
2              
3 40     40   19939 use 5.010001;
  40         182  
4 40     40   248 use strict;
  40         130  
  40         830  
5 40     40   265 use warnings;
  40         84  
  40         1158  
6              
7 40     40   238 use Carp qw{ confess };
  40         82  
  40         1922  
8 40     40   1318 use Readonly;
  40         7985  
  40         2092  
9              
10 40     40   13329 use Perl::Critic::Utils qw{ :characters };
  40         161  
  40         1445  
11              
12             our $VERSION = '1.150';
13              
14             #-----------------------------------------------------------------------------
15              
16             use Exception::Class (
17 40         381 'Perl::Critic::Exception::AggregateConfiguration' => {
18             isa => 'Perl::Critic::Exception',
19             description => 'A collected set of configuration exceptions.',
20             fields => [ qw{ exceptions } ],
21             alias => 'throw_aggregate',
22             },
23 40     40   23832 );
  40         96  
24              
25             #-----------------------------------------------------------------------------
26              
27             Readonly::Array our @EXPORT_OK => qw< throw_aggregate >;
28              
29             #-----------------------------------------------------------------------------
30              
31             sub new {
32 38292     38292 1 87963 my ($class, %options) = @_;
33              
34 38292         74746 my $exceptions = $options{exceptions};
35 38292 50       92513 if (not $exceptions) {
36 38292         83724 $options{exceptions} = [];
37             }
38              
39 38292         141781 return $class->SUPER::new(%options);
40             }
41              
42             #-----------------------------------------------------------------------------
43              
44             sub add_exception {
45 164     164 1 153877 my ( $self, $exception ) = @_;
46              
47 164         305 push @{ $self->exceptions() }, $exception;
  164         3044  
48              
49 164         1216 return;
50             }
51              
52             #-----------------------------------------------------------------------------
53              
54             sub add_exceptions_from {
55 1     1 1 3 my ( $self, $aggregate ) = @_;
56              
57 1         3 push @{ $self->exceptions() }, @{ $aggregate->exceptions() };
  1         24  
  1         24  
58              
59 1         7 return;
60             }
61              
62             #-----------------------------------------------------------------------------
63              
64             sub add_exception_or_rethrow {
65 21494     21494 1 43137 my ( $self, $eval_error ) = @_;
66              
67 21494 100       54324 return if not $eval_error;
68 2 50       16 confess $eval_error if not ref $eval_error;
69              
70 2 100       33 if ( $eval_error->isa('Perl::Critic::Exception::Configuration') ) {
    50          
71 1         7 $self->add_exception($eval_error);
72             }
73             elsif (
74             $eval_error->isa('Perl::Critic::Exception::AggregateConfiguration')
75             ) {
76 1         6 $self->add_exceptions_from($eval_error);
77             }
78             else {
79 0         0 die $eval_error; ## no critic (RequireCarping)
80             }
81              
82 2         6 return;
83             }
84              
85             #-----------------------------------------------------------------------------
86              
87             sub has_exceptions {
88 38890     38890 1 73405 my ( $self ) = @_;
89              
90 38890 100       59156 return @{ $self->exceptions() } ? 1 : 0;
  38890         723845  
91             }
92              
93             #-----------------------------------------------------------------------------
94              
95             Readonly::Scalar my $MESSAGE_PREFIX => $EMPTY;
96             Readonly::Scalar my $MESSAGE_SUFFIX => "\n";
97             Readonly::Scalar my $MESSAGE_SEPARATOR => $MESSAGE_SUFFIX . $MESSAGE_PREFIX;
98              
99             sub full_message {
100 150     150 1 54365 my ( $self ) = @_;
101              
102 150         362 my $message = $MESSAGE_PREFIX;
103 150         290 $message .= join $MESSAGE_SEPARATOR, @{ $self->exceptions() };
  150         3808  
104 150         172569 $message .= $MESSAGE_SUFFIX;
105              
106 150         434 return $message;
107             }
108              
109             1;
110              
111             #-----------------------------------------------------------------------------
112              
113             __END__
114              
115             =pod
116              
117             =for stopwords
118              
119             =head1 NAME
120              
121             Perl::Critic::Exception::AggregateConfiguration - A collection of a set of problems found in the configuration and/or command-line options.
122              
123             =head1 DESCRIPTION
124              
125             A set of configuration settings can have multiple problems. This is
126             an object for collecting all the problems found so that the user can
127             see them in one run.
128              
129              
130             =head1 INTERFACE SUPPORT
131              
132             This is considered to be a public class. Any changes to its interface
133             will go through a deprecation cycle.
134              
135              
136             =head1 METHODS
137              
138             =over
139              
140             =item C<add_exception( $exception )>
141              
142             Accumulate the parameter with rest of the exceptions.
143              
144              
145             =item C<add_exceptions_from( $aggregate )>
146              
147             Accumulate the exceptions from another instance of this class.
148              
149              
150             =item C<exceptions()>
151              
152             Returns a reference to an array of the collected exceptions.
153              
154              
155             =item C<add_exception_or_rethrow( $eval_error )>
156              
157             If the parameter is an instance of
158             L<Perl::Critic::Exception::Configuration|Perl::Critic::Exception::Configuration>
159             or
160             L<Perl::Critic::Exception::AggregateConfiguration|Perl::Critic::Exception::AggregateConfiguration>,
161             add it. Otherwise, C<die> with the parameter, if it is a reference,
162             or C<confess> with it. If the parameter is false, simply returns.
163              
164              
165             =item C<has_exceptions()>
166              
167             Answer whether any configuration problems have been found.
168              
169              
170             =item C<full_message()>
171              
172             Concatenate the exception messages. See
173             L<Exception::Class/"full_message">.
174              
175              
176             =back
177              
178              
179             =head1 AUTHOR
180              
181             Elliot Shank <perl@galumph.com>
182              
183             =head1 COPYRIGHT
184              
185             Copyright (c) 2007-2023 Elliot Shank
186              
187             This program is free software; you can redistribute it and/or modify
188             it under the same terms as Perl itself. The full text of this license
189             can be found in the LICENSE file included with this module.
190              
191             =cut
192              
193             ##############################################################################
194             # Local Variables:
195             # mode: cperl
196             # cperl-indent-level: 4
197             # fill-column: 78
198             # indent-tabs-mode: nil
199             # c-indentation-style: bsd
200             # End:
201             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :