view release on metacpan or  search on metacpan

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

   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
{
   my %args = @_;

   my $column = Gtk2::TreeViewColumn->new_with_attributes(
      $args{title}, Gtk2::CellRendererText->new, text => $args{idx},
   );
   $column->set_sort_column_id( $args{idx} );

   $svlist_view->append_column( $column );
}

# First two columns are special
$svlist_view->insert_column_with_data_func( -1, " ",
   Gtk2::CellRendererPixbuf->new, sub {
      my ( $column, $renderer, $model, $iter ) = @_;
      my $type = $model->get( $iter, Devel::MAT::UI->COLUMN_TYPE );
      my $icon = get_icon( "type-$type" );

      $renderer->set( pixbuf => $icon ) if $icon;
   }, undef
);
$svlist_view->insert_column_with_data_func( -1, "Address",
   Gtk2::CellRendererText->new, sub {
      my ( $column, $renderer, $model, $iter ) = @_;
      my $addr = $model->get( $iter, Devel::MAT::UI->COLUMN_ADDR );