Test::RDF patch

pattern-ok.diff

diff -urN Test-RDF-0.22/lib/Test/RDF.pm Test-RDF-0.23/lib/Test/RDF.pm
--- Test-RDF-0.22/lib/Test/RDF.pm	2011-04-01 22:51:12.000000000 +0100
+++ Test-RDF-0.23/lib/Test/RDF.pm	2011-10-13 10:46:02.477025390 +0100
@@ -8,10 +8,10 @@
 use RDF::Trine::Parser;
 use RDF::Trine::Model;
 use RDF::Trine::Graph;
+use Scalar::Util qw/blessed/;
 
 use base 'Test::Builder::Module';
-our @EXPORT = qw/are_subgraphs is_rdf is_valid_rdf isomorph_graphs has_subject has_predicate has_object_uri has_uri has_literal/;
-
+our @EXPORT = qw/are_subgraphs is_rdf is_valid_rdf isomorph_graphs has_subject has_predicate has_object_uri has_uri has_literal pattern_target pattern_ok/;
 
 
 =head1 NAME
@@ -20,11 +20,11 @@
 
 =head1 VERSION
 
-Version 0.22
+Version 0.23
 
 =cut
 
-our $VERSION = '0.22';
+our $VERSION = '0.23';
 
 
 =head1 SYNOPSIS
@@ -39,7 +39,8 @@
  has_predicate($uri_string, $model, 'Predicate URI is found');
  has_object_uri($uri_string, $model, 'Object URI is found');
  has_literal($string, $language, $datatype, $model, 'Literal is found');
-
+ pattern_target($model);
+ pattern_ok($pattern, '$pattern found in $model');
 
 =head1 EXPORT
 
@@ -50,21 +51,21 @@
 =cut
 
 sub is_valid_rdf {
-    my ($rdf, $syntax, $name) = @_;
-    my $parser = RDF::Trine::Parser->new($syntax);
-    my $test = __PACKAGE__->builder;
-    eval {
-        $parser->parse('http://example.org/', $rdf);
-    };
-    if ( my $error = $@ ) {
-        $test->ok( 0, $name );
-        $test->diag("Input was not valid RDF:\n\n\t$error");
-        return;
-    }
-    else {
-        $test->ok( 1, $name );
-        return 1;
-    }
+  my ($rdf, $syntax, $name) = @_;
+  my $parser = RDF::Trine::Parser->new($syntax);
+  my $test = __PACKAGE__->builder;
+  eval {
+    $parser->parse('http://example.org/', $rdf);
+  };
+  if ( my $error = $@ ) {
+    $test->ok( 0, $name );
+    $test->diag("Input was not valid RDF:\n\n\t$error");
+    return;
+  }
+  else {
+    $test->ok( 1, $name );
+    return 1;
+  }
 }
 
 
@@ -76,27 +77,27 @@
 
 
 sub is_rdf {
-    my ($rdf1, $syntax1, $rdf2, $syntax2, $name) = @_;
-    my $parser1 = RDF::Trine::Parser->new($syntax1);
-    my $test = __PACKAGE__->builder;
-    local $Test::Builder::Level = $Test::Builder::Level + 1;
+  my ($rdf1, $syntax1, $rdf2, $syntax2, $name) = @_;
+  my $parser1 = RDF::Trine::Parser->new($syntax1);
+  my $test = __PACKAGE__->builder;
+  local $Test::Builder::Level = $Test::Builder::Level + 1;
 
-    # First, test if the input RDF is OK
-    my $model1 = RDF::Trine::Model->temporary_model;
-    eval {
-        $parser1->parse_into_model('http://example.org/', $rdf1, $model1);
-    };
-    if ( my $error = $@ ) {
-        $test->ok( 0, $name );
-        $test->diag("Input was not valid RDF:\n\n\t$error");
-        return;
-    }
+  # First, test if the input RDF is OK
+  my $model1 = RDF::Trine::Model->temporary_model;
+  eval {
+    $parser1->parse_into_model('http://example.org/', $rdf1, $model1);
+  };
+  if ( my $error = $@ ) {
+    $test->ok( 0, $name );
+    $test->diag("Input was not valid RDF:\n\n\t$error");
+    return;
+  }
 
-    # If the expected RDF is non-valid, don't catch the exception
-    my $parser2 = RDF::Trine::Parser->new($syntax2);
-    my $model2 = RDF::Trine::Model->temporary_model;
-    $parser2->parse_into_model('http://example.org/', $rdf2, $model2);
-    return isomorph_graphs($model1, $model2, $name);
+  # If the expected RDF is non-valid, don't catch the exception
+  my $parser2 = RDF::Trine::Parser->new($syntax2);
+  my $model2 = RDF::Trine::Model->temporary_model;
+  $parser2->parse_into_model('http://example.org/', $rdf2, $model2);
+  return isomorph_graphs($model1, $model2, $name);
 }
 
 
