t/v4_02_repos.t - metacpan.org

use Test::More 'no_plan';
use Test::Exception;

use Data::Dumper;

use constant DONE => 0;

my $AG_SERVER = $ENV{AG4_SERVER};
unless ($AG_SERVER) {
    ok (1, 'Tests skipped. Use "export AG4_SERVER=http://my.server:port" before running the test suite. See README for details.');
    exit;
}

if (DONE) {
    use RDF::AllegroGraph::Server;
    my $server = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    # TODO: generate scratch here
    use RDF::AllegroGraph::Catalog4;
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);

    use Fcntl;
    my $model  = $scratch->repository ('/scratch/catlitter', O_CREAT);

    is ($model->size, 0, 'empty model');
    $model->add ();
    is ($model->size, 0, 'still empty model');

    $model->add (['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:rho>']);
    is ($model->size, 1, 'added: model of 1');

    $model->add (['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:rho>']);
    is ($model->size, 2, 'added: model of 2');
    
    $model->replace (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>']);
    is ($model->size, 1, 'replaced: model of 1');

    $model->add (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:katty>'],
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:ketty>'],
	);
    is ($model->size, 4, 'replaced/added: model of 4');

    $model->delete (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>']);
    is ($model->size, 3, 'deleted (fact): model of 3');

    $model->delete ([undef, '<urn:x-me:hates>', undef]);
    is ($model->size, 1, 'deleted (wildcard): model of 1');

    $model->delete (['<urn:x-me:rumsti>', undef, undef]);
    is ($model->size, 1, 'deleted (wildcard): model of 1');

    $model->add (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>'],
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:katty>'],
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
	);
    $model->delete ([undef, '<urn:x-me:loves>', undef ],
		    [undef, undef, '<urn:x-me:kitty>' ]	);
    is ($model->size, 1, 'deleted (wildcard): model of 1');

    $model->replace (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:katty>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
	);
    $model->delete ([undef, '<urn:x-me:loves>', undef ],
                    ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>' ] );
    is ($model->size, 2, 'deleted (wildcard): model of 2');

    $model->disband;
}

if (DONE) { # blank nodes
    my $server  = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    my $model   = $scratch->repository ('/scratch/catlitter', O_CREAT);

    $model->replace (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:katty>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
	             );
    my @bs = $model->blanks (10);
    is ((scalar @bs), 10, 'enough blanks');
    map { like ($_, qr/^_:.+/, 'blanks look good') } @bs;
    $model->disband;
}

if (DONE) {
    my $server  = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    my $model   = $scratch->repository ('/scratch/catlitter', O_CREAT);

    $model->replace (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:katty>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
	             );

    my @ss = $model->match ([undef, undef, '<urn:x-me:kitty>']);
    is (scalar @ss, 2, 'match found kitty');
    map { is ($_->[2], '<urn:x-me:kitty>', 'kitty!') } @ss;

    @ss = $model->match (['<urn:x-me:sacklpicker>', undef, undef]);
    is (scalar @ss, 4, 'match found sacklpicker');
    map { is ($_->[0], '<urn:x-me:sacklpicker>', 'sacklpicker!') } @ss;

    @ss = $model->match (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>']);
    is (scalar @ss, 2, 'match found exactly two identical');

    @ss = $model->match ([undef, '<urn:x-me:hates>', undef],
			 [undef, '<urn:x-me:loves>', undef]);
    is (scalar @ss, 4, 'match found love and hate');

    @ss = $model->match ({ limit => 2 },
			 [undef, '<urn:x-me:hates>', undef],
			 [undef, '<urn:x-me:loves>', undef]);
    is (scalar @ss, 3, 'match found love and hate (4->2)');

    $model->disband;
}

if (DONE) {
    my $server  = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    my $model   = $server->model ('/scratch/catlitter', mode => O_CREAT);

    $model->add ('<urn:x-me:sacklpicker> <urn:x-me:hates> <urn:x-me:tomcat> .');
    is (scalar $model->match (['<urn:x-me:sacklpicker>', undef, undef]), 1, 'added N3: 1');

    $model->add ('<urn:x-me:sacklpicker> <urn:x-me:hates> <urn:x-me:kitty> .
                  <urn:x-me:sacklpicker> <urn:x-me:hates> <urn:x-me:katty> .');
    is (scalar $model->match (['<urn:x-me:sacklpicker>', undef, undef]), 3, 'added N3: 3');

    $model->replace ('<urn:x-me:sacklpicker> <urn:x-me:hates> <urn:x-me:ketty> .
                      <urn:x-me:sacklpicker> <urn:x-me:hates> <urn:x-me:kotty> .');
    is (scalar $model->match (['<urn:x-me:sacklpicker>', undef, undef]), 2, 'replaced N3: 2');

    $model->disband;
}

my $file;
END { $AG_SERVER && defined $file && unlink $file; }

if (DONE) {
    use POSIX qw(tmpnam);
    use IO::File;
    do { $file = tmpnam().".n3";  } until IO::File->new ($file, O_RDWR|O_CREAT|O_EXCL);
    my $fh = IO::File->new ("> $file") || die "so what?";
    print $fh "
<urn:x-me:sacklpicker> <urn:x-me:hates> <urn:x-me:ketty> .
<urn:x-me:sacklpicker> <urn:x-me:hates> <urn:x-me:kotty> .
";
    $fh->close;

    my $server  = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    my $model   = $server->model ('/scratch/catlitter', mode => O_CREAT);

    $model->add ('file://'. $file);
    is (scalar $model->match (['<urn:x-me:sacklpicker>', undef, undef]), 2, 'added N3 file: 2');

    $model->replace (('file://'. $file ) x 3);
    is (scalar $model->match (['<urn:x-me:sacklpicker>', undef, undef]), 2*3, 'added N3 file: 2*3');

    $model->disband;
}


if (1||DONE) { # sparql and prolog queries
    my $server  = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    my $model   = $server->model ('/scratch/catlitter', mode => O_CREAT);

#    $model->namespace ('rdfs' => 'http://www.w3.org/2000/01/rdf-schema#');

    $model->add (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>'],
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:katty>'],
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],

		 ['<urn:x-me:hates>',       '<http://www.w3.org/2000/01/rdf-schema#subPropertyOf>', '<urn:x-me:knows>'],
		 ['<urn:x-me:loves>',       '<http://www.w3.org/2000/01/rdf-schema#subPropertyOf>', '<urn:x-me:knows>'],

		 ['<urn:x-me:tomcat>', '<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>',       '<urn:x-me:Cat>'],
		 ['<urn:x-me:Cat>',    '<http://www.w3.org/2000/01/rdf-schema#subClassOf>', '<urn:x-me:Mammal>'],
	);

    my @ss = $model->sparql ('SELECT ?p ?o WHERE {<urn:x-me:sacklpicker> ?p ?o .}' );
#    warn Dumper \@ss;
    is (scalar @ss, 4, 'query: all triples');
    map { like ($_->[0], qr/<urn:x-me:(hates|loves)>/, 'love/hate everywhere') } @ss;
    map { is (scalar @$_, 2,                           'tuple everywhere')     } @ss;

    @ss = $model->sparql ('SELECT ?thing WHERE { ?cat <urn:x-me:hates> ?thing . }' );
    is (scalar @ss, 2, 'query: all that hate (SPARQL)');
    map {  like ($_->[0], qr/<urn:x-me:(kitty|tomcat)>/, 'tomcat/kitty everywhere') } @ss;
    map { is (scalar @$_, 1,                 'singleton everywhere')        } @ss;

    @ss = $model->prolog (q{
 (select (?thing)
            (q ?cat !<urn:x-me:hates> ?thing)
  )
});
    is (scalar @ss, 3, 'query: all that hate (Prolog), delivers duplicate');
    map {  like ($_->[0], qr/<urn:x-me:(kitty|tomcat)>/, 'tomcat/kitty everywhere') } @ss;
    map { is (scalar @$_, 1,                 'singleton everywhere')        } @ss;
#    warn Dumper \@ss;

# reasoning
    @ss = $model->sparql ('SELECT ?thing WHERE { ?cat <urn:x-me:hates> ?thing . }', INFERENCING => undef );
    is (scalar @ss, 2, 'query: all that hate (SPARQL, no reasoning)');

    @ss = $model->sparql ('SELECT ?thing WHERE { ?cat <urn:x-me:knows> ?thing . }', INFERENCING => 'true' );
    is (scalar @ss, 4, 'query: all that hate and love (SPARQL, rdfs++ reasoning)');

# reasoning and naming
    my $ss = $model->sparql ('SELECT ?cat ?thing WHERE { ?cat <urn:x-me:knows> ?thing . }', INFERENCING => 'true', RETURN => 'NAMED_TUPLE_LIST' );
    ok (eq_array ($ss->{names}, [ 'cat', 'thing' ]), 'names are there');
    is ((scalar @{$ss->{values}}), 4, 'query: all that hate and love (SPARQL, rdfs++ reasoning, NAMED)');

    $model->disband;
}

if (DONE) {
    my $server  = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    my $model   = $scratch->repository ('/scratch/catlitter', O_CREAT);

    $model->replace (['<urn:x-me:sacklpicker>', '<urn:x-me:nrlegs>', '"6"^^<http://www.w3.org/2001/XMLSchema#long>'],
		     ['<urn:x-me:tomcat>',      '<urn:x-me:nrlegs>', '"2"^^<http://www.w3.org/2001/XMLSchema#long>'],
		     ['<urn:x-me:kitty>',       '<urn:x-me:nrlegs>', '"3"^^<http://www.w3.org/2001/XMLSchema#long>'],
		     ['<urn:x-me:fluffy>',      '<urn:x-me:nrlegs>', '"4"^^<http://www.w3.org/2001/XMLSchema#long>'],
	             );

    my @ss = $model->match ([undef, undef, '"3"^^<http://www.w3.org/2001/XMLSchema#long>']);
    is ((scalar @ss), 1, 'match with singular literal');

    @ss = $model->match ([undef, undef, [ '"3"^^<http://www.w3.org/2001/XMLSchema#long>', '"5"^^<http://www.w3.org/2001/XMLSchema#long>']]);
    is ((scalar @ss), 2, 'match with range literal');
    
    ok (eq_array ([ 3, 4 ],
		  [ sort
		    map { $_ =~ /"(\d+)"/ && $1 } 
		    map { $_->[2] }
		    @ss
		    ]), 'correct range values');


    @ss = $model->sparql ('SELECT ?s WHERE {?s <urn:x-me:nrlegs> ?o . FILTER ( ?o > 4 ) }' );
#    warn Dumper \@ss;
    ok (eq_array ([
		   [
		    '<urn:x-me:sacklpicker>'
		    ]
		   ],
		  \@ss
		  ), 'correct integer range query');


#    warn Dumper \@ss;

    $model->add (['<urn:x-me:sacklpicker>', '<urn:x-me:age>', '"666.6"^^<http://www.w3.org/2001/XMLSchema#float>'],
		 ['<urn:x-me:tomcat>',      '<urn:x-me:age>', '"3.141"^^<http://www.w3.org/2001/XMLSchema#float>'],
		 ['<urn:x-me:kitty>',       '<urn:x-me:age>', '"2"^^<http://www.w3.org/2001/XMLSchema#long>'],
		 ['<urn:x-me:fluffy>',      '<urn:x-me:age>', '"3"^^<http://www.w3.org/2001/XMLSchema#long>'],
		 );

    @ss = $model->sparql ('SELECT ?s WHERE {?s <urn:x-me:age> ?age . FILTER ( ?age > 3 && ?age < 333.3) }' );
#    warn Dumper \@ss;
    ok (eq_array ([
		   [
		    '<urn:x-me:tomcat>'
		    ]
		   ],
		  \@ss
		  ), 'correct float/int range query');

    use Time::HiRes;
    my $now = time();
    use DateTime;
    $model->add (
		 ['<urn:x-me:sacklpicker>', '<urn:x-me:birth>', '"'.DateTime->from_epoch ( epoch => ($now + 100)).'"^^<xsd#dateTime>'],
		 ['<urn:x-me:tomcat>',      '<urn:x-me:birth>', '"'.DateTime->from_epoch ( epoch => ($now - 100)).'"^^<xsd#dateTime>'],
		 ['<urn:x-me:kitty>',       '<urn:x-me:birth>', '"'.DateTime->from_epoch ( epoch => ($now +  10)).'"^^<xsd#dateTime>'],
		 ['<urn:x-me:fluffy>',      '<urn:x-me:birth>', '"'.DateTime->from_epoch ( epoch => ($now +  20)).'"^^<xsd#dateTime>'],
		 );
    @ss = $model->sparql ('SELECT ?s WHERE {?s <urn:x-me:birth> ?birth . FILTER ( ?birth > "'.DateTime->from_epoch ( epoch => $now ).'"^^<xsd#dateTime> ) }' );
#    warn Dumper \@ss;
    ok (eq_array ([
		   [
		    '<urn:x-me:sacklpicker>'
		    ],
		   [
		    '<urn:x-me:kitty>'
		    ],
		   [
		    '<urn:x-me:fluffy>'
		    ]
		   ],
                  \@ss
                  ), 'correct date range query');

    $model->disband;
}

if (DONE) { # indices
    my $server = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    use Fcntl;
    my $model  = $scratch->repository ('/scratch/catlitter', O_CREAT);

    my @vidxs = $model->valid_indices;
    ok ((grep { $_ eq 'spogi' } @vidxs), 'valid indices listed');

    my @idxs = $model->indices;
    ok (eq_set ([
		 'i',
		 'gospi',
		 'gposi',
		 'gspoi',
		 'ospgi',
		 'posgi',
		 'spogi'
		 ], \@idxs), 'default indices in the store');

    @idxs = $model->indices ('-gospi', '-gposi');
    ok (eq_set ([
		 'i',
		 'gspoi',
		 'ospgi',
		 'posgi',
		 'spogi'
		 ], \@idxs), 'after removal: indices in the store');

    ok (eq_set ([ 'spogi' ],
		[ $model->indices (map  { "-$_" }
                                   grep { $_ ne 'spogi' } @idxs) ]), 'removed all indices except one');

    throws_ok {
	$model->indices ('-spogi');
    } qr/at least one/, 'cannot remove last index';

    foreach my $idx (@vidxs) { # gradually adding all indices
	ok ((	grep { $_ eq $idx }
		$model->indices ("+$idx") ), "$idx has been added");
    }

    @idxs = $model->indices;
    ok (eq_set (\@vidxs, \@idxs), 'after adding all indices: all valid ones');

    $model->disband;
}

if (DONE) { # bulk, commit and duplicate modes, only the switches
    my $server  = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    my $model   = $scratch->repository ('/scratch/catlitter', O_CREAT);

    ok (!$model->bulk_loading_mode, 'bulk loading disabled by default');

    ok ( $model->bulk_loading_mode (1), 'switched on');
    ok ( $model->bulk_loading_mode,     'still switched on');

    ok (!$model->bulk_loading_mode (0), 'switched off');
    ok (!$model->bulk_loading_mode,     'still switched off');

    ok ( $model->bulk_loading_mode (1), 'switched on again');

    ok ( $model->commit_mode, 'commit enabled by default');
    ok (!$model->commit_mode (0), 'switched off');
    ok (!$model->commit_mode,     'still switched off');
    ok ( $model->commit_mode (1), 'switched on');
    ok ( $model->commit_mode,     'still switched on');

    ok ( $model->duplicate_suppression_mode, 'duplicate suppression enabled by default');
    ok (!$model->duplicate_suppression_mode (0), 'switched off');
    ok (!$model->duplicate_suppression_mode,     'still switched off');
    ok ( $model->duplicate_suppression_mode (1), 'switched on');
    ok ( $model->duplicate_suppression_mode,     'still switched on');

    $model->disband;
}

if (0&&DONE) { # test duplicate suppression
    my $server  = new RDF::AllegroGraph::Server (ADDRESS => $AG_SERVER);
    my $scratch = new RDF::AllegroGraph::Catalog4 (NAME => '/scratch', SERVER => $server);
    my $model   = $scratch->repository ('/scratch/catlitter', O_CREAT);

    $model->duplicate_suppression_mode (1);

    for (1..2) {
	$model->add (['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:tomcat>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:loves>', '<urn:x-me:katty>'],
		     ['<urn:x-me:sacklpicker>', '<urn:x-me:hates>', '<urn:x-me:kitty>'],
		     );
    }

    is ($model->size, 4, 'suppressed model');

    $model->disband;
}

__END__
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)