2 # This allows perl programs to call functions dynamically
4 # This has been nicked directly from the perlembed pages
5 # so has the perl copyright
10 package Embed::Persistent;
13 #require Devel::Symdump;
17 sub valid_package_name {
19 $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
20 #second pass only for words starting with a digit
21 $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;
23 #Dress it up as a real package name
25 return "Embed" . $string;
28 #borrowed from Safe.pm
34 $pkg = "main::$pkg\::"; # expand to full symbol table name
35 ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
37 my $stem_symtab = *{$stem}{HASH };
39 delete $stem_symtab->{$leaf };
43 my($filename, $delete) = @_;
44 my $package = valid_package_name($filename);
45 my $mtime = -M $filename;
46 if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) {
47 #we have compiled this subroutine already,
48 #it has not been updated on disk, nothing left to do
49 print STDERR "already compiled $package->handler\n";
52 open FH, $filename or die "open '$filename' $!";
57 #wrap the code into a subroutine inside our unique package
58 my $eval = qq{package $package; sub handler { $sub; }};
60 #hide our variables within this block
61 my($filename,$mtime,$package,$sub);
66 #cache it unless we're cleaning out each time
67 $Cache{$package}{mtime} = $mtime unless $delete;
70 eval {$package->handler;};
73 delete_package($package) if $delete;
75 #take a look if you want
76 #print Devel::Symdump->rnew($package)->as_string, $/;