@@ -108,20 +109,20 @@
 
 
 sub isomorph_graphs {
-    my ($model1, $model2, $name) = @_;
-    my $g1 = RDF::Trine::Graph->new( $model1 );
-    my $g2 = RDF::Trine::Graph->new( $model2 );
-    my $test = __PACKAGE__->builder;
+  my ($model1, $model2, $name) = @_;
+  my $g1 = RDF::Trine::Graph->new( $model1 );
+  my $g2 = RDF::Trine::Graph->new( $model2 );
+  my $test = __PACKAGE__->builder;
 
-    if ($g1->equals($g2)) {
-        $test->ok( 1, $name );
-        return 1;
-    } else {
-        $test->ok( 0, $name );
-        $test->diag('Graphs differ:');
-        $test->diag($g1->error);
-        return;
-    }
+  if ($g1->equals($g2)) {
+    $test->ok( 1, $name );
+    return 1;
+  } else {
+    $test->ok( 0, $name );
+    $test->diag('Graphs differ:');
+    $test->diag($g1->error);
+    return;
+  }
 }
 
 =head2 are_subgraphs
@@ -131,20 +132,20 @@
 =cut
 
 sub are_subgraphs {
-    my ($model1, $model2, $name) = @_;
-    my $g1 = RDF::Trine::Graph->new( $model1 );
-    my $g2 = RDF::Trine::Graph->new( $model2 );
-    my $test = __PACKAGE__->builder;
+  my ($model1, $model2, $name) = @_;
+  my $g1 = RDF::Trine::Graph->new( $model1 );
+  my $g2 = RDF::Trine::Graph->new( $model2 );
+  my $test = __PACKAGE__->builder;
 
-    if ($g1->is_subgraph_of($g2)) {
-        $test->ok( 1, $name );
-        return 1;
-    } else {
-        $test->ok( 0, $name );
-	$test->diag('Graph not subgraph: ' . $g1->error) if defined($g1->error);
-        $test->diag('Hint: There are ' . $model1->size . ' statement(s) in model1 and ' . $model2->size . ' statement(s) in model2');
-        return;
-    }
+  if ($g1->is_subgraph_of($g2)) {
+    $test->ok( 1, $name );
+    return 1;
+  } else {
+    $test->ok( 0, $name );
+    $test->diag('Graph not subgraph: ' . $g1->error) if defined($g1->error);
+    $test->diag('Hint: There are ' . $model1->size . ' statement(s) in model1 and ' . $model2->size . ' statement(s) in model2');
+    return;
+  }
 }
 
 =head2 has_subject
@@ -223,7 +224,7 @@
     return;
   }
 
-#  local $Test::Builder::Level = $Test::Builder::Level + 1;
+  #local $Test::Builder::Level = $Test::Builder::Level + 1;
   if ($model->count_statements(undef, undef, $literal) > 0) {
     $test->ok( 1, $name );
     return 1;
@@ -231,7 +232,8 @@
     $test->ok( 0, $name );
     $test->diag('No matching literals found in model');
     return 0;
-  }}
+  }
+}
 
 
 =head2 has_uri
@@ -271,6 +273,88 @@
   }
 }
 
