view release on metacpan or  search on metacpan

lib/App/BoolFindGrep/CLI.pm  view on Meta::CPAN

    my $pairs = shift;

    foreach my $keys ( @{$pairs} ) {
        my @key = @{$keys};
        if ( @key == ( grep { exists $self->args->{$_} } @key ) ) {
            $self->_msg( sprintf q('--%s' and '--%s' ) . $msg, @key );
            return;
        }
    }

    return 1;
} ## end sub _mutually_exclusive_checker

sub _empty_value_checker {
    my $self = shift;
    my $msg  = shift;
    my $keys = shift;

    foreach my $key ( @{$keys} ) {
        next unless exists $self->args->{$key};
        my $ref = ref $self->args->{$key} || q();
        my @value;
        if    ( $ref eq q() )      { @value = $self->args->{$key}; }
        elsif ( $ref eq q(ARRAY) ) { @value = @{ $self->args->{$key} }; }
        else                       { die; }

        if ( ( grep { $_ eq q() } @value ) != 0 ) {
            $self->_msg( sprintf q('--%s': ) . $msg, $key );
            return;
        }
    }

    return 1;
} ## end sub _empty_value_checker

sub _implies_checker {
    my $self    = shift;
    my $msg     = shift;
    my $implies = shift;

    foreach my $imply ( @{$implies} ) {
        foreach my $key ( keys %{$imply} ) {
            next unless exists $self->args->{$key};
            foreach my $skey ( @{ $imply->{$key} } ) {
                unless ( exists $self->args->{$skey} ) {
                    $self->_msg( sprintf q('--%s' %s '--%s' option.),
                        $key, $msg, $skey );
                    return;
                }
            }
        }
    }

    return 1;
} ## end sub _implies_checker

sub _files_from_checker {
    my $self  = shift;
    my $value = shift;

    my $parameter = ( split m{::_(\S+)_checker\z}msx, ( caller 0 )[3] )[-1];

    my $msg;
    foreach ($value) {
        if ( !/\A(?:-|stdin)\z/i ) {
            if ( !-e ) {
                $msg = sprintf q('--%s' => nonexistent file '%s'.),
                    $parameter, $value;
            }
            elsif ( !-f ) {
                $msg = sprintf q('--%s' => irregular file '%s'.),
                    $parameter, $value;
            }
            elsif ( !-r ) {
                $msg = sprintf q('--%s' => unreadable file '%s'.),
                    $parameter, $value;
            }
            elsif (-z) {
                $msg = sprintf q('--%s' => empty file '%s'.),
                    $parameter, $value;
            }
        } ## end if ( !/\A(?:-|stdin)\z/i)
    } ## end foreach ($value)

    if ( defined $msg ) { $self->_msg($msg); return; }

    $self->args->{files_delim} = qq(\N{LINE FEED});

    return 1;
} ## end sub _files_from_checker

sub _find_type_checker {
    my $self  = shift;
    my $value = shift;

    my $parameter = ( split m{::_(\S+)_checker\z}msx, ( caller 0 )[3] )[-1];
    my %type = (
        glob    => 1,    #
        literal => 1,    #
        regexp  => 1,    #
    );

    unless ( exists $type{$value} ) {
        $self->_msg( sprintf q('--%s' => argument invalid '%s'.),
            $parameter, $value );
        return;
    }

    return 1;
} ## end sub _find_type_checker

sub _directory_checker {
    my $self   = shift;
    my $values = shift;

    my $parameter = ( split m{::_(\S+)_checker\z}msx, ( caller 0 )[3] )[-1];

    my $msg;
    foreach ( @{$values} ) {
        if ( !-e ) {
            $msg = sprintf q('--%s' => nonexistent directory '%s'.),
                $parameter, $_;
        }
        elsif ( !-d ) {
            $msg = sprintf q('--%s' => non-directory argument '%s'.),
                $parameter, $_;
        }
        elsif ( !-r ) {
            $msg = sprintf q('--%s' => unreadable directory '%s'.),
                $parameter, $_;
        }
        if ( defined $msg ) { $self->_msg($msg); return; }
    } ## end foreach ( @{$values} )

    return 1;
} ## end sub _directory_checker

sub _msg {
    my $self = shift;
    my $msg  = shift;

    say STDERR sprintf q(%s: %s), $PROGRAM_NAME, $msg;
    say STDERR sprintf q(Try '%s --help' for more information.),
        $PROGRAM_NAME;

    return 1;
}

no Moo;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding utf8

=head1 NAME

App::BoolFindGrep::CLI - Command Line Interface functions.

=head1 VERSION

version 0.06

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 METHODS

=head2 args

Hash reference with command line arguments.