view release on metacpan or  search on metacpan

lib/Finance/Quote/TreasuryDirect.pm  view on Meta::CPAN

}

sub treasurydirect {

  # check for quotes for today, as well as the last three days

  my $time = time();
  my @times = map { $time-86400*$_ } 0..3;

  for my $t (@times) {
    my ($d, $m, $y) = (localtime($t))[3,4,5];
    $y += 1900;
    $m += 1;
    my @quotes = treasurydirect_ymd($y, $m, $d, @_);
    return @quotes if @quotes;
  }

}

sub treasurydirect_ymd {

  my ($y, $m, $d, $quoter, @symbols) = @_;

  return unless @symbols;

  my %info;

  $info{$_, 'success'} = 0 for @symbols;

  my $ua = $quoter->user_agent;
  $ua->timeout(10);
  $ua->ssl_opts( verify_hostname => 0 );

  my $content;
  my $url = $TREASURY_DIRECT_URL;
  #print "[debug]: ", $url, "\n";

  if (0) {
    my $response = $ua->request(GET $url);
    #print "[debug]: ", $response->content, "\n";
    if (!$response->is_success) {
      $info{$_, 'errormsg'} = 'Error contacting URL' for @symbols;
      return wantarray() ? %info : \%info;
    }
    $content = $response->content;
  }

  # this is no longer working, for some reason
  elsif (0) {
    my $url = 'https://www.treasurydirect.gov/GA-FI/FedInvest/selectSecurityPriceDate';
#    my $post_data = [ "priceDate.month" => "4", "priceDate.day" => "13", "priceDate.year" => "2018", "submit" => "Show+Prices" ];
    my $post_data = [ 'priceDate.month' => $m,
		      'priceDate.day' => $d,
		      'priceDate.year' => $y,
		      'submit' => 'Show Prices',
		    ];

    my $request = POST( $url, $post_data);
    my $resp = $ua->request($request);
    if ($resp->is_success) {
      $content = $resp->decoded_content;
      # print "[debug]: ", $content, "\n";
    } else {
      $info{$_, 'errormsg'} = 'Error contacting URL' for @symbols;
      return wantarray() ? %info : \%info;
    }
  }

  else {
    my $url = 'https://www.treasurydirect.gov/GA-FI/FedInvest/selectSecurityPriceDate';
    #my $data= 'priceDate.month=1&priceDate.day=4&priceDate.year=2021&submit=Show+Prices';

    my $data =
      'priceDate.month=' . $m .
      '&priceDate.day=' . $d .
      '&priceDate.year=' . $y .
      '&submit=Show+Prices';

    $content = `wget --no-check-certificate --post-data='$data' $url -O - 2>/dev/null`;
  }

  # submitted a future date
  return if $content =~ /Submitted date must be equal to/;

  # weekends, holidays (doesn't work like this any more)
  return if $content =~ /No data for selected date range/;

  my ($date, $isodate);
  if ($content =~ /Prices For:\s+(\w+)\s+(\d+),\s+(\d+)/) {
    my @months = qw/ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /;
    my %months; @months{@months} = 1..12;
    my ($year, $month, $day) = ($3, $months{$1}, $2);
    $date = sprintf "%02d/%02d/%04d", $month, $day, $year;
    $isodate = sprintf "%04d-%02d-%02d", $year, $month, $day;
  }

  my $te = new HTML::TableExtract();
  $te->parse($content);
  # print "[debug]: (parsed HTML)",$te, "\n";

  unless ($te->first_table_found()) {
    #print STDERR  "no tables on this page\n";
    $info{$_, 'errormsg'} = 'Parse error' for @symbols;
    return wantarray() ? %info : \%info;
  }

  # Debug to dump all tables in HTML...

=begin comment

  print "\n \n \n \n[debug]: ++++ ==== ++++ ==== ++++ ==== ++++ ==== START OF TABLE DUMP ++++ ==== ++++ ==== ++++ ==== ++++ ==== \n \n \n \n";

  for my $ts ($te->table_states) {

    printf "\n \n \n \n[debug]: //// \\\\ //// \\\\ //// \\\\ //// \\\\ START OF TABLE %d,%d //// \\\\ //// \\\\ //// \\\\ //// \\\\ \n \n \n \n",
      $ts->depth, $ts->count;

    for my $row ($ts->rows) {
      print '[debug]: ', join('|', map { defined $_ ? $_ : 'undef' } @$row), "\n";
    }
  }