#!/usr/bin/perl -w
###########################################
# pofo - draw a stacked portfolio graph
# Mike Schilli, 2007 (m@perlmeister.com)
###########################################
use strict;
use CachedQuote;
use DateTime;
use RRDTool::OO;
use Log::Log4perl qw(:easy);
#Log::Log4perl->easy_init($DEBUG);

my @colors = qw(f35b78 e80707 7607e8 
                0a5316 073f6f 59b0fb);
my $cq = CachedQuote->new();

my($cfg_file) = @ARGV;
die "usage: $0 cfgfile" unless $cfg_file;

my @symbols;
my $acts = cfg_read($cfg_file, \@symbols);
my %pos  = ();

my $end     = DateTime->today();
my $start   = $end->clone->subtract(
                               years => 1);

for my $act (sort keys %$acts) {
  next if $acts->{$act}->[0]->[0] 
          >= $start;
  pos_add(\%pos, $_) for @{$acts->{$act}};
}

my $counter = 0;
my %symbol_colors;
for (@symbols) {
  my $idx = ($counter++ % @colors);
  $symbol_colors{$_} = $colors[$idx];
}

unlink my $rrdfile = "holdings.rrd";
my $rrd = RRDTool::OO->new(
    file => $rrdfile,
);

$rrd->create(
  step  => 24*3600,
  start => $start->epoch() - 1,
    map({
      ( data_source => { 
          name      => tick_clean($_),
          type      => "GAUGE",
        },
      )} @symbols),
     archive     => { rows => 5000, 
                      cfunc => "MAX" }
);

for(my $dt = $start->clone; 
  $dt <= $end;
  $dt->add( days => 1)) {

  if(exists $acts->{$dt}) {
    pos_add(\%pos, $_) for @{$acts->{$dt}};
  }

  my %parts = ();
  my $total = sum_up(\%pos, $dt, \%parts);
  INFO "*** TOTAL *** = $total\n";

  $rrd->update(
    time   => $dt->epoch(),
    values => \%parts,
  ) if scalar keys %parts;
}

$rrd->graph(
    width => 800,
    height => 600,
    lower_limit    => 0,
    image          => "positions.png",
    vertical_label => "Positions",
    start          => $start->epoch(),
    end            => $end->epoch(),
    map { ( draw           => {
              type   => "stack",
              dsname => tick_clean($_),
              color  => $symbol_colors{$_},
              legend => $_,
            } )
        } @symbols,
);

###########################################
sub sum_up {
###########################################
  my($all, $dt, $parts) = @_;

  my $sum = 0;

  for my $tick (keys %$all) {
    my $q = 1;
    $q = $cq->quote($dt, $tick) if 
                         $tick ne 'cash';
    my $add = $all->{$tick} * $q;
    $parts->{tick_clean($tick)} = $add;
    $sum += $add;

    DEBUG "Add: $all->{$tick} $tick $add";
  }
  return $sum;
}

###########################################
sub pos_add {
###########################################
  my($all, $pos) = @_;

  my($dt, $act, $tick, $n) = @{ $pos };
  die "pos: @$pos" if ! defined $n;
  DEBUG "Action: $act $n $tick";

  my $q = 1;
  $q = $cq->quote($dt, $tick) if 
                           $tick ne 'cash';
  my $val = $n * $q;

  if($tick eq "cash") {
    $all->{cash} += $val if $act eq "in";
    $all->{cash} -= $val if $act eq "out";
    $all->{cash}  = $val if $act eq "chk";
  } else {
    if($act eq "in") {
      $all->{$tick} += $n;
      $all->{cash}  -= $val;
    } elsif($act eq "out") {
      $all->{$tick} -= $n;
      $all->{cash}  += $val;
    } elsif($act eq "find") {
      $all->{$tick} += $n;
    }
    DEBUG "After: $tick: $all->{$tick}";
  }

  $all->{cash} ||= 0;
  DEBUG "After: Cash: $all->{cash}";
}

###########################################
sub cfg_read {
###########################################
  my($cfgfile, $symbols) = @_;

  my %by_date = ();

  open FILE, "<$cfgfile" or 
    die "Cannot open $cfgfile ($!)";

  while(<FILE>) {
    chomp;
    s/#.*//;
    my @fields = split ' ', $_;
    next unless @fields; # empty line

    my $dt = dt_parse( $fields[0] );
    $fields[0] = $dt;

    push @$symbols, $fields[2] unless 
       grep { $_ eq $fields[2] } @$symbols;

    push @{ $by_date{ $dt } }, [ @fields ];
  }
  
  close FILE;
  return \%by_date;
}

###########################################
sub dt_parse {
###########################################
  my($string) = @_;

  my $fmt = DateTime::Format::Strptime->
              new( pattern => "%Y-%m-%d" );
    return $fmt->parse_datetime($string);
}

###########################################
sub tick_clean {
###########################################
    my($tick) = @_;

    $tick =~ s/./_/g;
    return $tick;
}