view release on metacpan or  search on metacpan

bin/wxprofile  view on Meta::CPAN

        }

        #die $sizer->GetRows();

        $parent->Fit();
        $parent->FitInside();

        # $navigator_notebook->AddPage($parent, 'List View');
        EVT_GRID_SELECT_CELL($pkg_grid, sub { $self->on_package_select(@_) } );
        EVT_GRID_SELECT_CELL($sub_grid, sub { $self->on_sub_select(@_) } );
        EVT_GRID_SELECT_CELL($call_grid, sub {
            $self->populate_callee_map(@_);
            $self->populate_callee_tree(@_);
        } );
        $main_sizer->Add($parent, 1, wxEXPAND);
    }
    EVT_CLOSE( $self, \&on_close );
    EVT_MENU( $self, wxID_ABOUT, \&on_about );
    EVT_MENU( $self, wxID_EXIT, sub { $self->Close } );
    EVT_MENU( $self, wxID_OPEN, \&on_open );

    $main->Fit();
    $main->FitInside();
    $self->SetIcon( Wx::GetWxPerlIcon() );
    $self->Show;

#    Wx::LogMessage( "Welcome to wxProfile!" );

    return $self;
}

sub setup_grid {
    my ($self,$grid, $height, @cols) = @_;

#   wxFont(int pointSize, wxFontFamily family, int style, wxFontWeight weight, const bool underline = false, const wxString& faceName = "", wxFontEncoding encoding = wxFONTENCODING_DEFAULT)
    my $font = Wx::Font->new(8);

    my $sizer = Wx::FlexGridSizer->new(0, scalar @cols, $#cols);

    $grid->SetSizer($sizer);
    $grid->CreateGrid(0, scalar @cols, -1);
    $grid->SetDefaultCellFont($font);
    $grid->SetLabelFont($font);
    $grid->SetRowLabelSize(32);
    $grid->EnableEditing(0);
    $grid->SetSelectionMode(1); # wxGridSelectRow

    for (0..$#cols) {
        $grid->SetColLabelValue($_, $cols[$_]);
    }

    $grid->SetMinSize([500,$height]);
    $grid->SetMaxSize([500,$height]);

    $grid->Fit();
    $grid->FitInside();
}

sub populate_pkg_grid {
    my ($self, $data) = @_;
    my $busy = Wx::BusyCursor->new();
    my $grid = $self->pkg_grid();
    my $data_from_ref = [ sort { $b->get_elapsed <=> $a->get_elapsed } values %{ $data } ];

    # die Data::Dumper::Dumper $data_from_ref;

    $grid->data($data_from_ref);
    $grid->AppendRows(scalar @{ $data_from_ref });

    for (my $i = 0; $i<scalar @{ $data_from_ref }; $i++ ) {
        $grid->SetCellValue($i, 0, $data_from_ref->[$i]->get_elapsed() );
        $grid->SetCellValue($i, 1, $data_from_ref->[$i]->get_calls() );
        $grid->SetCellValue($i, 2, $data_from_ref->[$i]->get_package() );
    }
    $grid->Fit();
    $grid->FitInside();

}

sub on_package_select {
    my ($self, $package_grid, $event) = @_;
    my $grid = $self->sub_grid();
    my $pkg = $package_grid->data()->[$event->GetRow()];
    $self->populate_sub_grid($pkg);
}

sub populate_sub_grid {
    my ($self, $pkg) = @_;
    if (not defined $pkg) {
        warn "no pkg - called from " , join " ", caller();
        return;
    }
    my $grid = $self->sub_grid();
    my @row_data = sort { $b->get_elapsed() <=> $a->get_elapsed() } values %{ $pkg->get_function };
    $grid->data( \@row_data );

    $grid->ClearGrid();

    my $rows = $grid->GetNumberRows();
    if ($rows > scalar @row_data) {
        $grid->DeleteRows(scalar @row_data, $rows - scalar @row_data);
    }
    elsif ($rows < scalar @row_data) {
        $grid->AppendRows(scalar @row_data - $rows);
    }

    for (my $i = 0; $i<scalar @row_data; $i++ ) {
        # use Data::Dumper; die Dumper $sub_from_ref->[$i]->get_calls;
        $grid->SetCellValue($i, 0, $row_data[$i]->get_elapsed() );
        $grid->SetCellValue($i, 1, $row_data[$i]->get_calls() );
        $grid->SetCellValue($i, 2, $row_data[$i]->get_function() );
    }
    $grid->Fit();
    $grid->FitInside();
    $grid->Layout();
    $grid->SelectRow(0);
}

sub select_package {
    my ($self, $package) = @_;
    my $grid = $self->pkg_grid();
    for my $row(0..$grid->GetNumberRows()) {
        if ($package eq $grid->GetCellValue($row,2)) {
            $grid->SelectRow($row);
            $grid->MakeCellVisible($row,0);
            return $grid->data()->[ $row ];
        }
    }
    return;
}

sub select_sub {
    my ($self, $package) = @_;
    my $grid = $self->sub_grid();
    for my $row(0..$grid->GetNumberRows()) {
        if ($package eq $grid->GetCellValue($row,2)) {
            $grid->SelectRow($row);
            $grid->MakeCellVisible($row,0);
            return $grid->data()->[ $row ];
        }
    }
    return;
}

sub on_sub_select {
    my ($self, $sub_grid, $event) = @_;
    my $pkg = $sub_grid->data()->[ $event->GetRow() ];
    $self->populate_call_grid($pkg);
}

sub populate_call_grid {
    my ($self, $pkg) = @_;
    my $busy = Wx::BusyCursor->new();

    my @row_data = @{ $pkg->get_child_nodes() };
    my $grid = $self->call_grid();
    $grid->data( \@row_data );

    $grid->ClearGrid();

    my $rows = $grid->GetNumberRows();
    if ($rows > scalar @row_data) {
        $grid->DeleteRows(scalar @row_data, $rows - scalar @row_data);
    }
    elsif ($rows < scalar @row_data) {
        $grid->AppendRows(scalar @row_data - $rows);
    }

    for (my $i = 0; $i<scalar @row_data; $i++ ) {
        # use Data::Dumper; die Dumper $sub_from_ref->[$i]->get_calls;
        $grid->SetCellValue($i, 0, $row_data[$i]->get_elapsed() );
        $grid->SetCellValue($i, 1, $row_data[$i]->get_calls() );
        $grid->SetCellValue($i, 2, $row_data[$i]->get_function() );
    }
    $grid->Fit();
    $grid->FitInside();
    $grid->Layout();
    $grid->SelectRow(0);
}

sub populate_callee_tree {
    my ($self, $call_grid, $event) = @_;
    my $busy = Wx::BusyCursor->new();
    my $data = $call_grid->data()->[ $event->GetRow() ];
    my $child_nodes = $data->get_child_nodes();
    my $callee_tree = $self->callee_tree();
    $callee_tree->Clear();
    $callee_tree->AppendText($data->get_function() . ": " . $data->get_elapsed() . "\n");
    $callee_tree->AppendText(join q{}, $self->generate_text_tree({
        data => $child_nodes,
        max_depth => 10,
    }));
}

sub populate_callee_map {
    my ($self, $call_grid, $event) = @_;
    my $busy = Wx::BusyCursor->new();
    my $data = $call_grid->data()->[ $event->GetRow() ];

    my $callee_map = $self->callee_map();

    my $file_id = ${ $data };

    my $dir = $self->preferences()->get_data_dir() . "/$$";
    mkdir $dir;
    my $filename = "$dir/$file_id.png";

    my $preferences = $self->preferences();

    if (! -r $filename) {
        my $imager = Devel::WxProf::Treemap::Output::Imager->new( WIDTH=>500, HEIGHT=>400,
            FONT_FILE => join ( '/', $preferences->get_font_dir(), $preferences->get_map_font_file() ),
            # '/usr/share/fonts/truetype/freefont/FreeSans.ttf',
            MIN_FONT_SIZE => $self->preferences()->get_map_font_size(),
            MAX_FONT_SIZE => $self->preferences()->get_map_font_size(),
        );

        my $map = Devel::WxProf::Treemap::Squarified->new(
            INPUT => $data,
            OUTPUT => $imager,
            SPACING => { left => 1, top => 1, right => 1, bottom => 1, min_width => 10, min_height => 10 },
            PADDING => { left => 1, top => 12, right => 1, bottom => 1 },
        );

        my @map_from = $map->map();
        $self->callee_map_data(\@map_from);

        $imager->save($filename);

    }

    my $file = IO::File->new( $filename, "r" );
    unless ($file) {
        print "Can't load $filename.";return undef
    };
    binmode $file;
    my $handler = Wx::PNGHandler->new();
    my $image = Wx::Image->new();
    my $bmp;    # used to hold the bitLabelmap.
    $handler->LoadFile( $image, $file );
    $bmp = Wx::Bitmap->new($image);

    if( $bmp->Ok() ) {
        #  create a static bitmap called ImageViewer that displays the
        #  selected image.
        $callee_map->SetBitmap( $bmp );
        # Wx::StaticBitmapWx::StaticBitmap->new($callee_map, -1, $bmp);
        my $dc = $self->callee_map_dc() || Wx::MemoryDC->new();
        $dc->SelectObject($bmp);
        $self->callee_map_dc($dc);
   }
}

sub generate_text_tree {
    my $self = shift;
    my $arg_ref = shift;
    my @result = @{ $arg_ref->{ data } };
    my $max_depth = $arg_ref->{ max_depth };
    my $indent = q{  };
    my $depth = 0;

    my @text = ();
    while (1) {
        my $node = shift @result;
        if (not defined $node) {
            $depth--;
            last if not @result;
            next;
        }
        push @text, $indent x $depth, $node->get_elapsed , q{ }, $node->get_package, q{ ::}, $node->get_function(), "\n";

        if ($depth < $max_depth) {
            my $children_from = $node->get_child_nodes;
            if (@{ $children_from }) {
                $depth++;
                @result = (@{ $children_from }, undef, @result);

            }
        }
        last if not @result;
    }
    return @text;
}

sub read_profile {
    my ($self, $filename) = @_;
    my $busy = Wx::BusyCursor->new();
    my $data = Devel::WxProf::Data->new({});

    my $reader = ($filename =~m{ tmon\.out$ }x)
        ? Devel::WxProf::Reader::DProf->new()
        : Devel::WxProf::Reader::WxProf->new();

    my @result = eval {
        $reader->read_file($filename)
    };
    if ($@) {
        Wx::LogMessage( "Error: $@");
        return;
    }
    $self->filename($filename);
    $self->_set_title($filename);
    $data->set_child_nodes(\@result);
    $self->populate_pkg_grid($reader->get_packages());
}

sub ask_for_filename {
    my ($self, $label) = shift;
    $label ||= 'Select file';
    my $default_dir = $self->preferences()->get_default_dir();
    my $dialog = Wx::FileDialog->new($self, $label, $default_dir);
    if ($dialog->ShowModal() == wxID_OK) {
        $self->preferences->set_default_dir($dialog->GetDirectory());
        return $dialog->GetPath()
    }
    return;
}

sub on_close {
    my( $self, $event ) = @_;

    Wx::Log::SetActiveTarget( $self->{old_log} );
    $event->Skip;
}

sub on_open {
    my( $self, $event ) = @_;
    my $filename = $self->ask_for_filename();
    if ($filename) {
        $self->read_profile($filename);
    }
}

sub on_about {
    my( $self ) = @_;
    use Wx qw(wxOK wxCENTRE wxVERSION_STRING);

    Wx::MessageBox( "wxprofile (c) 2008 Martin Kutter\n" .
                    "wxPerl $Wx::VERSION, " . wxVERSION_STRING,
                    "About wxprofile", wxOK|wxCENTRE, $self );
}

sub _set_title {
    my $self = shift;
    $self->SetTitle(shift);
}