From ffb0397721a50682b2fc54f53ea6bf94937b21c8 Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 16 Apr 2009 22:12:47 +0200 Subject: documentation, and a few author-tests --- lib/Tree/Transform/XSLTish/Utils.pm | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'lib/Tree/Transform/XSLTish/Utils.pm') diff --git a/lib/Tree/Transform/XSLTish/Utils.pm b/lib/Tree/Transform/XSLTish/Utils.pm index bed1167..bfb438c 100644 --- a/lib/Tree/Transform/XSLTish/Utils.pm +++ b/lib/Tree/Transform/XSLTish/Utils.pm @@ -31,3 +31,14 @@ sub _get_inheritance { } 1; +__END__ + +=head1 NAME + +Tree::Transform::XSLTish::Utils - utility functions + +=head1 AUTHOR + +Gianni Ceccarelli + +=cut -- cgit v1.2.3 From 43217e6ce9a7cae817d391e9bb10a3410c88e6e2 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sat, 18 Apr 2009 15:26:50 +0200 Subject: factories are inherited now, added test --- lib/Tree/Transform/XSLTish.pm | 12 ++++++++---- lib/Tree/Transform/XSLTish/Transformer.pm | 6 +++--- lib/Tree/Transform/XSLTish/Utils.pm | 13 ++++++------- t/02-inherit.t | 11 +++++++++-- 4 files changed, 26 insertions(+), 16 deletions(-) (limited to 'lib/Tree/Transform/XSLTish/Utils.pm') diff --git a/lib/Tree/Transform/XSLTish.pm b/lib/Tree/Transform/XSLTish.pm index 2176aea..7053428 100644 --- a/lib/Tree/Transform/XSLTish.pm +++ b/lib/Tree/Transform/XSLTish.pm @@ -62,8 +62,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; } @@ -71,8 +73,10 @@ 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; } diff --git a/lib/Tree/Transform/XSLTish/Transformer.pm b/lib/Tree/Transform/XSLTish/Transformer.pm index c4ff53f..dae5821 100644 --- a/lib/Tree/Transform/XSLTish/Transformer.pm +++ b/lib/Tree/Transform/XSLTish/Transformer.pm @@ -44,9 +44,9 @@ 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(); diff --git a/lib/Tree/Transform/XSLTish/Utils.pm b/lib/Tree/Transform/XSLTish/Utils.pm index bfb438c..770426f 100644 --- a/lib/Tree/Transform/XSLTish/Utils.pm +++ b/lib/Tree/Transform/XSLTish/Utils.pm @@ -14,15 +14,14 @@ sub _rules_store { 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); } diff --git a/t/02-inherit.t b/t/02-inherit.t index fb8e238..f11d116 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,7 +36,7 @@ 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; -- cgit v1.2.3 From b0c300919fd33fbff9167b294dca14dff0250bc1 Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Thu, 23 Apr 2009 15:29:16 +0200 Subject: passes critic --- lib/Tree/Transform/XSLTish.pm | 7 +++---- lib/Tree/Transform/XSLTish/Context.pm | 2 ++ lib/Tree/Transform/XSLTish/Transformer.pm | 21 ++++++++++----------- lib/Tree/Transform/XSLTish/Utils.pm | 6 +++++- t/00-author-critic.t | 4 +++- 5 files changed, 23 insertions(+), 17 deletions(-) (limited to 'lib/Tree/Transform/XSLTish/Utils.pm') diff --git a/lib/Tree/Transform/XSLTish.pm b/lib/Tree/Transform/XSLTish.pm index 4c29afa..42b7222 100644 --- a/lib/Tree/Transform/XSLTish.pm +++ b/lib/Tree/Transform/XSLTish.pm @@ -12,7 +12,8 @@ our $VERSION='0.1'; 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)], @@ -81,12 +82,10 @@ sub engine_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; diff --git a/lib/Tree/Transform/XSLTish/Context.pm b/lib/Tree/Transform/XSLTish/Context.pm index 0890401..96670ec 100644 --- a/lib/Tree/Transform/XSLTish/Context.pm +++ b/lib/Tree/Transform/XSLTish/Context.pm @@ -2,6 +2,8 @@ package Tree::Transform::XSLTish::Context; use Moose; use Carp::Clan qw(^Tree::Transform::XSLTish); +our $VERSION='0.1'; + has 'current_node' => ( is => 'rw', isa => 'Object' ); has 'node_list' => ( is => 'rw', isa => 'ArrayRef[Object]' ); diff --git a/lib/Tree/Transform/XSLTish/Transformer.pm b/lib/Tree/Transform/XSLTish/Transformer.pm index 857143a..0d241e4 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.1'; + 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'); @@ -52,7 +50,7 @@ sub _build_engine { 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,12 +138,12 @@ 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]; @@ -202,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)=@_; @@ -212,6 +210,7 @@ sub new { sub DESTROY { $_[0]->{trans}->leave(); + return; } 1; diff --git a/lib/Tree/Transform/XSLTish/Utils.pm b/lib/Tree/Transform/XSLTish/Utils.pm index 770426f..8546919 100644 --- a/lib/Tree/Transform/XSLTish/Utils.pm +++ b/lib/Tree/Transform/XSLTish/Utils.pm @@ -3,12 +3,14 @@ use strict; use warnings; use Class::MOP; +our $VERSION='0.1'; + 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); @@ -22,6 +24,8 @@ sub _set_engine_factory { my $pack=Class::MOP::Class->initialize($pack_name); $pack->add_package_symbol($ENGINE_FACTORY_NAME_WITH_SIGIL,$factory); + + return; } diff --git a/t/00-author-critic.t b/t/00-author-critic.t index d0a133a..79ed2b7 100644 --- a/t/00-author-critic.t +++ b/t/00-author-critic.t @@ -10,6 +10,7 @@ BEGIN { my @MODULES = ( 'Perl::Critic 1.098', 'Test::Perl::Critic 1.01', + 'File::Spec', ); # Don't run tests during end-user installs @@ -27,7 +28,8 @@ foreach my $MODULE ( @MODULES ) { : plan( skip_all => "$MODULE not available for testing" ); } } -Test::Perl::Critic->import( -exclude => ['ProhibitSubroutinePrototypes']); +my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); +Test::Perl::Critic->import( -profile => $rcfile ); all_critic_ok(); 1; -- cgit v1.2.3 From b7a218903103b5f32360dce11523b76c6b5de5ae Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Wed, 29 Apr 2009 15:53:30 +0200 Subject: hopefully fixed P::C tests, and upped version --- lib/Tree/Transform/XSLTish.pm | 20 ++++- lib/Tree/Transform/XSLTish/Context.pm | 2 +- lib/Tree/Transform/XSLTish/Transformer.pm | 6 +- lib/Tree/Transform/XSLTish/Utils.pm | 2 +- t/perlcriticrc | 128 +++++++++++++++++++++++++++--- 5 files changed, 141 insertions(+), 17 deletions(-) (limited to 'lib/Tree/Transform/XSLTish/Utils.pm') diff --git a/lib/Tree/Transform/XSLTish.pm b/lib/Tree/Transform/XSLTish.pm index 42b7222..9c4b1ec 100644 --- a/lib/Tree/Transform/XSLTish.pm +++ b/lib/Tree/Transform/XSLTish.pm @@ -8,7 +8,7 @@ use Tree::Transform::XSLTish::Transformer; use Carp::Clan qw(^Tree::Transform::XSLTish); use v5.8; -our $VERSION='0.1'; +our $VERSION='0.2'; my @DEFAULT_EXPORTS=('tree_rule', 'default_rules', @@ -270,6 +270,24 @@ and specify another one). This module uses L, see that module's documentation for things like renaming the imports. +=head1 KNOWN BUGS & ISSUES + +=over 4 + +=item * + +It's I. Right now each rule application is linear in the number +of defined rules I 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 could make everything look better + +=back + =head1 AUTHOR Gianni Ceccarelli diff --git a/lib/Tree/Transform/XSLTish/Context.pm b/lib/Tree/Transform/XSLTish/Context.pm index 96670ec..bb7c9de 100644 --- a/lib/Tree/Transform/XSLTish/Context.pm +++ b/lib/Tree/Transform/XSLTish/Context.pm @@ -2,7 +2,7 @@ package Tree::Transform::XSLTish::Context; use Moose; use Carp::Clan qw(^Tree::Transform::XSLTish); -our $VERSION='0.1'; +our $VERSION='0.2'; has 'current_node' => ( is => 'rw', isa => 'Object' ); has 'node_list' => ( is => 'rw', isa => 'ArrayRef[Object]' ); diff --git a/lib/Tree/Transform/XSLTish/Transformer.pm b/lib/Tree/Transform/XSLTish/Transformer.pm index 0d241e4..a36bd6a 100644 --- a/lib/Tree/Transform/XSLTish/Transformer.pm +++ b/lib/Tree/Transform/XSLTish/Transformer.pm @@ -8,7 +8,7 @@ use Tree::Transform::XSLTish::Context; use Tree::XPathEngine; use Carp::Clan qw(^Tree::Transform::XSLTish); -our $VERSION='0.1'; +our $VERSION='0.2'; subtype 'Tree::Transform::XSLTish::Engine' => as 'Object' @@ -238,10 +238,6 @@ If you don't specify an C, 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. -=for comment - -engine factories are not inherited! - =head2 C @results=$trans->transform($tree); diff --git a/lib/Tree/Transform/XSLTish/Utils.pm b/lib/Tree/Transform/XSLTish/Utils.pm index 8546919..c760585 100644 --- a/lib/Tree/Transform/XSLTish/Utils.pm +++ b/lib/Tree/Transform/XSLTish/Utils.pm @@ -3,7 +3,7 @@ use strict; use warnings; use Class::MOP; -our $VERSION='0.1'; +our $VERSION='0.2'; my $RULES_NAME='%_tree_transform_rules'; diff --git a/t/perlcriticrc b/t/perlcriticrc index 5ad1ad7..8503255 100644 --- a/t/perlcriticrc +++ b/t/perlcriticrc @@ -1,12 +1,122 @@ severity = 1 -theme = core || bug || maintenance || complexity || security color = 1 +only = 1 -[-Miscellanea::RequireRcsKeywords] -[-Documentation::RequirePodSections] -[-ValuesAndExpressions::ProhibitNoisyQuotes] -[-Subroutines::ProhibitSubroutinePrototypes] -[-Subroutines::RequireArgUnpacking] -[-Subroutines::ProtectPrivateSubs] -[-ControlStructures::ProhibitUnlessBlocks] -[-CodeLayout::RequireTidyCode] +[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] -- cgit v1.2.3