This file is indexed.

/usr/share/perl5/Test/RDF.pm is in libtest-rdf-perl 1.16-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
package Test::RDF;

use warnings;
use strict;

use Carp;
use RDF::Trine;
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 hasnt_uri has_literal hasnt_literal pattern_target pattern_ok pattern_fail/;


=head1 NAME

Test::RDF - Test RDF data for content, validity and equality, etc.

=head1 VERSION

Version 1.16

=cut

our $VERSION = '1.16';


=head1 SYNOPSIS

 use Test::RDF;

 is_valid_rdf($rdf_string, $syntax,  'RDF string is valid according to selected syntax');
 is_rdf($rdf_string, $syntax1, $expected_rdf_string, $syntax2, 'The two strings have the same triples');
 isomorph_graphs($model, $expected_model, 'The two models have the same triples');
 are_subgraphs($model1, $model2, 'Model 1 is a subgraph of model 2' );
 has_uri($uri_string, $model, 'Has correct URI');
 hasnt_uri($uri_string, $model, "Hasn't correct URI");
 has_subject($uri_string, $model, 'Subject URI is found');
 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');
 hasnt_literal($string, $language, $datatype, $model, 'Literal is not found');
 pattern_target($model);
 pattern_ok($pattern, '$pattern found in $model');
 pattern_fail($pattern, '$pattern not found in $model');

=head1 DESCRIPTION

This Perl module, Test::RDF, provides tools for testing code which
deals with RDF. It can test RDF for validity, check if two RDF graphs
are the same, or subgraphs of each other, if a URI is or is not in a
dataset, if it has certain subjects, predicates, objects or
literals. It can also test to see if a full pattern is present or
absent.


=head1 EXPORT

=head2 is_valid_rdf

Use to check if the input RDF string is valid in the chosen syntax

=cut

sub is_valid_rdf {
  my ($rdf, $syntax, $name) = @_;
  my $test = __PACKAGE__->builder;
  unless ($rdf) {
    $test->ok( 0, $name );
    $test->diag("No input was given.");
    return;
  }
  my $parser = RDF::Trine::Parser->new($syntax);
  eval {
    $parser->parse('http://example.org/', $rdf, sub {});
  };
  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;
  }
}


=head2 is_rdf

Use to check if the input RDF strings are isomorphic (i.e. the same).

=cut


sub is_rdf {
  my ($rdf1, $syntax1, $rdf2, $syntax2, $name) = @_;
  my $test = __PACKAGE__->builder;
  unless ($rdf1) {
    $test->ok( 0, $name );
    $test->diag("No input was given.");
    return;
  }
  my $parser1 = RDF::Trine::Parser->new($syntax1);
  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;
  }

  # 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);
}


=head2 isomorph_graphs

Use to check if the input RDF::Trine::Models have isomorphic graphs.

=cut


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;

  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

Use to check if the first RDF::Trine::Models is a subgraph of the second.

=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;

  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

Check if the string URI passed as first argument is a subject in any
of the statements given in the model given as second argument.

=cut

sub has_subject {
  my ($uri, $model, $name) = @_;
  my $resource = _resource_uri_checked($uri, $name);
  return $resource unless ($resource);
  my $count = $model->count_statements($resource, undef, undef);
  return _single_uri_tests($count, $name);
}


=head2 has_predicate

Check if the string URI passed as first argument is a predicate in any
of the statements given in the model given as second argument.

=cut

sub has_predicate {
  my ($uri, $model, $name) = @_;
  my $resource = _resource_uri_checked($uri, $name);
  return $resource unless ($resource);
  my $count = $model->count_statements(undef, $resource, undef);
  return _single_uri_tests($count, $name);
}

=head2 has_object_uri

Check if the string URI passed as first argument is a object in any
of the statements given in the model given as second argument.

=cut

sub has_object_uri {
  my ($uri, $model, $name) = @_;
  my $resource = _resource_uri_checked($uri, $name);
  return $resource unless ($resource);
  my $count = $model->count_statements(undef, undef, $resource);
  return _single_uri_tests($count, $name);
}

=head2 has_literal

Check if the string passed as first argument, with corresponding
optional language and datatype as second and third respectively, is a
literal in any of the statements given in the model given as fourth
argument.

language and datatype may not occur in the same statement, so the test
fails if they are both set. If none are used, use C<undef>, like e.g.

 has_literal('A test', undef, undef, $model, 'Simple literal');

A test for a typed literal may be done like

 has_literal('42', undef, 'http://www.w3.org/2001/XMLSchema#integer', $model, 'Just an integer');

and a language literal like

 has_literal('This is a Another test', 'en', undef, $model, 'Language literal');


=cut

sub has_literal {
  my ($string, $lang, $datatype, $model, $name) = @_;
  my $literal;
  my $test = __PACKAGE__->builder;
  eval {
    $literal = RDF::Trine::Node::Literal->new($string, $lang, $datatype);
  };
  if ( my $error = $@ ) {
    $test->ok( 0, $name );
    $test->diag("Invalid literal:\n\n\t$error");
    return;
  }

  if ($model->count_statements(undef, undef, $literal) > 0) {
    $test->ok( 1, $name );
    return 1;
  } else {
    $test->ok( 0, $name );
    $test->diag('No matching literals found in model');
    return 0;
  }
}


=head2 hasnt_literal

This is like the above, only the opposite: It checks if a literal
doesn't exist. Like the above, the test will fail if the literal is
invalid, however.

=cut

