X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Farm%2Flibperl-critic-perl%2Flibperl-critic-perl-1.088%2Flib%2FPerl%2FCritic%2FTheme.pm;fp=dev%2Farm%2Flibperl-critic-perl%2Flibperl-critic-perl-1.088%2Flib%2FPerl%2FCritic%2FTheme.pm;h=98670210feecafae8b630be3e0c53f0de0467620;hp=0000000000000000000000000000000000000000;hb=f477fa73365d491991707e7ed9217b48d6994551;hpb=da95c414033799c3a62606f299c3c00b5c77ca11 diff --git a/dev/arm/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Theme.pm b/dev/arm/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Theme.pm new file mode 100644 index 0000000..9867021 --- /dev/null +++ b/dev/arm/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Theme.pm @@ -0,0 +1,244 @@ +############################################################################## +# $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Theme.pm $ +# $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $ +# $Author: clonezone $ +# $Revision: 2489 $ +############################################################################## + +package Perl::Critic::Theme; + +use 5.006001; +use strict; +use warnings; +use English qw(-no_match_vars); +use Readonly; + +use base qw{ Exporter }; + +use List::MoreUtils qw(any); + +use Perl::Critic::Utils qw{ :characters :data_conversion }; +use Perl::Critic::Exception::Fatal::Internal qw{ &throw_internal }; +use Perl::Critic::Exception::Configuration::Option::Global::ParameterValue + qw{ &throw_global_value }; + +#----------------------------------------------------------------------------- + +our $VERSION = '1.088'; + +#----------------------------------------------------------------------------- + +Readonly::Array our @EXPORT_OK => qw{ + $RULE_INVALID_CHARACTER_REGEX + cook_rule +}; + +#----------------------------------------------------------------------------- + +Readonly::Scalar our $RULE_INVALID_CHARACTER_REGEX => + qr/ ( [^()\s\w\d+\-*&|!] ) /xms; + +#----------------------------------------------------------------------------- + +Readonly::Scalar my $CONFIG_KEY => 'theme'; + +#----------------------------------------------------------------------------- + +sub new { + + my ( $class, %args ) = @_; + my $self = bless {}, $class; + $self->_init( %args ); + return $self; +} + +#----------------------------------------------------------------------------- + +sub _init { + + my ($self, %args) = @_; + my $rule = $args{-rule} || $EMPTY; + + if ( $rule =~ m/$RULE_INVALID_CHARACTER_REGEX/xms ) { + throw_global_value + option_name => $CONFIG_KEY, + option_value => $rule, + message_suffix => qq{contains an invalid character: "$1".}; + } + + $self->{_rule} = cook_rule( $rule ); + + return $self; +} + +#----------------------------------------------------------------------------- + +sub rule { + my $self = shift; + return $self->{_rule}; +} + +#----------------------------------------------------------------------------- + +sub policy_is_thematic { + + my ($self, %args) = @_; + my $policy = $args{-policy} + || throw_internal 'The -policy argument is required'; + ref $policy + || throw_internal 'The -policy must be an object'; + + my $rule = $self->{_rule} or return 1; + my %themes = hashify( $policy->get_themes() ); + + # This bit of magic turns the rule into a perl expression that can be + # eval-ed for truth. Each theme name in the rule is translated to 1 or 0 + # if the $policy belongs in that theme. For example: + # + # 'bugs && (pbp || core)' ...could become... '1 && (0 || 1)' + + my $as_code = $rule; #Making a copy, so $rule is preserved + $as_code =~ s/ ( [\w\d]+ ) /exists $themes{$1} || 0/gemx; + my $is_thematic = eval $as_code; ## no critic (ProhibitStringyEval) + + if ($EVAL_ERROR) { + throw_global_value + option_name => $CONFIG_KEY, + option_value => $rule, + message_suffix => q{contains a syntax error.}; + } + + return $is_thematic; +} + +#----------------------------------------------------------------------------- + +sub cook_rule { + my ($raw_rule) = @_; + return if not defined $raw_rule; + + #Translate logical operators + $raw_rule =~ s{\b not \b}{!}ixmg; # "not" -> "!" + $raw_rule =~ s{\b and \b}{&&}ixmg; # "and" -> "&&" + $raw_rule =~ s{\b or \b}{||}ixmg; # "or" -> "||" + + #Translate algebra operators (for backward compatibility) + $raw_rule =~ s{\A [-] }{!}ixmg; # "-" -> "!" e.g. difference + $raw_rule =~ s{ [-] }{&& !}ixmg; # "-" -> "&& !" e.g. difference + $raw_rule =~ s{ [*] }{&&}ixmg; # "*" -> "&&" e.g. intersection + $raw_rule =~ s{ [+] }{||}ixmg; # "+" -> "||" e.g. union + + my $cooked_rule = lc $raw_rule; #Is now cooked! + return $cooked_rule; +} + + +1; + +__END__ + +#----------------------------------------------------------------------------- + +=pod + +=head1 NAME + +Perl::Critic::Theme - Construct thematic sets of policies. + +=head1 DESCRIPTION + +This is a helper class for evaluating theme expressions into sets of Policy +objects. There are no user-serviceable parts here. + +=head1 METHODS + +=over + +=item C<< new( -rule => $rule_expression ) >> + +Returns a reference to a new Perl::Critic::Theme object. C<-rule> is a string +expression that evaluates to true or false for each Policy.. See L<"THEME +RULES"> for more information. + +=item C<< policy_is_thematic( -policy => $policy ) >> + +Given a reference to a L object, this method returns +evaluates the rule against the themes that are associated with the Policy. +Returns 1 if the Policy satisfies the rule, 0 otherwise. + +=item C< rule() > + +Returns the rule expression that was used to construct this Theme. The rule +may have been translated into a normalized expression. See L<"THEME RULES"> +for more information. + +=back + +=head2 THEME RULES + +A theme rule is a simple boolean expression, where the operands are the names +of any of the themes associated with the Perl::Critic::Polices. + +Theme names can be combined with logical operators to form arbitrarily complex +expressions. Precedence is the same as normal mathematics, but you can use +parentheses to enforce precedence as well. Supported operators are: + + Operator Altertative Example + ---------------------------------------------------------------------------- + && and 'pbp && core' + || or 'pbp || (bugs && security)' + ! not 'pbp && ! (portability || complexity) + +See L for more information about customizing the +themes for each Policy. + + +=head1 SUBROUTINES + +=over + +=item C + +Standardize a rule into a almost executable Perl code. The "almost" comes +from the fact that theme names are left as is. + + +=back + + +=head1 CONSTANTS + +=over + +=item C<$RULE_INVALID_CHARACTER_REGEX> + +A regular expression that will return the first character in the matched +expression that is not valid in a rule. + + +=back + + +=head1 AUTHOR + +Jeffrey Thalhammer + +=head1 COPYRIGHT + +Copyright (c) 2006-2008 Jeffrey Thalhammer + +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. + +=cut + +############################################################################## +# 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 :