cvs-head/t/wais.t

#!/usr/bin/perl -w
#                              -*- Mode: Perl -*- 
# $Basename: wais.t $
# $Revision: 1.14 $
# Author          : Ulrich Pfeifer
# Created On      : Tue Dec 12 16:55:05 1995
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Sat Jan 19 21:46:24 2002
# Language        : Perl
# Update Count    : 192
# Status          : Unknown, Use with caution!
#
# (C) Copyright 1997, Ulrich Pfeifer, all rights reserved.
#
#

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

$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";
print "1..7\n";

use Fcntl;
if (1) {
  my $db = WAIT::Database->open(
                                name        => 'sample',
                                'directory' => "/tmp/wait-test-$$",
                                'mode'      => O_RDWR,
                               );
  print "not " unless $db;
  print "ok 1\n";
  my $tb = $db->table(name => 'bibdb');
  print "not " unless $tb;
  print "ok 2\n";
  
  print "not " unless $tb->open;
  print "ok 3\n";

  print "not " unless $tb->set(top => 1);
  print "ok 4\n";

  $tb->close;
  $db->close;
}


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

&headlines($result);

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;
print $#header >= 14 ?
    "ok 5\n" :
    "#\$\#header[$#header]result_text[$result_text]\nnot ok 5\n";

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;
print $result_text =~ m!Pfeifer/Fuhr:93! ?
    "ok 6\n" :
    "# result_text[$result_text]\nnot ok 6\n";

my @x = $short->split;
print $x[2] =~ /test.ste 3585 393$/ || $x[2] == 13 ?
    "ok 7\n" :
    "# \@x:[@x]\nnot ok 7\n";


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

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	# -- Mode: Perl --
3			# $Basename: wais.t $
4	ulpfr	19	# $Revision: 1.14 $
5	ulpfr	10	# Author : Ulrich Pfeifer
6			# Created On : Tue Dec 12 16:55:05 1995
7			# Last Modified By: Ulrich Pfeifer
8	ulpfr	64	# Last Modified On: Sat Jan 19 21:46:24 2002
9	ulpfr	10	# Language : Perl
10	ulpfr	64	# Update Count : 192
11	ulpfr	10	# Status : Unknown, Use with caution!
12	ulpfr	13	#
13	ulpfr	10	# (C) Copyright 1997, Ulrich Pfeifer, all rights reserved.
14	ulpfr	13	#
15			#
16	ulpfr	10
17			use WAIT::Database;
18			use WAIT::Wais;
19			use Cwd;
20	ulpfr	13	use strict;
21	laperla	63	use File::Path qw(mkpath rmtree);
22	ulpfr	10
23			$SIG{__DIE__} = $SIG{INT} = \&cleanup;
24
25			my $pwd = getcwd();
26	laperla	63	mkpath "/tmp/wait-test-$$";
27			print "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample\n";
28			system "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample > /dev/null 2>&1";
29	ulpfr	19	print "1..7\n";
30	ulpfr	10
31	ulpfr	19	use Fcntl;
32			if (1) {
33			my $db = WAIT::Database->open(
34			name => 'sample',
35	laperla	63	'directory' => "/tmp/wait-test-$$",
36	ulpfr	19	'mode' => O_RDWR,
37			);
38			print "not " unless $db;
39			print "ok 1\n";
40			my $tb = $db->table(name => 'bibdb');
41			print "not " unless $tb;
42			print "ok 2\n";
43
44			print "not " unless $tb->open;
45			print "ok 3\n";
46
47			print "not " unless $tb->set(top => 1);
48			print "ok 4\n";
49
50			$tb->close;
51			$db->close;
52			}
53
54
55	laperla	63	my $db = "/tmp/wait-test-$$/sample/bibdb";
56	ulpfr	13	print "# Testing WAIT searches\n";
57			my $result = WAIT::Wais::Search({
58			'query' => 'pfeifer',
59			'database' => $db,
60			});
61	ulpfr	10
62			&headlines($result);
63	ulpfr	64
64	ulpfr	13	my @header = $result->header;
65	ulpfr	64	my $N;
66			for (my $n=0;$n<@header;$n++) {
67			$N = $n if ${$header[$n]->[6]} eq "wait;/tmp/wait-test-$$/sample/bibdb;13";
68			}
69			my $id = ($result->header)[$N]->[6];
70			my $short = ($result->header)[$N]->[6];
71	ulpfr	10
72	ulpfr	13	my $result_text = $result->text;
73			print $#header >= 14 ?
74	ulpfr	19	"ok 5\n" :
75			"#\$\#header[$#header]result_text[$result_text]\nnot ok 5\n";
76	ulpfr	13
77			print "# Testing local retrieve\n";
78	ulpfr	10	$result = WAIT::Wais::Retrieve(
79			'database' => $db,
80	ulpfr	13	'docid' => $id,
81	ulpfr	10	'query' => 'pfeifer',
82			'type' => 'HTML',
83			);
84	ulpfr	13	$result_text = $result->text;
85			$result_text =~ s/^/# /gm;
86			print $result_text =~ m!Pfeifer/Fuhr:93! ?
87	ulpfr	19	"ok 6\n" :
88			"# result_text[$result_text]\nnot ok 6\n";
89	ulpfr	10
90	ulpfr	13	my @x = $short->split;
91	ulpfr	64	print $x[2] =~ /test.ste 3585 393$/ \|\| $x[2] == 13 ?
92	ulpfr	19	"ok 7\n" :
93			"# \@x:[@x]\nnot ok 7\n";
94	ulpfr	10
95	ulpfr	13
96			#######################################################################
97
98	ulpfr	10	sub headlines {
99			my $result = shift;
100			my ($tag, $score, $lines, $length, $headline, $types, $id);
101
102			for ($result->header) {
103			($tag, $score, $lines, $length, $headline, $types, $id) = @{$_};
104	ulpfr	13	printf "# %5d %5d %s %s\n",
105	ulpfr	10	$score*1000, $lines, $headline, join(',', @{$types});
106			}
107			}
108
109	ulpfr	19	# releasing 1 pending lock... at .../LockFile/Simple.pm
110			open STDERR, '>/dev/null';
111
112	ulpfr	10	sub cleanup
113			{
114	laperla	63	rmtree "/tmp/wait-test-$$";
115	ulpfr	10	}
116
117
118			sub END
119			{
120			&cleanup;
121			}