clueless newbie has asked for the wisdom of the Perl Monks concerning the following question:
Greetings!
I'm attempting to "load" modules from a database using a coderef prepended onto @INC but I'm having problems. It fails when a module loaded via the coderef requires another module which will be loaded via the coderef.
I've tried various incantations of the coderef without success and am hoping that the monastery can shed light on my error(s)
To illustration the problem we will need to create a small database containing our modules. We'll use SQLite.
populate.pl
This database contains the following modules:#!/usr/bin/env perl use Carp; use DBI; use strict; use warnings; eval { my $DBH=DBI->connect('dbi:SQLite:Library.sqlite','','',{ PrintErro +r=>1, RaiseError=>1 }); $DBH->do("DROP TABLE IF EXISTS packages;"); $DBH->do("CREATE TABLE packages ( package text, body text, unique (package) );"); my $STH=$DBH->prepare("INSERT INTO packages (package,body) VALUES +(?,?);"); print "Inserting package 'A'\n"; $STH->execute('A',<<'__A__'); package A; use Carp; use strict; use warnings; use A::B; sub sub_a { Carp::cluck '...'; A::B::sub_b(); } 1; __A__ print "Inserting package 'A::B'\n"; $STH->execute('A::B',<<'__A::B__'); package A::B; use Carp; use strict; use warnings; sub sub_b { Carp::cluck '...'; }; 1; __A::B__ $STH->finish; $DBH->disconnect; }; if (my $error=$@) { Carp::confess $error; }; print "$0 completed." __END__
package A; use Carp; use strict; use warnings; use A::B; sub sub_a { Carp::cluck '...'; A::B::sub_b(); } 1;
package A::B; use Carp; use strict; use warnings; sub sub_b { Carp::cluck '...'; }; 1;
Note that module 'A' requires module 'A::B'.
Here's the code that unshifts the coderef onto @INC.package dbLoader; use Carp; use Data::Dumper; use DBI; use Scalar::Util; use strict; use warnings; use feature 'state'; sub import { my $self=shift; return; }; # import: my $KNOWN_PACKAGES_HREF; my ($DBH,$STH); { # INTERNALS: sub _dbLoader { my (undef,$path_S)=@_; s{[/\\]}{::}g, s{\.pm$}{} for (my $package_s=$path_S); return # unless the package is in the this library unless (exists $KNOWN_PACKAGES_HREF->{$package_s}); warn Data::Dumper->Dump([\$path_S,\$package_s],[qw(*path *pack +age)]),' '; my $body_sref; eval { $STH->execute($package_s); if(my $value_aref=$STH->fetchrow_arrayref()) { chomp($value_aref->[0]); $body_sref=\$value_aref->[0]; warn "fetched - ",Data::Dumper->Dump([\$body_sref],[qw +(*body)]),''; $INC{$path_S}="DBI:Pg:$path_S"; }; }; if (my $error=$@) { Carp::confess $@; } elsif (!defined $body_sref) { return; } else { open my $fh,'<',$body_sref or Carp::confess "Couldn't open string for reading! $! +"; return ( sub { #Carp::cluck 'In anonymous sub'; if ($_=<$fh>) { warn Data::Dumper->Dump([\$_],[qw(*_)]),' +'; return 1; } else { return 0; }; } # Anonymous sub: ); }; }; # _dbLoader: } # INTERNALS: BEGIN { eval { $DBH=DBI->connect('dbi:SQLite:Library.sqlite','','',{ PrintErr +or=>1, RaiseError=>1 }); # Create a (global) hashref of packages/prefixes $STH=$DBH->prepare(<<"__SQL__"); SELECT package FROM packages; __SQL__ $STH->execute(); my $field_aref=$STH->{NAME_lc}; while (my $value_aref=$STH->fetchrow_arrayref()) { my %_h; @_h{@$field_aref}=@$value_aref; $KNOWN_PACKAGES_HREF->{$_h{package}}=undef; }; $STH->finish(); warn Data::Dumper->Dump([\$KNOWN_PACKAGES_HREF],[qw(*KNOWN_PAC +KAGES)]),' '; # Statement handle for fetching source(s) $STH=$DBH->prepare(<<"__SQL__"); SELECT body FROM packages WHERE package = ?; __SQL__ warn "SELECT prepared"; unshift @INC,\&_dbLoader; warn "Prepended \&_dbLoader to \@INC"; }; if (my $error=$@) { Carp::confess $@; }; }; # BEGIN: END { print STDERR sprintf("%40s\t%s\n",$_,$INC{$_}) for (sort grep { $INC{$_} !~ m{^([A-Za-z]:|/)}} keys %INC); }; # END: 1;
The following which explicitly requires A::B prior to requiring A runs successfully.
perl -MdbLoader works.pl#!/usr/bin/env perl use strict; use warnings; # Note the order ... "A::B", "A" - this works! use A::B; use A; A::sub_a(); A::B::sub_b(); exit;
While this which merely requires A (thus implicitly requiring A::B) does not.
perl -MdbLoader worksnot.pl#!/usr/bin/env perl use strict; use warnings; # Note the order ... "A" with the implicit requir'ing of "A::B" by "A" + - this does NOT work use A; A::sub_a(); A::B::sub_b(); exit;
It produces
... at DBI:Pg:A.pm line 8. require A.pm called at WorksNot.plx line 6 main::BEGIN() called at DBI:Pg:A.pm line 0 eval {...} called at DBI:Pg:A.pm line 0 Can't locate object method "b_b" via package "1" (perhaps you forgot t +o load "1"?) at DBI:Pg:A.pm line 7. Compilation failed in require at WorksNot.plx line 6. BEGIN failed--compilation aborted at WorksNot.plx line 6.
NB: I've played with various returns ranging from
return ( $body_sref );
return ( $fh, );
return ( sub { #Carp::cluck 'In anonymous sub'; if ($_=<$fh>) { warn Data::Dumper->Dump([\$_],[qw(*_)]),' +'; return 1; } else { return 0; }; } # Anonymous sub: );
and while they do NOT return the list as specified by the require docs they work on 'works.pl' and fail similarly on 'worksnot.pl'.
PS: I've chased down and read most of the "coderef"/"@INC" posts on perlmonks and stackoverflow and still
I'm clueless
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Coderefs and @INC
by haj (Vicar) on Jul 03, 2018 at 18:39 UTC | |
by clueless newbie (Curate) on Jul 03, 2018 at 19:57 UTC | |
|
Re: Coderefs and @INC (return filehandle or undef)
by Anonymous Monk on Jul 04, 2018 at 06:24 UTC | |
by clueless newbie (Curate) on Jul 04, 2018 at 16:13 UTC | |
|
Re: Coderefs and @INC
by Anonymous Monk on Jul 04, 2018 at 02:52 UTC | |
by Anonymous Monk on Jul 04, 2018 at 12:39 UTC | |
by Anonymous Monk on Jul 04, 2018 at 13:18 UTC |