I'm writing a program which makes use of a user defined collection of subsroutines, (i.e., the user enters a name for each subroutine and a snippet of perl code, the program eval's them, and we end up with a data structure like this:

%subs = ( sub1 => 
             sub { print "Bob is the greatest user ever!";},
          sub2 => 
             sub { print "He wrote this all by himself!"}
        );
[download]

However, I want this code to persist between exections of the progam. I was going to use Data::Dumper to dump the contents of %subs to a file, but Data::Dumper doesn't handle coderefs, except to put in a dummy value for the code. The solution? Store the pre-eval source as well as the executible post-eval code. I looked on CPAN, and not finding any modules to do this, I wrote the following. There's more info in the POD at the bottom of the code. If anyone want's to look it over for glaring problems, or offer other suggestions, they'd be most welcome. Also, I'm open to suggestion on the name, as the coder using the module doesn't actually use 'tie'.

 
package Tie::Source;
use warnings;
use strict;

use vars qw($AUTOLOAD);
our $VERSION = '1.00';

use Carp;
use Data::Dumper;

sub TIEHASH {
        bless {}, $_[0];
}

sub STORE {
        my ($self, $name, $text) = @_;
        croak "You must supply a name!" unless $name;
        #$text can be null, though I don't see why anyone'd want to...
        $self->{text}{$name} = $text;
        $self->{code}{$name} = eval $text;
        carp qq[Error Evaluating $name!\nError: $@\nCode: $text\n\n] i
+f $@;
        return; #maybe we should return the eval'ed code here?
}

sub FETCH {
        my ($self, $name) = @_;
        croak "Please supply a name!" unless $name;
        confess "\"$name\" doesn't exist!"
                unless exists $self->{text}{$name};
        return $self->{text}{$name};
}

sub FIRSTKEY {
        my $self = shift;
        scalar keys %{$self->{text}};
        return scalar each %{$self->{text}};
}

sub NEXTKEY {
        my $self = shift;
        return scalar each %{$self->{text}};
}

sub EXISTS {
        my ($self, $name) = @_;
        croak "Please supply a name!" unless $name;
        return exists $self->{text}{$name};
}

sub DELETE {
        my ($self, $name) = @_;
        croak "Please supply a name!" unless $name;
        confess "\"$name\" doesn't exist!"
                unless exists $self->{text}{$name};
        delete $self->{text}{$name};
        delete $self->{code}{$name};
        return;
}

sub CLEAR {
        my $self = shift;
        $self->{text} = {};
        $self->{code} = {};
}

sub DESTROY {
        my $self = shift;
        my $realself = tied %$self;
        my $file = $realself->{file};
        if ($file) {
                seek $file, 0, 0;
                truncate $file, 0;
                local $Data::Dumper::Useqq = 1;
                print $file (Dumper($realself->{text}));
                close $file;
        }
}

sub AUTOLOAD {
        my $self = $_[0];  #Don't use 'shift', because of the goto bel
+ow;
        my $realself = tied %$self;
        my $name = $AUTOLOAD;
        $name =~ s/^.*://;
        confess "\"$name\" doesn't exist!"
                unless exists $realself->{text}{$name};
        if ((ref $realself->{code}{$name}) =~ /CODE/) {
                goto &{$realself->{code}{$name}};
        } else {
                return $realself->{code}{$name};
        }

}

sub get {
        my $self = $_[0];  #Don't use 'shift', because of the goto bel
+ow;
        my $name = $AUTOLOAD;
        $name =~ s/^.*://;
        confess "\"$name\" doesn't exist!"
                unless exists $self->{text}{$name};
        return $self->{code}{$name};
}

sub new {
        my $type = shift;
        $type = ref($type) || $type;
        my $filename = shift || '';
        my $self;
        {
                my %inner;
                tie %inner, 'DynaCode', ();
                $self = \%inner;
        }
        if ($filename) {
                open FILE, (-e $filename ? "+<$filename" : "+>$filenam
+e")
                        or die "Couldn't open '$filename'";
                my $realself = tied %$self;
                $realself->{file} = \*FILE;
                {
                        local $/ = undef;
                        $_ = <FILE>;

                        no strict 'vars';
                        $realself->{text} = eval $_;
                        foreach (keys %{$realself->{text}}) {
                                $realself->{code}{$_} = eval $realself
+->{text}{$_};
                        }
                        die "$@" if $@;
                }
        }
        return bless $self, $type;
}

1;

__END__

=pod

=head1 NAME

Tie::Source

=head1 DESCRIPTION

The Tie::Source module allows the user (or the program itself, if you'
+re feeling
ambitious) to modify snippets of code at runtime, and store them in a 
text file between executions.  It's mainly a wrapper around Data::Dump
+er and 
some C<eval>s

=head1 REQUIRES

Carp

Data::Dumper

=head1 SYNOPSIS

    use Tie::Source;
    
    #Filename is optional.  If false or undef, no file will be used,
    # and changes will be lost when the object is destroyed.
    # Note that, currently, the file is only read when the object is
    # created, and only written when it is destroyed.
    $code = new Tie::Source( "FileName" );
    
    #Example 1
    $name = 'foo';
    $text = 'sub { print "Blah Blah Blah\n" }';

    $code->{$name} = $text;
    
    print "source to $name is this...\n"
    print $code->{$name};
    
    print "$name does this...\n";
    $code->$name();

    $ref = $code->get($name);
    

    #Example 2
    use MyClass;
    $code->{bar} = 'new MyClass ( @params )');
    
    #Careful, this next line could cause the actual object to get out
    # of sync with the pre-eval one.
    $code->bar->method_of_myclass();
    #or 
    $code->get('bar')->method_of_myclass();

=head1 BUGS / CAVEATS

=over 4

=item *

The docs could really use some more work.

=item *

No file locking is done by this module.

=item *

The file is only read when the object is created, and
only written when the object is destroyed.  Changes to the
file in between these times will be ignored and overwritten.

=back

Send all bug reports to <rkoppenh@eng.utoledo.edu>.  

=head1 TODO

=over 4

=item *

Add optional support for reading/writing the file on every access, and
+ for
C<flock>ing the file while we access it.

=item *

More extensive docs.

=item *

"Fault Tolerant" mode which doesn't C<carp> or C<croak> on errors.

=back

=head1 COPYRIGHT

Copyright 2000 by Ryan Koppenhaver <rkoppenh@eng.utoledo.edu>

You may redistribute this code under the same terms as Perl itself.

=cut
[download]

--
Ryan Koppenhaver, Aspiring Perl Hacker
"I ask for so little. Just fear me, love me, do as I say and I will be your slave."