git.maemo.org Git - dh-make-perl/blob - dev/arm/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Exception/AggregateConfiguration.pm

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