App-Chart

 view release on metacpan or  search on metacpan

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

      );

  require Encode;
  my $tr_from = join ('',
                      map { Encode::decode ('iso-8859-7', chr($_)) }
                      keys %table);
  my $tr_to = join ('', values %table);

  $tr_to   =~ s/-/\\-/g; # escape "tr" dash as range
  $tr_from =~ s/-/\\-/g;

  require Regexp::Tr;
  $translit = Regexp::Tr->new ($tr_from, $tr_to);
  Regexp::Tr->flush;
  ### $translit
}

#-----------------------------------------------------------------------------
# download - last 30 days by symbol
#
# This uses the prices pages like
#
#     http://www.ase.gr/content/en/marketdata/stocks/prices/Share_SearchResults.asp?share=HTO
#
# Various places link to those price pages using a "SID" id number, but the
# symbol works too.
#
# There's no ETag or Last-Modified to save re-downloading if our idea of
# what should be available is a bit out.

App::Chart::DownloadHandler->new
  (name   => __ 'ATHEX',
   pred   => $pred,
   proc   => \&last30_download,
   max_symbols => 1,
   available_date_time => \&last30_available_date_time,
  );

# Dunno when to expect new data.  Try after 6pm Athens time.
sub last30_available_date_time {
  return (App::Chart::Download::weekday_date_after_time
          (18,0, $timezone_athens),
          '18:00:00');
}

sub last30_download {
  my ($symbol_list) = @_;

  foreach my $symbol (@$symbol_list) {
    App::Chart::Download::status (__x ('ATHEX 30 days data {symbol}',
                                      symbol => $symbol));
    my $url = 'http://www.ase.gr/content/en/marketdata/stocks/prices/Share_SearchResults.asp?share='
      . URI::Escape::uri_escape (App::Chart::symbol_sans_suffix ($symbol));
    my $resp = App::Chart::Download->get ($url);
    App::Chart::Download::write_daily_group (last30_parse ($resp));
  }
}

sub last30_parse {
  my ($resp) = @_;
  my $content = $resp->decoded_content (raise_error => 1);

  my @data = ();
  my $h = { source        => __PACKAGE__,
            currency      => 'EUR',
            last_download => 1,
            cost_key      => 'athens-last30',
            date_format   => 'dmy',
            resp          => $resp,
            data          => \@data };

  # message in page if bad symbol
  if ($content =~ /Your search didn't return any results/) {
    return $h;
  }

  $content =~ m{Share Closing Prices: ([A-Z]+)[^-]*-[^>]*>([^<]+)</a>}
    or die "ATHEX last30 name not matched";
  my $symbol = $1 . '.ATH';
  my $name = $2;

  # some names on the english pages have greek 8859-7 capitals, mung those
  # to plain ascii
  $h->{'name'} = $translit->trans ($name);

  require HTML::TableExtract;
  my $te = HTML::TableExtract->new
    (headers => ['Date', 'Open', 'Max', 'Min', 'Price', 'Volume' ]);
  $te->parse($content);
  if (! $te->tables) {
    die "ATHEX last30 table not matched";
  }

  foreach my $row ($te->rows) {
    my ($date, $open, $high, $low, $close, $volume) = @$row;
    push @data, { symbol => $symbol,
                  date   => $date,
                  open   => $open,
                  high   => $high,
                  low    => $low,
                  close  => $close,
                  volume => $volume };
  }
  return $h;
}


#------------------------------------------------------------------------------
# dividends
#
# This uses the dividend page at
#
use constant DIVIDENDS_URL =>
  'http://www.ase.gr/content/en/announcements/dailypress/Daily_Dividends.asp';
#
# As of May 2008 alas there's no ETag or Last-Modified to avoid
# re-downloading, so leave at the default DividendsPage recheck frequency.
#

App::Chart::DownloadHandler::DividendsPage->new
  (name  => __('ATHEX dividends'),
   pred  => $pred,
   url   => DIVIDENDS_URL,
   parse => \&dividends_parse,
   key   => 'ATH-dividends');

sub dividends_parse {
  my ($resp) = @_;
  my $body = $resp->decoded_content (raise_error => 1);

  my @dividends = ();
  my $h = { source       => __PACKAGE__,
            resp         => $resp,
            date_format  => 'dmy',
            # amounts are like "0.360", trim to 2 decimals
            prefer_decimals => 2,
            dividends       => \@dividends };

  # "Price in &euro;" reaches here as wide char \x{20AC}, probably, maybe,
  # hopefully, but don't bother to try to match that.
  #
  require HTML::TableExtract;
  my $te = HTML::TableExtract->new
    (headers => [ 'Symbol',
                  'Ex-Dividend Date',
                  'Start Payment Date',
                  'Price in' ]);
  $te->parse($body);
  my @tables = $te->tables
    or die "ATHEX dividend table not matched";

  foreach my $ts (@tables) {
    foreach my $row ($ts->rows) {
      my ($symbol, $ex_date, $pay_date, $amount) = @$row;

      # skip blank separator rows
      if (! defined $symbol) { next; }

      # skip second row of headings under "Pre-Paid Dividends"
      if ($symbol eq 'Symbol') { next; }

      push @dividends, { symbol   => "$symbol.ATH",
                         ex_date  => $ex_date,
                         pay_date => $pay_date,
                         amount   => $amount };
    }
  }
  return $h;
}

1;
__END__



( run in 0.722 second using v1.01-cache-2.11-cpan-437f7b0c052 )