Padre::Plugin::Devel - tools used by the Padre developers

Padre documentation Contained in the Padre distribution.

Index

Code Index:

NAME

Top

Padre::Plugin::Devel - tools used by the Padre developers

DESCRIPTION

Top

Run Document inside Padre

Executes and evaluates the contents of the current (saved or unsaved) document within the current Padre process, and then dumps the result of the evaluation to Output.

Dump Current Document

Dump Top IDE Object

Dump %INC and @INC

Dumps the %INC hash to Output

Enable/Disable logging

Enable/Disable trace when logging

Simulate crash

wxWidgets 2.8.10 Reference

STC reference

Documentation for wxStyledTextCtrl, a control that wraps the Scintilla editor component.

wxPerl Live Support

Connects to #wxperl on irc.perl.org, where people can answer queries on wxPerl problems/usage.

About

AUTHOR

Top

Gábor Szabó

LICENSE

Top

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Padre documentation Contained in the Padre distribution. 
package Padre::Plugin::Devel;

use 5.008;
use strict;
use warnings;
use Padre::Wx     ();
use Padre::Util   ();
use Padre::Plugin ();

our $VERSION = '0.86';
our @ISA     = 'Padre::Plugin';





#####################################################################
# Padre::Plugin Methods

sub padre_interfaces {
	return (
		'Padre::Plugin'                       => 0.85,
		'Padre::Wx'                           => 0.85,
		'Padre::Wx::Main'                     => 0.85,
		'Padre::Wx::History::TextEntryDialog' => 0.85,
	);
}

sub plugin_name {
	Wx::gettext('Padre Developer Tools');
}

# Reuse the Padre icon
sub plugin_icon {
	require Padre::Wx::Icon;
	Padre::Wx::Icon::find('logo');
}

sub plugin_enable {
	my $self = shift;

	# Load our configuration
	# (Used for testing purposes)
	$self->{config} = $self->config_read;

	return 1;
}

sub plugin_disable {
	my $self = shift;

	# Save our configuration
	# (Used for testing purposes)
	if ( $self->{config} ) {
		$self->{config}->{foo}++;
		$self->config_write( delete( $self->{config} ) );
	} else {
		$self->config_write( { foo => 1 } );
	}

	return 1;
}

sub menu_plugins_simple {
	my $self = shift;
	return $self->plugin_name => [
		Wx::gettext('Run Document inside Padre')  => 'eval_document',
		Wx::gettext('Run Selection inside Padre') => 'eval_selection',

		'---'               => undef,
		Wx::gettext('Dump') => [
			Wx::gettext('Dump Expression...')    => 'dump_expression',
			Wx::gettext('Dump Current Document') => 'dump_document',
			Wx::gettext('Dump Task Manager')     => 'dump_taskmanager',
			Wx::gettext('Dump Top IDE Object')   => 'dump_padre',
			Wx::gettext('Dump Current PPI Tree') => 'dump_ppi',
			Wx::gettext('Dump %INC and @INC')    => 'dump_inc',
			Wx::gettext('Dump Display Geometry') => 'dump_display',
			Wx::gettext('Start/Stop sub trace')  => 'trace_sub_startstop',
		],
		'---' => undef,

		Wx::gettext('Load All Padre Modules')        => 'load_everything',
		Wx::gettext('Simulate Crash')                => 'simulate_crash',
		Wx::gettext('Simulate Background Exception') => 'simulate_task_exception',
		Wx::gettext('Simulate Background Crash')     => 'simulate_task_crash',

		'---' => undef,

		sprintf( Wx::gettext('wxWidgets %s Reference'), '2.8.10' ) => sub {
			Padre::Wx::launch_browser('http://docs.wxwidgets.org/2.8.10/');
		},
		Wx::gettext('STC Reference') => sub {
			Padre::Wx::launch_browser('http://www.yellowbrain.com/stc/index.html');
		},
		Wx::gettext('wxPerl Live Support') => sub {
			Padre::Wx::launch_irc('wxperl');
		},

		'---' => undef,

		Wx::gettext('About') => 'show_about',
	];
}





#####################################################################
# Plugin Methods

sub dump_expression {
	my $self = shift;

	# Get the expression
	require Padre::Wx::History::TextEntryDialog;
	my $dialog = Padre::Wx::History::TextEntryDialog->new(
		$self->main,
		Wx::gettext("Expression"),
		Wx::gettext("Expression"),
		'Padre::Plugin::Devel.expression',
	);
	return if $dialog->ShowModal == Wx::wxID_CANCEL;
	my $perl = $dialog->GetValue;
	$dialog->Destroy;

	# Evaluate it
	return $self->_dump_eval($perl);
}

sub eval_document {
	my $self = shift;
	my $document = $self->current->document or return;
	return $self->_dump_eval( $document->text_get );
}

sub eval_selection {
	my $self = shift;
	my $document = $self->current->document or return;
	return $self->_dump_eval( $self->current->text );
}

sub dump_document {
	my $self     = shift;
	my $current  = $self->current;
	my $document = $current->document;
	unless ($document) {
		$current->main->error( Wx::gettext('No file is open') );
		return;
	}
	return $self->_dump($document);
}

sub dump_taskmanager {
	my $self = shift;
	return $self->_dump( $self->current->ide->task_manager );
}

