view release on metacpan or  search on metacpan

bin/wxprofile  view on Meta::CPAN

          wxWHITE
          );
use Wx::Event qw(
    EVT_SIZE
    EVT_TREE_SEL_CHANGED
    EVT_MENU
    EVT_CLOSE
    EVT_GRID_SELECT_CELL
    EVT_BUTTON
    EVT_LEFT_DOWN
    EVT_MOUSE_EVENTS
    );

use Devel::WxProf::Data;
use Devel::WxProf::Grid;
use Devel::WxProf::Reader::WxProf;
use Devel::WxProf::Reader::DProf;
use Devel::WxProf::Preferences;
use Devel::WxProf::Treemap::Output::Imager;
use Devel::WxProf::Treemap::Squarified;

use UNIVERSAL::require;
use Module::Pluggable::Object;

use File::Path qw(rmtree);

__PACKAGE__->mk_accessors( qw(
    preferences
    filename
    pkg_grid
    sub_grid
    call_grid
    callee_tree
    callee_map
    callee_map_dc
    callee_map_data
    notebook) );

my @wx_defaults = (
        -1,
        wxDefaultPosition,
        wxDefaultSize,
        wxNO_FULL_REPAINT_ON_RESIZE|wxCLIP_CHILDREN
);

sub new {
    my( $class ) = @_;
    my $self = $class->SUPER::new(
        undef,
        -1,
        'wxprofile',
        wxDefaultPosition,
        [ 1024, 768 ],
        wxDEFAULT_FRAME_STYLE|wxNO_FULL_REPAINT_ON_RESIZE|wxCLIP_CHILDREN
    );

    $self->preferences( Devel::WxProf::Preferences->new() );

    Wx::InitAllImageHandlers();
    # create menu bar
    my $bar = Wx::MenuBar->new;
    my $file = Wx::Menu->new;
    $file->Append( wxID_OPEN, "Open" );
    $file->Append( wxID_EXIT, "E&xit" );

    my $help = Wx::Menu->new;
    $help->Append( wxID_ABOUT, "&About..." );

    $bar->Append( $file, "&File" );
    $bar->Append( $help, "&Help" );

    $self->SetMenuBar( $bar );

    my $main = Wx::ScrolledWindow->new($self, @wx_defaults);
    $main->SetScrollbars(20, 20, 55, 40);
    my $main_sizer = Wx::BoxSizer->new(wxVERTICAL);
    $main->SetSizer($main_sizer);

#    INFO: {
#        my $parent = Wx::Panel->new($main, @wx_defaults);
#        Wx::StaticText->new($parent, -1, 'Profile Data - table view');
#        $parent->Fit();
#        $main_sizer->AddSpacer(5);
#        $main_sizer->Add($parent);
#        $main_sizer->AddSpacer(10);
#    };


    CHILDREN: {
        my $parent = Wx::Panel->new($main, @wx_defaults);
        # $parent->SetScrollbars(20, 20, 55, 40);

        my $pkg_label = Wx::StaticText->new( $parent, -1, "Packages");
        my $pkg_grid = Devel::WxProf::Grid->new($parent, -1);

        my $sizer = Wx::FlexGridSizer->new(4,2,5,5);
        $parent->SetSizer($sizer);

        $self->setup_grid( $pkg_grid, 200, ('elapsed', 'calls', 'package') );
        $self->pkg_grid($pkg_grid);

        my $sub_label = Wx::StaticText->new( $parent, -1, "Subroutines",);
        my $sub_grid = Devel::WxProf::Grid->new($parent, -1);
        $self->setup_grid( $sub_grid, 400, ('elapsed', 'calls', 'sub') );
        $self->sub_grid($sub_grid);

        my $call_label = Wx::StaticText->new( $parent, -1, "Calls");
        my $call_grid = Devel::WxProf::Grid->new($parent, -1);
        $self->setup_grid( $call_grid, 200, ('elapsed', 'calls', 'sub') );
        $self->call_grid($call_grid);

        my $tree_label = Wx::StaticText->new( $parent, -1, "Callee Tree");

        my $callee_notebook = Wx::Notebook->new($parent, -1);
#
        my $callee_map;
        CALLEE_MAP: {
            #my $parent = $callee_notebook;
            my $parent = Wx::Panel->new($callee_notebook);
            # create a bitmap
            my $bmp = Wx::Bitmap->new(500, 400);
            # create a graphics device context
            my $temp_dc = Wx::MemoryDC->new();
            # select bitmap
            $temp_dc->SelectObject($bmp);
            # clear bitmap
            $temp_dc->Clear();

            # add (new cleared) bitmap to StaticBitmap display
            $callee_map = Wx::StaticBitmap->new($parent, -1, $bmp, wxDefaultPosition, wxDefaultSize, wxNO_BORDER);
            $callee_map->SetMinSize([500,400]);
            $callee_map->SetMaxSize([500,400]);

bin/wxprofile  view on Meta::CPAN

        : 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);
}

sub _add_menus {
    my( $self, %menus ) = @_;

    while( my( $title, $menu ) = each %menus ) {
        $self->GetMenuBar->Insert( 1, $menu, $title );
    }
}

sub _remove_menus {
    my( $self ) = @_;

    while( $self->GetMenuBar->GetMenuCount > 2 ) {
        $self->GetMenuBar->Remove( 1 )->Destroy;
    }
}

sub DESTROY {
    rmtree $_[0]->preferences->get_data_dir() . "/$$";
}

my $app = Wx::SimpleApp->new;
my $locale = Wx::Locale->new( Wx::Locale::GetSystemLanguage );
my $profile = WxProf->new();
$profile->read_profile($ARGV[0]) if @ARGV;

# add mouse event handler
# must be added for $app - application filters events.
EVT_LEFT_DOWN($app, sub {
    my ($app, $event) = @_;

    # only handle clicks on our map special
    if ($event->GetEventObject() == $profile->callee_map) {
        my ($x,$y) = $event->GetPositionXY();
        my $found = first {
            $_->[2] > $x && $x > $_->[0]
            && $_->[3] > $y && $y > $_->[1]
        } @{ $profile->callee_map_data() };

        if ($found) {
            my ($package,$sub) = $found->[-1] =~m{^(.+)::([^:]+)$}x;
            # warn ($package, " ", $sub);
            # warn Data::Dumper::Dumper($profile->callee_map_data());
            my $pkg = $profile->select_package($package);
            if ($pkg) {
                $profile->populate_sub_grid($pkg);
                my $sub_data = $profile->select_sub($sub);
                $profile->populate_call_grid($sub_data)
                    if ($sub_data);
            }
        }
        else {
            warn "No sub found for coordinates x=$x, y=$y";
        }
    }
    $event->Skip();
});

$app->MainLoop;



exit 0;



1;

=pod

=head1 NAME

wxprofile - Graphical profile data analyzer