home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
linuxmafia.com 2016
/
linuxmafia.com.tar
/
linuxmafia.com
/
pub
/
palmos
/
bart-1.3b2.tar.gz
/
bart-1.3b2.tar
/
bart-1.3b2
/
data
/
make-pdb-file
< prev
next >
Wrap
Text File
|
2000-01-12
|
28KB
|
921 lines
#!/usr/bin/perl -w
# Perl script to generate pdb file containing information, schedules,
# and fares from various text files.
# Copyright (c) 1999, 2000 Michael Wittman
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
# OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
use strict;
my $pdb_file = "bartdata.pdb";
my $header_file = "bartdata.h";
# the following line sets $data_dir to the directory that this script is in
my $data_dir = ($0 =~ m@^(?:(.*)/)?[^/]+$@)[0] || ".";
my $stations_file = "$data_dir/stations";
my $transfers_file = "$data_dir/transfers";
my $fares_file = "$data_dir/fares";
my $bike_names_file = "$data_dir/bike-names";
my $station_bike_restrictions_file = "$data_dir/bike-restrictions";
my $sched_dir = "$data_dir/schedules";
my (@days) = ("weekday", "saturday", "sunday");
my (@station_abbrevs);
my (%station_name,%station_number,%pilot_abbrev);
my (%transfers);
my (%fare);
my (%bike_name);
my (%station_bike_restrictions);
my (@weekday_lines,@saturday_lines,@sunday_lines,@weekday_scheds,@saturday_scheds,@sunday_scheds);
$| = 1;
# pdb file constants
my $PDB_HEADER_SIZE = 78;
my $RECORD_LIST_STRUCTURE_SIZE = 8;
# time_t value of db creation date; the corresponding date is displayed in
# the "About" form so users know how current their database is.
my $CREATION_DATE = `date -d "12:00pm 11/3/99" +%s`+0;
# use these two now to possibly save bits later if the fare range
# becomes greater
# number by which to multply the encoded fares to get the actual fares
my $FARE_MULTIPLIER = 0.05;
# minimum fare
my $MIN_FARE = 1.10;
# schedule days end at 2:30 AM
my $DAY_END_TIME = 150;
my $CREATOR_ID = "BART";
my $DB_ID = "DATA";
my $DB_NAME = "BART SchedulerDB";
my $DB_VERSION = 2;
my $GENERAL_CATEGORY = 0;
my $WEEKDAY_CATEGORY = 1;
my $SATURDAY_CATEGORY = 2;
my $SUNDAY_CATEGORY = 3;
# don't exhibit general category to user
my (@CATEGORY_NAMES) = ("Weekday","Saturday","Sunday");
my $INFO_RECORD_NUMBER = 0;
my $FARES_RECORD_NUMBER = 1;
my $TRANSFER_RECORD_NUMBER = 2;
my $INITIAL_LINE_RECORD_NUMBER = 8;
sub max {
my $max = shift;
local($_);
for (@_) { $max = $_ if $max < $_; }
$max;
}
sub min {
my $min = shift;
local($_);
for (@_) { $min = $_ if $min > $_; }
$min;
}
sub sum {
my $sum = 0;
local($_);
for (@_) { $sum += $_; }
$sum;
}
sub print_header_file {
my $file = shift;
my $oldfh;
open(HEADER_FILE,"> $file") || die "can't open header file: $file\n";
$oldfh = select HEADER_FILE;
print "/* This file automatically generated by $0 */\n\n";
print "#define DB_ID '$DB_ID'\n";
print "#define DB_VERSION $DB_VERSION\n\n";
print "#define GENERAL_CATEGORY $GENERAL_CATEGORY\n\n";
print "#define INFO_RECORD_NUMBER $INFO_RECORD_NUMBER\n";
print "#define FARES_RECORD_NUMBER $FARES_RECORD_NUMBER\n";
print "#define TRANSFER_RECORD_NUMBER $TRANSFER_RECORD_NUMBER\n";
print "#define INITIAL_LINE_RECORD_NUMBER $INITIAL_LINE_RECORD_NUMBER\n";
close(HEADER_FILE);
select $oldfh;
}
sub read_stations {
my ($file,$station_abbrevs_ref,$station_name_ref,$station_number_ref,$pilot_abbrev_ref) = @_;
my (@station_abbrevs,%station_name,%station_number,%pilot_abbrev);
my (%station_abbrev);
local($_);
open(FILE,$file) || die "can't open file $file\n";
while (defined ($_ = <FILE>)) {
chomp;
my ($abbrev,$pabbrev,$name) = split /\t/, $_;
$station_name{$abbrev} = $name;
$station_abbrev{$name} = $abbrev;
$pilot_abbrev{$abbrev} = $pabbrev;
push @station_abbrevs, $abbrev;
$station_number{$abbrev} = $#station_abbrevs;
}
close(FILE);
@$station_abbrevs_ref = @station_abbrevs;
%$station_name_ref = %station_name;
%$pilot_abbrev_ref = %pilot_abbrev;
%$station_number_ref = %station_number;
}
sub read_transfers {
my $file = shift;
my (%transfer);
local($_);
local($/) = "";
open(FILE,$file) || die "can't open file $file\n";
while (defined ($_ = <FILE>)) {
my ($line, @stations) = split /\n/, $_;
$line =~ s/^\s*(\S+)\s*:\s*$/$1/;
$transfer{$line} = {};
my $station_info;
for $station_info (@stations) {
my ($station,@lines) = split ' ', $station_info;
my (@line,@time);
my $i;
for $i (@lines) {
my ($transfer_line,$transfer_time) = ($i =~ /^(\S+?)(?::(\d+))?$/);
push @line, $transfer_line;
$transfer_time = 0 unless defined $transfer_time;
push @time, $transfer_time;
}
$transfer{$line}{$station} = {"line" => [@line], "time" => [@time]};
}
}
close(FILE);
%transfer;
}
sub read_fares {
my ($file,$station_abbrevs_ref) = @_;
my (%station_exists,%fare);
my (@fare_stations,@fare_fares);
local($_);
%station_exists = map +($_,1), @$station_abbrevs_ref;
open(FILE,$file) || die "can't open file $file\n";
while (defined ($_ = <FILE>)) {
my (@temp,$station);
chomp;
@temp = split ' ', $_;
$station = shift @temp;
die "bad station name: $station in $file\n"
unless $station_exists{$station};
push @fare_stations, $station;
push @fare_fares, [@temp];
}
close(FILE);
my ($i,$j);
for ($i = 0; $i < @fare_stations; $i++) {
for ($j = 0; $j < @{$fare_fares[$i]}; $j++) {
$fare{$fare_stations[$i],$fare_stations[$i+$j]} = $fare_fares[$i][$j];
$fare{$fare_stations[$i+$j],$fare_stations[$i]} = $fare_fares[$i][$j];
}
}
%fare;
}
sub read_bike_names {
my ($file) = shift;
my (%bike_name);
local($_);
open(FILE,$file) || die "can't open file $file\n";
while (defined ($_ = <FILE>)) {
chomp;
my ($bike_name,$abbrev) = split ' ', $_;
$bike_name{$bike_name} = $abbrev;
}
close(FILE);
%bike_name;
}
sub read_station_bike_restrictions {
my ($file) = shift;
my ($day);
my (%restrictions);
local($_);
for (@days) {
$restrictions{$_} = {};
}
open(FILE,$file) || die "can't open file $file\n";
while (defined ($_ = <FILE>)) {
chomp;
if (/^\s*(\S+)\s*:\s*$/) {
$day = $1;
}
elsif (!/^\s*\#?\s*$/) {
die "syntax error in file: $file\n" unless defined $day;
my ($station,@times) = split ' ', $_;
$restrictions{$day}->{$station} = [map &time_to_int($_), @times];
}
}
close(FILE);
%restrictions;
}
sub ls_dir {
my $dir = shift;
my @temp;
opendir(LS_DIR,$dir);
@temp = grep !/(\.|\.\.)/, readdir(LS_DIR);
closedir(LS_DIR);
@temp;
}
sub line_cmp {
my ($a1,$a2) = ($a =~ /^(\w+)-(\w+)$/);
my ($b1,$b2) = ($b =~ /^(\w+)-(\w+)$/);
my ($a3,$a4,$b3,$b4) = ($a1,$a2,$b1,$b2);
if ($a1 le $a2) {
$a3 = $a2; $a4 = $a1;
}
if ($b1 le $b2) {
$b3 = $b2; $b4 = $b1;
}
"$a3-$a4" eq "$b3-$b4" ? $a cmp $b : "$a3-$a4" cmp "$b3-$b4";
}
# Gets a reference to an ordered list of lines in an associative array
# for each day. Common lines appear first. Assumes that weekday lines
# == saturday lines and sunday lines are a subset of both.
sub get_lines {
my ($weekday_lines,$saturday_lines,$sunday_lines) = @_;
my (%recorded,@extra);
local($_);
@$weekday_lines = &ls_dir("$sched_dir/weekday");
@$saturday_lines = &ls_dir("$sched_dir/saturday");
@$sunday_lines = &ls_dir("$sched_dir/sunday");
# order lines to get common (sunday) lines first
@$sunday_lines = sort line_cmp @$sunday_lines;
%recorded = map +($_,1), @$sunday_lines;
for (@$weekday_lines) {
push @extra, $_ unless $recorded{$_};
}
@$weekday_lines = (@$sunday_lines, sort line_cmp @extra);
@$saturday_lines = (@$sunday_lines, sort line_cmp @extra);
}
sub time_to_int {
local($_) = shift;
my ($int);
if (/^--$/) {
$int = -1;
}
else {
my ($hour,$min,$ap) = /^(\d\d?):(\d\d)([ap])$/;
die "don't understand time specification: $_\n" unless defined $ap;
$hour = 0 if $hour == 12;
$int = ($hour + ($ap eq "a" ? 0 : 12))*60 + $min;
$int += 24*60 if $int < $DAY_END_TIME;
}
$int;
}
# sets the three sched variables to 3d arrays of [line][train][time]. entries
# for train == 0 are station abbrevs
sub get_schedules {
my ($weekday_lines,$saturday_lines,$sunday_lines,$weekday_scheds,$saturday_scheds,$sunday_scheds,$bike_name) = @_;
my (@day_line) = ($weekday_lines,$saturday_lines,$sunday_lines);
my (@day_sched) = ($weekday_scheds,$saturday_scheds,$sunday_scheds);
my (%recorded,@extra);
my (%station_idx);
my ($i,$j);
local($_);
for ($i = 0; $i < @days; $i++) {
my ($lines,$scheds,$day) = ($day_line[$i],$day_sched[$i],$days[$i]);
my ($line);
print STDOUT " $days[$i]:";
for $line (@$lines) {
my ($sched) = [];
print STDOUT " $line";
open(FILE,"$sched_dir/$day/$line")
|| die "can't open file $sched_dir/$day/$line\n";
my $header = <FILE>;
$header =~ s/BIKES NOT ALLOWED BETWEEN//;
my @stations = split ' ', $header;
for ($j = 0; $j < @stations; $j++) {
$station_idx{$stations[$j]} = $j;
}
push @$sched, [@stations];
while (defined ($_ = <FILE>)) {
my (@fields) = split ' ', $_;
my (@times) = grep /^(\d?\d:\d\d[ap]|--)$/, @fields;
my (@nobikesbtw) = grep !/^(\d?\d:\d\d[ap]|--)$/, @fields;
# correct for different station abbrev between bike name and abbrev
my $station;
for $station (@nobikesbtw) {
if (!defined $station_idx{$station} && !exists $$bike_name{$station}) {
die "I don't know what station $station is. Please add it to $bike_names_file\n";
}
else {
$station = $$bike_name{$station}
if exists $$bike_name{$station};
}
$station = $station_idx{$station};
}
# add "no stop" indicators for -- left off at end of line
while (@times < @stations) { push @times, '--'; }
push @$sched, [map(&time_to_int($_),@times), @nobikesbtw];
}
close(FILE);
push @$scheds, $sched;
}
print STDOUT "\n";
}
}
sub first_valid_elt {
my $i;
for ($i = 0; $i < @_; $i++) {
return $_[$i]
if ($_[$i] != -1);
}
}
sub get_inc_vector {
my ($first_time) = &first_valid_elt(@_);
local($_);
map +($_ == -1 ? -1 : $_-$first_time), @_;
}
sub vector_eq {
my ($vec1_ref,$vec2_ref) = @_;
my ($i);
warn "vectors are different lengths!\n"
unless @$vec1_ref == @$vec2_ref;
for ($i = 0; $i < @$vec1_ref; $i++) {
return 0 if $$vec1_ref[$i] != $$vec2_ref[$i];
}
1;
}
sub match_vector {
my ($newvec_ref, @vec_refs) = @_;
my ($i);
for ($i = 0; $i < @vec_refs; $i++) {
return $i
if &vector_eq($newvec_ref,$vec_refs[$i]);
}
$i;
}
sub gen_line_schedule {
my ($line_sched_ref,$station_number_ref) = @_;
my (@inc_vectors,@nobikes_pairs);
my (@train_vector,@time_diff,@train_bikepair);
my ($vec_ref,$pair_ref);
my ($buf);
my ($compress_level) = 2; # BART Scheduler expects level 2
my $i;
my $stations = @{$$line_sched_ref[0]};
# only needed for debugging
my $line = $$line_sched_ref[0][0]." to ".
$$line_sched_ref[0][$#{$$line_sched_ref[0]}];
# find increment vector for each train; insert into @inc_vectors if unique
for ($i = 1; $i < @$line_sched_ref; $i++) {
my @vec = &get_inc_vector(@{$$line_sched_ref[$i]}[0..$stations-1]);
my @pair;
my $iv_loc = &match_vector(\@vec,@inc_vectors);
my $nb_loc = 0xff; # "none" value
my $time_diff =
&first_valid_elt(@{$$line_sched_ref[$i]})
- &first_valid_elt(@{$$line_sched_ref[max($i-1,1)]});
# handle bike restrictions on this train if there are any
if (@{$$line_sched_ref[$i]} > $stations) {
@pair = @{$$line_sched_ref[$i]}[$stations,$stations+1];
$nb_loc = &match_vector(\@pair,@nobikes_pairs);
push @nobikes_pairs, \@pair
if $nb_loc > $#nobikes_pairs;
}
push @inc_vectors, \@vec
if $iv_loc > $#inc_vectors;
push @train_vector, $iv_loc;
push @train_bikepair, $nb_loc;
push @time_diff, $time_diff;
}
printf STDOUT " %2d trains", scalar(@train_vector);
printf STDOUT " %2d iv", scalar(@inc_vectors);
printf STDOUT " %2d bp", scalar(@nobikes_pairs);
$buf .= pack("C",scalar(@inc_vectors)); # number of increment vectors
# print STDOUT "$line line: ", scalar(@inc_vectors), " inc. vectors\n";
for $vec_ref (@inc_vectors) {
my $elt;
for $elt (@$vec_ref) {
$buf .= pack("C",($elt == -1 ? 0xff : $elt)); # -1 becomes 255
}
die "vector is wrong size (", scalar(@$vec_ref), " vs. ", $stations,
") in line ", $$line_sched_ref[0][0], " to ",
$$line_sched_ref[0][$#{$$line_sched_ref[0]}], "!\n"
unless @$vec_ref == $stations;
}
$buf .= pack("C",scalar(@nobikes_pairs)); # number of bike restriction pairs
for $pair_ref (@nobikes_pairs) {
my $elt;
for $elt (@$pair_ref) {
$buf .= pack("C",$elt);
}
}
# first valid time of first train (alignment of this value not guaranteed!)
$buf .= pack("n",&first_valid_elt(@{$$line_sched_ref[1]}));
# put the train blocks in a buffer so we can count them and print the
# number of blocks to the pdb file before the blocks themselves
my $blocks_buffer = "";
my $blocks = 0;
if ($compress_level == 0) {
for ($i = 0; $i < @train_vector; $i++) {
$blocks_buffer .= pack("N",$$line_sched_ref[$i+1][0]);
# this row's increment vector
$blocks_buffer .= pack("C",$train_vector[$i]);
# we use 0xff to mark no restrictions
$blocks_buffer .= pack("C",$train_bikepair[$i]);
$blocks++;
}
}
elsif ($compress_level == 1) {
for ($i = 0; $i < @train_vector; $i++) {
# use signed char since trains may not start at the same station
die "time_diff out of range!\n"
if $time_diff[$i] < -128 || $time_diff[$i] > 127;
$blocks_buffer .= pack("c",$time_diff[$i]);
# this row's increment vector
$blocks_buffer .= pack("C",$train_vector[$i]);
# we use 0xff to mark no restrictions
$blocks_buffer .= pack("C",$train_bikepair[$i]);
$blocks++;
}
}
elsif ($compress_level == 2) {
$i = 0;
while ($i < @time_diff) {
my $j = $i+1;
while ($j < @time_diff &&
$time_diff[$j] == $time_diff[$i] &&
$train_vector[$j] == $train_vector[$i] &&
$train_bikepair[$j] == $train_bikepair[$i]) {
$j++;
}
# number of repetitions of same time diff and train vector
$blocks_buffer .= pack("C",$j-$i);
# time difference from first valid entry of last row (or zero if this
# is the first row)
die "time_diff out of range!\n"
if $time_diff[$i] < -128 || $time_diff[$i] > 127;
$blocks_buffer .= pack("c",$time_diff[$i]);
# this row's increment vector
$blocks_buffer .= pack("C",$train_vector[$i]);
# we use 0xff to mark no restrictions
$blocks_buffer .= pack("C",$train_bikepair[$i]);
$blocks++;
$i = $j;
}
}
printf STDOUT " %2d blocks", $blocks;
$buf .= pack("C",$blocks); # number of train blocks
$buf .= $blocks_buffer;
$buf;
}
sub gen_line_info {
my ($initial_record_number,$station_number_ref,$lines_ref,$scheds_ref,$restrictions_ref) = @_;
my (%station_number) = %$station_number_ref;
my (@lines) = @$lines_ref;
my (@scheds) = @$scheds_ref;
my (%restrictions) = %$restrictions_ref;
my ($line);
my (@bufs,$buf);
my (@record_lengths);
$buf .= pack("C",$INFO_RECORD_NUMBER); # info record for this category
$buf .= pack("C",scalar(@lines)); # number of lines in this category
$buf .= pack("C",&sum(map +(scalar @$_)/2, values %restrictions));
$buf .= pack("x"); # null byte for alignment
my ($key,$i);
for $key (sort {$station_number{$a} <=> $station_number{$b}} keys %restrictions) {
my @array = @{$restrictions{$key}};
for ($i = 0; $i < @array; $i += 2) {
$buf .= pack("C",$station_number{$key});
$buf .= pack("x"); # null byte for alignment
$buf .= pack("nn",@array[$i,$i+1]);
}
}
push @bufs, $buf;
$buf = "";
for ($line = 0; $line < @lines; $line++) {
my $station;
$buf .= pack("C",$initial_record_number+$line); # number of this record
# number of stations on this line
$buf .= pack("C",scalar(@{$scheds[$line][0]}));
for $station (@{$scheds[$line][0]}) {
$buf .= pack("C",$station_number{$station});
}
print STDOUT " line $line ($lines[$line])\t", scalar(@{$scheds[$line][0]}), " stations";
$buf .= &gen_line_schedule($scheds[$line],$station_number_ref);
print STDOUT "\n";
push @bufs, $buf;
$buf = "";
}
@bufs;
}
# prints station names/abbrev's and category names to a record
sub gen_general_info {
my ($category_names_ref,$station_abbrevs_ref,$station_name_ref,$pilot_abbrev_ref) = @_;
my (@category_names) = @$category_names_ref;
my (@station_abbrevs) = @$station_abbrevs_ref;
my (%station_name) = %$station_name_ref;
my (%pilot_abbrev) = %$pilot_abbrev_ref;
my (%station_abbrev);
my ($buf);
local($_);
for (keys %station_name) {
$station_abbrev{$station_name{$_}} = $_;
}
$buf .= pack("C",$INFO_RECORD_NUMBER); # number of this record
$buf .= pack("x3"); # 3 null bytes for alignment
# creation date of the database; displayed in the "About" form
$buf .= pack("N",&unix_to_pilot_date($CREATION_DATE));
# time at which one day's schedule ends and another's begins. times are
# represented as the number of minutes since 12am on the first day of the
# schedule
$buf .= pack("n",$DAY_END_TIME);
$buf .= pack("C",scalar(@category_names)); # number of categories
for (@category_names) {
$buf .= pack("a*",$_."\0");
}
$buf .= pack("C",scalar(keys %station_name)); # number of stations
# station names
for (map $station_name{$_}, @station_abbrevs) {
$buf .= pack("a*",$_."\0");
}
# station abbreviations for the pilot
for (map $pilot_abbrev{$_}, @station_abbrevs) {
$buf .= pack("a*",$_."\0");
}
$buf;
}
sub gen_fares_info {
my ($station_abbrevs_ref,$fare_ref) = @_;
my (@stations) = @$station_abbrevs_ref;
my (%fare) = %$fare_ref;
my ($buf);
my ($i,$j);
$buf .= pack("C",$FARES_RECORD_NUMBER); # number of this record
$buf .= pack("C",int($FARE_MULTIPLIER*100+.5)); # in cents
# in multiples of the multiplier
$buf .= pack("C",int($MIN_FARE/$FARE_MULTIPLIER+.5));
for ($i = 0; $i < @stations; $i++) {
for ($j = $i; $j < @stations; $j++) {
# (fare-$MIN_FARE)/$FARE_MULTIPLIER for a trip in either direction
# between these two stations
$buf .= pack("C",int(($fare{$stations[$i],$stations[$j]}-$MIN_FARE)/$FARE_MULTIPLIER+.5));
}
}
$buf;
}
sub gen_transfer_info {
my ($transfers_ref,$weekday_lines_ref,$station_number_ref) = @_;
my (%transfers) = %$transfers_ref;
my (@weekday_lines) = @$weekday_lines_ref;
my (%station_number) = %$station_number_ref;
my (%line_number);
my ($buf);
my ($i);
local($_);
for ($i = 0; $i < @weekday_lines; $i++) {
$line_number{$weekday_lines[$i]} = $i;
}
$buf .= pack("C",$TRANSFER_RECORD_NUMBER); # number of this record
$buf .= pack("C",scalar(keys %transfers)); # number of lines with transfers
for ($i = 0; $i < @weekday_lines; $i++) {
my $line = $weekday_lines[$i];
if (exists $transfers{$line}) {
# line number
$buf .= pack ("C",$i);
# number of (station, line) transfer pairs on this line
$buf .= pack ("C",&sum(map scalar(@{$transfers{$line}{$_}{"line"}}), keys %{$transfers{$line}}));
my $station;
for $station (keys %{$transfers{$line}}) {
my $j;
my (%line_info) = %{$transfers{$line}{$station}};
for ($j = 0; $j < @{$line_info{"line"}}; $j++) {
# (station, line) pair
$buf .= pack ("C",$station_number{$station});
$buf .= pack ("C",$line_number{${$line_info{"line"}}[$j]});
$buf .= pack ("n",${$line_info{"time"}}[$j]);
}
}
}
}
$buf;
}
sub unix_to_pilot_date {
my ($date) = shift;
my $pilot_time_delta = 2082844800;
$date + $pilot_time_delta;
}
sub gen_pdb_header {
my ($name,$version,$db_type,$creator_id,$appinfo_length,$records) = @_;
my $time = time;
my $attributes;
my $appinfo_offset;
my ($buf);
if ($appinfo_length == 0) {
$appinfo_offset = 0;
}
else {
$appinfo_offset = $PDB_HEADER_SIZE+$RECORD_LIST_STRUCTURE_SIZE*$records;
}
$buf .= pack("a32",$name);
$attributes = 0x0008 | # backup database
0x0010; # OK to install new version of DB over this one
$buf .= pack("n",$attributes);
$buf .= pack("n",$version);
$buf .= pack("N",&unix_to_pilot_date($time)); # creation date
$buf .= pack("N",&unix_to_pilot_date($time)); # modification date
$buf .= pack("N",0); # last backup date
$buf .= pack("N",0); # modification number
$buf .= pack("N",$appinfo_offset); # offset of AppInfoArea (0 == does not exist)
$buf .= pack("N",0); # offset of SortInfoArea (0 == does not exist)
$buf .= pack("A4",$db_type); # database type
$buf .= pack("A4",$creator_id); # creator id
$buf .= pack("N",0); # unique ID seed (set to zero)
$buf .= pack("N",0); # next record list ID (set to zero)
$buf .= pack("n",$records); # number of records
$buf;
}
sub gen_pdb_record_list {
my ($offset, $record_sizes_ref, $categories_ref) = @_;
my (@record_sizes) = @$record_sizes_ref;
my (@categories) = @$categories_ref;
my (@record_offsets);
my $attributes = 0; # leave all attributes unset
my ($buf);
my $i;
$record_offsets[0] = $offset;
for ($i = 1; $i < @record_sizes; $i++) {
$record_offsets[$i] = $record_offsets[$i-1] + $record_sizes[$i-1];
}
for ($i = 0; $i < @record_offsets; $i++) {
$buf .= pack("N",$record_offsets[$i]); # byte offset of record within file
$buf .= pack("C",$attributes | $categories[$i]); # record attributes and category value
$buf .= pack("C3",0,0,0); # unique ID (set to zero)
}
# number of bytes written
$buf;
}
# this is for testing purposes only; BART Scheduler does not use the
# appinfo area
sub gen_appinfo_area {
my (@category_names) = @_;
my ($appinfo_strings,$appinfo_strlen) = (16,16);
my ($pad) = 0;
my ($uniq_id) = 0;
my ($buf);
my $i;
my $rename_bits = unpack("S",pack("b16","1" x @category_names));
$buf .= pack("n",$rename_bits); # set a bit for each category name
for ($i = 0; $i < @category_names; $i++) {
$buf .= pack("a$appinfo_strlen",$category_names[$i]);
}
for (; $i < $appinfo_strings; $i++) {
$buf .= pack("a$appinfo_strlen","");
}
for ($i = 0; $i < $appinfo_strings; $i++) {
# $buf .= pack("C",($i < @category_names ? $uniq_id++ : 128));
$buf .= pack("C",$uniq_id++);
}
$buf .= pack("C",$uniq_id-1); # highest uniq_id
if ($pad) {
# pad to 512 bytes (due to bugs mentioned in PDB file format document)
$buf .= pack("x".(512-(length $buf)));
}
$buf;
}
# parse cmd line args
my $use_appinfo_area = 0;
if (@ARGV && $ARGV[0] =~ /^-a$/) {
$use_appinfo_area = 1;
}
# read data in here
print STDOUT "Reading stations...\n";
&read_stations($stations_file,\@station_abbrevs,\%station_name,\%station_number,\%pilot_abbrev);
print STDOUT "Reading transfers...\n";
%transfers = &read_transfers($transfers_file);
print STDOUT "Reading fares...\n";
%fare = &read_fares($fares_file,\@station_abbrevs);
print STDOUT "Reading bike names...\n";
%bike_name = &read_bike_names($bike_names_file);
print STDOUT "Reading station bike restrictions...\n";
%station_bike_restrictions = &read_station_bike_restrictions($station_bike_restrictions_file);
print STDOUT "Reading line names...\n";
&get_lines(\@weekday_lines,\@saturday_lines,\@sunday_lines);
print STDOUT "Reading schedules...\n";
&get_schedules(\@weekday_lines,\@saturday_lines,\@sunday_lines,
\@weekday_scheds,\@saturday_scheds,\@sunday_scheds,
\%bike_name);
my ($data_area_buf, @new_records);
my ($appinfo_length) = 0;
my (@record_lengths,@categories);
my $records = 0;
my (@lengths);
print STDOUT "Generating pdb file...\n";
if ($use_appinfo_area) {
print STDOUT " appinfo\n";
$data_area_buf .= &gen_appinfo_area(@CATEGORY_NAMES);
}
print STDOUT " general info\n";
@new_records = &gen_general_info(\@CATEGORY_NAMES,\@station_abbrevs,
\%station_name,\%pilot_abbrev);
$data_area_buf .= join '', @new_records;
push @record_lengths, map length, @new_records;
push @categories, ($GENERAL_CATEGORY) x @new_records;
$records += @new_records;
print STDOUT " fares\n";
@new_records = &gen_fares_info(\@station_abbrevs,\%fare);
$data_area_buf .= join '', @new_records;
push @record_lengths, map length, @new_records;
push @categories, ($GENERAL_CATEGORY) x @new_records;
$records += @new_records;
print STDOUT " transfers\n";
@new_records = &gen_transfer_info(\%transfers,\@weekday_lines,
\%station_number);
$data_area_buf .= join '', @new_records;
push @record_lengths, map length, @new_records;
push @categories, ($GENERAL_CATEGORY) x @new_records;
$records += @new_records;
print STDOUT " weekday schedules\n";
@new_records = &gen_line_info($INITIAL_LINE_RECORD_NUMBER,\%station_number,
\@weekday_lines,\@weekday_scheds,
$station_bike_restrictions{$days[0]});
$data_area_buf .= join '', @new_records;
push @record_lengths, map length, @new_records;
push @categories, ($WEEKDAY_CATEGORY) x @new_records;
$records += @new_records;
print STDOUT " saturday schedules\n";
@new_records = &gen_line_info($INITIAL_LINE_RECORD_NUMBER,\%station_number,
\@saturday_lines,\@saturday_scheds,
$station_bike_restrictions{$days[1]});
$data_area_buf .= join '', @new_records;
push @record_lengths, map length, @new_records;
push @categories, ($SATURDAY_CATEGORY) x @new_records;
$records += @new_records;
print STDOUT " sunday schedules\n";
@new_records = &gen_line_info($INITIAL_LINE_RECORD_NUMBER,\%station_number,
\@sunday_lines,\@sunday_scheds,
$station_bike_restrictions{$days[2]});
$data_area_buf .= join '', @new_records;
push @record_lengths, map length, @new_records;
push @categories, ($SUNDAY_CATEGORY) x @new_records;
$records += @new_records;
my ($pdb);
print STDOUT " header\n";
$pdb .= &gen_pdb_header($DB_NAME,$DB_VERSION,$DB_ID,$CREATOR_ID,
$appinfo_length,$records);
print STDOUT " record list\n";
# arguments are: offset (== start of records), record lengths, categories.
# +2 and following pack are for filler to ensure 4-byte alignment (seems
# to be necessary on Macs)
$pdb .= &gen_pdb_record_list($PDB_HEADER_SIZE+$RECORD_LIST_STRUCTURE_SIZE*$records+$appinfo_length+2,\@record_lengths,\@categories);
$pdb .= pack("xx");
$pdb .= $data_area_buf;
open(PDB_FILE,"> $pdb_file")
|| die "can't open file $pdb_file for writing!\n";
print PDB_FILE $pdb;
close(PDB_FILE);
&print_header_file($header_file);
exit 0;