Perl::Critic::PolicyParameter - Metadata about a parameter for a Policy.

Perl-Critic documentation Contained in the Perl-Critic distribution.

Index

Code Index:

NAME

Top

Perl::Critic::PolicyParameter - Metadata about a parameter for a Policy.

DESCRIPTION

Top

A provider of validation and parsing of parameter values and metadata about the parameter.

INTERFACE SUPPORT

Top

This is considered to be a public class. Any changes to its interface will go through a deprecation cycle.

METHODS

Top

get_name()

Return the name of the parameter. This is the key that will be looked for in the .perlcriticrc.

get_description()

Return an explanation of the significance of the parameter, as provided by the developer of the policy.

get_default_string()

Return a representation of the default value of this parameter as it would appear if it was specified in a .perlcriticrc file.

parse_and_validate_config_value( $parser, $config )

Extract the configuration value for this parameter from the overall configuration and initialize the policy based upon it.

generate_full_description()

Produce a more complete explanation of the significance of this parameter than the value returned by get_description().

If no description can be derived, returns the empty string.

Note that the result may contain multiple lines.

to_formatted_string( $format )

Generate a string representation of this parameter, based upon the format.

The format is a combination of literal and escape characters similar to the way sprintf works. If you want to know the specific formatting capabilities, look at String::Format. Valid escape characters are:

%n

The name of the parameter.

%d

The description, as supplied by the programmer.

%D

The default value, in a parsable form.

%f

The full description, which is an extension of the value returned by %d. Takes a parameter of a prefix for the beginning of each line.

SEE ALSO

Top

"MAKING YOUR POLICY CONFIGURABLE" in Perl::Critic::DEVELOPER

AUTHOR

Top

Elliot Shank <perl@galumph.com>

COPYRIGHT

Top

Copyright (c) 2006-2011 Elliot Shank.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of this license can be found in the LICENSE file included with this module.

Perl-Critic documentation Contained in the Perl-Critic distribution. 
##############################################################################
#      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/distributions/Perl-Critic/lib/Perl/Critic/PolicyParameter.pm $
#     $Date: 2011-05-15 16:34:46 -0500 (Sun, 15 May 2011) $
#   $Author: clonezone $
# $Revision: 4078 $
##############################################################################

package Perl::Critic::PolicyParameter;

use 5.006001;
use strict;
use warnings;
use Readonly;

use base 'Exporter';

Readonly::Array our @EXPORT_OK => qw{ $NO_DESCRIPTION_AVAILABLE };

use String::Format qw{ stringf };

use Perl::Critic::Exception::Fatal::PolicyDefinition
    qw{ throw_policy_definition };
use Perl::Critic::PolicyParameter::Behavior;
use Perl::Critic::PolicyParameter::Behavior::Boolean;
use Perl::Critic::PolicyParameter::Behavior::Enumeration;
use Perl::Critic::PolicyParameter::Behavior::Integer;
use Perl::Critic::PolicyParameter::Behavior::String;
use Perl::Critic::PolicyParameter::Behavior::StringList;

use Perl::Critic::Utils qw{ :characters &interpolate };
use Perl::Critic::Utils::DataConversion qw{ &defined_or_empty };

our $VERSION = '1.116';

Readonly::Scalar our $NO_DESCRIPTION_AVAILABLE => 'No description available.';

#-----------------------------------------------------------------------------

# Grrr... one of the OO limitations of Perl: you can't put references to
# subclases in a superclass (well, not nicely).  This map and method belong
# in Behavior.pm.
Readonly::Hash my %BEHAVIORS =>
    (
        'boolean'     => Perl::Critic::PolicyParameter::Behavior::Boolean->new(),
        'enumeration' => Perl::Critic::PolicyParameter::Behavior::Enumeration->new(),
        'integer'     => Perl::Critic::PolicyParameter::Behavior::Integer->new(),
        'string'      => Perl::Critic::PolicyParameter::Behavior::String->new(),
        'string list' => Perl::Critic::PolicyParameter::Behavior::StringList->new(),
    );

