Line # Revision Author
1 8 dpavlin #!/usr/bin/perl -w
2
3 use strict;
4
5 51 dpavlin use Test::More tests => 53;
6 8 dpavlin
7 BEGIN {
8 use_ok('DBI');
9 use_ok('DBD::Pg');
10 };
11
12 # hum?
13 my $connect = "DBI:Pg:dbname=test";
14
15 my $dbh = DBI->connect($connect,"","") || die $DBI::errstr;
16 ok($dbh, "dbh");
17
18 my $pwd = $0;
19 $pwd =~ s#/[^/]*$##;
20 if ($pwd !~ m#^/#) {
21 my $cwd = `pwd`;
22 chomp($cwd);
23 $pwd = $cwd . '/' . $pwd;
24 }
25 ok($pwd, "pwd: $pwd");
26 my $index = "$pwd/../data/casket/";
27 51 dpavlin my $node = 'http://localhost:1978/node/trivia';
28 8 dpavlin
29 51 dpavlin my $sql = "select id from pgest('$node','admin','admin',0,?,?,?,?,?,array['\@id']) as (id text)";
30 diag $sql;
31 8 dpavlin my $sth = $dbh->prepare($sql) || die $dbh->errstr();
32 ok($sth, "sth");
33
34 sub pgest {
35 49 dpavlin $sth->execute(@_) || die "FATAL ERROR: direct " . $sth->errstr();
36 12 dpavlin {
37 no warnings;
38 ok($sth, "execute(".join(",",@_).")");
39 }
40 8 dpavlin
41 my @arr;
42 32 dpavlin while (my ($id) = $sth->fetchrow_array() ) {
43 push @arr, $id;
44 8 dpavlin }
45
46 return @arr;
47 }
48
49 sub estcmd {
50 51 dpavlin my ($q,$attr, $order, $limit, $offset) = @_;
51 8 dpavlin
52 51 dpavlin my $cmd = "estcall search -vu -sf";
53 $cmd .= " -attr '$attr'" if ($attr);
54 $cmd .= " -ord '$order'" if ($order);
55 if ($limit) {
56 $cmd .= " -max $limit";
57 } else {
58 $cmd .= " -max 999999";
59 }
60 $cmd .= " -sk $offset" if ($offset);
61 9 dpavlin $q ||= '';
62 51 dpavlin $cmd .= " $node '$q'";
63 8 dpavlin diag $cmd;
64
65 open(my $fh, "$cmd |") || die "cmd: $!";
66 31 dpavlin my $del = <$fh>;
67 chomp($del);
68 8 dpavlin while(<$fh>) {
69 31 dpavlin last if (/^\Q$del\E/);
70 8 dpavlin }
71 31 dpavlin my @arr;
72 while(<$fh>) {
73 chomp;
74 last if (/^\Q$del\E/);
75 push @arr, $_;
76 }
77
78 return @arr;
79 8 dpavlin }
80
81 9 dpavlin # test simple query
82 foreach my $q (qw(blade runner Philip k. dick)) {
83 8 dpavlin
84 ok(my $hits = estcmd($q), "estcmd: $q");
85
86 diag "$hits hits";
87
88 51 dpavlin cmp_ok(scalar pgest($q, '', undef, 0, 0), '==', $hits, "pgest: $q");
89 8 dpavlin }
90 9 dpavlin
91 # test attr query
92 foreach my $q (('@title STRINC Blade Runner', '@title ISTRBW blade runner')) {
93
94 ok(my $hits = estcmd('',$q), "estcmd: $q");
95
96 diag "$hits hits";
97
98 51 dpavlin cmp_ok($hits, '==', scalar pgest(undef, $q, undef, 0, 0), 'blade runner');
99 9 dpavlin }
100
101 12 dpavlin diag "Error handling test follows, ignore messages...";
102 # test NULL handling
103 31 dpavlin ok(! $dbh->do(qq`select * from pgest(null, '', '', null, 0, 0, array['\@id']) as (id text)`), "null index_path");
104 ok(my $hits = pgest('blade runner', '', undef, 0, 0), "test search");
105 cmp_ok($hits, '==', pgest('blade runner', undef, undef, 0, 0), "null attr");
106 cmp_ok($hits, '==', pgest('blade runner', '', undef, undef, 0), "null limit");
107 cmp_ok($hits, '==', pgest('blade runner', '', undef, 0, undef), "null offset");
108 cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "null optional");
109 12 dpavlin
110 14 dpavlin # test limit, offset and global mess
111 my $d = int($hits / 3);
112 31 dpavlin cmp_ok($d, '==', pgest('blade runner',undef, undef, $d, undef), "limit $d");
113 cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");
114 14 dpavlin
115 31 dpavlin cmp_ok(($hits - $d), '==', pgest('blade runner',undef, undef, undef, $d), "offset $d");
116 cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");
117 14 dpavlin
118 31 dpavlin cmp_ok(($hits - $d), '==', pgest('blade runner',undef, undef, ($hits - $d), $d), "limit ".($hits - $d)." offset $d");
119 cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");
120 32 dpavlin
121 # test sort
122 my @arr_asc = pgest('blade runner', undef, '@id NUMA', undef, undef);
123 my @arr_desc = pgest('blade runner', undef, '@id NUMD', undef, undef);
124
125 cmp_ok(@arr_asc, '==', @arr_desc, "same number of results");
126 my $errors = 0;
127 foreach my $i (0 .. $#arr_asc) {
128 my ($a, $b) = ($arr_asc[$i], $arr_desc[$#arr_desc - $i]);
129 if ($a ne $b) {
130 $errors++;
131 diag "element $i: $a != $b";
132 }
133 }
134
135 cmp_ok($errors, '==', 0, "errors in ordering");