view release on metacpan or  search on metacpan

lib/App/Chart/Annotation.pm  view on Meta::CPAN

     $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'},