1#!/usr/local/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). 6# 7# Copyright (c) 2002,2006 Olly Betts 8# 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. 13# 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. 18# 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 23 24use strict; 25use DBI; 26 27$#ARGV >= 1 or die "Syntax: $0 DATABASE TABLE [FIELD...]\n"; 28 29my $database = shift @ARGV; 30my $table = shift @ARGV; 31my $fields = join ",", @ARGV; 32my $username = $ENV{'DBUSER'} || $ENV{USER} || $ENV{LOGNAME} || ''; 33my $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. 36my $driver = $ENV{'DBIDRIVER'} || 'mysql'; 37 38length $fields or $fields = "*"; 39 40my $dbh = DBI->connect("DBI:$driver:$database", $username, $password) 41 or die "Couldn't connect to database: " . DBI->errstr; 42 43my $sth = $dbh->prepare("SELECT $fields FROM $table") 44 or die "Couldn't prepare statement: " . $dbh->errstr; 45 46$sth->execute() 47 or die "Couldn't execute statement: " . $sth->errstr; 48 49my $data; 50while (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"; 56 } 57 } 58 print "\n"; 59} 60$sth->err and die "Couldn't fetch row: " . $sth->errstr; 61 62$dbh->disconnect; 63