AIM Systems has asked for the wisdom of the Perl Monks concerning the following question:

Hi all,

My predecessor designed a nifty script to take select .dbf files for one database, compare that the contents of a MySQL database and then dynamically create UPDATE or INSERT statements to effectively sync the two..... Now it doesn't work.

In the calling script, I loop for 12 .dbf files. I receive 13 of these errors:

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

[download]

In 2 instances, I also receive this error:

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

[download]

As a side note: since am predecessor's leaving, we have migrated from Perl 5.8.8 which worked to 5.10.0 which doesn't work.

I have attached his code below:

Can anyone point a total noob in the rite direction?
Thanx

#!/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: $fie
+ld_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 . " reco
+rds)");
  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 (<<v
+alue1>>... <<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_typ
+e(@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;
}

[download]

Replies are listed 'Best First'.
Re: Can't retrieve last_record
by bv (Friar) on Dec 08, 2009 at 23:00 UTC

    It looks like you might have a version of Xbase that is incompatible with your version of Perl. Get the latest version from CPAN and see if that works. Make sure you get the same Xbase, though. It looks like there are at least two by two different authors. It may create more errors and warnings, but they should be easier to deal with from the standpoint of your code.

    @_=qw;
Just another Perl hacker,;
;$_=q=print
"@_"= and eval;

    [download]
[reply]
[d/l]

      Thanks for the advice.
      For the meantime, the prototype mismatch errors are proving to be non-fatal, though annoying.

      My intent is to look into rewriting the script in the new year using DBI drivers as I'm told that the Mysql module has been obsoleted

      ref: http://search.cpan.org/~capttofu/DBD-mysql-3.0008/lib/Mysql.pm#DESCRIPTION

      My concern is the inability to call the method "last_record" on 2 of 12 files.
      My understanding is that this method returns the zero-based number of the last record in the .dbf file. We use it to set the upper bound for looping through every record.
      As stated, only on 2 of 12 files can this method not be called.

      Can a structural abnormality in the FoxPro .dbf files be causing my grief?

[reply]
[d/l]
        My concern is the inability to call the method "last_record" on 2 of 12 files.

        As the error message says ("Can't call method "last_record" on an undefined value"), the method can't be called because what you expect to be an object ($database) is undefined: 

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

        [download]

        This is most likely because the .dbf file could not be opened/read/parsed, so the constructor fails and returns undef instead of an object to indicate the error.

        In other words, check for this case ($database being undefined), and only continue with the rest of the routine if things are ok.

        And in case you can't simply skip those 2 files, I'm afraid there's more trouble ahead, i.e. figuring out the underlying problem of why the XBase constructor is failing...

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom