#!/usr/bin/perl -w
#
# FidelityFixed.pm
#

package Finance::Quote::FidelityFixed;
require 5.004;

#
# Modification of Rolf Endres' Finance::Quote::ZA
#
# Peter Ratzlaff <pratzlaff@gmail.com>
# May, 2012
#

$VERSION = '1.17';


use strict;
use warnings;

use vars qw /$VERSION/ ;

use LWP::UserAgent;
use HTTP::Request::Common;
use HTML::TableExtract;

# e.g., https://fixedincome.fidelity.com/ftgw/fi/FIIndividualBondsSearch?cusip=912810QT8
my $FIDELITY_MAINURL = 'https://fixedincome.fidelity.com';
my $FIDELITY_URL = $FIDELITY_MAINURL . '/ftgw/fi/FIIndividualBondsSearch?cusip=';
#my $FIDELITY_MAINURL = 'http://fixedincome.fidelity.com';
#my $FIDELITY_URL = $FIDELITY_MAINURL . '/fi/FIIndividualBondsSearch?cusip=';

sub methods {
  return fidelityfixed => \&fidelityfixed;
}


sub labels {
  my @labels = qw/
		   method source name symbol coupon
		   bid bidyield askyield ask
		   date isodate time 3rdparty price
		 /;
  return fidelityfixed => \@labels;
}

sub fidelityfixed {

  my ($quoter, @symbols) = @_;
  return unless @symbols;

  my %info;

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

  for my $symbol (@symbols) {

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

    if (1) {
      my $response = $ua->request(GET $url);
      #print "[debug]: ", $response->content, "\n";
      if (!$response->is_success) {
        $info{$symbol, 'errormsg'} = 'Error contacting URL';
        next;
      }
      $content = $response->content;
    }

    else {
      $content = `wget --no-check-certificate $url -O - 2>/dev/null`;
    }

    $info{$symbol, 'success'} = 0;


    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{$symbol, 'errormsg'} = 'Parse error';
      next;
    }

    # 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('|', @$row), "\n";
           }
         }

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

=cut


    # GENERAL FIELDS
    $info{$symbol, 'method'} = 'fidelityfixed';
    $info{$symbol, 'symbol'} = $symbol;
    $info{$symbol, 'source'} = $FIDELITY_MAINURL;

    # OTHER INFORMATION
    my $ts = $te->table_state(0,1);
    if ($ts) {
      my @rows = $ts->rows;
      my $n = 3;

      if ($rows[$n][1] =~ /fidelity is not currently offering this security/i) {
	$n = 4;
      }

      if (
	  $rows[$n][1] !~ /do not match/ and
	  $rows[$n][1] !~ /return to the previous page/ and
	  1
	 ) {
	$info{$symbol, 'success'} = 1;
	$info{$symbol, 'name'}     = $rows[$n][1];
	$info{$symbol, 'coupon'}   = $rows[$n][2];
	$info{$symbol, 'maturity'} = $rows[$n][3];
	$info{$symbol, 'bidyield'} = $rows[$n][6];
	$info{$symbol, 'bid'}      = $rows[$n][7];
	$info{$symbol, 'ask'}      = $rows[$n][8];
	$info{$symbol, 'askyield'} = $rows[$n][9];
	$info{$symbol, '3rdparty'} = $rows[$n][10];

	# some bonds have a "Depth of Book" column in the table
	$info{$symbol, '3rdparty'} = $rows[$n][11] unless $info{$symbol, '3rdparty'} =~ /\d+\.\d+/;

	$info{$symbol, 'currency'} = 'USD';

	# clean things up a bit
	$info{$symbol, 'name'} =~ s/^\s+//;
	$info{$symbol, 'name'} =~ s/\s+$//;
	#($_) = /(\d+\.\d+)/ for $info{$symbol, 'bid'}, $info{$symbol, 'ask'};
	($info{$symbol, $_}) = $info{$symbol, $_} =~ /(\d+\.\d+)/ for qw( bid ask 3rdparty bidyield askyield );

	# as of 24 Sept 2013, Fidelity is requiring a login to display 3rd party
	$info{$symbol, 'price'} = $info{$symbol, '3rdparty'};
	$info{$symbol, 'price'} = sprintf("%.2f", 0.5*($info{$symbol, 'bid'} + $info{$symbol, 'ask'}));

	if ($content =~ /As of (\d+)\/(\d+)\/(\d+) at (\d+)\:(\d+) ([ap])\.m\./) {
	  $info{$symbol, 'date'} = "$1/$2/$3";
	  $info{$symbol, 'isodate'} = "$3-$1-$2";
	  $info{$symbol, 'time'} = $6 eq 'a' ? "$4:$5" : ($4+12).":$5";
	}
      } else {
	$info{$symbol, 'errormsg'} = 'no match';
      }
    }
  }

  return wantarray() ? %info : \%info;
}

1;

=head1 NAME

Finance::Quote::FidelityFixed- Obtain individual bond quotes from Fidelity

=head1 SYNOPSIS

    use Finance::Quote;

    $q = Finance::Quote->new;

    # Don't know anything about failover yet...

=head1 DESCRIPTION

This module obtains individual bond quotes by CUSIP number from fixedincome.fidelity.com

=head1 LABELS RETURNED

Information available from FidelityFixed may include the following labels:

method source name symbol coupon bid bidyield askyield ask price=3rdparty date isodate time

=head1 SEE ALSO

fidelity.com

Finance::Quote

=cut