Acme-RPC

 view release on metacpan or  search on metacpan

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

use B;
use B::Deparse;
use Continuity;
use IO::Handle;
# use Devel::Pointer;
use JSON;
use Data::Dumper;
use Devel::Caller 'caller_cv';
use PadWalker 'peek_sub';
use Scalar::Util 'blessed';

my $comment = <<'EOF';

Todo:

* Accept JSON as input too, for the parameters!

* When taking apart CODE, do closes_over() too, not just peek_my().

* Weaken references held in %registry.

* Bug:  Second hit with an oid= finds the server not accepting.

* Optionally require a password... use Acme::RPC password => whatever;

* entersubs=1, enterpackages=1, etc args to control how far the recurse goes in building $tree.

* Maybe don't recurse into blessed objects, but dump them nicely upon request.
  Or maybe do recurse into them and dump their instance data.
  If $oid is passed then recurse into arrays, hashes, and object instance data.

* We don't dump references found inside CODE in the main view.
  But if they request a dump for that object, dump it.
  Likewise, we're not dumping arrays and hashes, but if they request a dump on it, dump it.

* JSON output on the default tree view too.
  We'd have to sanitize our tree...

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

  Given a stash like "foo::", $node->{chr(0)} would actually be \%{'foo::'} and $node->{everything else} would be stuff in that package.

* Rather than only taking oids to dump/call, also take a path in the tree.

* lazy=1 parameter where the last $tree is re-used rather than re-computed.

* 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.

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

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

                if(ref($ob) eq 'CODE') {
                    my $buf = B::Deparse->new()->coderef2text($ob);
                    $buf =~ s{<}{\&lt;}g;
                    $request->print("<pre>$buf</pre>\n");
                } else {
                    if($output and $output eq 'json') {
                        $ob = tryunref($ob, $request) or next;
                        $ob = tryunobject($ob, $request) or next;
                        $request->print(eval { to_json($ob, { ascii => 1, allow_unknown => 1, allow_blessed => 1, }, ) } || $@);
                    } else {
                        $ob = tryunref($ob, $request) or next;
                        $request->print("<pre>", Data::Dumper::Dumper($ob), "</pre>\n");
                    }
                }

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

            } elsif($action eq 'call') {

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

                    $args[$i] = $request->param("arg$i");
                    # if($args[$i] =~ m/^\d+$/ and exists $registry{$args[$i]}) {
                    #     # try to find args in our %registry
                    #     $args[$i] = $registry{$args[$i]};
                    # }
                    $i++;
                }

                if(ref($ob) eq 'CODE') {
                    @ret = $ob->(@args);
                } elsif(blessed($ob)) {
                    my $method = $request->param('method');
                    $ob->can($method) or do { $request->print("object does not define that method"); next; }; 
                    @ret = $ob->can($method)->($ob, @args);
                }

                if($output and $output eq 'json') {
                     request->print(eval { to_json(\@ret, { ascii => 1}, ) } || $@);
                } else {
                    my $buf = Data::Dumper::Dumper(\@ret);
                    $request->print(qq{<pre>$buf</pre>\n});

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

                    # found a scalar inside of the package... create an entry for the scalar itself and if it contains a ref, recurse, I guess
                    my $scalar = *{$package.$k}{SCALAR};   # this is a scalarref in the case of "our $var = 1" or other simple things
                    my $scalarcontains = $$scalar;
                    if(ref $scalarcontains) {
                        $node->{'$'.$k} = caller_cv(0)->($scalarcontains);
                    }
                    reg( $node->{'$'.$k}{chr(0)} = $scalar ); # have to do this after assigning in from the recursive call
                }
            }
            # end for %{$package}, if %{$package}
        } elsif(my $class = blessed($object)) {
            # classes... instance data, methods XXX
            reg( $node->{chr(0)} = $object);  # do this after any recursive call, probably replacing the chr(0) value that came back
            $node->{chr(1)} = $class;   # comment
            # let's skip the instance data, for now
            # if( UNIVERSAL::isa($ob, 'HASH') ) {
            #     for my $k (keys %$object) {
            #         next unless ref $object->{$k};
            #         $node->{$k} = caller_cv(0)->($object->{$k});
            #     }
            # }

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

    ref($ob) eq 'REF' and do {
        $request->print("REF derefs to REF four times; probably circular");
        return;
    };
    return $ob;
}

sub tryunobject {
    my $ob = shift;
    my $request = shift;
    if( blessed($ob) and UNIVERSAL::isa($ob, 'HASH') ) {
        $ob = { %$ob };
    } elsif( blessed($ob) and UNIVERSAL::isa($ob, 'ARRAY') ) {
        $ob = [ @$ob ];
    } elsif( blessed($ob) and UNIVERSAL::isa($ob, 'SCALAR') ) {
        $ob = \ ${$ob};
    } elsif( blessed($ob) ) {
        $request->print("object not blessed hash, array or scalar... no logic for converting to JSON, sorry"); 
        return;
    }
    return $ob;
}

END { $continuity->loop }


1;

=head1 NAME

Acme::RPC - Easy remote function and method call and more

=head1 SYNOPSIS

  use Acme::RPC;
  our $test2 = t2->new();

  package t2; 
  sub new { bless {  one => 1 }, $_[0] }; 
  sub add { ($_[1] + $_[2]); }'

Then go to:

  http://localhost:7777/?path=%24test2/add()&action=call&arg0=10&arg1=15

The C<path> part, decoded, reads C<< $test2/add() >>.

=head1 DESCRIPTION

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

                # $oid =~ m/^0x[0-9a-f]{8,}$/
                # my $ob = Devel::Pointer::deref(hex($oid));
                my $ob = Devel::Pointer::deref($oid);
                my $buf = Data::Dumper::Dumper($ob);
                # $buf =~ s{(0x[a-f0-9]{6,})}{<a href="?oid=$1">$1</a>}g;
                $request->print(qq{<pre>$buf</pre>\n});
* Accepts posts as well, and handle by data type.
  Posts to CODE refs run them with the arguments (attempt to reconstitute object references in the arguments... move to 0x style oids again
  to support this).
  Posts to object references (blessed things) invoke the named method in them (again, reconstituting the args).
  Posts to scalars, arrays, hashes, etc merely replace their data.