File Coverage

blib/lib/App/Chart/Suffix/ATH.pm

Criterion	Covered	Total	%
statement	15	17	88.2
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	21	23	91.3

# Athens Stock Exchange setups.    -*- coding: iso-8859-7 -*-

# Copyright 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2015 Kevin Ryde

# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.


# http://www.helex.gr/web/guest/securities-market-products
# latest price of everything
# http://www.helex.gr/web/guest/stock-snapshot/-/select-stock/43
# snapshot, about 280k
# http://www.helex.gr/web/guest/stock-historic/-/select-stock/43
# last 30 days


# cf http://www.ase.gr/content/en/Companies/ListedCo/Profiles/pr_Snapshot.asp?Cid=99&coname=HELLENIC+TELECOM.+ORG.
#
#    http://www.ase.gr/content/en/Companies/ListedCo/Profiles/pr_Snapshot.asp?share=HTO
#    http://www.ase.gr/content/en/marketdata/stocks/prices/Share_SearchResults.asp?share=HTO



package App::Chart::Suffix::ATH;
use 5.006;
use strict;
use warnings;
use URI::Escape;
use Locale::TextDomain 'App-Chart';

use App::Chart;
use App::Chart::Download;
use App::Chart::DownloadHandler;
use App::Chart::DownloadHandler::DividendsPage;
use App::Chart::Sympred;
use App::Chart::TZ;
use App::Chart::Weblink;


my $timezone_athens = App::Chart::TZ->new
  (name     => __('Athens'),
   choose   => [ 'Europe/Athens' ],
   fallback => 'EET-2');
my $pred = App::Chart::Sympred::Suffix->new ('.ATH');
$timezone_athens->setup_for_symbol ($pred);

# (source-help! athens-symbol?
# 	      (__p('manual-node','Athens Stock Exchange'))


#------------------------------------------------------------------------------
# weblink - company info
#
# The greek pages "/gr/" need greek symbols, the english doesn't work, hence
# only an english link here, for now.

App::Chart::Weblink->new
  (pred => $pred,
   name => __('ATHEX _Company Information'),
   desc => __('Open web browser at the Athens Stock Exchange page for this company'),
   proc => sub {
     my ($symbol) = @_;
     return 'http://www.ase.gr/content/en/Companies/ListedCo/Profiles/Profile.asp?name='
       . URI::Escape::uri_escape (App::Chart::symbol_sans_suffix ($symbol));
   });


#------------------------------------------------------------------------------
# 8859-7 transliteration
#
# The 8859-7 bytes here in the source are for ease of seeing what they're
# supposed to be, but they're only in the comments, the code is all-ascii.
#
# $translit is a Regexp::Tr mapping Perl wide-chars which are certain greek
# characters (from iso-8859-7) to some latin equivalents.
#
# This is for some greek characters found in otherwise English names, like
# ÂÁÍÊ (0xC2,0xC1,0xCD,0xCA) for BANK in ALPHA.ATH.  That comes out looking
# ok in Gtk or anywhere with good fonts, but for a tty a change to the
# actual intended latin characters is needed to make it printable.

