view release on metacpan or  search on metacpan

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

  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',