gtfstool

#!/usr/bin/perl -W

# gtfstool - handle gtfs feeds

# This file is part of Tripover, a broad-search journey planner.

#  Copyright (C) 2014-2017 Joris van der Geer.

# primary use is to import gtfs feeds into tripover format.
# see usage below
# basic provisions for feed merge : add agencyID to all IDs, have timezone per agency in routes, trips and calendar
# basic filtering on transport mode

use 5.012;
use strict;
use utf8;

use POSIX ();

# perl -MO=Xref,-ounused.out

my $version_maj = 1;
my $version_min = '0.2';
my $lastchanged = " 16 May 2017";

my $copyright = "Copyright (C) 2014-2017 Joris van der Geer";

my $verbose = 0;
my $dryrun = 0;
my $testonly = 0;
my $conditional = 1;
my $Conditional = 1;

my $anaout = 0;
my $anadir = '.';

my $canonout = 0;
my $canondir = '.';

my $warningcnt = 0;
my $errorcnt = 0;

my $verbose_hops = 1;

my $writerefs = 1;

my $idprefix = '';

my $showinfer = 1;
my $showmerge = 2;

my $show_unconnect = 0;

my $use_stopseqs = 1;

my $do_patch = 1;
my $airport_ref = 0;
my $airport_use = 0;

my $tzmin = 0;
my $mergedir = '';

my $runto = '';

my $allreserved = 0;

my $include_tram = 1;
my $include_metro = 1;
my $include_rail = 1;
my $include_bus = 1;
my $include_ferry = 1;
my $include_taxi = 1;
my $include_cabcar = 1;
my $include_gondola = 1;
my $include_dom_air = 1;
my $include_int_air = 1;

my $routelim = 0;

my $taximode = 2; # 0: none 1: auto 2: only if duration

my $dateshift = 0;

my $geoacc = 6; # decimals for lat/lon in canon output

my $warn_nostop = 1;

my $omit_unconnect = 1;
my $omit_noparent = 0;

my $chkduproute = 0;
my $chkdupagroute = 0;
my $chkovertake = 0;
my $do_chksid = 0;

my $watchfile = 'watches.cfg';
my $gtfscfgfile = 'gtfsfeed.cfg';

my %stops2watch = ('0','noname');
my %rsids2watch;

my $logname = 'gtfstool.log';
my $logfd;

my $canonmagic = 'x4BAb35S';
my $iscanonin = 0;

my $geomagic = 'geo-JBKScycH'; # sync with gtfsprep

my $feedstamp = '';

my ($indir,$outdir,$format);

my $glinno = 0;
my $gfilename = '';

my $haltonperl = 1;

# stop at compile-time warnings
local $SIG{__WARN__} = sub {
  print "$_[0]";
  $. = "?" unless defined $.;
  print "  $gfilename line $.\n" if length $gfilename;
  exit 1 if $haltonperl;
};

if (-t STDOUT) {
  for (my $bck = 8; $bck >= 0; $bck--) {
    rename($logname . '.' . $bck,$logname . '.' . ($bck+1)) if (-f $logname . '.' . $bck);
  }
  rename($logname,$logname . '.0') if -f $logname;
  open($logfd,'>:encoding(UTF-8)',$logname) or print("cannot create $logname:$!");
}

# unbuffered i/o
my $orgfh = select STDOUT; $| = 1;
  select STDERR; $| = 1;
  if (defined $logfd) { select $logfd; $| = 1; }
select $orgfh;

binmode(STDOUT,':utf8');

sub basemsg($) {
  my ($m) = @_;

  print("$m\n");
  print($logfd "$m\n") if defined $logfd;
  return 1;
}

my $clron = sprintf('%c[1;36m',27); # 32 green 36 cyan
my $clrof = sprintf('%c[0m',27);
my $inprogress = 0;

my %msgcounts;
my $lastlvl;

sub msg($$) {
  my ($m,$lvl) = @_;

  $lastlvl = $lvl;
  my $t = time2yyyymmdd(time(),1,'sec');
  my $tt = substr($t,11);  # only from hh in yyyy-mm-dd hh:mm:ss

  my ($package,$filename,$line,$sub,$hasargs) = caller(1);
  my $fln = sprintf("%4u",$line);
  print "\n" if $inprogress;
  print("$clron$tt $fln $clrof$m\n");
  print($logfd "$t $fln $m\n") if defined $logfd;
  $inprogress = 0;
  return 1;
}

my %infocnts;
sub info($) {
  my ($package,$filename,$line,$sub,$hasargs) = caller(0);
  ($package,$filename,$line,$sub) = caller(1) if defined $sub and $sub eq 'main::info';
  $line = 0 unless defined $line;
  $infocnts{$line} = 0 unless defined $infocnts{$line};
  my $cnt = $infocnts{$line};
  return 1 if $cnt > 1000 and $line > 0;
  $cnt++;
  if ($cnt == 1000) { msg("message at line $line repeated 100 times",'i'); $cnt++; }
  $infocnts{$line} = $cnt;
  return msg($_[0],'i');
}

my $prog_t0 = 0;
my $prog_t1 = 0;

sub progress($$$$) {
  my ($fmt,$a,$b,$c) = @_;

  my $t = time();

  if ($a == 0) { $prog_t0 = $t; $prog_t1 = 0; return; }

  if ($prog_t1 == 0 or $a < $b) {
    return if $t - $prog_t0 < 1;
  }
  $prog_t0 = $prog_t1 = $t;
  my $ft = time2yyyymmdd($t,1,'sec');
  my $tt = substr($ft,11);

  my ($package,$filename,$line) = caller(0);
  my $fln = sprintf("%4u",$line);

  my $perc = ($a * 100) / $b;
  if ($a < $b) {
    print "\n" unless $inprogress;
    $inprogress = 1;
    printf("\r%s%s %4u %s $fmt %.0f %%\r",$clron,$tt,$line,$clrof,$a,$b,$c,$perc);
  } else {
    printf("\r%s%s %4u %s $fmt done\n",$clron,$tt,$line,$clrof,$a,$b,$c);
    $inprogress = 0;
  }
}

sub dinfo($) {
  my ($package,$filename,$line,$sub,$hasargs) = caller(0);
  return msg($_[0] . " fn $sub ln $line",'i');
}

my (%warnings,%warncnts);
sub warning($) {
  my ($package,$filename,$line,$sub,$hasargs) = caller(0);
  ($package,$filename,$line,$sub) = caller(1) if defined $sub and $sub eq 'main::error';
  $line = 0 unless defined $line;

  $warnings{$line} = $_[0] unless exists $warnings{$line};
  $warncnts{$line} = 0 unless defined $warncnts{$line};
  $warningcnt++;
  my $cnt = $warncnts{$line};
  return 1 if $cnt > 100;
  $cnt++;
  if ($cnt == 100) { msg("warning at line $line repeated 100 times",'i'); $cnt++; }
  $warncnts{$line} = $cnt;

  msg("warning: " . $_[0],'w');
  return 1;
}

sub uwarning($) {
  my ($package,$filename,$line,$sub,$hasargs) = caller(0);
  ($package,$filename,$line,$sub) = caller(1) if defined $sub and $sub eq 'main::error';
  $line = 0 unless defined $line;

  $warnings{$line} = $_[0] unless exists $warnings{$line};
  $warncnts{$line} = 0 unless defined $warncnts{$line};
  $warningcnt++;
  my $cnt = $warncnts{$line};
  $cnt++;
  $warncnts{$line} = $cnt;

  msg("warning: " . $_[0],'w');
  return 1;
}

my (%errors,%errcnts);
sub error($) {
  my ($package,$filename,$line,$sub) = caller(0);
  ($package,$filename,$line,$sub) = caller(1) if defined $sub and $sub eq 'main::error';
  $sub = '(main)' unless defined $sub;
  $sub =~ s/^main:://;
  msg("error: $_[0] in $sub",'e');
  $errors{$line} = $_[0] unless exists $errors{$line};
  $errcnts{$line} = 0 unless defined $errcnts{$line};

  $errorcnt++;
  $errcnts{$line}++;
  return 0;
}

sub serror($) {
  msg("$_[0]",'e');
  return 0;
}

sub error_exit($) {
  my ($package,$filename,$line,$sub) = caller(0);
  ($package,$filename,$line,$sub) = caller(1) if defined $sub and $sub eq 'main::error_exit';
  $sub = '(main)' unless defined $sub;

  msg("error: $_[0] in $sub",'e');
  $errorcnt++;
  exit 1;
}

sub vrb($) {
  msg($_[0],'v') if $verbose;
  return 1;
}
sub vrb0($) { vrb($_[0]); }

sub infovrb($$) {
  info($_[1]) if $_[0];
  vrb($_[1]);
}

sub plural($$)
{
  my ($n,$str) = @_;
  my $s = "$n $str";
  $s .= 's' if $n != 1;
  return $s;
}

sub usage()
{
  my $m = "usage: gtfstool [options] [cmd]\n\n";
  $m .= "options:\n";
  $m .= "-v -verbose        verbose mode\n";
  $m .= "-n -dryrun         dryrun mode\n";
  $m .= "-h -help           show help and quit\n";
  $m .= "-a -analysis       enable analysis output\n";
  $m .= "-c -canonical      enable canonical output\n";
  $m .= "-r -reserve        mark all routes as requiring reservation\n";
  $m .= "-t -test           test only, no output\n";
  $m .= "-V -version        show version and quit\n";
  $m .= "commands:\n\n";

  $m .= "import <outdir> [indir]  import gtfs into tripover\n";
  $m .= "merge  <outdir> [indirs] merge canonical gtfs feeds\n";
  $m .= "air2gtfs <mode> <outdir> <indir> convert pdf timetables to gtfs\n";
  $m .= 'tt2gtfs <mode> <outdir> <indir> convert generic timetables to gtfs';
  basemsg($m);
}

sub max($$) {
  my ($a,$b) = @_;
  return ($a > $b ? $a : $b);
}
sub min($$) {
  my ($a,$b) = @_;
  return ($a < $b ? $a : $b);
}

sub trimws($) {
  my ($s) = @_;
  $s =~ s/[ \t\r\n]+/ /g;
  $s =~ s/^ //;
  $s =~ s/ $//;
  return $s;
}

my $hhmmpat = qr'^([0-9]+):([0-9]+):([0-9]+)$';

sub time2yyyymmdd($$$) {
  my ($nixsec,$local,$res) = @_;

  my ($fmt,$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);

  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = ($local ? localtime($nixsec) : gmtime($nixsec));
  return sprintf('%04u-%02u-%02u %02u:%02u:%02u',($year + 1900,$mon + 1,$mday,$hour,$min,$sec)) if $res eq 'sec';
  return sprintf('%04u-%02u-%02u %02u:%02u',($year + 1900,$mon + 1,$mday,$hour,$min)) if $res eq 'min';
  return sprintf('%04u-%02u-%02u %02u:%02u',($year + 1900,$mon + 1,$mday));
}

# these are written as options to ext output

my $hisid = 0;
my $nosid = 0xffff;

my $hirstopid = 0;

my $dowstart = 'monday';

# sync with netio
my $fmt_prvsid = 1;
my $fmt_diftid = 2;
my $fmt_difdep = 4;
my $fmt_difarr = 8;
my $fmt_prvdep = 16;
my $fmt_prvarr = 32;
my $fmt_rep = 64;

# sync with tripover
my $opt_childstop = 1;
my $opt_parentstop = 2;
my $opt_geostop = 4;

# store field results here

# defaults
my $agencyname;
my $agencyid;
my $feedpublisher = '';

my %agencies;
my %agencyids;
my %agencyrids;

my %stopids;    # ext to int
my %stop_ids;   # int to ext

# my %stops2ignore;

my (%stopnames,%stopinames);

my %stops;
my @rstops;

my (@stopdeps,@stoparrs);
my (%stop_deps,%stop_arrs);

my $stopcmt = '';

my %parents;
my %parentids;
my %parent_ids;
my %parentbyid;
my $parentcnt = 0;
my $parentdupcnt = 0;
my %stop2parent;

my %uniparents;
my %parentdups;

my (%rstops,%rstopids,%rstopbyid,%stopmerge,%rstopbyname);

my @calendar;
my @caldates;

my %serviceids;
my %noserviceids;
my %servicedow;
my %servicet0;
my %servicet1;
my %serviceadd;
my %servicesub;
my $sidcnt = 0;
my %sidrefs;
#my %sids2ignore;

my %tripids;
my %trip_ids;
my %orgtrip_ids;
my %tripseq;
my %tripseq1;
my %trippseq;
my %tripref;
my $hitripid = 0;
my @uniqids;

my %triproutes;
my %tripsids;

my %tripnos;

my @trips;

my %tripfreqs;

my @stop_times;

my %tripservice;

my @hops;

my @routes;
my %routeids;
my %norouteids;
my %routebyids;
my %routeagency;
my %rtypes;
my %agency_ids;
my %routeres;
my %routetrips;
my %routestarts;
my %routeends;

my %xfersets;

my $hirrid = 0;

my $sumtimes = 0;

my @trip_ids;
my @dep_times;
my @arr_times;

my @frequencies;

my $agencycnt = 0;
my $stopcnt = 0;
my $ttcnt = 0;
my $hopcnt = 0;
my $tripcnt = 0;
my $routecnt = 0;
my $xfercnt = 0;
my $noroutecnt = 0;

# overall date range : coded decimal yyyymmdd
my $mint0 = 20200101;
my $maxt1 = 0;

my $nondigits = qr'[^0-9]';

my $unquoter = qr'/""/"/g';

sub inarray($@) {
  my ($a,@arr) = @_;

  foreach my $b (@arr) { return 1 if $a eq $b; }
  return 0;
}

sub showvers($)
{
  my ($full) = @_;

  basemsg("Tripover gtfs tool version $version_maj.$version_min");
  basemsg("last changed $lastchanged") if $full;
  basemsg("$copyright\n");
}

sub rdwatches()
{
  my ($fh,$line,$linno);
  my ($var,$val,$fmt);

  info("inspecting $watchfile");
  return unless -r $watchfile and -s $watchfile;

  open($fh,"<",$watchfile) or return warning("cannot open $watchfile: $!");

  my $varxval = qr?^([a-z_.]+)\s+([x,\*])([0-9a-f]*)?;

  $linno = 0;
  while($line = readline $fh) {
    $linno++;
    next if index($line,'#') == 0;
    next if length $line < 2;
    ($var,$fmt,$val) = ($line =~ $varxval);
    next unless defined $var and defined $fmt;

    info("$var $fmt $val");

    if ($fmt eq 'x' and defined $val) { $val = hex($val); }
    elsif ($fmt eq '*') { $val = '*'; }
    elsif ($fmt eq  ',') { }

    printf("%s %x.%u\n",$var,$val,$val) unless $fmt eq '*';
    $rsids2watch{$val} = 1 if $var eq 'rsid';
  }
}

sub min2hhmm($$)
{
  my ($t,$fln) = @_;

  my $h = int($t / 60);
  my $m = int ($t % 60);

  return sprintf("%02u%02u",$h,$m);
}

sub hhmm2min($$)
{
  my ($s,$fln) = @_;

  my ($thh,$tmm) = ($s =~ '^([0-9]+):([0-9]+)$');
  error_exit("$fln: unrecognised time '$s'") unless defined $thh and defined $tmm;
  my $tmin = int(($thh * 60) + $tmm);
  return $tmin;
}

sub hhmm2sec($$)
{
  my ($s,$fln) = @_;

  my ($thh,$tmm,$tss) = ($s =~ $hhmmpat);
  error_exit("$fln: unrecognised time $s") unless defined $thh and defined $tmm;
  $tss = 0 unless defined $tss;
  my $tsec = ($thh * 3600) + ($tmm * 60) + $tss;
  return $tsec;
}

my (%tzofs);

my $dston_def = '0329';
my $dstof_def = '1025';

sub init($)
{
  my $progdir = shift;
  my $tzname = $progdir . '/tzdb.txt';
  my $tzfile;
  my $col = 0;
  my ($line,$len,$tzstr,$tz,$ofs,$dstofs,$dston,$dstof,$a,$b,$c,$alt,$alias);
  my @tzs;
  my $tzcol = 3;
  my $ofscol = 5;
  my $dstofscol = 6;

  rdwatches() if $anaout;

  my $tznampat  = qr'^[A-Z][a-z]+/[A-Z][-A-Za-z_/]+$';
  my $tznampat1 = qr'^[A-Z0-9]+$';

                #      Africa/Windhoek 1:00 0904 0403
  my $zonepat = qr'^([-+A-Z0-9a-z/_]+)\t([-0-9:]+)\t([-0-9:]+)\t([0-9]+)\t([0-9]+)$';

  my $linkpat = qr'^([A-Za-z/_]+)\t([-+A-Za-z0-9/_]+)$';

  my $fln = '';

  open($tzfile,'<',$tzname) or return warning("cannot open $tzname:$!");

  my %tzlines;

  my @lines = readline($tzfile);
  close($tzfile);
  my $linno = 0;
  for $line (@lines) {
    $linno++;
    next unless length($line);
    next if index($line,'#') == 0;
    $c = chop $line;
    $fln = "$tzname.$linno: ";
    warning("$fln: unterminated line '$line'") if $c ne "\n";
    $len = length($line);
    next unless $len;
    $glinno = $linno;

    ($tzstr,$ofs,$dstofs,$dston,$dstof) = ($line =~ $zonepat);
    if (defined $tzstr and length($tzstr)) {
      return error("$fln unrecognised line '$line'") unless defined $dstof and length $dstof;

      return error("$fln $tzstr already defined at line $tzlines{$tzstr}") if exists $tzofs{$tzstr};

      $tzofs{$tzstr} = join(' ',$ofs,$dstofs,$dston,$dstof);
      $tzlines{$tzstr} = $linno;
      # info("new tz $tzstr $ofs $dstofs");
      next;
    }

    ($tzstr,$alias) = ($line =~ $linkpat);
    if (defined($alias) and length($alias)) {
      return error("$fln $alias to itself") if $alias eq $tzstr;
      return error("$fln $alias already defined") if exists $tzofs{$alias};
      return error("$fln unknown zone $tzstr for $alias") unless exists $tzofs{$tzstr};
      $tz = $tzofs{$tzstr};
      # info("new alias $alias for $tzstr $tz");
      $tzofs{$alias} = $tz;
      next;
    }
    return error("$fln unrecognised line $line");
  }

  return 1;

  # read timezone info from wikipedia export, in turn from iana TZ database
  open($tzfile,'<:encoding(UTF-8)',$tzname) or return warning("cannot open $tzname:$!");
  @lines = readline($tzfile);
  close($tzfile);
  $linno = 0;
  for $line (@lines) {
    $linno++;
    next unless length($line);
    next if index($line,'#') == 0;

    $len = length($line);
    @tzs = ();
    if (index($line,'|-') == 0) {
      $col = 0;
    } elsif (index($line,'|') == 0) {
      $line = substr($line,1);
      $col++;
    }

    if ($col == $tzcol) {
      $a = index($line,'[[');
      $b = index($line,']]');
      $tzstr = substr($line,$a+2,$b-3);
    } elsif ($col == $ofscol) {
      $a = index($line,'[[');
      $c = index($line,'|');
      $ofs = substr($line,$a+5,$c-6);
      if (substr($ofs,0,1) eq "\x{2212}") { $ofs = '-' . substr($ofs,1); } # math minus
      return error("tzinfo.$linno: $tzstr: expected hh:mm, found $ofs") unless $ofs =~ qr'[-+][01][0-9]:[0134][05]';
    } elsif ($col == $dstofscol) {
      $a = index($line,'[[');
      $c = index($line,'|');
      $dston = $dston_def;
      $dstof = $dstof_def;
      if ($a < 0) { info("$tzname:$linno:$tzstr:no dstofs for $tz"); $dstofs = $ofs; }
      else {
        $dstofs = substr($line,$a+5,$c-6);
        $a = index($line,'from ');
        $dston = substr($line,$a+5,4) if $a > 0;
        $b = index($line,'to ');
        $dstof = substr($line,$b+3,4) if $b > 0;
        return error("tzinfo.$linno:$tzstr: expected dst start mmdd, found $dston") unless $dston =~ qr'[01][0-9][0-3][0-9]';
        return error("tzinfo.$linno:$tzstr: expected dst end mmdd, found $dstof") unless $dstof =~ qr'[01][0-9][0-3][0-9]';
      }
      if (substr($dstofs,0,1) eq "\x{2212}") { $dstofs = '-' . substr($dstofs,1); }
      return error("tzinfo.$linno:$tzstr: expected hh:mm, found $dstofs") unless $dstofs =~ qr'[-+][01][0-9]:[0134][05]';
    } elsif ($col > $dstofscol) { # aliases
      while (length($tzstr)) {
        $alt = index($tzstr,'|');
        if ($alt < 0) {
          push @tzs,$tzstr;
          $tzstr = '';
        } else {
          $tz = substr($tzstr,0,$alt);
          push @tzs,$tz;
          $tzstr = substr($tzstr,$alt + 1);
        }
      }
      foreach $tz (@tzs) {
        $tzofs{$tz} = join(' ',$ofs,$dstofs,$dston,$dstof) unless defined $tzofs{$tz};
      }
      $col = 0;
    }
  }

  return 1;
}

# Europe/Paris or +02:30 to hh,mm,dstondstof 01,00,03291025
sub tz2ofs($$)
{
  my ($str,$fln) = @_;
  my ($a,$hh,$mm,$dhh,$dmm,$ofs,$dstofs,$dston,$dstof);

  if ($str =~ qr'^[-+][0-9]+:[0-5]+$') { $ofs = $dstofs = $str; }
  elsif ($str =~ qr'^[+]?[0-9]+$') {
    $hh = int($str / 100);
    $mm = int($str % 100);
    $ofs = $dstofs = sprintf("%02u:%02u",$hh,$mm);
  } elsif ($str =~ qr'^-[0-9]+$') {
    $str = substr($str,1);
    $hh = int($str / 100);
    $mm = int($str % 100);
    $ofs = $dstofs = sprintf("-%02u:%02u",$hh,$mm);
  } else {
    error_exit("$fln: no timezone info for $str") unless exists($tzofs{$str});
    ($ofs,$dstofs,$dston,$dstof) = split(' ',$tzofs{$str});
  }
  $a = index($ofs,':');
  $hh = $dhh = substr($ofs,0,$a);
  $mm = $dmm = substr($ofs,$a+1);

  $dston = '' unless defined $dston;
  $dstof = '' unless defined $dstof;

  if ($dstofs eq $ofs) {
    $dston = ''; $dstof = '';
  } elsif ($dston eq '') {
    warn("tz $str at $fln has no dst dates");
  } else {
    $a = index($dstofs,':');
    $dhh = substr($dstofs,0,$a);
    $dmm = substr($dstofs,$a+1);
  }

  vrb("utc offset for $str hh $hh mm $mm $dston $dstof");
  return ($hh,$mm,$dhh,$dmm,$dston . $dstof);
}

sub indst($$$)
{
  my ($date,$dston,$dstof) = @_;

  $date %= 10000;
#  info("$date $dston $dstof");
  if ($dston < $dstof) {
    if ($date >= $dston && $date < $dstof) { return 1; }
  } else {
    if ($date < $dstof || $date >= $dston) { return 1; }
  }
  return 0;
}

# Europe/Paris,0502 or -4:30 to minutes east from utc, includes dst
sub tz2dutcofs($$$$)
{
  my ($tz,$date,$fln,$dbg) = @_;

  error_exit("$fln: empty tz") unless length $tz;

  my ($hh,$mm,$dhh,$dmm,$dston,$dstof,$dstonof);

  ($hh,$mm,$dhh,$dmm,$dstonof) = tz2ofs($tz,$fln);
  vrb0("'$tz' @ $date -> $hh:$mm dst '$dstonof'") if $dbg;
  if (length($dstonof)) {
    $dston = int($dstonof / 10000);
    $dstof = int($dstonof % 10000);
    if (indst($date,$dston,$dstof)) {
      info("$fln '$tz' @ $date $hh:$mm = $dhh:$dmm dst '$dstonof'") if $dbg;
      $hh = $dhh;
      $mm = $dmm;
    }
  }
  if ($hh < 0) { return ($hh * 60 - $mm); }
  return ($hh * 60 + $mm);
}

sub mksid($)
{
  my $service_id = shift;
  my ($dow,$utcofs,$t0,$t1) = split(' ',$service_id);

  error_exit("invalid date $t0") unless $t0 =~ qr'^[0-9]+$';
  error_exit("invalid date $t1") unless $t1 =~ qr'^[0-9]+$';

  my ($mon,$tue,$wed,$thu,$fri,$sat,$sun);

  if (index($dow,'1') < 0) { $mon = 0; } else { $mon = 1; }
  if (index($dow,'2') < 0) { $tue = 0; } else { $tue = 1; }
  if (index($dow,'3') < 0) { $wed = 0; } else { $wed = 1; }
  if (index($dow,'4') < 0) { $thu = 0; } else { $thu = 1; }
  if (index($dow,'5') < 0) { $fri = 0; } else { $fri = 1; }
  if (index($dow,'6') < 0) { $sat = 0; } else { $sat = 1; }
  if (index($dow,'7') < 0) { $sun = 0; } else { $sun = 1; }

  push @calendar,join("\t",$service_id,$mon,$tue,$wed,$thu,$fri,$sat,$sun,$t0,$t1);
}

sub sun2mon($)
{
  my $sdow = shift;
  my $dow = '';

  $dow .= '1' if index($sdow,'2') >= 0;
  $dow .= '2' if index($sdow,'3') >= 0;
  $dow .= '3' if index($sdow,'4') >= 0;
  $dow .= '4' if index($sdow,'5') >= 0;
  $dow .= '5' if index($sdow,'6') >= 0;
  $dow .= '6' if index($sdow,'7') >= 0;
  $dow .= '7' if index($sdow,'1') >= 0;
  return $dow;
}

# 3 Feb to 0203
sub ddmmm($$$)
{
  my ($day,$mon,$linno) = @_;
  my $cdday = $day;

  if ($mon eq 'Jan') { $cdday += 100; }
  elsif ($mon eq 'Feb') { $cdday += 200; }
  elsif ($mon eq 'Mar') { $cdday += 300; }
  elsif ($mon eq 'Apr') { $cdday += 400; }
  elsif ($mon eq 'May') { $cdday += 500; }
  elsif ($mon eq 'Jun') { $cdday += 600; }
  elsif ($mon eq 'Jul') { $cdday += 700; }
  elsif ($mon eq 'Aug') { $cdday += 800; }
  elsif ($mon eq 'Sep') { $cdday += 900; }
  elsif ($mon eq 'Oct') { $cdday += 1000; }
  elsif ($mon eq 'Nov') { $cdday += 1100; }
  elsif ($mon eq 'Dec') { $cdday += 1200; }
  else { error("line $linno unrecognised month $mon"); }
  return sprintf('%04u',$cdday);
}

# Februari 21 2015 to 150221
sub mkyymmdd($$$)
{
  my ($mmm,$dd,$yy4) = @_;

  my $mmdd = ddmmm($dd,substr($mmm,0,3),0);
  my $yy = substr($yy4,2);
  return $yy . $mmdd;
}

# 12Nov to 1112
sub ddmmm2mmdd($)
{
  my $pat = shift;

  my ($d,$m) = ($pat =~ '([0-9]+)([A-Za-z]{3})');
  error("unrecognised date $pat") unless defined $m;
  return ddmmm($d,$m,0);
}

# 0328+6 to 0404
sub nextdate($$$)
{
  my ($mmdd,$year,$plusday) = @_;
  my $yy = int($year - 1900);
  my $mm = int( ($mmdd / 100) - 1);
  my $dd = int($mmdd % 100);
  my $nixsec = POSIX::mktime(0,0,0,$dd,$mm,$yy);

  $nixsec += ($plusday * 3600 * 24);
  my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$isdst) = localtime($nixsec);
  my $mmdd6 = sprintf("%02u%02u",$mon+1,$mday);
  return $mmdd6;
}

# 20170516 to secs utc 70
sub yymmdd2sec($)
{
  my ($yymmdd) = @_;
  my $yy = int($yymmdd / 10000);
  error_exit("invalid year $yy from $yymmdd") if $yy < 1900;
  $yy -= 1900;
  my $mm = int( ($yymmdd / 100) % 100);
  error_exit("invalid month $mm from $yymmdd") if $mm == 0 or $mm > 12;
  $mm--;
  my $dd = int($yymmdd % 100);
  my $nixsec = POSIX::mktime(0,0,0,$dd,$mm,$yy);
  return $nixsec;
}

# 20160128 + 6 to 20160203
sub nextyymmdd($$)
{
  my ($yymmdd,$plusday) = @_;
  my $nixsec = yymmdd2sec($yymmdd);

  $nixsec += ($plusday * 3600 * 24);
  my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$isdst) = localtime($nixsec);
  my $mmdd6 = sprintf("%04u%02u%02u",$yr + 1900,$mon+1,$mday);
  return $mmdd6;
}

# day of week for yyyymmdd, mon = 6 sun = 0
sub getdow($)
{
  my ($yymmdd) = @_;
  my $nixsec = yymmdd2sec($yymmdd);

  my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$isdst) = gmtime($nixsec);
  return 0 if $wday == 0; # sun
  return 6 if $wday == 1; # mon
  return 5 if $wday == 2; # mon
  return 4 if $wday == 3; # mon
  return 3 if $wday == 4; # mon
  return 2 if $wday == 5; # mon
  return 1 if $wday == 6; # mon
}

sub patch($$)
{
  my ($section,$indir) = @_;

  my ($c,$i,$line,$fline,$match,$nomatch,$pat,$rep,$mp);

  my $modname = $indir . '/' . $section . '.patch';
  my $srcname = $indir . '/' . $section . '.txt';
  info("patching $srcname with $modname");
  return 1 unless -f $modname;

  info("patching $section");
  open(my $updfh,'<:encoding(UTF-8)',$modname) or return error("cannot open $modname: $!");

  my @modlines = readline($updfh);
  close $updfh;
  return 1 unless @modlines > 0;

  open(my $srcfh,'<:encoding(UTF-8)',$srcname) or return error("cannot open $srcname: $!");
  my @srclines = readline($srcfh);
  close $srcfh;
  my $linecnt = scalar(@srclines);
  return 1 unless $linecnt > 0;
  my $change = 0;

  my %patches;
  my $linno = 0;

  foreach my $line (@modlines) {
    next unless length($line);
    $c = chop $line;
    $line .= $c if $c ne "\n";
    $linno++;
    next unless length($line);
    $c = substr($line,0,1);
    next if $c eq '#';
    if ($c eq '\\') {
      ($pat,$rep) = split("\t",substr($line,1));
      next unless defined $pat and length $pat;
      next unless defined $rep and length $rep;
      $match = $pat;
      $rep = "$rep:$pat";
    } else {
      ($match,$pat,$rep,$nomatch) = split("\t",$line);
      $rep = '' unless defined $rep;
      next unless defined $pat;
      $match = $rep unless defined $match and length $match;
    }
    $mp = "$match\t$pat";
    return error("line $linno: pattern $match $pat defined on line $patches{$mp}") if exists $patches{$mp};
    $patches{$mp} = $linno;
    for $i (0 .. $linecnt-1) {
      $fline = $srclines[$i];
      next if index($fline,$match) < 0;
      next if index($fline,$pat) < 0;
      next if defined $nomatch and length $nomatch and index($fline,$nomatch) >= 0;
      $fline =~ s/$pat/$rep/;
      $change++ if $fline ne $srclines[$i];
      $srclines[$i] = $fline;
    }
  }
  return 1 if $change == 0;

  info("$change lines patched in $section");
  my $nsrcname = $indir . '/' . $section . '.txt.new';

  open($srcfh,'>:encoding(UTF-8)',$nsrcname) or return error("cannot create $nsrcname: $!");
  for $fline (@srclines) {
    print($srcfh $fline);
  }
  close $srcfh;
  rename($srcname,$srcname . '.0') or return error("cannot rename $nsrcname: $!");
  rename($nsrcname,$srcname) or return error("cannot rename $nsrcname: $!");
  return 1;
}

# convert 2-column timetable into one column, airline-specific
# pdftotext -raw -f 5 qf_pdfTimetable.pdf
# pattern:

# 1 time   Addis Ababa to
# N times  Dubai
# NN times EK8724*	1540	2105	1234···	-	until 30 Apr
#           flno     dep     arr    days         validity
sub qantas2canon($)
{
  my ($dir) = @_;

  my ($line,$dep,$arr,$a);
  my $srcname = 'timetable';

  my $tname2 = "$dir/$srcname-raw.txt";
  my $tname = "$dir/$srcname.txt";
  return error("required $tname2 not present") unless -f $tname2 or -f $tname;

  unless (-f $tname2) {
    info("skip converting on $tname but no $tname2");
    return 1;
  }

  if ($conditional and -f $tname and -M $tname < -M $tname2) {
    info("skip converting $tname2 to newer $tname ");
    return 1;
  }

  info("converting $tname2");
  open(my $fh,'<:encoding(UTF-8)',$tname2) or return error("cannot open $tname2:$!");

  my @rlines = readline($fh);
  close $fh;

  my (@cols,@lines,@ltlines);
  my $state = 0;

  my $frompat = qr'^[-A-za-z ]+ to$';
  my $topat = qr'^[-A-za-z ]+$';

  my $prvflno = '';
  my $linno = 0;

  my $period = '';
  my $loadtime = '';

  for $line (@rlines) {
    if (substr($line,0,1) eq "\x0c") {
      push @lines,"\x0c";
      $line = substr($line,1);
    }
    push @lines,$line;
  }

  for $line (@lines) {
    $line = trimws($line);
    $linno++;
    next unless length $line;
    next if $line eq '†';

    $line = '1234567' if $line eq 'Daily';

    if ($state == 0 and $line =~ $frompat) {  # new dep
      $state = 1;
      push @ltlines,$line;
    } elsif ($state == 1 and $line =~ $topat) {  # new arr
      $state = 2;
      push @ltlines,$line;
    } elsif ($state == 2 and $line =~ qr'^[-0-9]$') { # no date
      $state = 4;
      $cols[4] = $line;
      $cols[5] = '';
    } elsif ($state == 2 and $line =~ qr'[0-9]+[-A-Za-z ]+$' and $line =~ qr'^[-A-za-z0-9 ]+[A-Za-z]+\s*$') { # date range
      $state = 3;
      $cols[5] = $line;
    } elsif ($state == 3 and $line =~ qr'^[-1-9]+$') {  # stops
      $state = 4;
      $cols[4] = $line;
    } elsif ($state == 4 and $line =~ qr'^[1-7·]+$') { # dow
      $state = 5;
      $cols[3] = $line;
    } elsif ($state == 5 and $line =~ qr'^[-0-9+]+$') { # tarr
      $state = 6;
      $cols[2] = $line;
    } elsif ($state == 6 and $line =~ qr'^[0-9]+$') { # tdep
      $state = 7;
      $cols[1] = $line;
    } elsif ($state == 7 and $line =~ qr'^[A-Z0-9][A-Z][0-9]+[*†]?$') {  # flno
      $state = 8;
      $cols[0] = $prvflno = $line;
      push @ltlines,join("\t",@cols[0 .. 2],0,@cols[3 .. 5]);
      @cols = ();
    } elsif ($state == 7 and $line eq '"' and length $prvflno) { # rept flno
      $state = 8;
      $cols[0] = $prvflno;
      push @ltlines,join("\t",@cols[0 .. 2],0,@cols[3 .. 5]);
      @cols = ();

    } elsif ($state == 8 and $line eq 'Worldwide Timetable') { # header / footer
      $state = 9;
    } elsif ($state == 8 and $line =~ $frompat) { # new dep
      $state = 1;
      push @ltlines,$line;
    } elsif ($state == 8 and $line =~ qr'[0-9]+[-A-Za-z ]+$' and $line =~ qr'^[-A-za-z0-9 ]+[A-Za-z]+\s*$') { # date range
      $state = 3;
      $cols[5] = $line;
    } elsif ($state == 8 and $line =~ qr'^[-0-9]$') { # no date  : stops
      $state = 4;
      $cols[4] = $line;
      $cols[5] = ' ';
    } elsif ($state == 8 and $line =~ $topat) {  # new arr
      $state = 2;
      push @ltlines,$line;
    } elsif ($state == 9) {
      if ($line eq "\x0c") {
        $state = 8;
      }
    } elsif (index($line,'period') == 0) {
      $period = substr($line, 7);
    } elsif (index($line,'loadtime') == 0) {
      $loadtime = substr($line, 9);
    } else {
      return error("line $linno state $state unrecognised line '$line'");
    }
  }
  info("writing $tname");
  open($fh,'>:encoding(UTF-8)',$tname) or return error("cannot open $tname:$!");
  print $fh "# period $period\n";
  print $fh "# loadtime $loadtime\n";
  for $line (@ltlines) {
    print $fh "$line\n";
  }
  close $fh;
  info("wrote $tname");
  return patch($srcname,$dir) if $do_patch;
  return 1;
}

# convert 2-column timetable into one column, skyteam style

#
# L pdftotext -x 0 -y 0 -W 295 -H 900 -f 5 -layout Skyteam_Timetable.pdf
# R pdftotext -x 295 -y 0 -W 295 -H 900 -f 5 -layout Skyteam_Timetable.pdf
# cat L R > timetable-raw.txt
#
# pattern:
# 'FROM:' Abu Dhabi, United Arab Emirates AUH
# TO: Perth, Australia PER
# Validity Days Dep Arr Flight Aircraft Travel
# Time Time Time
#
# 01 Apr - 30 Jun 1234567 22:25 13:50+1 KL3888* 332 11H25M
# Operated by: Etihad Airways
# ^L

sub skyteam2canon($)
{
  my ($dir) = @_;

  my ($line);

  my $tname2 = "$dir/timetable-raw.txt";
  my $tname = "$dir/timetable.txt";
  return error("required $tname or $tname2 not present") unless -f $tname2 or -f $tname;

  unless (-f $tname2) {
    info("skip converting on $tname but no $tname2");
    return 1;
  }

  if ($conditional and -f $tname and -M $tname < -M $tname2) {
    info("skip converting $tname2 to newer $tname ");
    return 1;
  }

  info("converting $tname2");
  open(my $fh,'<:encoding(UTF-8)',$tname2) or return error("cannot open $tname2:$!");

  my @lines = readline($fh);
  close $fh;

  my @ltlines;
  my $state = 0;

                #   FROM: Abidjan      , Cote d'Ivoire ABJ
  my $frompat = qr'^FROM: ([-A-za-z¿\'/ ]+), [-A-za-zé.\'&() ]+ ([A-Z]{3})$';
  my $topat = qr'^TO: ([-A-za-z¿\'/ ]+), [-A-za-zé.\'&() ]+ ([A-Z]{3})+$';

  my $frompat1 = qr'^FROM: ([-A-za-z¿\'/ ]+), ([A-Z]{3})$';
  my $topat1 = qr'^TO: ([-A-za-z¿\'/ ]+), ([A-Z]{3})+$';

                 #     01       Apr     -    30     Jun       1234567     15:40       23:10     KL3889*               332             11H30M
  my $linepat1 = qr'([0-3][0-9] [A-Za-z]+) - ([0-3][0-9] [A-Za-z]+) ([1-7 ]+) ([012][0-9]:[0-5][0-9]) ([012][0-9]:[0-5][0-9][-+12]*) ([A-Z][A-Z][0-9]+\*?) ([A-Za-z0-9]+) ([12]?[0-9]H[0-5]?[0-9]M)';

  my $colpat2 = qr'Time Time Time';

  my $durpat = qr'([0-9]+)H([0-9]+)M';

  my $datepat = qr'([0-3][0-9]) ([A-Za-z]+)';

                  # Covers period: 01 Dec 2015 through 29 Feb 2016
  my $periodpat = qr'^Covers period: ([0-9]+) ([A-Za-z]+) ([0-9]+) through ([0-9]+) ([A-Za-z]+) ([0-9]+)';
  my ($permmm0,$permmm1,$perdd0,$perdd1,$peryy0,$peryy1,$per0,$per1,$pery0,$pery1);
  my ($t00,$t10,$td,$tm,$t0,$t1);
  my ($flno,$dow,$st0,$st1,$dep,$depcode,$arr,$arrcode,$craft);
  my ($tdep,$tarr,$dur,$durh,$durm,$trip,$tripcnt);
  my $period = '';
  my $loadtime = '';

  my ($errstr);

  my $prvflno = '';
  my $linno = 0;
  my $pager = 1;

  my $linecnt = scalar @lines;

  return 1 unless $linecnt;

  my $rows = 0;
  my $prvtrip = '';

  $linno = 0;
  my $pgno = 1;
  my $fln;
  for $line (@lines) {
    $line = trimws($line);
    $linno++;
    next unless length $line;

    if (substr($line,0,1) eq "\x0c") {
      $pgno++;
      $line = substr($line,1);
      while (substr($line,0,1) eq "\x0c") {
        $line = substr($line,1);
        $pgno++;
      }
      $pager = 1;
      next unless length $line;
    }

    $fln = sprintf("pg %u ln %u: ",$pgno,$linno);
    $errstr = sprintf("%s unrecognised line '%s' state %u code %u",$fln,$line,$state,$pager);

    if ( ($state == 0 or $state == 3) and ($line =~ $frompat or $line =~ $frompat1)) {  # new dep
      $state = 1;
      ($dep,$depcode) = ($line =~ $frompat);
      ($dep,$depcode) = ($line =~ $frompat1) unless defined $dep;
      return error("$errstr") unless defined $dep;
      return error("$errstr dep = $dep") unless defined $depcode;
      push @ltlines,"$depcode:$dep to";
      vrb0("new dep $depcode : $dep");
    } elsif ($state == 1 and ($line =~ $topat or $line =~ $topat1)) {  # new arr
      $state = 2;
      ($arr,$arrcode) = ($line =~ $topat);
      ($arr,$arrcode) = ($line =~ $topat1) unless defined $arr;
      return error("$errstr") unless defined $arr and defined $arrcode;
      push @ltlines,"$arrcode:$arr";
      $prvtrip = '';
      $tripcnt = 0;
#     info("new arr $arrcode : $arr");
    } elsif ($state == 2 and $line =~ $colpat2) { # possible end column headers
#     info("last col header $line");
      $state = 3;

    } elsif ($state == 2 or $state == 21 or $state == 22) {
      if ($line =~ qr'^[A-Za-z ]+$') { # other column headers
#       info("skip headers $line state $state");
      } else {
        return error("$fln unknown col header $line state $state");
      }
    } elsif ($state == 3) {

      if ($line =~ qr'Operated by: ') {
        next;
      } elsif ($line =~ qr'Consult ') {
        next;
      }

      # parse the line
      if ($line =~ $linepat1) { # 01 Apr - 30 Jun 1234567 15:40 23:10 KL3889* 332 11H30M
        ($st0,$st1,$dow,$tdep,$tarr,$flno,$craft,$dur) = ($line =~ $linepat1);
        return error("line $linno: unrecognised line $line") unless defined $dur;
        $tdep =~ tr/://d;
        $tarr =~ tr/://d;
        $tarr =~ tr/+//d if index($tarr,'+-') > 0;
        $dow =~ tr/ //d;
        $trip = join(' ',$tdep,$tarr,$dow,$st0,$st1);
        if ($trip eq $prvtrip) {
          info("skip codeshare flight $flno " . $prvflno);
          next;
        }
        $dow = sun2mon($dow);
        ($durh,$durm) = ($dur =~ $durpat);
        $dur = int($durh * 60) + $durm;

        ($td,$tm) = ($st0 =~ $datepat);
        return error ("$fln unrecognised date $st0") unless defined $td;
        $t00 = ddmmm($td,$tm,$linno);
        $t0 = ($t00 < 700 ? $pery1 : $pery0) . $t00;

        ($td,$tm) = ($st1 =~ $datepat);
        return error ("$fln unrecognised date $st1") unless defined $td;
        $t10 = ddmmm($td,$tm,$linno);
        $t1 = ($t10 < 700 ? $pery1 : $pery0) . $t10;

        push @ltlines,"$flno $tdep $tarr $dur $dow 0 $t0 - $t1";
        $prvtrip = $trip;
        $prvflno = $flno;

      } else {
        return error("$errstr");
      }
    } elsif (index($line,'period') == 0) {
      $period = substr($line, 7);
      ($perdd0,$permmm0,$peryy0,$perdd1,$permmm1,$peryy1) = ($period =~ $periodpat);
      return error("unrecognised validity period $period") unless defined $peryy1 and length $peryy1;
      $per0 = mkyymmdd($permmm0,$perdd0,$peryy0);
      $per1 = mkyymmdd($permmm1,$perdd1,$peryy1);
      $pery0 = substr($peryy0,2);
      $pery1 = substr($peryy1,2);
    } elsif (index($line,'loadtime') == 0) {
      $loadtime = substr($line, 9);
    } else { # state 3: parse line
      return error("$fln line $linno state $state unrecognised line '$line'");
    }
  }

  info("writing $tname");
  open($fh,'>:encoding(UTF-8)',$tname) or return error("cannot open $tname:$!");
  print $fh "# period $period\n";
  print $fh "# loadtime $loadtime\n";
  for $line (@ltlines) {
    print $fh "$line\n";
  }
  close $fh;
  info("wrote $tname");
  return 1;
}

sub fixcase($)
{
  my $org = shift;

  my $new = substr($org,0,1) . lc substr($org,1);
  my $a = index($new,' ');
  return $new if $a < 0;
  $new = substr($new,0,$a) . ' ' . uc(substr($new,$a+1,1)) . substr($new,$a+2);
  return $new;
}

# convert united style timetable

#
# pdftotext -f 16 -raw timetable.pdf
#
# pattern:
# Dep Arr Flt Eqp St Dur 31Oct | 7Nov | 14Nov | 21Nov
# AALESUND (AES-VIGRA)
# OSLO, NORWAY (OSL) 232 mi
# 9:00A 9:55A 7011 738 0 55m --MT---|-------|---T---|--MT---
# 9:00A 9:55A 7011 73W 0 55m ----WTF|----WTF|--M-WTF|----WTF
# 9:00A 9:55A 7011 736 0 55m -------|--M----|-------|-------
# 9:00A 9:55A 7011 73G 0 55m -------|---T---|-------|-------

# ^L

# 6:10P to 1810
sub ampm2hhmm($$)
{
  my ($s,$isdep) = @_;
  my $pat = qr'^([0-9]+):([0-9]+)([AP])([-+12]*)$';

  my ($h,$m,$ap,$plusmin) = ($s =~ $pat);
  return error("time $s not recognised") unless defined $ap;
  if ($ap eq 'P') {
    $h += 12 if $h < 12;
  } else {
    $h = 0 if $h == 12;
  }
  return sprintf('%02u%02u%s',$h,$m,$plusmin);
}

# 2h10m to 130
sub dur2m($)
{
  my $s = shift;
  my $pat1 = qr'^([0-9]+)h([0-9]+)m$';
  my $pat2 = qr'^([0-9]+)m$';

  my ($h,$m) = ($s =~ $pat1);
  return int($h * 60 + $m) if defined $h and defined $m;

  ($m) = ($s =~ $pat2);
  return $m if defined $m and length $m;

  error("unrecognised duration $s");
  return 0;
}

# SSMT-T- to 12467
sub sf217($)
{
  my $sf = shift;
  my $i;
  my $o = '';
  my @os = ('6','7','1','2','3','4','5');

  for ($i = 2; $i < 7; $i++) {
    $o .= $os[$i] if substr($sf,$i,1) ne '-';
  }
  for ($i = 0; $i < 2; $i++) {
    $o .= $os[$i] if substr($sf,$i,1) ne '-';
  }
  return $o;
}

sub fmtuni($)
{
  my $s = shift;

  $s =~ s'PEOPLE\'S REPUBLIC OF '';
  $s =~ s'UNITED REPUBLIC OF'';
  $s =~ s'UNITED ARAB EMIRATES'EMIRATES';
  return $s;
}

sub uaflno($)
{
  my $x = shift;

  return '' unless $x =~ '[0-9]+';
  return 'UA' if $x < 1300;
  return 'AT' if $x > 3149 and $x < 3250; # amtrak
  return 'VW' if $x > 6548 and $x < 6599; # aeromar
  return 'NZ' if $x > 6748 and $x < 6829; # air nz
  return 'LO' if $x > 6828 and $x < 6849; # lot polish
  return 'SK' if $x > 6973 and $x < 7074; # sas
  return 'CM' if $x > 7073 and $x < 7174; # copa
  return 'SA' if $x > 7224 and $x < 7254; # south africa
  return 'OU' if $x > 7253 and $x < 7284; # croatia
  return 'OZ' if $x > 7283 and $x < 7324; # asiana
  return 'CA' if $x > 7423 and $x < 7624; # air china
  return 'EI' if $x > 7623 and $x < 7669; # air lingus
  return 'LX' if $x > 7668 and $x < 7769; # swiss
  return 'TK' if $x > 7768 and $x < 7793; # turkish
  return 'WP' if $x > 7792 and $x < 7879; # hawai
  return 'IS' if $x > 7878 and $x < 7915; # island
  return 'AC' if $x > 8014 and $x < 8715; # canada
  return 'LH' if $x > 8715 and $x < 9590; # lh
  return 'TP' if $x > 9589 and $x < 9640; # tap portugal
  return 'NH' if $x > 9639 and $x < 9740; # nippon
  return 'OS' if $x > 9814 and $x < 9855; # austrian
  return 'MS' if $x > 9854 and $x < 9869; # egypt
  return 'BR' if $x > 9882 and $x < 9900; # eva
  return 'SN' if $x > 9899 and $x < 9999; # brussels
  return "UA";  # todo more decoding
}

sub united2canon($$)
{
  my ($dir,$year) = @_;

  my ($line);

  my $tname2 = "$dir/timetable-raw.txt";
  my $tname = "$dir/timetable.txt";
  return error("required $tname or $tname2 not present") unless -f $tname2 or -f $tname;

  unless (-f $tname2) {
    info("skip converting on $tname but no $tname2");
    return 1;
  }

  if ($conditional && -f $tname and -M $tname < -M $tname2) {
    info("skip converting $tname2 to newer $tname ");
    return 1;
  }

  info("converting $tname2");
  open(my $fh,'<:encoding(UTF-8)',$tname2) or return error("cannot open $tname2:$!");

  my @lines = readline($fh);
  close $fh;

  my @ltlines;
  my $state = 0;

                 # Dep Arr Flt Eqp St Dur 31Oct | 7Nov | 14Nov | 21Nov
  my $headpat = qr'^Dep Arr Flt Eqp St Dur ([0-9A-Za-z]+) \| ([0-9A-Za-z]+) \| ([0-9A-Za-z]+) \| ([0-9A-Za-z]+)';

                    # NEW YORK/NEWARK, NJ (EWR - LIBERTY) 1,964 mi
  my $fromtopat = qr'^([-A-Z0-9./\' ,]+) \(([A-Z]{3})';

                     # 4:57P 6:50P+1 4175 ERJ 0 1h53m SSM---F|SSM---F|SSM---F|SS-TW--
  my $linepat1 = qr'^([0-9:]+[AP])\s+([-+0-9:AP]+)\s+([0-9]+)\s+([A-Z0-9]+)\s+([0-4])\s+([0-9hm]+)\s+([-SMTWF]+)\|([-SMTWF]+)\|([-SMTWF]+)\|([-SMTWF]+)';

  my $colpat2 = qr'^[A-Za-z0-9, ]+ to [A-Za-z0-9, ]+';
  my $pagepat = qr'^Page [0-9]+ of [0-9]+$';

  my ($dep,$depcode,$arr,$arrcode,$deparr,$dacode);
  my ($flno,$ccflno,$dow,$dow1,$dow2,$dow3,$dow4,$t0,$t1,$craft);
  my ($tdep,$tarr,$dur,$durh,$durm,$trip,$tripcnt,$nstop);
  my $period = '';
  my $loadtime = '';

  my ($errstr);

  my $prvflno = '';
  my $linno = 0;
  my $pager = 1;
  my $nstopcnt = 0;
  my $sharecnt = 0;

  my $linecnt = scalar @lines;

  return 1 unless $linecnt;

  my $rows = 0;
  my $prvtrip = '';
  my ($ctime,$ctime1,$ctime2,$ctime3,$ctime4,$downo);
  my (@ctimes,@dows);

  $linno = 0;
  my $pgno = 1;
  my $fln;
  for $line (@lines) {
    $line = trimws($line);
    $linno++;
    next unless length $line;

    if (substr($line,0,1) eq "\x0c") {
      $pgno++;
      # last if $pgno > 30;
      $line = substr($line,1);
      while (substr($line,0,1) eq "\x0c") {
        $line = substr($line,1);
        $pgno++;
      }
      $pager = 1;
      next unless length $line;
    }

    $fln = sprintf("pg %u ln %u: ",$pgno,$linno);
    $errstr = sprintf("%s unrecognised line '%s' state %u code %u",$fln,$line,$state,$pager);

    if ($line =~ $pagepat) {
      $state = 4;
    } elsif ($state == 4 and $line =~ $fromtopat) { # skip header
      $state = 0;
    } elsif ($line eq 'Flight Schedule Effective' or $line =~ $colpat2) {
      next;
    } elsif ($state == 0 and $line =~ $headpat) {
      ($ctime1,$ctime2,$ctime3,$ctime4) = ($line =~ $headpat);
      $ctimes[0] = ddmmm2mmdd($ctime1);
      $ctimes[1] = ddmmm2mmdd($ctime2);
      $ctimes[2] = ddmmm2mmdd($ctime3);
      $ctimes[3] = ddmmm2mmdd($ctime4);
    } elsif ( ($state == 2 or $state == 3) and $line =~ $headpat) {
    } elsif ($state == 2 and ($line =~ $fromtopat) ) {  # new dep or arr
      $state = 3;
      ($deparr,$dacode) = ($line =~ $fromtopat);
      return error("$errstr") unless defined $deparr;
      return error("$errstr deparr = $deparr") unless defined $dacode;
      $deparr = fmtuni($deparr);
      $deparr = fixcase($deparr);
    } elsif ($state == 3 and ($line =~ $fromtopat) ) {  # new arr, after new dep
      $state = 2;
      $dep = $deparr;
      $depcode = $dacode;
      push @ltlines,"$depcode:$dep to";
      vrb0("new dep 2 $depcode : $dep");
      ($arr,$arrcode) = ($line =~ $fromtopat);
      return error("$errstr") unless defined $arr and defined $arrcode;
      $arr = fmtuni($arr);
      $arr = fixcase($arr);
      push @ltlines,"$arrcode:$arr";
      $prvtrip = '';
      $tripcnt = 0;
      # info("new arr 2 $arrcode : $arr");
    } elsif ($state == 0 and ($line =~ $fromtopat) ) {  # new dep
      $state = 1;
      ($dep,$depcode) = ($line =~ $fromtopat);
      return error("$errstr") unless defined $dep;
      return error("$errstr dep = $dep") unless defined $depcode;
      $dep = fmtuni($dep);
      $dep = fixcase($dep);
      push @ltlines,"$depcode:$dep to";
      vrb0("new dep $depcode : $dep");
    } elsif ($state == 1 and $line =~ $fromtopat) {  # new arr
      $state = 2;
      ($arr,$arrcode) = ($line =~ $fromtopat);
      return error("$errstr") unless defined $arr and defined $arrcode;
      $arr = fixcase($arr);
      push @ltlines,"$arrcode:$arr";
      $prvtrip = '';
      $tripcnt = 0;
      # info("new arr $arrcode : $arr");

    } elsif ($state == 2 or $state == 3) {

      # parse the line
      if ($line =~ $linepat1) {
        if ($state == 3) {
          $arr = $deparr;
          $arrcode = $dacode;
          $state = 2;
          push @ltlines,"$arrcode:$arr";
          $prvtrip = '';
          $tripcnt = 0;
          # info("new arr $arrcode : $arr");
        }
        # info("$line");
        ($tdep,$tarr,$flno,$craft,$nstop,$dur,$dows[0],$dows[1],$dows[2],$dows[3]) = ($line =~ $linepat1);
        return error("line $linno: unrecognised line $line") unless defined $dows[3];
        $tdep = ampm2hhmm($tdep,1);
        $tarr = ampm2hhmm($tarr,0);
        # $tarr .= '+1' if $tdep =~ '^[0-9]+$' and $tarr =~ '^[0-9]+$' and $tarr < $tdep;

        $dur = dur2m($dur);

        $trip = join(' ',$tdep,$tarr,$nstop,$dur,$dows[0],$dows[1],$dows[2],$dows[3]);
        if ($trip eq $prvtrip) {
          info("skip codeshare flight $flno " . $prvflno);
          $sharecnt++;
          next;
        }
        $prvtrip = $trip;
        $prvflno = $flno;
        if ($nstop != 0) {
          info("skip $nstop-stop flight $dep $arr");
          $nstopcnt++;
          next;
        }
        $ccflno = uaflno($flno) . $flno;
        $downo = 0;
        for $ctime (@ctimes) {
          $t0 = $ctime;
          $t1 = nextdate($t0,$year,6);
          $dow = sf217($dows[$downo]);
          $downo++;
          next unless length $dow;
          push @ltlines,"$ccflno $tdep $tarr $dur $dow $nstop $t0 - $t1";
        }
      } else {
        return error("$errstr");
      }
    } elsif (index($line,'period') == 0) {
      $period = substr($line, 7) if length($line > 7);
      info("$period");
    } elsif (index($line,'loadtime') == 0) {
      $loadtime = substr($line, 9);
    } else { # state 3: parse line
      return error("$fln line $linno state $state unrecognised line '$line'");
    }
  }

  info("$sharecnt code shares skipped") if $sharecnt;
  info("$nstopcnt n-stop flights omitted") if $nstopcnt;

  info("writing $tname");
  open($fh,'>:encoding(UTF-8)',$tname) or return error("cannot open $tname:$!");
  print $fh "# period $period\n";
  print $fh "# loadtime $loadtime\n";
  for $line (@ltlines) {
    print $fh "$line\n";
    # info("$line");
  }
  close $fh;
  info("wrote $tname");
  return 1;
}

# convert 2-column timetable into one column, oneworld style

#
# L pdftotext -x 0 -y 0 -W 260 -H 900 -f 7 -layout oneworld.pdf
# R pdftotext -x 260 -y 0 -W 270 -H 900 -f 7 -layout oneworld.pdf
# cat L R > timetable-raw.txt
#
# pattern:
# TO A CORUNA, SPAIN (LCG)
# FROM: MADRID, SPAIN (MAD)
# From-To	Elapsed
# Validity	 Days	             Dep	Arr 	Flight	 Aircraft	 time
# -	  6Aug	 1	2	3	4	5	 07:25	08:40	IB514	 319	    01:15

# Operated by: ...
# ^L

sub oneworld2canon($$$)
{
  my ($dir,$tbox0,$tbox1) = @_;

  my ($line);

  my $tname2 = "$dir/timetable-raw.txt";
  my $tname = "$dir/timetable.txt";

  return error("required $tname or $tname2 not present") unless -f $tname2 or -f $tname;

  unless (-f $tname2) {
    info("skip converting on $tname but no $tname2");
    return 1;
  }

  if ($conditional and -f $tname and -M $tname < -M $tname2) {
    info("skip converting $tname2 to newer $tname ");
    return 1;
  }

  my $box0mmdd = substr($tbox0,4);
  my $box1mmdd = substr($tbox1,4);

  info("converting $tname2 into $tname");
  open(my $fh,'<:encoding(UTF-8)',$tname2) or return error("cannot open $tname2:$!");

  my @rlines = readline($fh);
  close $fh;

  my @ltlines;
  my $state = 0;

                #   FROM: MADRID, SPAIN (MAD)
  my $frompat  = qr'^FROM:? ([-A-za-z’\'/ \(\)]+)[,.] [-A-za-zé’.,/\'& ]+ \(([A-Z]{3})\)';
  my $frompat1 = qr'^FROM:? ([-A-za-z\'/ ]+) \(([A-Z]{3})\)';
  my $topat  = qr'^\s*TO:? ([-A-za-z’\'/ \(\)]+)[,.] [-A-za-zé’.,/\'& ]+ \(([A-Z]{3})\)';
  my $topat1 = qr'^\s*TO:? ([-A-za-z’\'/ ]+) \(([A-Z]{3})\)';

                 #      01Apr           30Jun      1 2 3 5 6          15:40                   23:10                         KL3889*            332                 11:30
  my $linepat = qr'([-0-9A-Za-z]+)\s+([-0-9A-Za-z]+)\s+([1-7 \t]+)\s+([012][0-9]:[0-5][0-9])\s+([012][0-9]:[0-5][0-9][-+12]*) ([0-9]?[A-Z]+[0-9]+\*?)\s+([A-Za-z0-9]+)\s+([012][0-9]:[0-5][0-9])';

  # workaroud for layout issue: weekday and duration on next line
  my $linepat2 = qr'([-0-9A-Za-z]+)\s+([-0-9A-Za-z]+)\s+([012][0-9]:[0-5][0-9])\s+([012][0-9]:[0-5][0-9][-+12]*) ([0-9]?[A-Z]+[0-9]+\*?)\s+([A-Za-z0-9]+)';

  my $linepat3= qr'\s*([1-7 \t]+)\s+([012][0-9]:[0-5][0-9])';

  my $datepat = qr'([0-3]?[0-9])([A-Za-z]+)';

  my $colpat2 = qr'Validity\s+Days\s+Dep';

                  # Valid: December 4, 2015 to January 1, 2016
  my $periodpat = qr'^Valid: ([A-Za-z]+) ([0-9]+), ([0-9]+) to ([A-Za-z]+) ([0-9]+), ([0-9]+)';
  my ($permmm0,$permmm1,$perdd0,$perdd1,$peryy0,$peryy1,$per0,$per1,$pery0,$pery1);
  my ($flno,$dow,$t0,$t1,$t00,$t10,$st0,$st1,$dep,$depcode,$arr,$arrcode,$craft);
  my ($tdep,$tarr,$dur,$durh,$durm,$td,$tm,$trip,$tripcnt);

  my ($errstr);

  my $prvflno = '';
  my $linno = 0;
  my $pager = 1;
  my $fixlayout = 1;

  my $linecnt = scalar @rlines;

  return 1 unless $linecnt;

  my @lines;

  # workaround layout issue
  $linno = 0;
  my $pgno = 1;
  my $fln;
  $st0 = '';
  for $line (@rlines) {
    $line = trimws($line);
    $linno++;
    $glinno = $linno;
    next unless length $line;
    if ($fixlayout == 0) {
      push @lines,$line;
      next;
    }

    if ($line =~ $linepat2) {
      ($st0,$st1,$tdep,$tarr,$flno,$craft) = ($line =~ $linepat2);
      if ( ($st0 eq '-' or $st0 =~ $datepat) and ($st1 eq '-' or $st1 =~ $datepat) ) {
        vrb(" t0 '$st0' t1 '$st1' td '$tdep' ta '$tarr' fl '$flno' a '$craft'");
      } else {
        push @lines,$line;
        $st0 = '';
      }
    } elsif ($line =~ $linepat3) {
      ($dow,$dur) = ($line =~ $linepat3);
      vrb("dow '$dow' dur '$dur'");
      next unless defined $st0 and length $st0;
      $line = join("\t",$st0,$st1,$dow,$tdep,$tarr,$flno,$craft,$dur);
      push @lines,$line;
      $st0 = '';
    } elsif ($line =~ $colpat2 and length $st0) {
      $line = join("\t",$st0,$st1,$dow,$tdep,$tarr,$flno,$craft);
      push @lines,$line;
      $st0 = '';
    } else {
      push @lines,$line;
      $st0 = '';
    }
  }
  @rlines = ();

  my $rows = 0;
  my $prvtrip = '';
  my $havedep = 0;
  my $havearr = 0;
  my $prvline = '';
  my $period = '';
  my $loadtime = '';

  $linno = 0;
  $pgno = 1;

  for $line (@lines) {
    $line = trimws($line);
    $linno++;
    $glinno = $linno;
    next unless length $line;

    if (substr($line,0,1) eq "\x0c") {
      $pgno++;
      $line = substr($line,1);
      $line = substr($line,1) if substr($line,0,1) eq ')';
      $line = trimws($line);
      while (substr($line,0,1) eq "\x0c") {
        $line = substr($line,1);
        $line = trimws($line);
        $pgno++;
      }
      $pager = 1;
      next unless length $line;
    }

    $fln = sprintf("pg %u ln %u: ",$pgno,$linno);
    $errstr = sprintf("%s unrecognised line '%s' state %u code %u",$fln,$line,$state,$pager);

    if ($state == 0 or $state == 3) {
      if ($line =~ $frompat or $line =~ $frompat1) {  # new dep
        ($dep,$depcode) = ($line =~ $frompat);
        ($dep,$depcode) = ($line =~ $frompat1) unless defined $dep;
        if ($state == 3) {
          $havearr = 0 if $havedep;
        } else {
          return error("$fln unexpected dep $line at state $state") if $havedep;
        }
        $havedep = 1;
        $state = 2 if $havearr;
        return error("$errstr") unless defined $dep and length $dep;
        return error("$errstr dep = $dep") unless defined $depcode and length $depcode;
        $dep = fixcase $dep;
        push @ltlines,"$depcode:$dep to";
        vrb0("new dep $depcode : $dep");
      } elsif ($line =~ $topat or $line =~ $topat1) {  # new arr
        if ($state == 3) {
          $havedep = 0 if $havearr;
        } else {
          return error("$fln unexpected arr $line") if $havearr;
        }
        $havearr = 1;
        $state = 2 if $havedep;
        ($arr,$arrcode) = ($line =~ $topat);
        ($arr,$arrcode) = ($line =~ $topat1) unless defined $arr;
        return error("$errstr") unless defined $arr and length $arr;
        return error("$errstr") unless defined $arrcode and length $arrcode;
        $arr = fixcase $arr;
        vrb0("new arr $arrcode : $arr");
        push @ltlines,"$arrcode:$arr";
        $prvtrip = '';
        $tripcnt = 0;
      } elsif (index($line,'period') == 0) {
        $period = substr($line, 7);
        info("$period");
        ($permmm0,$perdd0,$peryy0,$permmm1,$perdd1,$peryy1) = ($period =~ $periodpat);
        return error("unrecognised validity period $period") unless defined $peryy1 and length $peryy1;
        $per0 = mkyymmdd($permmm0,$perdd0,$peryy0);
        $per1 = mkyymmdd($permmm1,$perdd1,$peryy1);
        $pery0 = substr($peryy0,2);
        $pery1 = substr($peryy1,2);
      } elsif (index($line,'loadtime') == 0) {
        $loadtime = substr($line, 9);
      }
    } elsif ($state == 2 and $line =~ $colpat2) { # possible end column headers
      # info("last col header $line");
      $state = 3;
      next;
    } elsif ($state == 2 or $state == 21 or $state == 22) {
      if ($line =~ qr'^[-A-Za-z ]+$') { # other column headers
       # info("skip headers $line state $state");
      } elsif ($line =~ qr'^\([A-Z]+\)$') { # other column headers
      } else {
        return error("$fln unknown col header $line state $state  prv $prvline");
      }
    } else {
      return error("$fln line $linno state $state unrecognised line '$line'");
    }

    if ($state == 3 and $havedep and $havearr) {

      if ($line =~ qr'Operated by') {
        next;
      } elsif ($line =~ qr'Consult ') {
        next;
      } elsif ($line =~ qr'Schedules continue') {
        next;
      }

      # parse the line
      if ($line =~ $linepat) { # 01 Apr - 30 Jun 1234567 15:40 23:10 KL3889* 332 11H30M
        ($st0,$st1,$dow,$tdep,$tarr,$flno,$craft,$dur) = ($line =~ $linepat);
        return error("line $linno: unrecognised line $line") unless defined $dur and length $dur;
        $tdep =~ tr/://d;
        $tarr =~ tr/://d;
        $tarr =~ tr/+//d if index($tarr,'+-') > 0;
        $dow =~ tr/ //d;
        $dur =~ tr/://d;
        $trip = join(' ',$tdep,$tarr,$dow,$st0,$st1);
        if ($trip eq $prvtrip) {
          info("skip codeshare flight $flno " . $prvflno);
        } else {
          $durh = int($dur / 100);
          $durm = int($dur % 100);
          $dur = int($durh * 60) + $durm;

          if ($st0 eq '-') {
            $t0 = $per0;
          } else {
            ($td,$tm) = ($st0 =~ $datepat);
            return error ("$fln unrecognised date $st0") unless defined $td;
            $t00 = ddmmm($td,$tm,$linno);
            $t0 = ($t00 < 700 ? $pery1 : $pery0) . $t00;
          }
          if ($st1 eq '-') {
            $t1 = $per1;
          } else {
            ($td,$tm) = ($st1 =~ $datepat);
            return error("$fln unrecognised date '$st1' after '$st0' in $line") unless defined $td;
            $t10 = ddmmm($td,$tm,$linno);
            $t1 = ($t10 < 700 ? $pery1 : $pery0) . $t10;
          }

          push @ltlines,"$flno $tdep $tarr $dur $dow 0 $t0 - $t1";
          $prvtrip = $trip;
          $prvflno = $flno;
        #  info("new trip $flno $tdep $tarr $dur $dow 0 $t0 - $t1");
        }

      } else {
        warning("$linno ignore unknown line '$line' $dep $arr");
      }
    } else { # state 3: parse line
    }
    $prvline = $line;
  }

  info("writing $tname");
  open($fh,'>:encoding(UTF-8)',$tname) or return error("cannot open $tname:$!");
  print $fh "# period $period\n";
  print $fh "# loadtime $loadtime\n";

  for $line (@ltlines) {
    print $fh "$line\n";
  }
  close $fh;
  info("wrote $tname");
  return 1;
}

# undo 2-column layout
# prepare with: pdftotext -f 7 -raw oneworld.pdf
# work in progress
sub split2cols($$)
{
  my ($format,$dir) = @_;

  my ($line,$fh);
  my ($dep,$arr);

  my $tnamer = "$dir/timetable-raw.txt";
  my $tnamec = "$dir/timetable-1col.txt";
  my $tname = "$dir/timetable.txt";
  return error("required $tnamer not present") unless -f $tnamer;

  open($fh,'<:encoding(UTF-8)',$tnamer) or return error("cannot open $tnamer:$!");

  my @lines = readline($fh);
  close $fh;

  my (@cols,@ltcols,@rtcols,@ltlines,@rtlines);
  my $state = 0;

  for my $line (@lines) {
    $line = trimws($line);
    @cols = split("\t",$line);

    if ($state == 0 and @cols == 2) {
      push @ltcols,$cols[0];
      push @rtcols,$cols[1];
      $state = 1;
    } elsif ($state == 1 and @cols == 2) {
      push @ltcols,$cols[0];
      push @rtcols,$cols[1];
      $state = 2;
    } elsif ($state == 2 and $cols[0] eq 'From-To') {
      $state = 3;
    } elsif ($state == 2 and $cols[0] eq 'Validity') {
      $state = 4;
    } elsif ($state == 4 and @cols == 0) {
      push @ltlines,join("\t",@ltcols);
      push @rtlines,join("\t",@rtcols);
      @ltcols = ();
      @rtcols = ();
      $state = 0;
    } elsif ($state == 4 and @cols == 14) { # left col only
      push @ltcols,@cols;
    } elsif ($state == 4 and @cols > 14) {
      if (length($cols[0])) { # left + right
        push @ltcols,@cols[0 .. 13];
        push @rtcols,@cols[14 .. 27];
      } else { # right only
        while (length($cols[0]) == 0) { shift @cols; }
        push @rtcols,@cols;
      }
    } else {
    }
  }

  # converted to 1 column
  open($fh,'>:encoding(UTF-8)',$tnamec) or return error("cannot create $tnamec:$!");
  for $line (@ltlines) {
    print $fh "$line\n";
  }
  for $line (@rtlines) {
    print $fh "$line\n";
  }
  close $fh;
  info("wrote $tnamec");

  # normalised to canonical
  open($fh,'>:encoding(UTF-8)',$tname) or return error("cannot create $tname:$!");
  for $line (@lines) {
    print $fh "$line\n";
  }
  close $fh;
  info("wrote $tname");

  return 0;
}

# in excess of 20 km at 90 Km/hr assume highway out of city
# first 20 Km at 40 Km/hr, assume city
sub taxidur($$)
{
  my ($name,$dist) = @_;
  my $dur = 0;

  warning("$name has taxi link of " . int($dist) . " Km") if $dist > 120;

  $dur = 0;
  if ($dist > 20) {
    $dur = ($dist - 20) * 60 / 90;
    $dist -= ($dist - 20);
  }
  $dur += $dist * 60 / 40;
  $dur = int($dur + 6);
  return $dur;
}

my (%hislocfares,%hishicfares,%hisdist,%hislofares,%hishifares);
my $hiscumfare = 0;
my $hiscumdist = 0;
my $hiscperkm = 0;

# LH AMS CDG
sub mkhiskey($$$)
{
  my ($carrier,$dep,$arr) = @_;

  return join('_',$carrier,$dep,$arr);
}

sub rdhistimes()
{
  my $tname = 'histimes.tab';
  my $cname = 'histimes.csv';

  my ($fh,$line);

  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$filesize);
  my ($dep,$arr,$carrier,$lofare,$hifare,$fare,$dist,$fpm,$hiskey);
  my $donesize = 0;
  my $linno = 0;

  unless ($Conditional and -f $tname) {

    return info("no $cname or $tname") unless -f $cname;

    info("reading $cname");
    open($fh,'<',$cname) or return error("cannot open $cname: $!");

    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$filesize) = stat $fh;

    my $stdhdr = '"ItinID","MktID","MktCoupons","Year","Quarter","OriginAirportID","OriginAirportSeqID","OriginCityMarketID","Origin","OriginCountry","OriginStateFips","OriginState","OriginStateName","OriginWac","DestAirportID","DestAirportSeqID","DestCityMarketID","Dest","DestCountry","DestStateFips","DestState","DestStateName","DestWac","AirportGroup","WacGroup","TkCarrierChange","TkCarrierGroup","OpCarrierChange","OpCarrierGroup","RPCarrier","TkCarrier","OpCarrier","BulkFare","Passengers","MktFare","MktDistance","MktDistanceGroup","MktMilesFlown","NonStopMiles","ItinGeoType","MktGeoType",';
    my $hdr = readline $fh;
    chop $hdr;
    return error("header $hdr, expected $stdhdr") if $hdr ne $stdhdr;

    my ($ItinID,$MktID,$MktCoupons,$Year,$Quarter,$OriginAirportID,$OriginAirportSeqID,$OriginCityMarketID,$Origin,$OriginCountry,$OriginStateFips,$OriginState,$OriginStateName,$OriginWac,$DestAirportID,$DestAirportSeqID,$DestCityMarketID,$Dest,$DestCountry,$DestStateFips,$DestState,$DestStateName,$DestWac,$AirportGroup,$WacGroup,$TkCarrierChange,$TkCarrierGroup,$OpCarrierChange,$OpCarrierGroup,$RPCarrier,$TkCarrier,$OpCarrier,$BulkFare,$Passengers,$MktFare,$MktDistance,$MktDistanceGroup,$MktMilesFlown,$NonStopMiles,$ItinGeoType,$MktGeoType);

    my $nonfdigs = qr'[^0-9.]';

    while ($line = readline $fh) {
      next unless length($line);
      $donesize += length($line);
      chop $line;
      $linno++;
      $glinno = $linno;
      next unless length($line);

      ($ItinID,$MktID,$MktCoupons,$Year,$Quarter,$OriginAirportID,$OriginAirportSeqID,$OriginCityMarketID,$Origin,$OriginCountry,$OriginStateFips,$OriginState,$OriginStateName,$OriginWac,$DestAirportID,$DestAirportSeqID,$DestCityMarketID,$Dest,$DestCountry,$DestStateFips,$DestState,$DestStateName,$DestWac,$AirportGroup,$WacGroup,$TkCarrierChange,$TkCarrierGroup,$OpCarrierChange,$OpCarrierGroup,$RPCarrier,$TkCarrier,$OpCarrier,$BulkFare,$Passengers,$MktFare,$MktDistance,$MktDistanceGroup,$MktMilesFlown,$NonStopMiles,$ItinGeoType,$MktGeoType) = split(',',$line);
      $carrier = substr($TkCarrier,1,-1);
      $carrier = substr($OpCarrier,1,-1) if $carrier eq '99' or $carrier eq '--';
      $carrier = substr($RPCarrier,1,-1) if $carrier eq '99' or $carrier eq '--';
      next if $carrier eq '99' or $carrier eq '--';

      $dep = substr($Origin,1,-1);
      $arr = substr($Dest,1,-1);
      return error("$MktFare not numerical") if $MktFare =~ $nonfdigs;

      $fare = int($MktFare);

      $fpm = $MktFare / $MktDistance;

#    info("$carrier $dep $arr $MktDistance $MktFare");

      next if $fare == 0;

      next if $fpm < 0.02 or $fpm > 1;

      $hiskey = mkhiskey($carrier,$dep,$arr);

      if (exists($hislocfares{$hiskey})) {
        $hislocfares{$hiskey} = min($hislocfares{$hiskey},$fare);
        $hishicfares{$hiskey} = max($hishicfares{$hiskey},$fare);
      } else {
        $hislocfares{$hiskey} = $fare;
        $hishicfares{$hiskey} = $fare;
      }
      $hisdist{$hiskey} = int($MktDistance / 1.61);

      progress("%u of %u MB line %u",$donesize / 1000000,$filesize / 1000000,$linno) if $linno == 1 or ($linno % 100000) == 0;
    }
    close $fh;

    info("writing $tname");

    unlink($tname . '.0') if -f $tname . '.0';
    rename($tname,$tname . '.0') if -f $tname;

    open($fh,'>',$tname) or return error("cannot create $tname: $!");

    print($fh "# carrier\tdep\tarr\tlofare\thifare\tdist\n");
    foreach $hiskey (sort keys %hislocfares) {
      ($carrier,$dep,$arr) = split('_',$hiskey);
      print($fh join("\t",$carrier,$dep,$arr,$hislocfares{$hiskey},$hishicfares{$hiskey},$hisdist{$hiskey}) . "\n");
    }
    close $fh;
  }

  info("reading $tname");
  open($fh,'<',$tname) or return error("cannot open $tname: $!");
  $linno = 0;
  $donesize = 0;

  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$filesize) = stat $fh;

  while ($line = readline $fh) {
    next unless length($line);
    $donesize += length($line);
    chop $line;
    $linno++;
    $glinno = $linno;
    next unless length($line);

    next if substr($line,0,1) eq '#';

    ($carrier,$dep,$arr,$lofare,$hifare,$dist) = split("\t",$line);

    $hiskey = mkhiskey($carrier,$dep,$arr);

    $hislocfares{$hiskey} = $lofare;
    $hishicfares{$hiskey} = $hifare;
    $hisdist{$hiskey} = $dist;

    $hiskey = join('_',$dep,$arr);

    $hislofares{$hiskey} = $lofare;
    $hishifares{$hiskey} = $hifare;
    $hisdist{$hiskey} = $dist;

    $hiscumdist += $dist;
    $hiscumfare += $lofare;

    progress("%u of %u MB line %u",$donesize / 1000000,$filesize / 1000000,$linno) if $linno == 1 or ($linno % 100000) == 0;
  }
  close $fh;
  $hiscperkm = int($hiscumfare * 100 / $hiscumdist);
  info("$linno lines, avg $hiscperkm c / mile");
  return 1;
}

# pdf timetable to gtfs conversion

# 1 time   Addis Ababa to
# N times  Dubai
# NN times EK8724*	1540	2105	535 1234···	-	until 30 Apr
#           flno     dep     arr    dur days         validity
sub air2gtfs($$$$)
{
  my ($format,$dir,$tbox0,$tbox1) = @_;
  my ($tname,$pname,$fh,$reffh,$line,$linno,$fln,$state);
  my ($dep,$arr,$idep,$depid,$arrid,$idepid,$flno,$carrier,$depcode,$arrcode);
  my ($tdep,$tarr,$dur,$ftdep,$ftarr,$tdhh,$tdmm,$tahh,$tamm,$dow,$depint,$arrint);
  my ($plus,$plusday,$min,$minday,$day,$mon,$day0,$day1,$mon0,$mon1,$opts);
  my ($name,$dname,$aname,$alias,$code,$acc,$fulname);
  my ($dutcofs,$autcofs,$ddutc,$dutcofs12,$tzdep,$tzdep1,$tzarr,$orgtdep,$orgtarr);
  my ($dlat,$dlon,$dcc,$alat,$alon);
  my ($tripid,$trip_id,$tripline);
  my ($route_id,$rtype,$rname,$stops);
  my ($service_id,$sidt0,$sidt1,$orgsidt0,$sid_tz);
  my ($agency_id,$fullagency_id);
  my ($a,$dccx,$dcc2);

  my (%airports,%airportids,%iataports,%aliases,%codes,%airlinks,%airused,%nocountry);
  my ($linkline);
  my $nocountrycnt = 0;
  my $tboxcnt = 0;

  my $rid = 1;
  my $tid = 1;
  my $sid = 1;

  my $year0 = substr($tbox0,0,4);
  my $year1 = $year0 + 1;
  my $yr0mon = substr($tbox0,4,2);

  if ($format eq 'oneworld') {
    oneworld2canon($dir,$tbox0,$tbox1) or return 0;
  } elsif ($format eq 'qantas') {
    qantas2canon($dir) or return 0;
  } elsif ($format eq 'skyteam') {
    skyteam2canon($dir) or return 0;
  } elsif ($format eq 'united') {
    united2canon($dir,$year0) or return 0;
  } elsif ($format eq 'canon') {
  } else { return error("unknown format '$format' : known oneworld,qantas,skyteam,united,canon"); }

  rdhistimes() or return 0;

  my @dirs = split('/',$dir);
  if (@dirs > 2) { $agency_id = $dirs[-2]; }
  else { $agency_id = $dirs[0]; }
  $agency_id = uc(substr($agency_id,0,1)) . substr($agency_id,1);

  my ($dist,$dadist,$citydst,$cdlat,$cdlon,$cddur,$cname);

  push @agencies,join("\t",$agency_id,$agency_id,'','');

  my %icaos;
  my ($depicao,$arricao);
  my $icname = 'icao-iata.txt';
  $linno = 0;

  if (-f $icname) {
    info("reading $icname");
    open(my $icfh,'<:encoding(UTF-8)',$icname) or return error("cannot open $icname: $!");
    while ($line = readline $icfh) {
      $linno++;
      chop $line;
      next unless length($line);
      next if index($line,'#') == 0;
      next if index($line,'[to top]') == 0;
      next if index($line,'N/A') == 0;
      $fln = "$icname.$linno: ";
      ($depcode,$depicao) = ($line =~ '^([A-Z]+)\s+([A-Z]+)');
      return error("$fln unrecognised line $line") unless defined $depcode and length $depcode;
      return error("$fln unrecognised line $line") unless defined $depicao and length $depicao;
      $icaos{$depcode} = $depicao;
    }
    close $icfh;
  }

  $pname = "airports.tab";
  return error("required $pname not present") unless -f $pname;

  info("reading $pname");
  open($fh,'<:encoding(UTF-8)',$pname) or return error("cannot open $pname:$!");

  if ($airport_ref) {
    open($reffh,'>:encoding(UTF-8)','airports.ref') or return error("cannot create airports.ref:$!");
  }

  my @lines = readline($fh);
  close $fh;

  $linno = 0;
  $depid = 0;
  $name = '';
  my $prvcname = '';
  my $dupcnt = 0;
  for $line (@lines) {
    $linno++;
    $glinno = $linno;
    chop $line;
    next unless length($line);
    next if index($line,'#') == 0;
    $fln = "$pname.$linno: ";
    if (index($line,'=') == 0) {
      $alias = substr($line,1);
      return error("$fln empty alias") unless defined $alias and length $alias;
      return error("$fln airport $name previously defined on line $airportids{$alias}") if exists $airportids{$alias};
      warning("$fln: alias '$alias' redefined") if exists $aliases{$alias};
      $aliases{$alias} = $prvcname;
      print($reffh "$alias\n") if $airport_ref;
      next;
    }
    ($name,$code,$dccx,$dlat,$dlon,$tzdep,$citydst,$cdlat,$cdlon,$cddur) = split("\t",$line);
    return error("$fln missing name") unless defined $name and length $name;
    return error("$fln missing code for $name") unless defined $code and length $code;
    $code =~ s'-rail'';
    $code =~ s'-bus'';
    return error("$fln missing code for $name") unless defined $code and length $code;
    print($reffh "$name $code\n") if $airport_ref;
    unless (defined $dccx and length $dccx) {
      # warning("$fln: $name $code has no country");
      $nocountry{$code} = $name;
      $nocountrycnt++;
      $dccx = '';
    }
    $fln = "$pname.$linno $name: ";
    warning("$fln airport $code previously defined on line $codes{$code}") if exists $codes{$code};
    $codes{$code} = "$linno as $name";

    info("$dccx $name has no taxi link") unless defined $citydst or $taximode != 1;

    $cname = $name . ' ' . $code;
    $prvcname = $cname;
    if (exists $airportids{$cname}) {
      $depid = int($airportids{$cname} / 2);
      warning("$fln airport '$cname' previously defined on line $depid");
      $dupcnt++;
      next;
    }
    $iataports{$code} = $cname;
    $depid = $linno * 2;
    $airportids{$cname} = $depid;
    $airports{$cname} = $cname;
    unless (exists $airportids{$name}) {
      $airportids{$name} = $depid;
      $airports{$name} = $line;
    }
    $rstopbyid{$depid} = $cname;
    unless (defined $dlat) {
      info("$dccx $cname not defined");
      next;
    }
    return error("$fln missing lat for $name $code") unless defined $dlat and length $dlat;
    return error("$fln missing lon for $name $code") unless defined $dlon and length $dlon;
    return error("$fln invalid coord $dlat for $name $code") if index ($dlat,',') >= 0;
    return error("$fln invalid coord $dlon for $name $code") if index ($dlon,',') >= 0;

    unless (defined $tzdep and length $tzdep) {
      $tzdep .= "wget -nv -O abc 'http://api.geonames.org/timezone?";
      $tzdep .= 'lat=' . $dlat;
      $tzdep .= '&lng=' . $dlon;
      $tzdep .= "&username=joriswu' && fgrep timezoneId abc\n";
      $tzdep .= "echo $name\n";
      open(my $tzfh,'>:encoding(UTF-8)','tzget.sh') or return error("cannot create tzget.shf:$!");

      print($tzfh "$tzdep\n");
      close $tzfh;
      return error("$fln missing timezone for $name $code");
    }

    return error("$fln invalid coord $cdlat for $name $code") if defined $cdlat and index ($cdlat,',') >= 0;
    return error("$fln invalid coord $cdlon for $name $code") if defined $cdlon and index ($cdlon,',') >= 0;

    # Minneapolis MSP MN,US
    $a = index($dccx,'-');
    if ($a > 0) { $dcc = substr($dccx,0,$a); $dcc2 = substr($dccx,$a+1); }
    else { $dcc = $dccx; $dcc2 = ''; }

    $fulname = $name . ' ' . $code . ' ';
    $fulname .= uc($dcc2) . ',' if length $dcc2;
    $fulname .= uc $dcc;

    $stop_deps{$cname} = $stop_arrs{$cname} = 0;
    push @rstops, join("\t",$cname,$code,$cname,$fulname,$dlat,$dlon,$dcc,$tzdep);
    vrb("'$cname' full $fulname");

    if ($tzdep =~ qr'^[-A-Za-z/ _]+$') {  # regular, country/city
      $dutcofs = tz2dutcofs($tzdep,$tbox0,$pname . '.' . $linno,0);
      $tzdep1 = $tzdep;
      $ftdep = $tzdep;
    } elsif ($tzdep =~ qr'^-[0-9]+$') {  # coded decimal -430
      $tzdep = -$tzdep;
      $tdhh = int($tzdep / 100); $tdmm = int($tzdep % 100);
      return error("$fln unrecognised timezone $tzdep") if $tdhh < 0 or $tdhh > 14;
      return error("$fln unrecognised timezone $tzdep") if $tdmm < 0 or $tdmm > 59;
      $dutcofs12 = int( (12 - $tdhh) * 100 - $tdmm);
      $tzdep1 = $dutcofs12;
      $ftdep = sprintf('-%02u:%02u',$tdhh,$tdmm);
      vrb0("$tzdep -> $ftdep 12 $dutcofs12");
    } elsif ($tzdep =~ qr'^[0-9]+$') {  # coded decimal 830
      $tdhh = int($tzdep / 100); $tdmm = int($tzdep % 100);
      return error("$fln unrecognised timezone $tzdep") if $tdhh < 0 or $tdhh > 14;
      return error("$fln unrecognised timezone $tzdep") if $tdmm < 0 or $tdmm > 59;
      $dutcofs12 = int( ($tdhh + 12) * 100 + $tdmm);
      $tzdep1 = $dutcofs12;
      $ftdep = sprintf('+%02d:%02u',$tdhh,$tdmm);
    } else { return error("$fln expected timezone as Country/City or [-]hhmm, found $tzdep"); }

    $airports{$cname} = join("\t",$name,$code,$dcc,$dlat,$dlon,$ftdep,$fullagency_id);

    next if $taximode == 0;
    next unless defined $citydst and length $citydst;
    return error("line $linno: incomplete taxi info for $name") unless defined $cdlon;
    $cddur = '' unless defined $cddur;
    $airlinks{$cname} = join("\t",$cname,$dcc,$dlat,$dlon,$fullagency_id,$tzdep,$citydst,$cdlat,$cdlon,$cddur);
  } # each airport

  push @agencies,join("\t",$agency_id,$agency_id,'',$ftdep,'');

  close $reffh if $airport_ref;
  return error("$dupcnt duplicate airports") if $dupcnt;

  if ($nocountrycnt) {
    info("$nocountrycnt ports without country:");
    for $code (sort keys %nocountry) {
      print("  $code  $nocountry{$code}\n");
    }
    print("\n");
  }

  my $tbox0sh = $tbox0;
  my $tbox1sh = $tbox1;
  $tbox0sh = nextyymmdd($tbox0,$dateshift) if $dateshift > 0;
  $tbox1sh = nextyymmdd($tbox1,$dateshift) if $dateshift > 0;
  $service_id = join(' ','1234567',$tbox0sh,$tbox1sh);

  # add transfers between domestic and international terminals
  for $dep (keys %airportids) {
    $arr = $dep . '_int';
    next unless exists $airportids{$arr};
    next unless $taximode == 1;

    ($dname,$code,$dcc,$dlat,$dlon,$dutcofs,$fullagency_id) = split("\t",$airports{$dep});
    ($aname,$code,$dcc,$alat,$alon,$autcofs) = split("\t",$airports{$arr});

    next unless defined $dlat and defined $alat;

    if (exists($serviceids{$service_id})) { $sid = $serviceids{$service_id}; }
    else {
      $serviceids{$service_id} = $sid;
      $sidrefs{$sid} = 1;
      $sid++;
      mksid($service_id);
    }

    $depid = $airportids{$dep};
    $arrid = $airportids{$arr};

    $dist = geodist($dlat,$dlon,$alat,$alon);
    $dur = int(($dist * 3) + 10);

    $route_id = join('_','transfer',$dep,$arr);
    $rname = 'transfer $dep domestic to international';
    $rtype = 711;
    $routetrips{$route_id} = 1;
    push @routes,join("\t",$route_id,$agency_id,0,0,$rname,'',$rtype);

    for ($tdhh = 5; $tdhh < 24; $tdhh++) {
      for ($tdmm = 0; $tdmm < 60; $tdmm += 10) {
        $tahh = $tdhh; $tamm = $tdmm + $dur;
        while ($tamm >= 60) {
          $tahh++; $tamm -= 60;
        }
        $ftdep = sprintf('%02u:%02u:00',$tdhh,$tdmm);
        $ftarr = sprintf('%02u:%02u:00',$tahh,$tamm);

        $trip_id = join('_',$route_id,$tid);
        $tripline = join("\t",$route_id,$service_id,$trip_id,$dep . ' international','',0);
        $trip_ids{$tid} = $trip_id;
        push @trips,$tripline;

        push @stop_times,join("\t",$tid,$depid,1,$ftdep,$ftdep);
        push @stop_times,join("\t",$tid,$arrid,2,$ftarr,$ftarr);
        $tid++;
      }
    }

    $route_id = join('_','transfer',$arr,$dep);
    $rname = 'transfer $dep international to domestic';
    $rtype = 711;
    $routetrips{$route_id} = 1;
    push @routes,join("\t",$route_id,$utcagency_id,0,0,$rname,'',$rtype);

    for ($tdhh = 5; $tdhh < 24; $tdhh++) {
      for ($tdmm = 0; $tdmm < 60; $tdmm += 10) {
        $tahh = $tdhh; $tamm = $tdmm + $dur;
        while ($tamm >= 60) {
          $tahh++; $tamm -= 60;
        }
        $ftdep = sprintf('%02u:%02u:00',$tdhh,$tdmm);
        $ftarr = sprintf('%02u:%02u:00',$tahh,$tamm);

        $trip_id = join('_',$route_id,$tid);
        $tripline = join("\t",$route_id,$service_id,$trip_id,$dep . ' domestic','',0);
        $trip_ids{$tid} = $trip_id;
        push @trips,$tripline;

        push @stop_times,join("\t",$tid,$arrid,1,$ftdep,$ftdep);
        push @stop_times,join("\t",$tid,$depid,2,$ftarr,$ftarr);
        $tid++;
      }
    }

  }

#  foreach $dep (sort keys %airports) {
#    info("$dep -> $airports{$dep}");
#  }

  $tname = "$dir/timetable.txt";
  return error("required $tname not present") unless -f $tname;

  info("reading $tname");
  open($fh,'<:encoding(UTF-8)',$tname) or return error("cannot open $tname:$!");

  @lines = readline($fh);
  close $fh;

  my ($listfh,$uselistfh);
  my $listname = "$dir/newports.txt";
  my $uselistname = "$dir/useports.txt";
  open($listfh,'>:encoding(UTF-8)',$listname) or return error("cannot create $listname:$!");

  if ($airport_use) {
    open($uselistfh,'>:encoding(UTF-8)',$uselistname) or return error("cannot create $uselistname:$!");
  }

  my ($cdep,$carr,$xdep,$xarr,$iarr);
  $state = 0;
  $dep = ''; $arr = ''; $flno = '';

  # WS3464* 1645 1753 113 12345·7 - until 27 Feb
  # flno dep arr dur dow stops period
  #                    flight     tdep     tarr       dur      days           stops
  my $linepat1 = qr'^[A-Z0-9*]+\s+[0-9]+\s+[-+0-9]+\s+[0-9]+\s+[A-Za-z1-7·]+\s+[-0-9]';

 #                    flight         tdep        tarr       dur         days              stops   opt
  my $linepat2 = qr'^([A-Z0-9*]+)\s+([0-9]+)\s+([-+0-9]+)\s+([0-9]+)\s+([A-Za-z1-7·]+)\s+([-0-9])\s+([-0-9A-Za-z ]*)';

  my $patdep = qr'^([A-Z]+):([-A-Za-z0-9.,¿’\'/ \(\)]+)\s+to$';
  my $patarr = qr'^([A-Z]+):([-A-Za-z0-9.,¿’\'/ \(\)]+)$';

  my $patplain = qr'^[-A-Za-z\'/ ]+';

  my $cdatepat = qr'^([0-9]{6}) - ([0-9]{6})$';

  my (%duptrips,%airlines,%deplines,%arrlines,%depinfo,%arrinfo);
  my $dbg = 0;

  my ($hiskey,$fare);
  my $farecnt = 0;

  my $lodate = 20201213;
  my $hidate = 20100101;

  $depint = '';
  my $comment = 0;

  # read timetable
  $linno = 0;
  for $line (@lines) {
    $linno++;
    chop $line;
    next unless length($line);
    if (index($line,'#') == 0) {
      next if length($line) < 2;
      $comment = trimws(substr($line,1));
      info("$comment") if index($comment,'period') == 0;
      next;
    }
    next if $line eq '†';
    $fln = "$tname.$linno: ";

    if (index($line,'"') == 0) {
      $line = $flno . substr($line,1);
    }

    progress("processing line %u of %u%s",$linno,scalar(@lines),'') if $linno == 1 or ($linno % 100) == 0;

    if ($line =~ $patdep) {  # dep
      $dbg = 0;
      ($depcode,$dep) = ($line =~ $patdep);
      $arr = '';
      $depint = $dep . '_int';
      $cdep = $dep;
      $cdep .= ' ' . $depcode;
      $depint .= ' ' . $depcode;
      if (exists $aliases{$cdep}) {
        print($uselistfh "$cdep $dep\n") if $airport_use;
        $cdep = $aliases{$cdep};
      }
      if (exists($airportids{$cdep})) { $xdep = $cdep; }
      elsif (exists($airportids{$depint})) { $xdep = $depint; }
      elsif (exists($iataports{$depcode})) {
        $cdep = $iataports{$depcode};
        return error("missing port for $cdep from $depcode") unless exists $airportids{$cdep};
        $xdep = $cdep;
      } else {
        # warning("unknown dep airport '$dep' $depcode");
        print($listfh "$dep\t$depcode\n");
        $depid = 0;
        $xdep = '';
      }
      if (length $xdep) {
        print($uselistfh "$cdep $dep\n") if $airport_use;
        $depid = $airportids{$xdep};
        return error("line $linno: $xdep undefined at $line") unless defined $airports{$xdep};
        ($name,$code,$dcc,$dlat,$dlon,$tzdep,$fullagency_id) = split("\t",$airports{$xdep});
       # error("line $linno: $xdep undefined at $line") unless defined $fullagency_id;
        unless (defined $dlat) {
          $depinfo{$xdep} = "$linno $line";
          $deplines{$xdep} = 0;
          $depid = 0;
        }
        vrb0("new dep '$xdep' $depcode $airports{$xdep}") if $depid;
      }
      $state = 1;
      $arrid = 0;
    } elsif ($line =~ $patarr) {  # arr
      ($arrcode,$arr) = ($line =~ $patarr);
      $arrint = $arr . '_int';
      $carr = $arr;
      $carr .= ' ' . $arrcode if $arrcode ne 'XXX';
      $arrint .= ' ' . $arrcode if $arrcode ne 'XXX';
      if (exists $aliases{$carr}) {
        print($uselistfh "$carr $arr\n") if $airport_use;
        $carr = $aliases{$carr};
      }
      if (exists($airportids{$carr})) { $xarr = $carr; }
      elsif (exists($airportids{$arrint})) { $xarr = $arrint; }
      elsif (exists($iataports{$arrcode})) {
        $carr = $iataports{$arrcode};
        return error("missing port for $carr from $arrcode") unless exists $airportids{$carr};
        $xarr = $carr;
      } else {
        # warning("unknown arr airport $arr $arrcode");
        print($listfh "$arr\t$arrcode\n");
        $arrid = 0;
        $xarr = '';
      }
      if (length $xarr) {
        print($uselistfh "$carr $arr\n") if $airport_use;
        return error("line $linno: $xarr undefined at $line") unless defined $airports{$xarr};
        $arrid = $airportids{$xarr};
        ($name,$code,$acc,$alat,$alon,$tzarr) = split("\t",$airports{$xarr});
        unless (defined $alat) {
          $arrid = 0;
          $arrlines{$xarr} = 0;
          $arrinfo{$xarr} = "$linno $line";
        }
        if ($arrid) { vrb("new arr $arr $arrcode"); }
        else { vrb0("skip empty arr $arr $arrcode"); }
      } else { vrb0("no new arr $arr"); }
      $state = 1;
      if ($state == 1 and $depid != 0 and $arrid != 0) {
        warning("line $linno incomplete line for dep airport $dep") unless defined $tzdep;

# portlist has plain name for domestic. _int only if not colocated
        if ($dcc eq $acc) {
          $rtype = 1102;
          $idep = $xdep;
          $idepid = $depid;
          $iarr = $xarr;
        } else {
          $rtype = 1101;
          $idep = $xdep;
          $idepid = $depid;
          $iarr = $xarr;
          if (exists($airportids{$depint})) {
            $idep = $xdep . '_int';
            $idepid = $airportids{$depint};
            ($name,$code,$dcc,$dlat,$dlon,$tzdep,$fullagency_id) = split("\t",$airports{$depint});
            $idepid = 0 unless defined $dlat;
          }
          if (exists($airportids{$arrint})) {
            $iarr = $xarr . '_int';
            $arrid = $airportids{$arrint};
            ($name,$code,$acc,$alat,$alon,$tzarr) = split("\t",$airports{$arrint});
            $arrid = 0 unless defined $dlat;
          }
        }
        next if $idepid == 0 or $arrid == 0;

        $route_id = $idep . '_' . $iarr;
        $rname = "$xdep to $xarr";
        $dadist = geodist($dlat,$dlon,$alat,$alon);
        $state = 2;
      }
    } elsif ($line =~ $linepat1) {
      ($flno,$tdep,$tarr,$dur,$dow,$stops,$opts) = ($line =~ $linepat2);
      return error("line $linno: cannot parse '$line'") unless defined $flno;
      $opts = '' unless defined $opts;
      if ($state == 2 and ($stops eq '-' or $stops eq 0)) {
        $state = 3;
      } else {
        $deplines{$xdep}++ if exists $deplines{$xdep};
        $arrlines{$xarr}++ if exists $arrlines{$xarr};
      }
      info("$flno $tdep $tarr $dow $stops $opts") if $dbg;
    } elsif ($line =~ $patplain) {
      return error("$fln missing code in '$line'\t$line");
    } else { warning("$fln undecoded '$line' state $state"); return 0; }

    next if ($state != 3);

    return error("line $linno dep $dep id $depid") if $depid == 0;
    return error("line $linno arr $arr id $arrid") if $arrid == 0;

    warning("line $linno incomplete line for arr airport $arr") unless defined $tzarr;

    $state = 2;

    $dow = '1234567' if $dow eq 'Daily';
    return error("unrecognised day of week pattern '$dow'") unless $dow =~ qr'^[1-7·]+$';

    $dow =~ tr'·''d;
    $flno =~ tr'*''d;
    $opts =~ s/^ //g;
    $opts =~ s/ $//g;

    return error("line $linno: cannot parse '$line'") unless defined $flno;

    $carrier = '';
    $carrier = substr($flno,0,2) if length($flno) > 1;

    if (length($opts) == 0) {
      $sidt0 = $tbox0;
      $sidt1 = $tbox1;
   } elsif (index($opts,'from ') == 0) {
      ($day,$mon) = ($opts =~ qr'([0-9]+)\s+([A-Za-z]+)');
      $sidt0 = ddmmm($day,$mon,$linno);
      $sidt1 = $tbox1;
    } elsif (index($opts,'until ') == 0) {
      ($day,$mon) = ($opts =~ qr'([0-9]+)\s+([A-Za-z]+)');
      $sidt1 = ddmmm($day,$mon,$linno);
      $sidt0 = $tbox0;
    } elsif (index($opts,' only') > 0) {
      ($day,$mon) = ($opts =~ qr'([0-9]+)\s+([A-Za-z]+)');
      $sidt0 = ddmmm($day,$mon,$linno);
      $sidt1 = $sidt0;
    } elsif ($opts =~ qr'^[0-9]+\s+[A-Za-z]+\s+-\s+[0-9]+\s+[A-Za-z]+') { # 3 Mar - 12 Apr
      ($day0,$mon0,$day1,$mon1) = ($opts =~ qr'([0-9]+)\s+([A-Za-z]+)\s+-\s+([0-9]+)\s+([A-Za-z]+)');
      $sidt0 = ddmmm($day0,$mon0,$linno);
      $sidt1 = ddmmm($day1,$mon1,$linno);
    } elsif ($opts =~ qr'^[0-9]{4} - [0-9]{4}$') { # canonical 0126 - 0312
      ($mon0,$day0,$mon1,$day1) = ($opts =~ qr'^([0-9]{2})([0-9]{2}) - ([0-9]{2})([0-9]{2})');
      $sidt0 = $mon0 . $day0;
      $sidt1 = $mon1 . $day1;
    } elsif ($opts =~ $cdatepat) { # canonical 150126 - 150312
      ($sidt0,$sidt1) = ($opts =~ $cdatepat);
      $sidt0 = '20' . $sidt0;
      $sidt1 = '20' . $sidt1;
    } else { return error("line $linno unrecognised period '$opts'"); }

    # handle year wrap
    if (length($sidt0) == 4) {
      if (substr($sidt0,0,2) < $yr0mon) { $sidt0 = $year1 . $sidt0; }
      else { $sidt0 = $year0 . $sidt0; }
    }
    if (length($sidt1) == 4) {
      if (substr($sidt1,0,2) < $yr0mon) { $sidt1 = $year1 . $sidt1; }
      else { $sidt1 = $year0 . $sidt1; }
    }

    $lodate = min($lodate,$sidt0);
    $hidate = max($hidate,$sidt1);

    if ($sidt0 > $tbox1 or $sidt1 < $tbox0) {
      $tboxcnt++;
      next;
    }
    $sidt0 = $tbox0 unless defined $sidt0;
    $sidt1 = $tbox1 unless defined $sidt1;

    return error("line $linno end $sidt1 before start $sidt0") if $sidt1 < $sidt0;

    $sidt0 = $orgsidt0 = max($sidt0,$tbox0);
    $sidt1 = min($sidt1,$tbox1);
    $sidt0 = nextyymmdd($sidt0,$dateshift) if $dateshift > 0;
    $sidt1 = nextyymmdd($sidt0,$dateshift) if $dateshift > 0;

    return error("line $linno: $sidt0 after $sidt1 $opts") if $sidt0 > $sidt1;
    return error("invalid dow '$dow'") unless $dow =~ qr'^[1-7]+$';

    $service_id = join(' ',$dow,$sidt0,$sidt1);

    error_exit("invalid date $sidt0") unless $sidt0 =~ qr'^[0-9]+$';
    error_exit("invalid date $sidt1") unless $sidt1 =~ qr'^[0-9]+$';

    unless (exists $serviceids{$service_id}) {
      $serviceids{$service_id} = $sid;
      $sidrefs{$sid} = 1;
      $sid++;
      mksid($service_id);
    }

    $orgtdep = $tdep; $orgtarr = $tarr;

    # handle +1 and -1 days
    $dbg = 0;
    $min = index($tarr,'-');
    if ($min > 0) {
      return error("$fln unrecognised time $tarr") unless ($tarr =~ qr'^[0-9]+-[0-9]$');
      $minday = substr($tarr,$min + 1);
      $tarr = substr($tarr,0,$min);
      $tahh = int($tarr / 100);
      $tamm = int($tarr % 100);

      $tarr = ($tahh - 24 * $minday) * 100;
      if ($tarr < 0) {
        $tarr += (100 - $tamm);
      } else {
        $tarr += $tamm;
      }
      # info("$tahh:$tamm -> $tarr");
    } else {
      $plus = index($tarr,'+');
      if ($plus > 0) {
        $plusday = substr($tarr,$plus + 1);
        $tarr = substr($tarr,0,$plus);
        $tarr += $plusday * 2400;
      }
    }

    # obtain duration
    $dutcofs = tz2dutcofs($tzdep,$orgsidt0,$tname . '.' . $linno,$dbg);
    $autcofs = tz2dutcofs($tzarr,$orgsidt0,$tname . '.' . $linno,$dbg);

    todo get duration using utcofs difference

    $tdhh = int($tdep / 100); $tdmm = int($tdep % 100);
    $tahh = int($tarr / 100); $tamm = int(abs($tarr) % 100);

    info("$tahh:$tamm -> $tarr") if $dbg;

    $tdep = int($tdhh * 60) + $tdmm;

    if ($tahh < 0) {
      $tarr = int($tahh * 60);
      $tarr -= (60 - $tamm) if $tamm != 0;
    } else {
      $tarr = int($tahh * 60) + $tamm;
    }

    $ddutc = ($autcofs - $dutcofs);

    info("dutc $dutcofs autc $autcofs dd $ddutc dep $tdep arr $tarr $dep $arr") if $dbg;

    $tarr -= $ddutc;

    info("dutc $dutcofs autc $autcofs arr $tarr dur $dur $dep $arr") if $dbg;

    if ($dur > 0) {
      $a = $tarr - $tdep;
      if ($dur != $a) {
      }
    }

    warning("line $linno $dep $arr negative tarr $tarr") if $tarr < 0;

    if ($tarr < $tdep) {
      info("dutc $dutcofs autc $autcofs $flno td $orgtdep ta $orgtarr");
      error("line $linno $cdep $carr arr $tarr before dep $tdep");
      $tarr = $tdep + 20; # todo needs patch in input
    }
    if ($tarr - $tdep < 10) {
      info("dutc $dutcofs autc $autcofs $flno td $orgtdep ta $orgtarr");
      error("line $linno $cdep $carr arr $tarr only minutes after dep $tdep");
    }

    if ($dur > 0) {
      $a = $tarr - $tdep;
      if ($dur != $a) {
        if ( ($dur < $a and $a == $dur + 60) or ($dur > $a and $dur == $a + 60) ) {
          info("line $linno $cdep-$dcc to $carr-$acc dur $dur versus ta-td $a td $tdhh:$tdmm ta $tahh:$tamm");
          info("$sidt0 $sidt1 dofs $dutcofs $tzdep aofs $autcofs $tzarr");
          tz2dutcofs($tzdep,$sidt0,$tname . '.' . $linno,0);
          tz2dutcofs($tzarr,$sidt0,$tname . '.' . $linno,0);
          vrb0("line $linno $dep $arr dur $dur td $tdep ta $tarr");
        } else {
          warning("line $linno $cdep-$dcc to $carr-$acc dur $dur versus ta-td $a td $tdhh:$tdmm ta $tahh:$tamm");
          warning("$sidt0 $sidt1 dofs $dutcofs $tzdep aofs $autcofs $tzarr");
          tz2dutcofs($tzdep,$sidt0,$tname . '.' . $linno,0);
          tz2dutcofs($tzarr,$sidt0,$tname . '.' . $linno,0);
          vrb0("line $linno $dep $arr dur $dur td $tdep ta $tarr");
        }
#        return 1;
      }
    }

    $tahh = $tarr / 60;
    $tamm = $tarr % 60;

    warning("line $linno $flno $cdep-$dcc to $carr-$acc dur $dur $tarr < $tdep") if $tarr < $tdep;

    $tdep = sprintf('%02u:%02u',$tdhh,$tdmm);
    $tarr = sprintf('%02u:%02u',$tahh,$tamm);
    info("$tdep $tarr") if $dbg;

    $trip_id = join(' ',$flno,$cdep,$carr,$tdep,$tarr,$dow,$sidt0,$sidt1);
    next if exists($duptrips{$trip_id});

    $duptrips{$trip_id} = $linno;

    $route_id = join('_',$idep,$iarr,$carrier);

    $hiskey = mkhiskey($carrier,$depcode,$arrcode);
    if (exists($hislocfares{$hiskey})) {
      $fare = $hislocfares{$hiskey}; # + $hishifares{$hiskey} / 2;
    } else {
      $hiskey = join('_',$depcode,$arrcode);
      if (exists($hislofares{$hiskey})) {
        $fare = $hislofares{$hiskey}; # + $hishifares{$hiskey} / 2;
      } else {
        $fare = int($hiscperkm * $dadist / 100);
      }
    }
    $rname = "$carrier $xdep to $xarr";
    unless (exists $routetrips{$route_id}) {
      $farecnt++ if $fare > 0;
      vrb("new route $rname '$route_id' $idepid $arrid");
      push @routes,join("\t",$route_id,$fullagency_id,1,$fare,'',$rname,$rtype);
      $routetrips{$route_id} = 0;
      $stop_deps{$rstopbyid{$idepid}}++;
      $stop_arrs{$rstopbyid{$arrid}}++;
      $rid++;
    }

    $airlines{$carrier} = 1 if length $carrier;

    $trip_id = join('_',$flno,$route_id,$tid);
    $tripline = join("\t",$route_id,$service_id,$trip_id,$flno,'',1);
    $trip_ids{$tid} = $trip_id;
    $routetrips{$route_id}++;
#    info("route $route_id cnt $routetrips{$route_id}");
    push @trips,$tripline;

#   info("new trip $trip_id $service_id");
    push @stop_times,join("\t",$tid,$idepid,1,$tdep,$tdep);
    push @stop_times,join("\t",$tid,$arrid,2,$tarr,$tarr);

    $tid++;

    $airused{$cdep} = 1;
    $airused{$carr} = 1;
  }
  close $listfh;
  close $uselistfh if $airport_use;

  $routecnt = scalar(@routes);
  info("$routecnt routes, $farecnt with fares");

  info("date span $lodate - $hidate");
  info("$tboxcnt flights outside $tbox0 - $tbox1 omitted") if $tboxcnt;
  return 0 if $routecnt == 0;

  info("airlines:");
  $linno = 0;
  for my $airline (sort keys %airlines) {
    print("$airline ");
    $linno++;
    print("\n") if ($linno % 30) == 0;
  }
  print("\n");

  my $cnt = 0;
  for my $xdep (keys %deplines) {
    $cnt++ if $deplines{$xdep};
  }
  if ($cnt) {
    info("$cnt unreferenced departures");

    for my $xdep (sort keys %deplines) {
      info("$xdep\t\t$deplines{$xdep}") if $deplines{$xdep};
    }
  }

  $cnt = 0;
  for my $xarr (keys %arrlines) {
    $arrinfo{$xarr} = '' unless exists $arrinfo{$xarr};
    $cnt++ if $arrlines{$xarr};
  }

  if ($cnt) {
    info("$cnt unreferenced arrivals");
    for my $xarr (sort keys %arrlines) {
      info("$xarr\t\t$arrlines{$xarr}") if $arrlines{$xarr};
    }
  }

  for $cname (keys %airused) {
    next unless exists $airlinks{$cname};
    $linkline = $airlinks{$cname};

    ($cname,$dcc,$dlat,$dlon,$fullagency_id,$tzdep,$citydst,$cdlat,$cdlon,$cddur) = split("\t",$linkline);

    return error("taxi to unknown $cname") unless exists $airportids{$cname};
    $depid = $airportids{$cname};

    $fullagency_id = $agency_id . '_utc';

    # create airport to city taxi link
    if (exists($airportids{$citydst})) {
      $arrid = $airportids{$citydst};
    } else {
      $stop_deps{$citydst} = $stop_arrs{$citydst} = 0;
      push @rstops, join("\t",$citydst,'',$code,$citydst,$cdlat,$cdlon,$dcc,$tzdep);
      $arrid = $depid + 1;
      $airportids{$citydst} = $arrid;
      $rstopbyid{$arrid} = $citydst;
    }

    $dur = $cddur;
    $dist = geodist($dlat,$dlon,$cdlat,$cdlon);
    if ($taximode == 1) {
      $dur = taxidur($name,$dist) unless length $dur;
    } elsif ($taximode == 2) {
      next unless length $cddur;
    }
    $stop_deps{$citydst} = $stop_arrs{$citydst} = 1;

    $cname =~ tr/ /_/;
    $route_id = join('_','taxi',$cname,$citydst);
    $rname = "taxi to $citydst";
    $rtype = 1500;
    $routetrips{$route_id} = 1;
    push @routes,join("\t",$route_id,$fullagency_id,0,0,$rname,'',$rtype,'air');

    error_exit("invalid date $tbox0") unless $tbox0 =~ qr'^[0-9]+$';
    error_exit("invalid date $tbox1") unless $tbox1 =~ qr'^[0-9]+$';

    $service_id = join(' ','1234567','utc',$tbox0sh,$tbox1sh);
    if (exists($serviceids{$service_id})) { $sid = $serviceids{$service_id}; }
    else {
      $serviceids{$service_id} = $sid;
      $sidrefs{$sid} = 1;
      $sid++;
      mksid($service_id);
    }

    $trip_id = join('_',$route_id,$tid);
    $tripline = join("\t",$route_id,$service_id,$trip_id,$citydst,'air',0);
    $trip_ids{$tid} = $trip_id;
    push @trips,$tripline;

    $ftarr = min2hhmm($dur,$linno);

    push @stop_times,join("\t",$tid,$depid,1,'00:00');
    push @stop_times,join("\t",$tid,$arrid,2,$ftarr);
    $tid++;

    # and city to airport
    $route_id = join('_','taxi',$citydst,$cname);
    $rname = "taxi to airport $cname";
    $rtype = 1500;
    $routetrips{$route_id} = 1;
    push @routes,join("\t",$route_id,$fullagency_id,0,0,$rname,'',$rtype,'air');

    $trip_id = join('_',$route_id,$tid);
    $tripline = join("\t",$route_id,$service_id,$trip_id,$citydst,'air',0);
    $trip_ids{$tid} = $trip_id;
    push @trips,$tripline;

    $ftarr = min2hhmm($dur,$linno);

    push @stop_times,join("\t",$tid,$arrid,1,'00:00');
    push @stop_times,join("\t",$tid,$depid,2,$ftarr);
    $tid++;
  }

  return 1;
}

# convert a 'generic' timetable listing to gtfs
#
# timetable:
#   route
#   seq name_eng name_local arr dep
#   ...
#
# station list:
#   name_eng name_local lat lon
#  =alias
#  >dest    taxi link
sub tt2gtfs($$$$)
{
  my ($format,$dir,$tbox0,$tbox1) = @_;

  my($fln,$line,$c,$pname);
  my ($name,$curname,$fulname,$engname,$locname,$alias,$lat,$lon,$region,$cnt);
  my ($tdep,$tarr,$seq,$dur,$trip_id,$tid,$tripline);
  my ($link,$linkline,$txdur);

  my (%stations,%halfstations,%nostations);
  my %coords;
  my %nostationcnt;
  my (%aliases,%engnames);
  my (%links,%linkdurs);
  my (%dupenstas,%duplostas);

  # read list of stations
  $pname = $dir . "/places.txt";
  return error("required $pname not present") unless -f $pname;

  info("reading $pname");
  open(my $fh,'<:encoding(UTF-8)',$pname) or return error("cannot open $pname:$!");

  my @lines = readline($fh);
  close $fh;

  my $linno = 0;
  my $dupcnt = 0;

  $curname = '';

  for $line (@lines) {
    $linno++;
    chop $line;
    next unless length($line);
    $c = substr($line,0,1);
    next if $c eq '#';
    $fln = "$pname.$linno: ";

    if ($c eq '=') {
      return error("$fln missing alias") unless length $line > 1;
      $alias = substr($line,1);
      warning("$fln duplicate alias $alias for $aliases{$alias}") if exists $aliases{$alias};
      return error("$fln missing base for alias $alias") unless length $curname;
      return error("$fln $alias equals base") if exists $stations{$alias};
      $aliases{$alias} = $curname;
      next;
    } elsif ($c eq '>') {
      return error("$fln missing link") unless length $line > 1;
      $line = substr($line,1);
      ($link,$txdur) = split("\t",$line);
      return error("$fln missing base for link $link") unless length $curname;
      return error("$fln missing duration for link $link") unless defined $txdur and length $txdur;
      $linkline = $curname . "\t" . $link;
      warning("$fln duplicate taxi link") if exists $links{$linkline};
      $links{$linkline} = $curname;
      $linkdurs{$link} = $txdur;
      next;
    }

    ($engname,$locname,$lat,$lon,$region) = split("\t",$line);
    return error("$fln missing local name") unless defined $locname and length $locname;
    return error("$fln missing eng name") unless defined $engname and length $engname;
    return error("$fln $engname equal to $locname") if $engname eq $locname;

    $fln = "$pname.$linno $engname: ";
    return error("$fln $engname previously defined on line $dupenstas{$engname}") if exists $dupenstas{$engname};
    return error("$fln $locname $engname previously defined on line $duplostas{$locname}") if exists $duplostas{$locname};

    $dupenstas{$engname} = "$linno as $engname $locname";
    $duplostas{$locname} = "$linno as $locname $engname";

    return error("$fln unexpected whitespace in '$locname'") if index($locname,' ') >= 0;

    $curname = $name = $locname;

    $halfstations{$locname} = $line;
    $aliases{$engname} = $locname;

    next unless defined $lat and length $lat;
    next if $lat =~ '^[0-9]$';

    return error("$fln unrecognised lat coord") unless defined $lat and $lat =~ '^[-.0-9]+';
    return error("$fln unrecognised lon coord") unless defined $lon and $lon =~ '^[-.0-9]+';

    $stations{$name} = $line;
    $engnames{$name} = $engname;
    $coords{$name} = join(' ',$lat,$lon);
    $rstopbyid{$name} = $name;
    $stop_deps{$name} = $stop_arrs{$name} = 0;
    push @rstops, join("\t",$name,'',$name,$name . ' ' . $engname,$lat,$lon,'','');
  }
  $stopcnt = scalar @rstops;
  info("$stopcnt stations with coords");

  my $tz = 'Asia/Shanghai';

  # create taxi links

  my ($dep,$arr,$depename,$deplname,$arrename,$arrlname,$dlon,$dlat,$alon,$alat);
  my ($depline,$arrline,$dist,$ftarr);
  my $txroute = '';
  my $txrtype = 1500;
  my $txagency = 'taxi';
  my $txservice = 'txdaily';

  $serviceids{$txservice} = $txservice;
  $sidrefs{$txservice} = 1;
  push @calendar,join("\t",$txservice,1,1,1,1,1,1,1,$tbox0,$tbox1);

  push @agencies,join("\t",$txagency,$txagency,'',$tz,'');

  my $txcnt = 0;
  foreach $dep (keys %stations) {
    next unless $taximode > 0;
    info("skip unknown dep $dep") unless exists $stations{$dep};
    next unless exists $stations{$dep};

    $depline = $stations{$dep};
    $txcnt++;
    progress("inferring taxi link %u of %u%s",$txcnt,$stopcnt,'');
    ($depename,$deplname,$dlat,$dlon) = split("\t",$depline);
    foreach $arr (keys %stations) {
      # info("arr $arr");
      next if $arr eq $dep;
      info("skip unknown arr $arr") unless exists $stations{$arr};
      next unless exists $stations{$arr};
      $arrline = $stations{$arr};
      ($arrename,$arrlname,$alat,$alon) = split("\t",$arrline);
      $dist = geodist($dlat,$dlon,$alat,$alon);
      next if $dist > 20 or $dist < 0.5;

      $txdur = taxidur($dep,$dist);

      $txroute = $deplname . ' ' . $depename . ' to ' . $arrlname . ' ' . $arrename;
      push @routes,join("\t",$txroute,$txagency,0,0,$txroute,'',$txrtype);
      $routetrips{$txroute} = 1;
      $trip_id = $tid = $txroute;
      $tripline = join("\t",$txroute,$txservice,$trip_id,'','',0);
      $trip_ids{$tid} = $trip_id;
      push @trips,$tripline;

      $ftarr = min2hhmm($txdur,$dep);

      push @stop_times,join("\t",$tid,$deplname,1,'00:00');
      push @stop_times,join("\t",$tid,$arrlname,2,$ftarr);
      $stop_deps{$deplname} = $stop_arrs{$arrlname} = 1;
    }
  }
  info('inferred ' . scalar @trips . ' taxi links');

  while (($linkline,$name) = each %links) {
    return error("$linkline to unknown $name") unless exists $stations{$name};

    return error("$fln unknown station $link") unless exists $stations{$link};

    ($link,$name) = split("\t",$linkline);
    $txroute = $name . ' to ' . $link;
    info('add link $txroute');
    push @routes,join("\t",$txroute,$txagency,0,0,$txroute,'',$txrtype);
    $routetrips{$txroute} = 1;
    $trip_id = $tid = $txroute;
    $tripline = join("\t",$txroute,$txservice,$trip_id,'','',0);
    $trip_ids{$tid} = $trip_id;
    push @trips,$tripline;

    $txdur = $linkdurs{$link};
    push @stop_times,join("\t",$tid,$name,1,0,0);
    push @stop_times,join("\t",$tid,$link,2,$txdur,$txdur);
    $stop_deps{$name} = $stop_arrs{$link} = 1;
  }

  # read timetables
  $pname = $dir . "/timetable.txt";
  return error("required $pname not present") unless -f $pname;

  info("reading $pname");
  open($fh,'<:encoding(UTF-8)',$pname) or return error("cannot open $pname:$!");

  @lines = readline($fh);
  close $fh;

  $linno = 0;

  my $route = '';
  my $rtype = 2;
  my $agency = 'tielu';
  my $service = 'daily';

  my $routepat = qr'^#?[cdgtzky]?[0-9]+$';
  my $tripat = qr'^([cdgtzky]?[0-9]+) ([cdgtzky]?[0-9]+)$';
  my $linepat = qr"^[0-9]+\t[-A-Za-z/'() ]+\t";
  my $linepat1 = qr"^[-A-Za-z/'() ]+\t";

  my ($td_plusday,$ta_plusday,$prvtdep,$ttmp,$ctdep,$prvtarr,$prvseq,$ctarr);

  $serviceids{$service} = $service;
  $sidrefs{$service} = 1;
  push @calendar,join("\t",$service,1,1,1,1,1,1,1,$tbox0,$tbox1);

  push @agencies,join("\t",$agency,$agency,'',$tz,'');

  my $triplen = 0;

  my ($prvlat,$prvlon,$prvname,$dt,$prvctdep,$prvctdep1,$prvctarr);

  for $line (@lines) {
    $linno++;
    chop $line;
    next unless length($line);
    $fln = "$pname.$linno: ";
    if ($line =~ $routepat) {
      warning("$fln empty route $route") if $triplen == 0 and length $route;
      $route = $line;
      return error("$fln route $route redefined") if defined $routetrips{$route};
      info("$fln skip route $route") if substr($route,0,1) eq '#';
      next if substr($route,0,1) eq '#';

      vrb("new route $route");
      push @routes,join("\t",$route,$agency,1,0,$route,'',$rtype);
      $routetrips{$route} = 1;
      $routecnt++;
      $trip_id = $tid = $route;
      $tripline = join("\t",$route,$service,$trip_id,'','',1);
      $trip_ids{$tid} = $trip_id;
      push @trips,$tripline;
      $triplen = $prvseq = $prvctdep = $prvctdep1 = 0;
      $prvname = '';
    } elsif ($line =~ $tripat) {
      info("$fln new trip $line");
      ($route,$trip_id) = ($line =~ $tripat);
      return error("$fln unknown route $route") unless defined $routetrips{$route};
      return error("$fln trip $trip_id redefined") if defined $tripids{$trip_id};
      $tid = $trip_id;
      $tripline = join("\t",$route,$service,$trip_id,'','',1);
      $tripids{$trip_id} = $tid;
      $trip_ids{$tid} = $trip_id;
      push @trips,$tripline;
      $triplen = $prvseq = $prvctdep = $prvctdep1 = 0;
      $prvname = '';

    } elsif ($line =~ $linepat or $line =~ $linepat1) {
      return error("$fln no route") unless length $route;
      info("$fln skip route $route") if substr($route,0,1) eq '#';
      next if substr($route,0,1) eq '#';

      if ($line =~ $linepat) {
        ($seq,$engname,$locname,$tarr,$tdep,$dur) = split("\t",$line);
      } else {
        ($engname,$locname,$tarr,$tdep,$dur) = split("\t",$line);
        $seq = $triplen + 1;
      }
      #info("$fln route $route seq $seq prv $prvseq");

      return error("$fln incomplete line  last route $route") unless defined $dur and length $dur;
      $engname = $locname if defined $locname and (not defined $engname or not length $engname);
      $locname = $engname if defined $engname and not defined $locname;
      $engname = $locname if $engname eq 'undefined';
      return error("$fln incomplete line  last route $route") unless defined $locname and length $locname;
      $engname =~ s/ $//;
      $locname =~ s/ $//;
      $name = $locname;
      return error("$fln incomplete line  last route $route") unless defined $name and length $name;
      $fulname = $locname;
      $fulname .= ' ' . $engname if $engname ne $locname;
      $routestarts{$route} = $fulname unless exists $routestarts{$route};
      $routeends{$route} = $fulname;
      $name = $aliases{$name} if exists $aliases{$name} and not exists $stations{$name} and not exists $halfstations{$name};

      # info("$fln seq $seq prv $prvseq");
      return error("$fln $route stop $seq out of sequence $prvseq") if $seq != $prvseq + 1;

      return error("$fln incomplete line") unless defined $tarr and length $tarr;
      $tdep = $tarr unless defined $tdep and length $tdep;
      $tdep =~ s/ $//;
      $tarr =~ s/ $//;
      $tarr = $tdep if $tarr eq '----' or $tarr eq '-';
      $tdep = $tarr if $tdep eq '----' or $tdep eq '-';

      $tarr = $tdep unless $triplen;

      # handle day boundaries
      $ctdep = hhmm2min($tdep,$fln);
      $ctarr = hhmm2min($tarr,$fln);

      if ($triplen) {
        if ($ctdep < $prvtdep) {
          $td_plusday++;
        }
        if ($ctarr < $prvtarr) {
          $ta_plusday++;
        }
      } else {
        $td_plusday = $ta_plusday = 0;
      }
      $prvtdep = $ctdep; $prvtarr = $ctarr;
      $triplen++;

      $tarr = min2hhmm($ctarr,$fln);
      $tdep = min2hhmm($ctdep,$fln);
      # info("arr $tarr dep $tdep");

      if ($ta_plusday) { $tarr .= '+' . $ta_plusday; $ctarr += 1440 * $ta_plusday; }
      if ($td_plusday) { $tdep .= '+' . $td_plusday; $ctdep += 1440 * $td_plusday; }

      $ttmp = min2hhmm($prvctdep1,$fln);
      # info("arr $tarr $ta_plusday dep $tdep $td_plusday $ttmp");

      unless (exists $stations{$name}) {
        return error("$fln route $route undefined start station $engname\t$name") if $triplen == 1;
        if (exists $halfstations{$name}) {
          $nostations{$name} = '+ ' . $name . ' ' . $engname;
          $engname = 'undefined' unless defined $engname and length $engname;
          $engnames{$name} = $engname unless exists $engnames{$name};
        } else {
          $nostations{$name} = '- ' . $engname . "\t" . $name;
          $engname = 'undefined' unless defined $engname and length $engname;
          $engnames{$name} = $engname;
        }
        $nostationcnt{$name}++;
        $prvseq = $seq;
        $prvctdep1 = $ctdep;
        # $prvname1 = $name;
        next;
      }

      ($lat,$lon) = split(' ',$coords{$name});
      if ($triplen > 1) {
        $ttmp = min2hhmm($prvctdep1,$fln);
        return error("$fln route $route seq $seq arrive $tarr before last depart $ttmp") if $ctarr <= $prvctdep1;
        $dt = ($ctarr - $prvctdep) / 60;
        $dist = geodist($lat,$lon,$prvlat,$prvlon);
        return error("$fln route $route $prvname $engnames{$prvname} to $name $engnames{$name} $dist Km in $dt hours") if $dist / $dt > 300;

        return error("$fln undefined engname for $prvname") unless defined $engnames{$prvname};
        return error("$fln undefined engname for $name") unless defined $engnames{$name};

        warning("$fln $prvname $engnames{$prvname} to $name $engnames{$name} " . sprintf("%.2f",$dist) . " Km in " . sprintf("%.2f",$dt) . " hours") if $dt > 0.5 and $dist / $dt < 10;
      }
      $prvlat = $lat; $prvlon = $lon;
      $prvctdep = $prvctdep1 = $ctdep;
      $prvctarr = $ctarr;
      $prvname = $name;
      $prvseq = $seq;

      # info("$tid,$name1,$seq,$tarr,$tdep");
      $stop_deps{$name} = $stop_arrs{$name} = 1;
      push @stop_times,join("\t",$tid,$name,$seq,$tarr,$tdep);

    } else { return error("$fln unhandled line $line"); }

  }

  info("unknown stations hicon:");
  $pname = 'newstations.txt';
  open($fh,'>:encoding(UTF-8)',$pname) or return error("cannot open $pname:$!");
  for $name (sort keys %nostations) {
    $cnt = $nostationcnt{$name};
    next if $cnt < 7;
    info("'$name' '$nostations{$name}' $cnt");
    print($fh "$name\t$nostations{$name}\t$cnt\n");
  }
  print($fh "\n");
  vrb("unknown stations:");
  for $name (sort keys %nostations) {
    $cnt = $nostationcnt{$name};
    next unless $cnt < 7;
    vrb("'$name' '$nostations{$name}' $cnt");
    print($fh "$name\t$nostations{$name}\t$cnt\n");
  }
  close $fh;
  return 1;
}

sub fixallcaps($)
{
  my $org = shift;
  return $org unless $org =~ '[A-Z]{4}';
  my $new = substr($org,0,1) . lc substr($org,1);
  return $new;
}

# returns (retval,handle,header,comment) first non-blank non-comment line is header
sub opengtfs($$$)
{
  my ($name,$csvmode,$utf8) = @_;
  my ($fh,$mode,$headline,$c);
  my $cmt;
  my $cmts = '';
  my $byprep = 0;
  my $linno = 0;

  return error("required $name not present") unless -f $name;
  return error("required $name is empty") unless -s $name;

  $gfilename = $name;

  if ($csvmode) {
    open($fh,'<:encoding(UTF-8)',$name) or return error("cannot open $name:$!");
    $headline = readline($fh);
    return error("$name is empty") unless defined $headline and length($headline);
    $headline =~ s/^\x{FEFF}//;  # remove BOM
    $headline =~ s/[\r\n]+$//;
    return (1,$fh,1,$headline,'');
  } else {
    if ($utf8) { $mode = '<:encoding(UTF-8)'; }
    else { $mode = '<'; }
    open($fh,$mode,$name) or return error("cannot open $name:$!");
    do {
      $headline = readline($fh);
      $linno++;
      return error("$name.$linno nil line") unless defined $headline and length($headline);
      $c = substr($headline,0,1);
      if ($c eq '#') {
        $cmt = substr($headline,3) if length($headline) > 4 and substr($headline,1,1) eq '#';
        if (defined($cmt) and length($cmt) > 1) {
          chop $cmt;
          info("$cmt");
          $cmts .= $cmt . "\n";
        }
        $byprep = 1 if index($headline,'gtfsprep') > 0;
      }
    }
    while ($c eq '#' or $c eq "\n");

    error_exit("$name.$linno not generated by gtfsprep") if $byprep == 0;

    chop $headline if length $headline;
    chop $cmt if length $cmts;
    return (1,$fh,$linno,$headline,$cmts);
  }
}

sub readagency($)
{
  my ($dir) = @_;

  my ($rv,$agency,$agencyfname);
  my ($col,$colname,$line,$headline);

  my ($id,$name,$url,$tzstr,$region,$rawline,$rawagency);
  my ($utchh,$utcmm,$dhh,$dmm,$utcofs12,$dstonof,$linno,$cmt);

  return error("missing dir arg for import") unless defined $dir and length($dir);

  $agencyfname = $dir . '/' . 'agency.tab';

  return error("required $agencyfname not present") unless -f $agencyfname;
  return error("required $agencyfname is empty") unless -s $agencyfname;

  info("reading $agencyfname");
  return info("dryrun") if $dryrun;

  ($rv,$agency,$linno,$headline,$cmt) = opengtfs($agencyfname,0,1);
  return 0 unless $rv;

  my $canoncols = "agency_id\tagency_name\tagency_timezone\tagency_url";
  error_exit("expected $canoncols, found $headline") unless index($headline,$canoncols) == 0;

  my @lines = readline($agency);
  close($agency);
  error_exit("$agencyfname is empty") unless (@lines > 0);
  my $linno = 0;

  my $linecnt = scalar(@lines);

  vrb(plural($linecnt,"line"));

  foreach $line (@lines) {

    chop $line;
    $linno++;
    next unless length $line;
    $fln = sprintf('%s.%u ',$agencyfname,$linno);

    ($ag_id,$name,$tzstr,$url) = split "\t",$line;

    return error("$fln agency has no id or name $line") unless defined $ag_id or defined $name;
    return error("$fln agency '$name' has no id") unless defined $ag_id and length $ag_id;
    return error("$fln agency '$id' has no name") unless defined $name and length $name;

    $id = $linno;
    return error("$fln agency $ag_id $ag_name previously defined on line $agencyids{$ag_id}") if exists($agencyids{$ag_id});
    $agencyids{$ag_id} = $id;
    $agency_ids{$id} = $ag_id;
    $agencyrids{$id} = 0;

    $tzstr = '' unless defined $tzstr;
    $url = '' unless defined $url;

    if (length($tzstr)) {
      ($utchh,$utcmm,$dhh,$dmm,$dstonof) = tz2ofs($tzstr,$agencyfname . '.' . $linno);
      $utcofs12 = int(($utchh + 12) * 100) + $utcmm;
      info(sprintf("  '%s' utc%+02d:%02u %s",$id,$utchh,$utcmm,$dstonof));
    } else { $utcofs12 = 0; $dstonof = 0; }

    $agline = join("\t",$ag_id,$name,$tzstr,$utcofs12,$dstonof,$url);

    $agencies{$id} = $agline;

    # take first one to identify overall feed if feed_info missing

    $agencycnt++;
  }

  if ($agencycnt == 0) { return error("no agencies"); }
  else if $agencycnt == 1) {
    info("agency: '$name' $ag_id");
    $agencyname = $name;
    $agencyid = $id;
  } else { info("$agencycnt agencies"); }
  return 1;
}

sub readfeedinfo($)
{
  my ($dir) = @_;

  my ($rv,$file,$fname,$headline);
  my ($col,$colname,$line);
  my ($col_id,$col_name,$col_tz);

  return error("missing dir arg for import") unless defined $dir and length($dir);

  $fname = $dir . '/' . 'feed_info.txt';

  return info("optional $fname not present") unless -f $fname;
  return info("optional $fname is empty") unless -s $fname;

  info("reading $fname");
  return info("dryrun") if $dryrun;

  ($rv,$file,$headline) = opengtfs($fname,1,1);
  return 0 unless $rv;

  my @colnames = split(',',$headline);
  my @cols;
  my $colid = 0;

  foreach $colname (@colnames) {
    $col_name = $colid if ($colname eq 'feed_publisher_name');
    $col_id = $colid if ($colname eq 'feed_id');
    $colid++;
  }

  my @lines = readline($file);
  close($file);
  return warning ("$fname is empty") unless (@lines > 0);

  my $linecnt = scalar(@lines);

  info("$fname has $linecnt entries, reading first entry only") if $linecnt > 1;

  my $id = '';
  my $name = '';

  $line = $lines[0];

  @cols = split ',',trimws($line);

  $id = $cols[$col_id] if defined $col_id;
  $name = $cols[$col_name] if defined $col_name;

  $feedpublisher = $name;

  return 1;
}

my $latscale = 1000000;  # 10 cm
my $lonscale = 1000000;  # 20 cm
my $pi = 3.141592655;

# todo autoscale on bbox and have tripover read bbox+scale
sub str2lat($$)
{
  my ($lat,$linno) = @_;

  my ($ilat);

  $ilat = ($lat + 90) * $latscale;
  return int($ilat);
}

sub str2lon($$)
{
  my ($lon,$linno) = @_;

  my ($ilon);

  $ilon = ($lon + 180) * $lonscale;
  return int($ilon);
}

sub ilat2lat($)
{
  my ($ilat) = @_;

  my $lat = ($ilat / $latscale) - 90;
  return sprintf("%.*f",$geoacc,$lat);
}

sub ilon2lon($)
{
  my ($ilon) = @_;

  my $lon = ($ilon / $lonscale) - 180;
  return sprintf("%.*f",$geoacc,$lon);
}

my $geolow = $pi * 2.0e-6;  # ~50m
my $geolimit = $pi * 1.0e-8;
my $mean_earth_radius = 6371.0;
my $approx_surface = sqrt($mean_earth_radius * $mean_earth_radius + $mean_earth_radius * $mean_earth_radius);

sub acos { atan2( sqrt(1 - $_[0] * $_[0]), $_[0] ) }

# Adapted from Tripover:math.c which in turn is adapted from Wikipedia article
sub geodist($$$$)
{
  my ($slat,$slon,$lat,$lon) = @_;

  my ($dist,$dlat,$dlon);

  my $phi1 = ($slat * $pi) / 180;
  my $lam1 = ($slon * $pi) / 180;
  my $phi2 = ($lat * $pi) / 180;
  my $lam2 = ($lon * $pi) / 180;

  my $dlam = $lam2 - $lam1;
  my $dphi = $phi2 - $phi1;

  return 0 if abs($dlam) < $geolimit and abs($dphi) < $geolimit; # flush to zero

  if (abs($dlam) < $geolow and abs($dphi) < $geolow) { # trivial case: assume flat
    $dlat = $dlam * $approx_surface * 2 / $pi;
    $dlon = ($dphi * $approx_surface * 2) / $pi;
    $dist = sqrt( ($dlat * $dlat) + ($dlon * $dlon));
    return $dist;
  }

  my ($d,$dsig);

  $d = sin($phi1) * sin($phi2) + cos($phi1) * cos($phi2) * cos($dlam);
  if ($d >= 1.0) { error("geodist d $d for $phi1 $phi2 $lam1 $lam2"); return 0; }
  elsif ($d <= -1.0) { error("geodist d $d for $phi1 $phi2 $lam1 $lam2"); return 0; }

  $dsig = acos($d);

  $dist = $dsig * $mean_earth_radius;
  return $dist;
}

my $stops_canoncols = "stop_id\tstop_code\tlocation_type\tparent_station\tstop_name\tstop_name_int\tstop_lat\tstop_lon\tstop_desc";

sub readstops($)
{
  my ($dir) = @_;

  my ($stopfile,$stopsname,$anafile,$rv,$headline);
  my ($col,$colid,$colname,$line,$comma,$endq,$c,$req,$val,$fln);
  my ($id,$stopid,$stopid2,$rstopid,$xname);
  my ($code,$name,$intname,$sname,$desc,$lat,$lon,$zone_id,$url,$loctype,$parent,$platform,$opt,$tzname);
  my ($name2,$lat2,$lon2,$ilat2,$ilon2,$parent2,$loctype2,$code2,$desc2);
  my ($uniparent,$parentid,$parent1,$rparent,$isparent,$hasparent,$newparent,$newparentid);
  my ($ilat,$ilon);
  my ($simlst,$simstr,$simstop,$stopstr);
  my ($slat,$slon,$dist,$diststr,$nearby);
  my (%simlats,%simlons);
  my ($ilatcell,$iloncell,$acell,$ocell,$candidate,$candidates);
  my %sims;
  my (@simocells,@simacells);

  return error("missing dir arg for import") unless defined $dir and length($dir);

  $stopsname = $dir . '/' . 'stops.tab';

  info("reading $stopsname");
  return info("dryrun") if $dryrun;

  ($rv,$stopfile,$headline,$stopcmt) = opengtfs($stopsname,0,1);
  return 0 unless $rv;

  error_exit("expected $stops_canoncols, found $headline") unless index($headline,$stops_canoncols) == 0;

  my @lines = readline($stopfile);
  close($stopfile);
  $gfilename = '';
  error_exit("$stopsname is empty") unless (@lines > 0);
  my $linno = 0;

  my $linecnt = scalar(@lines);

  info("$linecnt lines");

  my $filtercnt = 0;
  my $infercnt = 0;
  my $instopcnt = 0;
  my $childstopcnt = 0;
  my $mergedupcnt = 0;
  my $mergedupcnt2 = 0;
  my $mergedupcnt3 = 0;

  $linno = 1;
  foreach $line (@lines) {
    $c = chop $line;
    $linno++;
    next unless length $line;
    $glinno = $linno;

    $fln = "$stopsname.$linno: ";
    ($id,$code,$loctype,$parent,$name,$intname,$lat,$lon,$desc,$tzname) = split "\t",$line;
    $desc = '' unless defined $desc;
    $parent = '' unless defined $parent;

    return error("$fln empty stop ID") unless defined $id and length $id;
    return error("$fln unnamed stop $id") unless defined $name and length $name;
    return error("$fln no timezone for stop $id $name") unless defined $tzname and length $tzname;
    return error("$fln no lat for stop $id $name") unless defined $lat and length $lat and $lat ne '#Inf' and $lat ne '#NaN';
    return error("$fln no lon for stop $id $name") unless defined $lon and length $lon and $lon ne '#Inf' and $lon ne '#NaN';

    $instopcnt++;

    if (exists($rstopids{$id})) {
      warning("$linno: stop id '$id' already defined on line $rstopids{$id}");
      $filtercnt++;
      next;
    } elsif (defined $stops2ignore{$id}) {
      info("$linno: filter stop id $id : $stops2ignore{$id}");
      $filtercnt++;
      next;
    }
    # gtfs ID may be integer or string. must be unique in set
    # tripover needs an integer : use line number as derived id
    $rstopid = $linno;
    $hirstopid = max($hirstopid,$rstopid);
    $rstopids{$id} = $rstopid;
    $rstopbyid{$rstopid} = $id;

    $ilat = str2lat($lat,$linno);
    $ilon = str2lon($lon,$linno);

    $isparent = 0;
    if (length($loctype)) {
      if ($loctype eq '1') { $isparent = 1; }
      elsif ($loctype eq '0') { $isparent = 0; }
      else {
        warning("$linno: stop $name has unknown location type $loctype");
        $loctype = '0';
      }
    }

    if ($isparent == 0 and length($parent)) {
      warning("$linno: stop $name has self as parent") if $parent eq $id;
    }

    $stopmerge{$rstopid} = $rstopid;

    $name = fixallcaps($name);
    $intname = '' unless defined $intname;

    tz2ofs($tzname,$stopsname . '.' . $linno); # check

    $rstops{$rstopid} = join("\t",$name,$intname,$lat,$lon,$ilat,$ilon,$parent,$loctype,$code,$desc,$tzname);

    if (index($id,$geomagic) < 0) { $stopdeps[$rstopid] = $stoparrs[$rstopid] = 0; }
    else { $stopdeps[$rstopid] = $stoparrs[$rstopid] = 1; }

  } # each line / stop in pass 1

  info("merged $mergedupcnt + $mergedupcnt2 stops on duplicate name and colocated") if $mergedupcnt or $mergedupcnt2;
  info("not merged $mergedupcnt3 stops on duplicate name and colocated") if $mergedupcnt3;

  # rescan stops, applying duplicate merging
  my %rstops1;

  foreach $rstopid (sort { $a <=> $b } keys %rstops) { # parents
    $id = $rstopbyid{$rstopid};

    $stopstr = $rstops{$rstopid};
    ($name,$intname,$lat,$lon,$ilat,$ilon,$rparent,$loctype,$code,$desc,$tzname) = split("\t",$stopstr);
    $tzname = '' unless defined $tzname;

    $hasparent = (length($rparent) > 0);
    if ($hasparent) {
      unless (exists($rstopids{$rparent})) {
        if ($omit_noparent) {
          info("omitting member stop id $id $name on no parent $rparent line $rstopid");
        } else {
          warning("$id $name has nonexistent parent $rparent on line $rstopid");
        }
        next;
      }
      $parentid = $stopmerge{$rstopids{$rparent}};
      $parent = $rstopbyid{$parentid};
      if ($parent ne $rparent) {
        infovrb($showmerge,"reparent $rparent to $parent for $id");
        $rstops1{$rstopid} = join("\t",$name,$lat,$lon,$ilat,$ilon,$parent,$loctype,$code,$desc,$tzname);
      } else { $rstops1{$rstopid} = $stopstr; }
    } else { $rstops1{$rstopid} = $stopstr; }
  }

  foreach $rstopid (sort { $a <=> $b } keys %rstops1) {  # stops
    $id = $rstopbyid{$rstopid};
    $stopstr = $rstops1{$rstopid};
    ($name,$intname,$lat,$lon,$ilat,$ilon,$parent,$loctype,$code,$desc,$tzname) = split("\t",$stopstr);

    $hasparent = (length($parent) > 0);
    if ($hasparent) {
      next unless exists($rstopids{$parent});
    }

    $stopid = $stopmerge{$rstopid};
    $id = $rstopbyid{$stopid};
    if ($stopid != $rstopid) {
      infovrb($showmerge,"merge $name id $id $rstopid to $stopid");
      next;
    }

    $stopids{$id} = $stopid;
    $stop_ids{$stopid} = $id;

    $stopnames{$stopid} = $name;
    $stopinames{$stopid} = $intname;

    $isparent = 0;
    if ($loctype eq '1') { $isparent = 1; }

    $hasparent = (length($parent) > 0);
    if ($hasparent and $isparent) {
      warning("$linno: parent stop $name has parent $parent");
      $hasparent = 0;
    }

    $simlats{$stopid} = $lat;
    $simlons{$stopid} = $lon;

    if ($isparent) {
      $parentids{$id} = $stopid;
      $parent_ids{$stopid} = $id;
      $parentcnt++;
      $opt = $opt_parentstop;
    } elsif ($hasparent) {  # refers to id above
      $opt = $opt_childstop;
      $parents{$parent} .= $stopid . ' ';
      $parentbyid{$stopid} = $parent;
    } else {
      $opt = 0;
    }

    if (index($id,$geomagic) < 0) {
      $stopdeps[$stopid] = $stoparrs[$stopid] = 0;
    } else {
      $opt |= $opt_geostop;
      $stopdeps[$stopid] = $stoparrs[$stopid] = 1;
    }

    error_exit("no stop code for $rstopid") unless defined $code;
    error_exit("no id for $rstopid") unless defined $id;
    error_exit("no parent for $rstopid") unless defined $parent;
    error_exit("duplicate stop $stopid for $rstopid") if exists $stops{$stopid};

    $stops{$stopid} = join("\t",$name,$intname,$ilat,$ilon,$code,$desc,$opt,$tzname);
  }

  my (@sibstops,$stoplst);

  while (($parent,$parent1) = each %parentdups) {
    next unless exists $parents{$parent};
    $stoplst = $parents{$parent};
    $parents{$parent} = '';
    $parents{$parent1} .= $stoplst;
    @sibstops = split(' ',trimws($stoplst));
    for $stopid (@sibstops) {
      $parentbyid{$stopid} = $parent1;
    }
  }

  my ($simname,$simdiff,$candidate2);
  my (@sims1);
  my %simdups;

  $stopcnt = scalar(keys %stops);

  $infercnt = 0;
  $parentcnt += $infercnt;
  $stopcnt += $infercnt;

  foreach $stopid (keys %stops) {
    if (exists $parentbyid{$stopid}) {
      $parent = $parentbyid{$stopid};
      warning("no parent for $parent") unless exists $parentids{$parent};
      $parentid = $parentids{$parent};
      $stop2parent{$stopid} = $parentid;
      $childstopcnt++
    } else {
      $stop2parent{$stopid} = $stopid;
    }
  }

  my $mline = "$stopcnt from $instopcnt stops";
  $mline .= " $parentcnt stations" if $parentcnt;
  $mline .= " $infercnt inferred" if $infercnt;
  $mline .= " $parentdupcnt merged" if $parentdupcnt;
  $mline .= " $filtercnt filtered" if $filtercnt;
  info($mline);
  my $outstopcnt = $stopcnt - $childstopcnt;
  info("$childstopcnt station members $outstopcnt total planning stops");

  return 1;
}

my @modenames = ( "tram","metro","rail","bus","ferry","cable car","gondola","funicular" );

# extended types from support.google.com/transitpartners/answer/3520902
sub extrtype($)
{
  my $xr = shift;

  return 2 if $xr >= 100 and $xr < 118;
  return 3 if $xr >= 200 and $xr < 210;
  return 2 if $xr == 300 or $xr == 400 or $xr == 403 or $xr == 404;
  return 1 if $xr == 401 or $xr == 402 or $xr == 405 or $xr == 500 or $xr == 600;
  return 3 if $xr >= 700 and $xr < 717;
  return 3 if $xr == 800;
  return 2 if $xr >= 900 and $xr < 907;
  return 4 if $xr >= 1000 and $xr < 1022;
  return 1101 if $xr == 1103 or $xr == 1106 or $xr == 1107 or $xr == 1112 or $xr == 1114;
  return 1102 if $xr == 1104 or $xr == 1105 or $xr == 1108 or $xr == 1109 or $xr == 1110 or $xr == 1111 or $xr == 1113;
  return 4 if $xr == 1200;
  return $xr;
}

sub filtermode($)
{
  my ($xtype) = @_;

  my $type = extrtype($xtype);
  return 0 if $type == 0 and $include_tram == 0;
  return 0 if $type == 1 and $include_metro == 0;
  return 0 if $type == 2 and $include_rail == 0;
  return 0 if $type == 3 and $include_bus == 0;
  return 0 if $type == 4 and $include_ferry == 0;
  return 0 if $type == 5 and $include_cabcar == 0;
  return 0 if $type == 6 and $include_gondola == 0;
  return 0 if $type == 1101 and $include_int_air == 0;
  return 0 if $type == 1102 and $include_dom_air == 0;
  return 0 if $type == 1500 and $include_taxi == 0;
  return 1;
}

my %agroutes;

sub readroutes($)
{
  my ($dir) = @_;

  my ($routefile,$routefname,$rv,$headline);
  my ($line,$c,$linno);
  my ($route_id,$agency_id,$routeid,$utcofs12,$name,$sname,$lname,$slname,$desc,$rtype,$modename);
  my ($reserveprefix,$reserve,$fare,$magic,$agency,$routepfx,$pfxpos);

  $routefname = $dir . '/' . 'routes.tab';

  info("reading $routefname");
  return info("dryrun") if $dryrun;

  ($rv,$routefile,$linno,$headline,$cmt) = opengtfs($routefname,0,1);
  return 0 unless $rv;

  my $canoncols = "route_id\tagency_id\troute_type\troute_short_name\troute_long_name\troute_desc\tfare";
  error_exit("expected $canoncols, found $headline") unless index($headline,$canoncols) == 0;

  my @lines = readline($routefile);
  close($routefile);
  $gfilename = '';
  error_exit("$routefname is empty") unless (@lines > 0);

  my $linecnt = scalar(@lines);

  vrb("$linecnt lines");

  foreach $line (@lines) {
    $c = chop $line;

    $linno++;
    $glinno = $linno;

    next unless length $line;

    ($route_id,$agency_id,$rtype,$sname,$lname,$desc,$fare) = split "\t",$line;

    return error("$linno: route $route_id has no agency") unless defined $agency_id and length $agency_id;

    return error("$linno: route $route_id has unknown agency $agency_id") unless exists $agencyids{$agency_id};
    $agid = $agencyids{$agency_id};

    $fare = 0 unless defined $fare and length $fare;
    return error("$linno: route $route_id has no fare") unless $fare =~ '^[0-9]+';

    $desc = '' unless defined $desc;

    $sname = fixallcaps($sname) if defined $sname and length($sname) > 8;
    $lname = fixallcaps($lname) if defined $lname;

    if (defined $sname and defined $lname) { $slname = $sname . ' ' . $lname; }
    elsif (defined $sname) { $slname = $sname; }
    elsif (defined $lname) { $slname = $lname; }
    else { $slname = '(unnamed)'; warning("$linno: route has no name $route_id $desc"); }

    unless ($rtype =~ qr'^[0-9]+$') {
      error_exit("line $linno: route_type $rtype not numerical");
      next;
    }

    $pfxpos = rindex($route_id,'/');

    # vrb("$linno $route_id '$slname' $rtype");
    $routeid = $linno;

    if (exists($routeids{$route_id})) {
      warning("$linno: route id $route_id $slname already defined on line $routeids{$route_id}");
      next;
    }

    $routebyids{$routeid} = $route_id;
    $routeids{$route_id} = $routeid;
    $routeagency{$routeid} = $agency_id;
    $rtypes{$routeid} = $rtype;

    $reserve = 0;
    if (index($route_id,$canonmagic) >= 0) {
      $iscanonin = 1;
      ($magic,$reserveprefix) = split '_',$route_id;
      $reserve = 1 if defined $reserveprefix and $reserveprefix eq 'r';
    } else { $reserve = $allreserved; }
    $routeres{$routeid} = $reserve;

    if (filtermode($rtype)) {
      push(@routes,join("\t",$route_id,$agency_id,$reserve,$fare,'',$slname,$rtype));
      $routetrips{$route_id} = 0;
      $hirrid = max($hirrid,$routeid);
      $agencyrids{$agid}++;
    } else {
      $noroutecnt++;
      if ($rtype < @modenames) { $modename = $modenames[$rtype]; }
      else { $modename = "unknown"; }
      info("filter route $route_id mode $modename = $rtype at line $linno");
      $norouteids{$route_id} = $routeid;
    }

    if ($chkdupagroute) {
      $agency = $agencynames{$agency_id};
      if ($agency ne 'unnamed' and $rtype != 1500 and $rtype != 1101 and $rtype != 1102) {
        $slname .= ' ' . substr($agency,0,40);
        $slname .= '...' if length($agency) > 40;
      }
      if (exists($agroutes{$slname})) {
        uwarning("$linno: $route_id and $agroutes{$slname} dup name $slname");
      } else {
        $agroutes{$slname} = $route_id;
      }
    }

    $routecnt = scalar(@routes);
    if ($routelim and $routecnt >= $routelim) {
      warning("limiting routes to $routelim");
      last;
    }

  } # each line

  info("$routecnt routes" . ($noroutecnt ? ", $noroutecnt filtered out" : ""));

  return 1;
}

# todo read transfers and write into 'hops' with type, mintime and zero times
sub readxfers($)
{
  my ($dir) = @_;

  my ($xferfile,$xferfname,$rv,$headline,$setid);
  my ($line,$c);
  my ($fstop_id,$tstop_id,$fstopid,$tstopid,$type,$mintt);

  $xferfname = $dir . '/' . 'transfers.tab';

  info("reading $xferfname");
  return info("dryrun") if $dryrun;

  return info("optional $xferfname not present") unless -f $xferfname;
  return info("optional $xferfname is empty") unless -s $xferfname;

  ($rv,$xferfile,$headline) = opengtfs($xferfname,0,1);
  return 0 unless $rv;

  my $canoncols = "from_stop_id\tto_stop_id\ttransfer_type\tmin_transfer_time";
  error_exit("expected $canoncols, found $headline") unless index($headline,$canoncols) == 0;

  my @lines = readline($xferfile);
  close($xferfile);
  return info("$xferfname is empty") unless (@lines > 0);

  my $linno = 1;
  my $linecnt = scalar(@lines);
  my @types = (0,0,0,0);
  my $dupcnt = 0;

  vrb("$linecnt lines");

  foreach $line (@lines) {
    $c = chop $line;

    $linno++;
    $glinno = $linno;

    next if $line eq $headline;  # support catenated files if same col layout
    next unless length $line;
    next if substr($line,0,1) eq '#';

    ($fstop_id,$tstop_id,$type,$mintt) = split "\t",$line;

    return error("$linno: incomplete line") unless defined $mintt;

    return error("$linno: non-numerical type $type") unless $type =~ '^[0-9]+$';
    return error("$linno: non-numerical time $mintt") unless $mintt =~ '^[0-9]+$';

    $types[$type]++;

    return error("$linno: unknown stop ID $fstop_id") unless exists $stopids{$fstop_id};
    return error("$linno: unknown stop ID $tstop_id") unless exists $stopids{$tstop_id};
    $fstopid = $stopids{$fstop_id};
    $tstopid = $stopids{$tstop_id};

    $setid = join("\t",$fstopid,$tstopid);
    if (exists($xfersets{$setid})) {
#      info("$linno: duplicate transfer $setid in $line");
      $dupcnt++;
      next;
    }
    $xfersets{$setid} = join("\t",$type,$mintt);
#   info("$setid for $fstop_id $tstop_id");
    $xfercnt++;
  } # each line

  for ($type = 0; $type < 4; $type++) { info(" type $type: $types[$type]"); }
  return info("$xfercnt transfers  $dupcnt duplicate");
}

sub readtrips($)
{
  my ($dir) = @_;

  my ($tripfile,$tripfname,$rv,$headline);
  my ($val,$col,$colid,$colname,$line,$comma,$endq,$c,$req);
  my ($route_id,$routeid,$rtype,$trip_id,$tripid,$tripno,$service_id,$sid);
  my ($agency_id,$headsign,$org_routeid,$org_tripid,$utcofs,$dstonof);

  $tripfname = $dir . '/' . 'trips.tab';

  info("reading $tripfname");
  return info("dryrun") if $dryrun;

  ($rv,$tripfile,$headline) = opengtfs($tripfname,0,1);
  return 0 unless $rv;

  my $canoncols = "route_id\tservice_id\ttrip_id\torg_tripid\torg_routeid\ttrip_headsign";
  error_exit("expected $canoncols, found $headline") unless index($headline,$canoncols) == 0;

  my @lines = readline($tripfile);
  close($tripfile);
  error_exit("$tripfname is empty") unless (@lines > 0);

  my $filtercnt = 0;
  my $linno = 0;
  my $linecnt = scalar(@lines);

  info("$linecnt lines");

  foreach $line (@lines) {
    $c = chop $line;

    $linno++;
    next unless length $line;

    progress("processing trip %u of %u%s",$linno,$linecnt,'') if $linno == 1 or $linno >= $linecnt or ($linno % 100) == 0;

    ($route_id,$service_id,$trip_id,$org_tripid,$org_routeid,$headsign) = split "\t",$line;

    $headsign = '' unless defined $headsign;

    if (length($trip_id) == 0) {
      warning("$linno: missing trip id for route  $route_id");
      next;
    }
    if (exists($tripids{$trip_id})) {
      warning("$linno: trip id $trip_id previously defined on line $tripids{$trip_id}");
      next;
    }

    unless (exists($routeids{$route_id})) {
      $filtercnt++;
      info("$linno: unknown route id $route_id");
      next;
    }

    if (exists($norouteids{$route_id})) {
      vrb("$linno: filter route $route_id");
      $filtercnt++;
      next;
    } elsif (exists($noserviceids{$service_id})) {
      info("$linno: filter trip on service $service_id : $noserviceids{$service_id}");
      $filtercnt++;
      next;
    }
    unless (exists($serviceids{$service_id})) {
      $filtercnt++;
      info("$linno: unknown service id $service_id");
      next;
    }
    $sid = $serviceids{$service_id};
    unless (defined $servicedow{$sid}) {
      info("$linno: undefined dow for $service_id $sid");
      next;
    }
    unless (defined $serviceadd{$sid}) {
      warning("$linno: undefined add for $service_id $sid");
      next;
    }

    if ($servicedow{$sid} == 0 and $serviceadd{$sid} == 0) {
      info("$linno: skip trio $trip_id on empty sid $service_id");
      next;
    }

    $tripid = $linno;
    $tripids{$trip_id} = $tripid;
    $trip_ids{$tripid} = $trip_id;
    $orgtrip_ids{$tripid} = $org_tripid;
    $hitripid = $linno;

    $routeid = $routeids{$route_id};
    $triproutes{$tripid} = $routeid;
    $rtype = $rtypes{$routeid};

    info("trip $linno '$trip_id' route $routeid $route_id");

    $tripno = ''; # todo in rides.txt
    if ($rtype == 1101 || $rtype == 1102) { # air modes have flightno in headsign
      $tripno = $headsign;
    }
    $tripnos{$tripid} = $tripno;

    $sid = $serviceids{$service_id};
    error_exit("undefined sid for $service_id") unless defined $sid;

    warning("no agency for route $routeid $route_id") unless exists $routeagency{$routeid};
    $agency_id = $routeagency{$routeid};

    push(@trips,join("\t",$route_id,$service_id,$trip_id,$headsign,'',0));
    $tripservice{$trip_id} = $service_id;
    $routetrips{$route_id}++;

  } # each line

  $tripcnt = scalar(@trips);

  info("$tripcnt trips $filtercnt filtered highest ID $hitripid");

  return 1;
}

sub readfreqs($)
{
  my ($dir) = @_;

  my ($freqfile,$freqfname,$rv,$headline);
  my ($val,$line,$c,$freqs);
  my ($trip_id,$tripid,$org_tripid,$service_id);
  my ($start_time,$end_time,$starttime,$endtime,$headway_secs);
  my $freqcnt = 0;

  $freqfname = $dir . '/' . 'frequencies.tab';

  return info("optional $freqfname not present") unless -f $freqfname;
  return info("optional $freqfname is empty") unless -s $freqfname;

  info("reading $freqfname");
  return info("dryrun") if $dryrun;

  ($rv,$freqfile,$headline) = opengtfs($freqfname,0,1);
  return 0 unless $rv;

  my $canoncols = "trip_id\torg_tripid\theadway_secs\tstart_time\tend_time";
  error_exit("expected $canoncols, found $headline") unless index($headline,$canoncols) == 0;

  my @lines = readline($freqfile);
  close($freqfile);
  return info ("optional $freqfname is empty") unless (@lines > 0);

  my $linno = 1;
  my $linecnt = scalar(@lines);

  vrb("$linecnt lines");

  foreach $line (@lines) {
    $c = chop $line;

    $linno++;
    next if $line eq $headline;  # support catenated files if same col layout
    next unless length $line;
    next if substr($line,0,1) eq '#';

    ($trip_id,$org_tripid,$headway_secs,$start_time,$end_time) = split "\t",$line;

    return error("$linno: empty line") unless defined $trip_id and length $trip_id;

    unless (exists($tripids{$trip_id})) {
      warning("line $linno: unknown trip id $org_tripid");
      next;
    }
    return error("$linno: missing start time") unless defined $start_time and length $start_time;
    return error("$linno: missing end time") unless defined $end_time and length $end_time;
    return error("$linno: missing interval") unless defined $headway_secs and length $headway_secs;

    return error("$linno: unknown interval $headway_secs") unless $headway_secs =~ qr'^[0-9]+$';

    return error("$linno: trip $trip_id has unknown sid") unless exists $tripservice{$trip_id};
    $service_id = $tripservice{$trip_id};

    $tripid = $tripids{$trip_id};

    $starttime = hhmm2sec($start_time,"line $linno");
    $endtime = hhmm2sec($end_time,"line $linno");

    $freqs = join(' ',$headway_secs,$starttime,$endtime);

    if (exists $tripfreqs{$tripid}) {
      push @{ $tripfreqs{$tripid} },$freqs;
    } else {
      $tripfreqs{$tripid} = [ ($freqs) ];
      $freqcnt++;
    }

  } # each line

  info("$freqcnt trips with frequency schedule");

  return 1;
}

sub readcalendar($)
{
  my ($dir) = @_;

  my ($val,$col,$colid,$colname,$line,$comma,$endq,$c,$req,$fln);
  my ($service_id,$sid,$t0,$t1,$day,$dayno,$dows,$dow,$utcofs);
  my $filtercnt = 0;
  my @days;

  my $calfname = $dir . '/' . 'calendar.tab';

  info("reading $calfname");
  return info("dryrun") if $dryrun;

  return info("optional $calfname not present") unless -f $calfname;
  return info("optional $calfname is empty") unless -s $calfname;

  my ($rv,$calfile,$headline,$stamp) = opengtfs($calfname,0,1);
  return 0 unless $rv;

  $feedstamp = $stamp if length $stamp;

  my $canoncols = "service_id\tmonday\ttuesday\twednesday\tthursday\tfriday\tsaturday\tsunday\tstart_date\tend_date";
  error_exit("expected $canoncols, found $headline") unless index($headline,$canoncols) == 0;

  my @lines = readline($calfile);
  close($calfile);
  return info("optional $calfname is empty") unless (@lines > 0);

  my $linno = 1;
  my $analines = '';

  my $linecnt = scalar(@lines);

  info("$linecnt lines");

  foreach $line (@lines) {
    $c = chop $line;

    $linno++;
    next if $line eq $headline;  # support catenated files if same col layout
    next unless length $line;
    next if substr($line,0,1) eq '#';

    $fln = "calendar.tab:$linno";

    ($service_id,$days[6],$days[5],$days[4],$days[3],$days[2],$days[1],$days[0],$t0,$t1) = split "\t",$line;

    $sid = $linno;

    if (length($service_id) == 0) {
      warning("$fln: missing service id");
      next;
    } elsif (exists($serviceids{$service_id})) {
      warning("$fln: service id $service_id previously defined on line $serviceids{$service_id}");
      $filtercnt++;
      next;
    } elsif (exists($sids2ignore{$service_id})) {
      $noserviceids{$service_id} = "ignored sid $sid";
      info("$fln: filter service id $service_id : $sids2ignore{$service_id}");
      $filtercnt++;
      next;
    }
    unless (length $t0) {
      warning("$fln: no start date");
      next;
    }
    unless (length $t1) {
      warning("$fln: no end date");
      next;
    }
    return error("$fln: start date $t0 invalid") if $t0 =~ $nondigits;
    return error("$fln: end date $t1 invalid") if $t1 =~ $nondigits;

    if ($t0 == 0) {
      $noserviceids{$service_id} = "no time range $t0 $t1 $sid";
      next;
    }
    $dows = '..............';
    $dow = 0; $dayno = 0;
    for $dayno (0 .. 6) {
      $day = $days[$dayno];
      return error("$fln: $day not 0 or 1") if $day ne '0' and $day ne '1';
      $dow <<= 1;
      if ($day) {
        $dow |= 1;
        substr($dows,(6 - $dayno) * 2,2,substr('SuSaFrThWeTuMo',$dayno * 2,2));
      }
    }

    if ($dow == 0) {
      vrb("$fln: empty service id $service_id");
    }

    warning("$fln: end time $t1 before start time $t0") if $t1 < $t0;

    $hisid = max($sid,$hisid);
    $serviceids{$service_id} = $sid;
    $servicedow{$sid} = $dow;
    $servicet0{$sid} = $t0;
    $servicet1{$sid} = $t1;
    $serviceadd{$sid} = [()];
    $servicesub{$sid} = [()];
    $mint0 = min($t0,$mint0);
    $maxt1 = max($t1,$maxt1);

    if (defined $rsids2watch{$sid} or defined $rsids2watch{'*'}) {
      $analines .= sprintf("rsid %02x.%02u: $t0 .. $t1 at $dows %x '$service_id'\n",$sid,$sid,$dow);
    }
    push @calendar,join("\t",$service_id,$days[6],$days[5],$days[4],$days[3],$days[2],$days[1],$days[0],$t0,$t1);
  } # each line

  $sidcnt = scalar(keys %serviceids);
  info("$sidcnt services $filtercnt filtered, overall period $mint0 to $maxt1");

  return 1 unless length $analines;

  my $anafile;
  open($anafile,'>',$anadir . '/rsids.log') or return 1;
  print($anafile $analines);
  close($anafile);

  return 1;
}

#  check sid range, disable if empty
sub chksids()
{
  my ($rsid,$sid,$dows,$dowbit,$t0,$t1,$t,$add,$sub);
  my (@adds,@subs);

  while (($rsid,$sid) = each %serviceids) {
    info("check sid $rsid");
    my @map;
    $dows = $servicedow{$sid};
    $t0 = $servicet0{$sid};
    $t1 = $servicet1{$sid};

    # roll out day map
    $dowbit = 1 << getdow($t0);
    for ($t = $t0; $t <= $t1; $t++) {
      $map[$t] = 1 if ($dowbit & $dows);

      $dowbit <<= 1;
      $dowbit = 1 if $dowbit == (1 << 7);
    }
    @adds = @{ $serviceadd{$sid} };
    foreach $add (@adds) {
      if ($add < $t0) {
        warning("sid $sid: added date $add before $t0 $rsid");
        $t0 = $servicet0{$sid} = $add;
      }
      if ($add > $t1) {
        warning("sid $sid: added date $add after $t1 $rsid");
        $t1 = $servicet1{$sid} = $add;
      }
      $map[$add] = 1;
    }
    @subs = @{ $servicesub{$sid} };
    foreach $sub (@subs) {
      $map[$sub] = 0 if $map[$sub];
    }

    for ($t = $t0; $t <= $t1; $t++) {
      last if $map[$t] and $map[$t] == 1;
    }
    next if $t <= $t1;

    # disable empty sid
    $noserviceids{$rsid} = $sid;
    info("disabling empty rsid $rsid");
  }
}

sub readcaldates($)
{
  my ($dir) = @_;

  my ($calfile,$calfname,$rv,$headline);
  my ($val,$col,$colid,$colname,$line,$comma,$endq,$c,$req);
  my ($service_id,$sid,$date,$extype,$t0,$t1);
  my $filtercnt = 0;

  $calfname = $dir . '/' . 'calendar_dates.tab';

  info("reading $calfname");
  return info("dryrun") if $dryrun;

  return info("optional $calfname not present") unless -f $calfname;
  return info("optional $calfname is empty") unless -s $calfname;

  ($rv,$calfile,$headline) = opengtfs($calfname,0,1);
  return 0 unless $rv;

  my $canoncols = "service_id\texception_type\tdate";
  error_exit("expected $canoncols, found $headline") unless index($headline,$canoncols) == 0;

  my @lines = readline($calfile);
  close($calfile);
  error_exit("$calfname is empty") unless (@lines > 0);

  my $linno = 1;
  my $linecnt = scalar(@lines);

  info("$linecnt lines");

  foreach $line (@lines) {
    $c = chop $line;

    $linno++;
    next if $line eq $headline;  # support catenated files if same col layout
    next unless length $line;
    next if substr($line,0,1) eq '#';

    ($service_id,$extype,$date) = split "\t",$line;

    $date += $dateshift;

    if (length($service_id) == 0) {
      warning("$linno: missing service id");
      $filtercnt++;
      next;
    } elsif ($extype ne '1' and $extype ne '2') {
      warning("$linno: exception_type $extype not 1 or 2");
      $filtercnt++;
      next;
    } elsif (exists($sids2ignore{$service_id})) {
      info("$linno: filter service id $service_id : $sids2ignore{$service_id}");
      $filtercnt++;
      next;
    } elsif (exists($serviceids{$service_id})) {  # modify existing regular sid
      $sid = $serviceids{$service_id};

      $t0 = $servicet0{$sid};
      $t1 = $servicet1{$sid};
      if ($extype == 1) {
        delete $noserviceids{$service_id};
        if ($date < $t0) {
          $servicet0{$sid} = $date;
        } elsif ($date > $t1) {
          $servicet1{$sid} = $date;
        }
        push (@{ $serviceadd{$sid} },$date);
        $mint0 = min($date,$mint0);
        $maxt1 = max($date,$maxt1);
      } elsif ($extype == 2) {
        if (exists($noserviceids{$service_id})) {  # filtered in calendar.txt
          $filtercnt++;
          next;
        }
        if ($date < $t0) {
          vrb("line $linno: excluding day $date below $service_id range $t0 .. $t1");
        } elsif ($date > $t1) {
          vrb("line $linno: excluding day $date above $service_id range $t0 .. $t1");
        } else {
          push (@{ $servicesub{$sid} },$date);
        }
      } else {
        warning("line $linno: unknown service type $extype");
      }
      push @caldates,join("\t",$service_id,$date,$extype);
    } elsif (exists($noserviceids{$service_id})) {
      vrb("$linno: service id $service_id previously filtered at calendar : $noserviceids{$service_id}");
      next;
    } else {            # not in calendar.txt
      if ($extype != 1 and $extype != 2) {
        warning("line $linno: unknown service type $extype");
        next;
      }
      $sid = $hisid + $linno;
      $serviceids{$service_id} = $sid;
      $servicet0{$sid} = $date;
      $servicet1{$sid} = $date;
      $servicedow{$sid} = 0;
      $serviceadd{$sid} = [()];
      $servicesub{$sid} = [()];
      $serviceadd{$sid} = [($date)] if $extype == 1;
      $servicesub{$sid} = [($date)] if $extype == 2;
      $mint0 = min($date,$mint0);
      $maxt1 = max($date,$maxt1);
      push @caldates,join("\t",$service_id,$date,$extype);
    }
  } # each line

  $sidcnt = scalar(keys %serviceids);
  info("$sidcnt services $filtercnt filtered, overall period $mint0 to $maxt1");

  return 1;
}

sub toparent($)
{
  my ($stopid) = @_;

  return $stopid unless exists $parentbyid{$stopid};
  my $parent = $parentbyid{$stopid};
  return $parentids{$parent};
}

sub haveconns($)
{
  my ($stopid) = @_;

  $stopid = toparent($stopid);

  return 1 if ($stopdeps[$stopid] > 0 or $stoparrs[$stopid] > 0);
  return 0;
}

# handle connectivity
sub do_conn()
{
  my ($stopid,$pstopid,$id,$cid,$name,$pname,$prefix,$pfxpos,$cnt,$dacnt,$daperc);
  my ($concnt,$ndep,$narr,$depcnt,$arrcnt,$parent,$parentid);
  my ($service_id,$sid);
  my $noconcnt = 0;
  my $qconcnt = 0;
  my (%unconns,%depconns,%arrconns,%daconns);

  # show some connectivity stats
  if ($noroutecnt == 0) {
    while (($id,$stopid) = each %stopids) {
      $name = $stopnames{$stopid};
      if (exists $stops2watch{$id}) {
        info("stop $id $name $stops2watch{$id} has $stopdeps[$stopid] deps and $stoparrs[$stopid] arrs");
      }
      $pstopid = toparent($stopid);
      $pfxpos = rindex($id,'/');
      if ($pfxpos > 0) { $prefix = substr($id,0,$pfxpos); }
      else { $prefix = ''; }

      $ndep = $stopdeps[$pstopid]; $narr = $stoparrs[$pstopid];
      if ($ndep == 0 and $narr != 0) {
        info("stop $id $name has no departures, " . plural($narr,'arrival')) if $stopid == $pstopid;
        $depconns{$prefix}++;
      } elsif ($ndep != 0 and $narr == 0) {
        info("stop $id $name has no arrivals, " . plural($ndep,'departure')) if $stopid == $pstopid;
        $arrconns{$prefix}++;
      }
      $daconns{$prefix}++;
      $qconcnt++;
    }

    while ( ($prefix,$cnt) = each %depconns) {
      $dacnt = $daconns{$prefix};
      info("$prefix: $cnt of $dacnt no deps") if $cnt * 100 >= $dacnt or $cnt > 10;
    }
    while ( ($prefix,$cnt) = each %arrconns) {
      $dacnt = $daconns{$prefix};
      info("$prefix: $cnt of $dacnt no arrs") if $cnt * 100 >= $dacnt or $cnt > 10;
    }

    info('');
    while (($id,$stopid) = each %stopids) {
      $name = $stopnames{$stopid};

      if ($stopdeps[$stopid] == 0 and $stoparrs[$stopid] == 0) {
        uwarning("stop $id $stopid $name is unconnected");
        $pfxpos = rindex($id,'/');
        if ($pfxpos > 0) {
          $prefix = substr($id,0,$pfxpos);
          $unconns{$prefix}++;
        }
        $noconcnt++;
        next;
      }

      $pstopid = toparent($stopid);
      $pname = $stopnames{$pstopid};
      if ($stopdeps[$pstopid] == 0 and $stoparrs[$pstopid] == 0) {
        if ($stopid == $pstopid) {
          uwarning("stop $id $name is unconnected");
          $pfxpos = rindex($id,'/');
          if ($pfxpos > 0) {
            $prefix = substr($id,0,$pfxpos);
            info("prefix $prefix");
            $unconns{$prefix}++;
          }
          while (($cid,$parent) = each %parentbyid) {
            info("  member stop $cid $stop_ids{$cid} $stopnames{$cid}") if $parent eq $id;
          }
        } else { uwarning("stop $id $name parent $pname is unconnected"); }
      }
    }
    if ($routelim == 0 and $noconcnt * 5 > $qconcnt) { return error("$noconcnt of $qconcnt stops unconnected"); }

    while ( ($prefix,$cnt) = each %unconns) {
      $dacnt = $daconns{$prefix};
      $daperc = ($cnt * 100) / max($dacnt,1);
      info(sprintf("%20s: %5u of %5u = %u%% unconnects",$prefix,$cnt,$dacnt,$daperc)) if $cnt * 100 >= $dacnt;
    }

  } # noroutecnt

  my ($nodacnt,$dep0cnt,$arr0cnt);
  $nodacnt = 0; $dep0cnt = 0; $arr0cnt = 0;

  for $stopid (values %stopids) {
    $stopid = toparent($stopid);
    $ndep = $stopdeps[$stopid]; $narr = $stoparrs[$stopid];
    $nodacnt++ if $ndep == 0 and $narr == 0;
    $dep0cnt++ if $ndep == 0 and $narr != 0;
    $arr0cnt++ if $narr == 0 and $ndep != 0;
  }
  info("stops without connection : $nodacnt") if $nodacnt;
  info("stops with no departures : $dep0cnt") if $dep0cnt;
  info("stops with no arrivals   : $arr0cnt") if $arr0cnt;

  while (($service_id,$sid) = each %serviceids) {
    vrb("service id $service_id not referenced") unless exists $sidrefs{$sid};
  }

  return 1;
}

# hop-oriented stop times list, replaces stop_times
sub readstopseqs($)
{
  my ($dir) = @_;

  my ($stopseqs,$stopseqsname,$rv,$headline);

  my ($trip_id,$arr_time,$dep_time,$stop_id);

  my ($routeid,$tripid);
  my ($route,$seq);
  my ($dstop_id,$astop_id,$dstopid,$astopid,$pdep,$parr);

  return error("missing dir arg for import") unless defined $dir and length($dir);

  $stopseqsname = $dir . '/' . 'stop_sequences.tab';

  info("reading $stopseqsname");
  return info("dryrun") if $dryrun;

  return error("$stopseqsname not present") unless -f $stopseqsname;
  return error("$stopseqsname is empty") unless -s $stopseqsname;

  ($rv,$stopseqs,$headline) = opengtfs($stopseqsname,0,1);
  return 0 unless $rv;

  my $canoncols = "trip_id\tdep_stop_id\tarr_stop_id\tstop_sequence\tdeparture_time\tarrival_time";
  error_exit("expected\n  $canoncols\nfound\n  $headline") unless index($headline,$canoncols) == 0;

  my $linno = 1;
  my $linecnt;

  my $nottcnt = 0;
  my $intracnt = 0;

  my ($sid,$service_id);
  my $prvtrip = -1;
  my $prvrrid = 0;
  $tripid = 0; $routeid = 0;

  my ($uniqid,$name);
  my ($trepiv,$trepstart,$trepend,$repstart,$hdeptime,$harrtime,$hstr,$freqcnt,$freqs);
  my $hrepend = 0;
  my @freqlist;

  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$filesize) = stat $stopseqs;
  my $donesize = 0;
  my $triplen = 0;

  while (my $line = readline $stopseqs) {

    $donesize += length($line);
    chop $line;
    $linno++;
    $glinno = $linno;

    next unless length $line;

    ($trip_id,$dstop_id,$astop_id,$seq,$dep_time,$arr_time) = split("\t",$line);

    unless (exists($tripids{$trip_id})) {
      info("line $linno: undefined or filtered trip id '$trip_id'");
      $nottcnt++;
      return 0;
      next;
    }
    $tripid = $tripids{$trip_id};

    if ($prvtrip != $tripid) { # first entry
      $triplen = 1;
      unless (exists($triproutes{$tripid})) {
        warning("line $linno: undefined route for trip $trip_id");
        $nottcnt++;
        next;
      }
      $routeid = $triproutes{$tripid};
      return error("line $linno: trip $trip_id unsorted route $routeid $routebyids{$routeid} after $prvrrid $routebyids{$prvrrid}\n$line") if $routeid < $prvrrid;
      $prvrrid = $routeid;

      $service_id = $tripservice{$trip_id};
      error_exit("undefined sid for $trip_id") unless defined $service_id;
      $sid = $serviceids{$service_id};
      error_exit("undefined $service_id") unless defined $sid;
      $sidrefs{$sid} = 1 unless exists $sidrefs{$sid};
      $tripsids{$tripid} = $sid;

      if (exists($tripfreqs{$tripid})) {
        @freqlist = @{ $tripfreqs{$tripid} };
        $freqcnt = scalar @freqlist;
        vrb0("freq $freqcnt");
        ($trepiv,$trepstart,$trepend) = split(' ',$freqlist[0]);
        warning("line $linno interval $trepiv") if $trepiv < 2;
      } else {
        $freqcnt = 0;
      }
    } else {
      $triplen++;
    }

    $prvtrip = $tripid;

    unless (exists $rstopids{$astop_id}) {
      warning("line $linno: unknown stop ID $astop_id") if $warn_nostop;
      $nottcnt++;
      next;
    }
    $astopid = $rstopids{$astop_id};

    unless (exists $rstopids{$dstop_id}) {
      warning("line $linno: unknown stop ID $dstop_id") if $warn_nostop;
      $nottcnt++;
      next;
    }
    $dstopid = $rstopids{$dstop_id};

    return error("$linno unrecognised time $dep_time") if $dep_time < 0 or $dep_time > 10 * 86400;
    return error("$linno unrecognised time $arr_time") if $arr_time < 0 or $arr_time > 10 * 86400;
    warning("line $linno $dep_time equals $arr_time") if $dep_time == $arr_time;

    $pdep = $stop2parent{$dstopid};
    $parr = $stop2parent{$astopid};

    $stopdeps[$dstopid] = 1;
    $stoparrs[$astopid] = 1;

    if ($pdep == $parr) {
      $stopdeps[$pdep] = 1;
      $stoparrs[$parr] = 1;
      next;
    }

    # actual hop derived from key lateron
    if ($chkduproute) { $uniqid = join('_',$pdep,$parr); }
    else { $uniqid = join('_',$routeid,$pdep,$parr); }

    if (exists($tripseq{$uniqid})) {
      $stopdeps[$pdep] = 1 if $pdep != $dstopid;
      $stoparrs[$parr] = 1 if $parr != $astopid;
    } else {
      push @uniqids,$uniqid;
      $stopdeps[$pdep] = 1 if $pdep != $dstopid;
      $stoparrs[$parr] = 1 if $parr != $astopid;
      $hopcnt++;
    }

    if ($freqcnt) {
      for $freqs (@freqlist) {
        ($trepiv,$trepstart,$trepend) = split(' ',$freqs);
        $hstr = join('_',$dstopid,$astopid,$tripid,$dep_time,$arr_time,$trepiv,$trepstart,$trepend,$seq);
        if (exists($tripseq{$uniqid})) {
          push @{ $tripseq{$uniqid} },$hstr;
        } elsif ($pdep != $parr) {
          $tripseq{$uniqid} = [ ($hstr) ];
        }
      }
      $sumtimes += $freqcnt;
    } else {
      if (exists($tripseq{$uniqid})) {
        push @{ $tripseq{$uniqid} },join('_',$dstopid,$astopid,$tripid,$dep_time,$arr_time,0,0,$dep_time,$seq);
      } else {
        $tripseq{$uniqid} = [ join('_',$dstopid,$astopid,$tripid,$dep_time,$arr_time,0,0,$dep_time,$seq) ];
      }
      $sumtimes++;
    }

    return error("$sumtimes time entries exceed 4G") if $sumtimes > 4 * 1024 * 1024 * 1024;

    progress("%u of %u MB line %u",$donesize / 1000000,$filesize / 1000000,$linno) if $linno == 1 or ($linno % 100000) == 0;

  } # each line
  print "\n";
  $linecnt = $linno - 1;

  close($stopseqs);
  error_exit("$stopseqsname is empty") unless ($linecnt > 0);

  info("$sumtimes time entries, $nottcnt skipped, $hopcnt hops $intracnt internal");

  error_exit("$stopseqsname is empty") unless ($sumtimes > 0 and $hopcnt > 0);

  do_conn() or return 0;

  my %ridrefs;
  my ($rid,$dep,$arr,$cnt);

  foreach $uniqid (@uniqids) {
    ($rid,$dep,$arr) = split('_',$uniqid);
    $ridrefs{$rid}++;
  }
  while (($rid,$cnt) = each %ridrefs) {
    vrb("rid $rid has $cnt hops");
  }
  return 1;
}

my %ridsidtimes;

# replaced by stopseqs above
sub readstoptimes($)
{
  my ($dir) = @_;

  my ($stoptimes,$stoptimesname,$rv,$headline,$str);
  my ($col,$colname,$fldend,$endq,$c,$req,$tmpcol,$lastline);

  my ($route_id,$trip_id,$arr_time,$dep_time,$stop_id,$headsign);

  my ($routeid,$tripid,$tripno,$stopid,$id,$rstopid,$rstop_id,$dep);
  my ($route,$trip,$seq,$hop,$dep_id,$arr_id);

  return error("missing dir arg for import") unless defined $dir and length($dir);

  $stoptimesname = $dir . '/' . 'stop_times.tab';

  info("reading $stoptimesname");
  return info("dryrun") if $dryrun;

  ($rv,$stoptimes,$headline) = opengtfs($stoptimesname,0,1);
  return 0 unless $rv;
# optionally

  my $canoncols = "trip_id\tstop_id\tstop_sequence\tarrival_time\tdeparture_time";
  error_exit("expected $canoncols, found $headline") unless index($headline,$canoncols) == 0;

  my $linno = 1;
  my $linecnt;

  my $nottcnt = 0;

  my (@newtrip,@newstrip);
  my ($newtripln,$parent,$parentid,$sid,$service_id,$xtripid,$xlinno,$prvpid,$pid);
  my $prvtrip = 0;
  my $prvroute = 0;
  $tripid = 0; $routeid = 0;

  my ($uniqid,$name,$tripline,$ridsidtime);
  my ($thh,$tmm,$tss,$tahh,$tamm,$tass,$tdepsec,$tarrsec,$tbias);
  my ($htdep,$htarr,$htdeparr,$trepiv,$trepend);

  my ($prvseq,$prvid,$prvtdep,$prvtarr);

  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$filesize) = stat $stoptimes;
  my $donesize = 0;

#  my $hhmmpat = qr'^([0-9]+):([0-9]+):([0-9]+)-([0-9]+):([0-9]+):([0-9]+)/([0-9]+):([0-9]+):([0-9]+)$';

  while (my $line = readline $stoptimes) {

    $donesize += length($line);
    chop $line;
    $lastline = eof($stoptimes);
    $linno++;
    $glinno = $linno;

    info("last line") if $lastline;
    next if $line eq $headline;  # support catenated files if same col layout
    next unless length $line;
    next if substr($line,0,1) eq '#';

    info("last line") if $lastline;

    ($trip_id,$rstop_id,$seq,$arr_time,$dep_time) = split("\t",$line);
    $arr_time = '' unless defined $arr_time;

    $dep_time = $arr_time unless defined $dep_time;

    unless (exists($tripids{$trip_id})) {
      vrb("line $linno: undefined or filtered trip id '$trip_id'");
      next;
    }
    $prvtrip = $tripid;
    $prvroute = $routeid;
    $tripid = $tripids{$trip_id};

    unless (exists($triproutes{$tripid})) {
      warning("line $linno: undefined route for trip $trip_id");
      next;
    }

    $routeid = $triproutes{$tripid};
    $route_id = $routebyids{$routeid};
    if (exists $norouteids{$route_id}) { # filtered
     info("filter $stop_id on route $route_id");
      next;
    }

    if ($prvtrip != $tripid) {
      $service_id = $tripservice{$trip_id};
      error_exit("undefined sid for $trip_id") unless defined $service_id;
      $sid = $serviceids{$service_id};
      error_exit("undefined $service_id") unless defined $sid;
      $sidrefs{$sid} = 1 unless exists $sidrefs{$sid};
      $tripsids{$tripid} = $sid;
    }

    unless (exists $rstopids{$rstop_id}) {
      warning("line $linno: unknown stop ID $rstop_id") if $warn_nostop;
      next;
    }
    $rstopid = $rstopids{$rstop_id};
    $stopid = $stopmerge{$rstopid};

    unless (exists $stop_ids{$stopid}) {
      warning("unknown stop ID $stopid line $linno"); # todo : at merge
      next;
    }
    $stop_id = $stop_ids{$stopid};
    unless (defined $stop_id) {
      warning("undefined stop ID for $stopid from $rstop_id $rstopid line $linno");
      next;
    }

# todo check if valid
#    $ridsidtime = join('_',$routeid,$sid,$stopid,$dep_time);
#    if (exists $ridsidtimes{$ridsidtime}) {
#       info("line $linno duplicate entry $ridsidtime");
#      $prvtrip = $tripid;
#      next;
#    }
#    $ridsidtimes{$ridsidtime} = 1;

    push(@stop_times, join("\t",$tripid,$rstopid,$seq,$arr_time,$dep_time)) if $canonout;

#    if (exists($parentbyid{$stopid})) {
#      $parent = $parentbyid{$stopid};
#      $parentid = $parentids{$parent};
#      $id = $parentid;
#    } else { $id = $stopid; }
    $id = $stopid;

    if ($prvtrip == 0) {
      @newtrip = ();
      push @newtrip,join("\t",$seq,$tripid,$id,$dep_time,$arr_time,$linno);
      info("processing last line $newstrip[0]") if $lastline;
    } elsif ($prvtrip == $tripid and not $lastline) {
      push(@newtrip,join("\t",$seq,$tripid,$id,$dep_time,$arr_time,$linno));
      info("processing last line $newstrip[0]") if $lastline;
    } else {
      if ($prvtrip == $tripid) {
        push(@newtrip,join("\t",$seq,$tripid,$id,$dep_time,$arr_time,$linno));
      }
      next if @newtrip == 0;
#      warning("1-hop trip $trip_id $tripid line $linno") if @newtrip == 1; # todo
#      info("seq $seq $newtrip[-1]");

      undef @newstrip;
      @newstrip = ();
      @newstrip = @newtrip;

      undef @newtrip;
      @newtrip = ();
      push @newtrip,join("\t",$seq,$tripid,$id,$dep_time,$arr_time,$linno);

      info("processing last line $newstrip[0]") if $lastline;

      $tdepsec = 0; $tarrsec = 0; $tbias = 0;
      ($seq,$xtripid,$id,$dep_time,$arr_time,$xlinno) = split("\t",$newstrip[0]);

      foreach $tripline (@newstrip) {
        $prvtdep = $tdepsec;
        $prvtarr = $tarrsec;
        $prvid = $id;
        $prvseq = $seq;

        ($seq,$xtripid,$id,$dep_time,$arr_time,$xlinno) = split("\t",$tripline);

        if ($xtripid ne $prvtrip) { # todo: at filter or at merge ?
          info("trip ID '$xtripid' mismatches '$prvtrip' $tripline");
        }

        return error("trip ID '$xtripid' unsorted sequence $seq after $prvseq at line $xlinno") if $seq < $prvseq;

        ($thh,$tmm,$tss) = ($dep_time =~ $hhmmpat);
        ($tahh,$tamm,$tass) = ($arr_time =~ $hhmmpat);
        info("arrtime '$arr_time' trip $tripid") unless defined $tahh;
        $tss = 0 unless defined $tss;
        $tass = 0 unless defined $tass;
        $tdepsec = ($thh * 3600) + ($tmm * 60) + $tss;
        $tarrsec = ($tahh * 3600) + ($tamm * 60) + $tass;

        $trepiv = 0;
        $trepend = $tdepsec;

        return error("line $xlinno: tdep $tdepsec") if $tdepsec > 7 * 86400;
        return error("line $xlinno: tarr $tarrsec") if $tarrsec > 7 * 86400;

        if ($id == $prvid) {
          next;
        }

        if ($seq == $prvseq) {
          warning("trip ID '$xtripid' duplicate sequence $seq line $xlinno");
          next;
        }

        if ( ($tdepsec / 3600) > 100 or ($tarrsec / 3600) > 100) {
          info(sprintf("dep %u h arr %u h %u\n",($tdepsec / 3600),($tarrsec / 3600),$tripid));
        }

        $htdep = int $prvtdep;
        $htarr = int $tarrsec;

        if ($htdep > $htarr) {
          $stop_id = $stop_ids{$id};
          $str = sprintf("line $xlinno dep > arr stop $stop_id d %u:%u a %u:%u $tripline\n",$htdep / 3600,($htdep % 3600) / 60,$htarr / 3600,($htarr % 3600) / 60);
          print $str;
          info("$str");
        }

        $htarr++ if $htdep == $htarr;
        warning("tdep $htdep equals tarr $htarr") if $htdep == $htarr;

        warning("no 2parent for $prvid") unless exists $stop2parent{$prvid};
        $prvpid = $stop2parent{$prvid};
        $pid = $stop2parent{$id};

        # actual hop derived from key lateron
        if ($chkduproute) { $uniqid = join('_',$prvpid,$pid); }
        else { $uniqid = join('_',$prvroute,$prvpid,$pid); }
        $sumtimes++;
        return error("$sumtimes time entries exceed 4G") if $sumtimes > 4 * 1024 * 1024 * 1024;

        if (exists($tripseq{$uniqid})) {
          $stopdeps[$prvid] = 1;
          $stoparrs[$id] = 1;
          $stopdeps[$prvpid] = 1 if $prvid != $prvpid;
          $stoparrs[$pid] = 1 if $id != $pid;
          push @{ $tripseq{$uniqid} },join('_',$prvid,$id,$xtripid,$htdep,$htarr,$trepiv,$trepend,$seq);
        } elsif ($prvpid != $pid) {
          $tripseq{$uniqid} = [ join('_',$prvid,$id,$xtripid,$htdep,$htarr,$trepiv,$trepend,$seq) ];
          push @uniqids,$uniqid;
          $stopdeps[$prvid] = 1;
          $stoparrs[$id] = 1;
          $stopdeps[$prvpid] = 1 if $prvid != $prvpid;
          $stoparrs[$pid] = 1 if $id != $pid;
          $hopcnt++;

        } else { # intra-station hop
          $stopdeps[$prvid] = 1;
          $stoparrs[$id] = 1;
        }
      } # each tripline
    } # each trip

    $ttcnt++;

    progress("%u of %u MB line %u",$donesize / 1000000,$filesize / 1000000,$linno) if $linno == 1 or ($linno % 100000) == 0;

  } # each line
  print "\n";
  $linecnt = $linno - 1;

  close($stoptimes);
  error_exit("$stoptimesname is empty") unless ($linecnt > 0);

  info("$ttcnt time entries, $nottcnt skipped, $hopcnt hops");

  do_conn() or return 0;

  my %ridrefs;
  my ($rid,$arr,$cnt);

  foreach $uniqid (@uniqids) {
    ($rid,$dep,$arr) = split('_',$uniqid);
    $ridrefs{$rid}++;
  }
  while (($rid,$cnt) = each %ridrefs) {
    vrb("rid $rid has $cnt hops");
  }
  return 1;
}

sub import($)
{
  my ($dir) = @_;

  info("excluding bus") unless $include_bus;
  info("excluding train") unless $include_rail;
  info("excluding metro") unless $include_metro;
  info("excluding ferry") unless $include_ferry;

  readfeedinfo($dir);
  readagency($dir) or return serror("could not read agencies");
  return 0 if $runto eq 'agencies';
  $agencyname = '(none)' unless defined $agencyname;

  readroutes($dir) or return serror("could not read agencies");
  return 0 if $runto eq 'routes';
  readcalendar($dir) or return serror("could not read calendar");
  readcaldates($dir) or return serror("could not read caldates");
  return 0 if $runto eq 'calendar';
  chksids() if $do_chksid;
  readstops($dir) or return serror("could not read stops");
  return 0 if $runto eq 'stops';
  readxfers($dir) or return serror("could not read transfers");
  return 0 if $runto eq 'transfers';
  readtrips($dir) or return serror("could not read trips");
  return 0 if $runto eq 'trips';
  readfreqs($dir) or return serror("could not read freqs");
  return 0 if $runto eq 'frequencies';
  if ($use_stopseqs) { readstopseqs($dir) or return serror("could not read stopseqs"); }
  else {readstoptimes($dir) or return serror("could not read stoptimes"); }
  return 0 if $runto eq 'times';
  return 1;
}

sub getdate()
{
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($^T);

  return sprintf("%u-%02u-%02u %u:%02u utc",$year+1900,$mon+1,$mday,$hour,$min);
}

sub iniext($$)
{
  my ($name,$cnt) = @_;

  my $bckname = $name . '.bak';

  info("writing $cnt items to $name");

  unlink($bckname) if -f $bckname;
  rename($name,$bckname) if -f $name;
}

sub inican($)
{
  my ($name) = @_;

  my $bckname = $name . '.bak';

  info("writing $name");

  unlink($bckname) if -f $bckname;
  rename($name,$bckname) if -f $name;
}

sub infoext($)
{
  my ($file) = @_;

  printf($file "# written by gtfstool %u.%s at %s\n",$version_maj,$version_min,getdate());
}

sub numsort {
  $a <=> $b;
}

sub writext($$)
{
  my ($indir,$outdir) = @_;

  my ($name,$portfile,$hopfile,$routefile);
  my ($stop,$stopid,$hop,$route,$hopid,$tripno);
  my ($dep_id,$arr_id,$dep,$arr,$depname,$arrname);
  my ($routeid,$route_id,$agency_id,$reserve,$rid,$rtype,$srtype,$shortname,$longname);
  my ($cnt,$line,$region);

  return 1 if $testonly;

  info("writing tripover external format");
  return info("dryrun") if $dryrun;

  my ($utcofs12,$agencytid);

  my ($agencyfile,$agencyhfile,$agencyline,$url,$tzstr);
  my $agencyfname = $outdir . '/to-agencies.txt';
  my $agencyhfname = $outdir . '/gt-agencies.html';

  iniext($agencyfname,$agencycnt);

  open($agencyfile,'>:encoding(UTF-8)',$agencyfname) or error_exit("cannot create $agencyfname:$!");

  open($agencyhfile,'>:encoding(UTF-8)',$agencyhfname) or error_exit("cannot create $agencyhfname:$!");

  print($agencyfile "# agencies.txt - tripover external agency file\n\n");
  infoext($agencyfile);
  printf($agencyfile "# %u agenc%s\n\n",$agencycnt,($agencycnt == 1) ? 'y' : 'ies');

  printf($agencyfile "# raid\aid\tutcofs\tdst\tname\turl\ttz\n\n");
  printf($routefile ".aidrange\t..%u\t%u\n\n",$agencycnt,$hiagid);

  for ($agid = 0; $agid <= $hiagid; $agid++) {
    next unless exists $agencyrids{$agid} and $agencyrids{$agid} > 0;
    $agencyline = $agencies{$agid);
    ($agency_id,$name,$tzstr,$utcofs12,$dstonof,$url) = split("\t",$agencyline);

    printf($agencyfile "%s\t..%u\t%u\t%u\t'%s\t'%s\t'%s\n",$agency_id,$agid,$utcofs12,$dstonof,$tzstr,$name,$url);
    print($agencyhfile "<a class=link href=$url>$name</a>&emsp;&mdash;&emsp;<br>\n");
  }

  close($agencyfile);
  close($agencyhfile);

  my $portname = $outdir . '/ports.txt';
  iniext($portname,$stopcnt);

  open($portfile,'>:encoding(UTF-8)',$portname) or error_exit("cannot create $portname:$!");

  print($portfile "# ports.txt - tripover external port aka stops file\n\n");
  infoext($portfile);
  printf($portfile "# %u ports from %s/stops.txt\n\n",$stopcnt,$indir);

  printf($portfile ".latscale\t.%u\n",$latscale);
  printf($portfile ".lonscale\t.%u\n\n",$lonscale);
  print($portfile ".comment\t'$stopcmt\n\n") if length $stopcmt;

  printf($portfile "# name\tiname\tpfx\tid\tsubid\tlat\tlon\topts\tstopid\tutcofs\tdst\n\n");

  my ($stop_id,$stopid_to,$stop_name,$stop_iname,$stop_code,$ilat,$ilon,$desc,$opts);
  my ($parent,$parentid,$stopstr,$prefix,$xstop_code,$aa);
  my ($hh,$mm,$dhh,$dmm,$dston,$dstof,$dstonof,$tzname);
  my $portcnt = $parentcnt;
  my $unconcnt = 0;
  my @cstops;
  my $digits = qr'^[0-9]+$';

  foreach $stopid (keys %stops) {
    return error("non-numerical $stopid") unless $stopid =~ $digits;
  }

  foreach $stopid (keys %stops) {
    $stopstr = $stops{$stopid};

    ($stop_name,$ilat,$ilon,$stop_code,$desc,$opts,$tzname) = split("\t",$stopstr);
    $stop_id = $stop_ids{$stopid};
    if ($omit_unconnect and $stopdeps[$stopid] == 0 and $stoparrs[$stopid] == 0) {
      $unconcnt++;
      info("omitting unconnected port $stop_name id $stopid") if $show_unconnect;
      next;
    }
    push @cstops,$stopid;
  }
  my @scstops = sort numsort @cstops;

  foreach $stopid (@scstops) {
    $stopstr = $stops{$stopid};

    ($stop_name,$stop_iname,$ilat,$ilon,$stop_code,$desc,$opts,$tzname) = split("\t",$stopstr);

    $stop_id = $stop_ids{$stopid};  # gtfs-view : stop_id.parent = stopid@tripover
    return error("$stop_id has no timezone") unless defined $tzname and length $tzname;

    $a = rindex($stop_id,'/');
    if ($a > 0) {
      $prefix = substr($stop_id,0,$a);
    } else {
      $prefix = '';
      $a = 0;
    }
    $stop_code = substr($stop_id,$a) unless defined $stop_code;
    $opts = 0 unless defined $opts;

    $parent = '';
    $parent = $parentbyid{$stopid} if exists $parentbyid{$stopid};

    if (length($parent) > 0 and exists $parentids{$parent}) {
      warning("$parent equal to $stop_id") if $parent eq $stop_id;
      $parentid = $parentids{$parent};
      warning("$stop_id has nonexistent parent $parent") unless exists $stop_ids{$parentid};
      if ($omit_unconnect and $stopdeps[$parentid] == 0 and $stoparrs[$parentid] == 0) {
        $unconcnt++;
        info("omitting port $stop_name on unconnected parent $parent") if $show_unconnect;
        next;
      }

      $stopid_to = $parentid;   # tripover-view  parent@gtfs = stopid_to
    } else {
      $stopid_to = $stopid;
      $portcnt++;
    }
    ($xstop_code) = ($stop_code =~ '[a-z/]*([0-9]+)');  # pass if numerical
    $xstop_code = 0 unless defined $xstop_code;
    $xstop_code = 0 if $xstop_code > 0xffffffff;
    $stop_name = '\\' . $stop_name if index($stop_name,'#') == 0;

    ($hh,$mm,$dhh,$dmm,$dstonof) = tz2ofs($tzname,'stopid ' . $stopid);
    $dstonof = 0 unless defined $dstonof and length $dstonof;
    $utcofs12 = int($hh + 12) * 100 + $mm;

    $stop_iname = '' if $stop_iname eq $stop_name;
    printf($portfile "%s\t'%s\t'%s\t.%u\t.%u\t%x\t%x\t%x\t.%u\t.%u\t.%u\t# id %s %s\n",$stop_name,$stop_iname,$prefix,$stopid_to,$stopid,$ilat,$ilon,$opts,$xstop_code,$utcofs12,$dstonof,$stop_id,$parent);
  }
  close($portfile);
  info("wrote $stopcnt stops to $portcnt ports");
  info("omitted $unconcnt unconnected stops") if $unconcnt;

  my $timefile;
  my $timename = $outdir . '/times.txt';
  my ($service_id,$sid,$t0,$t1,$utcofs,$day,$dow,$addcnt,$subcnt,$addtimes,$subtimes);
  my @sidsubs;
  my @sidadds;

  iniext($timename,$sidcnt);

  my $losid = 0xffffffff;
  my $hisid = 0;

  foreach $service_id (sort keys %serviceids) {
    $sid = $serviceids{$service_id};
    next unless exists $sidrefs{$sid};
    $losid = min($losid,$sid);
    $hisid = max($hisid,$sid);
  }

  open($timefile,'>:encoding(UTF-8)',$timename) or error_exit("cannot create $timename:$!");
  print($timefile "# times.txt - tripover external timetable aka calendar file\n\n");
  infoext($timefile);
  printf($timefile "# %u entries from %s\n\n",$sidcnt,$indir);

  printf($timefile ".dowstart\t'%s\t# day a week starts at : lsb in mask\n",$dowstart);
  printf($timefile ".timebox\t.%u\t.%u\t# departure time span\n",$mint0,$maxt1);
  printf($timefile ".sidrange\t.%u\t.%u\n",$losid,$hisid);
  printf($timefile ".%s\t# feed time\n",$feedstamp) if length $feedstamp;

  print($timefile "# service_id\tsid\tdow\tutcofs\tdst\tstart\tend\tadd\tsub\taddt\tsubt# \n\n");

  foreach $service_id (sort keys %serviceids) {
    $sid = $serviceids{$service_id};
    # info("svc $service_id sid $sid");
    next unless exists $sidrefs{$sid};

    $dow = $servicedow{$sid};
    $t0 = $servicet0{$sid};
    $t1 = $servicet1{$sid};
    if (defined $serviceadd{$sid}) {
      @sidadds = @{ $serviceadd{$sid} };
      $addcnt = @sidadds;
    } else { $subcnt = 0; }
    if (defined $servicesub{$sid}) {
      @sidsubs = @{ $servicesub{$sid} };
      $subcnt = @sidsubs;
    } else { $subcnt = 0; }
    $addtimes = $addcnt ? join("\t",@sidadds) : '';
    $subtimes = $subcnt ? join("\t",@sidsubs) : '';
    return error("invalid sid '$sid'") unless $sid =~ qr'^[0-9]+$';
    return error("sid $service_id: invalid dow '$dow'") unless $dow =~ qr'^[0-9a-f]+$';

    printf($timefile "%s\t.%u\t%x\t..%u\t%u\t%u\t%u\t%s\t%s\tx\n",$service_id,$sid,$dow,$t0,$t1,$addcnt,$subcnt,$addtimes,$subtimes);
  }
  close($timefile);

  my $routename = $outdir . '/to-routes.txt';
  iniext($routename,$routecnt);

  open($routefile,'>:encoding(UTF-8)',$routename) or error_exit("cannot create $routename:$!");
  print($routefile "# to-routes.txt - tripover external route file\n\n");
  infoext($routefile);
  printf($routefile ".ridrange\t..%u\t%u\n\n",$routecnt,$hirrid);
  print($routefile "# name\trid\ttype\treserve\tagency\tfare\t# rtype utcofs rrid\n\n");

  my $fare = 0;
  my $netroutecnt = 0;

  foreach $line (@routes) {
    ($route_id,$agency_id,$reserve,$fare,$shortname,$longname,$rtype) = split("\t",$line);
    next unless exists $routeids{$route_id};
    $rid = $routeids{$route_id};

    next if $routetrips{$route_id} == 0;
    $netroutecnt++;

    $srtype = extrtype($rtype);
    $name = '\\' . $name if index($name,'#') == 0;
    $agid = agencyids{$agency_id};
    printf($routefile "%s\t%u\t%u\t%u\t%u\t%u\t%u\t'%s\t'%s\n",$name,$rid,$srtype,$reserve,$agid,$fare,$rtype,$route_id,agency_id);
  }
  close($routefile);
  info("wrote $netroutecnt items to to_routes.txt");

  my ($ridecnt,$tidcnt,$hirtid);

  my $ridename = $outdir . '/rides.txt';
  iniext($ridename,$ridecnt);

  open(my $ridefile,'>:encoding(UTF-8)',$ridename) or error_exit("cannot create $ridename:$!");
  print($ridefile "# rides.txt - tripover external rides file\n\n");
  infoext($ridefile);
  printf($ridefile ".tidrange\t..%u\t%u\n\n",$tidcnt,$hirtid);
  print($ridefile "# name\tcnt\n\n");

  foreach $line (@trips) {
    ($route_id,$agency_id,$reserve,$fare,$shortname,$longname,$rtype) = split("\t",$line);
    next unless exists $routeids{$route_id};
    $rid = $routeids{$route_id};

    next if $routetrips{$route_id} == 0;
    $netroutecnt++;

    printf($ridefile "%s\t%u\t%u\t%u\t%u\t%u\t # %u %u %s\n",$name,$rid,$srtype,$reserve,$agencytid,$fare,$rtype,$utcofs12,$route_id);
  }
  close($ridefile);
  info("wrote $netroutecnt items to rides.txt");

  if ($writerefs) {
    my $refname = $outdir . '/refs.txt';
    open(my $reffile,'>:encoding(UTF-8)',$refname) or return error("cannot open $refname:$!");
    for my $tripid (sort keys %orgtrip_ids) {
      print($reffile "$tripid $orgtrip_ids{$tripid}\n");
    }
    close $reffile;
  }

  my $hopname = $outdir . '/hops.txt';
  iniext($hopname,$hopcnt);

  open($hopfile,'>:encoding(UTF-8)',$hopname) or error_exit("cannot create $hopname:$!");
  print($hopfile "# hops.txt - tripover external hops aka trips file\n\n");
  printf($hopfile "# written by gtfstool %u.%s at %s\n",$version_maj,$version_min,getdate());
  printf($hopfile "# %u hops from %s/stoptimes.txt\n\n",$hopcnt,$indir);

  printf($hopfile ".sumtimes\t.%u\t# total number of time entries\n",$sumtimes);
  printf($hopfile ".trips\t.%u\t# total number of trips\n",$tripcnt);
  printf($hopfile ".hitrip\t.%u\t# highest trip ID\n\n",$hitripid);

  print($hopfile "# route\tID\tfrom\tto\ttype\trid\tfare\ttimes\t# from-name to-name\n");
  print($hopfile "#   times: fmt sdep sarr sid tid tdep tarr\n\n");

  my ($uniqid,$hoptime,$mark,$fmt,$timestr,$testr,$dbgstr);
  my $xinfo = '';
  my $hopno = 0;
  my $dupcnt = 0;
  my (@times,@hoptimes,@tdeparrs);
  my ($tid,$tdep,$tarr,$seq,$tdeparr,$ztid,$ztdep,$ztarr,$prvsid,$prvtid,$prvtdep,$prvtarr,$prvrid);
  my ($sdep,$sarr,$prvsdep,$prvsarr,$trepiv,$trepstart,$trepend);
  my ($timecnt,$wtimecnt,$tstr);
  my ($overtakecnt,$overtakehi);

  ($prvrid,$dep,$arr) = split('_',$uniqids[0]);
  my @ridwarns;

  foreach $uniqid (@uniqids) {

    @times = @{ $tripseq{$uniqid} };

    error_exit("invalid hop id $hopno") if ($hopno >= $hopcnt);

    if ($chkduproute) {
      ($dep,$arr) = split('_',$uniqid);
      $rid = 2;
    } else {
      ($rid,$dep,$arr) = split('_',$uniqid);
    }
    error_exit("missing hop arguments") unless defined $arr;

    $fare = 0;

    warning("route ID $rid not found") unless exists $routebyids{$rid};
    $route = $routebyids{$rid};
    warning("route $route not found") unless exists $routeids{$route};
    next if exists $norouteids{$route_id}; # filtered: should not reach upto here

    if ($rid < $prvrid) {
      return error("routes unsorted: $rid $route after $prvrid");
    }
    $prvrid = $rid;

    $hopid = $hopno;

    $timecnt = scalar @times;

    vrb("$timecnt time entries");
    if ($timecnt == 0) {
      warn("hop $hopno $uniqid has no time entries");
      next;
    }

    $depname = $stopnames{$dep};
    $arrname = $stopnames{$arr};

    if ($dep == $arr) { # possible due to nearby dup merging
      info("hop $hopid dep $dep equals arr $depname");
      $dupcnt++;
      next;
    }

    warning("$route type not found") unless exists $rtypes{$rid};
    $rtype = $rtypes{$rid};
    $route = '.' . $route if (substr($route,0,1) eq '.');
    $xinfo = "\t# $route $depname to $arrname" if $verbose_hops;

    ($sdep,$sarr,$tid,$tdep,$tarr,$trepiv,$trepstart,$trepend,$seq) = split('_',shift @times);
    push(@tdeparrs,($tdep << 32) | $tarr);
    return error("hop $hopno no sid for $tid") unless exists $tripsids{$tid};

    $sid = $tripsids{$tid};

    return error("hop $hopid no sid for $tid") unless defined $sid;
    info("hop $hopid unreferenced sid $sid") unless exists $sidrefs{$sid};

    $tripno = $tripnos{$tid}; # fltno only for air

    $fmt = 0; $tstr = '';
    if ($trepiv != 0) {
      $fmt = $fmt_rep;
      $tstr = sprintf("%x\t%x\t%x\t",$trepiv,$trepstart,$trepend);
    }

    info("hop $hopno sid $sid") if $hopno == 0;

    $route = '\\' . $route if index($route,'#') == 0;
    printf($hopfile "%s\t%x\t.%u\t.%u\t%x\t.%u\t.%u\t.%u\t",$route,$hopid,$dep,$arr,$rtype,$rid,$fare,$timecnt);

    printf($hopfile "%x\t%x\t%x\t%x\t%s%x\t'%s\t%x\t%x\t%x",$fmt,$sdep,$sarr,$sid,$tstr,$tid,$tripno,$tdep,$tarr,$seq);
    $wtimecnt = 1;

#    warning("tdep $tdep after tarr $tarr for tid $tid") if $tdep > $tarr;
    warning("tdep $tdep equals tarr $tarr") if $tdep == $tarr;

    for $testr (@times) {
      $prvsid = $sid; $prvtid = $tid; $prvtdep = $tdep; $prvtarr = $tarr;
      $prvsdep = $sdep; $prvsarr = $sarr;
      ($sdep,$sarr,$tid,$tdep,$tarr,$trepiv,$trepstart,$trepend,$seq) = split('_',$testr);

      # info("rep iv $trepiv from $trepstart to $trepend") if $hopno < 20 and $trepiv;

      return error("incomplete time list for $uniqid $testr") unless defined $seq and $seq =~ '^[0-9]+$';
      $sid = $tripsids{$tid};
#      info("hop $hopno sid $sid") if $hopno == 0;
      return error("hop $hopid no sid for $tid") unless defined $sid;

      push(@tdeparrs,($tdep << 32) | $tarr) if $chkovertake;

      return error("hop $hopid unreferenced sid $sid") unless exists $sidrefs{$sid};

      $tripno = $tripnos{$tid};

      warning("tdep $tdep after tarr $tarr") if $tdep > $tarr;
      warning("tdep $tdep equals tarr $tarr") if $tdep == $tarr;

      $fmt = 0;
      $tstr = '';

      if ($sdep == $prvsdep) {
        $fmt |= $fmt_prvdep;
      } else {
        $tstr = sprintf("%x\t",$sdep);
      }
      if ($sarr == $prvsarr) {
        $fmt |= $fmt_prvarr;
      } else {
        $tstr .= sprintf("%x\t",$sarr);
      }
      if ($sid == $prvsid) {
        $fmt |= $fmt_prvsid;
      } else {
        $tstr .= sprintf("%x\t",$sid);
      }
      if ($trepiv != 0) {
        $fmt |= $fmt_rep;
        $tstr .= sprintf("%x\t%x\t%x\t",$trepiv,$trepstart,$trepend);
      }

      if ($tid >= $prvtid) {
        $fmt |= $fmt_diftid;
        $ztid = $tid - $prvtid;
      } else { $ztid = $tid; }

      $ztdep = $tdep;
      if ($tdep >= $prvtdep) {
        $fmt |= $fmt_difdep;
        $ztdep = $tdep - $prvtdep;
      } else { $ztdep = $tdep; }

      $ztarr = $tarr;
      if ($tarr >= $prvtarr) {
        $fmt |= $fmt_difarr;
        $ztarr = $tarr - $prvtarr;
      } else { $ztarr = $tarr; }

      printf($hopfile "\t%x\t%s%x\t'%s\t%x\t%x\t%x",$fmt,$tstr,$ztid,$tripno,$ztdep,$ztarr,$seq);
      $wtimecnt++;
    } # each time entry
    return error("hop $hopno timecnt $timecnt vs $wtimecnt") if $timecnt != $wtimecnt;
    printf($hopfile "%s\n",$xinfo);

    $overtakecnt = 0;
    $prvtdep = $prvtarr = 0;

    if ($chkovertake) {
      foreach $tdeparr (sort {$a <=> $b} @tdeparrs) {
        # $tdep = $tdeparr >> 32;
        $tarr = $tdeparr & 0xffffffff;
        if ($tarr < $prvtarr) { $overtakecnt++; $overtakehi = max($overtakehi,$prvtarr - $tarr); }
      }
      warning("hop $hopid has $overtakecnt overtaking events, max $overtakehi sec") if $overtakecnt;
    }
    $hopno++;
    progress("hop %u of %u%s",$hopno,$hopcnt,'') if $hopno == 1 or $hopno >= $hopcnt or ($hopno % 1000) == 0;
  }
  close($hopfile);
  return error("wrote 0 hops") if $hopno == 0;
  print "\n";
  info("wrote $hopno hops" . ($dupcnt ? " filtered $dupcnt duplicates" : ''));

  return 1 unless $xfercnt;

  my $xfername = $outdir . '/xfers.txt';
  iniext($xfername,$xfercnt);

  open(my $xferfile,'>:encoding(UTF-8)',$xfername) or error_exit("cannot create $xfername:$!");
  print($xferfile "# xfers.txt - tripover external transfers\n\n");
  printf($xferfile "# written by gtfstool %u.%s at %s\n",$version_maj,$version_min,getdate());
  printf($xferfile "# %u transfers from %s/stoptimes.txt\n\n",$xfercnt,$indir);

  print($xferfile "# fromname\ttoname\tfromID\ttoID\ttype\tmintt\n");

  my ($setid,$fstopid,$tstopid,$xtype,$mintt);
  my $netxfercnt = 0;
  foreach $setid (sort keys %xfersets) {
    ($fstopid,$tstopid) = split("\t",$setid);
    ($xtype,$mintt) = split("\t",$xfersets{$setid});
    $fstopid = toparent($fstopid);
    $tstopid = toparent($tstopid);
    if ($omit_unconnect) {
      next if $stopdeps[$fstopid] == 0 or $stoparrs[$tstopid] == 0;
    }
    $netxfercnt++;
    print($xferfile "$stopnames{$fstopid}\t'$stopnames{$tstopid}\t..$fstopid\t$tstopid\t$xtype\t$mintt\n");
  }
  close($xferfile);
  info("wrote $netxfercnt of $xfercnt transfers to $xfername");
  return 1;
}

