view release on metacpan or  search on metacpan

lib/Acme/RPC.pm  view on Meta::CPAN

* Should switch to our own recurse logic from Data::Dumper to support these other things.

* action=dump on anything; in the case of a coderef, find its source on disc or else deparse it

* action=call on coderefs and blessed objects, with an args parameter, or arg1, arg2, arg3, etc, and a method parameter for blessed objs.

* json will croak if a reference contains objects in side it somewhere.  Should handle this gracefully.

* Offer JSON output!  Not just Data::Dumper.  Do this for action=dump, action=call, and the default tree view.

* If Devel::Leak won't give us refs... have to do an Acme::State style crawl from main::, 
  but crawling into each sub and looking at its lexicals with PadWalker.
  Could make for a nice tree view.
  Would also make it easy to filter out the variables that hold refs.

* Maybe this should be called Acme::RPC.

* Actually crawl into code refs when recursing the output!

* Devel pointer is too much work also.  Maybe we should just cache $tree and then
  walk it again when passed an oid.  *sigh*  Magic isn't working for me today.
  Bleah.


EOF

# our $lt;
our $continuity;  # don't lose this reference
our @keepalive;   # stuff instances of objects created over RPC in there so they don't get garbage collected before the other end can use them
our $tree;        # cached tree
our %registry;    # oid=>objectrefs


sub import {

    Devel::Trace::trace('off') if exists $INC{'Devel/Trace.pm'};

    $continuity = Continuity->new(port => 7777, callback => sub {

        my $request = shift;
        while(1) {

            $SIG{PIPE} = 'IGNORE';

            my $action = $request->param('action') || 'dump';
            my $output = $request->param('output');
            my $ob;

            $tree = tree('main::') unless $tree and $request->param('lazy');

            #
            # if they're referencing a specific object, find it
            #

            if($request->param('oid')) {
                my $oid = $request->param('oid');
                $ob = $registry{$oid};
                $ob or do { $request->print("no object with that oid"); next; };
            } elsif($request->param('path')) {
                my @path = split m{/}, $request->param('path');
                my $node = $tree;
                while(@path) {
                    my $step = shift @path;
                    $node = $node->{$step} or do {
                        $step =~ s{[^a-z0-9:_-]}{}g;
                        $request->print("step ``$step'' not found in path");
                        $node = undef;
                        last;
                    };
                }
                $node or next;
                $ob = $node->{chr(0)} or do {
                    $request->print("tried to look up a path that has no object associated");
                };
            }

            #
            # default view -- index of everything, up to a certain point
            #

            if( ! $ob ) {

                my $htmlout = sub {
                    my $node = shift; 
                    no strict 'refs';
                    # each node now possibily contains named refs to other nodes (recurse into those),
                    # and a possible single chr(0), a ref to something in the running program.
                    $request->print("<ul>\n");
                    for my $k (sort { $a cmp $b } keys %$node) {
                        next if $k eq chr(0); # doesn't exist in root node and our calling instance needs to have handled it otherwise
                        next if $k eq chr(1);
                        if(exists $node->{$k}{chr(0)}) {
                            my $addy = 0+($node->{$k}{chr(0)});
                            my $comment = $node->{$k}{chr(1)} || '';
                            $request->print(qq{<li><a href="?oid=$addy">$k</a> $comment</li>\n});
                        } else {
                            $request->print(qq{<li>$k</li>\n});
                        }
                        caller_cv(0)->($node->{$k}); # caller_cv(0)->($node->{$k});
                    }       
                    $request->print("</ul>\n");
                };

                my $jsonout = sub {
                    my $node = shift; 
                    my $outnode = { };
                    no strict 'refs';
                    for my $k (sort { $a cmp $b } keys %$node) {
                        next if $k eq chr(0) or $k eq chr(1);
                        $outnode->{$k} = caller_cv(0)->($node->{$k});
                        if(exists $node->{$k}{chr(0)}) {
                            my $addy = 0+($node->{$k}{chr(0)});
                            $outnode->{$k}{oid} = $addy;
                        }
                    }
                    return $outnode;
                };

                # XXX json support here too... feed to_json a pruned $tree?
                # if($output and $output eq 'json')