PPI::Tester - A wxPerl-based interactive PPI debugger/tester

  ppitester

package PPI::Tester;

# The PPI Tester application

use 5.006;
use strict;
use PPI            1.000 ();
use PPI::Dumper    1.000 ();
use Devel::Dumpvar  0.04 ();
use Wx              0.85 ();

use vars qw{$VERSION};
BEGIN {
	$VERSION = '0.15';
}

sub main {
	my $class = shift;
	my $app   = $class->new;
	unless ( $app ) {
		croak("Failed to load PPI Tester application");
	}
	$app->MainLoop;
	exit(0);
}

sub new {
	PPI::Tester::App->new;
}





#####################################################################
# The main application class

package PPI::Tester::App;

our @ISA = 'Wx::App';

use constant APPLICATION_NAME => "PPI Tester $PPI::Tester::VERSION - PPI $PPI::VERSION";

sub OnInit {
	my $self = shift;
	$self->SetAppName(APPLICATION_NAME);

	# Create the one and only frame
	my $frame = PPI::Tester::Window->new(
		undef,            # Parent Window
		-1,               # Id
		APPLICATION_NAME, # Title
		[-1, -1],         # Default size
		[-1, -1],         # Default position
	);
	$frame->CentreOnScreen;

	# Set it as the top window and show it
	$self->SetTopWindow($frame);
	$frame->Show(1);

	# Do an initial parse
	$frame->debug;

	return 1;
}





#####################################################################
# The main window for the application

package PPI::Tester::Window;

our @ISA = 'Wx::Frame';

use Wx        qw{ :everything };
use Wx        qw{ wxHIDE_READONLY };
use Wx::Event qw{ EVT_TOOL EVT_TEXT EVT_CHECKBOX };

# wxWindowIDs
use constant CMD_CLEAR        => 1;
use constant CMD_LOAD         => 2;
use constant CMD_DEBUG        => 3;
use constant CODE_BOX         => 4;
use constant STRIP_WHITESPACE => 5;

my $initial_code = '';

sub new {
	my $class = shift;
	my $self  = $class->SUPER::new(@_);

	# Use the pretty Wx icon
	$self->SetIcon( Wx::GetWxPerlIcon() );

	# Create and populate the toolbar
	$self->CreateToolBar( wxNO_BORDER | wxTB_HORIZONTAL | wxTB_TEXT | wxTB_NOICONS );
	$self->GetToolBar->AddTool( CMD_CLEAR, 'Clear', wxNullBitmap );
	$self->GetToolBar->AddTool( CMD_LOAD,  'Load',  wxNullBitmap );
	# $self->GetToolBar->AddSeparator;
	# $self->GetToolBar->AddTool( CMD_DEBUG, 'Debug', wxNullBitmap );
	$self->GetToolBar->Realize;

	# Bind the events for the toolbar
	EVT_TOOL( $self, CMD_CLEAR, \&clear );
	EVT_TOOL( $self, CMD_LOAD,  \&load  );
	# EVT_TOOL( $self, CMD_DEBUG, \&debug );

	# Create the split window with the two panels in it
	my $Splitter = Wx::SplitterWindow->new(
		$self,             # Parent window
		-1,                # Default ID
		wxDefaultPosition, # Normal position
		wxDefaultSize,     # Automatic size
	);
	my $Left  = Wx::Panel->new( $Splitter, -1 );
	my $Right = Wx::Panel->new( $Splitter, -1 );
	$Splitter->SplitVertically( $Left, $Right, 0 );
	$Left->SetSizer(  Wx::BoxSizer->new(wxVERTICAL) );
	$Right->SetSizer( Wx::BoxSizer->new(wxHORIZONTAL) );

	# Create the options checkboxes
	$Left->GetSizer->Add(
		$self->{Option}->{StripWhitespace} = Wx::CheckBox->new(
			$Left,               # Parent panel
			STRIP_WHITESPACE,    # ID
			'Ignore Whitespace', # Label
			wxDefaultPosition,   # Automatic position
			wxDefaultSize,       # Default size
		),
		0,        # Expands vertically
		wxALL,    # Border on all sides
		5,        # Small border area
	);
	$self->{Option}->{StripWhitespace}->SetValue(1);

	# Create the resizer code area on the left side
	$Left->GetSizer->Add(
		$self->{Code} = Wx::TextCtrl->new(
			$Left,                # Parent panel,
			CODE_BOX,             # ID
			$initial_code,        # Help new users get a clue
			wxDefaultPosition,    # Normal position
			wxDefaultSize,        # Minimum size
			wxTE_PROCESS_TAB      # We keep tab presses (not working?)
			| wxTE_MULTILINE,     # Textarea
		),
		1,        # Expands vertically
		wxEXPAND, # Expands horizontally
	);

	# Create the resizing output textbox for the right side
	$Right->GetSizer->Add(
		$self->{Output} = Wx::TextCtrl->new(
			$Right,            # Parent panel,
			-1,                # Default ID
			'',                # Help new users get a clue
			wxDefaultPosition, # Normal position
			wxDefaultSize,     # Minimum size
			wxTE_READONLY      # Output you can't change
			| wxTE_MULTILINE   # Textarea
			| wxHSCROLL,
		),
		1,        # Expands horizontally
		wxEXPAND, # Expands vertically
	);
	$self->{Output}->Enable(1);

	# Set the initial focus
	$self->{Code}->SetFocus;
	$self->{Code}->SetInsertionPointEnd;

	# Enable the sizers
	$Left->SetAutoLayout(1);
	$Right->SetAutoLayout(1);

	# When the user does just about anything, regenerate
	EVT_TEXT( $self, CODE_BOX, \&debug );
	EVT_CHECKBOX( $self, STRIP_WHITESPACE, \&debug);

	$self;
}

