exmap.pl

内存管理工具Exmap。该工具比 ps 或 top 更精确

    }
    return 1;
}

# ------------------------------------------------------------

=head2 ProcsPerFileList

This is a ListView showing a list of processes which map a given file.

=cut

package ProcsPerFileList;
use base qw/ListView/;


sub _frame_name
{
    return "Processes mapping file";
}

sub _first_columns
{
    return (PID => 'int',
	    Cmdline => 'text');
}


sub set_data
{
    my $s = shift;
    my $file = shift;

    $s->{_rows} = [];
    if ($file) {
	my @rows = map {
	    my $proc = $_;
	    Row->new([$proc->pid,
		      $proc->cmdline],
		     sub { $proc->sizes($file) });
	} $file->procs;
	$s->{_rows} = [@rows];
    }
    else {
	$s->{_rows} = [Row->new([0, "No file selected"])];
    }

    return 1;
}


# ------------------------------------------------------------

=head2 ElfSectionList

This is a ListView showing a list of ELF sections within an ELF file.

=cut

package ElfSectionList;
use base qw/ListView/;

sub _frame_name
{
    return "ELF Sections for selected file and process";
}

sub _first_columns
{
    return ('Name' => 'text',
	    'File Offset' => 'text');
}

sub file { return $_[0]->{_file}; }
sub proc { return $_[0]->{_proc}; }

sub _absent_row { return $_[0]->{_absent_text}; }

sub set_data
{
    my $s = shift;
    my $file = shift;
    my $proc = shift;

    # Save these for later querying by the section view
    $s->{_file} = $file;
    $s->{_proc} = $proc;


    $s->{_rows} = [];

    my $absent_text;
    $absent_text = "No file or proc selected"
	unless $file && $proc;
    $absent_text = $file->name ." is not an ELF file"
	if $file && !$file->is_elf;

    if ($absent_text) {
	$s->{_rows} = [Row->new([$absent_text])];
    }
    else {
	# Deferred calculation via closures.
	# First row does the calculation and shifts out the first value.
	# The later rows just shift out the row values.
	my @sections = $file->elf->mappable_sections;
	my @ranges = map { $_->mem_range } @sections;

	# The closures manipulate this array
	my @row_data;

	my $calculator = sub {
	    @row_data = $proc->elf_range_sizes($file, @ranges);
	    shift @row_data;
	};
	my $shifter = sub { shift @row_data; };
	
	my @closures = ($calculator, map { $shifter } @sections);
	pop @closures;
	
	my @rows = map {
	    my $section = $_;
	    Row->new([$section->name,
		      $section->is_nobits ? "absent" : $section->offset],
		     shift @closures);
	} @sections;
	$s->{_rows} = [@rows];
    }

    return 1;
}


# ------------------------------------------------------------

=head2 ElfSymbolList

This is a ListView showing a list of ELF symbols within an ELF section.

=cut

package ElfSymbolList;
use base qw/ListView/;
use constant PAGE_SIZE => 4096;

sub _frame_name
{
    return "ELF Symbols in selected section";
}

sub _first_columns
{
    return ('Symbol Name' => 'text');
}


sub set_data
{
    my $s = shift;
    my $file = shift;
    my $proc = shift;
    my $section_name = shift;

    $s->{_rows} = [];

    my $absent_text;

    # Last test will take precedence
    $absent_text = "No ELF section selected" unless $section_name;
    $absent_text = $file->name ." is not an ELF file"
	if $file && !$file->is_elf;
    $absent_text = "No file and proc selected" unless $file && $proc;

    my $section;
    my @symbols;
    unless ($absent_text) {
	$section = $file->elf->section_by_name($section_name);
	@symbols = $file->elf->symbols_in_section($section);
	
	$absent_text = "No symbols in $section_name in " . $file->name
	    unless @symbols;
    }

    if($absent_text) {
	$s->{_rows} = [Row->new([$absent_text])];
    }
    else {
	# Deferred calculation via closures. See above.
	my @ranges = map { $_->range; } @symbols;
	my @row_data;
	
	my $calculator = sub {
	    @row_data = $proc->elf_range_sizes($file, @ranges);
	    shift @row_data;
	};
	my $shifter = sub { shift @row_data; };
	
	my @closures = ($calculator, map { $shifter } @symbols);
	pop @closures;
	
	my @rows = map {
	    my $sym = $_;
	    Row->new([$sym->name],
		     shift @closures);
	} @symbols;
	$s->{_rows} = [@rows];
    }

    return 1;
}


