#!/usr/bin/perl -w

# Depot.pl -- author: Oliver Bossert
# Copyright (C) 2003 Oliver Bossert
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use strict;
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);
use Finance::Quote;
use LWP::UserAgent;

my $DATAFILE = "./data.txt";
my $TRANSLATIONFILE = "./quote-hist-translation";
my $USEBIDASK = 1;
my %CACHE = ();
my %data = readfile( $DATAFILE );

# Close?
if ( defined(param('close')) && param('close') eq "1") {
  close_stock( \%data, param('id') ) if (defined(param('id')));
}

# Cancel?
if ( defined(param('cancel')) && param('cancel') eq "1"  ) {
  cancel_order( \%data, param('id') ) if (defined(param('id')));
}

# New Order?
if ( defined(param('buy')) && param('buy') eq "1"  ) {
  my $refdata = \%data;
  push @{$refdata->{'orders'}}, [ param('buysell'), 
				  param('wkn'), 
				  param('count'), 
				  param('func') ];
}

# Comment
if ( defined(param('comment')) ) {
  my $refdata = \%data;
  push @{$refdata->{'comment'}->{param('id')}}, param('comment');
}


processdata( \%data );
print_page( \%data );
writefile( $DATAFILE , \%data );

sub close_stock {
  my ($refdata, $id) = @_;
  return if ( !defined($id) );

  foreach my $nr (0..$#{$refdata->{'openpos'}} ) {
    if ( translatecode($refdata->{'openpos'}->[$nr]->[1]) eq translatecode( $id ) ) {
      my $type = "sell";
      $type = "buy" if ( $refdata->{'openpos'}->[$nr]->[0] =~ /short/i);
      push @{$refdata->{'orders'}}, [ $type, 
				      $id,
				      $refdata->{'openpos'}->[$nr]->[2] . "x", 
				      "TRUE()" ];

    }
  }
}

sub cancel_order {
  my ($refdata, $id) = @_;
  my $chg = 1;
  my $mnr = 0;
  while ( $chg == 1 ) {
    $chg = 0;
    foreach my $nr (0..$#{$refdata->{'orders'}} ) {
      if ( translatecode($refdata->{'orders'}->[$nr]->[1]) eq translatecode( $id ) ) {
	$mnr = $nr;
	$chg = 1;
      }
    }
    splice @{$refdata->{'orders'}}, $mnr, 1 if ($chg==1);
  }
}

sub readfile {
  my $filename = shift;
  my  %CMDS = map { $_ => \&$_ } 
    qw(CASH OLONG OSHORT TLONG TSHORT COMMENT BUY SELL);
  my %data;
  open DAT, $filename or die "Konnte Datei nicht öffnen!";
  while (<DAT>) {
    chomp;
    next if (/^\#/ | /^\s*$/);
    my @ar = split /\t/;

    # Process Data
    my $name = shift @ar;
    $name = uc($name);
    if(exists $CMDS{$name}) {
      $CMDS{$name}->( \%data, \@ar );  # Kommando
    } else {
      print "Unknown command '$name'\n";
    }
  }
  close DAT;
  return %data;
}

sub writefile {
  my ($filename, $refdata) = @_;
  open DAT, ">$filename" or warn "Konnte Datei nicht zum schreiben öffnen!";

  print DAT "CASH\t" . $refdata->{'cash'} . "\n";
  foreach my $p ( sort {$a->[3] cmp $b->[3]} @{$refdata->{'openpos'}} ) {
    my @a = @{$p};
    my $order = shift @a;
    print DAT "OLONG\t" . join("\t", @a) . "\n" if ($order =~ /long/ );
    print DAT "OSHORT\t" . join("\t", @a) . "\n" if ($order =~ /short/ );
  }
  foreach my $p ( @{$refdata->{'orders'}} ) {
    my @a = @{$p};
    my $order = shift @a;
    print DAT "BUY\t" . join("\t", @a) . "\n" if ($order =~ /buy/ );
    print DAT "SELL\t" . join("\t", @a) . "\n" if ($order =~ /sell/ );
  }
  foreach my $p ( @{$refdata->{'history'}} ) {
    my @a = @{$p};
    my $order = shift @a;
    print DAT "TLONG\t" . join("\t", @a) . "\n" if ($order =~ /long/ );
    print DAT "TSHORT\t" . join("\t", @a) . "\n" if ($order =~ /short/ );
    if ( $#{$p}>=7 && defined($refdata->{'comment'}->{$p->[7]}) ) {
      foreach my $c ( @{$refdata->{'comment'}->{$p->[7]}} ) {
	print DAT "COMMENT\t" . $p->[7] . "\t" . $c . "\n";
      }
    }
  }

  close DAT;
}

sub CASH {
  my ($refdata, $refparam) = @_;
  my @param = @{$refparam};
  $refdata->{'cash'} += $param[0] if ($#param>=0 & $param[0] =~ /[+-]{0,1}\d+\.{0,1}\d*/);
}

sub OLONG {
  my ($refdata, $refparam) = @_;
  my @param = @{$refparam};
  unshift @param, 'long';
  push @{$refdata->{'openpos'}}, [ @param ] if ($#param == 4);
}

sub OSHORT {
  my ($refdata, $refparam) = @_;
  my @param = @{$refparam};
  unshift @param, 'short';
  push @{$refdata->{'openpos'}}, [ @param ] if ($#param == 4);
}

sub TLONG {
  my ($refdata, $refparam) = @_;
  my @param = @{$refparam};
  unshift @param, 'long';
  push @{$refdata->{'history'}}, [ @param ] if ($#param >= 7);
  if (!defined($refdata->{'maxid'}) || ($#param >= 7 && $refdata->{'maxid'} <= $param[7]) ) {
    $refdata->{'maxid'} = $param[7];
  }
}

sub TSHORT {
  my ($refdata, $refparam) = @_;
  my @param = @{$refparam};
  unshift @param, 'short';
  push @{$refdata->{'history'}}, [ @param ] if ($#param >= 7);
  if (!defined($refdata->{'maxid'}) || ($#param >= 7 && $refdata->{'maxid'} <= $param[7]) ) {
    $refdata->{'maxid'} = $param[7];
  }
}

sub COMMENT {
  my ($refdata, $refparam) = @_;
  my @param = @{$refparam};
  my $id = shift @param;
  my $comment = join(" ", @param);
  push @{$refdata->{'comment'}->{$id}}, $comment;
}

sub BUY {
  my ($refdata, $refparam) = @_;
  my ($wkn,$count,$func) = @{$refparam};
  push @{$refdata->{'orders'}}, [ 'buy', $wkn, $count, $func ];
}

sub SELL {
  my ($refdata, $refparam) = @_;
  my ($wkn,$count,$func) = @{$refparam};
  push @{$refdata->{'orders'}}, [ 'sell', $wkn, $count, $func ];
}


sub processdata {
  my $refdata = shift;
  my $nr = 0;
  foreach my $p ( @{$refdata->{'orders'}} ) {
    my ($o, $wkn,$count,$func) = @{$p};
    my $back_func = $func;

    my @params = ();
    if ( $func =~ /(\w+)\((.+)\)/) {
      $func = $1;
      @params = split /\s*,\s*/, $2;
    } elsif ( $func =~ /(\w+)\(\)/) {
      $func = $1;
    }

    # Kurs besorgen
    my $value = getval($wkn);
    next if ( !defined($value) );
    #print STDERR $wkn . ": " . $value . "\n";
    #print STDERR ">>" . $func . "<<" . "\n";

    # Ausführen ?
    my $execute = 0;
    if ( uc($func) eq "TRUE" ) {
      $execute = 1;
    } elsif ( uc($func) eq "ABOVE" ) {
      if ( $#params >= 0 && $params[0] < $value ) {
	$execute = 1;
      }
    } elsif ( uc($func) eq "BELOW" ) {
      if ( $#params >= 0 && $params[0] > $value ) {
	$execute = 1;
      }
    } elsif ( uc($func) eq "TRAILINGABOVE" ) {
      if ( $#params >= 1 && $params[0] + $params[1] < $value  ) {
	$execute = 1;
      } elsif ( $#params >= 1 && $params[0] < $value ) {
	$params[0] = $value;
      }
    } elsif ( uc($func) eq "TRAILINGBELOW" ) {
      if ( $#params >= 1 && $params[0] + $params[1] > $value  ) {
	$execute = 1;
      } elsif ( $#params >= 1 && $params[0] > $value ) {
	$params[0] = $value;
      }
    }
    $refdata->{'orders'}->[$nr]->[3] = $func . "(" . join(",", @params) . ")";

    if ( $execute == 1 ) {
      print STDERR "Is executed ...\n";
      # Preis feststellen
      my $price;
      my $tcount;
      if ($count =~ /(\d+)x$/i) {
	$tcount = $1;
	$price = $tcount * $value;
      } else {
	$tcount = int($count / $value);
	$price = $tcount * $value;
      }

      # Schauen ob noch Aktienpositionen offen sind
      # Ich gehe davon aus, dass man nicht gelichzeitig 
      # eine Long und Short Pos. hält
      my $indepot = -1;
      foreach my $nr ( 0..$#{$refdata->{'openpos'}} ) {
	if ( translatecode($refdata->{'openpos'}->[$nr]->[1]) eq 
	     translatecode($wkn) ) {
	  $indepot = $nr;
	}
      }
      # Es sind noch Aktien im Depot
      if ( $indepot != -1 ) {
	my $p = splice @{$refdata->{'openpos'}}, $indepot, 1;
	$refdata->{'maxid'}++;
	$refdata->{'maxid'} = sprintf("%07d", $refdata->{'maxid'});

	if ( $p->[0] =~ /long/ ) {
	  # Long Pos. auflösen und später neu aufbauen
	  push @{$refdata->{'history'}}, [ 'long', $p->[1], $p->[2], $p->[3], $p->[4], timestamp(), $value, $refdata->{'maxid'} ];
	  $refdata->{'cash'} += $p->[2] * $value;
	  $tcount = $tcount - $p->[2] if ($o =~/buy/);
	  $tcount = $tcount - $p->[2] if ($o =~/sell/);
	}
	# Short Position auflösen
	else {
	  push @{$refdata->{'history'}}, [ 'short', $p->[1], $p->[2], $p->[3], $p->[4], timestamp(), $value, $refdata->{'maxid'} ];
	  $refdata->{'cash'} += $p->[2] * ($p->[4]) + ( $p->[2] *( $p->[4] - $value ) );
	  $tcount = $tcount -  $p->[2] if ($o =~/buy/);
	  $tcount = $tcount - $p->[2] if ($o =~/sell/);
	}
	push @{$refdata->{'comment'}->{$refdata->{'maxid'}}}, "Canceled by new order: " . $back_func;
	$price = $tcount * $value;
      }

      #      **** FIXME: *****
      # Teilausführungen ermöglichen

      # Wenn genug Cash vorhanden, zu den offenen Positionen gesellen;
      # ansonsten in die Warteschleife packen.
      if ( $price != 0 && $price <= $refdata->{'cash'} ) {
	$refdata->{'cash'} -= $price;
	push @{$refdata->{'openpos'}}, [ 'long', $wkn, $tcount, timestamp(), $value ] if ($o =~ /buy/i);
	push @{$refdata->{'openpos'}}, [ 'short', $wkn, $tcount, timestamp(), $value ] if ($o =~ /sell/i);
      }
      splice @{$refdata->{'orders'}},$nr,1;
    }
    $nr++;
  }
}


sub print_page {
  my $refdata = shift;
  print header, start_html('-title'   => 'My personal Depot',
			   '-BGCOLOR' => '#C0C0C0');
  print h1("Olf's very Own Depot");

  my $tablecontent = "";
  $tablecontent .= TR(td("Aktueller Cash: "), td({-align => 'right', -width => '250'}, sprintf("%.2f EUR", $refdata->{'cash'}))) if (defined($refdata->{'cash'}) );
  my $depotsum = 0;
  foreach my $p (  @{$refdata->{'openpos'}} ) {
    $depotsum += getval( $p->[1] ) * $p->[2];
  }
  $tablecontent .= TR( td("Aktuelle Depotsumme: "), td({-align => 'right'}, sprintf("%.2f EUR", $depotsum)) );
  $tablecontent .= TR( {-bgcolor => 'white' }, td(b("Gesamter Wert: ")), td({-align => 'right'}, b(sprintf("%.2f EUR", ($depotsum+$refdata->{'cash'})))) );
  print table({-border=>0,-cellpadding=>5,-cellspacing=>0}, $tablecontent);

  #print p( "Zeit: " . timestamp() );

  print h2("Offene Positionen");
  ######################################################################
  $tablecontent = TR( {-bgcolor=>'#8080FF'}, th("Datum"), th("WKN"), th("L/S"), th("Anzahl"), th("Kaufkurs"), th("Aktueller Kurs"), th("Prozent"), th("Close") );
  my $color = 0;
  foreach my $p ( sort {$a->[3] cmp $b->[3]} @{$refdata->{'openpos'}} ) {
    my $rowcontent = "";
    # Datum
    my $temp = $p->[3];
    $temp =~ s/_/&nbsp;/;
    $rowcontent .= td($temp);
    # WKN
    $rowcontent .= td($p->[1]);
    # L/S
    $rowcontent .= td($p->[0]);
    # Anzahl
    $rowcontent .= td($p->[2]);
    # Kurs
    $rowcontent .= td(sprintf("%.2f",$p->[4]));
    # Aktueller Kurs
    $temp = getval( $p->[1] );
    $rowcontent .= td(sprintf("%.2f",$temp));
    # Prozent
    my $prozent = ( 100 * ( ($p->[2]*$temp) - ($p->[2]*$p->[4]) ) ) / ($p->[2]*$p->[4]);
    $prozent *= -1 if ($p->[0] =~ /short/i);
    my $col = "#000000";
    $col = "#AA0000" if ($prozent < 0);
    $col = "#00AA00" if ($prozent > 0);
    $rowcontent .= td(span({-style=>"Color: $col;"}, sprintf("%.2f",$prozent)));
    # Close
    $rowcontent .= td( start_form(), hidden('close',1), hidden('id',$p->[1]), submit("CLOSE"), end_form() );

    $tablecontent .= TR({-bgcolor=>'#DDDDDD'}, $rowcontent) if ($color);
    $tablecontent .= TR($rowcontent) if (!$color);
    $color = !$color;
  }
  print table( {-border=>0,-cellpadding=>5,-cellspacing=>0}, $tablecontent );

  print h2("Open Orders");
  ######################################################################
  $tablecontent = TR( {-bgcolor=>'#8080FF'}, th("WKN"), th("L/S"), th("Anzahl / Preis"), th("Bedingung"), th("Aktueller Kurs"), th("Cancel?") );
  $color = 0;
  foreach my $p ( @{$refdata->{'orders'}} ) {
    my $rowcontent = "";
    # WKN
    $rowcontent .= td($p->[1]);
    # L/S
    $rowcontent .= td($p->[0]);
    # Anzahl
    $rowcontent .= td($p->[2]);
    # Kurs
    $rowcontent .= td($p->[3]);
    # Aktueller Kurs
    my $temp = getval( $p->[1] );
    $rowcontent .= td(sprintf("%.2f",$temp));
    # Button für Schließen
    # **** FIXME: ***** Momentan werden alle Orders für die WKN gecanceled
    $rowcontent .= td( start_form(), hidden('cancel',1), hidden('id',$p->[1]), submit("CANCEL"), end_form() );
    $tablecontent .= TR({-bgcolor=>'#DDDDDD'}, $rowcontent) if ($color);
    $tablecontent .= TR($rowcontent) if (!$color);
    $color = !$color;
  }
  print table( {-border=>0,-cellpadding=>5,-cellspacing=>0}, $tablecontent );

  print h2("New Order");
  ######################################################################
  print start_form, 
    table(
	  TR(td("WKN:"), td(textfield('wkn'))),
	  TR(td("Buy/Sell:"), td(radio_group(-name=>'buysell',
                                    -values=>['buy','sell'],
                                    -default=>'buy',
                                    -linebreak=>'true'))),
	  TR(td("Anzahl/Preis:"), td(textfield('count'))),
	  TR(td("Bedingung:"), td(textfield('func')))),
	    hidden('buy',1), submit("Order aufgeben"), end_form;


  print h2("History");
  ######################################################################<
  $tablecontent = TR( {-bgcolor=>'#8080FF'}, th("WKN"), th("L/S"), th("Datum"), th("Anzahl"), th("Kurs"), th("Wert"), th("Prozent") );
  $color = 0;
  foreach my $p ( @{$refdata->{'history'}} ) {
    #print p( join(" - ", @{$p}) );

    my $rowcontent = "";
    # WKN
    $rowcontent .= td($p->[1]);
    # L/S
    $rowcontent .= td($p->[0]);
    # Datum
    my $temp = $p->[3];
    $temp =~ s/_/&nbsp;/;
    $rowcontent .= td($temp);
    # Anzahl
    $rowcontent .= td($p->[2]);
    # Kurs
    $rowcontent .= td(sprintf("%.2f",$p->[4]));
    # Wert
    $rowcontent .= td(sprintf("%.2f",($p->[4]*$p->[2])));
    # Prozent
    $rowcontent .= td();
    $tablecontent .= TR({-bgcolor=>'#DDDDDD'}, $rowcontent) if ($color);
    $tablecontent .= TR($rowcontent) if (!$color);

    $rowcontent = "";
    # WKN
    $rowcontent .= td();
    # L/S
    $rowcontent .= td();
    # Datum
    $temp = $p->[5];
    $temp =~ s/_/&nbsp;/;
    $rowcontent .= td($temp);
    # Anzahl
    $rowcontent .= td($p->[2]);
    # Kurs
    $rowcontent .= td(sprintf("%.2f",$p->[6]));
    # Wert
    $rowcontent .= td(sprintf("%.2f",($p->[6]*$p->[2])));
    # Prozent
    my $prozent = ( 100 * ( ($p->[2]*$p->[6]) - ($p->[2]*$p->[4]) ) ) / ($p->[2]*$p->[4]);
    $prozent *= -1 if ($p->[0] =~ /short/i);
    my $col = "#000000";
    $col = "#AA0000" if ($prozent < 0);
    $col = "#00AA00" if ($prozent > 0);
    $rowcontent .= td(span({-style=>"Color: $col;"}, sprintf("%.2f",$prozent)));
#    $rowcontent .= td(sprintf("%.2f",$prozent));

    $tablecontent .= TR({-bgcolor=>'#DDDDDD'}, $rowcontent) if ($color);
    $tablecontent .= TR($rowcontent) if (!$color);

    if ( $#{$p}>=7 && defined($refdata->{'comment'}->{$p->[7]}) ) {
      foreach my $c ( @{$refdata->{'comment'}->{$p->[7]}} ) {
	my $tc = span({-style=>"font-size:0.9em;"}, $c);
	$tablecontent .= TR( {-bgcolor=>'#DDDDDD'}, td() . td() . td( {-colspan => 5}, $tc) ) if ($color);
	$tablecontent .= TR( td() . td() . td( {-colspan => 5}, $tc) ) if (!$color);
	#print p( $c );
      }
      my $tc = start_form . textfield('comment') . hidden('id',$p->[7]) . submit('Kommentar') . end_form;
      $tablecontent .= TR( {-bgcolor=>'#DDDDDD'}, td() . td() . td( {-colspan => 5}, $tc) ) if ($color);
      $tablecontent .= TR( td() . td() . td( {-colspan => 5}, $tc) ) if (!$color);
    }

    $color = !$color;

  }
  print table( {-border=>0,-cellpadding=>5,-cellspacing=>0}, $tablecontent );

  print end_html;
}


sub getval {
# Enable this for testing
#  return 50;
  my $wkn = shift;
  return $CACHE{$wkn} if (defined($CACHE{$wkn}));

  my $q = Finance::Quote->new;
  $q->timeout(60);
  $q->set_currency("EUR");
  $wkn = translatecode($wkn);
  my %quotes  = $q->fetch("europe",$wkn);
  my $value;
  if ( $USEBIDASK == 1 ) {
    $value = $quotes{$wkn, "bid"};
  } else {
    $value = $quotes{$wkn, "price"};
  }
  $CACHE{$wkn} = $value;
  return $value;
}

sub translatecode {
  my $code = shift;
  if ( defined($code) && $code =~ /\d{6}/i ) {
    $code .= ".DE";
  }
  return $code;
}


sub timestamp {
  my @t = localtime(time);
  $t[5] += 1900;
  $t[4] += 1;
  my $date = sprintf("%04d-%02d-%02d_%02d:%02d:%02d", $t[5], $t[4], $t[3], $t[2], $t[1], $t[0]);
  return $date;
}