%subs = ( sub1 => sub { print "Bob is the greatest user ever!";}, sub2 => sub { print "He wrote this all by himself!"} ); #### 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] if $@; 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 below; 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 below; 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" : "+>$filename") or die "Couldn't open '$filename'"; my $realself = tied %$self; $realself->{file} = \*FILE; { local $/ = undef; $_ = ; 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::Dumper and some Cs =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 . =head1 TODO =over 4 =item * Add optional support for reading/writing the file on every access, and for Cing the file while we access it. =item * More extensive docs. =item * "Fault Tolerant" mode which doesn't C or C on errors. =back =head1 COPYRIGHT Copyright 2000 by Ryan Koppenhaver You may redistribute this code under the same terms as Perl itself. =cut