#!/usr/bin/perl -X
use strict;
use File::Find;
use Getopt::Long;
use Storable qw(lock_retrieve lock_store);
use Data::Dumper;
use File::Spec;
use Cache::Memcached;
use Finance::Quant;
use XML::Simple;
use Statistics::Basic qw(mean);
use File::Basename;
use Text::Reform;

my @modules;
my $CACHE_VERSION = 1;
my $VERSION = "1.03";
my $backtest = {};
my @tested=();
my $cache = {};
my $master = {};
my$dir = File::Spec->tmpdir();
my $home = "/home/hagen/myperl/Finance-Quant/";
chdir($dir);
#print Dumper @tested;

# nice printout
foreach (@tested) {
  $backtest->{$_->[0]}=[$_->[1]];
# print "$_->[0] $_->[1]\n";
}


sub cmd{

  system(sprintf("beancounter ",join " ",@_));

}
my %opts = (
            timeout       => 24*60*60*1,
            max_cache_age => 1,
            backrole=>0,
            latesunday=>1,
            orders_file    => "~/.orders_getquotes_cache",
            export_file    => "~/.export_getquotes_cache",
            cache_file    => "~/.cache_getquotes_cache",
            cache         => 1,
            order         => 1,
            backdate      => "",
            datelastbuys=>"",
            ob=>"",
           );

GetOptions (\%opts,
            "timeout=i",
            "latesunday=i",
            "cache!",
            "order!",
            "datelastbuys=s",
            "ob=s",
            "max_cache_age=i",
            "backrole=i",
            "backdate=s",
            "export_file=s",
            "orders_file=s",
            "cache_file=s");


$opts{dayoffweek}=`date +"%u"`;


if($opts{dayoffweek} gt 5 || $opts{dayoffweek} eq 1){
    $opts{lastbuisday}="last friday";
    $opts{backrole} = 2;
}else{
    $opts{lastbuisday}="yesterday";
    $opts{backrole} = 1;
}

    if($opts{latesunday}||1){ $opts{backrole}=3;}
    $opts{backdate} = trim(`date --date=$opts{backrole}" days ago" +%Y-%m-%d`);



foreach(qw(orders cache export)){
$opts{sprintf("%s_file",$_)} = tildeexp(sprintf("%s_file",$_));

  if($_ !~/cache/){
      $master->{$_} = getNode($opts{sprintf("%s_file",$_)});
  }else {
      $cache =  getNode($opts{sprintf("%s_file",$_)});

  }

}

# return only matching modules
sub wanted { 


      my $f = $File::Find::name;
      $f =~ s/.\/Finance.*.backtest\///g;
      my $pdf =~ $f;
          $pdf =~ s/data/pdf/g;
     /longtrend_backtest[_](.*).data$/ && ($master->{export}->{datafile}->{$1}=$f) && ($master->{export}->{pdf}->{$1}=$pdf);
     
#/longtrend_backtest[_](.*).data$/ &&   ($master->{export}->{datafile}->{$1}=$File::Find::name);
#   /^*ownload(.*)Smallcon.jpg$/ && push @tested,[$1,$File::Find::name];

}

find(\&wanted, grep { -r and -d } @INC);


my $memd = new Cache::Memcached {
'servers' => [ "127.0.0.1:11211"],
'debug' => 0,
'compress_threshold' => 10_000,
} or warn($@);

my @symbols = @ARGV;

my $self = $memd->get("master-run");

#  $memd->set("symbols_key",[keys %{$self->{result}}]);

  @symbols =  @{$memd->get("master-run-SYMBOLS")};

  @symbols = map {uc} @symbols;

  $opts{ob} .= sprintf $#symbols;



sub getNode{

  my $file = shift;

my $cache = {};
eval {
  $cache = lock_retrieve($file);
};
#$cache = {};
$cache = {} unless
  $cache->{CACHE_VERSION} and $cache->{CACHE_VERSION} !~ m/\D/
  and $cache->{CACHE_VERSION} == $CACHE_VERSION;

refetch($cache, @symbols)
  unless $opts{cache} == 1 and
  check_cache($cache, @symbols);


  return $cache;

}


