/[wait]/trunk/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 /trunk/t/wais.t

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

branches/CPAN/t/wais.t revision 11 by unknown, Fri Apr 28 15:41:10 2000 UTC cvs-head/t/wais.t revision 25 by ulpfr, Sat Nov 11 17:24:38 2000 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl -w
2  #                              -*- Mode: Perl -*-  #                              -*- Mode: Perl -*-
3  # $Basename: wais.t $  # $Basename: wais.t $
4  # $Revision: 1.5 $  # $Revision: 1.14 $
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
8  # Last Modified On: Wed Nov 12 19:46:12 1997  # Last Modified On: Sat Nov 11 16:33:54 2000
9  # Language        : Perl  # Language        : Perl
10  # Update Count    : 157  # Update Count    : 187
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    
24  my $pwd = getcwd();  my $pwd = getcwd();
25  print  "$^X -Iblib blib/script/bibdb -dir /tmp -database sample\n";  print  "$^X -Mblib blib/script/bibdb -dir /tmp -database sample\n";
26  system "$^X -Iblib blib/script/bibdb -dir /tmp -database sample > /dev/null 2>&1";  system "$^X -Mblib blib/script/bibdb -dir /tmp -database sample > /dev/null 2>&1";
27    print "1..7\n";
28    
29    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 "1..3\n";    print "not " unless $tb->set(top => 1);
46  $db = '/tmp/sample/bibdb';    print "ok 4\n";
47  print "Testing WAIT searches\n";  
48  $result = WAIT::Wais::Search({    $tb->close;
49      'query'    => 'pfeifer',    $db->close;
50      'database' => $db,  }
51      });  
52    
53    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    
60  &headlines($result);  &headlines($result);
61  $id     = ($result->header)[9]->[6];  my $id     = ($result->header)[9]->[6];
62    # no strict order
63    $$id = 'wait;/tmp/sample/bibdb;13';
64  #$length = ($result->header)[9]->[3];  #$length = ($result->header)[9]->[3];
65  @header = $result->header;  my @header = $result->header;
66    
67  #my $types=($result->header)[9]->[5];  #my $types=($result->header)[9]->[5];
68  #print STDERR "\n## @$types\n";  #print STDERR "\n## @$types\n";
69    
70  $short = ($result->header)[0]->[6];  my $short = ($result->header)[0]->[6];
71  print $result->text;  
72  print ( ($#header >= 14) ? "ok 1\n" : "not ok 1\n$#header\n" );  my $result_text = $result->text;
73    print $#header >= 14 ?
74        "ok 5\n" :
75        "#\$\#header[$#header]result_text[$result_text]\nnot ok 5\n";
76    
77  print "Testing local retrieve\n";  print "# Testing local retrieve\n";
78  $result = WAIT::Wais::Retrieve(  $result = WAIT::Wais::Retrieve(
79                                'database' => $db,                                'database' => $db,
80                                'docid'    => $id,                                'docid'    => $id,
81                                'query'    => 'pfeifer',                                'query'    => 'pfeifer',
82                                'type'     => 'HTML',                                'type'     => 'HTML',
83                               );                               );
84  print $result->text, "\n";  $result_text = $result->text;
85  print ( ($result->text =~ m!Pfeifer/etal:94!) ? "ok 2\n" : "not ok 2\n" );  $result_text =~ s/^/# /gm;
86    print $result_text =~ m!Pfeifer/Fuhr:93! ?
87        "ok 6\n" :
88        "# result_text[$result_text]\nnot ok 6\n";
89    
90    my @x = $short->split;
91    print $x[2] =~ /test.ste 3585 393$/ || $x[2] == 1 ?
92        "ok 7\n" :
93        "# \@x:[@x]\nnot ok 7\n";
94    
95    
96    #######################################################################
97    
98  sub headlines {  sub headlines {
99      my $result = shift;      my $result = shift;
# Line 61  sub headlines { Line 101  sub headlines {
101    
102      for ($result->header) {      for ($result->header) {
103          ($tag, $score, $lines, $length, $headline, $types, $id) = @{$_};          ($tag, $score, $lines, $length, $headline, $types, $id) = @{$_};
104          printf "%5d %5d %s %s\n",          printf "# %5d %5d %s %s\n",
105          $score*1000, $lines, $headline, join(',', @{$types});          $score*1000, $lines, $headline, join(',', @{$types});
106      }      }
107  }  }
108    
109  @x = $short->split;  # releasing 1 pending lock... at .../LockFile/Simple.pm
110  print ( ($x[2] =~ /test.ste 3585 393$/ or $x[2] == 10) ? "ok 3\n" : "not ok 3\n" );  open STDERR, '>/dev/null';
111    
112  sub cleanup  sub cleanup
113  {  {
Legend:
Removed from v.11  
changed lines
  Added in v.25
  ViewVC Help
Powered by ViewVC 1.1.26