#!/usr/bin/perl -w
#
# Copyright (c) Stewart Whitman, 2006.
#                        All rights reserved
# Permission to use, copy, modify and distribute this material for
# any purpose and without fee is hereby granted, provided that the
# above copyright notice and this permission notice appear in all
# copies, and that the name of Stewart Whitman not be used in advertising
# or publicity pertaining to this material without the specific,
# prior written permission of an authorized representative of
# Stewart Whitman.
#
# STEWART WHITMAN MAKES NO REPRESENTATIONS AND EXTENDS NO WARRANTIES, EX-
# PRESS OR IMPLIED, WITH RESPECT TO THE SOFTWARE, INCLUDING, BUT
# NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
# FITNESS FOR ANY PARTICULAR PURPOSE, AND THE WARRANTY AGAINST IN-
# FRINGEMENT OF PATENTS OR OTHER INTELLECTUAL PROPERTY RIGHTS.  THE
# SOFTWARE IS PROVIDED "AS IS", AND IN NO EVENT SHALL STEWART WHITMAN OR
# ANY OF ITS AFFILIATES BE LIABLE FOR ANY DAMAGES, INCLUDING ANY
# LOST PROFITS OR OTHER INCIDENTAL OR CONSEQUENTIAL DAMAGES RELAT-
# ING TO THE SOFTWARE.
#
# File:    greenblatt.pl
# Project: Stock Scans
# Desc:    Determine Greenblatt Scores of stocks from various internet data sources
#
# $Header$
#

use Getopt::Long;
use File::Basename;
use LWP::UserAgent;
use LWP::Parallel::UserAgent;
use URI;
use Text::ParseWords;
use Date::Manip;
use vars qw/$FINANCE $QUOTE $RETRIES $UA $PUA $PROGRAM $TRUE $FALSE $HELP $VERBOSE $VERSION $DEBUG $QUIET %PAGES %REGISTERED_PAGES $TIMEOUT/;
use vars qw/$FACTOR_EXCESS_CASH $FACTOR_NOMINAL_INTEREST $FACTOR_USE_INTANGIBLES/;
#use strict;

sub error($);
sub warning($);
sub runScan($);

$PROGRAM = basename( $0 );
$VERSION = '1.4';
$TRUE    = 1;
$FALSE   = 0;
$RETRIES = 4;
$TIMEOUT = 60;

$FACTOR_EXCESS_CASH      = 2;		# Excess cash when CA exceeds CL
$FACTOR_USE_INTANGIBLES  = $TRUE;	# Add intangible assets in net fixed asset definition or not
$FACTOR_NOMINAL_INTEREST = 0.075;	# A reasonable interest rate for debt

#
#  Options
#

$DEBUG   = 0;
$HELP    = $FALSE;
$VERBOSE = 0;
$QUIET   = 0;
$FINANCE = 'google';
$QUOTE   = 'yahoo';			# Google is completely flakey with market cap, you probably should use it
if( !GetOptions( '-debug+', \$DEBUG, '-help', \$HELP, '-verbose+', \$VERBOSE, '-quiet', \$QUIET, '-finance=s', \$FINANCE, '-quote=s', \$QUOTE) ) {
  exit( 1 );
}

#
# If help option specified
#
if( $HELP ) {
  print STDERR "$PROGRAM Version $VERSION\n\n";
  print STDERR "`$PROGRAM' is a utility to determine Greenblatt's return of capital\n";
  print STDERR " and earnings yield for a stock from various internet data sources.\n\n";
  print STDERR "Usage: $PROGRAM [OPTION]... [TICKERS]...\n\n";
  print STDERR "Options:\n";
  print STDERR "  --finance=<source> source for financial data ('yahoo' or 'google')\n";
  print STDERR "  --quote=<source>   source for quote data ('yahoo' or 'google')\n";
  print STDERR "  -v, --verbose      output the descriptions (repeat for more info)\n";
  print STDERR "  -d, --debug        output debug information\n";
  print STDERR "  -h, --help         print this output, then exit\n";
  print STDERR "  -q, --quiet        suppress some warnings output\n\n";
  exit 1;
}

#
# Check sources
#
error( "invalid finance source specified '$FINANCE'." ) if $FINANCE ne 'yahoo' && $FINANCE ne 'google';
error( "invalid quote source specified '$QUOTE'." ) if $QUOTE ne 'yahoo' && $QUOTE ne 'google';

#
# If no input arguments
#
if( scalar(@ARGV) < 1 ) {
  error( 'no arguments' );
}

#
# Create the main user agent
#
if( 1 ) {
  $PUA = LWP::Parallel::UserAgent->new();
  $PUA->redirect( 0 ); # no redirects
  $PUA->timeout( $TIMEOUT ); # timeout
  $PUA->parse_head( 0 );
}
else {
  $UA = LWP::UserAgent->new( timeout => $TIMEOUT, keep_alive => 1 );
}

$| = 1;

foreach my $ticker ( @ARGV ) {
  $ticker =~ s/\r//g;
  $ticker =~ s/\s//g;
  runScan( $ticker );
}

exit 0;

