File Coverage

blib/lib/Acme/Globule.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch	6	6	100.0
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	47	47	100.0

package Acme::Globule;
BEGIN {
  $Acme::Globule::DIST = 'Acme-Globule';
}
BEGIN {
  $Acme::Globule::VERSION = '0.004';
}
# ABSTRACT: Extensible package-local way to override glob()
use warnings;
use strict;

# a quick dance to get at the glob()/<> implementation that we replace with
# a wrapper
use File::Glob qw( csh_glob );
my $csh_glob = \&csh_glob;

use Module::Load;

# This is a hash mapping packages that use us to the Globule plugins they
# requested.
my %clients;

# This is a hash of plugins that have been pulled in so far, and maps to the
# name of the package that actually implements the plugin.
my %plugins;

sub import {
    my($self, @plugins) = @_;
    my($importer) = caller;

    foreach my $plugin (@plugins) {
        unless (defined $plugins{$plugin}) {
            my $pkgname = __PACKAGE__."::$plugin";
            load $pkgname;
            $plugins{$plugin} = $pkgname;
        }
    }

    $clients{$importer} =  \@plugins;
}

sub _new_csh_glob {
    my($pattern) = @_;
    my($caller) = caller;  # contains package of caller, or (eval) etc, but
    # will match an entry in %clients for any package
    # that imported us
    if (my $client = $clients{$caller}) {
        # The caller imported us, so we work through the plugins they requested
        foreach my $plugin (@$client) {
            # Try the pattern against each plugin in turn, until one returns a
            # true value. This is assumed to be an arrayref that contains the
            # result of the glob
            my $result = $plugins{$plugin}->globule($pattern);
            return @$result if $result;
        }
    }
    # Since no plugins matched (or the caller didn't import us), we fall
    # through to the original glob function
    goto &$csh_glob;
}

no warnings;              # we don't want "subroutine redefined" diagnostics
*File::Glob::csh_glob = \&_new_csh_glob;
*CORE::GLOBAL::glob = \&File::Glob::csh_glob;

1;


1;

__END__