LTHAC dbf2mysql

From Lhi

#!/usr/bin/perl
%resw = ('DESC'=>'DESCRIP');
use DBI;
use DBD::XBase;
$dbhost = 'lthistory.from.net';
$dbuser = 'lthistorian';
$dbpwd = 'maidenhead';
$mdbh = DBI->connect("DBI:mysql:lthistory:$dbhost",$dbuser,$dbpwd,{RaiseError=>\
1});
for ('HDATE.DBF','HITEM.DBF','HPLACE.DBF','HSUBJ.DBF',
     'HFAC.DBF','HNAME.DBF','HSEE.DBF','HTYPE.DBF') {
   &cvtab($_);
}
#&cvtab("HITEM.DBF");
$mdbh->disconnect;
########################################################################
sub cvtab {
   my($filename,@xs) = @_;
   print "Processing $filename -- ";
   my $tabname = $filename;
   $tabname =~ s/H//;
   $tabname =~ s/\..*//;
   $tabname = lc($tabname);
   my $dbh = DBI->connect("DBI:XBase:.",undef, undef,{RaiseError=>1});
   my $stmt = "select * from $filename";
   my $sth = $dbh->prepare($stmt);
   my $rv = $sth->execute;
# First pass accumulates field names and max lengths:
   undef %flen; $k = 0;
   while ($rr = $sth->fetchrow_hashref) {
      &unreserve($rr);
      for (keys %$rr) {
         $flen{$_} = 0 if ! defined $flen{$_};
         $flen{$_} = length($$rr{$_}) if length($$rr{$_}) > $flen{$_};#findmax
      }
      $k += 1;
   }
   $sth->finish;
   print "$k records\n";
# create table
   my $dsth = $mdbh->prepare("drop table if exists $tabname");
   $rv = $dsth->execute;
   $dsth->finish;
   my $ccom = '';
   my $cstmt = "create table $tabname (";
   for (sort keys %flen) {
      #print "Field $_ len $flen{$_}\n";
      if ($flen{$_} > 200) {
         $cstmt .= $ccom."$_ text";
      } else {
         $cstmt .= $ccom."$_ varchar($flen{$_})";
      }
      $ccom = ", ";
   }
   $cstmt .= ")";
   #print "$cstmt\n";
   my $csth = $mdbh->prepare($cstmt);
   $rv = $csth->execute;
   $csth->finish;
# Second pass to load data into mysql table
   my $sth = $dbh->prepare($stmt);
   my $rv = $sth->execute;
   while ($rr = $sth->fetchrow_hashref) {
      &unreserve($rr);
      my @fn = (); my @fv = (); my @qm = ();
      for (keys %$rr) {
         push(@fn,$_); push(@fv,&clean($$rr{$_})); push(@qm,'?');
      }
      my $istmt = "insert into $tabname (".join(',',@fn).
          ") values (".join(',',@qm).")";
      my $isth = $mdbh->prepare($istmt);
      $rv = $isth->execute(@fv);
      $isth->finish;
   }
   $sth->finish;
   $dbh->disconnect;
}
sub clean {
   my $cs = shift;
   $cs =~s/\r//g;
   $cs =~s/\215/ /g;
   return $cs;
}
# replace all fields named for reserved keywords as defined by hash %resw
sub unreserve {
   my $rr = shift;
   for (keys %resw) {
      if (defined $$rr{$_}) {
         $$rr{$resw{$_}} = $$rr{$_};
         delete $$rr{$_};
      }
   }
}