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