libdbix-easy-perl 0.17-1 / usr / bin / dbs_update

#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

# Copyright (C) 1999,2000,2001,2002,2004 Stefan Hornburg

# Author: Stefan Hornburg (Racke) <racke@linuxia.de>
# Maintainer: Stefan Hornburg (Racke) <racke@linuxia.de>
# Version: 0.16

# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version.

# This file is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this file; see the file COPYING.  If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

use strict;
use DBIx::Easy;
use Getopt::Long;
use Term::ReadKey;

# process commandline parameters
my %opts;
$opts{'keys'} = 1;
my $whandler = $SIG{__WARN__};
$SIG{__WARN__} = sub {print STDERR "$0: @_";};
unless (GetOptions (\%opts, 'cleanse', 'columns|c=s',
                    'file|f=s', 'format=s', 'headline|h',
					'rows=s', 'keys|k=s',
					'map|m=s', 'map-filter=s', 'match-sql=s', 'routine|r=s',
					'skipbadlines',
					'table|t=s', 'update-only|o')) {
    exit 1;
}
$SIG{__WARN__} = $whandler;

# sanity checks
my $format = 'TAB';
my %inforef = ();
my %funcref = (CSV => {get_columns => \&get_columns_csv},
			   TAB => {get_columns => \&get_columns_tab},
			   XLS => {get_columns => \&get_columns_xls});
my %mfref = (lc => sub {lc(shift)});
my $sep_char = ',';
my $mfsub;

if ($opts{'cleanse'} || $opts{'headline'}) {
    unless ($opts{'table'}) {
        die ("$0: missing table name\n");
    }
}
if ($opts{'map-filter'}) {
	unless (exists($mfref{$opts{'map-filter'}})) {
		die qq{$0: unknown column name filter "$opts{'map-filter'}"}, "\n";
	}
	$mfsub = $mfref{$opts{'map-filter'}};
}

if ($opts{'format'}) {
	$format = uc($opts{'format'});

	if ($format =~ /^CSV/) {
	  	$format = 'CSV';
		if ($') {
			$sep_char = $';
			$sep_char =~ s/^\s+//;
			$sep_char =~ s/\s+$//;
		}
		eval {
			require Text::CSV_XS;
		};
		if ($@) {
			die "$0: couldn't load module Text::CSV_XS\n";
		}
		$inforef{object} = new Text::CSV_XS ({'binary' => 1, 'sep_char' => $sep_char});
	} elsif ($format eq 'XLS') {
		eval {
			require Spreadsheet::ParseExcel;
		};
		if ($@) {
			die "$0: couldn't load module Spreadsheet::ParseExcel\n";
		}
		$inforef{object} = new Spreadsheet::ParseExcel;
	} else {
		die ("$0: unknown format \"" . $opts{'format'} . "\"\n");
	}
}

my %fieldmap;
my $fd_input;

my ($sth, $keyfield, $update, $msg);
my ($table, $fieldnames, @values, $headline);
my (@columns, $routine, %colmap);
my $linebuf = '';

# whether to consider column
my $colflag = 1;
my %usecol;
# whether to consider rows
my $rowflag;
my %userow;
# current row
my $currow = 0;
# input with table as first field may specify start column
my $startcol;
# variables for --match-sql option
my (%matchmap, $matchcol);

