view release on metacpan or  search on metacpan

lib/App/Chart/Gtk2/IntradayDialog.pm  view on Meta::CPAN

  $self->set_title (__('Chart: Intraday'));
  $self->{'refresh_button'}
    = $self->add_button ('gtk-refresh' => RESPONSE_REFRESH);
  $self->add_buttons ('gtk-print'   => RESPONSE_PRINT,
                      'gtk-save'    => RESPONSE_SAVE,
                      'gtk-close'   => 'close',
                      'gtk-help'    => 'help');
  # this is an "after" to allow a user's signals to be called first on
  # 'close' or 'delete-event', since we're going to $self->destroy on those
  $self->signal_connect_after (response => \&_do_response);

  my $vbox = $self->vbox;

  # display symbol and mode in a label, since can't be certain the window
  # manager will have a good title bar
  my $title_label = $self->{'title_label'} = Gtk2::Label->new ('');
  _update_title_label ($self);
  $vbox->pack_start ($title_label, 0,0,0);

  # centre in area, don't grow image beyond desired size
  my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
  $vbox->pack_start ($align, 1,1,0);

  my $image = $self->{'image'} = App::Chart::Gtk2::IntradayImage->new;
  $align->add ($image);
  Glib::Ex::ConnectProperties->new ([$self,'symbol'],
                                    [$image,'symbol']);
  Glib::Ex::ConnectProperties->new ([$self,'mode'],
                                    [$image,'mode']);

  my $crosshair = $self->{'crosshair'}
    = Gtk2::Ex::CrossHair->new (widget => $image,
                                foreground => 'orange');
  Glib::Ex::ConnectProperties->new ([$crossbutton,'active'],
                                    [$crosshair,'active']);
  $image->add_events ('button-press-mask');
  $image->signal_connect (button_press_event =>\&_do_image_button_press_event);

  my $progress_label = $self->{'progress_label'} = Gtk2::Label->new ('');
  $vbox->pack_start ($progress_label, 0,0,0);

  my $hbox = Gtk2::HBox->new();
  $vbox->pack_start ($hbox, 0,0,0);

  $hbox->pack_start (Gtk2::Label->new (__('Symbol')), 0,0,0);

  my $entry = Gtk2::Entry->new ();
  $self->{'entry'} = $entry;
  $hbox->pack_start ($entry, 1, 1, 0.5 * Gtk2::Ex::Units::em($entry));
  $entry->signal_connect (activate => \&_do_entry_activate);

  my $button = Gtk2::Button->new_with_label (__('Enter'));
  $hbox->pack_start ($button, 0,0,0);
  $button->signal_connect (clicked => \&_do_enter_button);

  # During perl "global destruction" can have App::Chart::Gtk2::Job already
  # destroyed enough that it has disconnected the message emission hook
  # itself, leading to an unsightly Glib warning on attempting
  # signal_remove_emission_hook() in our 'destroy' class closure.
  #
  # As a workaround instead leave it connected, with a weakened ref, and let
  # it return 0 to disconnect itself on the next emission (if any).
  #
  #   App::Chart::Gtk2::Job->signal_add_emission_hook
  #       ('status-changed', \&_do_job_status_changed,
  #        App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
  #
  require App::Chart::Glib::Ex::EmissionHook;
  $self->{'hook'} = App::Chart::Glib::Ex::EmissionHook->new
    ('App::Chart::Gtk2::Job',
     status_changed => \&_do_job_status_changed,
     App::Chart::Glib::Ex::MoreUtils::ref_weak($self));

  $vbox->show_all;

  # secret Control-L to redraw
  # ENHANCE-ME: maybe accel_path thing for configurability
  my $accelgroup = $self->{'accelgroup'} = Gtk2::AccelGroup->new;
  $self->add_accel_group ($accelgroup);
  $accelgroup->connect (Gtk2::Gdk->keyval_from_name('l'), ['control-mask'], [],
                        \&_do_accel_redraw);

  # with a sensible intraday image size
  Gtk2::Ex::Units::set_default_size_with_subsizes
      ($self, [$image, 512, 288]);
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  ### SET_PROPERTY: $pspec->get_name
  ### newval: ''.\$newval

  my $pname = $pspec->get_name;
  $self->{$pname} = $newval;  # per default GET_PROPERTY

  if ($pname eq 'symbol') {
    my $symbol = $newval;
    my $entry = $self->{'entry'};
    $entry->set_text ($symbol);
    Gtk2::Ex::EntryBits::select_region_noclip ($entry, 0, -1);
  }
  _update_title_label ($self);
  _update_job_status ($self);
  $self->refresh_old;
}

# refresh if the image in the database is more than 2 minutes old, or
# there's none in the database at all
sub refresh_old {
  my ($self) = @_;
  my $symbol = $self->{'symbol'} || return;
  my $mode   = $self->{'mode'}   || return;

  require App::Chart::DBI;
  require App::Chart::Download;
  my $timestamp = App::Chart::DBI->read_single
    ('SELECT fetch_timestamp FROM intraday_image WHERE symbol=? AND mode=?',
     $symbol, $mode);
  if (! App::Chart::Download::timestamp_within ($timestamp, 120)) {
    $self->refresh;
  }