The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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 = '1.041';

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/\&amp\;/&/g ;
    }
    $n
}

my  $_brws ;
sub  _brws(@) {
    use LWP ;
    $_brws ||= new LWP::UserAgent() ;
    $_brws -> env_proxy() ;
    my $res = $_brws->get(@_) ;
    return $res -> content() if $res -> is_success() ;
    $res = $_brws->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 symbols_list($);
sub symbols_list($) {

    my $wt = shift || '?';
    $wt eq 'nasdaq' and return _gimi nas => 'http://www.nasdaq.com/screening/companies-by-name.aspx?letter=0&exchange=nasdaq&render=download' ;
    $wt eq 'amex'   and return _gimi nas => 'http://www.nasdaq.com/screening/companies-by-name.aspx?letter=0&exchange=amex&render=download' ;
    $wt eq 'nyse'   and return _gimi nas => 'http://www.nasdaq.com/screening/companies-by-name.aspx?letter=0&exchange=nyse&render=download' ;

    my @all = qw/nasdaq amex nyse/ ;
    $wt eq 'all'    and return map { symbols_list ($_) } @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__

=head1 NAME

Finance::TickerSymbols - Perl extension for getting symbols lists
                         from web resources

=head1 SYNOPSIS


  use Finance::TickerSymbols;
  for my $symbol ( symbols_list('all') ) {

     # do something with this $symbol
  }

  for my $industry ( industries_list()) {

     for my $symbol ( industry_list( $industry ) ) {

         # do something with $symbol and $industry

     }
  }

=head1 DESCRIPTION

get lists of ticker symbols. this list can be used for market queries.

=over 2

=item symbols_list

symbols_list( 'nasdaq' | 'amex' | 'nyse' | 'all' )
returns the apropriate array of symbols.

=item industries_list

industries_list()
returns array of industries names.

=item industry_list

industry_list( $industry_name )
returns array of symbols related with $industry_name

=item $Finance::TickerSymbols::long

setting $Finance::TickerSymbols::long to non-false would attach company name to each symbol
  (as "ARTNA:Basin Water, Inc." compare to "ARTNA")

=back

=head2 PROXY

Users may define proxy using environment variables.
examples (from LWP::UserAgent manuel):

      gopher_proxy=http://proxy.my.place/
      wais_proxy=http://proxy.my.place/
      no_proxy="localhost,my.domain"


=head2 TODO

=over 2

=item more markets

=back

=head1 SEE ALSO

  LWP
  http://quotes.nasdaq.com
  http://biz.yahoo.com/ic
  Finance::*

=head1 AUTHOR

Josef Ezra, E<lt>jezra@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Josef Ezra

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=head2 NOTES

- the returned data depends upon availability and format of
  external web sites. Needless to say, it is not guaranteed.


=head1 BUGS, REQUESTS, NICE IMPLEMENTATIONS, ETC.

Please email me about any of the above. I'll be more then happy to share
interesting implementation of this module.

=cut