#!/usr/bin/perl use strict; use warnings; use Pod::Usage; use PPIx::Regexp; use PPIx::Regexp::Dumper; use PPIx::Regexp::Util qw{ __instance }; use Term::ReadLine; @ARGV or die "Need an argument.\n"; my $re = PPIx::Regexp->new( $ARGV[0] ) or die PPIx::Regexp->errmsg(); my $obj = $re; my $tr = Term::ReadLine->new( 'Navigate a regular expression' ); my %internal = ( capture_names => sub { defined $obj or return; return join( ', ', map { "'$_'" } $obj->capture_names() ); }, delimiters => sub { defined $obj or return; return join( ', ', map { "'$_'" } $obj->delimiters() ); }, dump => sub { my @args; defined $_[0] and @args = split qr{ \s+ }smx, $_[0]; return PPIx::Regexp::Dumper->new( $obj, @args )->string(); }, help => sub { pod2usage( { -exitval => 'NOEXIT', -verbose => 2, -output => \*STDOUT, } ); return; }, nav => sub { return _safe( $obj->nav() ); }, parse => sub { my $temp = PPIx::Regexp->new( $_[0] ) or return PPIx::Regexp->errstr(); return ( $obj = $re = $temp ); }, reset => sub { return ( $obj = $re ); }, ); sub _safe { my ( @args ) = @_; my $rslt = join ', ', map { ref $_ eq 'ARRAY' ? '[ ' . _safe( @{ $_ } ) . ' ]' : "'$_'" } @args; $rslt =~ s/ \[ \s+ \] /[]/smxg; $rslt =~ s/ ' ( \d+ ) ' /$1/smxg; $rslt =~ s/ \[ \s* ( \d+ ) \s* \] /$1/smxg; $rslt =~ s/ ' ( \w+ ) ', /$1 =>/smxg; return $rslt; } while ( defined ( my $buffer = $tr->readline( 'prenav> ' ) ) ) { $buffer =~ s/ \s+ \z //smx; $buffer or next; $buffer =~ s/ \A \s+ //smx; '#' eq substr $buffer, 0, 1 and next; my ( $method, $arg ) = split qr{\s+}smx, $buffer, 2; 'exit' eq $method and last; my $temp = eval { $internal{$method} ? $internal{$method}->( $arg ) : $obj->$method( $arg ); } or do { if ( $@ ) { warn $@; } else { print "undef\n"; } next; }; print _format( $temp ); __instance( $temp, 'PPIx::Regexp::Element' ) and $obj = $temp; } sub _format { my ( @args ) = @_; my $rslt; foreach my $thing ( @args ) { if ( __instance( $thing, 'PPIx::Regexp::Element' ) ) { $rslt .= $thing->class() . "\t" . $thing->content() . "\n"; } elsif ( ref $thing eq 'ARRAY' ) { $rslt .= _format( @{ $thing } ); } else { $rslt .= $thing =~ m/ \n /smx ? $thing : $thing =~ m/ \A ' /smx ? "$thing\n" : $thing =~ m/ \D /smx ? "'$thing'\n" : "$thing\n"; } } return $rslt; } __END__ =head1 NAME prenav - Navigate a PPIx::Regexp parse tree =head1 SYNOPSIS prenav 's/(\w+)/\u$1/g' prenav> find_first Token::CharClass::Simple PPIx::Regexp::Token::CharClass::Simple \w prenav> dump verbose 1 PPIx::Regexp::Token::CharClass::Simple '\\w' significant can_be_quantified prenav> parent PPIx::Regexp::Structure::Capture (\w+) prenav> exit =head1 DESCRIPTION This script takes as its argument a string to be parsed as a regular expression, and prompts the user for navigation commands. A navigation command is any method that returns another element in the parse tree. Unless documented otherwise, all commands apply to the current object. Initially the current object is the L<PPIx::Regexp|PPIx::Regexp> object generated by the parse. Once a navigation command is issued, the object navigated to becomes the current object. If the navigation command does not specify an object (e.g. C<child 5> when the current object has fewer than 5 children) the current object remains unchanged. In addition to the navigation methods, any method that returns a scalar value can be used as a command. The value returned will be displayed. In addition to all the above, the following commands are recognized: =over =item capture_names This command wraps the L<< PPIx::Regexp->capture_names()|PPIx::Regexp/capture_names >> method, joining the results into a comma-delimited string. =item dump This command dumps the current object. Options to L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new> may be specified as arguments to the command. See the L<SYNOPSIS|/SYNOPSIS> for an example. =item exit This comamnd terminates the script. =item help This command displays this documentation. =item nav nav This command displays the method calls and arguments needed to navigate from the root of the parse tree to the current object. Yes, this is a perfectly good method, but we wrap the results of that method in some semi-nice formatting. Any arguments are ignored =item parse parse s/ ( \w+ ) foo \1 /bar/smx This command provides another regular expression to parse. If the parse succeeds, the previous regular expression is abandoned, and the new L<PPIx::Regexp|PPIx::Regexp> object becomes the current object. The new regular expression is taken to be everything on the line after the whit espace after the word C<parse>. It should B<not> be quoted. =item reset This command selects the top-level object as the current object. The C<top> command does the same thing, but C<top> does it by running through the parent chain, where C<reset> simply slam-dunks the retained L<PPIx::Regexp|PPIx::Regexp> object. =back =head1 SUPPORT Support is by the author. Please file bug reports at L<http://rt.cpan.org>, or in electronic mail to the author. =head1 AUTHOR Thomas R. Wyant, III F<wyant at cpan dot org> =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2011 by Thomas R. Wyant, III This program is free software; you can redistribute it and/or modify it under the same terms as Perl 5.10.0. For more details, see the full text of the licenses in the directory LICENSES. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =cut # ex: set textwidth=72 :