view release on metacpan or  search on metacpan

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

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