temp.raku

use v6.d;

class Header {
    has $.handle;

    has Str  $.last-updated          is built(False);
    has UInt $.record-count          is built(False);
    has UInt $.header-length         is built(False);
    has UInt $.record-length         is built(False);
    has Bool $.transaction-complete  is built(False);
    has Bool $.db-encrypted          is built(False);
    has Bool $.prod-mdx              is built(False);
    has UInt $.lang-driver           is built(False);

    has $!data;

    method TWEAK {
	self!read-metadata;	
    }

    method !read-metadata {
	my $HEADER-BYTES = 32;
	$!data = $!handle.read($HEADER-BYTES);

	constant $SUPPORTED-VERSION = 0x03;
	unless $!data[0] == $SUPPORTED-VERSION {
	    die 'Only dBase III without memo file is supported'; 
	}

	my $year  = $!data[1];
	my $month = $!data[2];
	my $day   = $!data[3];
	my $formatter = { "%04d-%02d-%02d".sprintf(.year, .month, .day) };
	$!last-updated = Date.new(year => $year + 1900, :$month, :$day, :$formatter).Str;

	$!record-count         = $!data.read-uint32(4, LittleEndian);
	$!header-length        = $!data.read-uint16(8, LittleEndian);
	$!record-length        = $!data.read-uint16(10, LittleEndian);
	$!transaction-complete = $!data[14] != 1;
	$!db-encrypted         = $!data[15] == 1;
	$!prod-mdx             = $!data[28] == 1;
	$!lang-driver          = $!data[29];
    }

    #| Returns a string table representation of the DBF file's metadata.
    method gist(Int:D :$bar-spaces = 2) {
	my @rows = 
	  ('last updated', $!last-updated),
	  ('record count', $!record-count),
	  ('header length', $!header-length),
	  ('record length', $!record-length),
	  ('transaction complete', $!transaction-complete),
	  ('db encrypted', $!db-encrypted),
	  ('production max', $!prod-mdx),
	  ('language driver', $!lang-driver),
	  ('version description', 'dBase III without memo file'),
	;

	my $longest-key = @rows.sort({ -$^pair[0].chars }).head[0];
	my $longest-val = @rows.sort({ -$^pair[1].chars }).head[1];

	sub create-row($key, $value --> Str:D) {
	      ('|', ' ' x $bar-spaces).join
	    ~ "%-{$longest-key.chars}s".sprintf($key)
	    ~ (' ' x $bar-spaces, '|', ' ' x $bar-spaces).join
	    ~ "%-{$longest-val.chars}s".sprintf($value) 
	    ~ (' ' x $bar-spaces, '|').join
	}


	sub create-delimiter(--> Str:D) {
	      '+'
	    ~ ('-' x $longest-key.chars + 2 * $bar-spaces)
	    ~ '+'
	    ~ ('-' x $longest-val.chars + 2 * $bar-spaces)
	    ~ '+'
    	}

	return (
	  create-delimiter(),
          create-row('Metadata', 'Value'),
	  create-delimiter(),
	  @rows.map(-> $pair { create-row(|$pair) }).join("\n"),
	  create-delimiter()
  	).join: "\n";
    }
}

class Field {
    has $.name;
    has $.type;
    has $.length;
    has $.decimal-places;
}

class Fields {
    has $.handle;
    has $.header-length;

    has @.fields is built(False);

    method TWEAK {
	self!read-fields;
    }

    method !read-fields {
	constant $FIELD-OFFSET = 32;
	my $FIELD-TERMINATOR = 0x0D;
	my $HEADER-BYTES = 32;
	my $FIELD-BYTES = 32;
	
	# determine number of total bytes in field descriptor array.
	my $TOTAL-FIELD-BYTES = $!header-length - $HEADER-BYTES - 1;
	# determine number of fields.
	my $FIELDS-COUNT = $TOTAL-FIELD-BYTES / $FIELD-BYTES;
	# grab all fields bytes from handle (it moves the file pointer).
	my $fields = $!handle.read($TOTAL-FIELD-BYTES);
	
	# grab the field terminator. If not the field terminator, then we don't
	# have the rigth number of bytes for all fields.
	my $field-terminator = $!handle.read(1);
	unless $field-terminator[0] == $FIELD-TERMINATOR {
	    die 'Wrong number of bytes for fields'
	}

	loop (my $i = 0; $i < $FIELDS-COUNT; $i++) {
	    my $field = $fields.subbuf($FIELD-BYTES * $i, $FIELD-BYTES);
	    
	    my $name = $field.subbuf(0, 10).decode('ascii').subst(/\x[00]+/, '');
	    my $type = $field.subbuf(11, 1).decode('ascii');
	    my $length = $field[16];
	    my $decimal-places = $field[17];
	    
	    @!fields.push: Field.new(:$name, :$type, :$length, :$decimal-places);
	}
    }
}

class DBF {
    has Str $.path;

    has $.header is built(False);
    has $.fields is built(False);

    submethod TWEAK {
	my $handle = $!path.IO.open(:r, :bin);
	
	$!header = Header.new: :$handle;
	my $header-length = $!header.header-length;

	$!fields = Fields.new: :$handle, :$header-length;
    }
}

# USAGE
my $path = './world-njs.dbf';
my $dbf = DBF.new: :$path;
say $dbf.header;
say $dbf.fields.fields;