File Coverage

blib/lib/Finance/TickerSymbols.pm

Criterion	Covered	Total	%
statement	54	71	76.0
branch	13	28	46.4
condition	8	17	47.0
subroutine	13	14	92.8
pod	3	3	100.0
total	91	133	68.4

package Finance::TickerSymbols;

use strict;
use warnings;
use bytes ;

use Carp ;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = qw'symbols_list
                 industries_list
                 industry_list
                ' ;

our $VERSION = '2.01';

our $long;

my %inds ;

sub _carp(@) { carp "@_\n" ; ()}

sub _http2name($){
    my  $n = shift ;
    for($n) {
        s/^\s+//s ;
        s/\s+$//s ;
        s/\s+/ /sg ;
        s/\&\;/&/g ;
    }
    $n
}

my  $_ua ;
sub  _ua() {
    use LWP ;
    # use HTTP::Cookies;
    # use File::Temp 'tempfile' ;
    # my $ua = new LWP::UserAgent(Accept => "text/html, */*;q=0.1", referer => 'http://google.com') ;
    my $ua = new LWP::UserAgent() ;
    $ua -> env_proxy() ;
    # $ua -> cookie_jar( new HTTP::Cookies (file => tempfile()));
    $ua -> agent("");
    $ua
}

sub  _brws(@) {
    $_ua ||= _ua() ;
    my $res = $_ua->get(@_) ;
    return $res -> content() if $res -> is_success() ;
       $res = $_ua->get(@_) ;
    return $res -> content() if $res -> is_success() ;
    return _carp "download (@_):", $res->status_line() ;
}

sub _gimi($$;@) {
    my $prs = shift ;

    local $_ = _brws(@_) or return ;

    if ($prs eq 'nas' and $long) {
        my @ret ;
        while ( m/^
                  \s* \" ([\w+\.]+) \" \s* \,
                  \s* \" (.*? (?:[^\\] | \\ \\ )) \"
                 /xgm ) { push @ret, "$1:$2" }
        shift  @ret if @ret and $ret[0] eq 'Symbol:Name' ;
        return @ret
    }
    elsif ($prs eq 'nas') {
        my @ret ;
        while (m/^ \s* \" ([\w+\.]+) \"
                /xgm ) { push @ret, $1 }
        shift  @ret if @ret and $ret[0] eq 'Symbol' ;
        return @ret ;
    }
    elsif ($prs eq 'ind' and $long) {
        my @ret ;
        while ( m{
                   http\://biz\.yahoo\.com/ic/\d+/\d+\.html\"\>([^\<]+).*?
                   http\://finance\.yahoo\.com/q\?s\=([\w\.]+)
             }xgs ) {push @ret, $2 . ':'. _http2name $1 }
        return @ret
    }
    elsif ($prs eq 'ind') {
        return
          m{http\://finance\.yahoo\.com/q\?s\=([\w\.]+)\s*\"}g
    }
    elsif ($prs eq 'inds') {

        while ( m{http\://biz\.yahoo\.com/ic/(\d+)\.html\s*\"\s*\>\s*([^\<]+)}sg ) {
            my ($d, $n) = ($1, $2) ;
            $inds{ _http2name $n } = $d ;
        }
        return keys %inds;
    }
}

sub _gimi_nasdaq($) {
    my $url = 'http://www.nasdaq.com/screening/companies-by-name.aspx?letter=0&exchange=' . shift ;
    # my $dummy = _brws($url);
    _gimi nas => $url . '&render=download';
}

sub symbols_list($) {

    my $wt = shift || '?';
    my @all = qw/nasdaq amex nyse/ ;
    return _gimi_nasdaq uc $wt            if grep {$_ eq $wt } @all ;
    return map {_gimi_nasdaq uc $_ } @all if $wt eq 'all';
    return _carp "bad parameter: should be " . join '|', @all, 'all' ;
}

sub industries_list { _gimi inds => 'http://biz.yahoo.com/ic/ind_index.html' }

sub industry_list($) {
    %inds or industries_list() ;
    my $name = shift ;
    my $n = $inds{$name} or return _carp "'$name' is not recognized" ;

    my $p = 'pub' ; # shift || ''; $p = 'pub' unless $p eq 'prv' or $p eq 'all' ;
                    # ?? TODO ??
                    # support Private/Foreign ? what for?
    _gimi ind => "http://biz.yahoo.com/ic/${n}_cl_${p}.html"
}

1;

__END__