view release on metacpan or  search on metacpan

meta/FunctionalPerl/Dependencies/ChjBin.pm  view on Meta::CPAN

    use Test::Requires +{
        'FunctionalPerl::Dependencies::ChjBin' => '"trigger-listen"' };
    # or
    #  list in FunctionalPerl::Dependencies's %dependencies

=head1 DESCRIPTION

A way to specify dependencies on tools from
L<chj-bin|https://github.com/pflanze/chj-bin> to the test system.

=head1 SEE ALSO

L<FP::Repl::Dependencies>, L<FunctionalPerl::Dependencies>

=head1 NOTE

This is alpha software! Read the status section in the package README
or on the L<website|http://functional-perl.org/>.

=cut

package FunctionalPerl::Dependencies::ChjBin;

use strict;
use warnings;
use warnings FATAL => 'uninitialized';

use FP::Carp;

# XX use ~FP::Memoize instead, but that one should be split into
# in-memory and disk versions.

sub simple_memoize {
    @_ == 2 or fp_croak_arity 2;
    my ($cacheref, $fn) = @_;    # cacheref must be a hash ref
    sub {
        @_ == 1 or fp_croak_arity 1;

        # only one argument supported, and argument must be a string,
        # or identical with regards of that string. And only does
        # scalar context for the result.
        my ($arg) = @_;
        exists $cacheref->{$arg} ? $cacheref->{$arg} : do {
            my $v = $fn->($_[0]);
            $cacheref->{$arg} = $v;
            $v
        }
    }
}

# Calling out to the `which` utility apparently spams the terminal
# with messages even on some "GNU/Linux" distros. D'uh. So go full
# Perl. Don't want to depend on https://metacpan.org/pod/File::Which,
# and we don't need Windows support as chj-bin is Unix only (really
# Linux only?) anyway. (Should we return undef on non-Linux $^O? No,
# nobody should be installing chj-bin if it doesn't work? Not sure.)

sub _maybe_which {
    my ($str)  = @_;
    my ($prog) = $str =~ /^([\w_.-]+)\z/s or die "invalid progname '$str'";
    my $paths  = [grep { length $_ } split m{:}, $ENV{PATH} // ""];
    for my $path (@$paths) {
        my $progpath = "$path/$prog";
        return $progpath if (-f $progpath and -x _);
    }
    undef
}

my %which;

sub maybe_which;
*maybe_which = simple_memoize \%which, \&_maybe_which;

use Chj::IO::Command;
use Chj::xperlfunc ":all";

my %dir_is_chjbin;

sub dir_is_chjbin;
*dir_is_chjbin = simple_memoize \%dir_is_chjbin, sub {
    my ($dirpath) = @_;

    # using combinedsender just to silence stderr, ok?
    my $in = Chj::IO::Command->new_combinedsender(
        sub {
            xchdir $dirpath;
            use Cwd;
            warn "really checking " . getcwd;
            xexec "git", "remote", "-v"
        }
    );
    my $cnt = $in->xcontent;
    if (0 == $in->xfinish) {

        # OH, must accept _bin, too, my special habit. So ugly.
        (
                   $cnt =~ m{/github\.com/[^/]+/chj-bin(?:\.git)?/? }
                or $cnt =~ m{/_bin/\.git}
        )
    } else {
        undef
    }
};

sub path_is_chjbin {
    my ($path) = @_;
    dir_is_chjbin dirname $path
}

sub import {
    my $class = shift;

    # my ($package, $filename, $line) = caller;
    my (@programs) = @_;
    my @which        = map  { [$_, maybe_which $_] } @programs;
    my @_found       = grep { defined $_->[1] } @which;
    my @_notfound    = map  { $_->[0] } grep { not defined $_->[1] } @which;
    my @found_really = grep { path_is_chjbin $_->[1] } @_found;
    my @found_notfound
        = map { $_->[0] } grep { !path_is_chjbin $_->[1] } @_found;