sub hasnt_literal {
  my ($string, $lang, $datatype, $model, $name) = @_;
  my $literal;
  my $test = __PACKAGE__->builder;
  eval {
    $literal = RDF::Trine::Node::Literal->new($string, $lang, $datatype);
  };

  if ( my $error = $@ ) {
    $test->ok( 0, $name );
    $test->diag("Invalid literal:\n\n\t$error");
    return;
  }

  if ($model->count_statements(undef, undef, $literal) > 0) {
    $test->ok( 0, $name );
    $test->diag('Matching literals found in model');
    return 0;
  } else {
    $test->ok( 1, $name );
    return 1;
  }
}



=head2 has_uri

Check if the string URI passed as first argument is present in any of
the statements given in the model given as second argument.

=cut

sub has_uri {
  my ($uri, $model, $name) = @_;
  my $test = __PACKAGE__->builder;
  my $resource = _resource_uri_checked($uri, $name);
  return $resource unless ($resource);
  if ($model->count_statements(undef, undef, $resource) > 0
      || $model->count_statements(undef, $resource, undef) > 0
      || $model->count_statements($resource, undef, undef) > 0) {
    $test->ok( 1, $name );
    return 1;
  } else {
    $test->ok( 0, $name );
    $test->diag('No matching URIs found in model');
    return 0;
  }
}


=head2 hasnt_uri

Check if the string URI passed as first argument is not present in any
of the statements given in the model given as second argument.

=cut

sub hasnt_uri {
  my ($uri, $model, $name) = @_;
  my $test = __PACKAGE__->builder;
  my $resource;
  eval {
	  $resource = RDF::Trine::Node::Resource->new($uri);
  };
  if (($resource) && ($model->count_statements(undef, undef, $resource) > 0
      || $model->count_statements(undef, $resource, undef) > 0
      || $model->count_statements($resource, undef, undef)) > 0) {
    $test->ok( 0, $name );
    $test->diag('Matching URIs found in model');
    return 0;
  } else {
    $test->ok( 1, $name );
    return 1;
  }
}


sub _single_uri_tests {
  my ($count, $name) = @_;
  my $test = __PACKAGE__->builder;
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  if ($count > 0) {
    $test->ok( 1, $name );
    return 1;
  } else {
    $test->ok( 0, $name );
    $test->diag('No matching URIs found in model');
    return 0;
  }
}

sub _resource_uri_checked {
	my ($uri, $name) = @_;
	my $resource;
	eval {
		$resource = RDF::Trine::Node::Resource->new($uri);
	};
	if ( my $error = $@ ) {
		my $test = __PACKAGE__->builder;
		local $Test::Builder::Level = $Test::Builder::Level + 1;
		$test->ok( 0, $name );
		$test->diag("No matching URIs found in model");
		return 0;
	}
	return $resource;
}

		



=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.

=head2 pattern_fail

The same as above, but tests if the pattern returns no results instead.

=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 = undef;
    $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 $s = RDF::Trine::Serializer::Turtle->new();

    my $iter    = $target->get_pattern($pattern);
    if ($iter->materialize->length > 0) {
      $test->ok(1, $message);
      return 1;
    }
	 # The test result is now known, return diagnostics
	 my $noreturns;
	 foreach my $triple ($pattern->triples) {
		 my @triple;
		 foreach my $node ($triple->nodes) {
			 if ($node->is_variable) {
				 push(@triple, undef);
			 } else {
				 push(@triple, $node);
			 }
		 }
		 next if ($target->count_statements(@triple));
		 $noreturns .= $triple->as_string . "\n";
	 }
    $test->ok(0, $message);
	 if ($noreturns) {
		 $test->diag("Triples that had no results:\n$noreturns");
	 } else {
		 $test->diag('Pattern as a whole did not match');
	 }
    return 0;
  }

  sub pattern_fail {
    my $message = undef;
    $message = pop @_ if !ref $_[-1];
    unless (defined $message and length $message) {
      $message = "Pattern doesn't 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)->materialize;

    if ($iter->length == 0) {
      $test->ok(1, $message);
      return 1;
    }
	 # The test result is now known, return diagnostics
    $test->ok(0, $message);
	 $test->diag("These triples had results:\n" . $iter->as_string);
    return 0;
  }
} # /scope for $target


=head1 NOTE

Graph isomorphism is a complex problem, so do not attempt to run the
isomorphism tests on large datasets. For more information see
L<http://en.wikipedia.org/wiki/Graph_isomorphism_problem>.


=head1 AUTHOR

Kjetil Kjernsmo, C<< <kjetilk at cpan.org> >>

=head1 BUGS

Please report any bugs using L<github|https://github.com/kjetilk/Test-RDF/issues>


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Test::RDF

You may find the Perl and RDF community L<website|http://www.perlrdf.org/> useful.

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Test-RDF>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Test-RDF>

=item * Search CPAN

L<http://search.cpan.org/dist/Test-RDF/>

=item * MetaCPAN

L<https://metacpan.org/module/Test::RDF>

=back


=head1 ACKNOWLEDGEMENTS

Michael Hendricks wrote the first Test::RDF. The present module is a
complete rewrite from scratch using Gregory Todd William's
L<RDF::Trine::Graph> to do the heavy lifting.

Toby Inkster has submitted the pattern_* functions.

=head1 LICENSE AND COPYRIGHT

Copyright 2010 ABC Startsiden AS and 2010-2013 Kjetil Kjernsmo.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Test::RDF