dbf2tsv

   1 #!/usr/bin/perl
   2
   3 # Copyright 2009-2012, Equinox Software, Inc.
   4 #
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  18
  19 use strict;
  20 use warnings;
  21
  22 use XBase;  # or could use DBI and DBD::XBase;
  23 use Data::Dumper;
  24 use Getopt::Long;
  25 use Encode;
  26
  27 my $in = '';
  28 my $out = '';
  29 my $help = 0;
  30 GetOptions('in=s' => \$in, 'out=s' => \$out, 'help' => \$help);
  31
  32 if ($help) { &show_help; }
  33
  34 my @errors;
  35 if ($in eq '') { push @errors, 'Input file must be specified ( --in inputfile.dbf )' };
  36 if ($out eq '') { push @errors, 'Output file must be specified ( --out outputfile.tsv )' };
  37 if (@errors > 0) { &show_help (@errors); }
  38
  39 open OUT, ">$out" or die $!;
  40
  41 my $table = new XBase $in or die XBase->errstr;
  42
  43 # get list of field names
  44 my @names = $table->field_names;
  45
  46 # print a header line with field names
  47 print OUT join ("\t", @names) . "\n";
  48
  49 sub clean {
  50   if ( $_ ) {
  51     s/\\/\\\\/g;
  52     s/\n/\\n/g;
  53     s/\r/\\r/g;
  54     s/\t/\\t/g;
  55     Encode::encode("utf8", $_)
  56   } else { ''; } # to avoid 'Use of uninitialized value in join'
  57 }
  58
  59 my $i = 0;
  60 for (0 .. $table->last_record) {
  61     $i++;
  62     my ($deleted, @row) = $table->get_record($_);
  63     @row = map (&clean, @row);
  64     print OUT join("\t", @row) . "\n" unless $deleted;
  65
  66 }
  67
  68 print STDERR "$i records exported to $out.\n";
  69
  70
  71 sub show_help {
  72     my ($msg) = @_;
  73     print "\nERROR - $msg\n" if $msg;
  74     print <<HELP;
  75
  76 dbf2tsv - convert XBase DBF to tab-separated format
  77
  78 Notes:
  79
  80   * Escapes backslash, newline, carriage return, and tab characters.
  81   * Converts to UTF-8.
  82
  83 Usage:
  84
  85   dbf2tsv --in inputfile.dbf --out outputfile.tsv
  86
  87 HELP
  88     exit;
  89 }
  90
  91 =pod
  92
  93 =head1 NAME
  94
  95   dbf2tsv - convert XBase DBF to tab-separated values
  96
  97 =head1 SYNOPSIS
  98
  99   dbf2tsv --in inputfile.dbf --out outputfile.dbf
 100
 101 =head1 CAVEATS
 102
 103   Munges data in the following ways:
 104
 105   * Escapes backslash, newline, carriage return, and tab characters.
 106   * Converts to UTF-8.
 107 =cut