File Coverage

blib/lib/Finance/TW/TAIFEX.pm

Criterion	Covered	Total	%
statement	95	131	72.5
branch	18	38	47.3
condition	6	26	23.0
subroutine	27	32	84.3
pod	11	11	100.0
total	157	238	65.9

package Finance::TW::TAIFEX;
use strict;
use Any::Moose;
use DateTime;
use DateTime::Format::Strptime;
use Try::Tiny;
use File::ShareDir qw(dist_dir);
use List::MoreUtils qw(firstidx);
use Any::Moose 'X::Types::DateTime';
require MouseX::NativeTraits if Any::Moose->mouse_is_preferred;
use HTTP::Request::Common qw(POST);
use LWP::Simple 'getstore';
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );

use Finance::TW::TAIFEX::Product;
use Finance::TW::TAIFEX::Contract;

use 5.008_001;
our $VERSION = '0.39';

has context_date => ( is => "rw", isa => "DateTime",
                      default => sub { DateTime->now(time_zone => 'Asia/Taipei') },
                      coerce => 1);

has calendar => (is => "ro", isa => "HashRef", default => sub { {} });

has products => (
    traits => ['Hash'],
    is => "ro",
    isa => "HashRef[Finance::TW::TAIFEX::Product]",
    handles  => {
        has_product => 'exists',
        product     => 'get',
    },
    lazy_build => 1,
);


sub _build_products {
    my $self = shift;
    return {
        (map { $_ => Finance::TW::TAIFEX::Product->new_with_traits(
            traits => ['Settlement::ThirdWednesday'],
            exchange => $self,
            name => $_,
        ) } qw(TX MTX TE TF T5F MSF CPF XIF GTF
               TXO TEO TFO MSO XIO GTO)),
    };

#        (map { $_ => Finance::TW::TAIFEX::Product->new_with_traits(
#            traits => ['Settlement::ThirdToLastDayOfMonth'],
#            exchange => $self,
#            name => $_,
#        ) } qw(TGF TGO)),
#
#        (GBF => Finance::TW::TAIFEX::Product->new_with_traits(
#            traits => ['Settlement::SecondWednesday'],
#            exchange => $self,
#            name => 'GBF',
#        )),

}

=head1 NAME

Finance::TW::TAIFEX - Helper functions for Taiwan Futures Exchange

=head1 SYNOPSIS

  use Finance::TW::TAIFEX;

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

  $taifex->is_trading_day(); # is today a trading day?

  my $date = DateTime->now;
  $taifex->daily_futures_uri($date);
  $taifex->daily_options_uri($date);

  $taifex->contract('TX', '201001')->settlement_date;
  $taifex->product('TX')->near_term;
  $taifex->product('TX')->next_term;

=head1 DESCRIPTION

Finance::TW::TAIFEX provides useful helper functions for the Taiwan
Future Exchanges.

=head1 METHODS

=head2 product NAME

Returns the L<Finance::TW::TAIFEX::Product> object represented by NAME.

Currently supported product names:

=over

=item Futures

TX MTX TE TF T5F MSF CPF XIF GTF

=item Options

TXO TEO TFO MSO XIO GTO

=back

=head2 has_product NAME

Checks if the given product exists.

=cut

my $Strp = DateTime::Format::Strptime->new( pattern => '%F', time_zone => 'Asia/Taipei');

sub BUILDARGS {
    my $class = shift;
    return { @_ } unless $#_ == 0;
    return { } unless $_[0];
    return { context_date => ref $_[0] ? $_[0] : $Strp->parse_datetime($_[0]) }
}

=head2 contract NAME YEAR MONTH

Returns the L<Finance::TW::TAIFEX::Contract> of the given product expires on YEAR/MONTH.

=cut

sub contract {
    my ($self, $name, $year, $month) = @_;
    unless ($month) {
        my $spec = $year;
        ($year, $month) = $spec =~ m/^(\d{4})(\d{2})$/
            or die "$spec doesn't look like a contract month";
    }

    die "unknown product $name"
        unless $self->has_product($name);

    return Finance::TW::TAIFEX::Contract->new( product => $self->product($name),
                                               year => $year,
                                               month => $month );
}

sub _read_cal {
    my ($self, $file) = @_;
    open my $fh, '<', $file or die "$file: $!" ;
    return [map { chomp; $_ } <$fh>];
}

=head2 calendar_for YEAR

Returns the trading calendar for YEAR.

=cut

sub calendar_for {
    my ($self, $year) = @_;
    $year ||= $self->context_date->year;

    return $self->calendar->{$year}
        if $self->calendar->{$year};

    my $dist_dir = File::Spec->rel2abs("../../../share", File::Basename::dirname($INC{"Finance/TW/TAIFEX.pm"}));
    $dist_dir = try { dist_dir('Finance-TW-TAIFEX') || 'share' } unless -e $dist_dir;
    $self->calendar->{$year} = $self->_read_cal("$dist_dir/calendar/$year.txt");
}

=head2 is_trading_day [DATE]

Checks if the given DATE is a known trading day.  Default DATE is the date in the current context.

=cut

sub is_trading_day {
    my ($self, $date) = @_;
    $date ||= $self->context_date;

    $self->_nth_trading_day($self->calendar_for($date->year), $date->ymd) != -1;
}

