trunk/bin/pgest-index.pl

#!/usr/bin/perl -w

use strict;
use Search::Estraier 0.07;
use DBI;
use Data::Dumper;
use Encode qw/from_to/;
use Time::HiRes qw/time/;
use Getopt::Long;

=head1 NAME

pgest-index.pl - create full-text index of some columns in your database

=cut

my $c = {
        debug => 0,
};

=head1 SYNOPSIS

  pgest-index.pl --create movies --sql "select id,title,year from movies"

  pgsql-index.pl --drop movies

Options:

=over 4

=item --create name

Create index C<name> and create triggers on table with same name

=item --drop name

Remove triggers from table C<name> and node with same name

=item --node-url http://localhost:1978/node/name

Full URI to node. If it's not specified, it's assumed that you are using
Hyper Estraier on C<http://localhost:1978/>.

=item --sql "select col1,col2 from name"

SQL query which will return names of columns which are included in full-text
index. Have in mind that you can't use aliases (as I<something>) in this SQL
query (or triggers will be created with wrong fields).

If SQL query isn't specified, default one C<< select * from movies >> will
be created. That will be B<serious performance hit> if all columns are
not needed for search.

=item --pk id

Specify name of primary key column in SQL query. If you allready have primary
key on table, and it consists of simgle column (compaund keys are not supported)
it will be picked up automatically.

If you specify value which is not unique, you will get just last occurence
of that item in index (which might be what you want). That's because specified
C<pk> column will be used for C<@uri> in Hyper Estraier.

=item --user login

=item --passwd password

Username and password to use when connecting to Hyper Estraier. If not specified,
C<admin> and C<admin> will be used.

=item --debug

Dump debugging output. It may be specified multiple times for more verbose
debugging.

=back

=cut

my $usage = "$0 database_name (--create|--drop) name [--sql='select id,foo,bar from table'] [--pk=id]\n";

GetOptions($c, qw/create=s drop=s node_url=s sql=s pk=s user=s passwd=s debug+/);

my $dbname = shift @ARGV || die $usage;

$c->{dbi} = 'Pg:dbname=' . $dbname;

warn "# c: ", Dumper($c) if ($c->{debug});

my $table = $c->{create} || $c->{drop} || die $usage;

$c->{node_url} = 'http://localhost:1978/node/' . $table;

$c->{user} ||= 'admin';
$c->{passwd} ||= 'admin';

# create and configure node
my $node = new Search::Estraier::Node(
        url => $c->{node_url},
        user => $c->{user},
        passwd => $c->{passwd},
        croak_on_error => 1,
        create => 1,
        debug => $c->{debug} >= 4 ? 1 : 0,
);

# create DBI connection
my $dbh = DBI->connect("DBI:$c->{dbi}","","") || die $DBI::errstr;

# drop existing triggers
sub drop_triggers {
        my $table = shift || die "no table?";

        warn "removing triggers from $table\n";

        foreach my $t (qw/UPDATE INSERT DELETE/) {
                my $lc_t = lc($t);
                $dbh->do(qq{ DROP TRIGGER pgest_trigger_${lc_t} ON ${table} });
        }
}

if ($c->{drop}) {
        drop_triggers( $table );
        warn "removing node $table\n";
        $node->master(
                action => 'nodedel',
                name => $table,
        );
        exit;
}

# clear existing node
$node->master(
        action => 'nodeclr',
        name => $table,
);

# create PostgreSQL functions
$dbh->do(qq{

CREATE OR REPLACE FUNCTION pgest(text, text, text, int, text, text, text, int, int, text[])
        RETURNS setof record
        AS 'pgest','pgest_node'
        LANGUAGE 'C' IMMUTABLE CALLED ON NULL INPUT;

CREATE OR REPLACE FUNCTION pgest_trigger() RETURNS TRIGGER
        AS 'pgest', 'pgest_trigger'
        LANGUAGE 'C' STRICT;

}) || die $dbh->errstr();


drop_triggers( $table );

if (! $c->{pk}) {

        warn "# finding primary key for $table\n" if ($c->{debug});

        $c->{pk} = $dbh->selectrow_array(qq{
                SELECT
                        a.attname, t.typname
                FROM pg_type t, pg_attribute a
                WHERE t.oid = a.atttypid AND attrelid = (
                        SELECT indexrelid
                        FROM pg_class c, pg_index i
                        WHERE c.relname = '$table'
                                AND c.oid = i.indrelid
                                AND indisprimary
                                AND indnatts = 1
                )
        });

}

die "$0: can't find single column primary key for table ${table}. Please specify column with --pk\n" unless ($c->{pk});

