#!/usr/bin/perl -w
# This simple perl scrip imports data from Visual Fox Pro table
# into MySql database (without SSL)

# PARAMETERS
my $table_name="telefony";     # name of the dbf table (without .dbf)
my $user="someone";            # mysql user
my $password="secret";         # mysql user password
my $hostname="localhost";      # localhost or ip address
my $database="data_base_name"; # mysql database
my $port="3306";               # mysql port
my $nullallow=" NOT NULL";     # make blank if you want to permit null values
# END OF PARAMETERS

my $sSql=""; #
my $timestart = time();

use XBase;
use Getopt::Long;
use strict;
use DBI();
use List::Util qw[min max];

# Declare the subroutines
sub trim($);
sub ltrim($);
sub rtrim($);

# open dbf file
my $table = new XBase "$table_name".".dbf" or die XBase->errstr;

# connect to MySql database 
my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
my $dbh = DBI->connect($dsn, $user, $password);

#print $table->field_names;
my @fields = $table->field_names;
my @types = $table->field_types;
my @len = $table->field_lengths;
my @dec = $table->field_decimals;
my $last_rec = $table->last_record +1 ;
my $sSqlStart="insert into ".$table_name." ("; # first part of the insert query
my $sSql=""; # 
my $dane="";
my $deleted=0; # no of deleted records in table

print "Fields count: $#fields, Record count: $last_rec \n";
print "Size: @fields \n";

# if dbf table was created in WIN 1250 code page
$dbh->do("SET CHARACTER SET cp1250;");
$dbh->do("SET NAMES cp1250;");

# create first part of the insert query
for (my $i=0; $i<=$#fields; $i++) 
{
 print "$fields[$i] : $types[$i] : $len[$i] : $dec[$i] \n";
 $sSqlStart = $sSqlStart.$fields[$i];
 if ($i<$#fields) {$sSqlStart=$sSqlStart.","}
}
$sSqlStart=$sSqlStart.")";

# read records
my $i=0;
my $speed=0;
for ($i=0; $i<$last_rec; $i++)
{
    $sSql=$sSqlStart." VALUES(";
    my @rekord = $table->get_record($i);
    # if not deleted
    if ( $rekord[0] == 0 )
    {
        for (my $j=1; $j<=$#fields+1; $j++)
        {
	#	print "$rekord[$j],";
		$dane=$rekord[$j];
	    # null or undef values
	    if ( !defined $dane ) 
            { 
    		$dane = "";
	    }
	    if ( $dane eq "")
	    {
		if ( $types[$j-1] eq 'D' or $types[$j-1] eq 'T' or $types[$j-1] eq 'I' or $types[$j-1] eq 'N' or $types[$j-1] eq 'L')
		    {$dane="0"}
	    }
	    # values of char or memo fields must be quoted
	    if ( $types[$j-1] eq 'C' or $types[$j-1] eq 'M')
	    {
	        $dane=$dbh->quote(trim($dane));
	    }
	    $sSql=$sSql."$dane";
	    if ($j<$#fields+1) {$sSql=$sSql.","}
        }
	$sSql=$sSql.");";
	my $sth = $dbh->prepare($sSql);
	  if (!$sth) {
	    print("Query: $sSql \n");
	    die "Error: " . $dbh->errstr . "\n";
          }
	    if (!$sth->execute) {
	      print("Query: $sSql \n");
              die "Error: " . $sth->errstr . "\n";
    	  }
    }         
    else {
	$deleted=$deleted+1;
    }
    $speed = int($i/max((time()-$timestart),1));
    my $percent = 100*($i/($last_rec));
    printf("%.1f",$percent);
    print " % , $i / $last_rec , Speed: $speed rec/sec.\n";
#    if ( $i > 2) { exit  }
}

my $timeend = time()-$timestart;
$dbh->disconnect();

print "Table: $table_name \n";
print "No of records in table: $last_rec. \n";
print "Deleted records in table: $deleted. \n";
$i = $i  - $deleted;
print "Imported records: $i. \n";
print "Import time: $timeend sec. \n";
print "Speed: $speed rec/sec.\n";



# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}
# Left trim function to remove leading whitespace
sub ltrim($)
{
    my $string = shift;
    $string =~ s/^\s+//;
    return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim($)
{
    my $string = shift;
    $string =~ s/\s+$//;
    return $string;
}