#!/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;
