Perl load routines from files

[tomastrek]

Hi there, I am trying to write a program that will load all of the subroutines from text files into a hashref, then call them using soft references. I am using this code:

opendir( ROUTINES, './data/routines/' ) || die( 'Error Loading Routines: Unable to open directory'."\n" );

foreach my $rtn( readdir( ROUTINES) )
{
next if( $rtn =~ m/^\.{1,2}$/ );
next if( -d( './data/routines/'.$rtn ) );

open( FILE, './data/routines/'.$rtn ) or die( 'Error Loading Routines: Unable to Open File '.$rtn."\n" );

local $/ = undef;
my $data = <FILE>;

close( FILE );

my( $rtnname ) = ( $rtn=~ m/^([A-Z0-9- ]+)/i );
$prog->{'routines'}->{$rtnname} = eval( 'return( '.$data.' );' );

die( 'RoutineError: '.$@."\n" ) if( $@ );
}

closedir( ROUTINES );

Now this doesnt throw up any errors, but when I try to call a routine I get an error saying I have an unblessed reference. Now I know that it is just a hashref and not a class so the error makes sense, but how can I achieve what I am trying to do? I have done this on another project a long time ago by using the same code and then casting the hashref values as routines (eg: &{$prog->{'routine'}}() but this doesnt seem to work any more.

Any help much apreciated

 

[Kirsle]

What does the file look like?

You could be able to do something like,

# in the routine file...
return sub {
   # subroutine code
};

# in the main script
my $coderef = do "file.pl";
&{$coderef}; # to call the sub

-------------
Cuvou.com | My personal homepage
Project Fearless | My web blog

 

[MillerH]

I suggest that you give each file its own namespace by declaring a package. Here is how I would advise you to tackle such a problem.

Note, I've created my own 'src' directory with the following two files:

[gray][i]# src/a.pl[/i][/gray]

[url=http://perldoc.perl.org/functions/sub.html][black][b]sub[/b][/black][/url] [maroon]foo[/maroon] [red]{[/red]
	[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple]a.pl: foo()[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
[red]}[/red]

[black][b]sub[/b][/black] [maroon]bar[/maroon] [red]{[/red]
	[black][b]print[/b][/black] [red]"[/red][purple]a.pl: bar()[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
[red]}[/red]

[gray][i]# b.pl[/i][/gray]

[url=http://perldoc.perl.org/functions/sub.html][black][b]sub[/b][/black][/url] [maroon]foo[/maroon] [red]{[/red]
	[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple]b.pl: foo()[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
[red]}[/red]

[black][b]sub[/b][/black] [maroon]bar[/maroon] [red]{[/red]
	[black][b]print[/b][/black] [red]"[/red][purple]b.pl: bar()[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
[red]}[/red]

And below is the source that would parse each file and create the hash with the code references:

[gray][i]# scratch.pl[/i][/gray]

[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]File::Basename[/green] [red]qw([/red][purple]fileparse[/purple][red])[/red][red];[/red]
[black][b]use[/b][/black] [green]File::Spec::Functions[/green] [red]qw([/red][purple]catfile[/purple][red])[/red][red];[/red]

[black][b]use[/b][/black] [green]strict[/green][red];[/red]

[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$super[/blue] = [red]'[/red][purple]CachedSubs[/purple][red]'[/red][red];[/red]
[black][b]my[/b][/black] [blue]$dir[/blue] = [red]'[/red][purple]src[/purple][red]'[/red][red];[/red] [gray][i]# './data/routines/';[/i][/gray]

[black][b]my[/b][/black] [blue]%hash[/blue][red];[/red]

[url=http://perldoc.perl.org/functions/opendir.html][black][b]opendir[/b][/black][/url][red]([/red][black][b]my[/b][/black] [blue]$dh[/blue], [blue]$dir[/blue][red])[/red] or [url=http://perldoc.perl.org/functions/die.html][black][b]die[/b][/black][/url] [red]"[/red][purple]Can't opendir [blue]$dir[/blue]: [blue]$![/blue][/purple][red]"[/red][red];[/red]
[maroon]FILE[/maroon][maroon]:[/maroon]
[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$name[/blue] [red]([/red][url=http://perldoc.perl.org/functions/readdir.html][black][b]readdir[/b][/black][/url][red]([/red][blue]$dh[/blue][red])[/red][red])[/red] [red]{[/red]
	[olive][b]next[/b][/olive] [olive][b]if[/b][/olive] [blue]$name[/blue] =~ [red]/[/red][purple]^[purple][b]\.[/b][/purple]+$[/purple][red]/[/red][red];[/red]
	
	[black][b]my[/b][/black] [blue]$file[/blue] = [maroon]catfile[/maroon][red]([/red][blue]$dir[/blue], [blue]$name[/blue][red])[/red][red];[/red]
	
	[olive][b]next[/b][/olive] [olive][b]if[/b][/olive] ! [url=http://perldoc.perl.org/functions/-X.html][black][b]-f[/b][/black][/url] [blue]$file[/blue][red];[/red]

	[gray][i]# Determine Package Name[/i][/gray]
	[black][b]my[/b][/black] [red]([/red][blue]$base[/blue][red])[/red] = [maroon]fileparse[/maroon][red]([/red][blue]$name[/blue], [red]qr{[/red][purple][purple][b]\.[/b][/purple][^.]*[/purple][red]}[/red][red])[/red][red];[/red]
	[olive][b]if[/b][/olive] [red]([/red][blue]$hash[/blue][red]{[/red][blue]$base[/blue][red]}[/red][red])[/red] [red]{[/red]
		[url=http://perldoc.perl.org/functions/warn.html][black][b]warn[/b][/black][/url] [red]"[/red][purple]Package name already taken: [blue]$base[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
		[olive][b]next[/b][/olive] FILE[red];[/red]
	[red]}[/red]
	[black][b]my[/b][/black] [blue]$package[/blue] = [blue]$super[/blue] . [red]'[/red][purple]::[/purple][red]'[/red] . [blue]$base[/blue][red];[/red]
	
	[gray][i]# Slurp contents[/i][/gray]
	[url=http://perldoc.perl.org/functions/open.html][black][b]open[/b][/black][/url][red]([/red][black][b]my[/b][/black] [blue]$fh[/blue], [blue]$file[/blue][red])[/red] or [black][b]die[/b][/black] [red]"[/red][purple]Can't open [blue]$file[/blue]: [blue]$![/blue][/purple][red]"[/red][red];[/red]
	[black][b]my[/b][/black] [blue]$contents[/blue] = [url=http://perldoc.perl.org/functions/do.html][black][b]do[/b][/black][/url] [red]{[/red][url=http://perldoc.perl.org/functions/local.html][black][b]local[/b][/black][/url] [blue]$/[/blue][red];[/red] <[blue]$fh[/blue]>[red]}[/red][red];[/red]
	[url=http://perldoc.perl.org/functions/close.html][black][b]close[/b][/black][/url][red]([/red][blue]$fh[/blue][red])[/red][red];[/red]
	
	[gray][i]# Evaluate Code[/i][/gray]
	[black][b]my[/b][/black] [blue]$code[/blue] = [red]qq{[/red][purple][/purple]
[purple]package ${package};[/purple]
[purple]$contents[/purple][red]}[/red][red];[/red]

	[url=http://perldoc.perl.org/functions/eval.html][black][b]eval[/b][/black][/url] [blue]$code[/blue][red];[/red]
	[olive][b]if[/b][/olive] [red]([/red][blue]$@[/blue][red])[/red] [red]{[/red]
		[black][b]warn[/b][/black] [red]"[/red][purple]Can't eval [blue]$name[/blue]: [blue]$@[/blue][/purple][red]"[/red][red];[/red]
		[olive][b]next[/b][/olive] FILE[red];[/red]
	[red]}[/red]
	
	[gray][i]# Determine Subs[/i][/gray]
	[maroon]SUB[/maroon][maroon]:[/maroon]
	[olive][b]while[/b][/olive] [red]([/red][blue]$contents[/blue] =~ [red]/[/red][purple]^sub[purple][b]\s[/b][/purple]+([purple][b]\w[/b][/purple]+)[/purple][red]/[/red][red]mg[/red][red])[/red] [red]{[/red]
		[black][b]my[/b][/black] [blue]$subname[/blue] = [blue]$1[/blue][red];[/red]
		[black][b]my[/b][/black] [blue]$coderef[/blue] = [black][b]eval[/b][/black] [red]"[/red][purple][purple][b]\\[/b][/purple][purple][b]\&[/b][/purple][blue]$[/blue]{package}::[blue]$[/blue]{subname}[/purple][red]"[/red][red];[/red]
		[olive][b]if[/b][/olive] [red]([/red][blue]$@[/blue][red])[/red] [red]{[/red]
			[black][b]warn[/b][/black] [red]"[/red][purple]Can't eval [blue]$[/blue]{name}::[blue]$[/blue]{subname}: [blue]$@[/blue][/purple][red]"[/red][red];[/red]
			[olive][b]next[/b][/olive] SUB[red];[/red]
		[red]}[/red]
		
		[blue]$hash[/blue][red]{[/red][blue]$base[/blue][red]}[/red][red]{[/red][blue]$subname[/blue][red]}[/red] = [blue]$coderef[/blue][red];[/red]
	[red]}[/red]
[red]}[/red]
[url=http://perldoc.perl.org/functions/closedir.html][black][b]closedir[/b][/black][/url][red]([/red][blue]$dh[/blue][red])[/red][red];[/red]

[olive][b]while[/b][/olive] [red]([/red][black][b]my[/b][/black] [red]([/red][blue]$name[/blue], [blue]$subs[/blue][red])[/red] = [url=http://perldoc.perl.org/functions/each.html][black][b]each[/b][/black][/url] [blue]%hash[/blue][red])[/red] [red]{[/red]
	[olive][b]while[/b][/olive] [red]([/red][black][b]my[/b][/black] [red]([/red][blue]$sub[/blue], [blue]$coderef[/blue][red])[/red] = [black][b]each[/b][/black] [blue]%$subs[/blue][red])[/red] [red]{[/red]
		[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple][blue]$name[/blue] -> [blue]$sub[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
		[blue]$coderef[/blue]->[red]([/red][red])[/red][red];[/red]
	[red]}[/red]
[red]}[/red]


[fuchsia]1[/fuchsia][red];[/red]

[teal]__END__[/teal]

[tt]------------------------------------------------------------
Pragmas (perl 5.8.8) used :
[ul]
[li]strict - Perl pragma to restrict unsafe constructs[/li]
[/ul]
Core (perl 5.8.8) Modules used :
[ul]
[li]File::Basename - Parse file paths into directory, filename and suffix.[/li]
[li]File::Spec::Functions - portably perform operations on file names[/li]
[/ul]
[/tt]

And the output:

>perl scratch.pl
a -> bar
a.pl: bar()
a -> foo
a.pl: foo()
b -> bar
b.pl: bar()
b -> foo
b.pl: foo()

Note how even though both files contain subs with the names foo and bar, that no conflict is made.

- Miller

 

[tomastrek]

My files look like this:

sub{
#some code here
}

I dont have the return inside the file with the code as it is in the loading routine (saves adding it for all files).

Thanks MillerH, what you have looks a lot better than the way I was trying to do it. It is now working perfectly!