sub register_section_list
{
    my $s = shift;
    my $sectionlist = shift;

    my $lw = $sectionlist->list_window;

    $lw->get_selection
	->signal_connect(changed => sub {
			     my $selection = shift;
			     my $model = $lw->get_model;
			     my $iter = $selection->get_selected;
			     return undef unless $iter;
			     my $section_name = $model->get_value($iter, 0);
			     $s->set_data($sectionlist->file,
					  $sectionlist->proc,
					  $section_name);
			     $s->update_view;
			 });
}



# ------------------------------------------------------------

=head2 Config

Wrapper around the Gtk2::KeyFile to provide a config file.

This is loaded from ~/.exmaprc if present and non-empty.

It is saved back to .exmaprc if it exists. Hence a way to get a config
file is to create an empty ~/.exmaprc and run exmap. On exit, it will
save back the default config.

=cut

package Config;

use constant GROUP_LIST_COLUMNS => "List Columns";
use constant GROUP_COLUMN_DEFS => "Column Definitions";
use constant BUILTIN => "built-in";

sub new
{
    my $c = shift;
    $c = ref $c if ref $c;
    my $s = bless {}, $c;
    $s->{_keyfile} = Glib::KeyFile->new;
    unless ($s->{_keyfile}) {
	warn("Can't create keyfile");
	return undef;
    }
    $s->{_keyfile}->set_list_separator(ord ",");
    $s->{_file} = $ENV{HOME} . "/.exmaprc";
    $s->{_save_file} = 0; # Only save a file if we loaded one.
    return $s;
}

sub load
{
    my $s = shift;
    my $flags = ['keep-comments', 'keep-translations'];

    my $worked;
    if (-f $s->{_file} && !-z $s->{_file}) {
	# Wrap in eval as load_from_file likes to call croak :-(
	eval {
	    $worked = $s->{_keyfile}->load_from_file($s->{_file}, $flags);
	};
	if (!$worked || $@) {
	    $@ ||= "";
	    print STDERR "Failed to load cfg file $s->{_file} : $@";
	}
    }
    else {
	$worked = 1;
	$s->_set_defaults;
    }
    $s->{_save_file} = -f $s->{_file};

    return $worked;
}

sub check_save
{
    my $s = shift;
    if ($s->{_save_file} && $s->{_keyfile} && $s->{_file}) {
	open(S, "> $s->{_file}")
	    or die("Can't open file $s->{_file} to save cfg : $!");
	print S $s->{_keyfile}->to_data;
	close S;
    }
    return 1;
}

sub _set_defaults
{
    my $s = shift;
    my @cols = Exmap::Sizes::keys;
    my @listviews = qw/ProcList
		       FileList
		       FilesPerProcList
		       ProcsPerFileList
		       ElfSectionList
		       ElfSymbolList/;
    my $kf = $s->{_keyfile};

    map { $kf->set_value(GROUP_COLUMN_DEFS, $_, BUILTIN) } @cols;

    map { $kf->set_value(GROUP_LIST_COLUMNS, $_, ""); } @listviews;

    return 1;
}

sub cols_for_listview
{
    my $s = shift;
    my $lv_name = shift;
    $lv_name =~ s/^:://;
    $lv_name =~ s/=.*$//;
    my @cols = $s->{_keyfile}->get_string_list(GROUP_LIST_COLUMNS,
					       $lv_name);
    @cols = $s->_trim_spaces(@cols);
    my @defined_cols = $s->defined_cols;

    my @good_cols;

    if (@cols) {
	foreach my $col (@cols) {
	    if (grep { $_ eq $col } @defined_cols) {
		push @good_cols, $col;
	    }
	    else {
		warn("Unrecognised column name $col for view $lv_name");
	    }
	}
    }
    else {
	@good_cols = @defined_cols
    }

    return @good_cols;
}

sub defined_cols
{
    my $s = shift;
    return $s->_trim_spaces($s->{_keyfile}->get_keys(GROUP_COLUMN_DEFS));
}

