Article 9047 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:9047
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!gatech!swrinde!sgiblab!gatekeeper.us.oracle.com!oracle!unrepliable!bounce
Newsgroups: comp.lang.perl
From: ntools1@be.oracle.com (student1)
Subject: Re: read DBF3 files
In-Reply-To: louis@mobil.arc.ulaval.ca's message of Thu, 9 Dec 1993 06:31:24 GMT
Message-ID: <NTOOLS1.93Dec20190259@berou1.be.oracle.com>
Sender: usenet@oracle.us.oracle.com (Oracle News Poster)
Nntp-Posting-Host: berou1.be.oracle.com
Organization: Oracle University
References: <louis.1105806324A@athena.ulaval.ca>
Date: Mon, 20 Dec 1993 19:02:59 GMT
X-Disclaimer: This message was written by an unauthenticated user
at Oracle Corporation. The opinions expressed are those
of the user and not necessarily those of Oracle.
Lines: 192
>>>>> "Louis" == Louis Demers <louis@mobil.arc.ulaval.ca> writes:
In article <louis.1105806324A@athena.ulaval.ca> louis@mobil.arc.ulaval.ca (Louis Demers) writes:
Louis> Hello, Where can I find a script for transform DBF3 file into
Louis> a tab or coma file?
Louis> Merci !
Below, you find the solution. The most important bug is that
the documentation is hidden in the source code. :-)
(mail me on "pbijnens@be.oracle.com", if you need help with it.)
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 09/25/1993 10:38 UTC by polleke@triton
# Source directory /user/div/polleke/db3
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 2226 -rw-rw-r-- db3.pl
# 763 -rwxrwxr-x db3flat
#
# ============= db3.pl ==============
if test -f 'db3.pl' -a X"$1" != X"-c"; then
echo 'x - skipping db3.pl (File already exists)'
else
echo 'x - extracting db3.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'db3.pl' &&
X# db3.pl -- routines to read dBaseIII-files
X# (c) 1992 Paul Bijnens
X
X
Xpackage db3;
X
X
X# initialise db3-structures from header of the file
X# usage: db3init(FH);
Xsub main'db3init {
X local(*Db3) = shift(@_);
X local($rec, $pos);
X
X seek(Db3, 0, 0);
X read(Db3, $rec, 32);
X $db3version = &endian(substr($rec,0,1));
X $db3totrec = &endian(substr($rec,4,4));
X $db3lenhead = &endian(substr($rec,8,2)) - 1;
X $db3lenrec = &endian(substr($rec,10,2));
X
X if ($db3version == 0x83) {
X warn("Cannot handle memo-fields\n");
X } elsif ($db3version != 0x03) {
X warn("Not a db3-file\n");
X return 0;
X }
X
X $db3nf = $[;
X $db3fmt = "a1";
X for ($pos = 32; $pos < $db3lenhead; $pos += 32) {
X read(Db3, $rec, 32);
X $db3fn[$db3nf] = unpack("A11", $rec);
X $db3fn[$db3nf] =~ s/\000.*//; # sometimes trailing garbage!!!
X $db3ft[$db3nf] = substr($rec,11,1);
X $db3fl[$db3nf] = &endian(substr($rec,16,2));
X $db3fi{$db3fn[$db3nf]} = $db3nf; # name -> field index
X $db3fmt .= "A$db3fl[$db3nf]";
X #if ($db3ft[$db3nf] eq "C") {
X # $db3fmt .= "a$db3fl[$db3nf]";
X #} elsif ($db3ft[$db3nf] eq "N") {
X # $db3fmt .= "A$db3fl[$db3nf]";
X #}
X $db3nf++;
X }
X
X if (($c = getc(Db3)) != "\r") {
X print "Header korrupt...\n";
X }
X 1;
X}
X
X
X# read the next record in the db3-file
X# usage: db3read(FH)
X# return: list of fields, or () on eof or error;
Xsub main'db3read {
X local(*Db3) = shift(@_);
X local($rec, $del, @res);
X
X do {
X read(Db3, $rec, $db3lenrec) || return ();
X ($del, @res) = unpack($db3fmt, $rec);
X } while ($del ne " ");
X return @res;
X}
X
X
X# print db3-record in flatfile-record format
X# usage: db3_flat_str
Xsub main'db3_flat_str {
X local($,) = "\t";
X local($\) = "\n";
X
X print @db3fn;
X print @db3fl;
X print @db3ft;
X}
X
X
X# convert to flatfile-like database
X# usage: db3_flat(DBHANDLE)
Xsub main'db3_flat {
X local(*Db3) = shift(@_);
X local($,) = "\t";
X local($\) = "\n";
X local(@flds);
X
X while (@flds = &main'db3read(*Db3)) {
X print @flds;
X }
X}
X
X
X# convert little-endian to native machine order
X# (intel = big-endian -> mc68k = big-endian)
X# usage
Xsub endian
X{
X local($n) = 0;
X foreach (reverse(split('', $_[0]))) {
X $n = $n * 256 + ord;
X }
X $n;
X}
X
X1;
SHAR_EOF
chmod 0664 db3.pl ||
echo 'restore of db3.pl failed'
Wc_c="`wc -c < 'db3.pl'`"
test 2226 -eq "$Wc_c" ||
echo 'db3.pl: original size 2226, current size' "c" ||
echo 'db3.pl: original size 2226, current size' "$Wc_c"
fi
# ============= db3flat ==============
if test -f 'db3flat' -a X"$1" != X"-c"; then
echo 'x - skipping db3flat (File already exists)'
else
echo 'x - extracting db3flat (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'db3flat' &&
X#!/usr/bin/perl
X
X
X# convert db3-file to a flatfile (ascii-file with records consisting
X# of 1 line, and fields separated by a fieldseparator (tab) character)
X
Xrequire 'db3.pl';
X
Xforeach $infile (@ARGV) {
X
X ($basename) = ($infile =~ /(.*)\.dbf$/i);
X die("$infile: name not like 'name.DBF'\n") unless $basename;
X
X open(DB, "< $infile") || die("$infile: cannot open: $!\n");
X open(OUT, "| repl -t pc2ascii > $basename") ||
X die("$basename: cannot open: $!\n");
X select(OUT);
X
X &db3init(*DB) || die("$infile: cannot initialise db3-format\n");
X
X &db3_flat_str; # print out the structure
X &db3_flat(*DB); # followed by the records
X
X close(DB) || die("$infile: close: $!\n");
X close(OUT) || die("$basename: close: $!\n");
X}
SHAR_EOF
chmod 0775 db3flat ||
echo 'restore of db3flat failed'
Wc_c="`wc -c < 'db3flat'`"
test 763 -eq "$Wc_c" ||
echo 'db3flat: original size 763, current size' "$Wc_c"
fi
exit 0