view release on metacpan or  search on metacpan

lib/POE/Devel/Top.pm  view on Meta::CPAN

use Carp;
use POE qw< API::Peek Session >;
use Term::ANSIColor qw< :constants >;


our $VERSION = "0.100";


#
# import()
# ------
sub import {
    my ($class, @args) = @_;

    # if caller line is zero, it means the module was loaded from the
    # command line, in which case we automatically spawn the session
    my ($package, undef, $line) = caller;
    $class->spawn(render => "console", @args)
        if $line == 0 or $package eq __PACKAGE__;
}


#
# spawn()
# -----
sub spawn {
    my ($class, @args) = @_;

    croak "Odd number of argument" if @args % 2 == 1;

    POE::Session->create(
        heap => {
            interval => 2,
            @args
        },

        inline_states => {
            _start => sub {
                $_[KERNEL]->alias_set("[$class]");
                $_[KERNEL]->delay(poe_devel_top_collect => $_[HEAP]->{interval});
            },
            poe_devel_top_collect   => \&collect,
            poe_devel_top_render    => \&render,
            poe_devel_top_store     => \&store,
        },
    );
}


#
# collect()
# -------
sub collect {
    my ($kernel, $heap) = @_[ KERNEL, HEAP ];
    my $poe_api = POE::API::Peek->new;
    my $now = time;

    # collect general data about the current process
    my @times = times;
    my @pwent = getpwuid(int $>);
    my $egid  = (split / /, $))[0];
    my @grent = getgrgid(int $egid);

    my %general = (
        process => {
            pid     => $$,
            uid     => $>,
            gid     => $egid,
            user    => $pwent[0],
            group   => $grent[0],
        },
        resource => {
            utime_self  => $times[0],
            utime_chld  => $times[2],
            stime_self  => $times[1],
            stime_chld  => $times[3],
        },
        poe => {
            sessions    => $poe_api->session_count,
            handles     => $poe_api->handle_count,
            loop        => $poe_api->which_loop,
        },
    );

    # collect information about the sessions
    my $kernel_id = $kernel->ID;
    my @sessions;

    for my $session ($poe_api->session_list) {
        push @sessions, {
          $session->ID eq $kernel_id ? (
              id        => 0,
              aliases   => "[POE::Kernel] id=".$session->ID,
          ) : (
              id        => $session->ID,
              aliases   => join(",", $poe_api->session_alias_list($session)),
          ),
          memory_size   => $poe_api->session_memory_size($session),
          refcount      => $poe_api->get_session_refcount($session),
          events_to     => $poe_api->event_count_to($session),
          events_from   => $poe_api->event_count_from($session),
        };
    }

    @sessions = sort { $a->{id} <=> $b->{id} } @sessions;

    # collect information about the events
    my @events;

    for my $event ($poe_api->event_queue_dump) {
        push @events, {
            id          => $event->{ID},
            name        => $event->{event},
            type        => $event->{type},
            priority    => $event->{priority} > $now ?
                $event->{priority} - $now : $event->{priority},
            source      => $event->{source}->ID,
            destination => $event->{destination}->ID,
        }
    }