view release on metacpan or  search on metacpan

support/cmdline.yp  view on Meta::CPAN

                |   --all
                |   --(?:branches|tags|remotes)(?:=.+)?
                |   --(?:glob|exclude)=.+
                |   --disambiguate=[0-9a-f]{4,40}

                    # git-rev-parse "Other Options" forms
                |   --(since|after|until|before)=.+

            )$) # End of RevRange

            (?<Rev> (?&Ref)(?&RefTrailer)* )
                    # This handles most of the cases.
                    # SHA1s, possibly abbreviated, are refs,
                    # as are git-describe outputs, whence RefTrailer*
                    # instead of RefTrailer+.

            (?<RefTrailer>
                    # For rev^[#] and rev~[#] forms
                    [~\^]\d*

                    # For rev^{} forms (empty braces OK)
                |   \^\{[^\}]*\}

                    # For rev^[@!] and rev^-n
                |   \^(?: \@ | ! | -\d* )
            ) # End of RefTrailer

            (?<Ref>
                (   \@      # '@' from git-rev-parse
                |   (?:[^\000-\037\177\ ~\^:\\?*\[.@/]
                            # git-check-ref-format #4, #5.
                            # [.@/] are handled below
                    | \.(?!\.)  # . ok, but .. prohibited
                    | \@(?!\{)  # @ ok, but @{ prohibited
                    | /(?!/)    # / ok, but // prohibited

                    )+?
                )
                (?(?{ _is_ref_ok($+) })|(?!))
                    # NOTE: $+ used since I couldn't get named capture groups
                    # with either %+ or %- to work
            ) # End of <Ref>

        ) #End of (DEFINE)

    `xi; # End of qr`...` and an extra backtick to unconfuse vim-eyapp: `

sub _is_valid_rev {
    my $arg = @_ ? $_[0] : $_;

    return false unless defined $arg and length($arg)>0;
    return scalar($arg =~ m{$_rev_regex});
} #_is_valid_rev()

# Get an expression element from the array passed in $_[0].
my $ARGTEST_cached = App::GitFind::Actions::ARGTEST();
sub _consume_expression_element {
    my $lrArgv = shift;
    my @retval;

    #say STDERR "# Trying >>$lrArgv->[0]<<";
    # TODO find(1) positional options, global options?

    # Regular options
    if($lrArgv->[0] =~ $ARGTEST_cached) {
        #say STDERR "#   - matched";
        my $arg = $1;
        my %opts = %{App::GitFind::Actions::argdetails($arg)};

        # Save any non-parser information from the argdetails to be
        # returned as part of the semantic value.
        my %extras = %opts;
        delete @extras{qw(token nparam)};

        # No-argument tests or actions
        unless($opts{nparam}>0) {
            #say STDERR "#   - No parameters";
            shift @$lrArgv;
            return ($opts{token} => { name => $arg, %extras })
        }

        # Consume additional arguments up to a regexp
        if(ref $opts{nparam} eq 'Regexp') {
            #say STDERR "#   - parameters until $opts{nparam}";
            die "Need argument(s) for --$arg" if @$lrArgv == 1;
            my $lastarg;
            #say STDERR "Args: ", join ' : ', @$lrArgv;
            for(1..$#$lrArgv) {
                $lastarg=$_, last if $lrArgv->[$_] =~ $opts{nparam};
            }
            die "--$arg needs an argument terminator matching $opts{nparam}"
                unless defined $lastarg;

            # Set up to fall through to the numeric-params case
            $opts{nparam} = $lastarg;
        }

        # Consume additional positional arguments
        #say STDERR "#   - $opts{nparam} parameters";
        die "Not enough parameters after --$arg (need $opts{nparam})"
            unless @$lrArgv >= ($opts{nparam}+1);   # +1 for $arg itself

        # Custom argument validation
        if($opts{validator}) {
            my $errmsg = $opts{validator}->(@{$lrArgv}[0..$opts{nparam}]);
            die "--$arg argument error: $errmsg" if defined($errmsg);
        }

        @retval = ($opts{token} => {
                        name => $arg,
                        params => [ @{$lrArgv}[1..$opts{nparam}] ],
                        %extras,
                    });
        splice @$lrArgv, 0, $opts{nparam}+1;
        return @retval;
    }

    # Operators
    my $arg = $lrArgv->[0];

    @retval = (COMMA => ',') if $arg eq ',';
    @retval = (OR => '-o') if $arg =~ /^(?:-o|--o|-or|--or|\|\|)$/;
    @retval = (AND => '-a') if $arg =~ /^(?:-a|--a|-and|--and|&&)$/;
    @retval = (NOT => '!') if $arg =~ /^(?:-not|--not|!|\^)$/;
    @retval = (LPAREN => '(') if $arg =~ /^[([]$/;
    @retval = (RPAREN => ')') if $arg =~ /^[])]$/;

    if(@retval) {
        shift @$lrArgv;
        return @retval;
    }

    return ();  # Not an expression element
} #_consume_expression_element

# Get a switch from the array passed in $_[0], if any.
# Removes the switch from the array if successful.
# Returns the token on success, and () on failure.
# TODO un-bundle switches; handle switches with args.
sub _consume_switch {
    my $lrArgv = shift;
    if($lrArgv->[0] =~ /^-([a-zA-z0-9\?])$/) {    # non-bundled switch
        shift @$lrArgv;
        return (SWITCH => $1)
    } elsif($lrArgv->[0] =~ /^--?(help|man|usage|version)$/) {  # long switch
        shift @$lrArgv;
        return (SWITCH => $1);
    }

    return ();
} #_consume_switch()

# Consume a rev from the array in $_[0]
sub _consume_rev {
    my $lrArgv = shift;
    my $arg = $lrArgv->[0];
    if(_is_valid_rev($arg)) {
        shift @$lrArgv;
        return (REV => $arg);