# getNonParallelPage:
#
# Get a url. Use a non-parallel interface
#
sub getNonParallelPage($)
{
  my ( $url ) = @_;
  my $host = URI->new($url)->host;

  if( !defined($UA) ) { 
    $UA = LWP::Parallel::UserAgent->new( timeout => $TIMEOUT, keep_alive => 1 );
  }

  my $req = new HTTP::Request GET => $url;
  $req->user_agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; Q342532)');
  $req->referer( 'http://' . $host );

  for( my $attempts = 0; $attempts < $RETRIES; $attempts++ ) {
    print STDERR "Getting $url (non-parallel)\n" if( $DEBUG > 1 );

    my $res = $UA->request( $req );

    print STDERR $res->status_line . "\n" if( $DEBUG > 1 );
    print STDERR $res->content . "\n" if( $DEBUG > 2 );

    if( $res->is_redirect ) {
      warning( "redirect response from $host: \"" . $res->status_line . '"' ) if $DEBUG;
      return '';
    }
    elsif( !$res->is_success ) {
      warning( "unexpected response from $host: \"" . $res->status_line . '"' . ($attempts < $RETRIES-1 ? ' (retrying)' : '') ) if $DEBUG || (!$QUIET && ($attempts == $RETRIES-1));
    }
    elsif( $res->content =~ /^[ \t\n\r]*$/ ) {
      warning( "unexpected empty response from $host" . ($attempts < $RETRIES-1 ? ' (retrying)' : '') ) if $DEBUG || (!$QUIET && ($attempts == $RETRIES-1));
    }
    else {
      return $res->content;
    }
    sleep( 2 );
  }

  return '';
} # end getNonParallelPage

# registerPage:
#
# Register a page to be fetched.
#
sub registerPage($)
{
  my $url = shift;

  if( defined($PUA) && !defined($REGISTERED_PAGES{$url}) ) {
    print STDERR "Registering $url\n" if( $DEBUG > 1 );

    my $req = new HTTP::Request GET => $url;
    $req->user_agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; Q342532)');
    $req->referer( 'http://' . URI->new($url)->host );

    $PUA->register( $req, undef, 80000 );

    $REGISTERED_PAGES{$url} = 1;
  }
} # end registerPage

# getPage:
#
# Get a page.
#
sub getPage($)
{
  my ( $url ) = @_;

  print STDERR "Getting $url\n" if( $DEBUG > 1 );

  while( defined($PUA) && exists $REGISTERED_PAGES{$url} && ! exists $PAGES{$url} ) {
    my $entries = $PUA->wait( 5 );

    return getNonParallelPage( $url ) if ! scalar(%$entries);

    foreach my $entry (keys %$entries) {
      my $res    = $entries->{$entry}->response;
      my $resurl = $res->request->url; 

      print STDERR "Received response for $resurl\n" if $DEBUG > 1;
      print STDERR $res->status_line . "\n" if( $DEBUG > 1 );
      print STDERR $res->content . "\n" if( $DEBUG > 2 );

      $PAGES{$resurl} = '';
      if( $res->is_redirect ) {
	warning( "parallel: redirect response from $resurl: \"" . $res->status_line . '"' ) if $DEBUG;
      }
      elsif( !$res->is_success ) {
	warning( "parallel: unexpected response from $resurl: \"" . $res->status_line . '"' ) if $DEBUG;
      }
      elsif( $res->content =~ /^[ \t\n\r]*$/ ) {
	warning( "parallel: unexpected empty response from $resurl" ) if $DEBUG;
      }
      else {
	warning( "parallel: got content from $resurl" ) if $DEBUG > 1;
	$PAGES{$resurl} = $res->content;
      }
    }
    foreach my $entry (keys %$entries) {
      $PUA->discard_entry( $entries->{$entry} );
    }
  }
  
  my $page = $PAGES{$url};
  return getNonParallelPage( $url ) if !defined($page) || $page eq '';
  return $page;
} # end getPage

sub displayField($$)
{
  if( $VERBOSE ) {
    my ( $fieldName, $value ) = @_;
    print "  $fieldName: " . (defined($value) ? $value : 'missing') . "\n";
  }
} # end displayField

sub fixMarketCap($)
{
  my $value = shift;

  if( defined($value) && $value =~ /^([\d+\.]+)([BMK])$/ ) {
    $value = $1;
    $value *= 1000000 if $2 eq 'B';
    $value *= 1000 if $2 eq 'M';
  }
  else {
    $value = undef;
  }
  return $value;
} # end fixMarketCap

# getYahooQuote:
#
# Get quotes for a stock from Yahoo! Finance.
#
# You can get simple comma-separated strings out of yahoo.com using
# the URL:
# 
#   http://finance.yahoo.com/d/quotes.csv?s=<SYMBOL>&f=<FORMAT>
# 
# where <SYMBOL> is the ticker symbol and <FORMAT> is the list of items to
# retrieve.  I found that these format items worked (there may be others, or
# some of these may be incorrect by now, I haven't tried it lately):
# 
#   item    meaning         format
#   ------------------------------
#   a       ask             x.y
#   b       bid             x.y
#   c1      change          x.y
#   d1      date            "m/d/yyyy"
#   e       earnings/share  x.y
#   g       day low         x.y
#   h       day high        x.y
#   j       year low        x.y
#   k       year high       x.y
#   l1      last            x.y
#   m       day range       "<g> - <h>"
#   n       name            "name"
#   o       open            x.y
#   p       prev close      x.y
#   q       ex-div          "month d"
#   r       price/earnings  x.y
#   s       symbol          "symbol"
#   t1      time            "h:mmAM"
#   v       volume          nnn
#   w       year range      "<j> - <k>"
#   x       exchange        "exchange"
#   y       yield           x.y
#   =       symbol          "symbol"
#
# Plus many others. See also: http://www.gummy-stuff.org/Yahoo-data.htm
#
sub registerYahooQuote($) 
{
  my ( $ticker ) = @_;

  registerPage( 'http://finance.yahoo.com/d/quotes.csv?s=' . $ticker . '&f=snl1j1&e=.csv' );
} # end registerYahooQuote

sub getYahooQuote($) 
{
  my ( $ticker ) = @_;

  local $_ = getPage( "http://finance.yahoo.com/d/quotes.csv?s=$ticker&f=snl1j1&e=.csv" );

  while( /(\"([^\"]+)"[^\n\r]+)/ ) {
    $_ = $';
    if( $ticker eq uc($2) ) {
      my %quote;
      ( $quote{'yahoo_ticker'},
	$quote{'name'},
	$quote{'last'},
	$quote{'mktCap'} ) = quotewords( ',', 0, $1 );
      return %quote;
    }
  }

  return ();
} # end getYahooQuote