our $translit; # global for testing
{
  my %table
    = (
       #            # A0   NO-BREAK SPACE
       #            # A1 ¡ MODIFIER LETTER REVERSED COMMA
       #            # A2 ¢ MODIFIER LETTER APOSTROPHE
       #            # A3 £ POUND SIGN
       #            # A4
       #            # A5
       #            # A6 ¦ BROKEN BAR
       #            # A7 § SECTION SIGN
       #            # A8 ¨ DIAERESIS
       #            # A9
       #            # AA
       #            # AB « LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
       #            # AC ¬ NOT SIGN
       #            # AD ­ SOFT HYPHEN
       #            # AE
       #            # AF ¯ HORIZONTAL BAR
       #            # B0 ° DEGREE SIGN
       #            # B1 ± PLUS-MINUS SIGN
       #            # B2 ² SUPERSCRIPT TWO
       #            # B3 ³ SUPERSCRIPT THREE
       #            # B4 ´ GREEK TONOS
       #            # B5 µ GREEK DIALYTIKA TONOS
       0xB6 => 'A', # B6 ¶ GREEK CAPITAL LETTER ALPHA WITH TONOS
       #            # B7 · MIDDLE DOT
       0xB8 => 'E', # B8 ¸ GREEK CAPITAL LETTER EPSILON WITH TONOS
       0xB9 => 'H', # B9 ¹ GREEK CAPITAL LETTER ETA WITH TONOS
       0xBA => 'I', # BA º GREEK CAPITAL LETTER IOTA WITH TONOS
       #            # BB » RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
       #            # BC ¼ GREEK CAPITAL LETTER OMICRON WITH TONOS
       #            # BD ½ VULGAR FRACTION ONE HALF
       #            # BE ¾ GREEK CAPITAL LETTER UPSILON WITH TONOS
       0xBF => 'O', # BF ¿ GREEK CAPITAL LETTER OMEGA WITH TONOS
       #            # C0 À GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
       0xC1 => 'A', # C1 Á GREEK CAPITAL LETTER ALPHA
       0xC2 => 'B', # C2 Â GREEK CAPITAL LETTER BETA
       0xC3 => 'G', # C3 Ã GREEK CAPITAL LETTER GAMMA
       0xC4 => 'D', # C4 Ä GREEK CAPITAL LETTER DELTA
       0xC5 => 'E', # C5 Å GREEK CAPITAL LETTER EPSILON
       0xC6 => 'Z', # C6 Æ GREEK CAPITAL LETTER ZETA
       0xC7 => 'H', # C7 Ç GREEK CAPITAL LETTER ETA
       #            # C8 È GREEK CAPITAL LETTER THETA
       0xC9 => 'I', # C9 É GREEK CAPITAL LETTER IOTA
       0xCA => 'K', # CA Ê GREEK CAPITAL LETTER KAPPA
       0xCB => 'L', # CB Ë GREEK CAPITAL LETTER LAMDA
       0xCC => 'M', # CC Ì GREEK CAPITAL LETTER MU
       0xCD => 'N', # CD Í GREEK CAPITAL LETTER NU
       0xCE => 'X', # CE Î GREEK CAPITAL LETTER XI
       #            # CF Ï GREEK CAPITAL LETTER OMICRON
       0xD0 => 'P', # D0 Ð GREEK CAPITAL LETTER PI
       0xD1 => 'R', # D1 Ñ GREEK CAPITAL LETTER RHO
       #            # D2
       0xD3 => 'S', # D3 Ó GREEK CAPITAL LETTER SIGMA
       0xD4 => 'T', # D4 Ô GREEK CAPITAL LETTER TAU
       #            # D5 Õ GREEK CAPITAL LETTER UPSILON
       #            # D6 Ö GREEK CAPITAL LETTER PHI
       #            # D7 × GREEK CAPITAL LETTER CHI
       #            # D8 Ø GREEK CAPITAL LETTER PSI
       0xD9 => 'O', # D9 Ù GREEK CAPITAL LETTER OMEGA
       #            # DA Ú GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
       #            # DB Û GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
       0xDC => 'a', # DC Ü GREEK SMALL LETTER ALPHA WITH TONOS
       0xDD => 'e', # DD Ý GREEK SMALL LETTER EPSILON WITH TONOS
       #            # DE Þ GREEK SMALL LETTER ETA WITH TONOS
       0xDF => 'i', # DF ß GREEK SMALL LETTER IOTA WITH TONOS
       #            # E0 à GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
       0xE1 => 'a', # E1 á GREEK SMALL LETTER ALPHA
       0xE2 => 'b', # E2 â GREEK SMALL LETTER BETA
       0xE3 => 'g', # E3 ã GREEK SMALL LETTER GAMMA
       0xE4 => 'd', # E4 ä GREEK SMALL LETTER DELTA
       0xE5 => 'e', # E5 å GREEK SMALL LETTER EPSILON
       0xE6 => 'z', # E6 æ GREEK SMALL LETTER ZETA
       #            # E7 ç GREEK SMALL LETTER ETA
       #            # E8 è GREEK SMALL LETTER THETA
       0xE9 => 'i', # E9 é GREEK SMALL LETTER IOTA
       0xEA => 'k', # EA ê GREEK SMALL LETTER KAPPA
       0xEB => 'l', # EB ë GREEK SMALL LETTER LAMDA
       0xEC => 'm', # EC ì GREEK SMALL LETTER MU
       0xED => 'n', # ED í GREEK SMALL LETTER NU
       #            # EE î GREEK SMALL LETTER XI
       #            # EF ï GREEK SMALL LETTER OMICRON
       0xF0 => 'p', # F0 ð GREEK SMALL LETTER PI
       0xF1 => 'r', # F1 ñ GREEK SMALL LETTER RHO
       0xF2 => 's', # F2 ò GREEK SMALL LETTER FINAL SIGMA
       0xF3 => 's', # F3 ó GREEK SMALL LETTER SIGMA
       0xF4 => 't', # F4 ô GREEK SMALL LETTER TAU
       #            # F5 õ GREEK SMALL LETTER UPSILON
       #            # F6 ö GREEK SMALL LETTER PHI
       #            # F7 ÷ GREEK SMALL LETTER CHI
       #            # F8 ø GREEK SMALL LETTER PSI
       0xF9 => 'o', # F9 ù GREEK SMALL LETTER OMEGA
       0xFA => 'i', # FA ú GREEK SMALL LETTER IOTA WITH DIALYTIKA
       #            # FB û GREEK SMALL LETTER UPSILON WITH DIALYTIKA
       #            # FC ü GREEK SMALL LETTER OMICRON WITH TONOS
       #            # FD ý GREEK SMALL LETTER UPSILON WITH TONOS
       0xFE => 'o', # FE þ GREEK SMALL LETTER OMEGA WITH TONOS
       #            # FF
      );

  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__