view release on metacpan or  search on metacpan

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

# As of July 2007, in https requests to secure.lme.com for the daily metals
# prices it seems essential to use http/1.1 persistent connections.  If
# "Connection: close" is requested by the client something fishy happens and
# the connection hangs at about byte 48887 out of about 62110 (waiting for
# the last 16kbyte tls packet).  This is with either gnutls or openssl and a
# trace with gnutls shows it just stops sending, though the TCP connection
# remains up.  Either the default http/1.1 persistence (no Connection header
# at all) or the compatibility "Connection: keep-alive" style seems to make
# it better.  Presumably it's something buggy in the server (Microsoft-IIS
# 6.0).

my $pred = App::Chart::Sympred::Suffix->new ('.LME');
App::Chart::TZ->london->setup_for_symbol ($pred);

# App::Chart::setup_source_help
#   ($pred, __p('manual-node','London Metal Exchange'));


my %polypropylene_hash = ('PP'=>1,'PA'=>1,'PE'=>1,'PN'=>1);
my %linearlow_hash     = ('LP'=>1,'LA'=>1,'LE'=>1,'LN'=>1);
my %steel_hash         = ('FM'=>1,'FF'=>1);

sub type {
  my ($symbol) = @_;
  my $commodity = App::Chart::symbol_commodity ($symbol);
  if ($polypropylene_hash{$commodity} || $linearlow_hash{$commodity}) {
    return 'plastics';
  }
  if ($steel_hash{$commodity}) {
    return 'steels';
  }
  return 'metals';
}

#-----------------------------------------------------------------------------
# weblink - commodity pages

App::Chart::Weblink->new
  (pred => $pred,
   name => __('LME _Commodity Page'),
   desc => __('Open web browser at the London Metal Exchange page for this commodity'),
   proc => sub {
     my ($symbol) = @_;

     if ($symbol =~ /^AA/) { return 'http://www.lme.co.uk/aluminiumalloy.asp' }
     if ($symbol =~ /^AH/) { return 'http://www.lme.co.uk/aluminium.asp' }
     if ($symbol =~ /^CA/) { return 'http://www.lme.co.uk/copper.asp' }
     if ($symbol =~ /^NA/) { return 'http://www.lme.co.uk/nasaac.asp' }
     if ($symbol =~ /^NI/) { return 'http://www.lme.co.uk/nickel.asp' }
     if ($symbol =~ /^PB/) { return 'http://www.lme.co.uk/lead.asp' }
     if ($symbol =~ /^SN/) { return 'http://www.lme.co.uk/tin.asp' }
     if ($symbol =~ /^ZS/) { return 'http://www.lme.co.uk/zinc.asp' }
     if ($symbol =~ /^F/)  { return 'http://www.lme.co.uk/steel.asp' }
     if ($symbol =~ /^P/)  { return 'http://www.lme.co.uk/plastics.asp' }
     if ($symbol =~ /^L/)  { return 'http://www.lme.co.uk/plastics.asp' }
     return undef;
   });


#-----------------------------------------------------------------------------
# HTTP::Cookies extras

# $jar is a HTTP::Cookies object, read $str into it with $jar->load (which
# would normally read from a file)
#
sub http_cookies_set_string {
  my ($jar, $str) = @_;
  my $fh = File::Temp->new (TEMPLATE => 'chart-cookie-jar-XXXXXX',
                            TMPDIR => 1);
  if (DEBUG) { print "cookie set tempfile ",$fh->filename,"\n"; }
  print $fh $str;
  close $fh or die;
  $jar->load ($fh->filename);
}

# $jar is a HTTP::Cookies object, return a string which is $jar->save output
# (which would normally go to a file)
#
sub http_cookies_get_string {
  my ($jar) = @_;
  my $fh = File::Temp->new (TEMPLATE => 'chart-cookie-jar-XXXXXX',
                            TMPDIR => 1);
  if (DEBUG) { print "cookie get $fh tempfile ",$fh->filename,"\n"; }
  $jar->save ($fh->filename);
  close $fh or die;
  # not certain if File::Temp 0.21 blessed handle is ok, use the filename
  return File::Slurp::slurp ($fh->filename);
}


