view release on metacpan or  search on metacpan

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

                            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

# return tdate for available daily report
# 
sub daily_available_date {
  my ($symbol) = @_;
  my $type = type($symbol);
  if ($type eq 'metals') {
    # http://www.lme.co.uk/who_how_ringtimes.asp
    #     Prices after second ring session each trading day, which would be
    #     16:15 maybe, try at 16:30.
    return App::Chart::Download::weekday_date_after_time
      (16,30, App::Chart::TZ->london, -1);
  }