+=head2 pattern_target
+
+Tests that the object passed as its parameter is an RDF::Trine::Model or
+RDF::Trine::Store. That is, tests that it is a valid thing to match basic
+graph patterns against.
+
+Additionally, this test establishes the target for future C<pattern_ok> tests.
+
+=head2 pattern_ok
+
+Tests that the pattern passed matches against the target established by
+C<pattern_target>. The pattern may be passed as an RDF::Trine::Pattern, or
+a list of RDF::Trine::Statement objects.
+
+ use Test::RDF;
+ use RDF::Trine qw[iri literal blank variable statement];
+ use My::Module;
+ 
+ my $foaf = RDF::Trine::Namespace->new('http://xmlns.com/foaf/0.1/');
+ pattern_target(My::Module->get_model); # check isa RDF::Trine::Model
+ pattern_ok(
+   statement(
+     variable('who'),
+     $foaf->name,
+     literal('Kjetil Kjernsmo')
+     ),
+   statement(
+     variable('who'),
+     $foaf->page,
+     iri('http://search.cpan.org/~kjetilk/')
+     ),
+   "Data contains Kjetil's details."
+   );
+
+B<Note:> C<pattern_target> must have been tested before any C<pattern_ok> tests.
+
+=cut
+
+{ # scope for $target
+  my $target;
+  sub pattern_target {
+    my $t = shift;
+    my $test = __PACKAGE__->builder;
+    if (blessed($t) && $t->isa('RDF::Trine::Model')) {
+      $target = $t;
+      $test->ok(1, 'Data is an RDF::Trine::Model.');
+      return 1;
+    }
+    elsif (blessed($t) && $t->isa('RDF::Trine::Store')) {
+      $target = $t;
+      $test->ok(1, 'Data is an RDF::Trine::Store.');
+      return 1;
+    }
+    else {
+      $test->ok(0, 'Data is not an RDF::Trine::Model or RDF::Trine::Store.');
+      return 0;
+    }
+  }
+  sub pattern_ok {
+    my $message = pop @_ if !ref $_[-1];
+    unless (defined $message and length $message) {
+      $message = "Pattern match";
+    }
+    my $test = __PACKAGE__->builder;
+    unless (blessed($target)) {
+      $test->ok(0, $message);
+      $test->diag("No target defined for pattern match. Call pattern_target test first.");
+      return 0;
+    }
+    my $pattern = (blessed($_[0]) and $_[0]->isa('RDF::Trine::Pattern'))
+                ? $_[0]
+                : RDF::Trine::Pattern->new(@_);
+    my $iter    = $target->get_pattern($pattern);
+    while (my $row = $iter->next) {
+      $test->ok(1, $message);
+      return 1;
+    }
+    $test->ok(0, $message);
+    return 0;
+  }
+} # /scope for $target
+
 
 =head1 NOTE
 
diff -urN Test-RDF-0.22/MANIFEST Test-RDF-0.23/MANIFEST
--- Test-RDF-0.22/MANIFEST	2011-04-01 23:01:28.000000000 +0100
+++ Test-RDF-0.23/MANIFEST	2011-10-13 10:52:35.024272876 +0100
@@ -27,6 +27,7 @@
 t/is_rdf.t
 t/is_valid_rdf.t
 t/isomorph_graphs.t
+t/pattern_ok.t
 xt/0-signature.t
 xt/01-critic.t
 xt/manifest.t
