CPAN/t/wais.t

#!/usr/bin/perl
#                              -*- 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: Mon May  8 20:51:25 2000
# Language        : Perl
# Update Count    : 182
# Status          : Unknown, Use with caution!
#
# (C) Copyright 1997, Ulrich Pfeifer, all rights reserved.
#
#

use WAIT::Database;
use WAIT::Wais;
use Cwd;
use strict;

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

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

use Fcntl;
if (1) {
  my $db = WAIT::Database->open(
                                name        => 'sample',
                                'directory' => '/tmp',
                                '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/sample/bibdb';
print "# Testing WAIT searches\n";
my $result = WAIT::Wais::Search({
                                 'query'    => 'pfeifer',
                                 'database' => $db,
                                });

&headlines($result);
my $id     = ($result->header)[9]->[6];
# no strict order
$$id = 'wait;/tmp/sample/bibdb;13';
#$length = ($result->header)[9]->[3];
my @header = $result->header;

#my $types=($result->header)[9]->[5];
#print STDERR "\n## @$types\n";

my $short = ($result->header)[0]->[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] == 1 ?
    "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
{
  system 'rm -rf /tmp/sample';
}


sub END
{
  &cleanup;
}
1	ulpfr	10	#!/usr/bin/perl
2			# -- 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	19	# Last Modified On: Mon May 8 20:51:25 2000
9	ulpfr	10	# Language : Perl
10	ulpfr	19	# Update Count : 182
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	ulpfr	10
22			$SIG{__DIE__} = $SIG{INT} = \&cleanup;
23
24			my $pwd = getcwd();
25	ulpfr	19	print "$^X -Mblib blib/script/bibdb -dir /tmp -database sample\n";
26			system "$^X -Mblib blib/script/bibdb -dir /tmp -database sample > /dev/null 2>&1";
27			print "1..7\n";
28	ulpfr	10
29	ulpfr	19	use Fcntl;
30			if (1) {
31			my $db = WAIT::Database->open(
32			name => 'sample',
33			'directory' => '/tmp',
34			'mode' => O_RDWR,
35			);
36			print "not " unless $db;
37			print "ok 1\n";
38			my $tb = $db->table(name => 'bibdb');
39			print "not " unless $tb;
40			print "ok 2\n";
41
42			print "not " unless $tb->open;
43			print "ok 3\n";
44
45			print "not " unless $tb->set(top => 1);
46			print "ok 4\n";
47
48			$tb->close;
49			$db->close;
50			}
51
52
53	ulpfr	13	my $db = '/tmp/sample/bibdb';
54			print "# Testing WAIT searches\n";
55			my $result = WAIT::Wais::Search({
56			'query' => 'pfeifer',
57			'database' => $db,
58			});
59	ulpfr	10
60			&headlines($result);
61	ulpfr	13	my $id = ($result->header)[9]->[6];
62	ulpfr	19	# no strict order
63			$$id = 'wait;/tmp/sample/bibdb;13';
64	ulpfr	10	#$length = ($result->header)[9]->[3];
65	ulpfr	13	my @header = $result->header;
66	ulpfr	10
67			#my $types=($result->header)[9]->[5];
68			#print STDERR "\n## @$types\n";
69
70	ulpfr	13	my $short = ($result->header)[0]->[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			print $x[2] =~ /test.ste 3585 393$/ \|\| $x[2] == 1 ?
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			system 'rm -rf /tmp/sample';
115			}
116
117
118			sub END
119			{
120			&cleanup;
121			}