]> gb7djk.dxcluster.net Git - spider.git/blobdiff - perl/persistent.pl
started the command processor code.
[spider.git] / perl / persistent.pl
diff --git a/perl/persistent.pl b/perl/persistent.pl
deleted file mode 100644 (file)
index 23b302e..0000000
+++ /dev/null
@@ -1,81 +0,0 @@
-#
-# This allows perl programs to call functions dynamically
-# 
-# This has been nicked directly from the perlembed pages
-# so has the perl copyright
-#
-# $Id$
-#
-
-package Embed::Persistent;
-#persistent.pl
-
-#require Devel::Symdump;  
-use strict;
-use vars '%Cache';
-
-sub valid_package_name {
-       my($string) = @_;
-       $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
-#second pass only for words starting with a digit
-       $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;
-       
-#Dress it up as a real package name
-       $string =~ s|/|::|g;
-       return "Embed" . $string;
-}
-
-#borrowed from Safe.pm
-sub delete_package {
-       my $pkg = shift;
-       my ($stem, $leaf);
-       
-       no strict 'refs';
-       $pkg = "main::$pkg\::";    # expand to full symbol table name
-               ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
-       
-       my $stem_symtab = *{$stem}{HASH };
-       
-       delete $stem_symtab->{$leaf     };
- }
-
-sub eval_file {
-       my($filename, $delete) = @_;
-       my $package = valid_package_name($filename);
-       my $mtime = -M $filename;
-       if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) {
-#we have compiled this subroutine already,
-#it has not been updated on disk, nothing left to do
-               print STDERR "already compiled $package->handler\n";
-       } else {
-               local *FH;
-               open FH, $filename or die "open '$filename' $!";
-               local($/) = undef;
-               my $sub = <FH>;
-               close FH;
-               
-#wrap the code into a subroutine inside our unique package
-               my $eval = qq{package $package; sub handler { $sub; }};
-               {
-#hide our variables within this block
-                       my($filename,$mtime,$package,$sub);
-                       eval $eval;
-               }
-               die $@ if $@;
-               
-#cache it unless we're cleaning out each time
-               $Cache{$package}{mtime} = $mtime unless $delete;
-}
-
-eval {$package->handler;};
-die $@ if $@;
-
-delete_package($package) if $delete;
-
-#take a look if you want
-#print Devel::Symdump->rnew($package)->as_string, $/;
-}
-
-1;
-
-__END__