warn "using primary key $c->{pk}\n";

$dbh->begin_work;

$c->{sql} ||= "select * from $table";

my $sth = $dbh->prepare($c->{sql}) || die $dbh->errstr();
$sth->execute() || die $sth->errstr();

my @cols = @{ $sth->{NAME} };

die "SQL '$c->{sql}' didn't include primary key $c->{pk}\n" unless grep(/^\Q$c->{pk}\E$/, @cols);

warn "# columns: ",join(",", @cols),"\n" if ($c->{debug});

my $total = $sth->rows;
my $i = 1;

my $t = time();
my $pk = $c->{pk} || 'id';

warn "indexing existing ",$sth->rows," rows\n";

while (my $row = $sth->fetchrow_hashref() ) {

        warn "# row: ",Dumper($row) if ($c->{debug} >= 3);

        # create document
        my $doc = new Search::Estraier::Document;

        if (my $id = $row->{$pk}) {
                $doc->add_attr('@uri', $id);
        } else {
                die "can't find pk column '$pk' in results\n";
        }

        my $log = sprintf "%4d ",$i;

        while (my ($col,$val) = each %{$row}) {

                if ($val) {
                        # add attributes (make column usable from attribute search)
                        $doc->add_attr($col, $val);

                        # add body text to document (make it searchable using full-text index)
                        $doc->add_text($val);

                        $log .= "R";
                } else {
                        $log .= ".";
                }

        }

        warn "# doc draft: ",$doc->dump_draft, "\n" if ($c->{debug} >= 2);

        die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });

        $log .= sprintf(" %d%% %.1f/s\r", int(( $i++ / $total) * 100), ( $i / (time() - $t) ) );

        print STDERR $log;

}

my $cols = "'" . join("', '", @cols) . "'";

foreach my $t (qw/UPDATE INSERT DELETE/) {

        my $lc_t = lc($t);

        my $sql = qq{

                CREATE TRIGGER pgest_trigger_${lc_t} AFTER ${t}
                        ON ${table} FOR EACH ROW
                        EXECUTE PROCEDURE pgest_trigger('$c->{node_url}','$c->{user}','$c->{passwd}',
                                '$c->{pk}', $cols
                        )

        };

        #warn "$sql\n";

        $dbh->do( $sql ) || die $dbh->errstr();

}

$dbh->commit;

=head1 SEARCHING

At end of each run, this script will output example search SQL query on STDOUT.

You can use it to quickly construct queries for your application.

=cut

my $col_names = join(', ', @cols);
my $col_def = join(', ', map { "$_ text" } @cols);

print "
-- example SQL search query:

SELECT $col_names
FROM pgest(
        -- node, login, passwd, depth
        '$c->{node_url}', '$c->{user}', '$c->{passwd}', 0,
        -- full text search
        'foo bar',
        -- attribute filter, order, limit, offset
        null, null, null, null,
        -- return columns
        array[$cols]
) as ($col_def);

";

__END__

=head1 AUTHOR

Dobrica Pavlinusic <dpavlin@rot13.org>

L<http://www.rot13.org/~dpavlin/>

=head1 LICENSE

This product is licensed under GNU Public License (GPL) v2 or later.

=cut

