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	ulpfr	10	#!/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			}