#   0 Symbol
#   1 Company Name
#   2 Last Price
#   3 Last Trade Date
#   4 Last Trade Time
#   5 Change
#   6 Percent Change
#   7 Volume
#   8 Average Daily Vol
#   9 Bid
#  10 Ask
#  11 Previous Close
#  12 Today's Open
#  13 Day's Range
#  14 52-Week Range
#  15 Earnings per Share
#  16 P/E Ratio
#  17 Dividend Pay Date
#  18 Dividend per Share
#  19 Dividend Yield
#  20 Market Capitalization
#  21 Stock Exchange


      $opts{ob} .= sprintf("\n****************************************************************************************************************\n\nQUOTES\n\n****************************************************************************************************************\n");

my $coreData = "";

$cache->{ranking}={};
for my $symbol (@symbols) {
  my $q = $cache->{$symbol}->{data};
  my $core = $cache->{$symbol}->{core};
  

#       next unless (defined($core->{result}[0]) && $core->{result}[0] eq"");
      my @r = @{$symbol,$core->{quote}->{result}};
      
      
     @r = split("\n", shift @r);
      
      foreach(@r){
#        print "\n$_" unless($_ !~/[\[]*[\]].*2012-02-09/);
         $cache->{$symbol}->{ordering}=$_ unless($_ !~/^[\[]1[\]]/);
      }
      @r = split(" ",$r[$#r]);
      
      $cache->{ranking}->{$r[2]}=$symbol unless($r[2] <10000);
#      $coreData .= "\n$symbol=". Dumper $core;


      #print "No symbol $symbol\n" and next unless ($q);
      my $name = lc $q->[1];
      my  $and = length $name<14?"\t\t":"\t";
      my $quote = sprintf "%-5s %6.2f %6.2f %6.2f%% - %10s %5s\t%4s\t(%s)%s%5s\n", $q->[0], $q->[2], $q->[5], $q->[6], $q->[3], $q->[4] , $core->{position},$name,$and,"<BACKTEST>";
      $opts{ob} .= $quote; 
      $master->{export}->{quotes}->{$q->[2]}=$quote; 
  }


      my @keys = reverse sort { $a <=> $b  }  keys %{$cache->{ranking}};
    
      $master->{export}->{symbolsRanked},[@keys];
 #   print Dumper @keys;  
      
      $opts{ob} .= sprintf("\n********************************************************\********************************************************\n\nORDERS %s\n\n****************************\************************************************************************************\n",$opts{backdate});
      
 foreach (@keys) { 
 
    my $sym = $cache->{ranking}->{$_};
    
    $cache->{$sym}->{ordering} = "" unless ($cache->{$sym}->{ordering});
   
    next unless ($cache->{$sym}->{ordering}=~ m/$opts{backdate}/);
    
    
  my @order = split(" ",$cache->{$sym}->{ordering});
   $cache->{$sym}->{ordering} =~ s/\@//g;
   
    if($cache->{$sym}->{ordering} =~ m/$sym -/){
    $cache->{$sym}->{ordering} = "SELL>".$cache->{$sym}->{ordering};
    
    $cache->{orders}->{$sym}=$cache->{$sym}->{ordering};
    }elsif($cache->{$sym}->{ordering} =~ m/$sym/){
      
      $cache->{$sym}->{ordering} = "BUY>".$cache->{$sym}->{ordering};
      
       @order = split(" ",$cache->{$sym}->{ordering});

      $cache->{orders}->{$sym}=$cache->{$sym}->{ordering};
#        push @{$cache->{orders}->{$sym}},[@order];
#       print Dumper @order;

       
       #`beancounte  delete $sym`;

#       `beancounter  addportfolio $sym:$order[3]:USD`;
    }else{
          $cache->{$sym}->{ordering} = ">".$cache->{$sym}->{ordering};
    }

         my $ob = sprintf("\n%d %s %s  %s %1.4f %s %s",$_,$sym,
                                          $cache->{$sym}->{core}->{position},
                                          $cache->{$sym}->{core}->{"guru-sum"},
                                          $cache->{$sym}->{core}->{"momentum"},$cache->{$sym}->{ordering}); 
          $master->{export}->{list}->{$sym} = join ".",@order;
                    $master->{export}->{list}->{$sym} =~ s/\n//g;
     
     
          if($opts{order} == 1)
          {         
            push @{$master->{orders}->{SELL}},$ob unless($ob !~/SELL/);
            push @{$master->{orders}->{BUY}},$ob unless($ob !~/BUY/);
          }
          $opts{ob} .= $ob;
  
#      }                                          
                                          
}


sub trim
{
	my $string = shift;

  $string = "" unless($string);
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}


# return only matching modules
sub wantedx { 


   /^F*(Market|Quant|Quant*Home|NASDAQ|Optical).*\.pm$/ && ($master->{export}->{datafile}->{$1}=$File::Find::name)
  
}


sub searchModule{

    my @return = ();
    # look in the @IRC dirs that exist
    find(\&wantedx, grep { -r and -d } @INC);



    # de-dupe
    my %saw;
    @modules = grep(!$saw{$_}++, @modules);

    # strip extraneous directories off the modules
    for my $prefix ( sort { length $b <=> length $a } @INC ) {
      for (@modules) { 
          next unless($_ =~ /Finance/);
          next if s/^\Q$prefix// 
       }
    }

    
    return  \@return;
}



sub DirContent ($ $)
{
    my ( $path,$id ) = @_;

     warn "$id: $path\n";

    local *DIR;

    unless ( opendir DIR, $path )
    {
    	print "$id: can't read $path $@";
    }

    my @tmp = readdir DIR;
    closedir DIR;

    my @results = ();
    foreach(@tmp){
          next if($_ eq "." || $_ eq "..");
          
         if($_ =~ /$id/){
           push @results,$_;
         }
         
    }

    return @results;
}


sub refetch {
  my ($cache, @symbols) = @_;
  eval {
    local $^W = 0;  # because Finance::YahooQuote doesn't pass
                    # warnings with 5.6.0.
    require Finance::YahooQuote;
    import  Finance::YahooQuote;
    $Finance::YahooQuote::TIMEOUT = $Finance::YahooQuote::TIMEOUT = $opts{timeout};
    
  };

  die qq[\nYou need to install the Finance::YahooQuote module\n\nTry\n\n  perl -MCPAN -e 'install "Finance::YahooQuote"'\n\nas root\n\n]
        if $@ =~ /locate Finance/;
  die $@ if $@;

  my @q = getquote(@symbols);
  for my $q (@q) {
    my $symbol = $q->[0];
    if ($q->[1] eq $symbol) {
      $q = undef;
    } else {
      $q->[6] =~ s/%$//;
    }
    $cache->{$symbol}->{time} = time;
    $cache->{$symbol}->{data} = $q;
    
    
my $quote = {};


$quote = {"symbol"	=>	$q->[0],
"CompanyName"	=>	$q->[1],
"LastPrice"	=>	$q->[2],
"LastTradeDate"	=>	$q->[3],
"LastTradeTime"	=>	$q->[4],
"PercentChange"	=>	$q->[5],
"Volume"	=>	$q->[7],
"AverageDailyVol"	=>	$q->[8],
"PreviousClose"	=>	$q->[11],
"Open"	=>	$q->[12],
"DayRange"	=>	$q->[13],
"52-WeekRange"	=>	$q->[14],
"MarketCapitalization"	=>	$q->[20],
"result"	=>	[readFile(@{$backtest->{$q->[0]}})]
};

    $cache->{$symbol}->{core} = getCore($symbol,$quote) unless(defined( $cache->{$symbol}->{core}));
    
    
    
  }
  $cache->{CACHE_VERSION} = $CACHE_VERSION;
  lock_store($cache, $opts{cache_file});
}

sub check_cache {
  my ($cache, @symbols) = @_;
  # check that all symbols are fresh enough
  for my $symbol (@symbols) {
    unless ($cache->{$symbol}->{time}
            and $cache->{$symbol}->{time} > time-$opts{max_cache_age}) {

      # XXX .. cache cleaning should work
     # for my $symbol (keys %{$cache}) {
        #if ($cache->{$symbol}->{time} < time-($opts{max_cache_age}*20)) {
        #  delete $cache->{$symbol};
       # }
     # }

      return 0;
    }
  }
  return 1;
}




sub getCore{

my ($symbol,$data) = @_;
  my $homex = $self->{result}->{$symbol}->{extended};
     $homex->{quote}=$data;
     
      my @tested = ();
      $symbol = "" unless($symbol);


      my $f = $File::Find::name;
      $f =~ s/Finance*backtest//g;
     /longtrend_backtest[_]$symbol.data$/ && ($master->{export}->{datafile}->{$1}=$f);
  
  return $homex;

}


sub readFile {
  my($filename) = @_;
  my(@lines);

  my $details = {};
  my $ret = "";
  if(!defined($filename) ) {
    return [];

  }
  my @array=();
  
  open(IN, $filename) or die "Error: couldn't open file $filename : $!\n";
  @lines = <IN>;
  
     foreach my $line(@lines){
        
        next unless($line =~/Net|Tx|2012-02/);
        $ret .= $line;
        push @array,$line;
        
   
    }
  
  close(IN);
   
  return $ret;#@array
}


sub tildeexp {
  my $path = shift;
  $path =~ s{^~([^/]*)} {  
          $1 
                ? (getpwnam($1))[7] 
                : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7])
          }ex;
  return $path;
}

