#!perl
# http://www.nicholson.com/rhn/pilot/pdb.txt  says:
#      #define dmDBNameLength    32/* 31 chars + 1 null terminator */
# 
#      struct pdb_header {       /* 78 bytes total */
# 	    char   name[ dmDBNameLength ];
# 	    DWord  attributes;
# 	    Word   version;
# 	    DWord  create_time;
# 	    DWord  modify_time;
# 	    DWord  backup_time;
# 	    DWord  modificationNumber;
# 	    DWord  appInfoID;
# 	    DWord  sortInfoID;
# 	    char   type[4];
# 	    char   creator[4];
# 	    DWord  id_seed;
# 	    DWord  nextRecordList;
# 	    Word   numRecords;
#      };
# 
#      struct pdb_rec_header {   /* 8 bytes total */
# 	    DWord  offset;
# 	    struct {
# 		   int delete    : 1;
# 		   int dirty     : 1;
# 		   int busy      : 1;
# 		   int secret    : 1;
# 		   int category  : 4;
# 	    }      attributes;
# 	    char   uniqueID[3];
#      }
#
# pdb_header::attributes is actually a Word, not a DWord, though.

$pdb_header = "a32 n n N N N N N N a4 a4 N N n";
$pdb_rec_header = "N C a3";

$sz_pdb_header = length pack $pdb_header;
$sz_pdb_rec_header = length pack $pdb_rec_header;

if ($debug) {
print "sz_pdb_header: $sz_pdb_header\n";
print "sz_pdb_rec_header: $sz_pdb_rec_header\n";
}
$fn = shift;
$output_type = shift;
$output_type = "raw" if not defined $output_type;
{
    open(PDB,"<$fn");
    local $/;
    $/ = undef;
    $pdbh = <PDB>;
    close(PDB);
}

($name,
 $attributes,
 $version,
 $create_time,
 $modify_time,
 $backup_time,
 $modificationNumber,
 $appInfoID,
 $sortInfoID,
 $type,
 $creator,
 $id_seed,
 $nextRecordList,
 $numRecords) = unpack $pdb_header,$pdbh;
 
if ($debug) {
print "name: $name\n";
print "attributes: $attributes\n";
print "version: $version\n";
print "create_time: $create_time\n";
print "modify_time: $modify_time\n";
print "backup_time: $backup_time\n";
print "modificationNumber: $modificationNumber\n";
print "appInfoID: $appInfoID\n";
print "sortInfoID: $sortInfoID\n";
print "type: $type\n";
print "creator: $creator\n";
print "id_seed: $id_seed\n";
print "nextRecordList: $nextRecordList\n";
print "numRecords: $numRecords\n";
}

if ($output_type eq "xml") {
    print "<scandb>\n";
} elsif ($output_type eq "html") {
    print "<table>\n";
    print "<tr><th>Tag</th><th>Scan</th><th>Unix Time</th><th>Scan Type</th><th>Shelf #</th></tr>\n";
}

for $i (0..$numRecords-1) {
    ($rh_offset[$i], $rh_attributes[$i], $rh_uniqueID[$i]) =
	unpack "x".($sz_pdb_header + $i * $sz_pdb_rec_header).$pdb_rec_header,
	$pdbh;

if ($debug) {
    print "rh_offset[$i]: $rh_offset[$i]\n";
    print "rh_attributes[$i]: $rh_attributes[$i]\n";
    print "rh_uniqueID[$i]: $rh_uniqueID[$i]\n";
}
    ($scan_ts[$i]) = unpack "x".$rh_offset[$i]."N", $pdbh;
    ($scan_tag[$i], $scan_scan[$i], $scan_type[$i], $scan_shelfno[$i]) =
	(unpack "x".$rh_offset[$i]."x4 a*", $pdbh) =~ m/(.*?)\0(.*?)\0(.)(.)/;
if ($debug) {
    print "scan_ts[$i]: $scan_ts[$i]\n";
    print "scan_tag[$i]: $scan_tag[$i]\n";
    print "scan_scan[$i]: $scan_scan[$i]\n";
    print "scan_type[$i]: $scan_type[$i]\n";
    print "scan_shelfno[$i]: $scan_shelfno[$i]\n";
}
    # (- 1970 1904)(/ 66.0 4)16.5
    # (+ (* 365 66) 16)24106
    # (* 86400.0 24106)2082758400.0
    $scan_unix_ts[$i] = $scan_ts[$i] - 2082758400;
    $scan_type[$i] = ord($scan_type[$i]); # but convert to tags too...
    $scan_shelfno[$i] = ord($scan_shelfno[$i]);

    if ($output_type eq "xml") {
	print "<scanrec>\n";
	print "<scantag>$scan_tag[$i]</scantag>\n";
	print "<scanscan>$scan_scan[$i]</scanscan>\n";
	print "<scantime>$scan_unix_ts[$i]</scantime>\n";
	print "<scantype>$scan_type[$i]</scantype>\n";
	print "<scanshelf>$scan_shelfno[$i]</scanshelf>\n";
	print "</scanrec>\n";
    } elsif ($output_type eq "html") {
	print "<tr>\n";
	print "<td>$scan_tag[$i]</td>\n";
	print "<td>$scan_scan[$i]</td>\n";
	print "<td>$scan_unix_ts[$i]</td>\n";
	print "<td>$scan_type[$i]</td>\n";
	print "<td>$scan_shelfno[$i]</td>\n";
	print "</tr>\n";
    } elsif ($output_type eq "raw") {
	print qq{$scan_unix_ts[$i], "$scan_tag[$i]", "$scan_scan[$i]", "$scan_type[$i]", "$scan_shelfno[$i]"\n};
    }
}

if ($output_type eq "xml") {
    print "</scandb>\n";
} elsif ($output_type eq "html") {
    print "</table>\n";
}