Toolkit - Keep your handy modules organized

    use Toolkit;

    # All your favorites are now available 

  

    use strict;
    use warnings;
    use Carp;
    use Smart::Comments;

    use Toolkit;

    > cat $PERL5LIB/Toolkit/Macros/ALWAYS/Modules

    use strict;
    use warnings;
    use Carp;
    use Smart::Comments;

    > cat $PERL5LIB/Toolkit/Runtime/prompt

    use IO::Prompt qw( prompt );

    > cat $PERL5LIB/Toolkit/Runtime/say

    sub say { print @_, "\n" }

    use Toolkit;

    $PERL5LIB/Toolkit/Macros/ALWAYS/
    $PERL5LIB/Toolkit/Macros/DEFAULT/

    use Toolkit qw(foo bar);

    $PERL5LIB/Toolkit/Macros/ALWAYS/
    $PERL5LIB/Toolkit/Macros/foo/
    $PERL5LIB/Toolkit/Macros/bar/

    $PERL5LIB/Toolkit/Runtime/

    use Toolkit;

    baz();

    $PERL5LIB/Toolkit/Runtime/baz

package Toolkit;

use version; $VERSION = qv('0.0.2');

use warnings;
use strict;
use Carp;

use File::Spec::Functions qw( catfile splitpath );
use Filter::Simple;

sub _uniq {
    my %seen;
    return grep { !$seen{$_}++ } @_;
}

# Read in an entire file given the filename...
sub _slurp {
    my ($file_path) = @_;

    open my $fh, '<', $file_path
        or croak "Toolkit couldn't open $file_path\n$!";

    local $/;
    return <$fh>;
}

# Cache of module names using this module
my @callers;

my @MANDATORY_KITS = qw(ALWAYS);
my @DEFAULT_KITS   = qw(ALWAYS DEFAULT);
my @ANY_KITS       = ();

# Handle the macro kits and prepare for run-time kits...
FILTER {
    my ($class, @args) = @_;

    # Remember where we came in...
    my ($caller, $file, $line) = caller(1);
    $line++;
    my $location = qq{\n#line $line "$file"\n};

    # Are we looking for something in particular?
    my @only_these_macro_kits 
        = _uniq(@args ? (@MANDATORY_KITS, @args) : @DEFAULT_KITS);
    ### @only_these_macro_kits
    my @only_these_runtime_kits 
        = _uniq(@args ? (@MANDATORY_KITS, @args) : @ANY_KITS);

    # Cache the module that invoked this filter (for run-time kits)..
    push @callers, $caller;

    # Get a list of run-time kits...
    my @subs_runtime
        = _kit_names( _find_all_kits(['Runtime'], \@only_these_runtime_kits) );

    # Load up all the compile-time macros (with line numbering)...
    my $macros = q{};
    for my $macro_path ( _find_all_kits(['Macros'], \@only_these_macro_kits) ) {
        $macros .= qq{#line 1 "$macro_path"\n} . _slurp $macro_path;
    }

    # Insert the macros and pre-declarations for run-time subs...
    $_ = $macros . _declarations_for(@subs_runtime) . $location . $_;
    ### Filtered source: $_
};

# Strip directory paths from kits...
sub _kit_names {
    return map {
        my (undef, undef, $file_name) = splitpath($_);
        $file_name;
    } @_;
}

# Locate all kits in the specified subdirectory by searching include path...
sub _find_all_kits {
    my ($sub_path_ref, $only_these_kits_ref) = @_;
    ### $sub_path_ref
    ### $only_these_kits_ref
    return map {
            _glob_plain_files(
                catfile($_, 'Toolkit',  @{$sub_path_ref}),
                $only_these_kits_ref,
            )
           } @INC;
}

# Return full paths of all plain files under root directory...
sub _glob_plain_files {
    my ($root_dir, $only_these_kits_ref) = @_;
    return () if ! -d $root_dir;

    ### Globbing: $root_dir
    my @files;
    use File::Find;
    my @root_dirs = @{$only_these_kits_ref}
                        ? map { catfile $root_dir, $_ } @{$only_these_kits_ref}
                        : $root_dir;
    ### Searching: @root_dirs
    ROOT:
    for my $root (@root_dirs) {
        next ROOT if ! -e $root;
        find(
            sub {
                return if -d; push @files, $File::Find::name
            },
            $root,
        );
    }
    ### @files
    return @files;
}

# Create declarations for run-time kits...
sub _declarations_for {
    return join q{}, map { "sub $_;" } @_;
}

# Install a subroutine from a run-time kit...
sub _install_kit_for {
    my ($full_sub_name) = @_;
    my ($package, $sub_name) = ($full_sub_name =~ m/(.*) :: (.*)/xms);

    # Which kit (if any)?
    my $file_path = _find_kit_for(qw(Toolkit Runtime), $sub_name);
    return if !$file_path;

    # Install it...
    return _install_kit_from($file_path, $full_sub_name, $sub_name);
}

# Load and install a subroutine from the specified kit...
sub _install_kit_from {
    my ($file_path, $full_sub_name, $sub_name) = @_;

    # First try to install it in the sandbox...
    package Toolkit::Sandbox;
    use Carp;
    do $file_path;

    # Verify that it was installed...
    no strict 'refs';
    if (! *{$sub_name}{CODE} ) {
        carp "Toolkit could not load &$sub_name\n",
                "(running $file_path didn't install it)\n",
                "Problem was detected";
        return; # failure
    }

    # Then move it to the requested location...
    *{$full_sub_name} = \&{$sub_name};

    return 1; # success
}

# Return the first kit matching the specified path...
sub _find_kit_for {
    my (@path) = @_;
    for my $dir (@INC) {
        my $file_path = catfile($dir,@path);
        return $file_path if -r $file_path;
    }
    return;
}

# Install AUTOLOADs in every module that used this one...
CHECK {
    for my $package (@callers) {
        my $full_AUTOLOAD_name = $package.'::AUTOLOAD';

        no strict 'refs';
        our $AUTOLOAD;

        # Save any existing AUTOLOAD in the same namespace...
        my $orig_AUTOLOAD_ref
            = *{$full_AUTOLOAD_name}{CODE}
           || sub { croak "Undefined subroutine &$AUTOLOAD called" };

        # Install a replacement that defaults to the original...
        no warnings 'redefine';
        *{$package.'::AUTOLOAD'} = sub {
            # First try to load the requested subroutine from a kit...
            if ( _install_kit_for($AUTOLOAD) ) {
                goto &{$AUTOLOAD};
            }

            # Otherwise default to the "real" AUTOLOAD...
            ${$package.'::AUTOLOAD'} = $AUTOLOAD;
            goto &{$orig_AUTOLOAD_ref};
        };
    }
}


1; # Magic true value required at end of module
__END__