I've been playing with this Perl "mini munny" idea. The name comes from a toy that's plain white and scultpable, designed to be customized. The customizations became a trendy art form lately. Likewise, the Perl idea is a single unit that's designed to be customized.
When launched, it starts listening on two ports. One the is main Web app (that the user is developing), and the other is the admin port (that may also be customized). The auth token to the admin gets printed on STDERR, and the user, through the admin, can chat with other connected admins, browse a tree of namespaces and fuctions in the application, edit functions in a JavaScript vi, create instances of objects, hand them to other admins, drop them, and destroy them. There's also a box for eval'ing arbitrary snippets of code that serves as a persistent scratchpad as well.
I need to do some more work on restartable exceptions in Continuity as part of this idea. And created, held objects need to define additional commands.
All of this -- the state of objects, modified functions, etc gets serialized with Storable and stored to disc, then reloaded on startup.
Eventually, this should be packaged up in a module that you can use from other programs. A visual diff and version control are on the wishlist too.
Originally I was using B::Deparse to display the code of methods and functions for edit but I predictably decided the slightly mangled code B::Deparse produced just did too much violence to the source. People will want to be able to make whitespace changes, change idiom, etc, and have those changes persist. Similarly, I was using Storable's $Storable::Deparse and $Storable::Eval to persist code changes and additions, so whitespace, comments, and changes to idiom would be lost there as well too.
So, now I'm working on changing the whole thing to change the actual original .pl source file using Adam Kennedy's PPI. But I wanted to leave a sort of monument to the working, if slightly violent, Deparse design I had. So, without further ado, here's the code.
use B; use Devel::Caller 'caller_cv'; # and several other modules
# on startup, thaw the serialized snapshot of the program state. # the tree structure mirrors the module namespace structure of # the program, and gets copied into the namespace structure of # the program. # caller_cv(0)->() is just a recursive call to the same block.
if(-f "$0.store") { $Storable::Eval = 1; # my $save = Storable::retrieve "$0.store"; sub { my $package = shift; my $tree = shift; no strict 'refs'; for my $k (keys %$tree) { if($k =~ m/::$/) { caller_cv(0)->($package.$k, $tree->{$k}); } elsif(ref($tree->{$k})) { *{$package.$k} = $tree->{$k}; } else { die $package.$k . " doesn't contain a ref"; } } }->sub('main::', $save); }
# for both serializing the state of the program and for presenting # a tree view of namespaces/subroutines/methods to edit, # this walks the symbol table, being careful to avoid XS subs # and subs imported from other packages. the B module is used # to figure those two things out. it also attempts to skip modules # listed in %INC. # after this runs, the returned structure is a tree where each # node is a reference to a hash, array, scalar, or a coderef, # or else if the key has :: as the end of its name, it's a ref to # another hash full of those things in another namespace.
my $build_tree = sub { # this is used by the save-state code but also by the admin editor stuff return sub { my $package = shift; my $node = shift() || { }; no strict 'refs'; for my $k (keys %$package) { next if $k =~ m/main::$/; next if $k =~ m/[^\w:]/; next if grep $_ eq $k, @{ $config->{stop_modules} }; if($k =~ m/::$/) { # recurse into that namespace unless it corresponds to a .pm module that got used at some point my $modulepath = $package.$k; for($modulepath) { s{^main::}{}; s{::$}{}; s{::}{/}g; $_ .= '.pm'; } next if exists $INC{$modulepath}; $node->{$k} ||= { }; caller_cv(0)->($package.$k, $node->{$k}); } elsif( *{$package.$k}{HASH} ) { $node->{$k} = *{$package.$k}{HASH}; } elsif( *{$package.$k}{ARRAY} ) { $node->{$k} = *{$package.$k}{ARRAY}; } elsif( *{$package.$k}{CODE} ) { my $ob = B::svref_2object(*{$package . $k}{CODE}); my $rootop = $ob->ROOT; # print "detected an XS sub!\n" if ! $$rootop; # Storable barfs on thawing these my $stashname = $$rootop ? $ob->STASH->NAME . '::' : '(none)'; if($$rootop and ($stashname eq $package or 'main::'.$stashname eq $package or $stashname eq 'main::' )) { # when we eval something in code in main::, it comes up as being exported from main::. *sigh* $node->{$k} = *{$package . $k}{CODE}; } } else { $node->{$k} = *{$package.$k}{SCALAR}; } } return $node; }->('main::'); };
# uses the above to save state:
my $save_db = sub { STDERR->print("Saving db!\n\n"); # $Storable::Deparse = 1; Storable::nstore $build_tree->(), "$0.store.new" or do { warn "saving state failed: $!"; # $mod_time = -M __FILE__; # XXX this requires FindBin anyway return; }; rename "$0.store", "$0.store.last"; rename "$0.store.new", "$0.store" or do { warn "renaming new save file into place failed: $!"; }; };
# Here's an out-of-context chunk of the function editing code:
my $code; if(do { no strict 'refs'; ${$file.'_src'} } ) { no strict 'refs'; $code = ${$file.'_src'}; } else { my $deparse = B::Deparse->new(); # "-p", "-sC"; $code = do { no strict 'refs'; $deparse->coderef2text(\&{$file}); }; } $request->print(qq{
