File Coverage

blib/lib/PPI/Tester.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package PPI::Tester;
2              
3             # The PPI Tester application
4              
5 1     1   1575 use 5.006;
  1         4  
  1         43  
6 1     1   5 use strict;
  1         1  
  1         49  
7 1     1   1011 use PPI 1.000 ();
  1         162098  
  1         34  
8 1     1   903 use PPI::Dumper 1.000 ();
  1         1268  
  1         29  
9 1     1   1096 use Devel::Dumpvar 0.04 ();
  1         2120  
  1         29  
10 1     1   473 use Wx 0.85 ();
  0            
  0            
11              
12             use vars qw{$VERSION};
13             BEGIN {
14             $VERSION = '0.15';
15             }
16              
17             sub main {
18             my $class = shift;
19             my $app = $class->new;
20             unless ( $app ) {
21             croak("Failed to load PPI Tester application");
22             }
23             $app->MainLoop;
24             exit(0);
25             }
26              
27             sub new {
28             PPI::Tester::App->new;
29             }
30              
31              
32              
33              
34              
35             #####################################################################
36             # The main application class
37              
38             package PPI::Tester::App;
39              
40             our @ISA = 'Wx::App';
41              
42             use constant APPLICATION_NAME => "PPI Tester $PPI::Tester::VERSION - PPI $PPI::VERSION";
43              
44             sub OnInit {
45             my $self = shift;
46             $self->SetAppName(APPLICATION_NAME);
47              
48             # Create the one and only frame
49             my $frame = PPI::Tester::Window->new(
50             undef, # Parent Window
51             -1, # Id
52             APPLICATION_NAME, # Title
53             [-1, -1], # Default size
54             [-1, -1], # Default position
55             );
56             $frame->CentreOnScreen;
57              
58             # Set it as the top window and show it
59             $self->SetTopWindow($frame);
60             $frame->Show(1);
61              
62             # Do an initial parse
63             $frame->debug;
64              
65             return 1;
66             }
67              
68              
69              
70              
71              
72             #####################################################################
73             # The main window for the application
74              
75             package PPI::Tester::Window;
76              
77             our @ISA = 'Wx::Frame';
78              
79             use Wx qw{ :everything };
80             use Wx qw{ wxHIDE_READONLY };
81             use Wx::Event qw{ EVT_TOOL EVT_TEXT EVT_CHECKBOX };
82              
83             # wxWindowIDs
84             use constant CMD_CLEAR => 1;
85             use constant CMD_LOAD => 2;
86             use constant CMD_DEBUG => 3;
87             use constant CODE_BOX => 4;
88             use constant STRIP_WHITESPACE => 5;
89              
90             my $initial_code = '';
91              
92             sub new {
93             my $class = shift;
94             my $self = $class->SUPER::new(@_);
95              
96             # Use the pretty Wx icon
97             $self->SetIcon( Wx::GetWxPerlIcon() );
98              
99             # Create and populate the toolbar
100             $self->CreateToolBar( wxNO_BORDER | wxTB_HORIZONTAL | wxTB_TEXT | wxTB_NOICONS );
101             $self->GetToolBar->AddTool( CMD_CLEAR, 'Clear', wxNullBitmap );
102             $self->GetToolBar->AddTool( CMD_LOAD, 'Load', wxNullBitmap );
103             # $self->GetToolBar->AddSeparator;
104             # $self->GetToolBar->AddTool( CMD_DEBUG, 'Debug', wxNullBitmap );
105             $self->GetToolBar->Realize;
106              
107             # Bind the events for the toolbar
108             EVT_TOOL( $self, CMD_CLEAR, \&clear );
109             EVT_TOOL( $self, CMD_LOAD, \&load );
110             # EVT_TOOL( $self, CMD_DEBUG, \&debug );
111              
112             # Create the split window with the two panels in it
113             my $Splitter = Wx::SplitterWindow->new(
114             $self, # Parent window
115             -1, # Default ID
116             wxDefaultPosition, # Normal position
117             wxDefaultSize, # Automatic size
118             );
119             my $Left = Wx::Panel->new( $Splitter, -1 );
120             my $Right = Wx::Panel->new( $Splitter, -1 );
121             $Splitter->SplitVertically( $Left, $Right, 0 );
122             $Left->SetSizer( Wx::BoxSizer->new(wxVERTICAL) );
123             $Right->SetSizer( Wx::BoxSizer->new(wxHORIZONTAL) );
124              
125             # Create the options checkboxes
126             $Left->GetSizer->Add(
127             $self->{Option}->{StripWhitespace} = Wx::CheckBox->new(
128             $Left, # Parent panel
129             STRIP_WHITESPACE, # ID
130             'Ignore Whitespace', # Label
131             wxDefaultPosition, # Automatic position
132             wxDefaultSize, # Default size
133             ),
134             0, # Expands vertically
135             wxALL, # Border on all sides
136             5, # Small border area
137             );
138             $self->{Option}->{StripWhitespace}->SetValue(1);
139              
140             # Create the resizer code area on the left side
141             $Left->GetSizer->Add(
142             $self->{Code} = Wx::TextCtrl->new(
143             $Left, # Parent panel,
144             CODE_BOX, # ID
145             $initial_code, # Help new users get a clue
146             wxDefaultPosition, # Normal position
147             wxDefaultSize, # Minimum size
148             wxTE_PROCESS_TAB # We keep tab presses (not working?)
149             | wxTE_MULTILINE, # Textarea
150             ),
151             1, # Expands vertically
152             wxEXPAND, # Expands horizontally
153             );
154              
155             # Create the resizing output textbox for the right side
156             $Right->GetSizer->Add(
157             $self->{Output} = Wx::TextCtrl->new(
158             $Right, # Parent panel,
159             -1, # Default ID
160             '', # Help new users get a clue
161             wxDefaultPosition, # Normal position
162             wxDefaultSize, # Minimum size
163             wxTE_READONLY # Output you can't change
164             | wxTE_MULTILINE # Textarea
165             | wxHSCROLL,
166             ),
167             1, # Expands horizontally
168             wxEXPAND, # Expands vertically
169             );
170             $self->{Output}->Enable(1);
171              
172             # Set the initial focus
173             $self->{Code}->SetFocus;
174             $self->{Code}->SetInsertionPointEnd;
175              
176             # Enable the sizers
177             $Left->SetAutoLayout(1);
178             $Right->SetAutoLayout(1);
179              
180             # When the user does just about anything, regenerate
181             EVT_TEXT( $self, CODE_BOX, \&debug );
182             EVT_CHECKBOX( $self, STRIP_WHITESPACE, \&debug);
183              
184             $self;
185             }
186              
187             # Clear the two test areas
188             sub clear {
189             $_[0]->{Code}->Clear;
190             $_[0]->{Output}->Clear;
191             return 1;
192             }
193              
194             # Load a file
195             sub load {
196             my $self = shift;
197             my $event = shift;
198              
199             # Create the file selection dialog
200             my $Dialog = Wx::FileDialog->new(
201             $self, # Parent window
202             "Select a file", # Message to show on the dialog
203             "", # The default directory
204             "", # The default filename
205              
206             # Wildcard. Long and complicated, but very comprehensive
207             "Modules(*.pm)|*.pm|perl header(.*ph)|*.ph|*.cgi|*.cgi|perl programs (*.pl)|*.pl|test files (*.t)|*.t|AutoSplit (*.al)|All files (*.*)|*.*",
208              
209             # The "Open as Read-Only" means nothing to us (I think)
210             wxFD_OPEN, # | wxFD_HIDE_READONLY
211             );
212              
213             if ( $Dialog->ShowModal == wxID_CANCEL ) {
214             # Do nothing if they cancel
215             } else {
216             my $file = $Dialog->GetPath;
217             if ( open INFILE, $file ) {
218             # Read the file
219             binmode INFILE;
220             my $code = join '', ;
221              
222             # Set the code in the text control
223             $self->{Code}->SetInsertionPoint(0);
224             $self->{Code}->SetValue( $code );
225             } else {
226             Wx::LogMessage( "Couldn't open $file : $! " );
227             }
228             }
229              
230             $Dialog->Destroy;
231             }
232              
233             # Do a processing run
234             sub debug {
235             my $self = shift;
236             my $source = $self->{Code}->GetValue;
237             unless ( $source ) {
238             return $self->_error("Nothing to parse");
239             }
240              
241             # Parse and dump the content
242             my $Document = eval { PPI::Document->new( \$source ) };
243             if ( ref $@ ) {
244             # Dump the exception
245             my $dumper = Devel::Dumpvar->new(
246             to => 'return',
247             ) or die "Failed to create dumper";
248             my $dumped = $dumper->dump($@);
249              
250             # Chop off the initial "0 " from "0 PPI::Exception"
251             $dumped =~ s/^...//;
252              
253             return $self->_error( $dumped );
254             } elsif ( $@ ) {
255             return $self->_error("Uncaught Error!\n $@");
256             } elsif ( ! $Document ) {
257             return $self->_error("Failed to parse document");
258             }
259              
260             # Does the user want to strip whitespace?
261             if ( $self->{Option}->{StripWhitespace}->IsChecked ) {
262             $Document->prune('PPI::Token::Whitespace');
263             }
264              
265             # Dump the Document to the dump screen
266             my $Dumper = PPI::Dumper->new( $Document, indent => 2 );
267             unless ( $Dumper ) {
268             return $self->_error("Failed to created PPI::Document dumper");
269             }
270             my $output = $Dumper->string;
271             unless ( $output ) {
272             return $self->_error("Dumper failed to generate output");
273             }
274             $self->{Output}->SetValue( $output );
275              
276             # Keep the focus on the code
277             $self->{Code}->SetFocus;
278              
279             1;
280             }
281              
282             sub _error {
283             my $self = shift;
284             my $message = join "\n", @_;
285             $self->{Output}->SetValue( $message );
286             return 1;
287             }
288              
289             1;
290              
291             =pod
292              
293             =head1 NAME
294              
295             PPI::Tester - A wxPerl-based interactive PPI debugger/tester
296              
297             =head1 DESCRIPTION
298              
299             This package implements a wxWindows desktop application which provides the
300             ability to interactively test the PPI perl parser.
301              
302             The C module implements the application, but is itself of no
303             use to the user. The launcher for the application 'ppitester' is installed
304             with this module, and can be launched by simply typing the following from
305             the command line.
306              
307             ppitester
308              
309             When launched, the application consists of two vertical panels. The left
310             panel is where you should type in your code sample. As the left hand panel
311             is changed, a PPI::Dumper output is continuously updated in the right
312             hand panel.
313              
314             There is a toolbar at the top of the application with two icon buttons,
315             currently without icons. The first toolbar button clears the panels, the
316             second is a placeholder for loading in code from a file, and is not yet
317             implemented. ( It's early days yet for this application ).
318              
319             =head1 TO DO
320              
321             - There are no icons on the toolbar buttons
322              
323             - An option is needed to save both the left and right panels into
324             a matching pair of files, compatible with the lexer testing script.
325              
326             =head1 SUPPORT
327              
328             To file a bug against this module, in a way you can keep track of, see the CPAN
329             bug tracking system.
330              
331             L
332              
333             For general comments, contact the maintainer.
334              
335             =head1 AUTHOR
336              
337             Adam Kennedy Eadamk@cpan.orgE
338              
339             =head1 SEE ALSO
340              
341             L, L
342              
343             =head1 COPYRIGHT
344              
345             Copyright 2004 - 2009 Adam Kennedy.
346              
347             This program is free software; you can redistribute
348             it and/or modify it under the same terms as Perl itself.
349              
350             The full text of the license can be found in the
351             LICENSE file included with this module.
352              
353             =cut