git.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/PolicyParameter/Behavior/StringList.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/PolicyParameter/Behavior/StringList.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::PolicyParameter::Behavior::StringList;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use Perl::Critic::Utils qw{ :characters &words_from_string &hashify };
  15
  16 use base qw{ Perl::Critic::PolicyParameter::Behavior };
  17
  18 our $VERSION = '1.088';
  19
  20 #-----------------------------------------------------------------------------
  21
  22 sub initialize_parameter {
  23     my ($self, $parameter, $specification) = @_;
  24
  25     # Unfortunately, this has to be kept as a reference, rather than a regular
  26     # array, due to a problem in Devel::Cycle
  27     # (http://rt.cpan.org/Ticket/Display.html?id=25360) which causes
  28     # t/92_memory_leaks.t to fall over.
  29     my $always_present_values = $specification->{list_always_present_values};
  30     $parameter->_get_behavior_values()->{always_present_values} =
  31         $always_present_values;
  32
  33     if ( not $always_present_values ) {
  34         $always_present_values = [];
  35     }
  36
  37     $parameter->_set_parser(
  38         sub {
  39             # Normally bad thing, obscuring a variable in a outer scope
  40             # with a variable with the same name is being done here in
  41             # order to remain consistent with the parser function interface.
  42             my ($policy, $parameter, $config_string) = @_;
  43
  44             my @values = @{$always_present_values};
  45             my $value_string = $parameter->get_default_string();
  46
  47             if (defined $config_string) {
  48                 $value_string = $config_string;
  49             }
  50
  51             if ( defined $value_string ) {
  52                 push @values, words_from_string($value_string);
  53             }
  54
  55             my %values = hashify(@values);
  56
  57             $policy->__set_parameter_value($parameter, \%values);
  58
  59             return;
  60         }
  61     );
  62
  63     return;
  64 }
  65
  66 #-----------------------------------------------------------------------------
  67
  68 sub generate_parameter_description {
  69     my ($self, $parameter) = @_;
  70
  71     my $always_present_values =
  72         $parameter->_get_behavior_values()->{always_present_values};
  73
  74     my $description = $parameter->_get_description_with_trailing_period();
  75     if ( $description and $always_present_values ) {
  76         $description .= qq{\n};
  77     }
  78
  79     if ( $always_present_values ) {
  80         $description .= 'Values that are always included: ';
  81         $description .= join ', ', sort @{ $always_present_values };
  82         $description .= $PERIOD;
  83     }
  84
  85     return $description;
  86 }
  87
  88 1;
  89
  90 __END__
  91
  92 #-----------------------------------------------------------------------------
  93
  94 =pod
  95
  96 =for stopwords
  97
  98 =head1 NAME
  99
 100 Perl::Critic::PolicyParameter::Behavior::StringList - Actions appropriate for a parameter that is a list of strings.
 101
 102 NOTE: Do not instantiate this class.  Use the singleton instance held
 103 onto by L<Perl::Critic::PolicyParameter>.
 104
 105
 106 =head1 DESCRIPTION
 107
 108 Provides a standard set of functionality for a string list
 109 L<Perl::Critic::PolicyParameter> so that the developer of a policy
 110 does not have to provide it her/himself.
 111
 112
 113 =head1 METHODS
 114
 115 =over
 116
 117 =item C<initialize_parameter( $parameter, $specification )>
 118
 119 Plug in the functionality this behavior provides into the parameter,
 120 based upon the configuration provided by the specification.
 121
 122 This behavior looks for one configuration item:
 123
 124 =over
 125
 126 =item always_present_values
 127
 128 Optional.  Values that should always be included, regardless of what
 129 the configuration of the parameter specifies, as an array reference.
 130
 131 =back
 132
 133 =item C<generate_parameter_description( $parameter )>
 134
 135 Create a description of the parameter, based upon the description on
 136 the parameter itself, but enhancing it with information from this
 137 behavior.
 138
 139 In this specific case, the always present values are added at the end.
 140
 141 =back
 142
 143
 144 =head1 AUTHOR
 145
 146 Elliot Shank <perl@galumph.com>
 147
 148 =head1 COPYRIGHT
 149
 150 Copyright (c) 2006-2008 Elliot Shank.  All rights reserved.
 151
 152 This program is free software; you can redistribute it and/or modify
 153 it under the same terms as Perl itself.  The full text of this license
 154 can be found in the LICENSE file included with this module.
 155
 156 =cut
 157
 158 # Local Variables:
 159 #   mode: cperl
 160 #   cperl-indent-level: 4
 161 #   fill-column: 78
 162 #   indent-tabs-mode: nil
 163 #   c-indentation-style: bsd
 164 # End:
 165 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :