The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
use strict;
use warnings;
use Pod::Usage;
use DateTime;
use DateTime::Format::Strptime;
use Finance::TW::TAIFEX;
BEGIN {
eval 'require Finance::FITF; Finance::FITF->import; 1'
    or die 'Finance::FITF required';
eval 'require Log::Log4perl; 1'
    or die 'Log::Log4perl required';
}
if (-e 'log.conf') {
    Log::Log4perl::init('log.conf');
}
else {
    use Log::Log4perl::Level;
    Log::Log4perl->easy_init($ERROR);

}
my $logger = Log::Log4perl->get_logger('taifex');

my $rpt_dir = shift or die 'rpt dir required';
my $fitf_db = shift or die 'fitf dir required';
my $contract = shift or die 'contract required';
my $code = shift;

$fitf_db =~ s/\%c/$code/g;

my $taifex = Finance::TW::TAIFEX->new(shift);

$taifex->is_trading_day
    or exit(0);

my $date_dt = $taifex->context_date;
my $date = $date_dt->ymd('-');
my $month = $taifex->product($contract)->near_term($date_dt);

my $rpt_f = "$rpt_dir/$date.rpt";
my $fitf_file = DateTime::Format::Strptime->new( pattern => $fitf_db, time_zone => 'Asia/Taipei' )->format_datetime($date_dt);

open my $fitf_fh, '>', "$fitf_file"
    or $logger->error_die("unable to open $fitf_file for writing: $!");

my $layer = '';
if (-e "$rpt_f.bz2") {
    $rpt_f .= '.bz2';
    require PerlIO::via::Bzip2;
    $layer .= ':via(Bzip2)';
}

open my $rpt_fh, '<'.$layer , $rpt_f
    or $logger->error_die("unable to open $rpt_f for read: $!");
$date =~ s/-//g;
my $writer = Finance::FITF->new_writer(
    fh => $fitf_fh,
    header => {
        name => 'XTAF.TX',
        date => $date,
        time_zone => 'Asia/Taipei',
        bar_seconds => 10,
        divisor => 1,
        format => FITF_TICK_USHORT | FITF_BAR_USHORT
    },
);

$writer->add_session( 525 * 60, 825 * 60 );

$logger->info("reading $contract $month");

<$rpt_fh>;
my $cumvol = 0;

my $prev_time;
my $prev_ts;
my $start = $writer->header->{start}[0];
sub gen_ts {
    my $data = shift;
    my $time = $data->{time};
    if ($prev_time && $time eq $prev_time) {
        $data->{timestamp} = $prev_ts;
        return $data;
    }
    my ($h, $m, $s) = $time =~ m/(\d\d?)(\d\d)(\d\d)/;
    $prev_ts = $data->{timestamp} = $start - 525 * 60 + ($h*60 + $m)*60 + $s;
    $prev_time = $time;
    return $data;
}

my $last_price;

my $contract_map = {
    TXF => 'TX',
};

while (<$rpt_fh>) {
    s/\s//g;
    my ($date, $c, $m,$time, $price, $vol, $derive_price) = split(',');
    next unless $c && $c eq $contract;
    $time = substr($time, 0, 6) if length $time == 8 && substr($time, 6, 2) eq '00';
    if ($contract eq 'TX' && $time >= 134500) {
        $time = 134459; # workaround for bizzare last entry in rpt
    }

    my $data;
    if ($m eq $month) {
        $data = { price  => $price,
                  date   => $date,
                  time   => $time,
                  volume => $vol/2,
                  cumvol => $cumvol += $vol/2 };
        $last_price = $price;
    }
    elsif ($m =~ m/^$month\//) { # spread
        $data = { price  => $last_price, #$derive_price,
                  date   => $date,
                  time   => $time,
                  volume => $vol/4,
                  cumvol => $cumvol += $vol/4 };
    }

    next unless $data;
    $data = gen_ts($data) if $data;
    $writer->push_price($data->{timestamp}, $data->{price}, $data->{volume});

}
$writer->end;