sub getYahooRowText($)
{
  my ($fieldName) = @_;

  foreach my $row ( split( /<tr/i ) ) {
    if( $row =~ /<td[^>]*>\Q$fieldName\E/i ) {
      $row = $';
      my @result = ($row =~ /<td[^>]*>\s*(.*?)\s*<\/td>/ig);
      print STDERR "  $fieldName: " . join( ',', @result) . "\n" if $DEBUG;
      return @result;
    }
  }

  warning( "field '$fieldName' not found" ) if $DEBUG;
  return ();
} # end getYahooRowText

sub getYahooRow($)
{
  my ($fieldName) = @_;

  foreach my $row ( split( /<tr/ ) ) {
    if( $row =~ /<td[^>]*>\Q$fieldName\E/ ) {
      $row = $';
      # Just accept the table entries '-' which means 0, or '(+ve number)' or 'number'
      # Numbers may include decimal points or commas
      my @result = ($row =~ /<td[^>]*>\s*(-|\([\d\,\.]+\)|-?[\d\,\.]+)\s*<\/td>/g);
      @result = map { $_ = 0 if $_ eq '-'; s/,//g; $_ = -$1 if /^\((.*)\)/; $_ } @result;
      print STDERR "  $fieldName: " . join( ',', @result) . "\n" if $DEBUG;
      return @result;
    }
  }

  warning( "field '$fieldName' not found" ) if $DEBUG;
  return ();
} # end getYahooRow

sub getYahooElement($)
{
  my ( $fieldName ) = @_;
  my @values = getYahooRow( $fieldName );
  my $value  = shift @values;
  displayField( $fieldName, $value );
  return $value;
} # end getYahooElement

sub getYahooElementSum($$)
{
  my $fieldName = shift;
  my $count     = shift || 4;
  my @values    = getYahooRow( $fieldName );
  my $value;
  my $max;
  if( @values >= $count ) {
    $value = 0;
    $max   = 0;
    for( my $i = 0; $i < $count; $i++ ) {
      my $x = $values[$i];
      $value += $x;
      $max = abs($x) if abs($x) > $max;
    }
  }
  displayField( $fieldName, $value );
  return ( $value, $max );
} # end getYahooElementSum

sub getYahooPage($)
{
  local $_ = getPage( shift );
  s/<\/?((small)|(b))[^>]*>//ig;
  s/\&nbsp;/ /g;
  s/\&amp;/\&/g;
  return $_;
} # end getYahooPage

# convertToYahooTicker:
#
# Transform stock ticker to format preferred by yahoo
#
sub convertToYahooTicker($)
{
  my ( $stock ) = @_;
  $stock =~ s/\.PR$/-P/;
  $stock =~ s/\.PR\./-P/;
  $stock =~ s/\./\-/g;
  return uc($stock);
} # end convertToYahooTicker

sub getGoogleRowText($$)
{
  my ($fieldName,$fieldRegex) = @_;

  foreach my $row ( split( /<tr/i ) ) {
    if( $row =~ /<td[^>]*>\s*$fieldRegex\s*</i ) {
      $row = $';
      my @result = ($row =~ /<td[^>]*>\s*(.*?)\s*<\/td>/ig);
      print STDERR "  $fieldName: " . join( ',', @result) . "\n" if $DEBUG;
      return @result;
    }
  }

  warning( "field '$fieldName' not found" ) if $DEBUG;
  return ();
} # end getGoogleRowText

sub getGoogleRow($)
{
  my ($fieldName) = @_;

  foreach my $row ( split( /<tr/ ) ) {
    if( $row =~ /<td[^>]*>\s*\Q$fieldName\E\s*</ ) {
      $row = $';
      # Just accept the table entries '-' which means 0, or '(+ve number)' or 'number'
      # Numbers may include decimal points or commas
      my @result = ($row =~ /<td[^>]*>\s*(-|\([\d\,\.]+\)|-?[\d\,\.]+)\s*<\/td>/g);
      @result = map { $_ = 0 if $_ eq '-'; s/,//g; $_ = -$1 if /^\((.*)\)/; $_ } @result;
      print STDERR "  $fieldName: " . join( ',', @result) . "\n" if $DEBUG;
      return @result;
    }
  }

  warning( "field '$fieldName' not found" ) if $DEBUG;
  return ();
} # end getGoogleRow

sub getGoogleElement($)
{
  my ( $fieldName ) = @_;
  my @values = getGoogleRow( $fieldName );
  my $value  = shift @values;
  displayField( $fieldName, $value );
  return $value;
} # end getGoogleElement

sub getGoogleElement0($)
{
  my $value = getGoogleElement( shift );
  return defined($value) ? $value : 0;
} # end getGoogleElement0

sub getGoogleElementSum($$$)
{
  my $fieldName = shift;
  my $count     = shift || 4;
  my $lastWeight = shift || 1;
  my @values    = getGoogleRow( $fieldName );
  my $value;
  my $max;
  if( @values >= $count ) {
    $value = 0;
    $max   = 0;
    for( my $i = 0; $i < $count; $i++ ) {
      my $x = $values[$i];
      $x *= $lastWeight if( $i == $count-1 ); 
      $value += $x;
      $max = abs($x) if abs($x) > $max;
    }
  }
  displayField( $fieldName, $value );
  return ( $value, $max );
} # end getGoogleElementSum

sub getGoogleDiv($$)
{
  my ( $divName, $page ) = @_;
  $divName .= 'div';
  return ($page =~ /<div\s+id="$divName"(.*?)<\/div>/s) ? $& : '';
} # end getGoogleDiv

sub getGooglePage($)
{
  local $_ = getPage( shift );
  s/<\/?((small)|(b)|(span)|(br)|(wbr))[^>]*>//ig;
  s/\&nbsp;/ /g;
  s/\&amp;/\&/g;
  return $_;
} # end getGooglePage

sub checknum($)
{
  my( $num ) = @_;
  my $ok = (defined($num) && ($num =~ /-?\d+(\.\d*)?/)) ? $TRUE : $FALSE;

  warning( "bad number " . (defined($num) ? $num : '<undefined>') ) if $DEBUG && !$ok;
  return $ok;
} # end checknum

sub runScan($)
{
  my($ticker) = @_;
  my $earningsYield   = undef;
  my $returnOnCapital = undef;
  my $price           = undef;
  my $marketCap       = undef;
  my $asOfDate        = undef;
  my $notes           = '';
  local $_;

  print "$ticker:\n" if $VERBOSE;

  %PAGES            = ();
  %REGISTERED_PAGES = ();

  if( $QUOTE eq 'yahoo' ) {
    my $yahooTicker = convertToYahooTicker( $ticker );
    displayField( 'Yahoo Ticker', $yahooTicker );

    registerYahooQuote( $yahooTicker  );

    # Get the last trade price and the current market cap
    my %quote = getYahooQuote( $yahooTicker );
    if( defined($quote{'last'}) && $quote{'last'} ne 'N/A' && $quote{'last'} != 0 && defined($quote{'mktCap'}) ) {
      $price = $quote{'last'};
      $marketCap = fixMarketCap( $quote{'mktCap'} );
    }
  }
  else {
    my $googleOverview = 'http://finance.google.com/finance?q=' . $ticker . '&hl=en';
    registerPage( $googleOverview );

    # Check the industry or sector for financial (or TBD:Utility)
    $_ = getGooglePage( $googleOverview );

    # Get the last trade price and the current market cap
    $marketCap = /<td[^>]*>\s*Mkt\s+Cap:\s*<\/td>\s*<td[^>]*>([\d\.]+[BMK])<\/td>/s ? fixMarketCap( $1 ) : undef;
    {
      my $page = getPage( $googleOverview );
      $price = $page =~ /<td[^>]*>\s*<span\s+class="pr"[^>]*>\s*([\d\.]+)\s*<\/span>\s*<\/td>/s ? $1 : undef;
    }
  }

  if( !defined($marketCap) || !defined($price) ) {
    warning( "cannot get $ticker Quote and/or Market Cap" ) if !$QUIET;
    $_ = '';
    goto SKIP;
  }

  displayField( 'Last Trade', $price );
  displayField( 'Market Cap', $marketCap );

  my ( $ebit, $totalCurrentAssets, $totalCurrentLiabilities, $netFixedAssets, $longTermDebt, $cash, $factor );

  if( $FINANCE eq 'yahoo' ) {
    my $yahooTicker = convertToYahooTicker( $ticker );
    displayField( 'Yahoo Ticker', $yahooTicker );

    my $yahooIndustry         = 'http://finance.yahoo.com/q/in?s=' . $yahooTicker;
    my $yahooQuarterlyBalance = 'http://finance.yahoo.com/q/bs?s=' . $yahooTicker . '&quarterly';
    my $yahooQuarterlyIncome  = 'http://finance.yahoo.com/q/is?s=' . $yahooTicker . '&quarterly';

    registerPage( $yahooIndustry );
    registerPage( $yahooQuarterlyBalance );
    registerPage( $yahooQuarterlyIncome );

    $factor = 1; 	# Financial Statement data provided is in 1000's

    # Check the industry or sector for financial (or TBD:Utility)
    $_ = getYahooPage( $yahooIndustry );
    if( ! /SECTOR \/ INDUSTRY MEMBERSHIP/ || /'\Q$ticker\E' is not a valid ticker symbol/s ) {
      warning( "cannot get $ticker Yahoo Industry page" ) if !$QUIET;
      $_ = '';
    }

    my $sector = /<td[^>]*>Sector:<\/td>\s*<td[^>]*><a[^>]*>([^<]+)</s ? $1 : 'Unknown';
    my $industry = /<td[^>]*>Industry:<\/td>\s*<td[^>]*><a[^>]*>([^<]+)</s ? $1 : 'Unknown';

    displayField( 'Sector', $sector );
    displayField( 'Industry', $industry );

    # Note 6: skipped if a financial or health care planner
    if( $sector eq 'Financial' || $industry eq 'Health Care Plans' ) {
      $notes .= '6';
      goto SKIP;
    }

    # Note 5: could not determine the industry and/or sector
    $notes .= '5' if $industry eq 'Unknown' || $sector eq 'Unknown';

    # Get data from set of quarterly balance sheets
    $_ = getYahooPage( $yahooQuarterlyBalance );
    if( ! /Balance\s+Sheet/ || /'\Q$ticker\E' is not a valid ticker symbol/s ) {
      warning( "cannot get $ticker Yahoo Quarterly Balance Sheet page" ) if !$QUIET;
      $_ = '';
    }

    # Get As Of Date From Balance Sheet
    {
      my @periods = getYahooRowText( 'PERIOD ENDING' );
      my $balanceAsOfDate = @periods ? ParseDate( $periods[0] ) : undef;
      displayField( 'Balance Sheet As Of', defined($balanceAsOfDate) ? UnixDate( $balanceAsOfDate, '%Y-%m-%d' ) : undef ) if $VERBOSE;
      $asOfDate = $balanceAsOfDate;
    }

    # Current Assets
    $cash                        = getYahooElement( 'Cash And Cash Equivalents' );
    my $shortTerm                = getYahooElement( 'Short Term Investments' );
    $cash += $shortTerm if defined($cash);
    displayField( 'Total Cash & Short Term', $cash);
    $totalCurrentAssets          = getYahooElement( 'Total Current Assets' );

    # Net Fixed Assets
    my $ppe                      = getYahooElement( 'Property Plant and Equipment' );
    my $intangibleAssets         = getYahooElement( 'Intangible Assets' );
    my $otherAssets              = getYahooElement( 'Other Assets' );
    my $longTermInvestments      = getYahooElement( 'Long Term Investments' );

    $netFixedAssets = $ppe;
    $netFixedAssets += $intangibleAssets if $FACTOR_USE_INTANGIBLES && defined($intangibleAssets);
    $netFixedAssets += $otherAssets if defined($otherAssets);
    $netFixedAssets += $longTermInvestments if defined($longTermInvestments);
    displayField( 'Net Fixed Assets', $netFixedAssets );

    # Current Liabilities
    my $shortTermDebt            = getYahooElement( 'Short/Current Long Term Debt' );
    $totalCurrentLiabilities     = getYahooElement( 'Total Current Liabilities' );

    # Long-term Debt & Related
    $longTermDebt                = getYahooElement( 'Long Term Debt' );
    my $minorityInterest         = getYahooElement( 'Minority Interest' );
    my $preferredStock           = getYahooElement( 'Preferred Stock' );
    my $redeemablePreferredStock = getYahooElement( 'Redeemable Preferred Stock' );

    $longTermDebt += $minorityInterest if defined($minorityInterest);
    $longTermDebt += $preferredStock if defined($preferredStock);
    $longTermDebt += $redeemablePreferredStock if defined($redeemablePreferredStock);
    displayField( 'Total Common Debt', $longTermDebt );

    # Get data from set of quarterly income statements
    $_ = getYahooPage( $yahooQuarterlyIncome );
    if( ! /Income\s+Statement/ || /'\Q$ticker\E' is not a valid ticker symbol/s ) {
      warning( "cannot get $ticker Yahoo Quarterly Income Statement page" ) if !$QUIET;
      $_ = '';
    }

    my $quarterCount   = 4;
    my $quarterAnomoly = $FALSE;
    {
      my @periods = getYahooRowText( 'PERIOD ENDING' );
      my $incomeAsOfDate = @periods ? ParseDate( $periods[0] ) : undef;
      displayField( 'Income Statement As Of', defined($incomeAsOfDate) ? UnixDate( $incomeAsOfDate, '%Y-%m-%d' ) : undef ) if $VERBOSE;
      $asOfDate = $incomeAsOfDate if defined($asOfDate) && defined($incomeAsOfDate) && Date_Cmp( $incomeAsOfDate, $asOfDate ) < 0;

      $quarterAnomoly = (@periods < 4);

      # Now we calculated the days from the last period statement
      # If that period end date is older than .875*365 days ago,
      # we move the end period
      if( @periods >= 4 ) {
	my @dates = map( ParseDate($_), @periods );
	while( $quarterCount > 1 &&
	       (!defined($dates[$quarterCount-1]) ||
		Delta_Format( DateCalc( $dates[$quarterCount-1], $dates[0] ), 0, '%dt' ) > 0.875*365) ) {
	  $quarterCount--;
	}

	$quarterAnomoly = $quarterCount != 4;

	# Sanity check the date of the earliest quarter - it should be about 0.75 years ago
	if( !$quarterAnomoly ) {
	  my $days = Delta_Format( DateCalc( $dates[$quarterCount-1], $dates[0] ), 0, '%dt' );
	  $quarterAnomoly = $days < 0.7*365 || $days > 0.8*365;
	} 
      }
      
      displayField( 'Income Quarters', $quarterCount );
    }

    $asOfDate = defined($asOfDate) ? UnixDate( $asOfDate, '%Y-%m-%d' ) : 'Unknown';

    my $maxEbit;
    ( $ebit, $maxEbit )                                  = getYahooElementSum( 'Earnings Before Interest And Taxes', $quarterCount );
    my ( $operatingIncome, $maxOperatingIncome )         = getYahooElementSum( 'Operating Income or Loss', $quarterCount );
    my ( $otherIncome, $maxOtherIncome )                 = getYahooElementSum( 'Total Other Income/Expenses Net', $quarterCount );
    my ( $nonRecurringExpense, $maxNonRecurringExpense ) = getYahooElementSum( 'Non Recurring', $quarterCount );
    my ( $minorityIntExpense, $maxMinorityIntExpense )   = getYahooElementSum( 'Minority Interest', $quarterCount );
    $ebit -= $otherIncome if defined($otherIncome);

    # Note 4: operating income + other income not close enough to ebit
    {
      my $diff = defined($ebit) && defined($operatingIncome) ? abs($operatingIncome - $ebit) : 0;
      $notes .= '4' if $diff > 10 && $diff > 0.02*abs($ebit);
    }

    # OK, typically, minority interest is accounted for like debt or it is so
    # small that it does not matter. But, if minority interest expense > 15%
    # of minority interest balance sheet entry, deduct the excess minority
    # interest expense from the operating income. Current example is HTRN.
    #
    # Note A: minority interest exceeds debt-like behavior
    if( defined($ebit) && defined($minorityIntExpense) && abs($minorityIntExpense) > 0.05*abs($ebit) &&
	(!defined($minorityInterest) || -$minorityIntExpense > 2*$FACTOR_NOMINAL_INTEREST*$minorityInterest) ) {
      $ebit += ($minorityIntExpense + $FACTOR_NOMINAL_INTEREST*$minorityInterest);
      $notes .= 'A';
    }

    $ebit += $nonRecurringExpense if defined($nonRecurringExpense);
    displayField( 'Adjusted EBIT', $ebit );

    # Note 3: other income is > 20% of ebit
    $notes .= '3' if defined($ebit) && defined($otherIncome) && (abs($otherIncome) > 0.20*abs($ebit));

    # Note 2: restructuring income is > 20% of ebit
    $notes .= '2' if defined($ebit) && defined($nonRecurringExpense) && (abs($nonRecurringExpense) > 0.20*abs($ebit));

    # Note 1: max ebit from any quarter is > 1/2 of total ebit
    $notes .= '1' if defined($ebit) && defined($maxEbit) && $maxEbit > 0.5*abs($ebit);

    # Note 9: An anomoly exists in the quarterly reporting periods
    $notes .= '9' if defined($ebit) && $quarterAnomoly;
  }
  else {
    my $googleOverview = 'http://finance.google.com/finance?q=' . $ticker . '&hl=en';
    registerPage( $googleOverview );

    $factor = 1000; 	# Financial Statement data provided is in 1000's

    # Check the industry or sector for financial (or TBD:Utility)
    $_ = getGooglePage( $googleOverview );
    if( /Your search - \Q$ticker\E - produced no matches/s ) {
      warning( "cannot get $ticker Google Stock page" ) if !$QUIET;
      $_ = '';
      goto SKIP;
    }

    # Most things in google are indexed off this variable
    my $cid = /var\s+_companyId\s*=\s*(\d+);/ ? $1 : undef;;
    displayField( 'Google Company ID', $cid );

    if( !defined($cid) ) {
      warning( "cannot get $ticker company id" ) if !$QUIET;
      goto SKIP;
    }

    my $googleFinancialStatements = 'http://finance.google.com/finance?fstype=ii&cid=' . $cid;
    $googleFinancialStatements    = 'http://finance.google.com/finance' . $1 if /<a\s+href=(\?fstype=ii\&cid=\d+)>Income\s+Statement<\/a>/;
    registerPage( $googleFinancialStatements );

    my $sector = /Sector:\s*<a[^>]*>([^<]+)<\/a/s ? $1 : 'Unknown';
    my $industry = /Industry:\s*<a[^>]*>([^<]+)<\/a/s ? $1 : 'Unknown';
    my $category;
    {
      my @categories = /<td[^>]*>Category:<\/td>\s*<td[^>]*>\s*(.*?)\s*<\/td>/sg;
      @categories = ( 'Unknown' ) if !@categories;
      @categories = map { s/<\/?a[^>]*>//g; $_ } @categories;
      @categories = map { s/\s*>\s*/:/gs; $_ } @categories;
      $category = join( ',', @categories );
    }

    displayField( 'Sector', $sector );
    displayField( 'Industry', $industry );
    displayField( 'Category', $category );

    # Note 6: skipped if a financial or health care planner
    if( $sector eq 'Financial' || $industry eq 'Health Care Plans' || $category =~ /REIT/ ) {
      $notes .= '6';
      goto SKIP;
    }

    # Note 5: could not determine the industry and/or sector
    $notes .= '5' if $industry eq 'Unknown' || $sector eq 'Unknown';

    # Get finanacial statement page
    my $financialStatements = getGooglePage( $googleFinancialStatements );
    $_ = $financialStatements;
    if( ! /Balance\s+Sheet/ || ! /Income\s+Statement/ || /Your search - \Q$ticker\E - produced no matches/s ) {
      warning( "cannot get $ticker Google Financial Statements page" ) if !$QUIET;
      $financialStatements = '';
      goto SKIP;
    }

    # Get data from set of quarterly balance sheets
    $_ = getGoogleDiv( 'balinterim', $financialStatements );
    if( ! /In Millions of USD/ ) {
      if( /In Millions of  \(except for per share items\)/ ) {
        # Note B: google error - missing currency
        $notes .= 'B' if $notes !~ /B/;
      }
      else {
	warning( "$ticker Google Interim Balance Sheet not in millions USD" ) if !$QUIET;
	$_ = '';
	goto DONE_BALANCE;
      }
    }

    # Get As Of Date From Balance Sheet
    {
      my @periods = getGoogleRowText( 'Heading', 'In Millions of (USD)? \(except for per share items\)' );
      @periods = map { s/^.*Ending\s*//; s/^.*As\s*of\s*//; $_ } @periods;
      my $balanceAsOfDate = @periods ? ParseDate( $periods[0] ) : undef;
      displayField( 'Balance Sheet As Of', defined($balanceAsOfDate) ? UnixDate( $balanceAsOfDate, '%Y-%m-%d' ) : undef ) if $VERBOSE;
      $asOfDate = $balanceAsOfDate;
    }

    # Current Assets
    $cash                        = getGoogleElement( 'Cash and Short Term Investments' );
    displayField( 'Cash & Short Term', $cash);
    $totalCurrentAssets          = getGoogleElement( 'Total Current Assets' );
    if( defined($totalCurrentAssets) && $totalCurrentAssets == 0 ) {
      $totalCurrentAssets = $cash;
      $totalCurrentAssets += getGoogleElement0( 'Total Receivables, Net' );
      $totalCurrentAssets += getGoogleElement0( 'Total Inventory' );
      $totalCurrentAssets += getGoogleElement0( 'Prepaid Expenses' );
      $totalCurrentAssets += getGoogleElement0( 'Other Current Assets, Total' );
    }
    displayField( 'Real Total Current Assets', $totalCurrentAssets );

    # Net Fixed Assets
    my $totalAssets              = getGoogleElement( 'Total Assets' );
    my $goodwill                 = getGoogleElement( 'Goodwill, Net' );
    my $intangibleAssets         = getGoogleElement( 'Intangibles, Net' );

    $netFixedAssets = $totalAssets;
    $netFixedAssets -= $totalCurrentAssets if defined($totalCurrentAssets);
    $netFixedAssets -= $goodwill if defined($goodwill);
    $netFixedAssets -= $intangibleAssets if !$FACTOR_USE_INTANGIBLES && defined($intangibleAssets);
    displayField( 'Net Fixed Assets', $netFixedAssets );

    # Current Liabilities
    my $shortTermDebt            = getGoogleElement( 'Notes Payable/Short Term Debt' );
    my $currentPartOfLTD         = getGoogleElement( 'Current Port. of LT Debt/Capital Leases' );
    $shortTermDebt += $currentPartOfLTD if defined($currentPartOfLTD);
    $totalCurrentLiabilities     = getGoogleElement( 'Total Current Liabilities' );
    if( !defined($totalCurrentLiabilities) || $totalCurrentLiabilities == 0 ) {
      $totalCurrentLiabilities = $shortTermDebt;
      $totalCurrentLiabilities += getGoogleElement0( 'Accounts Payable' );
      $totalCurrentLiabilities += getGoogleElement0( 'Accrued Expenses' );
      $totalCurrentLiabilities += getGoogleElement0( 'Other Current liabilities, Total' );
    } 
    displayField( 'Real Total Current Liabilities', $totalCurrentLiabilities );

    # Long-term Debt & Related
    $longTermDebt                = getGoogleElement( 'Long Term Debt' );
    my $minorityInterest         = getGoogleElement( 'Minority Interest' );
    my $preferredStock           = getGoogleElement( 'Redeemable Preferred Stock, Total' );
    my $redeemablePreferredStock = getGoogleElement( 'Preferred Stock - Non Redeemable, Net' );

    $longTermDebt += $minorityInterest if defined($minorityInterest);
    $longTermDebt += $preferredStock if defined($preferredStock);
    $longTermDebt += $redeemablePreferredStock if defined($redeemablePreferredStock);
    displayField( 'Total Common Debt', $longTermDebt );
DONE_BALANCE:

    # Get data from set of quarterly income statements
    $_ = getGoogleDiv( 'incinterim', $financialStatements );
    if( ! /In Millions of USD/ ) {
      if( /In Millions of  \(except for per share items\)/ ) {
        # Note B: google error - missing currency
        $notes .= 'B' if $notes !~ /B/;
      }
      else {
	warning( "$ticker Google Interim Income Statement not in millions USD" ) if !$QUIET;
	$_ = '';
	goto DONE_INCOME;
      }
    }

    my $quarterCount   = 0;
    my $quarterAnomoly = $FALSE;
    my $quarterLastWeight = 1;
    {
      my @periods = getGoogleRowText( 'Heading', 'In Millions of (USD)? \(except for per share items\)' );
      my @durations = map { my $weeks = 13;
			    $weeks = $1*365.2/7/12 if /(\d+)\s+months/i;
			    $weeks = $1 if /(\d+)\s+weeks/i;
			    $weeks = $1/7 if /(\d+)\s+days/i;
			    $weeks } @periods;
      @periods = map { s/^.*Ending\s*//; s/^.*As\s*of\s*//; $_ } @periods;
      my $incomeAsOfDate = @periods ? ParseDate( $periods[0] ) : undef;
      displayField( 'Income Statement As Of', defined($incomeAsOfDate) ? UnixDate( $incomeAsOfDate, '%Y-%m-%d' ) : undef ) if $VERBOSE;
      $asOfDate = $incomeAsOfDate if defined($asOfDate) && defined($incomeAsOfDate) && Date_Cmp( $incomeAsOfDate, $asOfDate ) < 0;


      # Find the end date using the number of weeks (ideally - 3 months = 13 and 4*13 = 52)
      my $yearlyWeeks = 0;
      FINDEND:
      for( my $i = 0; $i < @durations; $i++ ) {
	displayField( 'Duration ' . $i, $durations[$i] );
	#last FINDEND if abs(52 - $yearlyWeeks) < abs(52 - ($yearlyWeeks + $durations[$i]) ); 
	last FINDEND if $yearlyWeeks > 50.5;
	$yearlyWeeks += $durations[$i];
	$quarterCount++;
      }

      $quarterAnomoly = ($yearlyWeeks < 50.5 || $yearlyWeeks > 53.5);
      displayField( 'Yearly Weeks', $yearlyWeeks );

      # This extrapolates linearly based the income statement based on the last quarter
      if( $quarterAnomoly && $yearlyWeeks ) {
        $quarterLastWeight = (365.2/7 - ($yearlyWeeks - $durations[$quarterCount-1]))/$durations[$quarterCount-1];
	displayField( 'Quarter Last Weight', $quarterLastWeight);
      }
    }
    displayField( 'Income Quarters', $quarterCount );

    $asOfDate = defined($asOfDate) ? UnixDate( $asOfDate, '%Y-%m-%d' ) : 'Unknown';

    my $maxEbit;
    ( $ebit, $maxEbit )                                  = getGoogleElementSum( 'Income Before Tax', $quarterCount, $quarterLastWeight );
    my ( $operatingIncome, $maxOperatingIncome )         = getGoogleElementSum( 'Operating Income', $quarterCount, $quarterLastWeight );

    my ( $extraIncome,  $maxExtraIncome  )               = ( 0, 0 );
    my ( $extraIncomeA, $maxExtraIncomeA )               = getGoogleElementSum( 'Interest Income(Expense), Net Non-Operating', $quarterCount, $quarterLastWeight );
    my ( $extraIncomeB, $maxExtraIncomeB )               = getGoogleElementSum( 'Gain (Loss) on Sale of Assets', $quarterCount, $quarterLastWeight );
    my ( $otherIncome,  $maxOtherIncome )                = getGoogleElementSum( 'Other, Net', $quarterCount, $quarterLastWeight );
    $extraIncome += $extraIncomeA if defined($extraIncomeA);
    $extraIncome += $extraIncomeB if defined($extraIncomeB);
    $extraIncome += $otherIncome  if defined($otherIncome);

    # Sanity check the ebit/operating income relationship
    #
    # Note 4: operating income + other income not close enough to ebit
    $ebit -= $extraIncome if defined($extraIncome);
    {
      my $diff = defined($ebit) && defined($operatingIncome) ? abs($operatingIncome - $ebit) : 0;
      $notes .= '4' if $diff > 0.01 && $diff > 0.02*abs($ebit);
    }
    $ebit = $operatingIncome;
    $ebit += $otherIncome if defined($otherIncome) && $otherIncome < 0;

    # OK, typically, minority interest is accounted for like debt or it is so
    # small that it does not matter. But, if minority interest expense > 15%
    # of minority interest balance sheet entry, deduct the excess minority
    # interest expense from the operating income. Current example is HTRN.
    #
    # Note A: minority interest exceeds debt-like behavior
    my ( $minorityIntExpense, $maxMinorityIntExpense )   = getGoogleElementSum( 'Minority Interest', $quarterCount, $quarterLastWeight );
    if( defined($ebit) && defined($minorityIntExpense) && abs($minorityIntExpense) > 0.05*abs($ebit) &&
	(!defined($minorityInterest) || -$minorityIntExpense > 2*$FACTOR_NOMINAL_INTEREST*$minorityInterest) ) {
      $ebit += ($minorityIntExpense + $FACTOR_NOMINAL_INTEREST*$minorityInterest);
      $notes .= 'A';
    }

    # Add back any unusual expense to ebit
    my ( $nonRecurringExpense, $maxNonRecurringExpense ) = getGoogleElementSum( 'Unusual Expense (Income)', $quarterCount, $quarterLastWeight );
    my ( $otherOperatingExpense, $maxOtherOperatingExpense ) = getGoogleElementSum( 'Other Operating Expenses, Total ', $quarterCount, $quarterLastWeight );
    if( defined($otherOperatingExpense) && $otherOperatingExpense < 0 ) {
      $nonRecurringExpense    += $otherOperatingExpense;
      $maxNonRecurringExpense += $maxOtherOperatingExpense;
    }
    $ebit += $nonRecurringExpense if defined($nonRecurringExpense);
    displayField( 'Adjusted EBIT', $ebit );

    # Note 3: other income is > 20% of ebit
    $notes .= '3' if defined($ebit) && defined($otherIncome) && (abs($otherIncome) > 0.20*abs($ebit));

    # Note 2: restructuring income is > 20% of ebit
    $notes .= '2' if defined($ebit) && defined($nonRecurringExpense) && (abs($nonRecurringExpense) > 0.20*abs($ebit));

    # Note 1: max ebit from any quarter is > 1/2 of total ebit
    $notes .= '1' if defined($ebit) && defined($maxEbit) && $maxEbit > 0.5*abs($ebit);

    # Note 9: An anomoly exists in the quarterly reporting periods
    $notes .= '9' if defined($ebit) && $quarterAnomoly;
DONE_INCOME:
  }

  undef $_;

  #
  # All data has been gathered. Now the calculations begin.
  #

  # Calculate excess cash on balance sheet to be deducted from the market cap
  my $excessCash = 0;
  if( checknum($totalCurrentAssets) &&
      checknum($totalCurrentLiabilities) &&
      checknum($cash) &&
      $totalCurrentAssets > $FACTOR_EXCESS_CASH*$totalCurrentLiabilities ) {
    $excessCash = $totalCurrentAssets - $FACTOR_EXCESS_CASH*$totalCurrentLiabilities;
    $excessCash = $cash if $cash < $excessCash;
  }
  displayField( 'Excess Cash', $excessCash );

  if( checknum($ebit) && checknum($marketCap) && checknum($longTermDebt) && checknum($cash) ) {
    # N.B. On google all numbers are in 1000000
    my $ev = $marketCap / $factor + $longTermDebt - $excessCash;
    displayField( 'Enterprise Value', $ev );
    # Note 7: EV is zero or less
    if( $ev == 0 ) {
      warning( "enterprise value is zero for $ticker" ) if !$QUIET;
      $notes .= '7';
    }
    elsif( $ev < 0 ) {
      warning( "enterprise value is less than zero for $ticker" ) if !$QUIET;
      $notes .= '7';
    }
    else {
      $earningsYield = $ebit / $ev;
    }
  }

  if( checknum($ebit) && checknum($totalCurrentAssets) && checknum($totalCurrentLiabilities) && checknum($netFixedAssets) ) {
    my $netWorkingCapital = ($totalCurrentAssets - $totalCurrentLiabilities);
    $netWorkingCapital -= $excessCash;
    $netWorkingCapital = 0 if $netWorkingCapital < 0;
    displayField( 'Net Working Capital', $netWorkingCapital );
    # Note 8: Capital is zero
    if( $netWorkingCapital + $netFixedAssets == 0 ) {
      warning( "capital is zero for $ticker" ) if !$QUIET;
      $notes .= '8';
    }
    else {
      $returnOnCapital = $ebit / ($netWorkingCapital + $netFixedAssets);
    }
  }

SKIP:
  $earningsYield   = -9999.99999 if !defined($earningsYield); 
  $returnOnCapital = -9999.99999 if !defined($returnOnCapital); 
  $price           = 0 if !defined($price); 
  $marketCap       = 0 if !defined($marketCap); 
  $asOfDate        = 'Unknown' if !defined($asOfDate); 

  my $noteString = $notes ne '' ? 'Notes ' . $notes : '';
  if( $VERBOSE ) {
    printf "  Market Cap %d Price \$%0.2f Capital %0.3f%% Earnings %0.3f%% Date %s %s\n", $marketCap, $price, $returnOnCapital*100, $earningsYield*100, $asOfDate, $noteString;
  }
  else {
    printf "$ticker: Market Cap %d Price \$%0.2f Capital %0.3f%% Earnings %0.3f%% Date %s %s\n", $marketCap, $price, $returnOnCapital*100, $earningsYield*100, $asOfDate, $noteString;
  }
} # end runScan

# error:
#
# error message
#
sub error($)
{
  my($message) = @_;
  print STDERR "$PROGRAM: error: $message\n";
  exit 1;
} # end error

# warning:
#
# warning message
#
sub warning($)
{
  my($message) = @_;
  print STDERR "$PROGRAM: warning: $message\n";
} # end warning