Acme-Globule

 view release on metacpan or  search on metacpan

META.yml  view on Meta::CPAN

---
abstract: 'Extensible package-local way to override glob()'
author:
  - 'Peter Corlett <abuse@cabal.org.uk>'
build_requires:
  English: 0
  File::Find: 0
  File::Temp: 0
  Test::More: 0
configure_requires:
  ExtUtils::MakeMaker: 6.31
dynamic_config: 0

Makefile.PL  view on Meta::CPAN

use strict;
use warnings;

BEGIN { require 5.006; }

use ExtUtils::MakeMaker 6.31;



my %WriteMakefileArgs = (
  'ABSTRACT' => 'Extensible package-local way to override glob()',
  'AUTHOR' => 'Peter Corlett <abuse@cabal.org.uk>',
  'BUILD_REQUIRES' => {
    'English' => '0',
    'File::Find' => '0',
    'File::Temp' => '0',
    'Test::More' => '0'
  },
  'CONFIGURE_REQUIRES' => {
    'ExtUtils::MakeMaker' => '6.31'
  },

README  view on Meta::CPAN



This archive contains the distribution Acme-Globule,
version 0.004:

  Extensible package-local way to override glob()

This software is copyright (c) 2011 by Peter Corlett.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.


lib/Acme/Globule.pm  view on Meta::CPAN

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;

lib/Acme/Globule.pm  view on Meta::CPAN

        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__
=pod

=head1 NAME

Acme::Globule - Extensible package-local way to override glob()

=head1 VERSION

version 0.004

=head1 SYNOPSIS

 # a simple plugin
 package Acme::Globule::Ping;

 sub globule {
   my($self, $pattern) = @_;
   # somebody did <ping> and so we want to return ('pong')
   return [ "pong" ] if $pattern eq 'ping';
   # they didn't ping, so pass
   return;
 }

 # a simple client
 package main;

 use Acme::Globule qw( Ping );

 # prints "pong'
 print <ping>;
 # prints the location of your home directory
 print <~>;

=head1 DESCRIPTION

This package extends glob (and thus <>) to return custom results. It has a
plugin mechanism and you define which plugins you wish to use on the import
line. Now when you call glob(), these plugins will be tried left-to-right
until one claims it, with a fall-through to the standard glob() function.

Each of your packages may use different plugins, and packages that do not
import Acme::Globule will get standard glob() behaviour.

=head1 Creating a plugin

To create a plugin, create a module Acme::Globule::* and provide a globule()
method. The globule method should return an array reference containing the
matches, or nothing if it wishes to decline and let the next plugin try it.

=head1 BUGS

Any code that uses this module is perverse and therefore contains at least
one bug.

This module globally hooks both File::Glob::csh_glob CORE::GLOBAL::glob, and
so using this module anywhere in a program will cause all uses of glob() to
suffer a slight performance hit even in other modules which do not use it.

glob() within an eval() will probably not do what you expect.

=head1 SEE ALSO

Acme::Globule::*, the plugins.

=head1 AUTHOR

Peter Corlett <abuse@cabal.org.uk>

=head1 COPYRIGHT AND LICENSE

lib/Acme/Globule/Range.pm  view on Meta::CPAN

        while ($first >= $last) {
            push @range, $first;
            $first += $step;
        }
    } else {
        return [ $first ];
    }
    return \@range;
}

sub globule {
    my($self, $pattern) = @_;
    local $_ = $pattern;
    if (/^($num)\.\.($num)$/) {
        if ($1 < $2) {
            return _range($1, $2, 1);
        } elsif ($1 > $2) {
            return _range($1, $2, -1);
        } else {
            return [ $1 ];
        }

lib/Acme/Globule/Range.pm  view on Meta::CPAN

 use Acme::Globule qw( Range );

 foreach (<10..1>) {
   print "$_... ";
 }
 print "Lift-off!\n";

 # put down that crack pipe...
 sub my_keys(\%) {
   my @hash = %{ $_[0] };
  return @hash[ glob("0,2..$#hash") ];
 }

 sub my_values(\%) {
   my @hash = %{ $_[0] };
  return @hash[ glob("1,3..$#hash") ];
 }

=head1 DESCRIPTION

This is a Acme::Globule plugin that makes glob() do range operations. The
following range formats are supported:

=over 4

=item C<A..Z>

Returns the integers between A and Z. If Z is lower than A, this will return
a reversed range. Thus C<E<lt>1..9E<gt>> is C<(1..9)> and C<E<lt>9..1E<gt>>
is C<(reverse 1..9)>.

lib/Acme/Globule/Range.pm  view on Meta::CPAN


Returns the integers between A and Z with a step such that the next to last
value is Y. Thus C<E<lt>1..7,9E<gt>> is C<(1, 3, 5, 7, 9)>.

=back

Any other string will fall through to the next plugin.

METHODS

=head2 globule

The implementation of the range operator. You should never need to call this
directly.

=head1 BUGS

The syntax is rather rigid.

=head1 SEE ALSO

List::Maker which supports a wider range (*groan*) of syntax but affects
glob() globally.

=head1 AUTHOR

Peter Corlett <abuse@cabal.org.uk>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Peter Corlett.

This is free software; you can redistribute it and/or modify it under

t/10_noplugin.t  view on Meta::CPAN

#!/usr/bin/env perl
use warnings;
use strict;

# Test that using the module doesn't break normal use of glob

use Test::More tests => 1;

use Acme::Globule;

is(<.>, '.', 'regular globbing works' );

t/11_badplugin.t  view on Meta::CPAN

#!/usr/bin/env perl
use warnings;
use strict;

# Test that using the module doesn't break normal use of glob

use Test::More tests => 1;

eval "use Acme::Globule qw( Invalid::Globule::Plugin )";

like($@, qr~Can't locate Acme/Globule/Invalid/Globule/Plugin.pm~,
     "die()s when given an invalid plugin");

t/12_reimport.t  view on Meta::CPAN

#!/usr/bin/env perl
use warnings;
use strict;

# Test that using the module doesn't break normal use of glob

use Test::More tests => 1;

package First;

use Acme::Globule qw( Range );

package Second;

use Acme::Globule qw( Range );

t/59_range_mykeys.t  view on Meta::CPAN

#!/usr/bin/env perl
use warnings;
use strict;

# Test that using the module doesn't break normal use of glob

use Test::More tests => 6;

use Acme::Globule qw( Range );

sub my_keys(\%) {
    my @hash = %{ $_[0] };
    return @hash[ glob("0,2..$#hash") ];
}

sub my_values(\%) {
    my @hash = %{ $_[0] };
    return @hash[ glob("1,3..$#hash") ];
}

my %hash = ( 1..20 );

is_deeply( [ my_keys %hash ], [ keys %hash ], 'my_keys works');
is_deeply( [ my_values %hash ], [ values %hash ], 'my_values works');

%hash = (1, 2);

is_deeply( [ my_keys %hash ], [ keys %hash ], 'my_keys works');



( run in 0.613 second using v1.01-cache-2.11-cpan-49f99fa48dc )