#-----------------------------------------------------------------------------
# secure login
#
# This logs in at the data service page,
#
use constant LOGIN_URL =>
  'https://secure.lme.com/Data/Community/Login.aspx?ReturnUrl=%2fData%2fcommunity%2findex.aspx';
#
# The result is a cookie ".ASPXAUTH" recorded under "lme-cookie-jar" in the
# database ready for subsequent use.  An extra cookie with a dummy domain,
#
use constant LOGIN_DOMAIN  => 'chart-lme-logged-in.local';
#
# is used to note success.  Not sure how long a login is supposed to last
# (the server doesn't put an expiry on the cookie), but for now consider it
# expired after an hour,
#
use constant LOGIN_EXPIRY_SECONDS => 3600;
#

# create and return a new HTTP::Cookies which is the jar in the database
sub login_read_jar {
  require HTTP::Cookies;
  my $jar = HTTP::Cookies->new;
  my $str = App::Chart::Database->read_extra ('', 'lme-cookie-jar');
  if ($str) { http_cookies_set_string ($jar, $str); }
  return $jar;
}

# $jar is a HTTP::Cookies object, save it to the database
sub login_write_jar {
  my ($jar) = @_;
  App::Chart::Database->write_extra ('', 'lme-cookie-jar',
                                    http_cookies_get_string ($jar));
}

# return true if we're still logged in
sub login_is_logged_in {
  my $jar = login_read_jar();
  my $login_timestamp = jar_get_login_timestamp ($jar);
  return App::Chart::Download::timestamp_within ($login_timestamp,
                                                LOGIN_EXPIRY_SECONDS);
}

sub login_ensure {
  if (login_is_logged_in()) { return; }

  App::Chart::Download::status (__('LME login'));
  App::Chart::Database->write_extra ('', 'lme-cookie-jar', undef);

  my $username = App::Chart::Database->preference_get ('lme-username', undef);
  my $password = App::Chart::Database->preference_get ('lme-password', '');
  if (! defined $username || $username eq '') {
    die 'No LME username set in preferences';
  }

  require App::Chart::UserAgent;
  require HTTP::Cookies;
  my $ua = App::Chart::UserAgent->instance->clone;
  my $jar = HTTP::Cookies->new;
  $ua->cookie_jar ($jar);

  my $login_url = LOGIN_URL;
  $login_url = 'http://localhost/Login.aspx';
  my $resp = App::Chart::Download->get ($login_url, ua => $ua);

  my $content = $resp->decoded_content(raise_error=>1);
  my $form = HTML::Form->parse($content, $login_url)
    or die "LME login page not a form";

  # these are literal "$" in the field name
  $form->value ("_logIn\$_userID",   $username);
  $form->value ("_logIn\$_password", $password);

  my $req = $form->click();
  $ua->requests_redirectable ([]);
  $resp = $ua->request ($req);
  # The POST is to the Login.aspx page and success is a redirect to the main
  # data page /Data/community/index.aspx.  So failure is anything other than
  # 302, or no Location, or a Location but containing "Login".
  if ($resp->code != 302
      || ! $resp->header ('Location')
      || $resp->header ('Location') =~ /Login/) {
    die "LME: login failed";
  }

  jar_set_login_timestamp ($jar);
  login_write_jar ($jar);
}


sub jar_get_login_timestamp {
  my ($jar) = @_;
  my $login_timestamp;
  $jar->scan(sub {
               my ($version, $key, $val, $path, $domain, $port, $path_spec,
                   $secure, $expires, $discard, $hash) = @_;
               if ($domain eq LOGIN_DOMAIN && $key eq 'timestamp') {
                 $login_timestamp = $val;
               }
             });
  return $login_timestamp;
}
sub jar_set_login_timestamp {
  my ($jar) = @_;
  $jar->set_cookie (0,                    # version
                    'timestamp',          # key
                    App::Chart::Download::timestamp_now(), # value
                    '/',                  # path
                    LOGIN_DOMAIN,         # domain
                    0,                    # port
                    0,                    # path_spec
                    0,                    # secure
                    LOGIN_EXPIRY_SECONDS, # maxage
                    0);                   # discard
}


