/[wait]/branches/CPAN/t/wais.t
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /branches/CPAN/t/wais.t

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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