From 37b4676a0b65649748d9001d7c3f52ec6d2bbf9b Mon Sep 17 00:00:00 2001 From: dakkar Date: Wed, 12 Aug 2009 18:05:56 +0200 Subject: added lots of attributes now most PPI classes export their attributes; there is also some protection against exceptions in accessors --- lib/PPIx/XPath.pm | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++---- t/03-advanced.t | 40 ++++++++++++++++ 2 files changed, 170 insertions(+), 9 deletions(-) create mode 100644 t/03-advanced.t diff --git a/lib/PPIx/XPath.pm b/lib/PPIx/XPath.pm index f5cd244..d4975e4 100644 --- a/lib/PPIx/XPath.pm +++ b/lib/PPIx/XPath.pm @@ -97,10 +97,12 @@ sub xpath_is_attribute_node { 0 } sub xpath_is_document_node { 0 } sub xpath_get_attributes { return - PPIx::XPath::Attr->new($_[0],significant => $_[0]->significant), - PPIx::XPath::Attr->new($_[0],content => $_[0]->content), + PPIx::XPath::Attr->new($_[0],'significant'), + PPIx::XPath::Attr->new($_[0],'content'), } sub xpath_to_literal { "$_[0]" } +sub xpath_get_value { "$_[0]" } +sub xpath_string_value { "$_[0]" } sub xpath_cmp { my( $a, $b)= @_; @@ -178,6 +180,61 @@ use warnings; sub xpath_get_child_nodes { return } +package PPI::Token::Quote::Double; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'interpolations'), +} + +package PPI::Token::Number; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'base'), +} + +package PPI::Token::Word; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'method-call'), +} + +package PPI::Token::Comment; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'line'), +} + +package PPI::Token::HereDoc; +use strict; +use warnings; + +# TODO: add access to the contents of the heredoc (->heredoc method) + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'terminator'), +} + +package PPI::Token::Prototype; +use strict; +use warnings; + +sub xpath_to_literal { $_[0]->prototype } +sub xpath_get_value { $_[0]->prototype } +sub xpath_string_value { $_[0]->prototype } + package PPI::Node; use strict; use warnings; @@ -185,7 +242,29 @@ use warnings; sub xpath_get_child_nodes { $_[0]->schildren } sub xpath_get_attributes { return $_[0]->SUPER::xpath_get_attributes, - PPIx::XPath::Attr->new($_[0],scope => $_[0]->scope), + PPIx::XPath::Attr->new($_[0],'scope'), +} + +package PPI::Token::Attribute; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'identifier'), + PPIx::XPath::Attr->new($_[0],'parameters'), +} + +package PPI::Token::Symbol; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'symbol'), + PPIx::XPath::Attr->new($_[0],'canonical'), + PPIx::XPath::Attr->new($_[0],'raw_type'), + PPIx::XPath::Attr->new($_[0],'symbol_typel'), } package PPI::Statement; @@ -194,8 +273,44 @@ use warnings; sub xpath_get_attributes { return $_[0]->SUPER::xpath_get_attributes, - PPIx::XPath::Attr->new($_[0],label => $_[0]->label), - PPIx::XPath::Attr->new($_[0],stable => $_[0]->stable), + PPIx::XPath::Attr->new($_[0],'label'), + PPIx::XPath::Attr->new($_[0],'stable'), + PPIx::XPath::Attr->new($_[0],'type'), +} + +package PPI::Statement::Sub; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'name'), + PPIx::XPath::Attr->new($_[0],'prototype'), + PPIx::XPath::Attr->new($_[0],'forward'), + PPIx::XPath::Attr->new($_[0],'reserved'), +} + +package PPI::Statement::Package; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'namespace'), + PPIx::XPath::Attr->new($_[0],'file-scoped'), +} + +package PPI::Statement::Include; +use strict; +use warnings; + +sub xpath_get_attributes { + return $_[0]->SUPER::xpath_get_attributes, + PPIx::XPath::Attr->new($_[0],'module'), + PPIx::XPath::Attr->new($_[0],'module-version'), + PPIx::XPath::Attr->new($_[0],'version'), + PPIx::XPath::Attr->new($_[0],'version-literal'), + PPIx::XPath::Attr->new($_[0],'pragma'), } package PPI::Structure; @@ -204,9 +319,9 @@ use warnings; sub xpath_get_attributes { return $_[0]->SUPER::xpath_get_attributes, - PPIx::XPath::Attr->new($_[0],start => $_[0]->start), - PPIx::XPath::Attr->new($_[0],finish => $_[0]->finish), - PPIx::XPath::Attr->new($_[0],braces => $_[0]->braces), + PPIx::XPath::Attr->new($_[0],'start'), + PPIx::XPath::Attr->new($_[0],'finish'), + PPIx::XPath::Attr->new($_[0],'braces'), } package PPI::Document; @@ -223,7 +338,13 @@ use strict; use warnings; sub new { - my ($class,$parent,$name,$value)=@_; + my ($class,$parent,$name)=@_; + + my $meth=$parent->can($name); + return unless $meth; + + my $value; + eval {$value=$meth->($parent);1} or return; return unless defined $value; diff --git a/t/03-advanced.t b/t/03-advanced.t new file mode 100644 index 0000000..4f46757 --- /dev/null +++ b/t/03-advanced.t @@ -0,0 +1,40 @@ +#!perl +use Test::Most tests=>6,'die'; +use strict; +use warnings; +use PPI; +use PPIx::XPath; +use Tree::XPathEngine; + +my $x=PPI::Document->new(\<<'EOF'); +sub foo { print "bar" } + +sub baz { print "boo"; foo() }; + +baz(); +EOF + +my $e=Tree::XPathEngine->new(); + +#explain('the doc: ',$x); + +{ +my @subdefs = $e->findnodes('/Statement-Sub',$x); +is_deeply([sort map {$_->name} @subdefs],[qw(baz foo)],'Got the two sub'); +} +{ +my ($subdef) = $e->findnodes('/Statement-Sub[@name="foo"]',$x); +is($subdef->name,'foo','Got the sub by name'); +} + +{ +my ($string,@rest) = $e->findnodes('/Statement-Sub[@name="foo"]//Statement[Token-Word="print"]/Token-Quote-Double',$x); +is($string->string,'bar','Got the string'); +is(scalar(@rest),0,'and nothing more'); +} + +{ +my ($call,@rest) = $e->findnodes('/Statement-Sub//Statement[Token-Word and Structure-List[count(*)=0]]',$x); +is("$call",'foo()','Got the call'); +is(scalar(@rest),0,'and nothing more'); +} -- cgit v1.2.3