#-----------------------------------------------------------------------------
# Daily data

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

#   my ($symbol) = @_;
#   return
#     App::Chart::Download::iso_to_tdate_floor (daily_available_date ($symbol));
# }

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

  my $sm = partition_by_key ($symbol_list, \&type);
  while (my ($type, $symbol_list) = each %$sm) {
    App::Chart::Download::verbose_message ('LME', $type, @$symbol_list);

    login_ensure();
    my $l = daily_latest ($type);

    my $lo_tdate = App::Chart::Download::start_tdate_for_update (@$symbol_list);
    my $hi_tdate = $l->{'tdate'} - 1;

    foreach my $tdate ($lo_tdate .. $hi_tdate) {
      my $resp = daily_download_one ($type, $tdate, $l);
      my $h = daily_parse ($resp, $tdate);
      App::Chart::Download::write_daily_group ($h);
    }
    App::Chart::Download::write_daily_group ($l->{'h'});
  }
}

sub partition_by_key {
  my ($list, $func) = @_;
  require Tie::IxHash;
  my %sm;
  tie %sm, 'Tie::IxHash';
  foreach my $elem (@$list) {
    my $key = $func->($elem);
    push @{$sm{$key}}, $elem;
  }
  return \%sm;
}

sub daily_download_one {
  my ($type, $tdate, $l) = @_;

  require HTML::Form;
  my $content  = $l->{'content'};
  my $url  = $l->{'url'};
  my $form = HTML::Form->parse($content, $url)
    or die "LME metals page not a form";

  my ($year, $month, $day) = App::Chart::tdate_to_ymd ($tdate);
  # these are literal "$" in the field name
  $form->value ("_searchForm\$_lstdate",  $day);
  $form->value ("_searchForm\$_lstmonth", $month);
  $form->value ("_searchForm\$_lstyear",  $year);

  App::Chart::Download::status
      (__x('LME daily {type} {date}',
           type => $type,
           date => App::Chart::Download::tdate_range_string ($tdate)));

  require App::Chart::UserAgent;
  require HTTP::Cookies;
  my $ua = App::Chart::UserAgent->instance->clone;
  $ua->requests_redirectable ([]);
  my $jar = HTTP::Cookies->new;
  $ua->cookie_jar ($jar);

  my $req = $form->click();
  my $resp = $ua->request ($req);

  if (! $resp->is_success) {
    die "Cannot download $url\n",$resp->headers->as_string,"\n";
  }
  return $resp;
}

my %type_to_daily_url
  = (metals   => 'https://secure.lme.com/Data/community/Dataprices_daily_metals.aspx',
     plastics => 'https://secure.lme.com/Data/community/Dataprices_daily_prices_plastics.aspx',
     steels   => 'https://secure.lme.com/Data/community/Dataprices_Steels_OfficialPrices.aspx');

sub daily_latest {
  my ($type) = @_;
  require App::Chart::Pagebits;
  return App::Chart::Pagebits::get
    (name      => __x('LME daily latest {type}',
                      type => $type),
     url       => $type_to_daily_url{$type},
     key       => "lme-daily-latest-$type",
     freq_days => 0,
     timezone  => App::Chart::TZ->london,
     parse     => \&daily_latest_parse);
}

sub daily_latest_parse {
  my ($resp) = @_;
  my $content = $resp->decoded_content (raise_error => 1);
  my $h = daily_parse ($resp);
  return { h       => $h,
           date    => $h->{'data'}->[0]->{'date'},
           url     => $resp->uri->as_string,
           content => $content };
}


1;
__END__


#-----------------------------------------------------------------------------
# download - daily
#
#

# LST has elements (SYMBOL NAME TDATE BUY-STR SELL-STR MDATE) per
# `daily-html-parse'
#
# The sell price is used.  The report for cash prices has the seller marked
# as the settlement and for the forwards the historical files can be seen
# with the seller price.
#
(define (daily-process symbol-list lst)
  (download-process
   #:module      (_ "LME")
   #:symbol-list symbol-list