view release on metacpan or  search on metacpan

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

                        $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') {

                my @ret;
                my @args;

                my $i = 0;
                while(defined $request->param("arg$i")) {
                    $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});
                }

                for my $item (@ret) {
                    # add newly created items to the registry
                    $registry{0+$item} = $item if ref $item;
                }

            }

        } continue {

            # warn "doing request-next";
            $request->next;
            # warn "got next request";
        }

    });
}

sub reg ($) {
    $registry{0+$_[0]} = $_[0];
}

sub tree {

    # first, recurse through stashes starting with main::, then as we hit arrayrefs, hashrefs, and coderefs,
    # recurse into those.

    # XXX reworking this a bit.  each node should contain things logically under it as well as a ref to the
    # object that it logically refers to.  items under it are $node{whatever}, and itself is $node{chr(0)} now.
    # so, it follows that given $node{whatever}, $node{whatever}{chr(0)} is the reference for whatever.
    # this way, all nodes are hashes with children and a seperated off reference to the target object.

    # scalars can appear in packages, in object instance data, or in code refs.  same for lots of things.

    my $package = shift;

    return sub {
        # recurse through stashes (happens at the topmost level)
        my $object = shift;
        my $node = { };
        no strict 'refs';
        if(! ref($object) and $object =~ m/::$/) {
            # I don't like how each scenario is replicated here, but each is pretty short, after the custom logic for dealing with the stash.
            my $package = $object;
            for my $k (keys %{$package}) {
                next if $k =~ m/main::$/;
                next if $k =~ m/[^\w:]/;
                if($k =~ m/::$/) {
                    # found a package inside of a package
                    # my $modulepath = $package.$k;
                    # for($modulepath) { s{^main::}{}; s{::$}{}; s{::}{/}g; $_ .= '.pm'; }
                    $node->{$k} = caller_cv(0)->($package.$k);
                    reg( $node->{$k}{chr(0)} = \%{$package.$k} ); # have to do this after assinging in from the recursie call
                } elsif( *{$package.$k}{HASH} ) {
                    # our or 'use vars' variable
                    # don't recurse into hashes and arrays... if they want to see what's inside, they need to request a dump on it.
                    reg( $node->{'%'.$k}{chr(0)} = *{$package.$k}{HASH} );
                } elsif( *{$package.$k}{ARRAY} ) {
                    # our or 'use vars' variable
                    # don't recurse into hashes and arrays... if they want to see what's inside, they need to request a dump on it.
                    reg( $node->{'@'.$k}{chr(0)} = *{$package.$k}{ARRAY} );
                } elsif( *{$package.$k}{CODE} ) {
                    # subroutine inside of a package, declared with sub foo { }, else *foo = sub { }, exported, or XS.
                    # save coderefs but only if they aren't XS (can't serialize those) and weren't exported from elsewhere.
                    my $ob = B::svref_2object(*{$package . $k}{CODE});
                    my $rootop = $ob->ROOT;
                    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*
                        reg( $node->{$k.'()'}{chr(0)} = *{$package . $k}{CODE} );
                    }
                } elsif( ref(*{$package.$k}{SCALAR}) ne 'GLOB' ) {
                    # 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

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

    my $request = shift;
    for(1..4) {
        $ob = $$ob if(ref $ob) eq 'REF';
    }
    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

By my estimate, there are over 10,000 RPC modules on CPAN.  Each one makes RPC more
difficult than the one before it.  They all want you to pass tokens back and forth,
register handlers for which methods may be called, create sessions, and so.
With L<Acme::RPC>, there's only one required step:  GET or POST to your method.
And if you don't know which methods are available, L<Acme::RPC> will help you find them.
Even if they're hidden away in objects referenced from inside of closures.

The RPC daemon starts after the program finishes, or whe it does C<< Event::loop >>.

=head2 CGI Parameters

=over 4

=item C<< / >>

(No parameter.)

=item C<< action=dump >>

Gives an index of packages, subroutines, variables in those subroutines, closures in those variables, and so on.

=item C<< output=json >>

Output a JavaScript datastructures (JSON) instead of Perl style L<Data::Dumper> or HTML.
The main index page otherwise prints out HTML (under the assumption that a human will be digging through it)
and other things mostly emit L<Data::Dumper> formatted text.

=item C<< oid=(number) >>

=item C<< path=/path/to/something >>

There are two ways to specify or reference an object:  by it's C<oid> or by the path to navigate to it from the 
main index screen.
JSON and HTML output from the main index screen specifies the oids of each item and the paths can be derived from
the labels in the graph.
With no action specified, it defaults to C<dump>.

=item C<< action=call >>

Invokes a method or code ref.
It does I<not> invoke object references.
Requires either C<oid> or C<path> be specified.
You may also set C<arg0>, C<arg1>, C<arg2> etc GET or POST parameters to pass data into the function.
There's currently no way to pass in an arbitrary object (see TODO below).

=item C<< action=method >>

Used with C<< method=[method name] >> and either an C<< oid=[oid] >> or C<< path=[path] >> to an
object reference, it calls that method on that object.
As above, takes argument data from C<arg0>, C<arg1>, C<arg2>, etc.

=item C<< lazy=1 >>

Avoid rebuilding the entire object graph to speed things up a bit.

=head2 TODO

C<oidarg[n]> to pass in an arbitrary other object as a parameter.

JSON posted to the server to specify arguments.

JSON posted to the server to specify the entire function/method call.

=head2 BUGS

There is no security.  At all.

A lot of this stuff hasn't been tested.  At all.