# Athens Stock Exchange setups. -*- coding: iso-8859-7 -*- # Copyright 2005, 2006, 2007, 2008, 2009, 2010, 2011 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 . # 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]+)[^-]*-[^>]*>([^<]+)} 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 => \÷nds_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 €" 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__