view release on metacpan or  search on metacpan

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

}
widget_class "App__Chart__Gtk2__Diagnostics.*.GtkTextView" style:gtk "Chart_fixed_width_font"
HERE

use constant RESPONSE_REFRESH => 0;

sub INIT_INSTANCE {
  my ($self) = @_;
  my $vbox = $self->vbox;

  $self->set_title (__('Chart: Diagnostics'));
  $self->add_buttons ('gtk-close'   => 'close',
                      'gtk-refresh' => RESPONSE_REFRESH);
  $self->signal_connect (response => \&_do_response);

  my $scrolled = Gtk2::ScrolledWindow->new;
  $scrolled->set_policy ('never', 'automatic');
  $vbox->pack_start ($scrolled, 1,1,0);

  my $textbuf = $self->{'textbuf'} = Gtk2::TextBuffer->new;
  $textbuf->set_text ('');

  my $textview = $self->{'textview'}
    = Gtk2::TextView->new_with_buffer ($textbuf);
  $textview->set (wrap_mode => 'char',
                  editable => 0);
  $scrolled->add ($textview);

  $vbox->show_all;

  # with a sensible rows and columns size for the TextView
  Gtk2::Ex::Units::set_default_size_with_subsizes
      ($self,
       [$textview, '60 ems', -1],
       [$scrolled, -1, '40 lines']);

  # limit to 80% screen height
  my ($width, $height) = $self->get_default_size;
  $height = min ($height, 0.8 * $self->get_screen->get_height);
  $self->set_default_size ($width, $height);
}

sub _do_response {
  my ($self, $response) = @_;

  if ($response eq RESPONSE_REFRESH) {
    $self->refresh;

  } elsif ($response eq 'close') {
    # close signal as per a keyboard Esc close; it defaults to raising
    # 'delete-event', which in turn defaults to a destroy
    $self->signal_emit ('close');
  }
}

sub refresh {
  my ($self) = @_;
  ### refresh: "$self"
  my $textview = $self->{'textview'};

  # can be a bit slow counting the database the first time, so show busy
  require Gtk2::Ex::WidgetCursor;
  Gtk2::Ex::WidgetCursor->busy;

  require Gtk2::Ex::TextBufferBits;
  Gtk2::Ex::TextBufferBits::replace_lines
      ($textview->get_buffer, $self->str());
}

sub str {
  my ($class_or_self) = @_;
  my $self = ref $class_or_self ? $class_or_self : undef;

  # mallinfo and mstats before loading other stuff, mallinfo first since
  # mstats is quite likely not available, and mallinfo first then avoids
  # counting Devel::Peek
  my $mallinfo;
  if (eval { require Devel::Mallinfo; }) {
    $mallinfo = Devel::Mallinfo::mallinfo();
  }

  # mstats_fillhash() croaks if no perl malloc in the running perl
  my %mstats;
  require Devel::Peek;
  ## no critic (RequireCheckingReturnValueOfEval)
  eval { Devel::Peek::mstats_fillhash(\%mstats) };
  ## use critic

  my $str = '';

  if (App::Chart::DBI->can('has_instance') # if loaded
      && App::Chart::DBI->has_instance) {  # and DBI connected
    my $dbh = App::Chart::DBI->instance;

    require DBI::Const::GetInfoType;
    $str .= "Database: "
      . $dbh->get_info($DBI::Const::GetInfoType::GetInfoType{'SQL_DBMS_NAME'})
        . " "
          . $dbh->get_info($DBI::Const::GetInfoType::GetInfoType{'SQL_DBMS_VER'})
            . "\n";
    {
      # as per App::Chart::DBI code
      my ($dbversion) = $dbh->selectrow_array
        ("SELECT value FROM extra WHERE key='database-schema-version'");
      $str .= "  schema version: @{[$dbversion//'undef']}\n";
    }
    {
      my ($count) = $dbh->selectrow_array('SELECT COUNT(*) FROM info');
      $str .= "  symbols: $count\n";
      my ($daily) = $dbh->selectrow_array('SELECT COUNT(*) FROM daily');
      $str .= sprintf ("  daily records: %d (%d per symbol)\n",
                       $daily, $daily / $count);
    }
    {
      my ($count) = $dbh->selectrow_array('SELECT COUNT(*) FROM latest');
      $str .= "  latest records: $count\n";
    }
    {
      my ($count) = $dbh->selectrow_array('SELECT COUNT(*) FROM intraday_image');
      $str .= "  intraday images: $count\n";
    }
  } else {
    $str .= "Database not connected yet\n";