if ($opts{'columns'}) {
    $colflag = ! ($opts{'columns'} =~ s/\s*[\!^]//);

    # setup positive/negative list for columns
    for (@columns = split(/\s*,\s*/, $opts{'columns'})) {
        $usecol{$_} = $colflag;
    }
}

if ($opts{'rows'}) {
    my @rows;
    
    $rowflag = ! ($opts{'rows'} =~ s/\s*[^\!]//);

    # setup positive/negative list for rows
    for (@rows = split(/\s*,\s*/, $opts{'rows'})) {
        unless (/^\d+$/) {
            die "$0: row number \"$_\" is not numeric\n";
        }
        $userow{$_} = $rowflag;
    }
}

if ($opts{'file'}) {
    # read input from file
	require IO::File;
	$fd_input = new IO::File;
    $fd_input->open($opts{'file'})
        || die "$0: couldn't open $opts{'file'}: $!\n";
} else {
	# read input from standard input
	require IO::Handle;
	$fd_input = new IO::Handle;
	$fd_input->fdopen(fileno(STDIN),'r');
}

if ($opts{'map'}) {
    # parse column name mapping
    my ($head, $name);
    foreach (split (/;/, $opts{'map'})) {
        ($head, $name) = split /=/;
        $colmap{$head} = $name;
    }
}

my $csv;

if ($opts{'headline'}) {
    my %hcolmap;
    
    # the first row consists of the column names
#    unless (defined ($headline = <$fd_input>)) {
#        die ("$0: empty input file\n");
#    }
	my @columns;
	if ($funcref{$format}->{get_columns}(\%inforef, $fd_input,\@columns) <= 0)  {
		die "$0: couldn't find headline\n";
	}
	
	if ($format eq 'CSV') {
		while (! csv_parseline ($csv, \$linebuf, $headline, \@columns)) {
			unless (defined ($headline = <$fd_input>)) {
				die ("$0: couldn't find headline\n");
			}
		}
	}

	if ($opts{'map-filter'}) {
		@columns = map {$mfsub->($_)} @columns;
	}

	# remove whitespace from column names and mark them
	map {s/^\s+//; s/\s+$//; $hcolmap{$_} = 1;} @columns;

    if ($opts{'map'}) {
        my @newcolumns;
        
        # filter column names
        foreach (@columns) {
            if (exists $colmap{$_}) {
                push (@newcolumns, $colmap{$_});
				$hcolmap{$colmap{$_}} = 1;
            } else {
                push (@newcolumns, $_);
            }
        }
        @columns = @newcolumns;
    }

    # add any other columns explicitly selected
    for (sort (keys %usecol)) {
        next if $hcolmap{$_};
        next unless exists $usecol{$_};
        next unless $usecol{$_};
        push (@columns, $_);
    }
    
    # fixed table name 
    $table = $opts{'table'};
    $fieldmap{$table} = \@columns;
}

if ($opts{'routine'}) {
    # read Perl subroutine for filtering the input
    $routine = eval $opts{'routine'};

    if ($@) {
        die "$0: invalid filter routine: $@: \n";
    }

    if (ref($routine) ne 'CODE') {
        die "$0: invalid filter routine\n";
    }
}

if ($opts{'table'}) {
    # set fixed table name
    $table = $opts{'table'};
	# use defined columns
	if (! $opts{'headline'} && $opts{'columns'}) {
		$fieldmap{$table} = \@columns;
	}
}

my $dbif;
my $pwdused = 0;

my ($driver, $database, $user) = @ARGV;

$dbif = new DBIx::Easy ($driver, $database, $user);

# handler for DBI error messages and missing password
$dbif -> install_handler (\&fatal);

# we need to explicitly establish the connection
# for the case that a password is needed
$dbif -> connect;

my (@keys, @cleansekeys, %cleansemap, $numkeysleft, %recmap, @names);

if ($opts{'cleanse'}) {
    # determine column names
    @names = &column_names ($dbif, $table);
    $fieldnames = \@names;

    # determine keys
    %cleansemap = &key_names ($dbif, $table, $opts{'keys'}, 1);
    @cleansekeys = sort (keys %cleansemap);
	
	# get records
    my ($row, $href, $i);

    $sth = $dbif -> process ('SELECT ' . join(', ', @cleansekeys)
							 . " FROM $table");

    while ($row = $sth -> fetch()) {
        # build chain of all keys but the last
        $href = \%recmap;
        for ($i = 0; $i < $#cleansekeys; $i++) {
            unless (exists $href->{$$row[$i]}) {
                $href->{$$row[$i]} = {};
            }
            $href = $href->{$$row[$i]};
        }
        # stop if key kombination occurs multiple
        if (exists $href->{$$row[$i]}) {
            die "$0: duplicate key: ", join (",", @$row), "\n";
        }
        # record last key
		if (defined $$row[$i]) {
			$href->{$$row[$i]} = 1;
		} else {
			$href->{$$row[$i]} = '';
		}
    }
}

if ($opts{'match-sql'}) {
	unless ($opts{'match-sql'} =~ /^(.*?):\{(.*?)\}$/) {
		die "$0: invalid format for option --match-sql: $opts{'match-sql'}\n";
	}
	$matchcol = $1;
	$sth = $dbif -> process ($2);
	
	my $row;
	while ($row = $sth->fetch()) {
		$matchmap{$$row[0]} = 1;
	}
}

my $gcsub = $funcref{$format}->{get_columns};

MAIN: while ($gcsub->(\%inforef, $fd_input, \@columns)) {
    my (@data);

    if ($opts{'headline'} || $opts{'table'}) {
        # table name already known
		@values = @columns;
    } else {
        # table name is the first column
		if ($format eq 'TAB') {
			($table, @values) = split /\t/;
		} elsif ($format eq 'CSV') {
			next unless csv_parseline ($csv, \$linebuf, $_, [$table, @values]);
        }
    
        # extract optional start column parameter
        if ($table =~ /(.+?)\.(.+)/) {
            $table = $1; $startcol = $2;
            
            unless ($startcol =~ /^\d+$/) {
                $msg = "$0: $.: start column not a number: \""
                    . $startcol . "\"\n";
                if ($opts{'skipbadlines'}) {
                    warn ($msg);
                    next;
                } else {
                    die ($msg);
                }
            }
        }
        
        # sanity check on the table name
        if ($table =~ /\s/) {
            warn ("$0: $.: skipping record (\"$table\" not accepted as table name)\n");
            next;
        }
    }

    # check for row ex/inclusion
    $currow++;
    if (defined $rowflag) {
        if ($rowflag && ! exists $userow{$currow}) {
#            print "Skipping row $currow due to inclusion\n";
            next;
        }
        if (! $rowflag && exists $userow{$currow}) {
#            print "Skipping row $currow due to exclusion\n";
            next;
        }
    }
    
    # determine column names
    @names = &column_names ($dbif, $table, $startcol);
    $fieldnames = \@names;

    if ($opts{'routine'}) {
        # filter input first
        next unless filter_input ($routine, $table, $fieldnames, \@values);
    }

	# filter out non-matching rows
	MATCHSQL: {
			if ($opts{'match-sql'}) {
				for (my $i = 0; $i < @$fieldnames; $i++) {
					if ($$fieldnames[$i] eq $matchcol) {
						last MATCHSQL if $matchmap{$values[$i]};
						print "Not accepted record @values\n";
						next MAIN;
					}
				}
			}
		}

    # sanity checks on input data
    my $typeref = $dbif -> typemap ($table);
    my $sizeref = $dbif -> sizemap ($table);

    for (my $i = 0; $i <= $#$fieldnames; $i++) {
        # check for column exclusion
        if (keys %usecol) {
            # note: we do not check the actual value !!
            if ($colflag && ! exists $usecol{$$fieldnames[$i]}) {
                next;
            }
            if (! $colflag && exists $usecol{$$fieldnames[$i]}) {
                next;
            }
        }
		# expand newlines and tabulators
		if (defined $values[$i]) {
			$values[$i] =~ s/\\n/\n/g;
			$values[$i] =~ s/\\t/\t/g;
		}
        
        # check if input exceeds column capacity
		unless (exists $$typeref{$$fieldnames[$i]}) {
			warn ("$0: No type information for column $$fieldnames[$i] found\n");
			next;
		}
		unless (exists $$sizeref{$$fieldnames[$i]}) {
			warn ("$0: No size information for column $$fieldnames[$i] found\n");
			next;
		}
        if ($$typeref{$$fieldnames[$i]} == DBI::SQL_CHAR) {
            if (defined $values[$i]) {
                if (length($values[$i]) > $$sizeref{$$fieldnames[$i]}) {
					warn (prefix() . "Data for field $$fieldnames[$i] truncated: $values[$i]\n");
					$values[$i] = substr($values[$i], 0,
										 $$sizeref{$$fieldnames[$i]});
				}
			} else {
				# avoid insertion of NULL values
				$values[$i] = '';
			}	
        } elsif ($$typeref{$$fieldnames[$i]} == DBI::SQL_VARCHAR) {
            if (defined $values[$i]) {
                if (length($values[$i]) > $$sizeref{$$fieldnames[$i]}) {
					warn (prefix() . "Data for field $$fieldnames[$i] truncated: $values[$i]\n");
					$values[$i] = substr($values[$i], 0,
										 $$sizeref{$$fieldnames[$i]});
				}
			} else {
				# avoid insertion of NULL values
				$values[$i] = '';
			}
        }
#        push (@data, $$fieldnames[$i], $values[$i]);
    }

    # check if record exists
    my %keymap = &key_names ($dbif, $table, $opts{'keys'}, 1);
    @keys = (keys(%keymap));
    my @terms = map {$_ . ' = ' . $dbif->quote($values[$keymap{$_}])}
        (@keys);
    $sth = $dbif -> process ('SELECT ' . join(', ', @keys)
							 . " FROM $table WHERE "
							 . join (' AND ', @terms));
    while ($sth -> fetch) {}

    if ($sth -> rows () > 1) {
        $" = ', ';
        die ("$0: duplicate key(s) @keys in table $table\n");
    }

    $update = $sth -> rows ();
    $sth -> finish ();
    
    # generate SQL statement
    for (my $i = 0; $i <= $#$fieldnames; $i++) {
        # check for column exclusion
        if (keys %usecol) {
            # note: we do not check the actual value !!
            if ($colflag && ! exists $usecol{$$fieldnames[$i]}) {
                next;
            }
            if (! $colflag && exists $usecol{$$fieldnames[$i]}) {
                next;
            }
        }
		# expand newlines
		if (defined $values[$i]) {
			$values[$i] =~ s/\\n/\n/g;
		}
        push (@data, $$fieldnames[$i], $values[$i]);
    }

    if ($update) {
#        print "UPDATING $.\n";
        $dbif -> update ($table, join (' AND ', @terms), @data);
    } else {
        if ($opts{'update-only'}) {
            $" = ', ';
            die ("$0: key(s) @keys not found\n");
        }
#        print "INSERTING $.\n";
        $dbif -> insert ($table, @data);
    }

    if ($opts{'cleanse'} && $update) {
        my ($href, $i);
        
        # now unregister key combination
        $href = \%recmap;
        # Mysql strips trailing blanks from VARCHAR fields, so we do
        if ($dbif->{DRIVER} eq 'mysql') {
            for ($i = 0; $i < @cleansekeys; $i++) {
                if ($$typeref{$cleansekeys[$i]}
                    == DBI::SQL_VARCHAR) {
                    $values[$cleansemap{$cleansekeys[$i]}] =~ s/\s+$//;
                }
            }
        }
		# data from input file may exceed column capacity
		for ($i = 0; $i < @cleansekeys; $i++) {
			if ($$typeref{$cleansekeys[$i]} == DBI::SQL_CHAR) {
				$values[$cleansemap{$cleansekeys[$i]}]
                  = substr($values[$cleansemap{$cleansekeys[$i]}],
                           0,$$sizeref{$cleansekeys[$i]});
			}
		}
        for ($i = 0; $i < $#cleansekeys; $i++) {
            unless (exists $href->{$values[$cleansemap{$cleansekeys[$i]}]}) {
                die ("$0: internal error: key $cleansekeys[$i] not found: ",
                     join (",", @values), "\n");
            }
            $href = $href->{$values[$cleansemap{$cleansekeys[$i]}]};
        }

        unless (exists $href->{$values[$cleansemap{$cleansekeys[$i]}]}) {
            die ("$0: internal error: key $cleansekeys[$i] not found: ",
                 join (",", @values), "\n");
        }
		if ($href->{$values[$cleansemap{$cleansekeys[$i]}]} == 0) {
            my $j = 0;
			warn (prefix () . "duplicate key(s) in input: ",
				  join (", ", map {"$_ = \"" . $values[$cleansemap{$cleansekeys[$j++]}] . "\""} @cleansekeys) . "\n");
		}
        $href->{$values[$cleansemap{$cleansekeys[$i]}]} = 0;
    }
}

if ($opts{'cleanse'}) {
    my $href;
    
    # now start to eliminate old records
    $href = \%recmap;

    my @keylist = keys %recmap;
    my (@tmpkeys, @reckeys, $thiskey, $keyval, @conds);

    for (keys %recmap) {
        push (@reckeys, [$recmap{$_}, $_]);
    }

    for (my $i = 1; $i < @cleansekeys; $i++) {
        @tmpkeys = @reckeys;
        undef @reckeys;
        for $thiskey (@tmpkeys) {
            $href = shift @$thiskey;
            for (keys %$href) {
                push (@reckeys, [$href->{$_}, @$thiskey, $_]);
            }
        }
    }
    for (@reckeys) {
        undef @conds;
            
        # finally delete the record
        next unless shift (@$_);

        for (my $i = 0; $i < @cleansekeys; $i++) {
            push (@conds, $cleansekeys[$i] . ' = ' . $dbif->quote ($_->[$i]));
        }

        $dbif -> process ("DELETE FROM $table WHERE " . join (' AND ', @conds));
    }
}

if (length $linebuf) {
	if ($opts{'skipbadlines'}) {
		warn ("$0: unexpected EOF");
	} else {
		die ("$0: unexpected EOF");
	}
}

undef $dbif;

if ($opts{'file'}) {
    $fd_input->close;
}

# ----------------------------------------
# FUNCTION: get_columns_tab IREF FD COLREF
#
# Get columns from a tab separated file.
# ----------------------------------------

sub get_columns_tab {
	my ($iref, $fd, $colref) = @_;
	my $line;
	
	while (defined ($line = <$fd>)) {
		# skip empty/blank/comment lines
		next if $line =~ /^\#/; next if $line =~ /^\s*$/;
		# remove newlines and carriage returns
		chomp ($line);
		$line =~ s/\r$//;

		@$colref = split (/\t/, $line);
		return @$colref;
	}
}

# ----------------------------------------
# FUNCTION: get_columns_xls IREF FD COLREF
#
# Get columns from a XLS spreadsheet.
# ----------------------------------------

sub get_columns_xls {
	my ($iref, $fd, $colref) = @_;

	unless ($iref->{workbook}) {
		# parse the spreadsheet once
		$iref->{workbook} = $iref->{object}->Parse($fd);
		unless ($iref->{workbook}) {
			die "$0: couldn't parse spreadsheet\n";
		}
		$iref->{worksheet} = $iref->{workbook}->{Worksheet}[0];
		$iref->{row} = 0;
	}

	if ($iref->{row} <= $iref->{worksheet}->{MaxRow}) {
		@$colref = map {$_->Value()}
			@{$iref->{worksheet}->{Cells}[$iref->{row}++]};
		return @$colref;
	}
}

# -------------------------------------------------
# FUNCTION: column_names DBIF TABLE [START]
#
# Returns array with column names from table TABLE
# using database connection DBIF.
# Optional parameter START specifies column where
# the array should start with.
# -------------------------------------------------

sub column_names ($$) {
    my ($dbif, $table, $start) = @_;    
    my ($names, $sth);

    $start = 0 unless $start;
    
    if (exists $fieldmap{$table}) {
        $names = $fieldmap{$table};
    } else {
        $sth = $dbif -> process ("SELECT * FROM $table WHERE 0 = 1");
        $names = $fieldmap{$table} = $sth -> {NAME};
        $sth -> finish ();
    }

    @$names[$start .. $#$names];
}

# --------------------------------------------------
# FUNCTION: key_names DBIF TABLE KEYSPEC [HASH]
#
# Returns array with key names for table TABLE.
# Database connection DBIF may be used to
# retrieve necessary information.
# KEYSPEC contains desired keys, either a numeric
# value or a comma-separated list of keys.
# If HASH is set, a mapping between key name
# and position is returned.
# --------------------------------------------------

sub key_names () {
    my ($dbif, $table, $keyspec, $hash) = @_;
    
    my ($numkeysleft, $i);
    my @columns = column_names ($dbif, $table);
    my (@keys, %kmap);
    
    $keyspec =~ s/^\s+//; $keyspec =~ s/\s+$//;

    if ($keyspec =~ /^\d+$/) {
        #
        # passed keys are numeric, figure out the names
        #

        $numkeysleft = $keyspec;

        for ($i = 0; $i < $numkeysleft && $i < @columns; $i++) {
            if (keys %usecol) {
                # note: we do not check the actual value !!
                if ($colflag && ! exists $usecol{$columns[$i]}) {
                    $numkeysleft++;
                    next;
                }
                if (! $colflag && exists $usecol{$columns[$i]}) {
                    $numkeysleft++;
                    next;
                }
            }
            if ($hash) {
                $kmap{$columns[$i]} = $i;
            } else {
                push (@keys, $columns[$i]);
            }
        }
	} else {
        #
        # key names are passed explicitly
        #

        my %colmap;
        
        for ($i = 0; $i < @columns; $i++) {
            $colmap{$columns[$i]} = $i;
        }
        
        for (split (/\s*,\s*/, $keyspec)) {
            # sanity check
            unless (exists $colmap{$_}) {
                die "$0: key \"$_\" appears not in column list\n";
            }
            
            if ($hash) {
                $kmap{$_} = $colmap{$_};
            } else {
                push (@keys, $_);
            }
        }
    }

    return $hash ? %kmap : @keys;
}

# -------------------------------------------
# FUNCTION: csv_parseline CSV BUF LINE AREF
#
# Parses line with the help of the CSV object.
# BUF is a reference to preceding lines or an
# empty string.
# LINE is the current line.
# Returns truth value and records the fields
# in AREF if successful.
# -------------------------------------------

sub csv_parseline {
	my ($csv, $buf, $line, $aref) = @_;
	my $string = $$buf . $line;
	my $msg;
	
	if ($csv -> parse ($string)) {
		# string is correct, delete the buffer
		@$aref = $csv -> fields;
		$$buf = '';
		1;
	} else {
		if (($string =~ tr/"/"/) % 2) {
			# odd number of quotes, try again with next line
			$$buf = $string;
		} else {
			$msg = "$0: $.: line not in CSV format: " . $csv->error_input . "\n";
			if ($opts{'skipbadlines'}) {
				warn ($msg);
			} else {
				die ($msg);
			}
		}
		0;
	}
}

# ---------------------------------------------------------
# FUNCTION: filter_input ROUTINE TABLE FIELDNAMES VALREF
#
# Filters data input with ROUTINE. Produces first a mapping
# between FIELDNAMES and the data pointed to by VALREF
# and passes the table name TABLE and the mapping to the
# ROUTINE.
# ---------------------------------------------------------

sub filter_input {
    my ($routine, $table, $fieldnames, $valref) = @_;
    my (%colmap, $ret);

    # produce mapping
    for (my $i = 0; $i <= $#$fieldnames; $i++) {
        $colmap{$$fieldnames[$i]} = $$valref[$i];
    }

    # apply filter routine
    $ret = &$routine ($table, \%colmap);
    
    # write new values
    for (my $i = 0; $i <= $#$fieldnames; $i++) {
        $$valref[$i] = $colmap{$$fieldnames[$i]};
    }

    $ret;
}

# ------------------------------------
# FUNCTION: prefix
#
# Generates prefix for error messages.
# ------------------------------------

sub prefix {
    my @frags = ($0);

    if ($.) {
        if ($opts{'file'}) {
            push (@frags, $opts{'file'});
        }
        push (@frags, $.);
    }
    join (': ', @frags, '');
}

# -----------------------------------
# FUNCTION: fatal
#
# Error handler called by DBIx::Easy.
# -----------------------------------

sub fatal {
  my ($statement, $err, $msg) = @_;
  my $pwd;
  my $prefix = prefix ();
  
  if ($dbif->is_auth_error ($err)) {
    unless ($pwdused) {
      print "We need a password.\n";
      $pwd = querypwd();
      $pwdused = 1;
    
      # retry the connection
      if (length ($pwd)) {
        $dbif = new DBIx::Easy ($driver, $database, $user, $pwd);
        $dbif -> install_handler (\&fatal);
        $dbif -> connect ();
        return;
      } else {
        die ("$prefix$statement: $msg\n");
      }
    }
  }
  die ("$prefix$statement: $msg\n");
}

# ----------------------------
# FUNCTION: querypwd
#
# Queries user for a password.
# ----------------------------

sub querypwd () {
  my $pwd;

  print "Password: ";
  ReadMode ('noecho');  # turn echo off
  $pwd = ReadLine (0);
  ReadMode ('restore'); # restore terminal
  print "\n";
  chomp ($pwd);
  $pwd;
}

# script documentation (POD style)

=head1 NAME

dbs_update - Update SQL Databases

=head1 DESCRIPTION

dbs_update is an utility to update SQL databases from text files.

=head2 FORMAT OF THE TEXT FILES

dbs_update assumes that each line of the input contains a data record
and that the field within the records are separated by tabulators.
You can tell dbs_update about the input format with the B<--format>
option.

The first field of the data record is used as table specification.
These consists of the table name and optionally the index of starting
column, separated by a dot.

Alternatively dbs_update can read the column names from the first line
of input (see the B<-h>/B<--headline> option). These can even be aliases
for the real column names (see the B<-m>/B<--map> option).

=head1 COMMAND LINE PARAMETERS

Required command line parameters are the DBI driver
(C<Pg> for Postgres or C<mysql> for MySQL)
and the database name. The third parameter is optionally
and specifies the database user and/or the host where the
database resides (C<racke>, C<racke@linuxia.de> or C<@linuxia.de>).

=head1 OPTIONS

=head2 B<--cleanse>

I<Removes> all records which remain unaffected from the update
process. The same result as deleting all records from the table
first and then running dbs_update, but the table is not empty
in the meantime.

=head2 B<-c> I<COLUMN,COLUMN,...>, B<--columns>=I<COLUMN,COLUMN,...>

Update only the table columns given by the I<COLUMN> parameters.
To exclude columns from the update prepend C<!> or C<^> to the
parameters.

=head2 B<--rows>=I<ROW,ROW,...>

Update only the input rows given by the I<ROW> parameters.
The first row is 1 where headlines doesn't count.
To exclude rows from the update prepend C<!> or C<^> to the
parameters.

=head2 B<-f> I<FILE>, B<--file>=I<FILE>

Reads records from file I<FILE> instead of from standard input.

=head2 B<--format>=I<FORMAT[SEPCHAR]>

Assumes I<FORMAT> as format for the input. Only B<CSV> can be
specified for now, default is B<TAB>. The default field
separator for B<CSV> is a comma, you may change this by
appending the separator to the format.

=head2 B<-h>, B<--headline>

Reads the column names from the first line of the input instead
of dedicting them from the database layout. Requires the
B<-t/--table> option.

=head2 B<-k> I<COUNT>, B<-k> I<KEY,KEY,...>, B<--keys>=I<COUNT>, B<--keys>=I<KEY,KEY,...>

Specifies the keys for the table(s) either as the number of columns
used as keys or by specifying them explicitly as comma separated
arguments to the option.
This is used for the detection of existing records.

=head2 B<-m> I<ALIASDEF>, B<--map>=I<ALIASDEF>

Maps the names found in the first line of input to the actual column
names in the database. The alias and the column name are separated
with C<=> signs and the different entries are separated by C<;> signs,
e.g. C<Art-No.=code;Short Description=shortdescr'>.

=head2 B<--map-filter>=I<FILTER>

Applies a filter to the column names read from the input file.
Currently there is only the C<lc> filter available.

=head2 B<--match-sql>=I<FIELD:{STATEMENT}>

Updates only records where the value of the column I<FIELD> is in
the result set of the SQL statement I<STATEMENT>,
e.g. C<category:{select distinct name from categories}>.

=head2 B<-o>, B<--update-only>

Updates existing database entries only, stops if it detects
new ones.

=head2 B<-r> I<ROUTINE>, B<--routine>=I<ROUTINE>

Applies I<ROUTINE> to any data record. I<ROUTINE> must be a subroutine.
dbs_update passes the table name and a hash reference to this subroutine.
The keys of the hash are the column names and the values are the
corresponding field values. If the return value of I<ROUTINE> is not
a truth value, the data record will be skipped.

C<sub {my ($table, $valref) = @_;
    unless (defined $$valref{country} && $$valref{country} !~ /\S/) {
        $$valref{country} = "Germany";
    }
    1;
}>

=head2 B<--skipbadlines>

Lines not matching the assumed format are ignored. Without this
option, dbs_update simply stops.

=head2 B<-t> I<TABLE>, B<--table>=I<TABLE>

Uses I<TABLE> as table name for all records instead of the
first field name.

=head1 AUTHOR

Stefan Hornburg (Racke), racke@linuxia.de

=head1 SEE ALSO

perl(1), DBIx::Easy(3)

=cut