sub _trim_spaces
{
    my $s = shift;
    map { s/^\s+//; s/\s+$//; $_ } @_;
}


# ------------------------------------------------------------

=head2 ExmapTabPage

Abstract base class for the file/proc tabs. This contains the common
mainlist/sublist/elfsectionlist functionality.

=cut

package ExmapTabPage;
use base qw/View/;

sub _init_windows
{
    my $s = shift;
    $s->{_exmap} = shift;
    $s->{_symlist} = shift;

    my $vbox = Gtk2::VBox->new;
    $s->{_sectionlist} = ElfSectionList->new;

    $vbox->add($s->{_mainlist}->window);
    $vbox->add($s->{_sublist}->window);
    $vbox->add($s->{_sectionlist}->window);

    $s->window($vbox);

    my $mainlistwin = $s->{_mainlist}->list_window;
    my $sublistwin = $s->{_sublist}->list_window;

    # Update the sublist data when the mainwin selection changes
    $mainlistwin->get_selection
	->signal_connect(changed => sub {
			   my $selection = shift;
			   my $model = $mainlistwin->get_model;
			   my $iter = $selection->get_selected;
			   return undef unless $iter;
			   my $item = $model->get_value($iter, 0);
			   my $data = $s->_mainlist_item_to_data($item);
			   $s->{_sublist}->set_data($data);
			   $s->{_sublist}->update_view;
			   # Also clear section list
			   $s->{_sectionlist}->set_data();
			   $s->{_sectionlist}->update_view;
		       });

    # Update the section list when the sublist selection changes
    $sublistwin->get_selection
	->signal_connect(changed => sub {
			     my $selection = shift;
			     my $model = $sublistwin->get_model;
			     my $subiter = $selection->get_selected;
			     return undef unless $subiter;
			     my $subitem = $model->get_value($subiter, 0);
			     my $subdata = $s->_sublist_item_to_data($subitem);
			     my $mainiter = $mainlistwin->get_selection->get_selected;
			     my $mainitem = $mainlistwin->get_model->get_value($mainiter, 0);
			     my $maindata = $s->_mainlist_item_to_data($mainitem);
			     if ($s->_main_first_for_sectionlist) {
				 $s->{_sectionlist}->set_data($maindata,
							      $subdata);
			     }
			     else {
				 $s->{_sectionlist}->set_data($subdata,
							      $maindata);
			     }
			     $s->{_sectionlist}->update_view;
			 });
    
    return 1;
}

sub _pid_to_proc
{
    my $s = shift;
    my $pid = shift;
    return $s->{_exmap}->pid_to_proc($pid);
}

sub _fname_to_file
{
    my $s = shift;
    my $fname = shift;
    my $file = $s->{_exmap}->file_pool->name_to_file($fname);
    return $file;
}

sub show_tab
{
    my $s = shift;
    $s->{_mainlist}->update_view;
    $s->{_sublist}->update_view;
    $s->{_sectionlist}->update_view;
}

# ------------------------------------------------------------

=head2 ProcTab

Class to wrap the 'Processes' tab in the view. The mainlist is a
ProcList, the sublist is a 'FilesPerProcList'.

=cut

package ProcTab;
use base qw/ExmapTabPage/;

sub _init_windows
{
    my $s = shift;

    $s->{_mainlist} = ProcList->new;
    $s->{_sublist} = FilesPerProcList->new;

    return $s->SUPER::_init_windows;
}

sub _mainlist_item_to_data
{
    my $s = shift;
    return $s->_pid_to_proc(@_);
}

sub _sublist_item_to_data
{
    my $s = shift;
    return $s->_fname_to_file(@_);
}

sub set_data
{
    my $s = shift;
    $s->{_exmap} = shift;
    my $symlist = shift;

    $s->{_mainlist}->set_data($s->{_exmap}->procs);
    $symlist->register_section_list($s->{_sectionlist});

    return 1;
}

sub _main_first_for_sectionlist { return 0; }

# ------------------------------------------------------------

=head2 FileTab

Class to wrap the 'Files' tab in the view. The mainlist is a
FileList, the sublist is a 'ProcsPerFileList'.

=cut

package FileTab;
use base qw/ExmapTabPage/;

sub _init_windows
{
    my $s = shift;
    $s->{_mainlist} = FileList->new;
    $s->{_sublist} = ProcsPerFileList->new;
    return $s->SUPER::_init_windows;
}


sub _mainlist_item_to_data
{
    my $s = shift;
    return $s->_fname_to_file(@_);
}

sub _sublist_item_to_data
{
    my $s = shift;
    return $s->_pid_to_proc(@_);
}

sub set_data
{
    my $s = shift;
    $s->{_exmap} = shift;
    my $symlist = shift;

    $s->{_mainlist}->set_data($s->{_exmap}->files);
    $symlist->register_section_list($s->{_sectionlist});

    return 1;
}

sub _main_first_for_sectionlist { return 1; }