diff -urN Test-RDF-0.22/t/pattern_ok.t Test-RDF-0.23/t/pattern_ok.t
--- Test-RDF-0.22/t/pattern_ok.t	1970-01-01 01:00:00.000000000 +0100
+++ Test-RDF-0.23/t/pattern_ok.t	2011-10-13 10:48:28.862272049 +0100
@@ -0,0 +1,152 @@
+use Test::Tester tests=>57;
+use Test::RDF;
+use RDF::Trine qw[iri variable literal statement];
+
+check_test(
+  sub {
+    pattern_target(100);
+  },
+  {
+    ok   => 0,
+    name => 'Data is not an RDF::Trine::Model or RDF::Trine::Store.',
+  },
+  'pattern_target - invalid target'
+);
+
+check_test(
+  sub {
+    pattern_ok();
+  },
+  {
+    ok   => 0,
+    name => 'Pattern match',
+    diag => 'No target defined for pattern match. Call pattern_target test first.',
+  },
+  'pattern_ok - uninitialised target'
+);
+
+check_test(
+  sub {
+    my $store = RDF::Trine::Store->temporary_store;
+    pattern_target($store);
+  },
+  {
+    ok   => 1,
+    name => 'Data is an RDF::Trine::Store.',
+  },
+  'pattern_target - target store'
+);
+
+my $model;
+check_test(
+  sub {
+    pattern_target($model = RDF::Trine::Model->new);
+  },
+  {
+    ok   => 1,
+    name => 'Data is an RDF::Trine::Model.',
+  },
+  'pattern_target - target model'
+);
+
+RDF::Trine::Parser->new('turtle')->parse_into_model('http://example.org', <<'TURTLE', $model);
+@prefix foaf: <http://xmlns.com/foaf/0.1/> .
+
+[] a foaf:Person ;
+  foaf:name "Kjetil Kjernsmo" ;
+  foaf:page <http://search.cpan.org/~kjetilk/> .
+[] a foaf:Person ;
+  foaf:name "Toby Inkster" ;
+  foaf:page <http://search.cpan.org/~tobyink/> .
+TURTLE
+
+my $foaf = RDF::Trine::Namespace->new('http://xmlns.com/foaf/0.1/');
+
+check_test(
+  sub {
+    pattern_ok(
+      statement(variable('who'), $foaf->name, literal('Kjetil Kjernsmo')),
+      statement(variable('who'), $foaf->page, iri('http://search.cpan.org/~kjetilk/')),
+      );
+  },
+  {
+    ok   => 1,
+  },
+  'pattern_ok - statement list'
+);
+
+check_test(
+  sub {
+    pattern_ok(
+      RDF::Trine::Pattern->new(
+        statement(variable('who'), $foaf->name, literal('Kjetil Kjernsmo')),
+        statement(variable('who'), $foaf->page, iri('http://search.cpan.org/~kjetilk/')),
+        ),
+      );
+  },
+  {
+    ok   => 1,
+  },
+  'pattern_ok - pattern'
+);
+
+check_test(
+  sub {
+    pattern_ok(
+      statement(variable('who'), $foaf->name, literal('Kjetil Kjernsmo')),
+      statement(variable('who'), $foaf->page, iri('http://search.cpan.org/~kjetilk/')),
+      "FOO",
+      );
+  },
+  {
+    ok   => 1,
+    name => 'FOO',
+  },
+  'pattern_ok - statement list plus message'
+);
+
+check_test(
+  sub {
+    pattern_ok(
+      RDF::Trine::Pattern->new(
+        statement(variable('who'), $foaf->name, literal('Kjetil Kjernsmo')),
+        statement(variable('who'), $foaf->page, iri('http://search.cpan.org/~kjetilk/')),
+        ),
+      "FOO",
+      );
+  },
+  {
+    ok   => 1,
+    name => 'FOO',
+  },
+  'pattern_ok - pattern plus message'
+);
+
+check_test(
+  sub {
+    pattern_ok(
+      statement(variable('who'), $foaf->name, literal('Toby Inkster')),
+      statement(variable('who'), $foaf->page, iri('http://search.cpan.org/~kjetilk/')),
+      );
+  },
+  {
+    ok   => 0,
+  },
+  'pattern_ok - statement list should fail'
+);
+
+check_test(
+  sub {
+    pattern_ok(
+      RDF::Trine::Pattern->new(
+        statement(variable('who'), $foaf->name, literal('Toby Inkster')),
+        statement(variable('who'), $foaf->page, iri('http://search.cpan.org/~kjetilk/')),
+        ),
+      );
+  },
+  {
+    ok   => 0,
+  },
+  'pattern_ok - pattern should fail'
+);
+