# Clear the two test areas
sub clear {
	$_[0]->{Code}->Clear;
	$_[0]->{Output}->Clear;
	return 1;
}

# Load a file
sub load {
	my $self  = shift;
	my $event = shift;

	# Create the file selection dialog
	my $Dialog = Wx::FileDialog->new(
		$self,           # Parent window
		"Select a file", # Message to show on the dialog
		"",              # The default directory
		"",              # The default filename

		# Wildcard. Long and complicated, but very comprehensive
		"Modules(*.pm)|*.pm|perl header(.*ph)|*.ph|*.cgi|*.cgi|perl programs (*.pl)|*.pl|test files (*.t)|*.t|AutoSplit (*.al)|All files (*.*)|*.*",

		# The "Open as Read-Only" means nothing to us (I think)
		wxFD_OPEN, # | wxFD_HIDE_READONLY
	);

	if ( $Dialog->ShowModal == wxID_CANCEL ) {
		# Do nothing if they cancel
	} else {
		my $file = $Dialog->GetPath;
		if ( open INFILE, $file ) {
			# Read the file
			binmode INFILE;
			my $code = join '', <INFILE>;

			# Set the code in the text control
			$self->{Code}->SetInsertionPoint(0);
			$self->{Code}->SetValue( $code );
		} else {
			Wx::LogMessage( "Couldn't open $file : $! " );
		}
	}

	$Dialog->Destroy;
}

# Do a processing run
sub debug {
	my $self   = shift;
	my $source = $self->{Code}->GetValue;
	unless ( $source ) {
		return $self->_error("Nothing to parse");
	}

	# Parse and dump the content
	my $Document = eval { PPI::Document->new( \$source ) };
	if ( ref $@ ) {
		# Dump the exception
		my $dumper = Devel::Dumpvar->new(
			to => 'return',
		) or die "Failed to create dumper";
		my $dumped =  $dumper->dump($@);

		# Chop off the initial "0  " from "0  PPI::Exception"
		$dumped =~ s/^...//;

		return $self->_error( $dumped );
	} elsif ( $@ ) {
		return $self->_error("Uncaught Error!\n  $@");
	} elsif ( ! $Document ) {
		return $self->_error("Failed to parse document");
	}

	# Does the user want to strip whitespace?
	if ( $self->{Option}->{StripWhitespace}->IsChecked ) {
		$Document->prune('PPI::Token::Whitespace');
	}

	# Dump the Document to the dump screen
	my $Dumper = PPI::Dumper->new( $Document, indent => 2 );
	unless ( $Dumper ) {
		return $self->_error("Failed to created PPI::Document dumper");
	}
	my $output = $Dumper->string;
	unless ( $output ) {
		return $self->_error("Dumper failed to generate output");
	}
	$self->{Output}->SetValue( $output );

	# Keep the focus on the code
	$self->{Code}->SetFocus;

	1;
}

sub _error {
	my $self    = shift;
	my $message = join "\n", @_;
	$self->{Output}->SetValue( $message );
	return 1;
}

1;