trunk/t/wais.t

#!/usr/bin/perl -w

use Test::More;
use blib;

use WAIT::Database;
use WAIT::Wais;
use Cwd;
use strict;
use File::Path qw(mkpath rmtree);

plan tests => 10;

$SIG{__DIE__} = $SIG{INT} = \&cleanup;

my $pwd = getcwd();
mkpath "/tmp/wait-test-$$";
print  "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample\n";
system "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample > /dev/null 2>&1";

use Fcntl;

ok(
  my $db = WAIT::Database->open(
                                name        => 'sample',
                                'directory' => "/tmp/wait-test-$$",
                                'mode'      => O_RDWR,
  ), "open");

ok(my $tb = $db->table(name => 'bibdb'), "table");
  
ok($tb->open, "open");

ok($tb->set(top => 1), "set(top => 1)");

ok($tb->close, "tb->close");
ok($db->close, "db->close");

$db = "/tmp/wait-test-$$/sample/bibdb";
print "# Testing WAIT searches\n";
ok(my $result = WAIT::Wais::Search({
                                 'query'    => 'pfeifer',
                                 'database' => $db,
                                }),
  "WAIT::Wais::Search");

ok(&headlines($result), "headlines");

my @header = $result->header;
my $N;
for (my $n=0;$n<@header;$n++) {
  $N = $n if ${$header[$n]->[6]} eq "wait;/tmp/wait-test-$$/sample/bibdb;13";
}
my $id    = ($result->header)[$N]->[6];
my $short = ($result->header)[$N]->[6];

my $result_text = $result->text;
ok($#header >= 14, "\$\#header[$#header]result_text[$result_text]");

print "# Testing local retrieve\n";
$result = WAIT::Wais::Retrieve(
                              'database' => $db,
                              'docid'    => $id,
                              'query'    => 'pfeifer',
                              'type'     => 'HTML',
                             );
$result_text = $result->text;
$result_text =~ s/^/# /gm;
ok($result_text =~ m!Pfeifer/Fuhr:93!, "result_text[$result_text]");

my @x = $short->split;
ok($x[2] =~ /test.ste 3585 393$/ || $x[2] == 13, "\@x:[@x]");


#######################################################################

sub headlines {
    my $result = shift;
    my ($tag, $score, $lines, $length, $headline, $types, $id);

    for ($result->header) {
        ($tag, $score, $lines, $length, $headline, $types, $id) = @{$_};
        printf "# %5d %5d %s %s\n",
        $score*1000, $lines, $headline, join(',', @{$types});
    }
}

# releasing 1 pending lock... at .../LockFile/Simple.pm
open STDERR, '>/dev/null';

sub cleanup
{
  rmtree "/tmp/wait-test-$$";
}


sub END
{
  &cleanup;
}
1	ulpfr	25	#!/usr/bin/perl -w
2	ulpfr	10
3	dpavlin	116	use Test::More;
4			use blib;
5
6	ulpfr	10	use WAIT::Database;
7			use WAIT::Wais;
8			use Cwd;
9	ulpfr	13	use strict;
10	laperla	63	use File::Path qw(mkpath rmtree);
11	ulpfr	10
12	dpavlin	116	plan tests => 10;
13
14	ulpfr	10	$SIG{__DIE__} = $SIG{INT} = \&cleanup;
15
16			my $pwd = getcwd();
17	laperla	63	mkpath "/tmp/wait-test-$$";
18			print "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample\n";
19			system "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample > /dev/null 2>&1";
20	ulpfr	10
21	ulpfr	19	use Fcntl;
22	dpavlin	116
23			ok(
24	ulpfr	19	my $db = WAIT::Database->open(
25			name => 'sample',
26	laperla	63	'directory' => "/tmp/wait-test-$$",
27	ulpfr	19	'mode' => O_RDWR,
28	dpavlin	116	), "open");
29
30			ok(my $tb = $db->table(name => 'bibdb'), "table");
31	ulpfr	19
32	dpavlin	116	ok($tb->open, "open");
33	ulpfr	19
34	dpavlin	116	ok($tb->set(top => 1), "set(top => 1)");
35	ulpfr	19
36	dpavlin	116	ok($tb->close, "tb->close");
37			ok($db->close, "db->close");
38	ulpfr	19
39	dpavlin	116	$db = "/tmp/wait-test-$$/sample/bibdb";
40	ulpfr	13	print "# Testing WAIT searches\n";
41	dpavlin	116	ok(my $result = WAIT::Wais::Search({
42	ulpfr	13	'query' => 'pfeifer',
43			'database' => $db,
44	dpavlin	116	}),
45			"WAIT::Wais::Search");
46	ulpfr	10
47	dpavlin	116	ok(&headlines($result), "headlines");
48	ulpfr	64
49	ulpfr	13	my @header = $result->header;
50	ulpfr	64	my $N;
51			for (my $n=0;$n<@header;$n++) {
52			$N = $n if ${$header[$n]->[6]} eq "wait;/tmp/wait-test-$$/sample/bibdb;13";
53			}
54			my $id = ($result->header)[$N]->[6];
55			my $short = ($result->header)[$N]->[6];
56	ulpfr	10
57	ulpfr	13	my $result_text = $result->text;
58	dpavlin	116	ok($#header >= 14, "\$\#header[$#header]result_text[$result_text]");
59	ulpfr	13
60			print "# Testing local retrieve\n";
61	ulpfr	10	$result = WAIT::Wais::Retrieve(
62			'database' => $db,
63	ulpfr	13	'docid' => $id,
64	ulpfr	10	'query' => 'pfeifer',
65			'type' => 'HTML',
66			);
67	ulpfr	13	$result_text = $result->text;
68			$result_text =~ s/^/# /gm;
69	dpavlin	116	ok($result_text =~ m!Pfeifer/Fuhr:93!, "result_text[$result_text]");
70	ulpfr	10
71	ulpfr	13	my @x = $short->split;
72	dpavlin	116	ok($x[2] =~ /test.ste 3585 393$/ \|\| $x[2] == 13, "\@x:[@x]");
73	ulpfr	10
74	ulpfr	13
75			#######################################################################
76
77	ulpfr	10	sub headlines {
78			my $result = shift;
79			my ($tag, $score, $lines, $length, $headline, $types, $id);
80
81			for ($result->header) {
82			($tag, $score, $lines, $length, $headline, $types, $id) = @{$_};
83	ulpfr	13	printf "# %5d %5d %s %s\n",
84	ulpfr	10	$score*1000, $lines, $headline, join(',', @{$types});
85			}
86			}
87
88	ulpfr	19	# releasing 1 pending lock... at .../LockFile/Simple.pm
89			open STDERR, '>/dev/null';
90
91	ulpfr	10	sub cleanup
92			{
93	laperla	63	rmtree "/tmp/wait-test-$$";
94	ulpfr	10	}
95
96
97			sub END
98			{
99			&cleanup;
100			}