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 >
Text File  |  2000-01-12  |  28KB  |  921 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # Perl script to generate pdb file containing information, schedules,
  4. # and fares from various text files.
  5.  
  6. # Copyright (c) 1999, 2000 Michael Wittman
  7. # 
  8. # Permission is hereby granted, free of charge, to any person obtaining a
  9. # copy of this software and associated documentation files (the "Software"),
  10. # to deal in the Software without restriction, including without limitation
  11. # the rights to use, copy, modify, merge, publish, distribute, sublicense,
  12. # and/or sell copies of the Software, and to permit persons to whom the
  13. # Software is furnished to do so, subject to the following conditions:
  14. # 
  15. # The above copyright notice and this permission notice shall be included
  16. # in all copies or substantial portions of the Software.
  17. # 
  18. # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  19. # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  20. # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
  21. # THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
  22. # OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
  23. # ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  24. # OTHER DEALINGS IN THE SOFTWARE.
  25.  
  26. use strict;
  27.  
  28. my $pdb_file = "bartdata.pdb";
  29. my $header_file = "bartdata.h";
  30.  
  31. # the following line sets $data_dir to the directory that this script is in
  32. my $data_dir = ($0 =~ m@^(?:(.*)/)?[^/]+$@)[0] || ".";
  33. my $stations_file = "$data_dir/stations";
  34. my $transfers_file = "$data_dir/transfers";
  35. my $fares_file = "$data_dir/fares";
  36. my $bike_names_file = "$data_dir/bike-names";
  37. my $station_bike_restrictions_file = "$data_dir/bike-restrictions";
  38. my $sched_dir = "$data_dir/schedules";
  39. my (@days) = ("weekday", "saturday", "sunday");
  40.  
  41. my (@station_abbrevs);
  42. my (%station_name,%station_number,%pilot_abbrev);
  43. my (%transfers);
  44. my (%fare);
  45. my (%bike_name);
  46. my (%station_bike_restrictions);
  47. my (@weekday_lines,@saturday_lines,@sunday_lines,@weekday_scheds,@saturday_scheds,@sunday_scheds);
  48.  
  49. $| = 1;
  50.  
  51. # pdb file constants
  52. my $PDB_HEADER_SIZE = 78;
  53. my $RECORD_LIST_STRUCTURE_SIZE = 8;
  54.  
  55. # time_t value of db creation date; the corresponding date is displayed in
  56. # the "About" form so users know how current their database is.
  57. my $CREATION_DATE = `date -d "12:00pm 11/3/99" +%s`+0;
  58.  
  59. # use these two now to possibly save bits later if the fare range
  60. # becomes greater
  61.  
  62. # number by which to multply the encoded fares to get the actual fares
  63. my $FARE_MULTIPLIER = 0.05;
  64. # minimum fare
  65. my $MIN_FARE = 1.10;
  66.  
  67. # schedule days end at 2:30 AM
  68. my $DAY_END_TIME = 150;
  69.  
  70. my $CREATOR_ID = "BART";
  71. my $DB_ID = "DATA";
  72. my $DB_NAME = "BART SchedulerDB";
  73. my $DB_VERSION = 2;
  74.  
  75. my $GENERAL_CATEGORY = 0;
  76. my $WEEKDAY_CATEGORY = 1;
  77. my $SATURDAY_CATEGORY = 2;
  78. my $SUNDAY_CATEGORY = 3;
  79. # don't exhibit general category to user
  80. my (@CATEGORY_NAMES) = ("Weekday","Saturday","Sunday");
  81.  
  82. my $INFO_RECORD_NUMBER = 0;
  83. my $FARES_RECORD_NUMBER = 1;
  84. my $TRANSFER_RECORD_NUMBER = 2;
  85. my $INITIAL_LINE_RECORD_NUMBER = 8;
  86.  
  87.  
  88. sub max {
  89.    my $max = shift;
  90.    local($_);
  91.    for (@_) { $max = $_ if $max < $_; }
  92.    $max;
  93. }
  94.  
  95. sub min {
  96.    my $min = shift;
  97.    local($_);
  98.    for (@_) { $min = $_ if $min > $_; }
  99.    $min;
  100. }
  101.  
  102. sub sum {
  103.    my $sum = 0;
  104.    local($_);
  105.    for (@_) { $sum += $_; }
  106.    $sum;
  107. }
  108.  
  109. sub print_header_file {
  110.    my $file = shift;
  111.    my $oldfh;
  112.  
  113.    open(HEADER_FILE,"> $file") || die "can't open header file: $file\n";
  114.    $oldfh = select HEADER_FILE;
  115.    print "/* This file automatically generated by $0 */\n\n";
  116.    print "#define DB_ID                      '$DB_ID'\n";
  117.    print "#define DB_VERSION                 $DB_VERSION\n\n";
  118.    print "#define GENERAL_CATEGORY           $GENERAL_CATEGORY\n\n";
  119.    print "#define INFO_RECORD_NUMBER         $INFO_RECORD_NUMBER\n";
  120.    print "#define FARES_RECORD_NUMBER        $FARES_RECORD_NUMBER\n";
  121.    print "#define TRANSFER_RECORD_NUMBER     $TRANSFER_RECORD_NUMBER\n";
  122.    print "#define INITIAL_LINE_RECORD_NUMBER $INITIAL_LINE_RECORD_NUMBER\n";
  123.    close(HEADER_FILE);
  124.  
  125.    select $oldfh;
  126. }
  127.  
  128. sub read_stations {
  129.    my ($file,$station_abbrevs_ref,$station_name_ref,$station_number_ref,$pilot_abbrev_ref) = @_;
  130.    my (@station_abbrevs,%station_name,%station_number,%pilot_abbrev);
  131.    my (%station_abbrev);
  132.    local($_);
  133.  
  134.    open(FILE,$file) || die "can't open file $file\n";
  135.    while (defined ($_ = <FILE>)) {
  136.       chomp;
  137.       my ($abbrev,$pabbrev,$name) = split /\t/, $_;
  138.       $station_name{$abbrev} = $name;
  139.       $station_abbrev{$name} = $abbrev;
  140.       $pilot_abbrev{$abbrev} = $pabbrev;
  141.       push @station_abbrevs, $abbrev;
  142.       $station_number{$abbrev} = $#station_abbrevs;
  143.    }
  144.    close(FILE);
  145.  
  146.    @$station_abbrevs_ref = @station_abbrevs;
  147.    %$station_name_ref = %station_name;
  148.    %$pilot_abbrev_ref = %pilot_abbrev;
  149.    %$station_number_ref = %station_number;
  150. }
  151.  
  152. sub read_transfers {
  153.    my $file = shift;
  154.    my (%transfer);
  155.    local($_);
  156.    local($/) = "";
  157.  
  158.    open(FILE,$file) || die "can't open file $file\n";
  159.    while (defined ($_ = <FILE>)) {
  160.       my ($line, @stations) = split /\n/, $_;
  161.       $line =~ s/^\s*(\S+)\s*:\s*$/$1/;
  162.       $transfer{$line} = {};
  163.       my $station_info;
  164.       for $station_info (@stations) {
  165.      my ($station,@lines) = split ' ', $station_info;
  166.      my (@line,@time);
  167.      my $i;
  168.      for $i (@lines) {
  169.         my ($transfer_line,$transfer_time) = ($i =~ /^(\S+?)(?::(\d+))?$/);
  170.         push @line, $transfer_line;
  171.         $transfer_time = 0 unless defined $transfer_time;
  172.         push @time, $transfer_time;
  173.      }
  174.      $transfer{$line}{$station} = {"line" => [@line], "time" => [@time]};
  175.       }
  176.    }
  177.    close(FILE);
  178.  
  179.    %transfer;
  180. }
  181.  
  182. sub read_fares {
  183.    my ($file,$station_abbrevs_ref) = @_;
  184.    my (%station_exists,%fare);
  185.    my (@fare_stations,@fare_fares);
  186.    local($_);
  187.  
  188.    %station_exists = map +($_,1), @$station_abbrevs_ref;
  189.    
  190.    open(FILE,$file) || die "can't open file $file\n";
  191.    while (defined ($_ = <FILE>)) {
  192.       my (@temp,$station);
  193.       chomp;
  194.       @temp = split ' ', $_;
  195.       $station = shift @temp;
  196.       die "bad station name: $station in $file\n"
  197.     unless $station_exists{$station};
  198.       push @fare_stations, $station;
  199.       push @fare_fares, [@temp];
  200.    }
  201.    close(FILE);
  202.  
  203.    my ($i,$j);
  204.  
  205.    for ($i = 0; $i < @fare_stations; $i++) {
  206.       for ($j = 0; $j < @{$fare_fares[$i]}; $j++) {
  207.      $fare{$fare_stations[$i],$fare_stations[$i+$j]} = $fare_fares[$i][$j];
  208.      $fare{$fare_stations[$i+$j],$fare_stations[$i]} = $fare_fares[$i][$j];
  209.       }
  210.    }
  211.  
  212.    %fare;
  213. }
  214.  
  215. sub read_bike_names {
  216.    my ($file) = shift;
  217.    my (%bike_name);
  218.    local($_);
  219.  
  220.    open(FILE,$file) || die "can't open file $file\n";
  221.    while (defined ($_ = <FILE>)) {
  222.       chomp;
  223.       my ($bike_name,$abbrev) = split ' ', $_;
  224.       $bike_name{$bike_name} = $abbrev;
  225.    }
  226.    close(FILE);
  227.  
  228.    %bike_name;
  229. }
  230.  
  231. sub read_station_bike_restrictions {
  232.    my ($file) = shift;
  233.    my ($day);
  234.    my (%restrictions);
  235.    local($_);
  236.  
  237.    for (@days) {
  238.       $restrictions{$_} = {};
  239.    }
  240.    
  241.    open(FILE,$file) || die "can't open file $file\n";
  242.    while (defined ($_ = <FILE>)) {
  243.       chomp;
  244.  
  245.       if (/^\s*(\S+)\s*:\s*$/) {
  246.      $day = $1;
  247.       }
  248.       elsif (!/^\s*\#?\s*$/) {
  249.      die "syntax error in file: $file\n" unless defined $day;
  250.      my ($station,@times) = split ' ', $_;
  251.      $restrictions{$day}->{$station} = [map &time_to_int($_), @times];
  252.       }
  253.    }
  254.    close(FILE);
  255.  
  256.    %restrictions;
  257. }
  258.  
  259. sub ls_dir {
  260.    my $dir = shift;
  261.    my @temp;
  262.    opendir(LS_DIR,$dir);
  263.    @temp = grep !/(\.|\.\.)/, readdir(LS_DIR);
  264.    closedir(LS_DIR);
  265.  
  266.    @temp;
  267. }
  268.  
  269. sub line_cmp {
  270.    my ($a1,$a2) = ($a =~ /^(\w+)-(\w+)$/);
  271.    my ($b1,$b2) = ($b =~ /^(\w+)-(\w+)$/);
  272.    my ($a3,$a4,$b3,$b4) = ($a1,$a2,$b1,$b2);
  273.  
  274.    if ($a1 le $a2) {
  275.       $a3 = $a2; $a4 = $a1;
  276.    }
  277.    if ($b1 le $b2) {
  278.       $b3 = $b2; $b4 = $b1;
  279.    }
  280.    "$a3-$a4" eq "$b3-$b4" ? $a cmp $b : "$a3-$a4" cmp "$b3-$b4";
  281. }
  282.  
  283. # Gets a reference to an ordered list of lines in an associative array
  284. # for each day.  Common lines appear first.  Assumes that weekday lines
  285. # == saturday lines and sunday lines are a subset of both.
  286. sub get_lines {
  287.    my ($weekday_lines,$saturday_lines,$sunday_lines) = @_;
  288.    my (%recorded,@extra);
  289.    local($_);
  290.  
  291.    @$weekday_lines = &ls_dir("$sched_dir/weekday");
  292.    @$saturday_lines = &ls_dir("$sched_dir/saturday");
  293.    @$sunday_lines = &ls_dir("$sched_dir/sunday");
  294.  
  295.    # order lines to get common (sunday) lines first
  296.    @$sunday_lines = sort line_cmp @$sunday_lines;
  297.    %recorded = map +($_,1), @$sunday_lines;
  298.    for (@$weekday_lines) {
  299.       push @extra, $_ unless $recorded{$_};
  300.    }
  301.    @$weekday_lines = (@$sunday_lines, sort line_cmp @extra);
  302.    @$saturday_lines = (@$sunday_lines, sort line_cmp @extra);
  303. }
  304.  
  305. sub time_to_int {
  306.    local($_) = shift;
  307.    my ($int);
  308.  
  309.    if (/^--$/) {
  310.       $int = -1;
  311.    }
  312.    else {
  313.       my ($hour,$min,$ap) = /^(\d\d?):(\d\d)([ap])$/;
  314.       die "don't understand time specification: $_\n" unless defined $ap;
  315.  
  316.       $hour = 0 if $hour == 12;
  317.       $int = ($hour + ($ap eq "a" ? 0 : 12))*60 + $min;
  318.  
  319.       $int += 24*60 if $int < $DAY_END_TIME;
  320.    }
  321.  
  322.    $int;
  323. }
  324.  
  325. # sets the three sched variables to 3d arrays of [line][train][time].  entries
  326. # for train == 0 are station abbrevs
  327. sub get_schedules {
  328.    my ($weekday_lines,$saturday_lines,$sunday_lines,$weekday_scheds,$saturday_scheds,$sunday_scheds,$bike_name) = @_;
  329.    my (@day_line) = ($weekday_lines,$saturday_lines,$sunday_lines);
  330.    my (@day_sched) = ($weekday_scheds,$saturday_scheds,$sunday_scheds);
  331.    my (%recorded,@extra);
  332.    my (%station_idx);
  333.    my ($i,$j);
  334.    local($_);
  335.  
  336.    for ($i = 0; $i < @days; $i++) {
  337.       my ($lines,$scheds,$day) = ($day_line[$i],$day_sched[$i],$days[$i]);
  338.       my ($line);
  339.  
  340.       print STDOUT " $days[$i]:";
  341.       for $line (@$lines) {
  342.      my ($sched) = [];
  343.      print STDOUT " $line";
  344.      open(FILE,"$sched_dir/$day/$line")
  345.        || die "can't open file $sched_dir/$day/$line\n";
  346.      my $header = <FILE>;
  347.      $header =~ s/BIKES NOT ALLOWED BETWEEN//;
  348.      my @stations = split ' ', $header;
  349.      for ($j = 0; $j < @stations; $j++) {
  350.         $station_idx{$stations[$j]} = $j;
  351.      }
  352.      push @$sched, [@stations];
  353.      while (defined ($_ = <FILE>)) {
  354.         my (@fields) = split ' ', $_;
  355.         my (@times) = grep /^(\d?\d:\d\d[ap]|--)$/, @fields;
  356.         my (@nobikesbtw) = grep !/^(\d?\d:\d\d[ap]|--)$/, @fields;
  357.  
  358.         # correct for different station abbrev between bike name and abbrev
  359.         my $station;
  360.         for $station (@nobikesbtw) {
  361.            if (!defined $station_idx{$station} && !exists $$bike_name{$station}) {
  362.           die "I don't know what station $station is. Please add it to $bike_names_file\n";
  363.            }
  364.            else {
  365.           $station = $$bike_name{$station}
  366.             if exists $$bike_name{$station};
  367.            }
  368.            $station = $station_idx{$station};
  369.         }
  370.         
  371.         # add "no stop" indicators for -- left off at end of line
  372.         while (@times < @stations) { push @times, '--'; }
  373.         push @$sched, [map(&time_to_int($_),@times), @nobikesbtw];
  374.      }
  375.      close(FILE);
  376.      push @$scheds, $sched;
  377.       }
  378.       print STDOUT "\n";
  379.    }
  380.    
  381. }
  382.  
  383. sub first_valid_elt {
  384.    my $i;
  385.    for ($i = 0; $i < @_; $i++) {
  386.       return $_[$i]
  387.     if ($_[$i] != -1);
  388.    }
  389. }
  390.  
  391. sub get_inc_vector {
  392.    my ($first_time) = &first_valid_elt(@_);
  393.    local($_);
  394.  
  395.    map +($_ == -1 ? -1 : $_-$first_time), @_;
  396. }
  397.  
  398. sub vector_eq {
  399.    my ($vec1_ref,$vec2_ref) = @_;
  400.    my ($i);
  401.  
  402.    warn "vectors are different lengths!\n"
  403.      unless @$vec1_ref == @$vec2_ref;
  404.    
  405.    for ($i = 0; $i < @$vec1_ref; $i++) {
  406.       return 0 if $$vec1_ref[$i] != $$vec2_ref[$i];
  407.    }
  408.    
  409.    1;
  410. }
  411.  
  412. sub match_vector {
  413.    my ($newvec_ref, @vec_refs) = @_;
  414.    my ($i);
  415.  
  416.    for ($i = 0; $i < @vec_refs; $i++) {
  417.       return $i
  418.     if &vector_eq($newvec_ref,$vec_refs[$i]);
  419.    }
  420.  
  421.    $i;
  422. }
  423.  
  424. sub gen_line_schedule {
  425.    my ($line_sched_ref,$station_number_ref) = @_;
  426.    my (@inc_vectors,@nobikes_pairs);
  427.    my (@train_vector,@time_diff,@train_bikepair);
  428.    my ($vec_ref,$pair_ref);
  429.    my ($buf);
  430.    my ($compress_level) = 2;    # BART Scheduler expects level 2
  431.    my $i;
  432.  
  433.    my $stations = @{$$line_sched_ref[0]};
  434.  
  435.    # only needed for debugging
  436.    my $line = $$line_sched_ref[0][0]." to ".
  437.      $$line_sched_ref[0][$#{$$line_sched_ref[0]}];
  438.    
  439.    # find increment vector for each train; insert into @inc_vectors if unique
  440.    for ($i = 1; $i < @$line_sched_ref; $i++) {
  441.       my @vec = &get_inc_vector(@{$$line_sched_ref[$i]}[0..$stations-1]);
  442.       my @pair;
  443.       my $iv_loc = &match_vector(\@vec,@inc_vectors);
  444.       my $nb_loc = 0xff; # "none" value
  445.       my $time_diff =
  446.     &first_valid_elt(@{$$line_sched_ref[$i]})
  447.       - &first_valid_elt(@{$$line_sched_ref[max($i-1,1)]});
  448.  
  449.       # handle bike restrictions on this train if there are any
  450.       if (@{$$line_sched_ref[$i]} > $stations) {
  451.      @pair = @{$$line_sched_ref[$i]}[$stations,$stations+1];
  452.      $nb_loc = &match_vector(\@pair,@nobikes_pairs);
  453.      push @nobikes_pairs, \@pair
  454.        if $nb_loc > $#nobikes_pairs;
  455.       }
  456.       
  457.       push @inc_vectors, \@vec
  458.     if $iv_loc > $#inc_vectors;
  459.       
  460.       push @train_vector, $iv_loc;
  461.       push @train_bikepair, $nb_loc;
  462.       push @time_diff, $time_diff;
  463.    }
  464.  
  465.    printf STDOUT " %2d trains", scalar(@train_vector);
  466.    printf STDOUT " %2d iv", scalar(@inc_vectors);
  467.    printf STDOUT " %2d bp", scalar(@nobikes_pairs);
  468.    $buf .= pack("C",scalar(@inc_vectors)); # number of increment vectors
  469.    # print STDOUT "$line line: ", scalar(@inc_vectors), " inc. vectors\n";
  470.    for $vec_ref (@inc_vectors) {
  471.       my $elt;
  472.       for $elt (@$vec_ref) {
  473.      $buf .= pack("C",($elt == -1 ? 0xff : $elt)); # -1 becomes 255
  474.       }
  475.       die "vector is wrong size (", scalar(@$vec_ref), " vs. ", $stations,
  476.       ") in line ", $$line_sched_ref[0][0], " to ",
  477.       $$line_sched_ref[0][$#{$$line_sched_ref[0]}], "!\n"
  478.     unless @$vec_ref == $stations;
  479.    }
  480.  
  481.    $buf .= pack("C",scalar(@nobikes_pairs)); # number of bike restriction pairs
  482.    for $pair_ref (@nobikes_pairs) {
  483.       my $elt;
  484.       for $elt (@$pair_ref) {
  485.      $buf .= pack("C",$elt);
  486.       }
  487.    }
  488.  
  489.    # first valid time of first train (alignment of this value not guaranteed!)
  490.    $buf .= pack("n",&first_valid_elt(@{$$line_sched_ref[1]}));
  491.  
  492.    # put the train blocks in a buffer so we can count them and print the
  493.    # number of blocks to the pdb file before the blocks themselves
  494.    my $blocks_buffer = "";
  495.    my $blocks = 0;
  496.  
  497.    if ($compress_level == 0) {
  498.       for ($i = 0; $i < @train_vector; $i++) {
  499.      $blocks_buffer .= pack("N",$$line_sched_ref[$i+1][0]);
  500.      # this row's increment vector
  501.      $blocks_buffer .= pack("C",$train_vector[$i]);
  502.      # we use 0xff to mark no restrictions
  503.      $blocks_buffer .= pack("C",$train_bikepair[$i]);
  504.      $blocks++;
  505.       }
  506.    }
  507.    elsif ($compress_level == 1) {
  508.       for ($i = 0; $i < @train_vector; $i++) {
  509.      # use signed char since trains may not start at the same station
  510.      die "time_diff out of range!\n"
  511.        if $time_diff[$i] < -128 || $time_diff[$i] > 127;
  512.      $blocks_buffer .= pack("c",$time_diff[$i]);
  513.      # this row's increment vector
  514.      $blocks_buffer .= pack("C",$train_vector[$i]);
  515.      # we use 0xff to mark no restrictions
  516.      $blocks_buffer .= pack("C",$train_bikepair[$i]);
  517.      $blocks++;
  518.       }
  519.    }
  520.    elsif ($compress_level == 2) {
  521.       $i = 0;
  522.       while ($i < @time_diff) {
  523.      my $j = $i+1;
  524.      while ($j < @time_diff &&
  525.         $time_diff[$j] == $time_diff[$i] &&
  526.         $train_vector[$j] == $train_vector[$i] &&
  527.             $train_bikepair[$j] == $train_bikepair[$i]) {
  528.         $j++;
  529.      }
  530.      # number of repetitions of same time diff and train vector
  531.      $blocks_buffer .= pack("C",$j-$i);
  532.      # time difference from first valid entry of last row (or zero if this
  533.      # is the first row)
  534.      die "time_diff out of range!\n"
  535.        if $time_diff[$i] < -128 || $time_diff[$i] > 127;
  536.      $blocks_buffer .= pack("c",$time_diff[$i]);
  537.      # this row's increment vector
  538.      $blocks_buffer .= pack("C",$train_vector[$i]);
  539.      # we use 0xff to mark no restrictions
  540.      $blocks_buffer .= pack("C",$train_bikepair[$i]);
  541.      $blocks++;
  542.      $i = $j;
  543.       }
  544.    }
  545.  
  546.    printf STDOUT " %2d blocks", $blocks;
  547.    $buf .= pack("C",$blocks);    # number of train blocks
  548.    $buf .= $blocks_buffer;
  549.  
  550.    $buf;
  551. }
  552.  
  553. sub gen_line_info {
  554.    my ($initial_record_number,$station_number_ref,$lines_ref,$scheds_ref,$restrictions_ref) = @_;
  555.    my (%station_number) = %$station_number_ref;
  556.    my (@lines) = @$lines_ref;
  557.    my (@scheds) = @$scheds_ref;
  558.    my (%restrictions) = %$restrictions_ref;
  559.    my ($line);
  560.    my (@bufs,$buf);
  561.    my (@record_lengths);
  562.  
  563.    $buf .= pack("C",$INFO_RECORD_NUMBER);    # info record for this category
  564.    $buf .= pack("C",scalar(@lines)); # number of lines in this category
  565.    $buf .= pack("C",&sum(map +(scalar @$_)/2, values %restrictions));
  566.    $buf .= pack("x");        # null byte for alignment
  567.  
  568.    my ($key,$i);
  569.    for $key (sort {$station_number{$a} <=> $station_number{$b}} keys %restrictions) {
  570.       my @array = @{$restrictions{$key}};
  571.       for ($i = 0; $i < @array; $i += 2) {
  572.      $buf .= pack("C",$station_number{$key});
  573.      $buf .= pack("x");    # null byte for alignment
  574.      $buf .= pack("nn",@array[$i,$i+1]);
  575.       }
  576.    }
  577.  
  578.    push @bufs, $buf;
  579.    $buf = "";
  580.    
  581.  
  582.    for ($line = 0; $line < @lines; $line++) {
  583.       my $station;
  584.       
  585.       $buf .= pack("C",$initial_record_number+$line); # number of this record
  586.       # number of stations on this line
  587.       $buf .= pack("C",scalar(@{$scheds[$line][0]}));
  588.       
  589.       for $station (@{$scheds[$line][0]}) {
  590.      $buf .= pack("C",$station_number{$station});
  591.       }
  592.       print STDOUT "  line $line ($lines[$line])\t", scalar(@{$scheds[$line][0]}), " stations";
  593.  
  594.       $buf .= &gen_line_schedule($scheds[$line],$station_number_ref);
  595.  
  596.       print STDOUT "\n";
  597.  
  598.       push @bufs, $buf;
  599.       $buf = "";
  600.    }
  601.  
  602.    @bufs;
  603. }
  604.  
  605. # prints station names/abbrev's and category names to a record
  606. sub gen_general_info {
  607.    my ($category_names_ref,$station_abbrevs_ref,$station_name_ref,$pilot_abbrev_ref) = @_;
  608.    my (@category_names) = @$category_names_ref;
  609.    my (@station_abbrevs) = @$station_abbrevs_ref;
  610.    my (%station_name) = %$station_name_ref;
  611.    my (%pilot_abbrev) = %$pilot_abbrev_ref;
  612.    my (%station_abbrev);
  613.    my ($buf);
  614.    local($_);
  615.  
  616.    for (keys %station_name) {
  617.       $station_abbrev{$station_name{$_}} = $_;
  618.    }
  619.  
  620.    $buf .= pack("C",$INFO_RECORD_NUMBER); # number of this record
  621.    $buf .= pack("x3");        # 3 null bytes for alignment
  622.  
  623.    # creation date of the database; displayed in the "About" form
  624.    $buf .= pack("N",&unix_to_pilot_date($CREATION_DATE));
  625.    
  626.    # time at which one day's schedule ends and another's begins.  times are
  627.    # represented as the number of minutes since 12am on the first day of the
  628.    # schedule
  629.    $buf .= pack("n",$DAY_END_TIME);
  630.    $buf .= pack("C",scalar(@category_names)); # number of categories
  631.    for (@category_names) {
  632.       $buf .= pack("a*",$_."\0");
  633.    }
  634.    
  635.    $buf .= pack("C",scalar(keys %station_name)); # number of stations
  636.    # station names
  637.    for (map $station_name{$_}, @station_abbrevs) {
  638.       $buf .= pack("a*",$_."\0");
  639.    }
  640.    # station abbreviations for the pilot
  641.    for (map $pilot_abbrev{$_}, @station_abbrevs) {
  642.       $buf .= pack("a*",$_."\0");
  643.    }
  644.  
  645.    $buf;
  646. }
  647.  
  648. sub gen_fares_info {
  649.    my ($station_abbrevs_ref,$fare_ref) = @_;
  650.    my (@stations) = @$station_abbrevs_ref;
  651.    my (%fare) = %$fare_ref;
  652.    my ($buf);
  653.    my ($i,$j);
  654.    
  655.    $buf .= pack("C",$FARES_RECORD_NUMBER); # number of this record
  656.    $buf .= pack("C",int($FARE_MULTIPLIER*100+.5)); # in cents
  657.    # in multiples of the multiplier
  658.    $buf .= pack("C",int($MIN_FARE/$FARE_MULTIPLIER+.5));
  659.    for ($i = 0; $i < @stations; $i++) {
  660.       for ($j = $i; $j < @stations; $j++) {
  661.      # (fare-$MIN_FARE)/$FARE_MULTIPLIER for a trip in either direction
  662.      # between these two stations
  663.      $buf .= pack("C",int(($fare{$stations[$i],$stations[$j]}-$MIN_FARE)/$FARE_MULTIPLIER+.5));
  664.       }
  665.    }
  666.  
  667.    $buf;
  668. }
  669.  
  670. sub gen_transfer_info {
  671.    my ($transfers_ref,$weekday_lines_ref,$station_number_ref) = @_;
  672.    my (%transfers) = %$transfers_ref;
  673.    my (@weekday_lines) = @$weekday_lines_ref;
  674.    my (%station_number) = %$station_number_ref;
  675.    my (%line_number);
  676.    my ($buf);
  677.    my ($i);
  678.    local($_);
  679.  
  680.    for ($i = 0; $i < @weekday_lines; $i++) {
  681.       $line_number{$weekday_lines[$i]} = $i;
  682.    }
  683.    
  684.    $buf .= pack("C",$TRANSFER_RECORD_NUMBER); # number of this record
  685.    $buf .= pack("C",scalar(keys %transfers)); # number of lines with transfers
  686.  
  687.    for ($i = 0; $i < @weekday_lines; $i++) {
  688.       my $line = $weekday_lines[$i];
  689.       
  690.       if (exists $transfers{$line}) {
  691.      # line number
  692.      $buf .= pack ("C",$i);
  693.      # number of (station, line) transfer pairs on this line
  694.      $buf .= pack ("C",&sum(map scalar(@{$transfers{$line}{$_}{"line"}}), keys %{$transfers{$line}}));
  695.  
  696.      my $station;
  697.      for $station (keys %{$transfers{$line}}) {
  698.         my $j;
  699.         my (%line_info) = %{$transfers{$line}{$station}};
  700.         for ($j = 0; $j < @{$line_info{"line"}}; $j++) {
  701.            # (station, line) pair
  702.            $buf .= pack ("C",$station_number{$station});
  703.            $buf .= pack ("C",$line_number{${$line_info{"line"}}[$j]});
  704.            $buf .= pack ("n",${$line_info{"time"}}[$j]);
  705.         }
  706.      }
  707.       }
  708.    }
  709.  
  710.    $buf;
  711. }
  712.  
  713.  
  714. sub unix_to_pilot_date {
  715.    my ($date) = shift;
  716.    my $pilot_time_delta = 2082844800;
  717.    $date + $pilot_time_delta;
  718. }
  719.  
  720. sub gen_pdb_header {
  721.    my ($name,$version,$db_type,$creator_id,$appinfo_length,$records) = @_;
  722.    my $time = time;
  723.    my $attributes;
  724.    my $appinfo_offset;
  725.    my ($buf);
  726.  
  727.    if ($appinfo_length == 0) {
  728.       $appinfo_offset = 0;
  729.    }
  730.    else {
  731.       $appinfo_offset = $PDB_HEADER_SIZE+$RECORD_LIST_STRUCTURE_SIZE*$records;
  732.    }
  733.  
  734.    $buf .= pack("a32",$name);
  735.    $attributes = 0x0008 |    # backup database
  736.          0x0010;    # OK to install new version of DB over this one
  737.    $buf .= pack("n",$attributes);
  738.    $buf .= pack("n",$version);
  739.    $buf .= pack("N",&unix_to_pilot_date($time)); # creation date
  740.    $buf .= pack("N",&unix_to_pilot_date($time)); # modification date
  741.    $buf .= pack("N",0);        # last backup date
  742.    $buf .= pack("N",0);        # modification number
  743.    $buf .= pack("N",$appinfo_offset); # offset of AppInfoArea (0 == does not exist)
  744.    $buf .= pack("N",0);        # offset of SortInfoArea (0 == does not exist)
  745.    $buf .= pack("A4",$db_type);    # database type
  746.    $buf .= pack("A4",$creator_id); # creator id
  747.    $buf .= pack("N",0);        # unique ID seed (set to zero)
  748.    $buf .= pack("N",0);        # next record list ID (set to zero)
  749.    $buf .= pack("n",$records);    # number of records
  750.  
  751.    $buf;
  752. }
  753.  
  754. sub gen_pdb_record_list {
  755.    my ($offset, $record_sizes_ref, $categories_ref) = @_;
  756.    my (@record_sizes) = @$record_sizes_ref;
  757.    my (@categories) = @$categories_ref;
  758.    my (@record_offsets);
  759.    my $attributes = 0;        # leave all attributes unset
  760.    my ($buf);
  761.    my $i;
  762.  
  763.    $record_offsets[0] = $offset;
  764.    for ($i = 1; $i < @record_sizes; $i++) {
  765.       $record_offsets[$i] = $record_offsets[$i-1] + $record_sizes[$i-1];
  766.    }
  767.  
  768.    for ($i = 0; $i < @record_offsets; $i++) {
  769.       $buf .= pack("N",$record_offsets[$i]); # byte offset of record within file
  770.       $buf .= pack("C",$attributes | $categories[$i]); # record attributes and category value
  771.       $buf .= pack("C3",0,0,0);    # unique ID (set to zero)
  772.    }
  773.    
  774.    # number of bytes written
  775.    $buf;
  776. }
  777.  
  778. # this is for testing purposes only; BART Scheduler does not use the
  779. # appinfo area
  780. sub gen_appinfo_area {
  781.    my (@category_names) = @_;
  782.    my ($appinfo_strings,$appinfo_strlen) = (16,16);
  783.    my ($pad) = 0;
  784.    my ($uniq_id) = 0;
  785.    my ($buf);
  786.    my $i;
  787.  
  788.    my $rename_bits = unpack("S",pack("b16","1" x @category_names));
  789.  
  790.    $buf .= pack("n",$rename_bits); # set a bit for each category name
  791.    for ($i = 0; $i < @category_names; $i++) {
  792.       $buf .= pack("a$appinfo_strlen",$category_names[$i]);
  793.    }
  794.    for (; $i < $appinfo_strings; $i++) {
  795.       $buf .= pack("a$appinfo_strlen","");
  796.    }
  797.    for ($i = 0; $i < $appinfo_strings; $i++) {
  798.       # $buf .= pack("C",($i < @category_names ? $uniq_id++ : 128));
  799.       $buf .= pack("C",$uniq_id++);
  800.    }
  801.    $buf .= pack("C",$uniq_id-1); # highest uniq_id
  802.  
  803.    if ($pad) {
  804.       # pad to 512 bytes (due to bugs mentioned in PDB file format document)
  805.       $buf .= pack("x".(512-(length $buf)));
  806.    }
  807.  
  808.    $buf;
  809. }
  810.  
  811. # parse cmd line args
  812. my $use_appinfo_area = 0;
  813. if (@ARGV && $ARGV[0] =~ /^-a$/) {
  814.    $use_appinfo_area = 1;
  815. }
  816.  
  817. # read data in here
  818. print STDOUT "Reading stations...\n";
  819. &read_stations($stations_file,\@station_abbrevs,\%station_name,\%station_number,\%pilot_abbrev);
  820. print STDOUT "Reading transfers...\n";
  821. %transfers = &read_transfers($transfers_file);
  822. print STDOUT "Reading fares...\n";
  823. %fare = &read_fares($fares_file,\@station_abbrevs);
  824. print STDOUT "Reading bike names...\n";
  825. %bike_name = &read_bike_names($bike_names_file);
  826. print STDOUT "Reading station bike restrictions...\n";
  827. %station_bike_restrictions = &read_station_bike_restrictions($station_bike_restrictions_file);
  828. print STDOUT "Reading line names...\n";
  829. &get_lines(\@weekday_lines,\@saturday_lines,\@sunday_lines);
  830. print STDOUT "Reading schedules...\n";
  831. &get_schedules(\@weekday_lines,\@saturday_lines,\@sunday_lines,
  832.            \@weekday_scheds,\@saturday_scheds,\@sunday_scheds,
  833.            \%bike_name);
  834.  
  835.  
  836. my ($data_area_buf, @new_records);
  837. my ($appinfo_length) = 0;
  838. my (@record_lengths,@categories);
  839. my $records = 0;
  840. my (@lengths);
  841.  
  842. print STDOUT "Generating pdb file...\n";
  843. if ($use_appinfo_area) {
  844.    print STDOUT " appinfo\n";
  845.    $data_area_buf .= &gen_appinfo_area(@CATEGORY_NAMES);
  846. }
  847.  
  848. print STDOUT " general info\n";
  849. @new_records = &gen_general_info(\@CATEGORY_NAMES,\@station_abbrevs,
  850.                    \%station_name,\%pilot_abbrev);
  851. $data_area_buf .= join '', @new_records;
  852. push @record_lengths, map length, @new_records;
  853. push @categories, ($GENERAL_CATEGORY) x @new_records;
  854. $records += @new_records;
  855.  
  856. print STDOUT " fares\n";
  857. @new_records = &gen_fares_info(\@station_abbrevs,\%fare);
  858. $data_area_buf .= join '', @new_records;
  859. push @record_lengths, map length, @new_records;
  860. push @categories, ($GENERAL_CATEGORY) x @new_records;
  861. $records += @new_records;
  862.  
  863. print STDOUT " transfers\n";
  864. @new_records = &gen_transfer_info(\%transfers,\@weekday_lines,
  865.                     \%station_number);
  866. $data_area_buf .= join '', @new_records;
  867. push @record_lengths, map length, @new_records;
  868. push @categories, ($GENERAL_CATEGORY) x @new_records;
  869. $records += @new_records;
  870.  
  871. print STDOUT " weekday schedules\n";
  872. @new_records = &gen_line_info($INITIAL_LINE_RECORD_NUMBER,\%station_number,
  873.                 \@weekday_lines,\@weekday_scheds,
  874.                 $station_bike_restrictions{$days[0]});
  875. $data_area_buf .= join '', @new_records;
  876. push @record_lengths, map length, @new_records;
  877. push @categories, ($WEEKDAY_CATEGORY) x @new_records;
  878. $records += @new_records;
  879.  
  880. print STDOUT " saturday schedules\n";
  881. @new_records = &gen_line_info($INITIAL_LINE_RECORD_NUMBER,\%station_number,
  882.                 \@saturday_lines,\@saturday_scheds,
  883.                 $station_bike_restrictions{$days[1]});
  884. $data_area_buf .= join '', @new_records;
  885. push @record_lengths, map length, @new_records;
  886. push @categories, ($SATURDAY_CATEGORY) x @new_records;
  887. $records += @new_records;
  888.  
  889. print STDOUT " sunday schedules\n";
  890. @new_records = &gen_line_info($INITIAL_LINE_RECORD_NUMBER,\%station_number,
  891.                 \@sunday_lines,\@sunday_scheds,
  892.                 $station_bike_restrictions{$days[2]});
  893. $data_area_buf .= join '', @new_records;
  894. push @record_lengths, map length, @new_records;
  895. push @categories, ($SUNDAY_CATEGORY) x @new_records;
  896. $records += @new_records;
  897.  
  898.  
  899. my ($pdb);
  900.  
  901. print STDOUT " header\n";
  902. $pdb .= &gen_pdb_header($DB_NAME,$DB_VERSION,$DB_ID,$CREATOR_ID,
  903.               $appinfo_length,$records);
  904. print STDOUT " record list\n";
  905. # arguments are: offset (== start of records), record lengths, categories.
  906. # +2 and following pack are for filler to ensure 4-byte alignment (seems
  907. # to be necessary on Macs)
  908. $pdb .= &gen_pdb_record_list($PDB_HEADER_SIZE+$RECORD_LIST_STRUCTURE_SIZE*$records+$appinfo_length+2,\@record_lengths,\@categories);
  909. $pdb .= pack("xx");
  910.  
  911. $pdb .= $data_area_buf;
  912.  
  913. open(PDB_FILE,"> $pdb_file")
  914.   || die "can't open file $pdb_file for writing!\n";
  915. print PDB_FILE $pdb;
  916. close(PDB_FILE);
  917.  
  918. &print_header_file($header_file);
  919.  
  920. exit 0;
  921.