bibliofile/parse_db.pl

   1 #!/usr/bin/perl -w
   2
   3 # Parses Bibliofile files.
   4 # Usage: parse_db.pl TITLE.DB
   5 # Works fine on TITLE.DB, but misses the boat on other files; probably different block sizes or something.
   6
   7 use strict;
   8 use POSIX;
   9
  10 $/ = undef;
  11
  12 my $startOfColumnTypes = 8;
  13 my $startOfRealData = 4096;
  14 my $blockSize = 4096;
  15 my $initialOffset = 6;
  16 my %dataTypes = (
  17   'A' => 'Text',
  18   'N' => 'Numeric',
  19   'S' => 'Integer'
  20 );
  21
  22 my $rowLength;
  23 my @fieldLengths;
  24 my @fieldNames;
  25 my @fieldTypes;
  26
  27 my $db = $ARGV[0];
  28 my $dbd = $db . "D";
  29
  30 open (DBD, $dbd);
  31
  32 while (<DBD>) {
  33
  34   my $data = $_;
  35
  36   $rowLength = ord(substr($data, 0, 1)) + (256 * (ord(substr($data, 1, 1))));
  37   #print STDERR "Row length: $rowLength\n";
  38
  39   my $numColumns = ord substr($data, 2, 1);
  40   #print STDERR "Columns:    $numColumns\n";
  41
  42   my $namedata = substr($data, $startOfColumnTypes + ($numColumns * 7) - 2);
  43   @fieldNames = split(/\x00/, $namedata);
  44
  45   for (my $i = 0; $i < $numColumns; $i++) {
  46     $fieldTypes[$i] = substr($data, ($i * 7) + $startOfColumnTypes, 1);
  47     $fieldLengths[$i] = ord substr($data, ($i * 7) + $startOfColumnTypes + 1, 1);
  48   }
  49
  50 }
  51
  52 close(DBD);
  53
  54 print join("\t", @fieldNames) . "\n";
  55
  56 open (DB, $db);
  57
  58 my $blocks = 0;
  59
  60 while (read DB, my $data, $blockSize) {
  61   $blocks++;
  62   next if ($blocks == 1);
  63   my $maxRecords = POSIX::floor($blockSize / $rowLength);
  64   my $indexIndicator1 = ord substr($data, 1, 1);
  65   next if ($indexIndicator1 != 0);
  66   my $indexIndicator2 = ord substr($data, 7, 1);
  67   next if ($indexIndicator2 == 0);
  68
  69 #  for (my $i = 1; $i <= scalar(@fieldLengths); $i++) {
  70 #    print "Field $i has length $fieldLengths[$i-1]\n";
  71 #  }
  72
  73   for (my $r = 0; $r < $maxRecords; $r++) {
  74
  75     my $pos = 0;
  76     my @field;
  77
  78     #print STDERR "Record " . ($r+1) . " of $maxRecords\n";
  79
  80
  81     for (my $f = 0; $f < scalar(@fieldLengths); $f++) {
  82       $field[$f] = substr($data, $initialOffset + ($r * $rowLength) + $pos, $fieldLengths[$f]);
  83       if ($fieldTypes[$f] eq 'S') { $field[$f] = ord $field[$f]; }
  84       $pos += $fieldLengths[$f];
  85     }
  86
  87     if ($field[0] =~ m/[^\x00]/) {
  88       print join("\t", @field) . "\n";
  89       #print STDERR "Length: $pos\n";
  90     }
  91
  92   }
  93
  94 }
  95
  96 close(DB);