view release on metacpan or  search on metacpan

lib/App/Context/POE/Server.pm  view on Meta::CPAN

        else {
            @args = ();
            @args = @{$event->{args}} if ($event->{args});
            $args_str = join(",",@args);
            $state .= sprintf("   %-20s %-40s", $event->{event_token}, "$event->{name}.$event->{method}($args_str)");
            if ($callback_event) {
                @args = ();
                @args = @{$callback_event->{args}} if ($callback_event->{args});
                $args_str = join(",",@args);
                $state .= " => $callback_event->{name}.$callback_event->{method}($args_str)";
            }
            $state .= "\n";
        }
    }

    $state .= "\n";

    ### Only enable this in development, requires a library uncomment as well
    $state .= $self->_state_poe();

    ### THIS DOESN'T WORK YET
    #$state .= $self->_state_q();

    $state .= $self->SUPER::_state();

    &App::sub_exit($state) if ($App::trace);
    return($state);
}

sub _state_poe {
    my ($self) = @_;
    my $state = "";

    ### POE state dumping - Currently commented out because it doesn't gain us much
    ### in the way of visibility, and POE::API::Peek is a CPAN pain
    ### UNCOMMENT THIS IF YOU NEED IT, DEPENDS ON A PAINFUL LIBRARY
    if ($self->{poe_peek}) {
        App->use("POE::API::Peek");
        my $api = POE::API::Peek->new();
        my @queue = $api->event_queue_dump();
        $state .= "POE event_queue_dump\n";
        my $first = 1;
        my $poe_stuff = [qw(ID index priority event type source destination)];
        for my $item (@queue) {
            if ($first) {
                $state .= sprintf("%7s %6s %20s %30s %15s %30s %30s\n", @$poe_stuff);
                $first = 0;
            }
            $state .= sprintf("%7d %6d %20f %30s %15s %30s %30s\n", @{$item}{@$poe_stuff});
        }
        $state .= "\n";
    }

    return $state;
}

### THIS DOESN'T WORK YET, THROWS AN EXCEPTION
sub _state_q {
    my $self = @_;
    my $HOTEL_SITE_QNAME    = "q-hotel_site";
    my $HOTEL_COMPUTE_QNAME = "q-hotel_compute";
    my $state = "";

    for my $qname ("q-hotel_site", "q-hotel_compute") {
        $state .= "$qname\n";
        ### EXCEPTION IS THROWN HERE
        my $q = $self->work_queue($qname);
        my $entries = $q->{data};
        foreach my $entry (@$entries) {
            $state .= sprintf("   {", join("|",%$entry), "}\n");
        }
        $state .= "\n";
    }
    $state .= "\n";

    return $state;
}

sub debug {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;

    my $datetime = time2str("%Y-%m-%d %H:%M:%S", time());
    my $debug = "DEBUG --- Server: $self->{host}:$self->{port}  procs[$self->{num_procs}/$self->{max_procs}:max]  async_events[$self->{num_async_events}/$self->{max_async_events}:max]\n[$datetime]\n";
    $debug .= "\n";
    my $service = $self->{main_service};
    $debug .= $service->debug();

    &App::sub_exit($debug) if ($App::trace);
    return($debug);
}

# TODO: Implement this as a fork() or a context-level message to a node to fork().
#       i.e. messages such as "EVENT:" and "EVENT-OK:"
#       Save the callback_event according to an event_token.
#       Then implement cleanup_pid to send the callback_event.

sub send_async_event {
    &App::sub_entry if ($App::trace);
    my ($self, $event, $callback_event, $unique_event_name, $unique_event_method, $count) = @_;

    my $event_token = $self->new_event_token();
    $event->{event_token} = $event_token;
    $callback_event->{event_token} = $event_token if ($callback_event);
    if (   (   !$unique_event_name
            && !$unique_event_method)
        || (   $unique_event_name
            && $unique_event_method
            && ($self->count_in_pending_async_events($unique_event_name, $unique_event_method) <= $count)) ) {
        push(@{$self->{pending_async_events}}, [ $event, $callback_event ]);
        $self->poe_yield($self->{poe_kernel}, "poe_dispatch_pending_async_events");
    }

    &App::sub_exit($event_token) if ($App::trace);
    return($event_token);
}

sub count_in_pending_async_events {
    &App::sub_entry if ($App::trace);
    my ($self, $event_name, $event_method) = @_;