# Dumps the current Perl 5 PPI document to the current output window
sub dump_ppi {
	my $self     = shift;
	my $current  = $self->current;
	my $document = $current->document;
	my $main     = $self->current->main;

	# Make sure that there is a Perl 5 document
	require Params::Util;
	unless ( Params::Util::_INSTANCE( $current->document, 'Padre::Document::Perl' ) ) {
		$main->error( Wx::gettext('No Perl 5 file is open') );
		return;
	}

	# Generate the PPI dump string and set into the output window
	require PPI::Dumper;
	require PPI::Document;
	my $source = $document->text_get;
	my $doc    = PPI::Document->new( \$source );
	my $dumper = PPI::Dumper->new( $doc, locations => 1, indent => 4 );

	$main->output->SetValue( $dumper->string );
	$main->output->SetSelection( 0, 0 );
	$main->show_output(1);
}

sub dump_padre {
	$_[0]->_dump( $_[0]->current->ide );
}

# Copy %INC and @INC before passing them to _dump,
# so changes during the _dump process aren't in the output.
sub dump_inc {
	$_[0]->_dump( {%INC}, [@INC] );
}

sub dump_display {
	my $self     = shift;
	my @displays = ();

	# Due to the way it is mapped into Wx.pm
	# this must NOT be called as a method.
	my $count = Wx::Display::GetCount();

	foreach ( 0 .. $count - 1 ) {
		my $display = Wx::Display->new($_);
		push @displays,
			{
			IsPrimary     => $display->IsPrimary,
			GetGeometry   => $self->_rect( $display->GetGeometry ),
			GetClientArea => $self->_rect( $display->GetClientArea ),
			};
	}
	$self->_dump(
		{   GetCount    => $count,
			DisplayList => \@displays,
		}
	);
}

sub _rect {
	my $self = shift;
	my $rect = shift;
	my %hash = map { $_ => $rect->$_() } qw{
		GetTop
		GetBottom
		GetLeft
		GetRight
		GetHeight
		GetWidth
	};
	$hash{wx} = $rect;
	return \%hash;
}

sub trace_sub_startstop {
	my $self = shift;
	my $main = $self->current->main;

	if ( defined( $self->{trace_sub_before} ) ) {
		delete $self->{trace_sub_before};
		delete $self->{trace_sub_after};
		$main->info( Wx::gettext('Sub-tracing stopped') );
		return;
	}

	eval 'use Aspect;';
	if ($@) {
		$main->error( Wx::gettext('Error while loading Aspect, is it installed?') . "\n$@" );
		return;
	}

	eval '
		$self->{trace_sub_before} = before {
						print STDERR "enter ".shift->{sub_name}."\n";
				} call qr/^Padre::/;
		$self->{trace_sub_after} = after {
						print STDERR "leave ".shift->{sub_name}."\n";
				} call qr/^Padre::/;
';
	$main->info( Wx::gettext('Sub-tracing started') );

}

sub simulate_crash {
	require POSIX;
	POSIX::_exit();
}

# Simulate a background thread that does an uncaught exception/die
sub simulate_task_exception {
	require Padre::Task::Eval;
	Padre::Task::Eval->new(
		run    => 'sleep 5; die "This is a debugging task that simply crashes after running for 5 seconds!";',
		finish => 'warn "This should never be reached";',
	)->schedule;
}

# Simulate a background thread that does a hard exit/segfault
sub simulate_task_crash {
	require Padre::Task::Eval;
	Padre::Task::Eval->new(
		run    => 'sleep 5; exit(1);',
		finish => 'warn "This should never be reached";',
	)->schedule;
}

sub show_about {
	my $self  = shift;
	my $about = Wx::AboutDialogInfo->new;
	$about->SetName('Padre::Plugin::Devel');
	$about->SetDescription( Wx::gettext("A set of unrelated tools used by the Padre developers\n") );
	Wx::AboutBox($about);
	return;
}

sub load_everything {
	my $self = shift;
	my $main = $self->current->main;

	# Find the location of Padre.pm
	my $padre = $INC{'Padre.pm'};
	my $parent = substr( $padre, 0, length($padre) - 3 );

	# Find everything under Padre:: with a matching version
	require File::Find::Rule;
	my @children = grep { not $INC{$_} }
		map {"Padre/$_->[0]"}
		grep { defined( $_->[1] ) and $_->[1] eq $VERSION }
		map { [ $_, Padre::Util::parse_variable( File::Spec->catfile( $parent, $_ ) ) ] }
		File::Find::Rule->name('*.pm')->file->relative->in($parent);
	$main->message( sprintf( Wx::gettext('Found %s unloaded modules'), scalar @children ) );
	return unless @children;

	# Load all of them (ignoring errors)
	my $loaded = 0;
	foreach my $child (@children) {
		eval { require $child; };
		next if $@;
		$loaded++;
	}

	# Say how many classes we loaded
	$main->message( sprintf( Wx::gettext('Loaded %s modules'), $loaded ) );
}

# Takes a string, which it evals and then dumps to Output
sub _dump_eval {
	my $self = shift;
	my $code = shift;

	# Evecute the code and handle errors
	my @rv = eval $code;
	if ($@) {
		$self->current->main->error( sprintf( Wx::gettext("Error: %s"), $@ ) );
		return;
	}

	return $self->_dump(@rv);
}

sub _dump {
	my $self = shift;
	my $main = $self->current->main;

	# Generate the dump string and set into the output window
	require Devel::Dumpvar;
	$main->output->SetValue( Devel::Dumpvar->new( to => 'return' )->dump(@_) );
	$main->output->SetSelection( 0, 0 );
	$main->show_output(1);

	return;
}

1;


# Copyright 2008-2011 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.