view release on metacpan or  search on metacpan

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

      $str .= sprintf ("  %.1f Mb%s in %s\n",
                       $size/1e6,
                       $st->size > $size ? ' (sparse)' : '',
                       Glib::filename_display_name($filename));
    }
  }

  $str .= "\n";

  {
    my $count = (App::Chart::Series::Database->can('new')
                 ? keys %App::Chart::Series::Database::cache
                 : 'not loaded yet');
    $str .= "Cached series:     $count\n";
  }
  {
    my $count;
    if (! App::Chart::Latest->can('get')) {
      $count = 'not loaded yet';
    } elsif (my $t = tied %App::Chart::Latest::get_cache) {
      $count = scalar(keys %App::Chart::Latest::get_cache)
        . " of " . $t->{'max_count'};
    } else {
      $count = 'uninitialized';
    }
    $str .= "Cached latest LRU: $count\n";
  }
  $str .= "\n";

  # if BSD::Resource available, only selected info bits
  if (eval { require BSD::Resource; }) {
    my ($usertime, $systemtime,
        $maxrss, $ixrss, $idrss, $isrss, $minflt, $majflt, $nswap,
        $inblock, $oublock, $msgsnd, $msgrcv,
        $nsignals, $nvcsw, $nivcsw)
      = BSD::Resource::getrusage ();
    $str .= "getrusage (BSD::Resource)\n";
    $str .= "  user time:      $usertime (seconds)\n";
    $str .= "  system time:    $systemtime (seconds)\n";
    # linux kernel 2.6.22 doesn't give memory info
    if ($maxrss) { $str .= "  max resident:   $maxrss\n"; }
    if ($ixrss)  { $str .= "  shared mem:     $ixrss\n"; }
    if ($idrss)  { $str .= "  unshared mem:   $idrss\n"; }
    if ($isrss)  { $str .= "  unshared stack: $isrss\n"; }
    # linux kernel 2.4 didn't count context switches
    if ($nvcsw)  { $str .= "  voluntary yields:   $nvcsw\n"; }
    if ($nivcsw) { $str .= "  involuntary yields: $nivcsw\n"; }
  }
  $str .= "\n";

  if ($mallinfo) {
    $str .= "mallinfo (Devel::Mallinfo)\n" . hash_format ($mallinfo);
  } else {
    $str .= "(Devel::Mallinfo not available.)\n";
  }
  $str .= "\n";

  if (%mstats) {
    $str .= "mstat (Devel::Peek)\n" . hash_format (\%mstats);
  } else {
    $str .= "(Devel::Peek -- no mstat() in this perl)\n";
  }

  if (eval { require Devel::Arena; }) {
    $str .= "\n";
    my $stats = Devel::Arena::sv_stats();
    my $magic = $stats->{'magic'};
    $stats->{'magic'}  # mung to reduce verbosity
      = scalar(keys %$magic) . ' total '
        . List::Util::sum (map {$magic->{$_}->{'total'}} keys %$magic);
    $str .= "SV stats (Devel::Arena)\n" . hash_format ($stats);

    my $shared = Devel::Arena::shared_string_table_effectiveness();
    $str .= "Shared string effectiveness:\n" . hash_format ($shared);
  } else {
    $str .= "(Devel::Arena -- module not available)\n";
  }

  if (eval { require Devel::SawAmpersand; 1 }) {
    $str .= 'PL_sawampersand is '
      . (Devel::SawAmpersand::sawampersand()
         ? "true, which is bad!"
         : "false, good")
        . " (Devel::SawAmpersand)\n";
  } else {
    $str .= "(Devel::SawAmpersand -- module not available.)\n";
  }
  $str .= "\n";

  $str .= "Modules loaded: " . (scalar keys %INC) . "\n";
  {
    $str .= "Module versions:\n";
    my @modulenames = ('Gtk2',
                       'Glib',
                       'DBI',
                       'DBD::SQLite',
                       'LWP',
                       'Devel::Arena',
                       # 'Devel::Mallinfo',
                       'Devel::Peek',
                       'Devel::StackTrace',
                       'Gtk2::Ex::Datasheet::DBI',
                       # 'Gtk2::Ex::NoShrink',
                       'Gtk2::Ex::TickerView',
                       'HTML::TableExtract',
                       'Number::Format',
                       'Set::IntSpan::Fast',
                       ['Compress::Raw::Zlib', 'ZLIB_VERSION'],
                       ['Finance::TA', 'TA_GetVersionString'],
                       # no apparent version number in geniustrader
                      );
    my $width = max (map {length} @modulenames);
    $str .= sprintf ("  %-*s%s\n", $width+2, 'Perl', $^V);
    foreach my $modulename (@modulenames) {
      my $funcname;
      if (ref($modulename)) {
        ($modulename,$funcname) = @$modulename;
      }
      my $version = $modulename->VERSION;
      if (defined $version && defined $funcname) {
        my $func = $modulename->can($funcname);