/[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 13 by ulpfr, Fri Apr 28 15:42:44 2000 UTC trunk/t/wais.t revision 88 by dpavlin, Mon May 24 13:44:01 2004 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.6 $  # $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 Jan 19 21:46:24 2002
9  # Language        : Perl  # Language        : Perl
10  # Update Count    : 157  # Update Count    : 192
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.
# Line 18  use WAIT::Database; Line 18  use WAIT::Database;
18  use WAIT::Wais;  use WAIT::Wais;
19  use Cwd;  use Cwd;
20  use strict;  use strict;
21    use File::Path qw(mkpath rmtree);
22    
23  $SIG{__DIE__} = $SIG{INT} = \&cleanup;  $SIG{__DIE__} = $SIG{INT} = \&cleanup;
24    
25  my $pwd = getcwd();  my $pwd = getcwd();
26  print  "$^X -Iblib blib/script/bibdb -dir /tmp -database sample\n";  mkpath "/tmp/wait-test-$$";
27  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";
28    system "$^X -Mblib blib/script/bibdb -dir /tmp/wait-test-$$ -database sample > /dev/null 2>&1";
29    print "1..7\n";
30    
31    use Fcntl;
32    if (1) {
33      my $db = WAIT::Database->open(
34                                    name        => 'sample',
35                                    'directory' => "/tmp/wait-test-$$",
36                                    'mode'      => O_RDWR,
37                                   );
38      print "not " unless $db;
39      print "ok 1\n";
40      my $tb = $db->table(name => 'bibdb');
41      print "not " unless $tb;
42      print "ok 2\n";
43      
44      print "not " unless $tb->open;
45      print "ok 3\n";
46    
47  print "1..3\n";    print "not " unless $tb->set(top => 1);
48  my $db = '/tmp/sample/bibdb';    print "ok 4\n";
49    
50      $tb->close;
51      $db->close;
52    }
53    
54    
55    my $db = "/tmp/wait-test-$$/sample/bibdb";
56  print "# Testing WAIT searches\n";  print "# Testing WAIT searches\n";
57  my $result = WAIT::Wais::Search({  my $result = WAIT::Wais::Search({
58                                   'query'    => 'pfeifer',                                   'query'    => 'pfeifer',
# Line 34  my $result = WAIT::Wais::Search({ Line 60  my $result = WAIT::Wais::Search({
60                                  });                                  });
61    
62  &headlines($result);  &headlines($result);
 my $id     = ($result->header)[9]->[6];  
 #$length = ($result->header)[9]->[3];  
 my @header = $result->header;  
63    
64  #my $types=($result->header)[9]->[5];  my @header = $result->header;
65  #print STDERR "\n## @$types\n";  my $N;
66    for (my $n=0;$n<@header;$n++) {
67  my $short = ($result->header)[0]->[6];    $N = $n if ${$header[$n]->[6]} eq "wait;/tmp/wait-test-$$/sample/bibdb;13";
68    }
69    my $id    = ($result->header)[$N]->[6];
70    my $short = ($result->header)[$N]->[6];
71    
72  my $result_text = $result->text;  my $result_text = $result->text;
73  print $#header >= 14 ?  print $#header >= 14 ?
74      "ok 1\n" :      "ok 5\n" :
75      "#\$\#header[$#header]result_text[$result_text]\nnot ok 1\n";      "#\$\#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(
# Line 58  $result = WAIT::Wais::Retrieve( Line 84  $result = WAIT::Wais::Retrieve(
84  $result_text = $result->text;  $result_text = $result->text;
85  $result_text =~ s/^/# /gm;  $result_text =~ s/^/# /gm;
86  print $result_text =~ m!Pfeifer/Fuhr:93! ?  print $result_text =~ m!Pfeifer/Fuhr:93! ?
87      "ok 2\n" :      "ok 6\n" :
88      "# result_text[$result_text]\nnot ok 2\n";      "# result_text[$result_text]\nnot ok 6\n";
89    
90  my @x = $short->split;  my @x = $short->split;
91  print $x[2] =~ /test.ste 3585 393$/ || $x[2] == 1 ?  print $x[2] =~ /test.ste 3585 393$/ || $x[2] == 13 ?
92      "ok 3\n" :      "ok 7\n" :
93      "# \@x:[@x]\nnot ok 3\n";      "# \@x:[@x]\nnot ok 7\n";
94    
95    
96  #######################################################################  #######################################################################
# Line 80  sub headlines { Line 106  sub headlines {
106      }      }
107  }  }
108    
109    # releasing 1 pending lock... at .../LockFile/Simple.pm
110    open STDERR, '>/dev/null';
111    
112  sub cleanup  sub cleanup
113  {  {
114    system 'rm -rf /tmp/sample';    rmtree "/tmp/wait-test-$$";
115  }  }
116    
117    
Legend:
Removed from v.13  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.26