view release on metacpan or  search on metacpan

lib/FindApp/Object/Behavior.pm  view on Meta::CPAN

            $dir ne "/";
            $dir = dirname($dir))
    {
        return $dir if $self->path_passes_constraints($dir);
    }
    $self->reset_origin;
    return;

}

# Takes a directory argument and makes sure that everything
# wanted can be found in any of the allowed (sub)directories.
# Returns a boolean success value.
sub path_passes_constraints { &ENTER_TRACE;
    my $self = &myself;
    my($candidate_dir) = @_;

    $self->reset_all_groups;

    my %groups  = %{ $self->group };
    my @groups  = delete $groups{root};
    push @groups, values %groups;

    for my $group (@groups) {
        next if $group->base_has_wanteds($candidate_dir);
        $self->reset_all_groups;
        return;
    }

    return 1;
}

sub reset_all_groups {
    my $self = &myself;
    $_->found->reset for values %{ $self->group };
}

################################################################
# Misc methods.

sub shell_settings {
    my $self = &myself;
    return q() unless $self->has_app_root;
    return join q() => (
        $self->show_shell_var(APP_ROOT => $self->app_root),
        $self->show_shell_var(PERL5LIB => $self->libdirs),
        $self->show_shell_var(PATH     => $self->bindirs),
        $self->show_shell_var(MANPATH  => $self->mandirs),
    );
}

sub show_shell_var {
    &all_args_defined;
    my $self = &myself;
    state $poly = { map { $_ => 1 } qw(PERL5LIB PATH MANPATH) };
    my($varname, @dirs) = @_;
    $varname =~ /^\w+$/         || croak "$varname doesn't look like a good shell variable name";
    my $retstr = q();
    if (@dirs) {
        $retstr  = is_csh()
                    ? "setenv $varname "
                    : "export $varname=" ;
        push(@dirs, '$' . $varname)  if $$poly{$varname};
        $retstr .= sprintf qq{"%s";\n}, colonize @dirs;
    }
    return $retstr;
}

#################################################################
# BUILDERS
#################################################################

# All generated functions are given proper names, thus allowing for
# not merely "not-from-hell" stack traces, but even better, letting you
# breakpoint and even list them in the debugger.  The builders are
# all written in a way to make it utterly clear which lexicals are
# being accessed from outside the closure's scope.  These are really
# paramerized function-building templates, like macros, and so $ALL_CAPS
# is used for the template "arguments"; that is, the stuff outside
# our scope that we are relying inside the closure.

no namespace::clean;

sub generate_helper_methods {
    my $class = shift || __PACKAGE__;
    my @_SUBDIRS = +BLM;
    my @_ALLDIRS = (root => @_SUBDIRS);

    for my $DIR (@_ALLDIRS) {
        # BUILD: export_bin_to_env
        # BUIOD: export_lib_to_env
        # BUIOD: export_man_to_env
        # BUIOD: export_root_to_env
        function "export_${DIR}_to_env" => sub { &ENTER_TRACE;
            my $self = &myself;
            good_args(@_ == 0);
            $self->group($DIR)->export_to_env;
        };
        # BUILD: bindirs libdirs mandirs rootdirs
        function "${DIR}dirs" => sub {
            my $self = &myself;
            good_args(@_ == 0);
            my $group = $self->group($DIR);
            return wantarray ? $group->found : $group;
        };
        *rootdir = \&rootdirs;

        my $is_pl    = $DIR ne "root";
        my $NAMEDIR  = $DIR . "dir" . ($is_pl && "s");
        my $has_have = $is_pl ? "have" : "has";
        my $is_are   = $is_pl ? "are"  : "is";

        my %access_verb = (
            wanted  => $has_have,
            allowed => $is_are,
        );

        while (my($ACCESSOR, $VERB) = each %access_verb) {
            print "making ${NAMEDIR}_${VERB}\n";
            function $NAMEDIR . "_" . $VERB => sub {
                my $self = &myself;