comment on

Coderefs and @INC

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

#!/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__
[download]

This database contains the following modules:

package A;

use Carp;
use strict;
use warnings;
use A::B;

sub sub_a {
    Carp::cluck '...';
    A::B::sub_b();
    }
    1;
[download]

package A::B;

use Carp;
use strict;
use warnings;

sub sub_b {
    Carp::cluck '...';
    };

    1;
[download]

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;
[download]

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;
[download]

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;
[download]

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.
[download]

NB: I've played with various returns ranging from

            return (
                    $body_sref
                    );
[download]

            return (
                    $fh,
                   );
[download]

            return (
                    sub { #Carp::cluck 'In anonymous sub';
                        if ($_=<$fh>) {
                            warn Data::Dumper->Dump([\$_],[qw(*_)]),' 
+';
                            return 1;
                            }
                        else {
                            return 0;
                            };
                        } # Anonymous sub:
                    );
[download]

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

In reply to Coderefs and @INC by clueless newbie

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.