Prototype mismatch: sub XBase::Base::O_BINARY () vs none at (eval 5) line 1.
Constant subroutine O_BINARY redefined at (eval 5) line 1.

##</code><code>##

Can't call method "last_record" on an undefined value at /usr/local/bin/dbf2MySQL.pl line 159.

##</code><code>##

#!/usr/bin/perl
#
#use strict;
use XBase;
use Mysql;

my %TYPES = (
    C => ["Character", "VARCHAR (254)"],
    N => ["Numberic", "INTEGER (15)"],
    F => ["Float", "INTEGER (15)"],
    # L => ["??Long??", "INTEGER (15)"],
    O => ["Double", "NUMERIC(25,5)"],
    # A => ["??AutoIncrement??", "INTEGER(10)"],
    D => ["Date", "DATE"],
    T => ["TimeStamp", "DATETIME"],
    L => ["Logical", "TINYINT(1)"],
    M => ["Memo", "BLOB"],
    B => ["Binary", "BLOB"],
    I => ["Integer", "INTEGER (6)"],
    Y => ["Currency", "NUMERIC(20,2)"],
    V => ["VariField", "VARCHAR(10)"],
    0 => ["?????", "CHAR(1)"]
  );

my $sql_out = "./out.sql";
my $data_dir = "./Data";
my $xbase_file = "file.dbf";
my $verbose = 0;
my $debug = 0;

use Getopt::Std;

my %opt;
my $opts = "hD:f:co:avdsH:t:u:p:k:Tq";
getopts($opts, \%opt) or help();

help() if $opt{h};

$verbose = 1 if $opt{v};
$debug = 1 if $opt{d};
$data_dir = $opt{D} if $opt{D};
$sql_out = $opt{o} if $opt{o};

if ($opt{f}){
  $data_dir = "";
  $xbase_file = $opt{f};
}

debug("Verbose: " . $verbose);
debug("Debug: " . $debug);
debug("Data dir:" . $data_dir);
debug("XBase file:" . $xbase_file);
debug("SQL output:" . $sql_out);
debug("MySQL host:" . $opt{H});
debug("MySQL database:" . $opt{t});
debug("MySQL user:" . $opt{u});
debug("MySQL password:" . $opt{p});
debug("MySQL key column:" . $opt{k});
debug("");

if ($opt{T}){
  $debug = 1;
  showStats($xbase_file);
} elsif ($opt{a}){
  createAllDBFiles();
} elsif ($opt{c}){
  createDB($xbase_file) if $opt{c};
} elsif ($opt{s}){
  syncDB($xbase_file);
}

exit (0);

#####################################################
###                 SUB ROUTINES
#####################################################

# Prints help message
sub help{
  print "Usage: ./test.pl [-h][-D][-f][-c][-o][-a][-v][-d]\n";
  print "                 [-s][-H][-t][-u][-p][-T][-q]\n";
  print "\n";
  print "  -h: displays this help message\n";
  print "  -D: XBase data directory\n";
  print "  -f: XBase file to synchronize\n";
  print "  -c: create SQL database definition\n";
  print "  -o: output file name\n";
  print "  -a: all DBF files in data directory\n";
  print "  -v: verbose\n";
  print "  -d: debug\n";
  print "  -s: synchronize database\n";
  print "  -H: MySQL hostname\n";
  print "  -t: MySQL database\n";
  print "  -u: MySQL username\n";
  print "  -p: MySQL password\n";
  print "  -k: MySQL key fields separated by a ':'\n";
  print "  -T: show statistics on XBase file\n";
  print "  -q: suppress warnings\n";
  print "\n";
  exit (0);
}

# Reads selected Database file and creates new SQL Schema
sub createDB {
  my $xbase_file = shift;

  open (OUTFILE, ">>" . $sql_out);
  debug("Creating database definition");
  showStats($xbase_file);
  my $database = new XBase $xbase_file;
  my @field_names = $database->field_names();
  my $records = $database->last_record() + 1;
  my $sql_name = sqlName($xbase_file);

  my $sql_create = "DROP TABLE IF EXISTS " . $sql_name . ";\n";
  $sql_create .= "CREATE TABLE " .  $sql_name . " (\n";

  foreach my $current_fn (@field_names){
    my $field_type = $database->field_type($current_fn);
    my $field_length = $database->field_length($current_fn);
    my $field_decimal = $database->field_decimal($current_fn);

    if ( ! @{$TYPES{$field_type}}[1] ){
      print "$sql_name: $current_fn -- LEN: $field_length -- DEC: $field_decimal\n";
      die ("\nField type '" . $field_type . "' not supported\n\n");
    }

    $sql_create .= "  $current_fn @{$TYPES{$field_type}}[1], \n";
  }

  $sql_create = substr($sql_create, 0, -3) . "\n);\n\n";

  debug($sql_create);

  print OUTFILE $sql_create;
  close(OUTFILE);
}

