view release on metacpan or  search on metacpan

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

                    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
            $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});
            #     }
            # }
            my @isa = ($class, @{$class.'::ISA'});
            for my $package (@isa) {
                for my $k (keys %{$package.'::'}) {
                    next if $k =~ m/[^\w:]/;
                    next if $k =~ m/^_/;
                    next if exists $node->{$k};  # XXX $node->{$class}{chr(0)} could probably point to the correct stash or something
                    next unless *{$package.'::'.$k}{CODE};
                    reg( $node->{$k.'()'}{chr(0)} = sub { $object->can($k)->($object, @_); } ); # XXX hackish
                    # not recursing into the coderef here; if the sub is found hanging off of a stash, we'll recurse into it then.
                }
            }
        } elsif(ref($object) eq 'HASH') {
            # either our parent knows our name and did $node->{whatever} = caller_cv($ref), or else they made something up for us.
            reg( $node->{chr(0)} = $object );
        } elsif(ref($object) eq 'ARRAY') {
            reg( $node->{chr(0)} = $object );
        } elsif(ref($object) eq 'SCALAR') {
            # a scalar... if it's not a ref, this node will get one item put in it; otherwise, it may get many.
            # each of these can put whatever they want into $node!
            # the above is a bit strange in trying to fill in child nodes as well as the node itself... it should probably be recursing. XXX
            reg( $node->{chr(0)} = $object );
            my $scalarcontains = $$object;
            if(ref($scalarcontains) and ref($scalarcontains) ne 'SCALAR') {
                $node->{ref($scalarcontains)} = caller_cv(0)->($scalarcontains);
            }
        } elsif(ref($object) eq 'CODE') {
            # generic name for ourself -- this was found inside another code ref, in instance data, array element, or something.
            reg( $node->{chr(0)} = $object );
            # variables inside code refs
            # walk into the sub and pick out lexical variables
            # normally only closures would contain data in their lexical variables, but with multiple
            # coroutines executing concurrently, there's the chance that a subroutine is currently
            # running, in which case it has data in its pad.  if it's recursive, it might have data
            # at multiple depths too!
            my $p = peek_sub($object);
            for my $k (sort { $a cmp $b } keys %$p) {
                $node->{$k} = caller_cv(0)->($p->{$k});  # anything it contains by way of refs, which might be nothing
                reg( $node->{$k}{chr(0)} = $p->{$k} );  # have to do this after assigning in from the recursie call
            }
        } elsif( ! ref($object) ) {
            # XXX how could we represent constant data, as in the case of our $foo = "hi there", or instance data fields, or...?
        }
        return $node;
    }->('main::');
}

sub tryunref {
    my $ob = shift;
    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]); }'