CODEWITHSUNDEEP
perlnamespacesincluderequire
scozy
scozy

Reputation: 2582

Call a subroutine from a file that was required in a different namespace

I am refactoring some old, badly made Perl code. In many places, data that was stored in external .pl files like this:

sub data{{ huge => 'datastructure', etc => '...' }};
1;

is imported like that:

require 'file_with_data.pl';
my $data = data();

I cannot change the way this data is stored, but I am moving all this require logic to a single package which will make the data accessible to anyone that wants it.

My problem is, I have to do this progressively, i.e. for some time, some modules will use the old, ugly way, whereas some others will use the new, slightly less ugly way.

Here is one of the methods I have in my new package:

sub load_from_subroutine {
    no strict 'refs';
    my ($self, $file, $subroutine) = @_;
    my $data;
    try {
        if (exists $INC{$file}) {
            die "What should I do now?";  # <-- this is what I want to change
        }
        else {
            untaint $file;
            require $file;
            if (defined &$subroutine) {
                $data = &$subroutine;
            }
            else {
                die "Subroutine $subroutine is not defined";
            }
        }
    }
    catch {
        croak "Unable to load resource from file $file: $_";
    };
    return $data;
}

In case exists $INC{$file} tests to true, is there any trick I can use to be able to get at &$subroutine? It is implied that, in this namespace, defined &$subroutine is false.

Temporary code

In the meanwhile, this is what I'm using:

warn "Doing dirty trick in order to be able to load $file!\n";
my $tmp = '/tmp/data' . time . rand(100) . '.pl';
copy $file, $tmp;
require $tmp;
# do the loading stuff as shown...
unlink $tmp;

This is really awful and I'm longing for a better solution.

Upvotes: 0

Views: 109

Answers (2)

Miller
Miller

Reputation: 35198

It sounds like ikegami helped with your initial problem.

Please note that because you're importing all of these files into a single package there is likely to be some name overlap, especially if the previous coder reused the name sub data. I would therefore suggest that you give each of these files their own package and to cache the result.

The follow demonstrates now to do that:

package MyNamespace::DataLoader;

use strict;
use warnings;
use autodie;

use Carp;

# Both of the below subs output a string, like:  sub data { "foo" }
print load_from_subroutine(qw(data2.pl data)), "\n";
print load_from_subroutine(qw(data3.pl data)), "\n";

our %files;
our $inc = 0;

sub load_from_subroutine {
    my ($file, $subroutine) = @_;

    # Load the file
    if (!$files{$file}) {
        my $data = do {
            local $/;
            open my $fh, '<', $file;
            <$fh>;
        };

        carp "File already has a package declaration: $file" if $data =~ /^package/;

        my $pkg = __PACKAGE__ . '::Package' . ++$inc;
        $files{$file}{pkg} = $pkg;

        eval "package $pkg;\n$data\n1;";
        croak "Unable to load '$file': $@" if $@;
    }

    # Reference the subroutine
    if (!$files{$file}{sub}{$subroutine}) {
        my $subname = $files{$file}{pkg} . '::' . $subroutine;

        no strict 'refs';
        if (! defined &{"$subname"}) {
            croak "Subroutine doesn't exist: $file->$subroutine";
        }

        $files{$file}{sub}{$subroutine} = \&{"$subname"};
    }

    return $files{$file}{sub}{$subroutine}->();
}

Upvotes: 1

ikegami
ikegami

Reputation: 385496

It wasn't loaded in a different namespace (note the lack of package). The lack of package also means you should be using do instead of require. do ignores %INC.

Upvotes: 1

Related Questions