view release on metacpan or  search on metacpan

devel/Casablanca.pm  view on Meta::CPAN

sub methods {
  return (casablanca => \&casablanca_quotes);
}
sub labels {
  return (casablanca => [ qw(date isodate name currency
                             bid ask
                             open high low last close p_change volume
                             year_range
                             eps
                             div ex_div div_yield
                             cap
                             method source success errormsg

                             bid_quantity
                             ask_quantity
                             dollar_volume_both_sides
                             year_high
                             year_low
                             net_profit
                             payout_percent
                             par_value
                             shares_on_issue
                             nominal_capital
                           ) ]);
}
sub currency_fields {
  return (Finance::Quote::default_currency_fields(),
          qw(dollar_volume_both_sides
             year_high
             year_low
             net_profit
             par_value
             nominal_capital));
}

# Similar information is on the stocks-by-sector page
#
#     http://www.casablanca-bourse.com/cgi/ASP/Marche_Central/sectors_en.asp
#
# but there's no bid/offer there, so the individual pages are used.
#
use constant QUOTE_BASE_URL =>
  'http://www.casablanca-bourse.com/cgi/ASP/Donnees_Valeur/anglais/Donnes_valeurs.asp?ticker_valeur=';

sub make_url {
  my ($symbol) = @_;
  require URI::Escape;
  return QUOTE_BASE_URL . URI::Escape::uri_escape($symbol);
}

sub casablanca_quotes {
  my ($fq, @symbol_list) = @_;
  my $ua = $fq->user_agent;
  my %quotes;

  foreach my $symbol (@symbol_list) {
    my $url = make_url ($symbol);

    my $req = HTTP::Request->new ('GET', $url);
    $ua->prepare_request ($req);
    $req->accept_decodable; # we know decoded_content() below
    $req->user_agent (__PACKAGE__."/$VERSION " . $req->user_agent);
    ### Request: $req->as_string

    my $resp = $ua->request ($req);
    resp_to_quotes ($fq, $symbol, $resp, \%quotes);
  }
  return wantarray() ? %quotes : \%quotes;
}

# The "Reference price" seems to be the previous close, ie. reference for
# the change amount.  The volume is a dollar volume, and it seems to be
# doubled, roughly 2 * price * "Total securities traded".
#
%label_to_field = ('currentprice'      => 'last',
                   'opening'           => 'open',
                   'referenceprice'    => 'close', # ie. previous

                   'todayshigh'        => 'high',
                   'todayslow'         => 'low',
                   'percentchange'     => 'p_change',

                   'actualcapital'     => 'cap', # think this is market cap
                   'volume'            => 'dollar_volume_both_sides',
                   'totalsecuritiestraded' => 'volume',

                   'bestbuyersask'            => 'ask',
                   'quantityofbestbuyersask'  => 'ask_quantity',
                   'bestsellersbid'           => 'bid',
                   'quantityofbestsellersbid' => 'bid_quantity',
                   'yearshigh'                => 'year_high',
                   'yearslow'                 => 'year_low',

                   # is exercice the results year for other figures?
                   'exercice'         => undef,
                   'capital'          => 'nominal_capital',
                   # total business revenue, or turnover ?
                   'figureofaffair'   => undef,

                   'dividend'         => 'div', # amount
                   'numberofshare'    => 'shares_on_issue',
                   'netresult'        => 'net_profit', # total

                   'ex-datedividend'  => 'ex_div', # date
                   'nominalvalue'     => 'par_value',

                   'payout(en%)'      => 'payout_percent',
                   'dividendyield(%)' => 'div_yield',
                   'earningpershare'  => 'eps',

                   # empty label
                   '' => undef,
                  );

# store to hashref $quotes for $symbol based on HTTP::Response in $resp
sub resp_to_quotes {
  my ($fq, $symbol, $resp, $quotes) = @_;

  $quotes->{$symbol,'method'} = 'casablanca';
  $quotes->{$symbol,'currency'} = 'MAD';
  $quotes->{$symbol,'source'} = __PACKAGE__;
  $quotes->{$symbol,'success'} = 1;

  # defaults to latin1, which is right
  my $content = $resp->decoded_content (raise_error => 1, charset => 'none');
  if (! $resp->is_success) {
    $quotes->{$symbol,'success'}  = 0;
    $quotes->{$symbol,'errormsg'} = $resp->status_line;
    return;
  }
  $content =~ tr/\240/ /;

  if ($content =~ /Pas de r.sultat/) {
    $quotes->{$symbol,'success'}  = 0;
    $quotes->{$symbol,'errormsg'} = 'No information';
    return;
  }

  # Pick out the name, eg.
  # <center>
  #  <p>&nbsp;</p>
  #  <p><font color="#004496" face="Verdana" size="-1"><b>AUTO NEJMA    </b></font><br>
  if ($content !~ /<[bB]>([A-Z][^<\r\n]+)/) {
    $quotes->{$symbol,'success'}  = 0;
    $quotes->{$symbol,'errormsg'} = 'Cannot find stock name in page';
    return;
  }
  my $name = $1;
  $name =~ s/\s+$//; # trailing whitespace
  $quotes->{$symbol,'name'} = $name;

  # Pick out the date, eg.
  # <b>Session of:</b> </font><font color="#004496" face="Verdana" size="-2"><b>
  #      13/04/2007 </b></font> </td>
  # Match first d/m/y after "Session of" (possibly crossing newlines)
  if ($content !~ m{Session of.*?([0-9]{1,2}/[0-9]{1,2}/[0-9]{4})}s) {
    $quotes->{$symbol,'success'}  = 0;
    $quotes->{$symbol,'errormsg'} = 'Cannot find date in page';
    return;
  }
  $fq->store_date($quotes, $symbol, {eurodate => $1});

  require HTML::TableExtract;
  my $te = HTML::TableExtract->new;
  $te->parse ($content);

  foreach my $ts ($te->tables) {
    my $rows = $ts->rows;
    foreach my $row (@$rows) {
      ### $row

      for (my $i = 0; $i <= $#$row-1; $i += 2) {
        my $label = $row->[$i];
        if (! defined $label) { next; }
        $label = lc $label;
        $label =~ s/[\s:']//g; # collapse for matching
        #         if (DEBUG) {
        #           if (! exists $label_to_field{$label}) {
        #             print "Unrecognised label: '$label'\n";
        #           }
        #         }
        my $field = $label_to_field{$label} or next;

        my $value = $row->[$i+1];
        $value =~ tr/\240/ /; # &nbsp; converted by TableExtract HTML::Parser