#!/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 => $_, 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); $rrd->update( time => $dt->epoch(), values => \%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 => $_, 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} = $add; $sum += $add; DEBUG "Add: $all->{$tick} $tick $add"; } return $sum; } ########################################### sub pos_add { ########################################### my($all, $pos) = @_; my($dt, $act, $tick, $n) = @{ $pos }; 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 { die "chk: cash-only" if $act eq "chk"; if($act eq "in") { $all->{$tick} += $n; $all->{cash} -= $val; } elsif($act eq "out") { $all->{$tick} -= $n; $all->{cash} += $val; } DEBUG "After: $tick: $all->{$tick}"; } DEBUG "After: Cash: $all->{cash}"; } ########################################### sub cfg_read { ########################################### my($cfgfile, $symbols) = @_; my %by_date = (); open FILE, "<$cfgfile" or die "Cannot open $cfgfile ($!)"; while() { 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); }