GopherProxy

#!/usr/bin/perl -w
###########################################
# pofo - draw a stacked portfolio graph
# Mike Schilli, 2007 ([email protected])
###########################################
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;
}