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: Sender: usenet@oracle.us.oracle.com (Oracle News Poster) Nntp-Posting-Host: berou1.be.oracle.com Organization: Oracle University References: 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 writes: In article 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