view release on metacpan or  search on metacpan

lib/App/Chart/Suffix/TGE.pm  view on Meta::CPAN

# There's an ETag / Last-Modified on the year file, but it's hardly needed
# since the dates are in the name.

App::Chart::DownloadHandler->new
  (name   => __('TGE'),
   pred   => $pred,
   proc   => \&download,
   backto => undef,
   available_tdate => \&available_tdate,
   by_commodity    => 1);

sub download {
  my ($symbol_list) = @_;
  download_day ($symbol_list)
    || download_year ($symbol_list);

  # (download-name-from-latest (_ "TGE") symbol-list))
}

# return tdate for available download data
# the .csv downloads have been seen with a Last-Modified headers
#     Wed, 24 Aug 2005 01:00:20 GMT      == 10am tokyo
#     Thu, 01 Sep 2005 22:33:05 GMT      ==  7am tokyo
# so try at 10:05am tokyo
#
sub available_tdate {
  App::Chart::Download::weekday_tdate_after_time
      (10,5, App::Chart::TZ->tokyo, -1);
}

# do a download of the last day .csv file for $symbol_list, if that would
# update all those
# return true if updated successfully, or false if not (should use zip instead)
# 
sub download_day {
  my ($symbol_list) = @_;

  my $commodity = App::Chart::symbol_commodity ($symbol_list->[0]);
  my $avail_tdate = available_tdate();
  my $start_tdate = App::Chart::Download::start_tdate_for_update(@$symbol_list);

  # use csv if all of $symbol_list just wanting $avail_tdate
  if ($start_tdate < $avail_tdate) {
    return 0;
  }
  my $filename = "\L$commodity\E01.csv";
  my $url = 'http://www.tge.or.jp/data/down_load/'
    . URI::Escape::uri_escape ($filename);

  App::Chart::Download::status (__x('TGE data {filename}',
                                   filename => $filename));
  my $resp = App::Chart::Download->get ($url,
                                       url_tags_key => 'TGE-day');
  if (! $resp->is_success) {
    # not modified, no new data
    return 1;
  }
  my $got_tdate = csv_tdate ($resp);
  if ($got_tdate == $start_tdate) {
    # got the expected data, process it
    my $content = $resp->decoded_content (charset => 'none');
    my $h = csv_parse ($content);
    $h->{'url_tags_key'} = 'TGE-day';
    return 1;
  } elsif ($got_tdate < $avail_tdate) {
    # got something older, there's no new data
    return 1;
  } else {
    return 0;
  }
}

sub download_year {
  my ($symbol_list) = @_;
  my $commodity = App::Chart::symbol_commodity ($symbol_list->[0]);
  my $avail_tdate = available_tdate();


  # try 0, -1, -2 direct filenames, then finally download page
  # (allowing for new COMM_NUM values too)
  #
  download_year_attempt (download_tdate_url ($commodity, $avail_tdate))
    || download_year_attempt (download_tdate_url ($commodity, $avail_tdate - 1))
      || download_year_attempt (download_tdate_url ($commodity, $avail_tdate - 2))
        || download_year_attempt (download_page ($commodity));
}

# return true if successful
sub download_year_attempt {
  my ($commodity, $url) = @_;

  $url =~ m{/([^/]+)$/};
  my $filename = $1;
  App::Chart::Download::status (__x('TGE data {filename}',
                                   filename => $filename));

  my $resp = App::Chart::Download->get ($url, allow_404 => 1);
  if (! $resp->is_success) { return 0; }

  # got the expected data, process it
  my $h = zip_parse ($resp);
  $h->{'url_tags_key'} = 'TGE-day';
  return 1;
}

# eg. http://www.tge.or.jp/data/down_load/co01040610050609.zip
#     for Jun/10/2004 - Jun/09/2005
sub download_tdate_url {
  my ($commodity, $tdate) = @_;
  my ($end_year, $end_month, $end_day) = App::Chart::tdate_to_ymd ($tdate);

  # a year ago, plus one day
  my ($start_year, $start_month, $start_day) = Date::Calc::Add_Delta_YMD
    ($end_year, $end_month, $end_day,  -1, 0, 1);

  return sprintf 'http://www.tge.or.jp/data/down_load/%s01%02d%02d%02d%02d%02d%02d.zip',
    lc($commodity),
      $start_year % 100, $start_month, $start_day,
        $end_year % 100, $end_month, $end_day;
}

sub zip_parse {
  my ($resp) = @_;
  my $zipstr = $resp->decoded_content (charset => 'none', raise_error => 1);
  my $h;

  require Archive::Zip;
  require IO::String;
  my $zip = Archive::Zip->new;
  my $io = IO::String->new ($zipstr);
  $zip->readFromFileHandle ($io);

  foreach my $member ($zip->members) {
    my $csv = $member->contents;
    my $hh = csv_parse ($csv);
    if ($h) {
      push @{$h->{'data'}}, @{$hh->{'data'}};
    } else {
      $h = $hh;
    }
  }
  return $h;
}

sub csv_parse {
  my ($content) = @_;
  $content =~ s/\r//g;
  my @lines = split /\n/, $content;

  my $heading = shift @lines;
  $heading eq 'yr_mo_dy,contract,contract_month,contract_price_m1,contract_price_m2,contract_price_m3,contract_price_a1,contract_price_a2,contract_price_a3,sett_price,volume,open_int,net_position'
    or die "TGE: unrecognised CSV headings: $heading";

  my @data;
  my $h = { source        => __PACKAGE__,
            currency      => 'JPY',
            month_format  => 'MMM_YY',
            expiry_proc   => \&symbol_expiry_date,
            date_format   => 'ymd',
            suffix        => '.TGE',
            last_download => 1,
            data          => \@data };

  foreach my $line (@lines) {
    my ($date, $commodity, $month, $m1, $m2, $m3, $a1, $a2, $a3, $settle,
        $volume, $openint, $net)
      = split /,/, $line;

    push @data, { date      => $date,  # eg. '20040603'
                  commodity => $commodity,
                  month     => YYYYMM_to_iso($month), # eg. '200407'
                  sessions  => [$m1, $m2, $m3, $a1, $a2, $a3, $settle],
                  volume    => $volume,
                  openint   => $openint };
  }
  return $h;
}

sub YYYYMM_to_iso {
  my ($str) = @_;
  return substr($str,0,4) . '-' . substr($str,4) . '-01';
}

1;