in reply to Re^2: BEGIN and compile-time
in thread BEGIN and compile-time

Ikegami, you're right as always. Perhaps  eval "use Foo 5.01; 1" or do { require Foo; ... } does it.

Thanks tye for clearning up that little something, it made me take a closer look at sub VERSION.

Here's an attempt to get  use Module VERSION to load the right VERSION. 
$ cat a/strict.pm
package strict;

our $VERSION = 1.04;

sub VERSION {
    my ($module, $version) = @_;
    return $VERSION unless $version;
    until ($VERSION == $version) {
        shift @INC;
        delete $INC{"strict.pm"};
        eval " require strict; 1; ";
        $VERSION = $strict::VERSION;
    }
    return $VERSION;
}

$ cat ./strict
#!/usr/bin/perl -Wl

BEGIN {

    eval {
        local @INC = @INC;
        unshift @INC, qw|a b c|;
        eval " 
            use strict 1.03 qw|subs vars refs|; 
            1; 
        ";
        warn "$@" if $@;
    };
}

print "strict using $INC{'strict.pm'} version $strict::VERSION ";

$ ./strict 

strict using /usr/share/perl/5.8/strict.pm version 1.03

[download]
It's kludgy and noisy but it works.

Replies are listed 'Best First'.
Re^4: BEGIN and compile-time
by ikegami (Patriarch) on Nov 11, 2006 at 10:43 UTC
    • Putting the code in VERSION makes it less useful.
    • Gave function a prototype that will allow user to omit quotes around module name.
    • The module name was both a parameter and hardcoded. Removed the hardcoding.
    • Broke infinite loop if version not found.
    • Don't try to load twice from the same @INC path.
    • Made strict-safe and warning-safe. 
    use Carp qw( croak );

sub require_exact_ver(*$) {
   my ($pkg, $desired_ver) = @_;

   {
      my $ver = $pkg->VERSION;
      return 1 if defined($ver)
               && $ver == $desired_ver;
   }

   my $file = $pkg;
   $file =~ s{::}{/}g;
   $file .= '.pm';

   foreach $inc (@INC) {
      delete $INC{$file};
      local @INC = $inc;
      eval { require $file }
         or next;

      my $ver = $pkg->VERSION;
      return 1 if defined($ver)
               && $ver == $desired_ver;
   }

   delete $INC{$file};
   croak("Unable to load $pkg version $desired_ver");
}

    [download]

    You might get lots of redefined warnings. Other hard to debug problems might also surface. To avoid those, you might want to take CPAN's approach to determining a module's version. CPAN searches for $VERSION in the source and executes only that line (more or less). Since the module isn't actually loaded, no redefined problems, etc. 

    use Carp       qw( croak );
use File::Spec qw( );

sub require_exact_ver(*$) {
   my ($pkg, $desired_ver) = @_;

   my $file = $pkg;
   $file =~ s{::}{/}g;
   $file .= '.pm';

   if ($INC{$file}) {
      # Module already loaded.

      my $ver = $pkg->VERSION;
      return 1 if defined($ver)
               && $ver == $desired_ver;

      croak("$pkg version $ver already loaded (want $desired_ver)");
   }

   local $/;

   foreach $inc (@INC) {
      next if ref($inc);  # XXX

      my $path = File::Spec->catfile($inc, $file);

      open(my $fh, '<', $path)                          or next;
      my $file = <$fh>                                  or next;
      my ($ver_cmd) = $file =~ /\$VERSION\s*=([^\n;]);/ or next;
      my $ver = eval $ver_cmd                           or next;
      $ver != $desired_ver                              or next;

      # woot!
      require $path;
   }

   croak("Unable to locate $pkg version $desired_ver");
}

    [download]
[reply]
[d/l]
[select]
Re^4: BEGIN and compile-time
by Firefly258 (Beadle) on Nov 11, 2006 at 18:49 UTC
    A much improved and refined sub VERSION() for the implicit approach. 

    
sub VERSION {
    my ($module, $version) = @_;
    return $VERSION unless $version; # satisfy UNIVERSAL::VERSION()

    do { require File::Spec;
         require File::Basename;
        my $file = File::Spec->catfile( split /::/, $module ) . ".pm";
         my $dir;
        $dir = File::Basename::dirname( $dir || $INC{$file} ) 
                     for 0 .. $module =~ /::/g;

        for my $dir ( local @INC = grep { !/^$dir$/ && -e File::Spec->
+catfile( $_, $file ) } @INC ) {
            open MOD, "<", File::Spec->catfile( $dir, $file ) or warn 
+"$@";
            grep {
                /(.*VERSION.*)/ 
                and eval "eval '$1' == $version" 
                and do {
                    delete $INC{$file};
                    eval " require $module; $module->VERSION " == $ver
+sion and do return $version ;
                    shift @INC;
                }
            } <MOD>;
        }

        require Carp;
        Carp::croak(" Loading $module ($version) failed. ");

    } unless ($version == $VERSION);
}

    [download]
    A loader hook for @INC for explicit version control, basically just the above modified slightly. 
    BEGIN {
    sub my_use {
        my ($arg_ref, $module) = @_;
        my $version;
        local @INC;
        (undef, $version, @INC) = @$arg_ref;
        require File::Spec;
        for my $dir ( grep { -e File::Spec->catfile( $_, $module ) } @
+INC ) {
            my $file = File::Spec->catfile( $dir, $module );
            open MOD, "<", $file or warn "failed opening $file : $@";
            grep {
                /(?:VERSION\s*=(.*))/
                and eval "eval '$1' || 0" == $version
                and do {
                    open my $fh, "<", $file or warn "open $file failed
+ : $@";
                    close MOD;
                    return $fh;
                }
            } <MOD>;
        }

    }
   {
    local @INC = [ \&my_use, "1.03", qw|a b c|, @INC ];
    eval "use strict";
   }
   {
    local @INC = [ \&my_use, "5.01", @INC, qw|a b c|];
    eval "use Foo::Bar";
   }
}

    [download]
    There's bound to be room for correction and improvement, especially to creating a simple and elegant data structure to house information about module and version numbers.
[reply]
[d/l]
[select]

In Section Meditations