=head2 next_trading_day [DATE]

Returns the next known trading day in string after the given DATE.

=cut

sub next_trading_day {
    my ($self, $date) = @_;
    $date ||= $self->context_date;

    my $cal = $self->calendar_for($date->year);
    my $d = $date->ymd;
    my $nth = firstidx { $_ gt $d } @{$cal};

    if ($nth < 0) {
        return $self->calendar_for($date->year + 1)->[0];
    }

    return $cal->[$nth];
}

=head2 previous_trading_day [DATE]

Returns the previous known trading day in string after the given DATE.

=cut

sub previous_trading_day {
    my ($self, $date, $offset) = @_;
    $date ||= $self->context_date;
    $offset ||= -1;

    my $cal = $self->calendar_for($date->year);
    my $nth = $self->_nth_trading_day($cal, $date->ymd);
    die "$date not a known trading day"
        if $nth < 0;

    if ($nth + $offset < 0) {
        return $self->calendar_for($date->year - 1)->[-1];
    }

    return $cal->[$nth + $offset];
}

sub _nth_trading_day {
    my ($self, $cal, $date) = @_;
    firstidx { $_ eq $date } @{$cal}
}

=head2 daily_futures_uri DATE

Returns the URI of the official TAIFEX futures trading records for DATE.

=cut

sub daily_futures_uri {
    my ($self, $date) = @_;
    $date ||= $self->context_date;
    return "http://www.taifex.com.tw/DailyDownload/Daily_@{[ $date->ymd('_') ]}.zip";
}

=head2 interday_futures_request($product, [$DATE])

Returns a HTTP::Request object that fetches futures monthly interday
csv file for $product of $DATE.

=cut

sub interday_futures_request {
    my ($self, $product, $date) = @_;
    $date ||= $self->context_date;
    my $from = $date->clone->truncate( to => 'month' );
    my $to = $from->clone->add( months => 1 )->subtract( days => 1 );
    return POST 'http://www.taifex.com.tw/chinese/3/3_1_2dl.asp',
      [ goday          => '',
        DATA_DATE      => $from->ymd('/'),
        DATA_DATE1     => $to->ymd('/'),
        DATA_DATE_Y    => $from->year,
        DATA_DATE_M    => $from->month,
        DATA_DATE_D    => $from->day,
        DATA_DATE_Y1   => $to->year,
        DATA_DATE_M1   => $to->month,
        DATA_DATE_D1   => $to->day,
        commodity_id2t => '',
        COMMODITY_ID   => $product ];
}

=head2 interday_options_request($product, [$DATE])

Returns a HTTP::Request object that fetches options monthly interday
csv file for $product of $DATE.

=cut

sub interday_options_request {
    my ($self, $product, $date) = @_;
    $date ||= $self->context_date;
    my $from = $date->clone->truncate( to => 'month' );
    my $to = $from->clone->add( months => 1 )->subtract( days => 1 );
    return POST 'http://www.taifex.com.tw/chinese/3/3_2_3_b.asp',
      [ goday          => '',
        DATA_DATE      => $from->ymd('/'),
        DATA_DATE1     => $to->ymd('/'),
        DATA_DATE_Y    => $from->year,
        DATA_DATE_M    => $from->month,
        DATA_DATE_D    => $from->day,
        DATA_DATE_Y1   => $to->year,
        DATA_DATE_M1   => $to->month,
        DATA_DATE_D1   => $to->day,
        COMMODITY_ID   => $product.'%' ];
}


=head2 daily_options_uri DATE

Returns the URI of the official TAIFEX options trading records for DATE.

=cut

sub daily_options_uri {
    my ($self, $date) = @_;
    $date ||= $self->context_date;
    return "http://www.taifex.com.tw/OptionsDailyDownload/OptionsDaily_@{[ $date->ymd('_') ]}.zip";
}

=head2 ensure_rpt DIR, TYPE, PREFIX

=cut

sub ensure_rpt {
    my ($self, $rpt_dir, $type, $prefix) = @_;
    my $date = $self->context_date;
    my $rpt_f = "$rpt_dir/".$date->ymd('-').".rpt";

    unless (-s $rpt_f) {
        my $rpt = $prefix.$date->ymd('_' ).".rpt";
        my $f = $self->can('daily_'.$type.'_uri') or die "unknown type: $type";
        my $url = $self->$f();
        my $tmp = "/tmp/taifex-$type-".$date->ymd('-').".zip";
        unless (-s $tmp) {
            my $rc = getstore($url => $tmp);

            die("failed to fetch $url: $rc")
                if HTTP::Status::is_error($rc);
        }
        my $zip = Archive::Zip->new();
        unless ( $zip->read( $tmp ) == AZ_OK ) {
            unlink( $tmp );
            die("Unable to read zip file $tmp");
        }
        unless ( $zip->extractMember($rpt, $rpt_f) == AZ_OK ) {
            die("Unable to extract $rpt from $tmp");
        }
    }
}

=head1 CAVEATS

The URI returned by C<daily_futures_uri> and C<daily_options_uri> are only valid for the last 30 trading days per the policy of TAIFEX.

=head1 AUTHOR

Chia-liang Kao E<lt>[e-mail]<gt>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<http://www.taifex.com.tw/>

=cut

__PACKAGE__->meta->make_immutable;
no Any::Moose;
1;