CPAN/t/wais.t

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

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

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

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

print "1..3\n";
$db = '/tmp/sample/bibdb';
print "Testing WAIT searches\n";
$result = WAIT::Wais::Search({
    'query'    => 'pfeifer', 
    'database' => $db,
    });

&headlines($result);
$id     = ($result->header)[9]->[6];
#$length = ($result->header)[9]->[3];
@header = $result->header;

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

$short = ($result->header)[0]->[6];
print $result->text;
print ( ($#header >= 14) ? "ok 1\n" : "not ok 1\n$#header\n" );

print "Testing local retrieve\n";
$result = WAIT::Wais::Retrieve(
                              'database' => $db,
                              'docid'    => $id, 
                              'query'    => 'pfeifer',
                              'type'     => 'HTML',
                             );
print $result->text, "\n";
print ( ($result->text =~ m!Pfeifer/etal:94!) ? "ok 2\n" : "not ok 2\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});
    }
}

@x = $short->split;
print ( ($x[2] =~ /test.ste 3585 393$/ or $x[2] == 10) ? "ok 3\n" : "not ok 3\n" );

sub cleanup
{
  system 'rm -rf /tmp/sample';
}


sub END
{
  &cleanup;
}
1	#!/usr/bin/perl
2	# -- Mode: Perl --
3	# $Basename: wais.t $
4	# $Revision: 1.5 $
5	# Author : Ulrich Pfeifer
6	# Created On : Tue Dec 12 16:55:05 1995
7	# Last Modified By: Ulrich Pfeifer
8	# Last Modified On: Wed Nov 12 19:46:12 1997
9	# Language : Perl
10	# Update Count : 157
11	# Status : Unknown, Use with caution!
12	#
13	# (C) Copyright 1997, Ulrich Pfeifer, all rights reserved.
14	#
15	#
16
17	use WAIT::Database;
18	use WAIT::Wais;
19	use Cwd;
20
21	$SIG{__DIE__} = $SIG{INT} = \&cleanup;
22
23	my $pwd = getcwd();
24	print "$^X -Iblib blib/script/bibdb -dir /tmp -database sample\n";
25	system "$^X -Iblib blib/script/bibdb -dir /tmp -database sample > /dev/null 2>&1";
26
27	print "1..3\n";
28	$db = '/tmp/sample/bibdb';
29	print "Testing WAIT searches\n";
30	$result = WAIT::Wais::Search({
31	'query' => 'pfeifer',
32	'database' => $db,
33	});
34
35	&headlines($result);
36	$id = ($result->header)[9]->[6];
37	#$length = ($result->header)[9]->[3];
38	@header = $result->header;
39
40	#my $types=($result->header)[9]->[5];
41	#print STDERR "\n## @$types\n";
42
43	$short = ($result->header)[0]->[6];
44	print $result->text;
45	print ( ($#header >= 14) ? "ok 1\n" : "not ok 1\n$#header\n" );
46
47	print "Testing local retrieve\n";
48	$result = WAIT::Wais::Retrieve(
49	'database' => $db,
50	'docid' => $id,
51	'query' => 'pfeifer',
52	'type' => 'HTML',
53	);
54	print $result->text, "\n";
55	print ( ($result->text =~ m!Pfeifer/etal:94!) ? "ok 2\n" : "not ok 2\n" );
56
57
58	sub headlines {
59	my $result = shift;
60	my ($tag, $score, $lines, $length, $headline, $types, $id);
61
62	for ($result->header) {
63	($tag, $score, $lines, $length, $headline, $types, $id) = @{$_};
64	printf "%5d %5d %s %s\n",
65	$score*1000, $lines, $headline, join(',', @{$types});
66	}
67	}
68
69	@x = $short->split;
70	print ( ($x[2] =~ /test.ste 3585 393$/ or $x[2] == 10) ? "ok 3\n" : "not ok 3\n" );
71
72	sub cleanup
73	{
74	system 'rm -rf /tmp/sample';
75	}
76
77
78	sub END
79	{
80	&cleanup;
81	}