Blame lib/inc/latest/private.pm

Packit Service d63224
use strict;
Packit Service d63224
use warnings;
Packit Service d63224
Packit Service d63224
package inc::latest::private;
Packit Service d63224
# ABSTRACT: private implementation for inc::latest
Packit Service d63224
Packit Service d63224
our $VERSION = '0.500';
Packit Service d63224
Packit Service d63224
use File::Spec;
Packit Service d63224
use IO::File;
Packit Service d63224
Packit Service d63224
# must ultimately "goto" the import routine of the module to be loaded
Packit Service d63224
# so that the calling package is correct when $mod->import() runs.
Packit Service d63224
sub import {
Packit Service d63224
    my ( $package, $mod, @args ) = @_;
Packit Service d63224
    my $file = $package->_mod2path($mod);
Packit Service d63224
Packit Service d63224
    if ( $INC{$file} ) {
Packit Service d63224
        # Already loaded, but let _load_module handle import args
Packit Service d63224
        goto \&_load_module;
Packit Service d63224
    }
Packit Service d63224
Packit Service d63224
    # A bundled copy must be present
Packit Service d63224
    my ( $bundled, $bundled_dir ) = $package->_search_bundled($file)
Packit Service d63224
      or die "No bundled copy of $mod found";
Packit Service d63224
Packit Service d63224
    my $from_inc = $package->_search_INC($file);
Packit Service d63224
    unless ($from_inc) {
Packit Service d63224
        # Only bundled is available
Packit Service d63224
        unshift( @INC, $bundled_dir );
Packit Service d63224
        goto \&_load_module;
Packit Service d63224
    }
Packit Service d63224
Packit Service d63224
    if ( _version($from_inc) >= _version($bundled) ) {
Packit Service d63224
        # Ignore the bundled copy
Packit Service d63224
        goto \&_load_module;
Packit Service d63224
    }
Packit Service d63224
Packit Service d63224
    # Load the bundled copy
Packit Service d63224
    unshift( @INC, $bundled_dir );
Packit Service d63224
    goto \&_load_module;
Packit Service d63224
}
Packit Service d63224
Packit Service d63224
sub _version {
Packit Service d63224
    require ExtUtils::MakeMaker;
Packit Service d63224
    return ExtUtils::MM->parse_version(shift);
Packit Service d63224
}
Packit Service d63224
Packit Service d63224
# use "goto" for import to preserve caller
Packit Service d63224
sub _load_module {
Packit Service d63224
    my $package = shift; # remaining @_ is ready for goto
Packit Service d63224
    my ( $mod, @args ) = @_;
Packit Service d63224
    eval "require $mod; 1" or die $@;
Packit Service d63224
    if ( my $import = $mod->can('import') ) {
Packit Service d63224
        goto $import;
Packit Service d63224
    }
Packit Service d63224
    return 1;
Packit Service d63224
}
Packit Service d63224
Packit Service d63224
sub _search_bundled {
Packit Service d63224
    my ( $self, $file ) = @_;
Packit Service d63224
Packit Service d63224
    my $mypath = 'inc';
Packit Service d63224
Packit Service d63224
    local *DH; # Maintain 5.005 compatibility
Packit Service d63224
    opendir DH, $mypath or die "Can't open directory $mypath: $!";
Packit Service d63224
Packit Service d63224
    while ( defined( my $e = readdir DH ) ) {
Packit Service d63224
        next unless $e =~ /^inc_/;
Packit Service d63224
        my $try = File::Spec->catfile( $mypath, $e, $file );
Packit Service d63224
Packit Service d63224
        return ( $try, File::Spec->catdir( $mypath, $e ) ) if -e $try;
Packit Service d63224
    }
Packit Service d63224
    return;
Packit Service d63224
}
Packit Service d63224
Packit Service d63224
# Look for the given path in @INC.
Packit Service d63224
sub _search_INC {
Packit Service d63224
    # TODO: doesn't handle coderefs or arrayrefs or objects in @INC, but
Packit Service d63224
    # it probably should
Packit Service d63224
    my ( $self, $file ) = @_;
Packit Service d63224
Packit Service d63224
    foreach my $dir (@INC) {
Packit Service d63224
        next if ref $dir;
Packit Service d63224
        my $try = File::Spec->catfile( $dir, $file );
Packit Service d63224
        return $try if -e $try;
Packit Service d63224
    }
Packit Service d63224
Packit Service d63224
    return;
Packit Service d63224
}
Packit Service d63224
Packit Service d63224
# Translate a module name into a directory/file.pm to search for in @INC
Packit Service d63224
sub _mod2path {
Packit Service d63224
    my ( $self, $mod ) = @_;
Packit Service d63224
    my @parts = split /::/, $mod;
Packit Service d63224
    $parts[-1] .= '.pm';
Packit Service d63224
    return $parts[0] if @parts == 1;
Packit Service d63224
    return File::Spec->catfile(@parts);
Packit Service d63224
}
Packit Service d63224
Packit Service d63224
1;
Packit Service d63224
Packit Service d63224
Packit Service d63224
# vim: ts=4 sts=4 sw=4 tw=75 et:
Packit Service d63224
Packit Service d63224
__END__
Packit Service d63224
Packit Service d63224
=pod
Packit Service d63224
Packit Service d63224
=encoding UTF-8
Packit Service d63224
Packit Service d63224
=head1 NAME
Packit Service d63224
Packit Service d63224
inc::latest::private - private implementation for inc::latest
Packit Service d63224
Packit Service d63224
=head1 VERSION
Packit Service d63224
Packit Service d63224
version 0.500
Packit Service d63224
Packit Service d63224
=head1 DESCRIPTION
Packit Service d63224
Packit Service d63224
This module has the private methods used to find and load bundled modules.
Packit Service d63224
It should not be used directly.
Packit Service d63224
Packit Service d63224
=head1 AUTHORS
Packit Service d63224
Packit Service d63224
=over 4
Packit Service d63224
Packit Service d63224
=item *
Packit Service d63224
Packit Service d63224
David Golden <dagolden@cpan.org>
Packit Service d63224
Packit Service d63224
=item *
Packit Service d63224
Packit Service d63224
Eric Wilhelm <ewilhelm@cpan.org>
Packit Service d63224
Packit Service d63224
=back
Packit Service d63224
Packit Service d63224
=head1 COPYRIGHT AND LICENSE
Packit Service d63224
Packit Service d63224
This software is Copyright (c) 2009 by David Golden.
Packit Service d63224
Packit Service d63224
This is free software, licensed under:
Packit Service d63224
Packit Service d63224
  The Apache License, Version 2.0, January 2004
Packit Service d63224
Packit Service d63224
=cut