Article 6119 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:6119
Path: feenix.metronet.com!news.utdallas.edu!wupost!howland.reston.ans.net!europa.eng.gtefsd.com!uunet!news.univie.ac.at!blekul11!polleke
Message-ID: <19930925.123519.678799.NETNEWS@CC1.KULEUVEN.AC.BE>
Nntp-Posting-Host: 134.58.131.2
Date: Sat, 25 Sep 1993 12:35:18 +0200
From: polleke@triton.lew.kuleuven.ac.be (Paul Bijnens)
Subject: Re: HELP with perl and SAS ?
Newsgroups: comp.lang.perl
References: <27na94$chs@crchh327.bnr.ca>
Distribution: world
X-Newsreader: TIN [version 1.1 PL9]
Lines: 203

Edward Tobin (tobin@bnr.ca) wrote:
: Niranjan Perera (perera@genaro.lislab.uga.edu) wrote:
: ...
: > I am new to perl, does anybody know or have a perl script that will
: > take a dbf file and process it, to produce the sas, and dat files used
: > by the SAS  package ?

: The best hint I can offer here is the unix pipe facility in SAS. You could
: try something like this:

: 	FILENAME perldata PIPE 'db_accessing_perl_script';
: 	DATA project.perlinfo /VIEW=project.perlinfo;
: 	INFILE perldata;
: 	INPUT @1  key
: 	      @10 data;

: Each time the project.perlinfo view is referenced, the DATA step will be
: executed, and the db_accessing_perl_script will be executed.

And if you need a  perl package to read dbf files (I hope you mean
Dbase III files), here you have one.
The documentation is encrypted inside the code however...  :-)


#!/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' "$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

--
Paul Bijnens              -- MS DOS is the world's most widespread virus
polleke@triton.lew.kuleuven.ac.be      ---     pbijnens@be.oracle.com