[ci] Test Tcl bindings for dragonfly/freebsd
[xapian.git] / xapian-applications / omega / dbi2omega
blob3b68670cbbdee108c695a5217e2d20e621f01304
1 #!/usr/bin/perl -w
2 # dbi2omega - dump an SQL database into a form suitable for indexing
3 # into a Xapian database using scriptindex. This script requires the perl DBI
4 # interface to be installed (on Debian systems, this is provided by the
5 # libdbi-perl package).
7 # Copyright (c) 2002,2006 Olly Betts
9 # This program is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU General Public License as
11 # published by the Free Software Foundation; either version 2 of the
12 # License, or (at your option) any later version.
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
22 # USA
24 use strict;
25 use DBI;
27 $#ARGV >= 1 or die "Syntax: $0 DATABASE TABLE [FIELD...]\n";
29 my $database = shift @ARGV;
30 my $table = shift @ARGV;
31 my $fields = join ",", @ARGV;
32 my $username = $ENV{'DBUSER'} || $ENV{USER} || $ENV{LOGNAME} || '';
33 my $password = $ENV{'DBPASSWORD'} || '';
34 # DBI defaults to DBIDRIVER if you specify a datasource of "DBI::$database", so
35 # it's an appropriate environment variable to check.
36 my $driver = $ENV{'DBIDRIVER'} || 'mysql';
38 length $fields or $fields = "*";
40 my $dbh = DBI->connect("DBI:$driver:$database", $username, $password)
41 or die "Couldn't connect to database: " . DBI->errstr;
43 my $sth = $dbh->prepare("SELECT $fields FROM $table")
44 or die "Couldn't prepare statement: " . $dbh->errstr;
46 $sth->execute()
47 or die "Couldn't execute statement: " . $sth->errstr;
49 my $data;
50 while (defined($data = $sth->fetchrow_arrayref())) {
51 for my $i (0 .. $sth->{NUM_OF_FIELDS} - 1) {
52 my $v = $$data[$i];
53 if (defined($v)) {
54 $v =~ s/\n/\n=/g;
55 print "${$sth->{NAME_lc}}[$i]=$v\n";
58 print "\n";
60 $sth->err and die "Couldn't fetch row: " . $sth->errstr;
62 $dbh->disconnect;