Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re^4: require() @INC hooks problem [non-Moose]

by kcott (Archbishop)
on Dec 27, 2020 at 21:52 UTC ( [id://11125838]=note: print w/replies, xml ) Need Help??


in reply to Re^3: require() @INC hooks problem
in thread require() @INC hooks problem

Out of curiousity, I took Moose out of the equation. There was no change to the problem; however, if you or someone else can solve the non-Moose issue, I suspect that solution can probably be applied to the Moose version.

I've made no changes to the module structure: just added a new() routine; changed extends to use parent; and so on. Everything is pretty much the same except all classes are now prefixed with Mooseless.

MooselessRequireHookTest.pm:

package MooselessRequireHookTest; use 5.032; use warnings; sub new { my ($class) = @_; return bless {} => $class; } sub dynamic_require { my ($self, $ns_extension) = @_; { my $class = join '::', __PACKAGE__, $ns_extension; my $source = <<~EOF; package $class; use parent 'MooselessRequireHookTest'; 1; EOF my sub for_inc { my ($coderef, $filename) = @_; return \$source }; my $for_inc_ref = \&for_inc; push @INC, $for_inc_ref; eval "require $class;"; } return; } 1;

sscce_mooseless_require_hook_test.t:

#!perl use 5.032; use warnings; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 6; use MooselessRequireHookTest; my $rht = MooselessRequireHookTest::->new(); is(defined $rht, 1, 'Test MooselessRequireHookTest::->new()'); isa_ok($rht, 'MooselessRequireHookTest', 'Test MooselessRequireHookTes +t::->new() ISA'); $rht->dynamic_require('Test1'); my $rht_test1 = MooselessRequireHookTest::Test1->new(); is(defined $rht_test1, 1, 'Test MooselessRequireHookTest::Test1->new() +'); isa_ok($rht_test1, 'MooselessRequireHookTest::Test1', 'Test MooselessR +equireHookTest::Test1->new() ISA'); $rht->dynamic_require('Test2'); my $rht_test2 = MooselessRequireHookTest::Test2->new(); is(defined $rht_test2, 1, 'Test MooselessRequireHookTest::Test2->new() +'); isa_ok($rht_test2, 'MooselessRequireHookTest::Test2', 'Test MooselessR +equireHookTest::Test2->new() ISA');

Example run:

$ prove -v sscce_mooseless_require_hook_test.t sscce_mooseless_require_hook_test.t .. 1..6 ok 1 - Test MooselessRequireHookTest::->new() ok 2 - 'Test MooselessRequireHookTest::->new() ISA' isa 'MooselessRequ +ireHookTest' ok 3 - Test MooselessRequireHookTest::Test1->new() ok 4 - 'Test MooselessRequireHookTest::Test1->new() ISA' isa 'Mooseles +sRequireHookTest::Test1' Can't locate object method "new" via package "MooselessRequireHookTest +::Test2" at sscce_mooseless_require_hook_test.t line 23. # Looks like your test exited with 255 just after 4. Dubious, test returned 255 (wstat 65280, 0xff00) Failed 2/6 subtests Test Summary Report ------------------- sscce_mooseless_require_hook_test.t (Wstat: 65280 Tests: 4 Failed: 0) Non-zero exit status: 255 Parse errors: Bad plan. You planned 6 tests but ran 4. Files=1, Tests=4, 1 wallclock secs ( 0.02 usr 0.01 sys + 0.06 cusr + 0.05 csys = 0.14 CPU) Result: FAIL

— Ken

Replies are listed 'Best First'.
Re^5: require() @INC hooks problem [non-Moose]
by choroba (Cardinal) on Dec 27, 2020 at 22:24 UTC
    The problem is the first generated code is run for the second generated module, too. You can verify it by adding the following line before the push @INC:
    pop @INC if ref $INC[-1];

    Cleaner way is to check the name in the hook itself, e.g. before returning \$source, insert

    return if -1 == index $filename, $ns_extension;

    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

      G'day choroba,

      ++ Many thanks for this.

      The namespace extension ($ns_extension) can contain several parts, e.g. A::B::C, so I made a slight adjustment to handle that. I also pared the code, bit by bit, to end up with the simplified:

      sub dynamic_require { my ($self, $ns_extension) = @_; my $class = join '::', __PACKAGE__, $ns_extension; my $source = <<~EOF; package $class; use parent 'MooselessRequireHookTest'; 1; EOF push @INC, sub { my ($coderef, $filename) = @_; my $wanted_filename = $class =~ s{::}{/}gr . '.pm'; return unless $filename eq $wanted_filename; return \$source; }; eval "require $class;"; return; }

      I added a couple more tests:

      $rht->dynamic_require('A::B::C'); my $rht_abc = MooselessRequireHookTest::A::B::C->new(); is(defined $rht_abc, 1, 'Test MooselessRequireHookTest::A::B::C->new() +'); isa_ok($rht_abc, 'MooselessRequireHookTest::A::B::C', 'Test MooselessR +equireHookTest::A::B::C->new() ISA');

      I also added this temporary debug line after unpacking @_:

      warn "\$coderef[$coderef] \$filename[$filename]\n";

      Now, all tests are successful and I have a little more insight into what is going on:

      sscce_mooseless_require_hook_test.t .. 1..8 ok 1 - Test MooselessRequireHookTest::->new() ok 2 - 'Test MooselessRequireHookTest::->new() ISA' isa 'MooselessRequ +ireHookTest' ok 3 - Test MooselessRequireHookTest::Test1->new() ok 4 - 'Test MooselessRequireHookTest::Test1->new() ISA' isa 'Mooseles +sRequireHookTest::Test1' ok 5 - Test MooselessRequireHookTest::Test2->new() ok 6 - 'Test MooselessRequireHookTest::Test2->new() ISA' isa 'Mooseles +sRequireHookTest::Test2' ok 7 - Test MooselessRequireHookTest::A::B::C->new() ok 8 - 'Test MooselessRequireHookTest::A::B::C->new() ISA' isa 'Moosel +essRequireHookTest::A::B::C' $coderef[CODE(0x60008aa00)] $filename[MooselessRequireHookTest/Test1.p +m] $coderef[CODE(0x60008aa00)] $filename[MooselessRequireHookTest/Test2.p +m] $coderef[CODE(0x600868c78)] $filename[MooselessRequireHookTest/Test2.p +m] $coderef[CODE(0x60008aa00)] $filename[MooselessRequireHookTest/A/B/C.p +m] $coderef[CODE(0x600868c78)] $filename[MooselessRequireHookTest/A/B/C.p +m] $coderef[CODE(0x60086da88)] $filename[MooselessRequireHookTest/A/B/C.p +m] ok All tests successful. Files=1, Tests=8, 0 wallclock secs ( 0.00 usr 0.03 sys + 0.08 cusr + 0.03 csys = 0.14 CPU) Result: PASS

      The mechanism behind this is a mystery to me. Why is it calling the subroutine with all the previous CODEREF values then the newly created CODEREF? Anyway, what you provided weeds out all of the unwanted parts. @INC ends up with: the use lib dir; the 4 usual dirs; and 3 (hook) CODEREFs.

      /home/ken/tmp/pm_sscce_require_hook/lib /home/ken/perl5/perlbrew/perls/perl-5.32.0/lib/site_perl/5.32.0/cygwin +-thread-multi /home/ken/perl5/perlbrew/perls/perl-5.32.0/lib/site_perl/5.32.0 /home/ken/perl5/perlbrew/perls/perl-5.32.0/lib/5.32.0/cygwin-thread-mu +lti /home/ken/perl5/perlbrew/perls/perl-5.32.0/lib/5.32.0 CODE(0x60008aa00) CODE(0x600868c78) CODE(0x60086da88)

      As I suspected, the issue had nothing to do with Moose. I applied these changes to my original module and all of its tests now pass. Thanks again.

      — Ken

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11125838]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2024-04-26 07:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found