/[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

cvs-head/t/wais.t revision 10 by ulpfr, Fri Apr 28 15:40:52 2000 UTC trunk/t/wais.t revision 116 by dpavlin, Wed Jul 14 09:48:26 2004 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl -w
2  #                              -*- Mode: Perl -*-  
3  # $Basename: wais.t $  use Test::More;
4  # $Revision: 1.5 $  use blib;
 # 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.  
 #  
 #  
5    
6  use WAIT::Database;  use WAIT::Database;
7  use WAIT::Wais;  use WAIT::Wais;
8  use Cwd;  use Cwd;
9    use strict;
10    use File::Path qw(mkpath rmtree);
11    
12    plan tests => 10;
13    
14  $SIG{__DIE__} = $SIG{INT} = \&cleanup;  $SIG{__DIE__} = $SIG{INT} = \&cleanup;
15    
16  my $pwd = getcwd();  my $pwd = getcwd();
17  print  "$^X -Iblib blib/script/bibdb -dir /tmp -database sample\n";  mkpath "/tmp/wait-test-$$";
18  system "$^X -Iblib blib/script/bibdb -dir /tmp -database sample > /dev/null 2>&1";  print  "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample\n";
19    system "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample > /dev/null 2>&1";
20    
21    use Fcntl;
22    
23    ok(
24      my $db = WAIT::Database->open(
25                                    name        => 'sample',
26                                    'directory' => "/tmp/wait-test-$$",
27                                    'mode'      => O_RDWR,
28      ), "open");
29    
30    ok(my $tb = $db->table(name => 'bibdb'), "table");
31      
32    ok($tb->open, "open");
33    
34    ok($tb->set(top => 1), "set(top => 1)");
35    
36    ok($tb->close, "tb->close");
37    ok($db->close, "db->close");
38    
39    $db = "/tmp/wait-test-$$/sample/bibdb";
40    print "# Testing WAIT searches\n";
41    ok(my $result = WAIT::Wais::Search({
42                                     'query'    => 'pfeifer',
43                                     'database' => $db,
44                                    }),
45      "WAIT::Wais::Search");
46    
47    ok(&headlines($result), "headlines");
48    
49    my @header = $result->header;
50    my $N;
51    for (my $n=0;$n<@header;$n++) {
52      $N = $n if ${$header[$n]->[6]} eq "wait;/tmp/wait-test-$$/sample/bibdb;13";
53    }
54    my $id    = ($result->header)[$N]->[6];
55    my $short = ($result->header)[$N]->[6];
56    
57  print "1..3\n";  my $result_text = $result->text;
58  $db = '/tmp/sample/bibdb';  ok($#header >= 14, "\$\#header[$#header]result_text[$result_text]");
 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" );  
59    
60  print "Testing local retrieve\n";  print "# Testing local retrieve\n";
61  $result = WAIT::Wais::Retrieve(  $result = WAIT::Wais::Retrieve(
62                                'database' => $db,                                'database' => $db,
63                                'docid'    => $id,                                'docid'    => $id,
64                                'query'    => 'pfeifer',                                'query'    => 'pfeifer',
65                                'type'     => 'HTML',                                'type'     => 'HTML',
66                               );                               );
67  print $result->text, "\n";  $result_text = $result->text;
68  print ( ($result->text =~ m!Pfeifer/etal:94!) ? "ok 2\n" : "not ok 2\n" );  $result_text =~ s/^/# /gm;
69    ok($result_text =~ m!Pfeifer/Fuhr:93!, "result_text[$result_text]");
70    
71    my @x = $short->split;
72    ok($x[2] =~ /test.ste 3585 393$/ || $x[2] == 13, "\@x:[@x]");
73    
74    
75    #######################################################################
76    
77  sub headlines {  sub headlines {
78      my $result = shift;      my $result = shift;
# Line 61  sub headlines { Line 80  sub headlines {
80    
81      for ($result->header) {      for ($result->header) {
82          ($tag, $score, $lines, $length, $headline, $types, $id) = @{$_};          ($tag, $score, $lines, $length, $headline, $types, $id) = @{$_};
83          printf "%5d %5d %s %s\n",          printf "# %5d %5d %s %s\n",
84          $score*1000, $lines, $headline, join(',', @{$types});          $score*1000, $lines, $headline, join(',', @{$types});
85      }      }
86  }  }
87    
88  @x = $short->split;  # releasing 1 pending lock... at .../LockFile/Simple.pm
89  print ( ($x[2] =~ /test.ste 3585 393$/ or $x[2] == 10) ? "ok 3\n" : "not ok 3\n" );  open STDERR, '>/dev/null';
90    
91  sub cleanup  sub cleanup
92  {  {
93    system 'rm -rf /tmp/sample';    rmtree "/tmp/wait-test-$$";
94  }  }
95    
96    
Legend:
Removed from v.10  
changed lines
  Added in v.116
  ViewVC Help
Powered by ViewVC 1.1.26