sub print2($$$$)
{
  my ($fh1,$fh2,$str,$prefix) = @_;

  print($fh1 $str);
  print($fh2 $prefix . $str) if defined $fh2;
}

# write input to canonical gtfs:
# prefix all IDs with an agency-unique ID
# only includes required fields
sub writegtfs()
{
  my ($stopsfile,$calendarfile,$caldatesfile,$routesfile,$tripsfile,$stoptimfile,$agencyfile,$mergefile);
  my ($line,$fname,$cmt);

  my ($name,$iname,$id,$parent,$lat,$lon,$ilat,$ilon,$code,$desc,$opt,$tzname);
  my ($loctype,$stopid,$stopstr);

  my ($mon,$tue,$wed,$thu,$fri,$sat,$sun,$startdate,$enddate,$date,$extype);

  my ($route_id,$shortname,$longname,$rtype,$utcofs,$reserve);

  my ($service_id,$sid,$headsign,$dir);

  my ($tripid,$trip_id,$orgtripid,$stop_id,$seq,$dep_time,$arr_time,$stline);

  my ($agency_id,$agency_name,$agency_url,$agency_timezone,$agency_region);

  return warning("input is canonical, no canonical output") if ($iscanonin);

  my $merge = length($mergedir);
  info("merge to $mergedir") if $merge;
  info("prefix $idprefix") if length $idprefix;

# agency
  if (@agencies) {
    $fname = 'agency.tab';
    inican($canondir . "/$fname");
    open($agencyfile,'>:encoding(UTF-8)',$canondir . "/$fname") or return 0;
    if ($merge) {
      $cmt = -f $mergedir . "/$fname" ? '# ' : '';
      open($mergefile,'>>:encoding(UTF-8)',$mergedir . "/$fname") or return 0;
    }

    print2($agencyfile,$mergefile,"agency_id\tagency_name\tagency_timezone\tagency_url\tagency_region\n",$cmt);

    foreach $line (@agencies) {
      ($agency_id,$agency_name,$agency_url,$agency_timezone,$agency_region) = split("\t",$line);
      $agency_region = '' unless defined $agency_region;
      $agency_id = $idprefix . $agency_id;
      print2($agencyfile,$mergefile,"$agency_id\t$agency_name\t$agency_timezone\t$agency_url\t$agency_region\n",'');
    }
    close($agencyfile);
    close($mergefile) if $merge;
    info("wrote canonical agency.tab");
  }

# stops
  my $wstopcnt = 0;

  $fname = 'stops.tab';
  inican($canondir . "/$fname");
  open($stopsfile,'>:encoding(UTF-8)',$canondir . "/$fname") or return 0;
  if ($merge) {
    $cmt = -f $mergedir . "/$fname" ? '# ' : '';
    open($mergefile,'>>:encoding(UTF-8)',$mergedir . "/$fname") or return 0;
  }

  print2($stopsfile,$mergefile,"$stops_canoncols\n",$cmt);

  if (@rstops > 0) {

    for $stopstr (@rstops) {
      ($id,$code,$name,$iname,$lat,$lon,$desc,$tzname) = split("\t",$stopstr);
      vrb("$id deps $stop_deps{$id}");
      next if $omit_unconnect and $stop_deps{$id} == 0 and $stop_arrs{$id} == 0;
      $wstopcnt++;
      print2($stopsfile,$mergefile,join("\t",$idprefix . $id,$code,0,'',$name,$iname,$lat,$lon,$desc,$tzname),'');
      print2($stopsfile,$mergefile,"\n",'');
    }

  } else {

    while (($stopid,$stopstr) = each %stops) {

      ($name,$iname,$ilat,$ilon,$code,$desc,$opt,$tzname) = split("\t",$stopstr);

      $id = $stop_ids{$stopid};  # gtfs-view : stop_id.parent = stopid@tripover

      $code = '' unless defined $code;
      $opt = 0 unless defined $opt;

      $parent = '';
      $parent = $idprefix . $parentbyid{$stopid} if exists $parentbyid{$stopid};

      $loctype = ($opt & $opt_parentstop) ? 1 : 0;

      next if ($omit_unconnect and $stopdeps[$stopid] == 0 and $stoparrs[$stopid] == 0);

      $lat = ilat2lat($ilat);
      $lon = ilon2lon($ilon);

      $wstopcnt++;
      print2($stopsfile,$mergefile,join("\t",$idprefix . $id,$code,$loctype,$parent,$name,$iname,$lat,$lon,$desc,$tzname),'');
      print2($stopsfile,$mergefile,"\n",'');
    }
  }

  close($stopsfile);
  close($mergefile) if $merge;
  info("wrote $wstopcnt canonical stops.tab");

# calendar
  if (@calendar > 0) {
    $fname = 'calendar.tab';
    inican($canondir . "/$fname");
    open($calendarfile,'>:encoding(UTF-8)',$canondir . "/$fname") or return 0;
    if ($merge) {
      $cmt = -f $mergedir . "/$fname" ? '# ' : '';
      open($mergefile,'>>:encoding(UTF-8)',$mergedir . "/$fname") or return 0;
    }

    print2($calendarfile,$mergefile,"service_id\tmonday\ttuesday\twednesday\tthursday\tfriday\tsaturday\tsunday\tstart_date\tend_date\n",$cmt);

    foreach $line (@calendar) {
      ($service_id,$mon,$tue,$wed,$thu,$fri,$sat,$sun,$startdate,$enddate) = split("\t",$line);

      return error("unknown service $service_id") unless exists $serviceids{$service_id};

      $sid = $serviceids{$service_id};
      next unless exists $sidrefs{$sid};

      print2($calendarfile,$mergefile,join("\t",$idprefix . $service_id,$mon,$tue,$wed,$thu,$fri,$sat,$sun,$startdate,$enddate),'');
      print2($calendarfile,$mergefile,"\n",'');
    }
    close($calendarfile);
    close($mergefile) if $merge;
    info("wrote canonical calendar.tab");
  }

  if (@caldates > 0) {
    $fname = 'calendar_dates.tab';
    inican($canondir . "/$fname");
    open($caldatesfile,'>:encoding(UTF-8)',$canondir . "/$fname") or return 0;
    if ($merge) { open($mergefile,'>>:encoding(UTF-8)',$mergedir . "/$fname") or return 0; }

    print2($caldatesfile,$mergefile,"service_id\texception_type\tdate\n",'# ');

    foreach $line (@caldates) {
      ($service_id,$date,$extype) = split("\t",$line);

      $sid = $serviceids{$service_id};
      next unless exists $sidrefs{$sid};

      $service_id = $idprefix . $service_id;
      print2($caldatesfile,$mergefile,"$service_id\t$extype\t$date\n",'');
    }
    close($caldatesfile);
    close($mergefile) if $merge;
    info("wrote canonical calendar_dates.tab");
  }

# routes
  my $reserveprefix = $allreserved ? 'r' : 'u';

  my $omitcnt = 0;
  my $localpfx = '';
  my $fare = 0;

  $fname = 'routes.tab';
  inican($canondir . "/$fname");
  open($routesfile,'>:encoding(UTF-8)',$canondir . "/$fname") or return 0;
  if ($merge) {
      $cmt = -f $mergedir . "/$fname" ? '# ' : '';
    open($mergefile,'>>:encoding(UTF-8)',$mergedir . "/$fname") or return 0;
  }

  print2($routesfile,$mergefile,"route_id\tagency_id\troute_type\troute_short_name\troute_long_name\troute_desc\tfare\n",$cmt);
  $desc = '';

  foreach $line (@routes) {
    ($route_id,$agency_id,$reserve,$fare,$shortname,$longname,$rtype,$localpfx) = split("\t",$line);
    if ($routetrips{$route_id} == 0) {
      vrb("omit empty route $line");
      $omitcnt++;
      next;
    }
    $reserveprefix = ($reserve or $allreserved) ? 'r' : 'u';
    $localpfx = $idprefix unless defined $localpfx;
    $shortname = '' unless defined $shortname;
    $longname = '' unless defined $longname;
    $longname = $routestarts{$route_id} . ' to ' . $routeends{$route_id} if exists $routestarts{$route_id} and exists $routeends{$route_id} and not length $longname;
    $route_id = join '_',$canonmagic,$reserveprefix,$localpfx,$route_id;
    $agency_id = $idprefix . $agency_id;
    print2($routesfile,$mergefile,"$route_id\t$agency_id\t$rtype\t$shortname\t$longname\t$desc\t$fare\n",'');
  }
  close($routesfile);
  close($mergefile) if $merge;
  info("wrote " . ($routecnt - $omitcnt) . " canonical routes.tab");

#trips
  my $ntripcnt = 0;
  $fname = 'trips.tab';
  inican($canondir . "/$fname");
  open($tripsfile,'>:encoding(UTF-8)',$canondir . "/$fname") or return 0;
  if ($merge) {
      $cmt = -f $mergedir . "/$fname" ? '# ' : '';
    open($mergefile,'>>:encoding(UTF-8)',$mergedir . "/$fname") or return 0;
  }

  print2($tripsfile,$mergefile,"route_id\tservice_id\ttrip_id\torg_tripid\torg_routeid\ttrip_headsign\n",$cmt);

  foreach $line (@trips) {
    ($route_id,$service_id,$trip_id,$headsign,$localpfx,$reserve) = split("\t",$line);

    next if exists($norouteids{$route_id});
    $localpfx = $idprefix unless defined $localpfx and length $localpfx;
    $reserve = 0 unless defined $reserve;
    return error('invalid reserve $reserve in $line') if $reserve =~ '[^01]';

    $reserveprefix = ($reserve or $allreserved) ? 'r' : 'u';

    $route_id = join '_',$canonmagic,$reserveprefix,$localpfx,$route_id;
    $service_id = $idprefix . $service_id;
    $trip_id = $idprefix . $trip_id;
    # $headsign =~ tr','`';
    print2($tripsfile,$mergefile,"$route_id\t$service_id\t$trip_id\t\t\t$headsign\n",'');
    $ntripcnt++;
  }
  close($tripsfile);
  close($mergefile) if $merge;
  info("wrote $ntripcnt canonical trips.tab");

  my ($frequencyfile,$interval,$starttime,$endtime);

# frequencies
  if (@frequencies > 0) {
    $fname = 'frequencies.tab';
    inican($canondir . "/$fname");
    open($frequencyfile,'>:encoding(UTF-8)',$canondir . "/$fname") or return 0;
    if ($merge) {
      $cmt = -f $mergedir . "/$fname" ? '# ' : '';
      open($mergefile,'>>:encoding(UTF-8)',$mergedir . "/$fname") or return 0;
    }

    print2($frequencyfile,$mergefile,"trip_id\torg_trip_id\theadway_secs\tstart_time\tend_time\n",$cmt);

    foreach $line (@frequencies) {
      ($trip_id,$interval,$starttime,$endtime) = split("\t",$line);

      $trip_id = $idprefix . $trip_id;
      print2($frequencyfile,$mergefile,"$trip_id\t$trip_id\t$interval\t$starttime\t$endtime\n",'');
    }
    close($frequencyfile);
    close($mergefile) if $merge;
    info("wrote canonical frequencies.tab");
  }

# stop times
  $fname = 'stop_times.tab';
  inican($canondir . "/$fname");
  open($stoptimfile,'>:encoding(UTF-8)',$canondir . "/$fname") or return 0;
  if ($merge) {
      $cmt = -f $mergedir . "/$fname" ? '# ' : '';
    open($mergefile,'>>:encoding(UTF-8)',$mergedir . "/$fname") or return 0;
  }

  print2($stoptimfile,$mergefile,"trip_id\tstop_id\tstop_sequence\tarrival_time\tdeparture_time\n",$cmt);

  $glinno = 0;
  foreach $line (@stop_times) {
    $glinno++;
    ($tripid,$stopid,$seq,$arr_time,$dep_time) = split("\t",$line);
    return error("$line: no arrtime") unless defined $arr_time;
    $dep_time = $arr_time unless defined $dep_time;
    $trip_id = $idprefix . $trip_ids{$tripid};
    return error("undefined stop $stopid") unless exists $rstopbyid{$stopid};
    $stop_id = $idprefix . $rstopbyid{$stopid};
    return error("undefined tid") unless defined $trip_id;
    return error("undefined stop") unless defined $stop_id;
    $stline = sprintf("%s\t%s\t%u\t%s\t%s\n",$trip_id,$stop_id,$seq,$arr_time,$dep_time);
    print2($stoptimfile,$mergefile,$stline,'');
  }
  close($stoptimfile);
  close($mergefile) if $merge;
  info("wrote canonical stop_times.tab");
  return 1;
}

# main program starts here

my $starttime = time();

my $progdir = rindex $0,'/';
my $cwd = '.';
if ($progdir > 0) { $cwd = substr($0,0,$progdir); }

my ($arg,$opt,$cmd,$argno,$tbox0,$tbox1,$dist);
my $endopt = 0;
my @args;

if (@ARGV == 0) { usage(); exit 1; }

foreach $arg (@ARGV) {
  if (substr($arg,0,1) eq '-') {
    $opt = $arg;
    $opt =~ s/^-+//;
    if ($opt eq 'h' or $opt eq '?' or $opt eq 'help') { showvers(0); usage(); exit 1; }
    if ($opt eq 'V' or $opt eq 'version') { showvers(1); exit 1; }
  }
}

showvers(0);

foreach $arg (@ARGV) {
  my ($eq,$xopt,$val,$isnum);
  if ($endopt == 0 and substr($arg,0,1) eq '-') {
    if ($arg eq '--') { $endopt = 1; next; }
    $xopt = $arg;
    $xopt =~ s/^-+//;
    next unless length $xopt;
    $eq = index($xopt,'=');
    if ($eq > 0) {
      $isnum = 0;
      $opt = substr($xopt,0,$eq);
      $val = substr($xopt,$eq+1);
      $isnum = 1 if $val =~ '^[0-9]+$';
    }
    else { $opt = $xopt; $val = ''; }
    vrb("opt '$opt' val '$val'");
    if ($opt eq 'v' or $opt eq 'verbose') { info('verbose mode'); $verbose = 1; }
    elsif ($opt eq 'n' or $opt eq 'dryrun') { info('dryrun mode'); $dryrun = 1; }
    elsif ($opt eq 'a' or $opt eq 'analysis') { info('analysis output enabled'); $anaout = 1; }
    elsif ($opt eq 'c' or $opt eq 'canonical') { info('canonical output enabled'); $canonout = 1; }
    elsif ($opt eq 'r' or $opt eq 'reserve') { info('mark all routes as requiring reservation'); $allreserved = 1; }
    elsif ($opt eq 't' or $opt eq 'test') { info('test only, no output'); $testonly = 1; }
    elsif ($opt eq 'u' or $opt eq 'unconditional') { info('unconditional'); $conditional = 0; }
    elsif ($opt eq 'U' or $opt eq 'Unconditional') { info('Unconditional'); $conditional = $Conditional = 0; }
    elsif ($opt eq 'mergedir') { $mergedir = $val; info("merge to '$val'"); }
    elsif ($opt eq 'runto') { $runto = $val; info("run to '$val'"); }
    elsif ($opt eq 'duproute') { $chkduproute = 1; }
    elsif ($opt eq 'nobus') { $include_bus = 0; }
    elsif ($opt eq 'nometro') { $include_metro = 0; }
    elsif ($opt eq 'notaxi') { $include_taxi = 0; }
    elsif ($opt eq 'routelim') {
      error("$opt needs integer arg, found $val") unless $isnum;
      $routelim = $val;
    } elsif ($opt eq 'taximode') {
      if ($isnum) { $taximode = $val; }
      else { error("$opt needs integer arg, found $val"); exit 1; }
      info("taxi mode $taximode");
    } elsif ($opt eq 'dateshift') {
      if ($isnum) { $dateshift = $val * 7; }
      else { error("$opt needs integer arg, found $val"); exit 1; }
      info("date shift $dateshift days");
    }
    elsif ($opt eq 'noferry') { $include_ferry = 0; }
    elsif ($opt eq 'notrain' or $opt eq 'norail') { $include_rail = 0; }
    elsif ($opt eq 'nopatch') { $do_patch = 0; }
    elsif ($opt eq 'tzmin') { $tzmin = $opt; }
    else { info("ignoring unknown option -$opt"); }
  } else {
    push(@args,$arg);
  }
}
if (@args > 0) {
  init($cwd) or exit 1;
  $cmd = $args[0];
  if ($cmd eq 'import') {
    unless (@args > 1) { basemsg("missing arg 'dir' for import"); exit 1; }
    $outdir = (@args > 1) ? $args[1] : '.';
    $indir = (@args > 2) ? $args[2] : $outdir;
    $indir = $outdir if $indir eq '=';
    $indir = $outdir . substr($indir,1) if substr($indir,0,1) eq '=';
    $anadir = $outdir;
    $canondir = $outdir;
    error_exit("dir $indir does not exist") unless -d $indir;
    error_exit("dir $outdir does not exist") unless -d $outdir;
    info("import from $indir to $outdir");
    if (import($indir)) {
      writext($indir,$outdir) or exit 1;
      writegtfs() if $canonout;
    }
  } elsif ($cmd eq 'air2gtfs') {
    unless (@args > 5) { basemsg("$cmd needs format,outdir,indir,startdate,enddate"); exit 1; }
    $format = $args[1];
    $outdir = $args[2];
    $indir = $args[3];
    $indir = $outdir if $indir eq '=';
    $indir = $outdir . substr($indir,1) if substr($indir,0,1) eq '=';
    $canondir = $outdir;
    $tbox0 = $args[4];
    $tbox1 = $args[5];
    # $idprefix = $indir . '/';
    info("$cmd from $indir to $outdir");
    error_exit("air2gtfs failed") unless air2gtfs($format,$indir,$tbox0,$tbox1);
    writegtfs() unless $testonly;
  } elsif ($cmd eq 'tt2gtfs') {
    unless (@args > 5) { basemsg("$cmd needs format,outdir,indir,startdate,enddate"); exit 1; }
    $format = $args[1];
    $outdir = $args[2];
    $indir = $args[3];
    $canondir = $outdir;
    $indir = $outdir if $indir eq '=';
    $indir = $outdir . substr($indir,1) if substr($indir,0,1) eq '=';
    $tbox0 = $args[4];
    $tbox1 = $args[5];
    $idprefix = substr($indir,0,-2);
    info("$cmd from $indir to $outdir");
    error_exit("tt2gtfs failed") unless tt2gtfs($format,$indir,$tbox0,$tbox1);
    writegtfs() unless $testonly;
  } elsif ($cmd eq 'geo') {
    unless (@args > 4) { basemsg("$cmd needs lat1,lon1,lat2,lon2"); exit 1; }
    $dist = geodist($args[1],$args[2],$args[3],$args[4]);
    info("$dist");
  } else { error_exit("unknown command '$cmd': known are import,merge,air2gtfs,tt2gtfs"); }
}

my $usertime = time() - $starttime;
if ($usertime > 60) { info("elapsed time " . int($usertime / 60) . " min " . $usertime % 60 . " sec"); }
elsif ($usertime > 1) { info("elapsed time " . plural($usertime,'second')); }

if ($errorcnt) {
  exit 1 if $lastlvl eq 'e';
  info("$errorcnt errors") if $errorcnt > 1;
  while (my ($line,$cnt) = each %errcnts) {
    if ($cnt > 1) { info("E line $line $errors{$line} * $cnt"); }
    else { info("E line $line $errors{$line}"); }
  }
  exit 1;
}

info(plural($warningcnt,"warning")) if $warningcnt;

if ($warningcnt > 1) {
  while (my ($line,$cnt) = each %warncnts) {
    info("w line $line $warnings{$line} * $cnt");
  }
}

# POSIX::_exit($errorcnt > 0);