#!/usr/local/bin/perl
use 5.008;
use strict;
use warnings;
use Getopt::Long 2.33;
use Pod::Usage;
use PPI::Document;
use PPIx::Regexp::Dumper;
use Scalar::Util qw{ refaddr };
our $VERSION = '0.036';
my %opt = (
default_modifiers => [],
verbose => 0,
);
GetOptions( \%opt,
help => sub { pod2usage ( {
-exitval => 0,
-verbose => 2,
-output => \*STDOUT,
} )
},
qw{
default_modifiers|default-modifiers=s@
encoding=s files!
indent=i margin=i objectify! ordinal! perl_version!
significant!
test! tokens! trace+ unescape! verbose+
} )
and @ARGV
or pod2usage( {
-exitval => 2,
-verbose => 1,
-output => \*STDERR,
} );
$opt{default_modifiers} = [ map { split qr{ \s* , \s* }smx } @{
$opt{default_modifiers} } ];
foreach my $re ( process_args( \%opt, @ARGV ) ) {
if ( ! $opt{test} ) {
my @output = ( "\n$re" );
@{ $opt{default_modifiers} }
and push @output, q{default_modifiers => '} . join( ',', @{
$opt{default_modifiers} } ) . q{'};
print join( "\t", @output ), "\n";
@output = item_info( $re )
and print join( "\t", @output ), "\n";
}
PPIx::Regexp::Dumper->new( $re, %opt )->print();
}
{
my @docs; # Have to save reference
my %file;
sub process_args {
my ( $opt, @args ) = @_;
my @rslt;
foreach my $datum ( @args ) {
if ( $opt->{files} ) {
my $doc = PPI::Document->new( $datum, readonly => 1 )
or die "Can not make PPI::Document from file '$datum'\n";
$doc->index_locations();
push @docs, $doc;
push @rslt, extract_res( $doc );
$file{ refaddr( $doc ) } = {
name => $datum,
};
} else {
$opt->{unescape}
and $datum =~ s/ \\\\ /\\/smxg;
if ( $opt->{objectify} ) {
my $doc = PPI::Document->new( \$datum )
or die "Can not make PPI::Document from '$datum'\n";
push @docs, $doc;
push @rslt, extract_res( $doc );
} else {
push @rslt, $datum;
}
}
}
delete $opt->{files};
delete $opt->{objectify};
delete $opt->{unescape};
return @rslt;
}
sub item_info {
my ( $obj ) = @_;
ref $obj
or return;
eval {
$obj->isa( 'PPI::Element' );
} or return;
my $doc = $obj->document()
or return;
my $info = $file{ refaddr $doc }
or return;
return wantarray ?
( $info->{name}, @{ $obj->location() || [] }[0, 2] ) :
$info->{name};
}
}
sub extract_res {
my ( $doc ) = @_;
return (
map { @{ $doc->find( $_ ) || [] } } qw{
PPI::Token::QuoteLike::Regexp
PPI::Token::Regexp::Match
PPI::Token::Regexp::Substitute
}
);
}
__END__
=head1 NAME
predump - Dump a regular expression
=head1 SYNOPSIS
predump 'qr{foo}smx'
predump -ordinal 'm/foo/x'
You can use
predump -help
for full documentation on usage.
=head1 DESCRIPTION
This Perl script parses the regular expression given on its command line
and dumps the results of the parse to standard out. The following
options are recognized:
=over
=item -default-modifiers text
This option specifies default modifiers for the regular expression. You
can specify more than one, either as a comma-separated list or by
specifying the option multiple times, or both. It is simply passed
through to L<< PPIx::Regexp->new()|PPIx::Regexp/new >>.
This option can also be expressed as C<-default_modifiers>.
=item -encoding name
This option specifies the encoding of the regular expression. It is
simply passed through to L<< PPIx::Regexp->new()|PPIx::Regexp/new >>.
=item -files
If true, this option specifies that the arguments are files whose
regular expressions are to be analyzed. If this options is asserted,
C<-objectify> and C<-unescape> are ignored.
=item -indent number
This option specifies the number of spaces to indent each level of the
parse hierarchy. It is simply passed through to
L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new >>.
=item -margin number
This option specifies the width of the left margin of the dump output.
It is simply passed through to
L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new >>.
=item -objectify
If true, this option specifies that the arguments should be made into
L<PPI::Token|PPI::Token> objects before being passed to PPIx::Regexp.
This option is ignored if C<-files> is asserted.
=item -ordinal
If true, this option specifies that the ordinal value of all
L<PPIx::Regexp::Token::Literal|PPIx::Regexp::Token::Literal> objects be
displayed as part of the dump. The default is false. This is simply
passed through to
L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new >>.
=item -perl_version
If true, this option specifies that the dump include the perl version
applicable to each dumped item. The default is false. This is simply
passed through to
L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new >>.
=item -significant
If true, this option specifies that the dump include only significant
syntax elements. That is, no comments or non-significant white space.
The default is false. This is simply passed through to
L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new >>.
=item -test
If true, this option specifies that the dump take the form of a
predefined set of tests be generated for the regular expression. This
option is unsupported in the sense that the author makes no commitment
to what it will do, and reserves the right to change it without notice.
This is simply passed through to
L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new >>.
=item -tokens
If true, this option specifies that only tokenization be done on the
regular expression, and the output tokens dumped to standard out.
This is simply passed through to
L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new >>.
=item -trace
If true, this option specifies the generation of trace output from the
parse. It is unsupported in the sense that the author makes no
commitment to what it will do, and reserves the right to change it
without notice. This is simply passed through to
L<< PPIx::Regexp->new()|PPIx::Regexp/new >>.
=item -unescape
If true, this option causes the argument to be unescaped before
processing. You would use it if the argument is a Perl single-quotish
string, since Perl's single-quoted syntax differs from that of the usual
Unix shell. This option is ignored if C<-files> is asserted.
=item -verbose
If true, this option causes more information to be dumped about each
object produced by the parse. It is unsupported in the sense that the
author makes no commitment to what it will do, and reserves the right to
change it without notice. This is simply passed through to L<<
PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new >>.
=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-2014 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 :