sub  ACCOUNT {

  my $ret = {};
  `/usr/bin/beancounter update`;
  $ret->{raw} =`/usr/bin/beancounter status`;
  
  
  return $ret;

}

#my $xml = XML::Simple::XMLout($cache);

#open (XML,">a");
#print XML $xml;
#close (XML);


my @strb = DirContent ($home,"./*");    

$opts{ob} .= sprintf $coreData;

my $account = ACCOUNT();

   



my @name  = (qw(foo foo2 foo3)) x 20;
my @last  = (qw(bar bar2 bar3)) x 20;
my @count = (qw( 3   4    5  )) x 20;

my @sort =  [[values %{$cache->{ranking}}],
             [keys %{$cache->{ranking}}],
             [map{($_ = ($_-10000))/100  }keys %{$cache->{ranking}}]];
my @buffer = [@{$sort[0][0]}];


my  $pct     = [map{$_=sprintf("%3.2f%",$_)}@{$sort[0][2]}];





print form
"--------------------------------------------------------------------[INITIAL ACCOUNT 10000USD]-----------------------------------------------------------------",
"---------------------------------------------------------------------------------------------------------------------------------------------------------------",
"SYMBOL    BACKTEST-NET        PL_PCT              DATA-FILE                                PDF                               ORDER",
"---------------------------------------------------------------------------------------------------------------------------------------------------------------",
"[[[[[[[   [[[[[[[[       |||||||||||||   ||".("|"x30)." ||".("|"x30)." ||".("|"x45)." ||||||".("["x35),
[@{$sort[0][0]}],[@{$sort[0][1]}],[@$pct],
 [map {$_ = $master->{export}->{datafile}->{$_} } @{$sort[0][0]}],
 [map {my $new=$_;  $new=~ s/\.data/\.pdf/g; $_=$new; } @{$sort[0][0]}],
 [map {my $new=$_;  $new=~ s/^longtrend_backtest_(.*)\.pdf$/$1/g; my $ord = $master->{export}->{list}->{$new}; $ord=~ s/>|\t|\"|_| |\n/#/g; $_ = $ord  } @{$sort[0][0]}];



#cmd(@tested);
printf "%s\n%s\n%s",$opts{ob},$account->{raw};



#print Dumper $master;   


1;

__DATA__


=head1 SYNOPSIS


=head1 TODO

--help option.

Cache cleanup.

=head1 COPYRIGHT



