view release on metacpan or  search on metacpan

lib/PPIx/Grep.pm  view on Meta::CPAN

    } # end if

    return;
} # end _initialize_from_command_line()


sub _handle_info_requests {
    my ($options) = @_;

    if ($options->{help}) {
        _emit_usage_message();

        return 1;
    } # end if

    if ($options->{version}) {
        _emit_version();

        return 1;
    } # end if

    return;
} # end _handle_info_requests()


sub _emit_usage_message {
    print {_get_stderr()} <<'END_USAGE';  ## no critic (RequireCheckedSyscalls)
ppigrep [--match regex] [--format format] PPI-class file [...]

ppigrep { -h | --help | -V | --version }

--format escapes:
    %f – The name of the file.
    %l – The starting line number of the element.
    %c – The starting character within the first line of the element.
    %C – The starting column within the first line of the element.
    %L – The class of the element, with the 'PPI::' prefix removed.
    %s – The source-code/content for the element.
    %S – The source-code/content for the element, C<chomp>ed.
    %W – The source-code/content for the element, whitespace shrunk.

(Note: file argument is required-- STDIN is not yet handled.)
END_USAGE

    return;
} # end _emit_usage_message()

sub _emit_version {
    print {_get_stderr()} <<"END_VERSION";  ## no critic (RequireCheckedSyscalls)
ppigrep $VERSION, Copyright ©2007-2008, Elliot Shank <perl\@galumph.com>.
END_VERSION

    return;
} # end _emit_usage_message()


sub _derive_ppi_classes {
    my ($pattern) = @_;

    my @ppi_classes;
    foreach my $subpattern ( split m/,/xms, $pattern ) {
        my $ppi_class = get_ppi_class($subpattern);
        if (not $ppi_class) {
            print
                {_get_stderr()}
                qq<Could not figure out what PPI::Element subclass to use for "$subpattern".\n>;
            return;
        } # end if

        push @ppi_classes, $ppi_class;
    } # end foreach

    if (not @ppi_classes) {
        print
            {_get_stderr()}
            qq<Could not find any PPI::Element subclasses to use for "$pattern".\n>;

        return;
    } # end if

    return @ppi_classes;
} # end _derive_ppi_classes()


sub _build_query {
    my ($ppi_classes) = @_;

    my $ppi_class;
    if ( 1 == @{$ppi_classes} ) {
        $ppi_class = $ppi_classes->[0]
    } # end if

    if ( my $match = _get_match() ) {
        if ($ppi_class) {
            return sub {
                my (undef, $element) = @_;

                return 0 if not $element->isa($ppi_class);
                return 1 if $element->content() =~ $match;
                return 0;
            };
        } # end if

        return sub {
            my (undef, $element) = @_;

            return 0 if none { $element->isa($_) } @{$ppi_classes};
            return 1 if $element->content() =~ $match;
            return 0;
        };
    } # end if

    return $ppi_class if ($ppi_class);

    return sub {
        my (undef, $element) = @_;

        return 1 if any { $element->isa($_) } @{$ppi_classes};
        return 0;
    };
} # end _build_query()