trunk/t/pgest.t

#!/usr/bin/perl -w

use strict;

use Test::More tests => 67;

BEGIN {
        use_ok('DBI');
        use_ok('DBD::Pg');
};

# hum?
my $connect = "DBI:Pg:dbname=test";

my $dbh = DBI->connect($connect,"","") || die $DBI::errstr;
ok($dbh, "dbh");

my $pwd = $0;
$pwd =~ s#/[^/]*$##;
if ($pwd !~ m#^/#) {
        my $cwd = `pwd`;
        chomp($cwd);
        $pwd = $cwd . '/' . $pwd;
}
ok($pwd, "pwd: $pwd");
my $index = "$pwd/../data/casket/";

my $sql = "select * from pgest('$index',?,?,?,?,?,?) as (id text)";
diag "$sql";

my $sth = $dbh->prepare($sql) || die $dbh->errstr();
ok($sth, "sth");

sub pgest {
        $sth->execute(@_, "{'\@id'}" ) || die $sth->errstr();
        {
                no warnings;
                ok($sth, "execute(".join(",",@_).")");
        }

        my @arr;
        while (my $row = $sth->fetchrow_hashref() ) {
                push @arr, $row;
        }
        ok(@arr, "pgest results: ".($#arr + 1));

        return @arr;
}

sub estcmd {
        my $q = shift;
        my $attr = shift;

        my $cmd = "estcmd search ";
        $cmd .= " -attr '$attr' " if ($attr);
        $cmd .= " -max 999999 ";                # why do I need this?
        $q ||= '';
        $cmd .= "$index '$q'";
        diag $cmd;

        open(my $fh, "$cmd |") || die "cmd: $!";
        my $del = <$fh>;
        chomp($del);
        while(<$fh>) {
                last if (/^\Q$del\E/);
        }
        my @arr;
        while(<$fh>) {
                chomp;
                last if (/^\Q$del\E/);
                push @arr, $_;
        }

        return @arr;
}

# test simple query
foreach my $q (qw(blade runner Philip k. dick)) {

        ok(my $hits = estcmd($q), "estcmd: $q");

        diag "$hits hits";

        cmp_ok(scalar pgest($q, '', undef, 0, 0), '==', $hits, 'blade runner');
}

# test attr query
foreach my $q (('@title STRINC Blade Runner', '@title ISTRBW blade runner')) {

        ok(my $hits = estcmd('',$q), "estcmd: $q");

        diag "$hits hits";

        cmp_ok(scalar pgest(undef, $q, undef, 0, 0), '==', $hits, 'blade runner');
}

diag "Error handling test follows, ignore messages...";
# test NULL handling
ok(! $dbh->do(qq`select * from pgest(null, '', '', null, 0, 0, array['\@id']) as (id text)`), "null index_path");
ok(my $hits = pgest('blade runner', '', undef, 0, 0), "test search");
cmp_ok($hits, '==', pgest('blade runner', undef, undef, 0, 0), "null attr");
cmp_ok($hits, '==', pgest('blade runner', '', undef, undef, 0), "null limit");
cmp_ok($hits, '==', pgest('blade runner', '', undef, 0, undef), "null offset");
cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "null optional");

# test limit, offset and global mess
my $d = int($hits / 3);
cmp_ok($d, '==', pgest('blade runner',undef, undef, $d, undef), "limit $d");
cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");

cmp_ok(($hits - $d), '==', pgest('blade runner',undef, undef, undef, $d), "offset $d");
cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");

cmp_ok(($hits - $d), '==', pgest('blade runner',undef, undef, ($hits - $d), $d), "limit ".($hits - $d)." offset $d");
cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");
1	dpavlin	8	#!/usr/bin/perl -w
2
3			use strict;
4
5	dpavlin	14	use Test::More tests => 67;
6	dpavlin	8
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
28	dpavlin	31	my $sql = "select * from pgest('$index',?,?,?,?,?,?) as (id text)";
29	dpavlin	8	diag "$sql";
30
31			my $sth = $dbh->prepare($sql) \|\| die $dbh->errstr();
32			ok($sth, "sth");
33
34			sub pgest {
35	dpavlin	22	$sth->execute(@_, "{'\@id'}" ) \|\| die $sth->errstr();
36	dpavlin	12	{
37			no warnings;
38			ok($sth, "execute(".join(",",@_).")");
39			}
40	dpavlin	8
41			my @arr;
42			while (my $row = $sth->fetchrow_hashref() ) {
43			push @arr, $row;
44			}
45	dpavlin	31	ok(@arr, "pgest results: ".($#arr + 1));
46	dpavlin	8
47			return @arr;
48			}
49
50			sub estcmd {
51			my $q = shift;
52	dpavlin	9	my $attr = shift;
53	dpavlin	8
54	dpavlin	9	my $cmd = "estcmd search ";
55			$cmd .= " -attr '$attr' " if ($attr);
56	dpavlin	31	$cmd .= " -max 999999 "; # why do I need this?
57	dpavlin	9	$q \|\|= '';
58			$cmd .= "$index '$q'";
59	dpavlin	8	diag $cmd;
60
61			open(my $fh, "$cmd \|") \|\| die "cmd: $!";
62	dpavlin	31	my $del = <$fh>;
63			chomp($del);
64	dpavlin	8	while(<$fh>) {
65	dpavlin	31	last if (/^\Q$del\E/);
66	dpavlin	8	}
67	dpavlin	31	my @arr;
68			while(<$fh>) {
69			chomp;
70			last if (/^\Q$del\E/);
71			push @arr, $_;
72			}
73
74			return @arr;
75	dpavlin	8	}
76
77	dpavlin	9	# test simple query
78			foreach my $q (qw(blade runner Philip k. dick)) {
79	dpavlin	8
80			ok(my $hits = estcmd($q), "estcmd: $q");
81
82			diag "$hits hits";
83
84	dpavlin	31	cmp_ok(scalar pgest($q, '', undef, 0, 0), '==', $hits, 'blade runner');
85	dpavlin	8	}
86	dpavlin	9
87			# test attr query
88			foreach my $q (('@title STRINC Blade Runner', '@title ISTRBW blade runner')) {
89
90			ok(my $hits = estcmd('',$q), "estcmd: $q");
91
92			diag "$hits hits";
93
94	dpavlin	31	cmp_ok(scalar pgest(undef, $q, undef, 0, 0), '==', $hits, 'blade runner');
95	dpavlin	9	}
96
97	dpavlin	12	diag "Error handling test follows, ignore messages...";
98			# test NULL handling
99	dpavlin	31	ok(! $dbh->do(qq`select * from pgest(null, '', '', null, 0, 0, array['\@id']) as (id text)`), "null index_path");
100			ok(my $hits = pgest('blade runner', '', undef, 0, 0), "test search");
101			cmp_ok($hits, '==', pgest('blade runner', undef, undef, 0, 0), "null attr");
102			cmp_ok($hits, '==', pgest('blade runner', '', undef, undef, 0), "null limit");
103			cmp_ok($hits, '==', pgest('blade runner', '', undef, 0, undef), "null offset");
104			cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "null optional");
105	dpavlin	12
106	dpavlin	14	# test limit, offset and global mess
107			my $d = int($hits / 3);
108	dpavlin	31	cmp_ok($d, '==', pgest('blade runner',undef, undef, $d, undef), "limit $d");
109			cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");
110	dpavlin	14
111	dpavlin	31	cmp_ok(($hits - $d), '==', pgest('blade runner',undef, undef, undef, $d), "offset $d");
112			cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");
113	dpavlin	14
114	dpavlin	31	cmp_ok(($hits - $d), '==', pgest('blade runner',undef, undef, ($hits - $d), $d), "limit ".($hits - $d)." offset $d");
115			cmp_ok($hits, '==', pgest('blade runner', undef, undef, undef, undef), "check");