# Reads all DBF files in data dir and creates new SQL Schema
sub createAllDBFiles {
  say("Syncing all files in: " . $data_dir);
  opendir (DIR, $data_dir);
  foreach my $file (readdir(DIR)){
    next if !($file =~ /.DBF$/i);
    debug("Found: " . $file);
    if ($opt{c}){
      createDB($data_dir . "/" . $file);
    }
  }
  closedir(DIR);
}

# Synchronizes database data
sub syncDB{
  my $database_file = shift;
  my $dbh = Mysql->connect($opt{H}, $opt{t}, $opt{u}, $opt{p}) or die "Can't connect to database";

  my $database = new XBase $database_file;
  my $records = $database->last_record() + 1;

  say("Syncing database: " . $database_file . " (" . $records . " records)");
  my @field_names = $database->field_names();
  my $sql_name = sqlName($database_file);

  for (my $x = 0; $x < $records; $x++){
    my @data = $database->get_record($x);
    my $sql_key = "";

    foreach (split(/:/, $opt{k})){
      $sql_key .= @field_names[$_] . " = '" . formatField(@data[$_ + 1], $database->field_type(@field_names[$_])) . "' AND ";
    }
    $sql_key = substr($sql_key, 0, -5);

    my $sql_count = "SELECT COUNT(*) FROM " . $sql_name . " WHERE " . $sql_key;
    debug ($sql_count);

    my $qh = executeQuery($dbh, $sql_count, $opt{q});
    my @row = $qh->fetchrow;
    my $sql_update = "";
    my $sql_error = "";

    if (@row[0] == 0){
      # Insert
      # INSERT INTO <<TABLE>> (<<column1>>... <<columnN>>) VALUES (<<value1>>... <<valueN>>)
      my $sql1 = "";
      my $sql2 = "";
      my $tmp_data = "";

      for (my $y = 0; $y < @field_names; $y ++){
        $sql1 .= @field_names[$y] . ", ";
        $sql2 .= "'" . formatField(@data[$y + 1], $database->field_type(@field_names[$y])) . "', ";
      }

      $sql_update = "INSERT INTO " . $sql_name . "(\n";
      $sql_update .= substr($sql1, 0, -2) . "\n)\n";
      $sql_update .= "VALUES\n";
      $sql_update .= "(\n";
      $sql_update .= substr($sql2, 0, -2) . "\n";
      $sql_update .= ")\n";
    } else {
      # Update
      # UPDATE <<TABLE>> SET <<column1>> = <<value1>> ... <<columnN>> = <<valueN>>
      #                  WHERE <<key column>> = <<key value>>;
      $sql_update = "UPDATE " . $sql_name . " SET ";

      for (my $y = 0; $y < @field_names; $y ++){
        $sql_update .= @field_names[$y] . " = '" . formatField(@data[$y + 1], $database->field_type(@field_names[$y])) . "', ";
      }

      $sql_update = substr($sql_update, 0, -2) . " WHERE " . $sql_key;
    }
    debug($x . ") " . $sql_update);
    executeQuery($dbh, $sql_update, $opt{q});
  }
}

sub showStats {
  my $database_file = shift;

  my $database = new XBase $database_file or die(XBase->errstr);
  my $records = $database->last_record() + 1;
  my @field_names = $database->field_names();

  my $say = "File: " . $database_file . "\n";
  $say .= "SQL Table Name: " . sqlName($database_file). "\n";
  $say .= "Records: " . $records. "\n";
  $say .= "Fields: " . @field_names. "\n";
  $say .= "Field Names: ";
  foreach (@field_names){
    $say .= $_ . ", ";
  }
  $say = substr($say, 0, -2) . "\n";
  $say .= "\n";
  debug($say);
}
# output text if in verbose mode
sub say {
  if ($verbose){
    print shift;
    print "\n";
  }
}

# output text if in debug mode
sub debug {
  if ($debug){
    print shift;
    print "\n";
  }
}

# converts Xbase name to sql name
sub sqlName {
  my $result = shift;
  $result = substr($result, rindex($result, "/") + 1, -4);
  return $result;
}

# Escapes string for sql insert
sub escape {
  my $value = shift;
  $value =~ s/\\/\\/g;
  $value =~ s/"/\\"/g;
  $value =~ s/'/\\'/g;
  return $value;
}

# formats selected field from perl to sql based on type
sub formatField {
  my ($data, $type) = @_;
  my $result = "";

  # debug("Data: '" . $data . "'\nType: '" . $type . "'\n");

  # Convert from decimal to sql time string
  if ($type eq "T"){
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime $data;
    $year += 1900;
    $mon ++;
    $result = "$year-$mon-$mday $hour:$min:$sec";
  } else {
    $result = escape($data);
  }

  return $result;
}

# executes sql query given handle, query, and quiet option
sub executeQuery {
  my ($handle, $query, $quiet) = @_;
  my $sql_error = "";

  my $result = $handle->query($query) or $sql_error = $handle->errmsg();

  if ($sql_error){
    say($sql_error);
    if (! $quiet){
      die("");
    }
  }

  return $result;
}