sub _get_behavior_for_name {
    my $behavior_name = shift;

    my $behavior = $BEHAVIORS{$behavior_name}
        or throw_policy_definition qq{There's no "$behavior_name" behavior.};

    return $behavior;
}

#-----------------------------------------------------------------------------

sub new {
    my ($class, $specification) = @_;
    my $self = bless {}, $class;

    defined $specification
        or throw_policy_definition
            'Attempt to create a ', __PACKAGE__, ' without a specification.';

    my $behavior_specification;

    my $specification_type = ref $specification;
    if ( not $specification_type ) {
        $self->{_name} = $specification;

        $behavior_specification = {};
    } else {
        $specification_type eq 'HASH'
            or throw_policy_definition
                'Attempt to create a ',
                __PACKAGE__,
                " with a $specification_type as a specification.",
                ;

        defined $specification->{name}
            or throw_policy_definition
                'Attempt to create a ', __PACKAGE__, ' without a name.';
        $self->{_name} = $specification->{name};

        $behavior_specification = $specification;
    }

    $self->_initialize_from_behavior($behavior_specification);
    $self->_finish_standard_initialization($behavior_specification);

    return $self;
}

# See if the specification includes a Behavior name, and if so, let the
# Behavior with that name plug in its implementations of parser, etc.
sub _initialize_from_behavior {
    my ($self, $specification) = @_;

    my $behavior_name = $specification->{behavior};
    my $behavior;
    if ($behavior_name) {
        $behavior = _get_behavior_for_name($behavior_name);
    } else {
        $behavior = _get_behavior_for_name('string');
    }

    $self->{_behavior} = $behavior;
    $self->{_behavior_values} = {};

    $behavior->initialize_parameter($self, $specification);

    return;
}

# Grab the rest of the values out of the specification, including overrides
# of what the Behavior specified.
sub _finish_standard_initialization {
    my ($self, $specification) = @_;

    my $description =
        $specification->{description} || $NO_DESCRIPTION_AVAILABLE;
    $self->_set_description($description);
    $self->_set_default_string($specification->{default_string});

    $self->_set_parser($specification->{parser});

    return;
}

#-----------------------------------------------------------------------------

sub get_name {
    my $self = shift;

    return $self->{_name};
}

#-----------------------------------------------------------------------------

sub get_description {
    my $self = shift;

    return $self->{_description};
}

sub _set_description {
    my ($self, $new_value) = @_;

    return if not defined $new_value;
    $self->{_description} = $new_value;

    return;
}

sub _get_description_with_trailing_period {
    my $self = shift;

    my $description = $self->get_description();
    if ($description) {
        if ( $PERIOD ne substr $description, ( length $description ) - 1 ) {
            $description .= $PERIOD;
        }
    } else {
        $description = $EMPTY;
    }

    return $description;
}

#-----------------------------------------------------------------------------

sub get_default_string {
    my $self = shift;

    return $self->{_default_string};
}

sub _set_default_string {
    my ($self, $new_value) = @_;

    return if not defined $new_value;
    $self->{_default_string} = $new_value;

    return;
}

#-----------------------------------------------------------------------------

sub _get_behavior {
    my $self = shift;

    return $self->{_behavior};
}

sub _get_behavior_values {
    my $self = shift;

    return $self->{_behavior_values};
}

#-----------------------------------------------------------------------------

sub _get_parser {
    my $self = shift;

    return $self->{_parser};
}

sub _set_parser {
    my ($self, $new_value) = @_;

    return if not defined $new_value;
    $self->{_parser} = $new_value;

    return;
}

#-----------------------------------------------------------------------------

sub parse_and_validate_config_value {
    my ($self, $policy, $config) = @_;

    my $config_string = $config->{$self->get_name()};

    my $parser = $self->_get_parser();
    if ($parser) {
        $parser->($policy, $self, $config_string);
    }

    return;
}

#-----------------------------------------------------------------------------

sub generate_full_description {
    my ($self) = @_;

    return $self->_get_behavior()->generate_parameter_description($self);
}

#-----------------------------------------------------------------------------

sub _generate_full_description {
    my ($self, $prefix) = @_;

    my $description = $self->generate_full_description();

    if (not $description) {
        return $EMPTY;
    }

    if ($prefix) {
        $description =~ s/ ^ /$prefix/xmsg;
    }

    return $description;
}

#-----------------------------------------------------------------------------

sub to_formatted_string {
    my ($self, $format) = @_;

    my %specification = (
        n => sub { $self->get_name() },
        d => sub { defined_or_empty( $self->get_description() ) },
        D => sub { defined_or_empty( $self->get_default_string() ) },
        f => sub { $self->_generate_full_description(@_) },
    );

    return stringf( interpolate($format), %specification );
}

#-----------------------------------------------------------------------------

1;

__END__

#-----------------------------------------------------------------------------


# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 78
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :