The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyright 2008, 2009, 2010, 2011 Kevin Ryde

# This file is part of Chart.
#
# Chart 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 3, or (at your option) any later version.
#
# Chart 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 Chart.  If not, see <http://www.gnu.org/licenses/>.


package App::Chart::Annotation;
use 5.010;
use strict;
use warnings;

use App::Chart::Database;

use constant DEBUG => 0;

sub delete {
  my ($self) = @_;
  if (DEBUG) { print "Annotation delete ",$self->table,
                 " symbol ",$self->{'symbol'}," id ",$self->{'id'},"\n"; }
  my $table = $self->table;
  my $symbol = $self->{'symbol'};
  my $id = $self->{'id'};

  require App::Chart::DBI;
  my $dbh = App::Chart::DBI->instance;
  my $rows = $dbh->do ("DELETE FROM $table WHERE symbol=? AND id=?",
                       undef, $symbol, $id);
  if ($rows != 1) {
    carp ("Annotation delete: oops, affected $rows\n");
  }
  App::Chart::chart_dirbroadcast()->send ('data-changed', { $symbol => 1 });
}

sub clone {
  my ($self) = @_;
  return bless { %$self }, ref ($self);
}

sub ensure_id {
  my ($self, $symbol) = @_;
  return ($self->{'id'} ||= do {
    my $table = $self->table;
    my $last_id = App::Chart::Database::read_notes_single
      ("SELECT id FROM $table WHERE symbol=?
        ORDER BY id DESC LIMIT 1",
       $symbol);
    ($last_id||0) + 1;
  });
}

sub next_id {
  my ($table, $symbol) = @_;
  my $last_id = App::Chart::Database::read_notes_single
    ("SELECT id FROM $table WHERE symbol=? ORDER BY id DESC LIMIT 1",
     $symbol);
  return ($last_id || 0) + 1;
}

sub swap_ends {
}

#------------------------------------------------------------------------------

package App::Chart::Annotation::Alert;
use strict;
use warnings;
use base 'App::Chart::Annotation';

use constant DEBUG => 0;

sub new {
  my ($class, %self) = @_;
  return bless \%self, $class;
}

sub table { return 'alert'; }

sub t {
  my ($self, $new_t) = @_;
  if (@_ < 2) { return $self->{'t'}||0; }
  $self->{'t'} = $new_t;
}

sub price {
  my ($self, $newprice) = @_;
  if (@_ < 2) { return $self->{'price'}; }
  $self->{'price'} = $newprice;
}

sub write {
  my ($self) = @_;
  my $symbol = $self->{'symbol'};

  require App::Chart::DBI;
  my $dbh = App::Chart::DBI->instance;
  App::Chart::Database::call_with_transaction
      ($dbh, sub {
         my $id = $self->ensure_id ($symbol);

         $dbh->do ('INSERT OR REPLACE INTO alert
                   (symbol, id, price, above)
                   VALUES (?,?, ?,?)',
                   undef, # DBI options
                   $symbol,
                   $id,
                   $self->{'price'},
                   $self->{'above'});
         update_alert ($symbol);
       });
  App::Chart::chart_dirbroadcast()->send ('data-changed', { $symbol => 1 });
}

sub delete {
  my ($self) = @_;
  $self->SUPER::delete;
  App::Chart::Annotation::Alert::update_alert ($self->{'symbol'});
}

sub draw {
  my ($self, $graph, $region) = @_;
  App::Chart::Gtk2::Graph::Plugin::Alerts->draw ($graph, $region, [ $self ]);
}

sub update_alert {
  my ($symbol) = @_;
  require App::Chart::Gtk2::Symlist::Alerts;
  my $symlist = App::Chart::Gtk2::Symlist::Alerts->instance;
  if (want_alert ($symbol)) {
    $symlist->insert_symbol ($symbol);
  } else {
    $symlist->delete_symbol ($symbol);
  }
}

# return true if $symbol should be in the Alerts list
sub want_alert {
  my ($symbol) = @_;
  if (DEBUG) { print "want_alert $symbol\n"; }

  # must be in all list, so not historical and not symbols deleted but with
  # user notes remaining
  require App::Chart::Gtk2::Symlist::All;
  my $symlist = App::Chart::Gtk2::Symlist::All->instance;
  $symlist->contains_symbol($symbol) or return 0;

  require App::Chart::DBI;
  my $dbh = App::Chart::DBI->instance;
  my $sth = $dbh->prepare_cached ('SELECT price,above FROM alert
                                   WHERE symbol=?');
  my $alert_list = $dbh->selectall_arrayref ($sth, {Slice=>{}}, $symbol);
  $sth->finish;
  if (! @$alert_list) { return 0; } # no levels

  require App::Chart::Latest;
  my $latest = App::Chart::Latest->get ($symbol);

  foreach my $alert (@$alert_list) {
    if ($alert->{'above'}) {
      # look at bid, but if crossed to offer<bid then use only the offer,
      # ie. the lesser of the two
      my $above_price = App::Chart::max_maybe
        ($latest->{'last'},
         App::Chart::min_maybe ($latest->{'bid'}, $latest->{'offer'}))
          // return 0; # if nothing in latest record

      if (DEBUG) { print "  compare $above_price above ",
                     $alert->{'price'},"\n"; }
      if ($above_price >= $alert->{'price'}) { return 1; }

    } else {
      # look at offer, but if crossed to bid>offer then use only the bid,
      # ie. the greater of the two
      my $below_price = App::Chart::min_maybe
        ($latest->{'last'},
         App::Chart::max_maybe ($latest->{'bid'},
                                $latest->{'offer'}))
          // return 0; # if nothing in latest record

      if (DEBUG) { print "  compare $below_price below ",
                     $alert->{'price'},"\n"; }
      if ($below_price <= $alert->{'price'}) { return 1; }
    }
  }
}

package App::Chart::Annotation::Line;
use strict;
use warnings;
use Carp;
use Math::Round;
use base 'App::Chart::Annotation';

sub table { return 'line'; }

sub new_for_graph {
  my ($class, $graph, $x, $y) = @_;
  my $series = $graph->get('series_list')->[0] || return;
  my $symbol = $series->symbol
    || croak 'Cannot add line to non-database series';
  my $timebase = $series->timebase;
  my $t = $graph->x_to_date ($x);
  my $p = $graph->y_to_value ($y);
  my $date = $timebase->to_iso ($t);
  return bless { symbol  => $symbol,
                 id      => undef,
                 date1   => $date,
                 price1  => $p,
                 date2   => $date,
                 price2  => $p,
                 horizontal => 0,

                 timebase => $timebase,
                 t1      => $t,
                 t2      => $t }, $class;
}

sub App::Chart::Series::Database::AnnLines_arrayref {
  my ($series) = @_;
  return ($series->{__PACKAGE__.'.array'} ||= do {
    my $symbol = $series->symbol || '';
    require App::Chart::DBI;
    my $dbh = App::Chart::DBI->instance;

    my $sth = $dbh->prepare_cached ('SELECT * FROM line WHERE symbol=?');
    my $aref = $dbh->selectall_arrayref ($sth, {Slice=>{}}, $symbol);
    $sth->finish;
    my $timebase = $series->timebase;
    foreach my $elem (@$aref) {
      $elem->{'timebase'} = $timebase;
      $elem->{'t1'} = $timebase->from_iso_floor ($elem->{'date1'});
      $elem->{'t2'} = $timebase->from_iso_floor ($elem->{'date2'});
      bless $elem, __PACKAGE__;
    }
    $aref;
  });
}

sub t {
  my ($self, $new_t) = @_;
  if (@_ < 2) { return $self->{'t1'}; }
  $new_t = Math::Round::round ($new_t);
  $self->{'t1'} = $new_t;
  my $timebase = $self->{'timebase'};
  $self->{'date1'} = $timebase->to_iso ($new_t);
}

sub price {
  my ($self, $newprice) = @_;
  if (@_ < 2) { return $self->{'price1'}; }
  $self->{'price1'} = $newprice;
}

sub swap_ends {
  my ($self) = @_;
  swap ($self->{'date1'}, $self->{'date2'});

  { my $tmp = $self->{'t1'};
    $self->{'t1'} = $self->{'t2'};
    $self->{'t2'} = $tmp;
  }
  { my $tmp = $self->{'price1'};
    $self->{'price1'} = $self->{'price2'};
    $self->{'price2'} = $tmp;
  }
  return $self;
}

sub swap {
  my $tmp = $_[0]; $_[0] = $_[1]; $_[1] = $tmp;
}

sub write {
  my ($self) = @_;
  my $symbol = $self->{'symbol'};

  if ($self->{'horizontal'}) {
    $self->{'price2'} = $self->{'price1'};
  }

  require App::Chart::DBI;
  my $dbh = App::Chart::DBI->instance;
  App::Chart::Database::call_with_transaction
      ($dbh, sub {
         my $id = $self->ensure_id ($symbol);

         $dbh->do ('INSERT OR REPLACE INTO line
                    (symbol,id, date1,price1,date2,price2,horizontal)
                    VALUES (?,?, ?,?,?,?,?)',
                   undef, # DBI options
                   $symbol,
                   $id,
                   $self->{'date1'},
                   $self->{'price1'},
                   $self->{'date2'},
                   $self->{'price2'},
                   $self->{'horizontal'});
       });
  App::Chart::chart_dirbroadcast()->send ('data-changed', { $symbol => 1 });
}

sub draw {
  my ($self, $graph, $region) = @_;
  App::Chart::Gtk2::Graph::Plugin::AnnLines->draw ($graph, $region, [ $self ]);
}

1;
__END__