#!/usr/local/bin/perl
use 5.006;
use strict;
use warnings;
use Getopt::Long 2.33;
use Pod::Usage;
use PPI::Document;
use PPIx::Regexp::Dumper;
use Scalar::Util qw{ refaddr };
use vars qw{ $VERSION };
$VERSION = '0.057';
my %opt = (
default_modifiers => [],
verbose => 0,
);
GetOptions( \%opt,
help => sub { pod2usage ( {
-exitval => 0,
-verbose => 2,
-output => \*STDOUT,
} )
},
'guess!' => \&set_parse,
'regex!' => \&set_parse,
'string!' => \&set_parse,
qw{
default_modifiers|default-modifiers=s@
encoding=s explain! files!
indent=i margin=i objectify! ordinal! perl_version!
postderef! significant! strict!
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, $opt );
$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, $opt );
} 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};
}
}
{
my ( %classes, @regex, @string );
BEGIN {
@regex = qw{
PPI::Token::QuoteLike::Regexp
PPI::Token::Regexp::Match
PPI::Token::Regexp::Substitute
};
@string = qw{
PPI::Token::Quote
PPI::Token::QuoteLike::Command
PPI::Token::QuoteLike::BackTick
PPI::Token::HereDoc
};
%classes = (
guess => [ @regex, @string ],
regex => \@regex,
string => \@string,
);
}
sub extract_res {
my ( $doc, $opt ) = @_;
my $parse = $opt->{parse} || 'regex';
return (
map { @{ $doc->find( $_ ) || [] } } @{
$classes{$parse} || $classes{regex} }
);
}
}
sub set_parse {
my ( $opt, $assert ) = @_;
if ( $assert ) {
$opt{parse} = "$opt";
} else {
delete $opt{parse};
}
return;
}
__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 -guess
If true, this option specifies that the parser guess whether the
argument is to be parsed as a regex or a string. If false, it specifies
the default parse, which is as a regex. If more than one of C<-guess>,
C<-regex> and C<-string> is specified, the last one parsed (normally the
C<-string> are specified, the last specification parsed (normally the
rightmost one) wins.
The default is C<-noguess>, which specifies the default parse.
=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 -postderef
If true, this option specifies that postfix dereferences are recognized
in code and interpolations. If false (specified as C<-nopostderef>) they
are not recognized. For the default see the documentation for the
tokenizer's L<new()|PPIx::Regexp::Tokenizer/new> method.
=item -regex
If true, this option specifies that the parser parse the argument as a
regex. If false, it specifies the default parse, which is as a regex,
so this option is unnecessary unless the default parse changes. If more
than one of C<-guess>, C<-regex> and C<-string> is specified, the last
one parsed (normally the C<-string> are specified, the last
specification parsed (normally the rightmost one) wins.
The default is C<-noregex>, which specifies the default parse.
=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 -string
If true, this option specifies that the argument be parsed as a string,
not a regex. If false, it specifies the default parse, which is as a
regex. If more than one of C<-guess>, C<-regex> and C<-string> is
specified, the last one parsed (normally the C<-string> are specified,
the last specification parsed (normally the rightmost one) wins.
The default is C<-nostring>, which specifies the default parse.
=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-2018 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 :