diff options
-rw-r--r-- | ChangeLog | 8 | ||||
-rw-r--r-- | Makefile.PL | 6 | ||||
-rw-r--r-- | TODO | 4 | ||||
-rw-r--r-- | lib/Tree/Transform/XSLTish.pm | 159 | ||||
-rw-r--r-- | lib/Tree/Transform/XSLTish/Context.pm | 12 | ||||
-rw-r--r-- | lib/Tree/Transform/XSLTish/Transformer.pm | 142 | ||||
-rw-r--r-- | lib/Tree/Transform/XSLTish/Utils.pm | 30 | ||||
-rw-r--r-- | t/00-author-critic.t | 35 | ||||
-rw-r--r-- | t/00-author-minver.t | 33 | ||||
-rw-r--r-- | t/00-author-pod.t | 33 | ||||
-rw-r--r-- | t/01-basic.t | 5 | ||||
-rw-r--r-- | t/02-inherit.t | 14 | ||||
-rw-r--r-- | t/03-byname.t | 5 | ||||
-rw-r--r-- | t/04-errors.t | 5 | ||||
-rw-r--r-- | t/05-html-tree.t | 6 | ||||
-rw-r--r-- | t/perlcriticrc | 122 |
16 files changed, 562 insertions, 57 deletions
diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..7ce649d --- /dev/null +++ b/ChangeLog @@ -0,0 +1,8 @@ +.. -*- mode: rst; coding: utf-8 -*- + +0.2 2009-04-30 + - fixed Perl::Critic tests + - fixed perl version requirement + +0.1 2009-04-27 + - initial version diff --git a/Makefile.PL b/Makefile.PL index 9fc553e..d387a46 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -6,14 +6,16 @@ all_from 'lib/Tree/Transform/XSLTish.pm'; requires 'Tree::XPathEngine' => 0, 'Moose' => 0, - 'MooseX::AttributeHelpers' => 0, + 'Class::MOP' => 0, 'Params::Validate' => 0, 'Carp::Clan' => 0, 'Sub::Exporter' => 0, + 'MooseX::AttributeHelpers' => 0, + 'perl' => '5.6.0', ; test_requires 'Test::Most' => 0, - 'Tree::DAG_Node::XPath' => 0, + 'Tree::DAG_Node::XPath' => '0.10', ; WriteAll; @@ -1 +1,5 @@ .. -*- mode: rst; coding: utf-8 -*- + +* test modifica contesto +* apply_imports +* sort? diff --git a/lib/Tree/Transform/XSLTish.pm b/lib/Tree/Transform/XSLTish.pm index e754cd0..e489992 100644 --- a/lib/Tree/Transform/XSLTish.pm +++ b/lib/Tree/Transform/XSLTish.pm @@ -6,12 +6,14 @@ use Params::Validate ':all'; use Tree::Transform::XSLTish::Utils; use Tree::Transform::XSLTish::Transformer; use Carp::Clan qw(^Tree::Transform::XSLTish); +use 5.006; -our $VERSION='0.1'; +our $VERSION='0.2'; my @DEFAULT_EXPORTS=('tree_rule', 'default_rules', - 'new_transformer' => {-as => 'new'}); + 'new_transformer' => {-as => 'new'}, + ); Sub::Exporter::setup_exporter({ exports => [qw(tree_rule default_rules new_transformer engine_class engine_factory)], @@ -40,7 +42,7 @@ sub tree_rule { }); # TODO at least one of 'name' and 'match' must be specified - # TODO default priority mased on match + # TODO default priority based on match my $store=Tree::Transform::XSLTish::Utils::_rules_store(scalar caller); @@ -61,8 +63,10 @@ sub tree_rule { sub engine_class { my ($classname)=@_; - my $factory=Tree::Transform::XSLTish::Utils::_engine_factory(scalar caller); - $$factory=sub{$classname->new()}; + Tree::Transform::XSLTish::Utils::_set_engine_factory( + scalar caller, + sub{$classname->new()}, + ); return; } @@ -70,18 +74,18 @@ sub engine_class { sub engine_factory(&) { my ($new_factory)=@_; - my $factory=Tree::Transform::XSLTish::Utils::_engine_factory(scalar caller); - $$factory=$new_factory; + Tree::Transform::XSLTish::Utils::_set_engine_factory( + scalar caller, + $new_factory, + ); return; } -sub _transformer_class { 'Tree::Transform::XSLTish::Transformer' }; - sub new_transformer { my $rules_package=shift; - return _transformer_class->new(rules_package=>$rules_package,@_); + return Tree::Transform::XSLTish::Transformer->new(rules_package=>$rules_package,@_); } 1; @@ -117,6 +121,8 @@ Transforming an HTML document: use strict; use warnings; + engine_class 'XML::XPathEngine'; + default_rules; tree_rule match => 'img[@alt="pick"]', action => sub { @@ -124,13 +130,12 @@ Transforming an HTML document: }; package main; - use XML::XPathEngine; use HTML::TreeBuilder::XPath; my $tree=HTML::TreeBuilder::XPath->new(); $tree->parse_file('mypage.html'); - my $trans=HtmlTransform->new(engine=>XML::XPathEngine->new()); + my $trans=HtmlTransform->new(); my ($image_srce)=$trans->transform($tree); =head1 DESCRIPTION @@ -153,6 +158,136 @@ that are compatible with the XPath engine; for example, L<Tree::DAG_Node::XPath> if you use L<Tree::XPathEngine>, or L<HTML::TreeBuilder::XPath> if you use L<XML::XPathEngine>. +=head1 EXPORTS + +=head2 C<tree_rule> + + tree_rule match => '//node_name', + priority => 1, + action => sub { ... }; + +This is the basic fuction to declare a transformation rule; it's +equivalent to the C<template> element is XSLT. It takes its parameters +as a hash: + +=over 4 + +=item C<match> + +this is equivalent to the C<match> attribute of C<template>: it +specifies the pattern for the nodes to which this rule applies. + +From the L<XSLT spec|http://www.w3.org/TR/xslt.html#NT-Pattern>: + +I<A pattern is defined to match a node if and only if there is a +possible context such that when the pattern is evaluated as an +expression with that context, the node is a member of the resulting +node-set. When a node is being matched, the possible contexts have a +context node that is the node being matched or any ancestor of that +node, and a context node list containing just the context node.> + +=item C<name> + +this is equivalent of the C<name> attribute of C<template>: it allows +calling rules by name (see +L<call_rule|Tree::Transform::XSLTish::Transformer/call_rule>) + +=item C<priority> + +this is equivalent of the C<priority> attribute of C<template>; +currently the "default priority" as specified in the +L<spec|http://www.w3.org/TR/xslt.html#conflict> is not implemented + +=item C<action> + +this code-ref will be called (in list context) when the rule is to be +applied; it can return whatever you want: +L<call_rule|Tree::Transform::XSLTish::Transformer/call_rule> will +return the result unchanged, +L<apply_rules|Tree::Transform::XSLTish::Transformer/apply_rules> will +return the list of all results of all the applied rules + +=back + +The C<action> code-ref will be called (by +L<apply_rules|Tree::Transform::XSLTish::Transformer/apply_rules> or +L<call_rule|Tree::Transform::XSLTish::Transformer/call_rule>) with a +L<Tree::Transform::XSLTish::Transformer> object as its only parameter. + +=head2 C<default_rules> + +This function will declare two rules that mimic the implicit rules of +XSLT. It's equivalent to: + + tree_rule match => '/', priority => 0, action => sub {$_[0]->apply_rules}; + tree_rule match => '*', priority => 0, action => sub {$_[0]->apply_rules}; + +=head2 C<engine_class> + + engine_class 'XML::LibXML::XPathContext'; + +This function declares that the +L<Tree::Transform::XSLTish::Transformer> object returned by L</new> +should use this class to build its XPath engine. + +This function is not exported by default: you have to use the module as: + + use Tree::Transform::XSLTish ':engine'; + +=head2 C<engine_factory> + + engine_factory { My::XPath::Engine->new(params=>$whatever) }; + +This function declares that the +L<Tree::Transform::XSLTish::Transformer> object returned by L</new> +should call the passed code-ref to get its engine. + +C<engine_class $classname> is equivalent to C<engine_factory { +$classname->new }>. + +This function is not exported by default: you have to use the module as: + + use Tree::Transform::XSLTish ':engine'; + +=head2 C<new> + +Returns a L<Tree::Transform::XSLTish::Transformer> for the rules +declared in this package. + +=head1 INHERITANCE + +L<Stylesheet import|http://www.w3.org/TR/xslt.html#import> is implented +with the usual Perl inheritance scheme. It should even work with +L<Class::C3>, since we use L<Class::MOP>'s C<class_precedence_list> to +get the list of inherited packages. + +Engine factories are inherited, too, so you can extend a rules package +without re-specifying the engine (you can, of course, override this +and specify another one). + +=head1 IMPORTING + +This module uses L<Sub::Exporter>, see that module's documentation for +things like renaming the imports. + +=head1 KNOWN BUGS & ISSUES + +=over 4 + +=item * + +It's I<slow>. Right now each rule application is linear in the number +of defined rules I<times> the depth of the node being +transformed. There are several ways to optimize this for most common +cases (patches welcome), but I prefer to "make it correct, before +making it fast" + +=item * + +Some sugaring with L<Devel::Declare> could make everything look better + +=back + =head1 AUTHOR Gianni Ceccarelli <dakkar@thenautilus.net> diff --git a/lib/Tree/Transform/XSLTish/Context.pm b/lib/Tree/Transform/XSLTish/Context.pm index 2e696a5..bb7c9de 100644 --- a/lib/Tree/Transform/XSLTish/Context.pm +++ b/lib/Tree/Transform/XSLTish/Context.pm @@ -2,8 +2,20 @@ package Tree::Transform::XSLTish::Context; use Moose; use Carp::Clan qw(^Tree::Transform::XSLTish); +our $VERSION='0.2'; + has 'current_node' => ( is => 'rw', isa => 'Object' ); has 'node_list' => ( is => 'rw', isa => 'ArrayRef[Object]' ); __PACKAGE__->meta->make_immutable;no Moose;1; __END__ + +=head1 NAME + +Tree::Transform::XSLTish::Context - helper class + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=cut diff --git a/lib/Tree/Transform/XSLTish/Transformer.pm b/lib/Tree/Transform/XSLTish/Transformer.pm index fd61ea6..a36bd6a 100644 --- a/lib/Tree/Transform/XSLTish/Transformer.pm +++ b/lib/Tree/Transform/XSLTish/Transformer.pm @@ -8,14 +8,12 @@ use Tree::Transform::XSLTish::Context; use Tree::XPathEngine; use Carp::Clan qw(^Tree::Transform::XSLTish); +our $VERSION='0.2'; + subtype 'Tree::Transform::XSLTish::Engine' => as 'Object' => where { - my $object=$_; - for my $meth (qw(findnodes)) { - return unless $object->can($meth); - } - return 1; + return $_->can('findnodes') ? 1 : (); }; has 'rules_package' => (is => 'ro', isa => 'ClassName'); @@ -44,15 +42,15 @@ sub _build_engine { my ($self)=@_; if ($self->rules_package) { - my $factory=Tree::Transform::XSLTish::Utils::_engine_factory($self->rules_package); - if ($$factory) { - return $$factory->(); + my $factory=$self->rules_package->can($Tree::Transform::XSLTish::Utils::ENGINE_FACTORY_NAME); + if ($factory) { + return $factory->(); } } return Tree::XPathEngine->new(); } -sub it { $_[0]->context->current_node } +sub it { return $_[0]->context->current_node } sub transform { my ($self,$tree)=@_; @@ -115,7 +113,7 @@ sub find_rule { return $ret if $ret; } - croak "No valid rule"; + croak 'No valid rule'; } sub find_rule_by_name { @@ -140,16 +138,18 @@ sub find_rule_in_package { my $rules=$store->{by_match}; my @candidates= - sort { $b->{priority} <=> $a->{priority} } - grep { $self->rule_matches($_) } @$rules; + sort { $b->{priority} <=> $a->{priority} } ## no critic (ProhibitReverseSortBlock) + grep { $self->rule_matches($_) } @{$rules}; if (@candidates > 1 and $candidates[0]->{priority} == $candidates[1]->{priority}) { - croak "Ambiguous rule application"; + croak 'Ambiguous rule application'; } elsif (@candidates >= 1) { return $candidates[0]; } + + return; } sub find_rule_by_name_in_package { @@ -200,7 +200,7 @@ sub rule_matches { __PACKAGE__->meta->make_immutable;no Moose; -package Tree::Transform::XSLTish::ContextGuard; +package Tree::Transform::XSLTish::ContextGuard; ## no critic (ProhibitMultiplePackages) sub new { my ($class,$trans,$context)=@_; @@ -210,7 +210,121 @@ sub new { sub DESTROY { $_[0]->{trans}->leave(); + return; } 1; __END__ + +=head1 NAME + +Tree::Transform::XSLTish::Transformer - transformer class for L<Tree::Transform::XSLTish> + +=head1 METHODS + +=head2 C<new> + + $trans=Tree::Transform::XSLTish::Transformer->new( + rules_package => 'Some::Package', + engine => $engine_instance, + ); + +You usually don't call this constructor directly, but instead use L<< +the C<new> function exported by +Tree::Transform::XSLTish|Tree::Transform::XSLTish/new >>, which passes +the correct C<rules_package> automatically. + +If you don't specify an C<engine>, it will be constructed using the +class or factory declared in the rules package; if you didn't declare +anything, it will be an instance of L<Tree::XPathEngine>. + +=head2 C<transform> + + @results=$trans->transform($tree); + +When you call this function on a tree, the transformer will transform +it according to your rules and to the L<XSLT processing +model|http://www.w3.org/TR/xslt.html#section-Processing-Model>. + +C<< $trans->transform($node) >> is equivalent to C<< +$trans->apply_rules($trans->engine->findnodes('/',$node)) >>. + +Always call this method in list context. + +=head2 C<apply_rules> + + $trans->apply_rules(@nodes); + +Just like C<apply-rules> in XSLT, this function will apply the rules +to the specified nodes, or to the children of the current node if none +are passed, and return all the results in a single list. + +This will die if there are no matching rules, or if there are more +than one matching rule with highest priority. + +Always call this method in list context. + +=head2 C<call_rule> + + $trans->call_rule('rule-name'); + +This fuction will apply the named rule to the current node, and return +the result. + +This will die if there is no rule with the given name. + +Always call this method in list context. + +=head2 C<it> + + $current_node = $trans->it; + +Inside a rule, this fuction will return the node to which the rule is +being applied. + +=head1 INTERNAL FUNCTIONS + +These functions should not be called from outside this module. + +=head2 C<find_rule> + +For each package in the linearized inheritance chain of the rules +package on which this transformer has been instantiated, calls +L<find_rule_in_package> and returns the first defined result. + +=head2 C<find_rule_in_package> + +Gets all the rules having a C<match> attribute, filters those for +which L<rule_matches> returns true, sorts them priority, and returns +the one with the highest priority. + +Dies if there is more than one rule with the highest priority; returns +undef if there are no matching rules. + +=head2 C<find_rule_by_name> + +For each package in the linearized inheritance chain of the rules +package on which this transformer has been instantiated, calls +L<find_rule_by_name_in_package> and returns the first defined result. + +=head2 C<find_rule_by_name_in_package> + +Returns the rule with the given name, if any; returns undef otherwise. + +=head2 C<rule_matches> + +Evaluates the C<match> XPath expression in a sequence of contexts, to +see if the current node appears in the resulting node-set. If it does, +returns true; if there is no such context, returns false. + +The first context is the current node; following contexts are each the +parent node of the previous one. + +NOTE: to check whether a node appears in a node-set, we either use the +C<isSameNode> method, or check the stringifications for equality. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=cut diff --git a/lib/Tree/Transform/XSLTish/Utils.pm b/lib/Tree/Transform/XSLTish/Utils.pm index bed1167..c760585 100644 --- a/lib/Tree/Transform/XSLTish/Utils.pm +++ b/lib/Tree/Transform/XSLTish/Utils.pm @@ -3,26 +3,29 @@ use strict; use warnings; use Class::MOP; +our $VERSION='0.2'; + my $RULES_NAME='%_tree_transform_rules'; sub _rules_store { my $pack=Class::MOP::Class->initialize($_[0]); - if (! $pack->has_package_symbol($RULES_NAME) ) { + if (! $pack->has_package_symbol($RULES_NAME) ) { $pack->add_package_symbol($RULES_NAME,{}); } return $pack->get_package_symbol($RULES_NAME); } -my $ENGINE_FACTORY_NAME='$_tree_transform_engine_factory'; +our $ENGINE_FACTORY_NAME='_tree_transform_engine_factory'; +my $ENGINE_FACTORY_NAME_WITH_SIGIL='&'.$ENGINE_FACTORY_NAME; -sub _engine_factory { - my $pack=Class::MOP::Class->initialize($_[0]); +sub _set_engine_factory { + my ($pack_name,$factory)=@_; + my $pack=Class::MOP::Class->initialize($pack_name); - if (! $pack->has_package_symbol($ENGINE_FACTORY_NAME) ) { - $pack->add_package_symbol($ENGINE_FACTORY_NAME,undef); - } - return $pack->get_package_symbol($ENGINE_FACTORY_NAME); + $pack->add_package_symbol($ENGINE_FACTORY_NAME_WITH_SIGIL,$factory); + + return; } @@ -31,3 +34,14 @@ sub _get_inheritance { } 1; +__END__ + +=head1 NAME + +Tree::Transform::XSLTish::Utils - utility functions + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=cut diff --git a/t/00-author-critic.t b/t/00-author-critic.t new file mode 100644 index 0000000..79ed2b7 --- /dev/null +++ b/t/00-author-critic.t @@ -0,0 +1,35 @@ +#!/usr/bin/perl + +# Test that the module passes perlcritic +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +my @MODULES = ( + 'Perl::Critic 1.098', + 'Test::Perl::Critic 1.01', + 'File::Spec', +); + +# Don't run tests during end-user installs +use Test::More; +unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { + plan( skip_all => "Author tests not required for installation" ); +} + +# Load the testing modules +foreach my $MODULE ( @MODULES ) { + eval "use $MODULE"; + if ( $@ ) { + $ENV{RELEASE_TESTING} + ? die( "Failed to load required release-testing module $MODULE" ) + : plan( skip_all => "$MODULE not available for testing" ); + } +} +my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); +Test::Perl::Critic->import( -profile => $rcfile ); +all_critic_ok(); + +1; diff --git a/t/00-author-minver.t b/t/00-author-minver.t new file mode 100644 index 0000000..4dfb876 --- /dev/null +++ b/t/00-author-minver.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl + +# Test that our declared minimum Perl version matches our syntax +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +my @MODULES = ( + 'Perl::MinimumVersion 1.20', + 'Test::MinimumVersion 0.008', +); + +# Don't run tests during end-user installs +use Test::More; +unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { + plan( skip_all => "Author tests not required for installation" ); +} + +# Load the testing modules +foreach my $MODULE ( @MODULES ) { + eval "use $MODULE"; + if ( $@ ) { + $ENV{RELEASE_TESTING} + ? die( "Failed to load required release-testing module $MODULE" ) + : plan( skip_all => "$MODULE not available for testing" ); + } +} + +all_minimum_version_from_metayml_ok(); + +1; diff --git a/t/00-author-pod.t b/t/00-author-pod.t new file mode 100644 index 0000000..2cdfcc4 --- /dev/null +++ b/t/00-author-pod.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl + +# Test that the syntax of our POD documentation is valid +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +my @MODULES = ( + 'Pod::Simple 3.07', + 'Test::Pod 1.26', +); + +# Don't run tests during end-user installs +use Test::More; +unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { + plan( skip_all => "Author tests not required for installation" ); +} + +# Load the testing modules +foreach my $MODULE ( @MODULES ) { + eval "use $MODULE"; + if ( $@ ) { + $ENV{RELEASE_TESTING} + ? die( "Failed to load required release-testing module $MODULE" ) + : plan( skip_all => "$MODULE not available for testing" ); + } +} + +all_pod_files_ok(); + +1; diff --git a/t/01-basic.t b/t/01-basic.t index a6670a5..a8e2474 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -32,14 +32,11 @@ package OtherTransform;{ } package main; -use Test::Most qw(no_plan die); +use Test::Most tests=>2,'die'; use strict; use warnings; use Tree::DAG_Node::XPath; -sub Tree::DAG_Node::XPath::Root::xpath_get_root_node { return $_[0] } -sub Tree::DAG_Node::XPath::Root::xpath_get_parent_node { return } - my $tree=Tree::DAG_Node::XPath->new(); $tree->name('base'); $tree->new_daughter->name("coso$_") for 1..5; diff --git a/t/02-inherit.t b/t/02-inherit.t index fb8e238..e882b53 100644 --- a/t/02-inherit.t +++ b/t/02-inherit.t @@ -1,8 +1,15 @@ #!perl package TransformA;{ - use Tree::Transform::XSLTish; + use Tree::Transform::XSLTish ':engine'; use strict; use warnings; + use Tree::XPathEngine; + use Test::Most; + + engine_factory { + ok 1,'custom factory called'; + Tree::XPathEngine->new(); + }; default_rules; @@ -29,14 +36,11 @@ package TransformB;{ } package main; -use Test::Most qw(no_plan die); +use Test::Most tests=>2,'die'; use strict; use warnings; use Tree::DAG_Node::XPath; -sub Tree::DAG_Node::XPath::Root::xpath_get_root_node { return $_[0] } -sub Tree::DAG_Node::XPath::Root::xpath_get_parent_node { return } - my $tree=Tree::DAG_Node::XPath->new(); $tree->name('base'); $tree->new_daughter->name("coso$_") for 1..5; diff --git a/t/03-byname.t b/t/03-byname.t index 784138b..a16b2d6 100644 --- a/t/03-byname.t +++ b/t/03-byname.t @@ -17,14 +17,11 @@ package NameTransform;{ } package main; -use Test::Most qw(no_plan die); +use Test::Most tests=>1,'die'; use strict; use warnings; use Tree::DAG_Node::XPath; -sub Tree::DAG_Node::XPath::Root::xpath_get_root_node { return $_[0] } -sub Tree::DAG_Node::XPath::Root::xpath_get_parent_node { return } - my $tree=Tree::DAG_Node::XPath->new(); $tree->name('base'); $tree->new_daughter->name("coso$_") for 1..5; diff --git a/t/04-errors.t b/t/04-errors.t index 107c1bd..6656933 100644 --- a/t/04-errors.t +++ b/t/04-errors.t @@ -1,13 +1,10 @@ #!perl package main; -use Test::Most qw(no_plan); +use Test::Most tests=>7; use strict; use warnings; use Tree::DAG_Node::XPath; -sub Tree::DAG_Node::XPath::Root::xpath_get_root_node { return $_[0] } -sub Tree::DAG_Node::XPath::Root::xpath_get_parent_node { return } - my $tree=Tree::DAG_Node::XPath->new(); $tree->name('base'); $tree->new_daughter->name("coso$_") for 1..5; diff --git a/t/05-html-tree.t b/t/05-html-tree.t index eb990e8..2973d25 100644 --- a/t/05-html-tree.t +++ b/t/05-html-tree.t @@ -18,12 +18,10 @@ package main; use Test::Most 'die'; use strict; use warnings; -eval 'use XML::XPathEngine;use HTML::TreeBuilder::XPath;'; -plan skip_all => 'XML::XPathEngine and HTML::TreeBuilder::XPath needed for this test' if $@; +eval 'use XML::XPathEngine;use HTML::TreeBuilder::XPath 0.10;'; +plan skip_all => 'XML::XPathEngine and HTML::TreeBuilder::XPath 0.10 needed for this test' if $@; plan tests=> 1; -sub HTML::TreeBuilder::XPath::Root::getRootNode { return $_[0] } - my $tree=HTML::TreeBuilder::XPath->new(); $tree->parse(<<'HTML');$tree->eof; <html> diff --git a/t/perlcriticrc b/t/perlcriticrc new file mode 100644 index 0000000..8503255 --- /dev/null +++ b/t/perlcriticrc @@ -0,0 +1,122 @@ +severity = 1 +color = 1 +only = 1 + +[BuiltinFunctions::ProhibitBooleanGrep] +[BuiltinFunctions::ProhibitComplexMappings] +[BuiltinFunctions::ProhibitLvalueSubstr] +[BuiltinFunctions::ProhibitReverseSortBlock] +[BuiltinFunctions::ProhibitSleepViaSelect] +[BuiltinFunctions::ProhibitStringyEval] +[BuiltinFunctions::ProhibitStringySplit] +[BuiltinFunctions::ProhibitUniversalCan] +[BuiltinFunctions::ProhibitUniversalIsa] +[BuiltinFunctions::ProhibitVoidGrep] +[BuiltinFunctions::ProhibitVoidMap] +[BuiltinFunctions::RequireBlockGrep] +[BuiltinFunctions::RequireBlockMap] +[BuiltinFunctions::RequireGlobFunction] +[BuiltinFunctions::RequireSimpleSortBlock] +[ClassHierarchies::ProhibitAutoloading] +[ClassHierarchies::ProhibitExplicitISA] +[ClassHierarchies::ProhibitOneArgBless] +[CodeLayout::ProhibitHardTabs] +[CodeLayout::ProhibitParensWithBuiltins] +[CodeLayout::ProhibitQuotedWordLists] +[CodeLayout::ProhibitTrailingWhitespace] +[CodeLayout::RequireConsistentNewlines] +[CodeLayout::RequireTrailingCommas] +[ControlStructures::ProhibitCStyleForLoops] +[ControlStructures::ProhibitCascadingIfElse] +[ControlStructures::ProhibitDeepNests] +[ControlStructures::ProhibitLabelsWithSpecialBlockNames] +[ControlStructures::ProhibitMutatingListFunctions] +[ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions] +[ControlStructures::ProhibitPostfixControls] +[ControlStructures::ProhibitUnreachableCode] +[ControlStructures::ProhibitUntilBlocks] +[Documentation::RequirePackageMatchesPodName] +[Documentation::RequirePodAtEnd] +[ErrorHandling::RequireCarping] +[ErrorHandling::RequireCheckingReturnValueOfEval] +[InputOutput::ProhibitBacktickOperators] +[InputOutput::ProhibitBarewordFileHandles] +[InputOutput::ProhibitExplicitStdin] +[InputOutput::ProhibitInteractiveTest] +[InputOutput::ProhibitJoinedReadline] +[InputOutput::ProhibitOneArgSelect] +[InputOutput::ProhibitReadlineInForLoop] +[InputOutput::ProhibitTwoArgOpen] +[InputOutput::RequireBracedFileHandleWithPrint] +[InputOutput::RequireBriefOpen] +[InputOutput::RequireCheckedClose] +[InputOutput::RequireCheckedOpen] +[InputOutput::RequireCheckedSyscalls] +[Miscellanea::ProhibitFormats] +[Miscellanea::ProhibitTies] +[Miscellanea::ProhibitUnrestrictedNoCritic] +[Miscellanea::ProhibitUselessNoCritic] +[Modules::ProhibitAutomaticExportation] +[Modules::ProhibitExcessMainComplexity] +[Modules::ProhibitMultiplePackages] +[Modules::RequireBarewordIncludes] +[Modules::RequireEndWithOne] +[Modules::RequireExplicitPackage] +[Modules::RequireFilenameMatchesPackage] +[Modules::RequireNoMatchVarsWithUseEnglish] +[Modules::RequireVersionVar] +[NamingConventions::Capitalization] +[NamingConventions::ProhibitAmbiguousNames] +[References::ProhibitDoubleSigils] +[RegularExpressions::ProhibitCaptureWithoutTest] +[RegularExpressions::ProhibitFixedStringMatches] +[RegularExpressions::ProhibitUnusualDelimiters] +[RegularExpressions::RequireBracesForMultiline] +[RegularExpressions::RequireDotMatchAnything] +[RegularExpressions::RequireExtendedFormatting] +[RegularExpressions::RequireLineBoundaryMatching] +[Subroutines::ProhibitAmpersandSigils] +[Subroutines::ProhibitBuiltinHomonyms] +[Subroutines::ProhibitExcessComplexity] +[Subroutines::ProhibitExplicitReturnUndef] +[Subroutines::ProhibitManyArgs] +[Subroutines::ProhibitNestedSubs] +[Subroutines::ProhibitReturnSort] +[Subroutines::RequireFinalReturn] +[TestingAndDebugging::ProhibitNoStrict] +[TestingAndDebugging::ProhibitNoWarnings] +[TestingAndDebugging::ProhibitProlongedStrictureOverride] +[TestingAndDebugging::RequireTestLabels] +[TestingAndDebugging::RequireUseStrict] +[TestingAndDebugging::RequireUseWarnings] +[ValuesAndExpressions::ProhibitCommaSeparatedStatements] +[ValuesAndExpressions::ProhibitConstantPragma] +[ValuesAndExpressions::ProhibitEmptyQuotes] +[ValuesAndExpressions::ProhibitEscapedCharacters] +[ValuesAndExpressions::ProhibitImplicitNewlines] +[ValuesAndExpressions::ProhibitInterpolationOfLiterals] +[ValuesAndExpressions::ProhibitLeadingZeros] +[ValuesAndExpressions::ProhibitLongChainsOfMethodCalls] +[ValuesAndExpressions::ProhibitMagicNumbers] +[ValuesAndExpressions::ProhibitMismatchedOperators] +[ValuesAndExpressions::ProhibitMixedBooleanOperators] +[ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters] +[ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator] +[ValuesAndExpressions::ProhibitVersionStrings] +[ValuesAndExpressions::RequireInterpolationOfMetachars] +[ValuesAndExpressions::RequireNumberSeparators] +[ValuesAndExpressions::RequireQuotedHeredocTerminator] +[ValuesAndExpressions::RequireUpperCaseHeredocTerminator] +[Variables::ProhibitConditionalDeclarations] +[Variables::ProhibitLocalVars] +[Variables::ProhibitMatchVars] +[Variables::ProhibitPackageVars] +[Variables::ProhibitPerl4PackageNames] +[Variables::ProhibitPunctuationVars] +[Variables::ProhibitReusedNames] +[Variables::ProhibitUnusedVariables] +[Variables::ProtectPrivateVars] +[Variables::RequireInitializationForLocalVars] +[Variables::RequireLexicalLoopIterators] +[Variables::RequireLocalizedPunctuationVars] +[Variables::RequireNegativeIndices] |