view release on metacpan or  search on metacpan

bin/pmat-explore-gtk  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Carp;

use Glib qw( TRUE FALSE );
use Gtk2 -init;
use Gtk2::SimpleList;

use Devel::MAT;

use List::Util qw( pairs );
use List::UtilsBy qw( sort_by );

use App::Devel::MAT::Explorer::GTK::Resources qw( get_icon );
use App::Devel::MAT::Explorer::GTK::Shell;
use App::Devel::MAT::Explorer::GTK::SVDetail;
use App::Devel::MAT::Explorer::GTK::Utils qw( bytes2size );
use App::Devel::MAT::Explorer::GTK::Widgets qw( framed vscrollable );

my $pmat;
my $df;

my $win = Gtk2::Window->new( "toplevel" );
$win->signal_connect( destroy => sub { Gtk2->main_quit } );
$win->resize( 1000, 600 );
my $winbox = Gtk2::VBox->new( 0, 0 );
$win->add( $winbox );

my $menu = Gtk2::MenuBar->new;
$winbox->pack_start( $menu, FALSE, TRUE, 0 );

my $filemenu = add_submenu( $menu, "File" );
add_menuitem( $filemenu, "Quit" => sub { Gtk2->main_quit } );

my $navmenu = add_submenu( $menu, "Navigate" );

my $toolbar = Gtk2::Toolbar->new;
$toolbar->set_style( 'both' );
$winbox->pack_start( $toolbar, FALSE, TRUE, 0 );

my $backbtn = $toolbar->append_item( "Back", "Go back to the previous SV", "",
   Gtk2::Image->new_from_stock("gtk-go-back", "small-toolbar"), \&history_back );
my $forwardbtn = $toolbar->append_item( "Forward", "Go forward to the next SV", "",
   Gtk2::Image->new_from_stock("gtk-go-forward", "small-toolbar"), \&history_forward );

my $svs_loaded;

my $outrefs_mth = "outrefs";
my $inrefs_mth = "inrefs";
{
   my %mode_buttons;

   my %mode_tooltip = (
      All    => "Display and count every kind of inref and outref",
      Direct => "Display and count only direct inrefs and outrefs",
      Strong => "Display and count only strong direct inrefs and outrefs",
   );

   Devel::MAT::UI->provides_radiobutton_set(
      map {
         my $filter = $_ eq "All" ? "" : "_\L$_";

         Devel::MAT::UI->register_icon(
            name => "refs-$_",
            svg => "icons/refs-$_.svg"
         );

         {
            text    => $_,
            icon    => "refs-$_",
            tooltip => $mode_tooltip{$_},
            code    => sub {
               $outrefs_mth = "outrefs$filter";
               $inrefs_mth  = "inrefs$filter";

               reset_svlist_refs() if $svs_loaded;
               redisplay_sv();
            },

bin/pmat-explore-gtk  view on Meta::CPAN

   }

   sub Devel::MAT::UI::current_sv
   {
      return $current_sv;
   }
}

add_menuitem( $navmenu, "Back" => \&history_back );
add_menuitem( $navmenu, "Forward" => \&history_forward );

add_menuitem( $navmenu, "By address..." => sub {
   defined( my $addr = entry_dialog( "Enter SV address" ) ) or return;

   $addr = hex $addr;
   if( my $sv = $df->sv_at( $addr ) ) {
      history_nav( $sv );
   }
   else {
      progress( sprintf "Cannot navigate by address: no such SV at 0x%x", $addr );
   }
});

add_menuitem( $navmenu, "By symbol..." => sub {
   defined( my $symb = entry_dialog( "Enter symbol name" ) ) or return;

   if( my $sv = eval { $pmat->find_symbol( $symb ) } ) {
      history_nav( $sv );
   }
   else {
      chomp( my $e = $@ );
      progress( "Cannot navigate by symbol: $e" );
   }
});

my $rootmenu = add_submenu( $menu, "Roots" );

my $toolmenu;
foreach my $tool ( sort Devel::MAT->available_tools ) {
   my $tool_class = "Devel::MAT::Tool::$tool";
   next unless $tool_class->can( "FOR_UI" ) and $tool_class->FOR_UI;

   $toolmenu ||= add_submenu( $menu, "Tools" );
   add_menuitem( $toolmenu, $tool, sub {
      my ( $mi ) = @_;

      $mi->set_sensitive( FALSE );

      my $tool = $pmat->load_tool( $tool, progress => \&progress );
      $tool->init_ui( "Devel::MAT::UI" );
      progress();
   });
}

$winbox->add( my $vpane = Gtk2::VPaned->new );
$vpane->pack1( my $hpane = Gtk2::HPaned->new, TRUE, TRUE );

my $statusbar = Gtk2::Statusbar->new;
$winbox->pack_end( $statusbar, FALSE, TRUE, 0 );

$statusbar->pack_start( framed( my $perlver_label = Gtk2::Label->new( "" ) ), FALSE, FALSE, 0 );
$statusbar->pack_start( framed( my $svcount_label = Gtk2::Label->new( "" ) ), FALSE, FALSE, 0 );
$statusbar->pack_start( framed( my $bytetotal_label = Gtk2::Label->new( "" ) ), FALSE, FALSE, 0 );

$win->show_all;

{
   my $id = $statusbar->get_context_id( "progress" );

   sub progress
   {
      $statusbar->pop( $id );
      $statusbar->push( $id, "Progress: $_[0]" ) if defined $_[0];
      Gtk2->main_iteration_do( FALSE ) while Gtk2->events_pending;
   }
}

my $filename = $ARGV[0] or die "Need dumpfile\n";

$win->set_title( "$filename - pmat-explore-gtk" );

$pmat = Devel::MAT->load( $filename, progress => \&progress );
$df = $pmat->dumpfile;

$perlver_label->set_text( join " ", "Perl",
   $df->perlversion,
   ( $df->ithreads ? "thread" : () ),
   ( $df->ptr_len * 8 ) . "bit",
);
$svcount_label->set_text( scalar($df->heap) . " SVs" );

# We're going to be using Inrefs
$pmat->load_tool( "Inrefs", progress => \&progress );

foreach ( pairs $df->roots ) {
   my ( $desc, $sv ) = @$_;
   add_menuitem( $rootmenu, $desc, sub { history_nav( $sv ) } ) if $sv;
}

my $svlist_model = Gtk2::ListStore->new(
   "Glib::String",
   ( $df->ptr_len > 4 ? "Glib::Long" : "Glib::Int" ),
   "Glib::String",
   "Glib::Int",
   "Glib::String",
   "Glib::Int",
   "Glib::Int",
);

# UI column constants
sub Devel::MAT::UI::COLUMN_TYPE   () { 0 }
sub Devel::MAT::UI::COLUMN_ADDR   () { 1 }
sub Devel::MAT::UI::COLUMN_DESC   () { 2 }
sub Devel::MAT::UI::COLUMN_SIZE   () { 3 }
sub Devel::MAT::UI::COLUMN_BLESSED() { 4 }
sub Devel::MAT::UI::COLUMN_OUTREFS() { 5 }
sub Devel::MAT::UI::COLUMN_INREFS () { 6 }

my $svlist_view = Gtk2::TreeView->new;
$svlist_view->set_model( $svlist_model );

sub add_svlist_column
{