1	dpavlin	62	#!/usr/bin/perl -w
2
3			use strict;
4	dpavlin	63	use Search::Estraier 0.07;
5	dpavlin	62	use DBI;
6			use Data::Dumper;
7			use Encode qw/from_to/;
8			use Time::HiRes qw/time/;
9			use Getopt::Long;
10
11			=head1 NAME
12
13			pgest-index.pl - create full-text index of some columns in your database
14
15			=cut
16
17			my $c = {
18	dpavlin	74	debug => 0,
19	dpavlin	62	};
20
21	dpavlin	67	=head1 SYNOPSIS
22	dpavlin	62
23	dpavlin	67	pgest-index.pl --create movies --sql "select id,title,year from movies"
24
25			pgsql-index.pl --drop movies
26
27			Options:
28
29			=over 4
30
31			=item --create name
32
33			Create index C<name> and create triggers on table with same name
34
35			=item --drop name
36
37			Remove triggers from table C<name> and node with same name
38
39			=item --node-url http://localhost:1978/node/name
40
41			Full URI to node. If it's not specified, it's assumed that you are using
42			Hyper Estraier on C<http://localhost:1978/>.
43
44			=item --sql "select col1,col2 from name"
45
46			SQL query which will return names of columns which are included in full-text
47			index. Have in mind that you can't use aliases (as I<something>) in this SQL
48			query (or triggers will be created with wrong fields).
49
50	dpavlin	70	If SQL query isn't specified, default one C<< select * from movies >> will
51			be created. That will be B<serious performance hit> if all columns are
52			not needed for search.
53
54	dpavlin	67	=item --pk id
55
56	dpavlin	70	Specify name of primary key column in SQL query. If you allready have primary
57			key on table, and it consists of simgle column (compaund keys are not supported)
58			it will be picked up automatically.
59	dpavlin	67
60	dpavlin	70	If you specify value which is not unique, you will get just last occurence
61			of that item in index (which might be what you want). That's because specified
62			C<pk> column will be used for C<@uri> in Hyper Estraier.
63
64	dpavlin	67	=item --user login
65
66			=item --passwd password
67
68			Username and password to use when connecting to Hyper Estraier. If not specified,
69			C<admin> and C<admin> will be used.
70
71			=item --debug
72
73	dpavlin	70	Dump debugging output. It may be specified multiple times for more verbose
74			debugging.
75	dpavlin	67
76			=back
77
78			=cut
79
80	dpavlin	68	my $usage = "$0 database_name (--create\|--drop) name [--sql='select id,foo,bar from table'] [--pk=id]\n";
81
82	dpavlin	67	GetOptions($c, qw/create=s drop=s node_url=s sql=s pk=s user=s passwd=s debug+/);
83
84	dpavlin	68	my $dbname = shift @ARGV \|\| die $usage;
85
86			$c->{dbi} = 'Pg:dbname=' . $dbname;
87
88	dpavlin	62	warn "# c: ", Dumper($c) if ($c->{debug});
89
90	dpavlin	68	my $table = $c->{create} \|\| $c->{drop} \|\| die $usage;
91	dpavlin	63
92	dpavlin	67	$c->{node_url} = 'http://localhost:1978/node/' . $table;
93
94			$c->{user} \|\|= 'admin';
95			$c->{passwd} \|\|= 'admin';
96
97	dpavlin	62	# create and configure node
98			my $node = new Search::Estraier::Node(
99			url => $c->{node_url},
100			user => $c->{user},
101			passwd => $c->{passwd},
102			croak_on_error => 1,
103			create => 1,
104			debug => $c->{debug} >= 4 ? 1 : 0,
105			);
106
107	dpavlin	67	# create DBI connection
108			my $dbh = DBI->connect("DBI:$c->{dbi}","","") \|\| die $DBI::errstr;
109
110			# drop existing triggers
111			sub drop_triggers {
112			my $table = shift \|\| die "no table?";
113
114			warn "removing triggers from $table\n";
115
116			foreach my $t (qw/UPDATE INSERT DELETE/) {
117			my $lc_t = lc($t);
118			$dbh->do(qq{ DROP TRIGGER pgest_trigger_${lc_t} ON ${table} });
119			}
120			}
121
122			if ($c->{drop}) {
123			drop_triggers( $table );
124			warn "removing node $table\n";
125			$node->master(
126			action => 'nodedel',
127			name => $table,
128			);
129			exit;
130			}
131
132			# clear existing node
133	dpavlin	63	$node->master(
134			action => 'nodeclr',
135			name => $table,
136			);
137
138			# create PostgreSQL functions
139			$dbh->do(qq{
140
141			CREATE OR REPLACE FUNCTION pgest(text, text, text, int, text, text, text, int, int, text[])
142			RETURNS setof record
143			AS 'pgest','pgest_node'
144			LANGUAGE 'C' IMMUTABLE CALLED ON NULL INPUT;
145
146			CREATE OR REPLACE FUNCTION pgest_trigger() RETURNS TRIGGER
147			AS 'pgest', 'pgest_trigger'
148			LANGUAGE 'C' STRICT;
149
150			}) \|\| die $dbh->errstr();
151
152
153	dpavlin	67	drop_triggers( $table );
154	dpavlin	63
155	dpavlin	68	if (! $c->{pk}) {
156
157			warn "# finding primary key for $table\n" if ($c->{debug});
158
159			$c->{pk} = $dbh->selectrow_array(qq{
160			SELECT
161			a.attname, t.typname
162			FROM pg_type t, pg_attribute a
163			WHERE t.oid = a.atttypid AND attrelid = (
164			SELECT indexrelid
165			FROM pg_class c, pg_index i
166			WHERE c.relname = '$table'
167			AND c.oid = i.indrelid
168			AND indisprimary
169			AND indnatts = 1
170			)
171			});
172
173			}
174
175			die "$0: can't find single column primary key for table ${table}. Please specify column with --pk\n" unless ($c->{pk});
176
177			warn "using primary key $c->{pk}\n";
178
179	dpavlin	63	$dbh->begin_work;
180
181	dpavlin	68	$c->{sql} \|\|= "select * from $table";
182
183	dpavlin	62	my $sth = $dbh->prepare($c->{sql}) \|\| die $dbh->errstr();
184			$sth->execute() \|\| die $sth->errstr();
185
186			my @cols = @{ $sth->{NAME} };
187
188	dpavlin	68	die "SQL '$c->{sql}' didn't include primary key $c->{pk}\n" unless grep(/^\Q$c->{pk}\E$/, @cols);
189
190	dpavlin	62	warn "# columns: ",join(",", @cols),"\n" if ($c->{debug});
191
192			my $total = $sth->rows;
193			my $i = 1;
194
195			my $t = time();
196	dpavlin	67	my $pk = $c->{pk} \|\| 'id';
197	dpavlin	62
198	dpavlin	69	warn "indexing existing ",$sth->rows," rows\n";
199
200	dpavlin	62	while (my $row = $sth->fetchrow_hashref() ) {
201
202			warn "# row: ",Dumper($row) if ($c->{debug} >= 3);
203
204			# create document
205			my $doc = new Search::Estraier::Document;
206
207	dpavlin	67	if (my $id = $row->{$pk}) {
208	dpavlin	62	$doc->add_attr('@uri', $id);
209			} else {
210	dpavlin	67	die "can't find pk column '$pk' in results\n";
211	dpavlin	62	}
212
213	dpavlin	69	my $log = sprintf "%4d ",$i;
214	dpavlin	62
215			while (my ($col,$val) = each %{$row}) {
216
217			if ($val) {
218			# add attributes (make column usable from attribute search)
219			$doc->add_attr($col, $val);
220
221			# add body text to document (make it searchable using full-text index)
222			$doc->add_text($val);
223
224	dpavlin	69	$log .= "R";
225	dpavlin	62	} else {
226	dpavlin	69	$log .= ".";
227	dpavlin	62	}
228
229			}
230
231			warn "# doc draft: ",$doc->dump_draft, "\n" if ($c->{debug} >= 2);
232
233			die "error: ", $node->status,"\n" unless (eval { $node->put_doc($doc) });
234
235	dpavlin	69	$log .= sprintf(" %d%% %.1f/s\r", int(( $i++ / $total) * 100), ( $i / (time() - $t) ) );
236	dpavlin	62
237	dpavlin	69	print STDERR $log;
238
239	dpavlin	62	}
240
241	dpavlin	65	my $cols = "'" . join("', '", @cols) . "'";
242	dpavlin	62
243			foreach my $t (qw/UPDATE INSERT DELETE/) {
244
245			my $lc_t = lc($t);
246
247			my $sql = qq{
248
249			CREATE TRIGGER pgest_trigger_${lc_t} AFTER ${t}
250			ON ${table} FOR EACH ROW
251			EXECUTE PROCEDURE pgest_trigger('$c->{node_url}','$c->{user}','$c->{passwd}',
252	dpavlin	67	'$c->{pk}', $cols
253	dpavlin	62	)
254
255			};
256
257	dpavlin	63	#warn "$sql\n";
258	dpavlin	62
259			$dbh->do( $sql ) \|\| die $dbh->errstr();
260
261			}
262	dpavlin	63
263			$dbh->commit;
264	dpavlin	65
265	dpavlin	70	=head1 SEARCHING
266
267			At end of each run, this script will output example search SQL query on STDOUT.
268
269			You can use it to quickly construct queries for your application.
270
271			=cut
272
273	dpavlin	65	my $col_names = join(', ', @cols);
274			my $col_def = join(', ', map { "$_ text" } @cols);
275
276	dpavlin	66	print "
277	dpavlin	69	-- example SQL search query:
278	dpavlin	65
279			SELECT $col_names
280			FROM pgest(
281			-- node, login, passwd, depth
282			'$c->{node_url}', '$c->{user}', '$c->{passwd}', 0,
283			-- full text search
284			'foo bar',
285	dpavlin	66	-- attribute filter, order, limit, offset
286	dpavlin	65	null, null, null, null,
287			-- return columns
288			array[$cols]
289			) as ($col_def);
290
291			";
292	dpavlin	70
293			__END__
294
295			=head1 AUTHOR
296
297			Dobrica Pavlinusic <dpavlin@rot13.org>
298
299			L<http://www.rot13.org/~dpavlin/>
300
301			=head1 LICENSE
302
303			This product is licensed under GNU Public License (GPL) v2 or later.
304
305			=cut
306