added lots of attributes

now most PPI classes export their attributes; there is also some
protection against exceptions in accessors

2 files changed, 170 insertions, 9 deletions

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');
+}