File Coverage

blib/lib/Sprocket.pm

Criterion	Covered	Total	%
statement	129	144	89.5
branch	21	40	52.5
condition	3	6	50.0
subroutine	31	32	96.8
pod	4	13	30.7
total	188	235	80.0

package Sprocket;

use strict;
use warnings;

our $VERSION = '0.07';

use Carp qw( croak );
use Sprocket::Common;
use POE;

our $sprocket;
our $sprocket_aio;

use Sprocket::AIO;
use Scalar::Util qw( weaken );

use Sprocket::Util::Observable;
use base qw( Sprocket::Util::Observable );

# weak list of all sprocket components
our %COMPONENTS;
our %PLUGINS;

# events sent to process_plugins
sub EVENT_NAME() { 0 }
sub SERVER()     { 1 }
sub CONNECTION() { 2 }


sub import {
    shift;

    my @modules = @_;

    unshift( @modules, 'Common' );
    @modules = map { 'Sprocket::'.$_  } @modules;

    unshift( @modules, 'POE' );

    my $package = caller();
    my @failed;

    foreach my $module ( @modules ) {
        my $code = "package $package; use $module;";
        eval( $code );
        if ( $@ ) {
            warn $@;
            push( @failed, $module );
        }
    }

    unless ( defined( $sprocket ) ) {
        Sprocket->new();
    }

    {
        no strict 'refs';
        *{ $package . '::sprocket' } = \$sprocket;
    }

    @failed and croak 'could not import (' . join( ' ', @failed ) . ')';
}

sub new {
    my $class = shift;
    croak "$class requires an even number of parameters" if @_ % 2;
    return $sprocket if ( defined( $sprocket ) );

    my $self = $sprocket = $class->SUPER::new( @_ );
    $self->{_uuid} = gen_uuid( $self );

    $self->register_hook( [qw(
        sprocket.component.add
        sprocket.component.remove
        sprocket.plugin.add
        sprocket.plugin.remove
        sprocket.shutdown
    )] );

    return $self;
}

sub add_plugin {
    my $self = shift;
    my $uuid = $_[ 0 ]->uuid;

    $PLUGINS{ $uuid } = $_[ 0 ];
    weaken( $PLUGINS{ $uuid } );

    $self->broadcast( 'sprocket.plugin.add', {
        source => $self,
        target => $_[ 0 ],
    } );

    return;
}

sub remove_plugin {
    my ( $self, $uuid ) = @_;

    $self->broadcast( 'sprocket.plugin.remove', {
        source => $self,
        target => $uuid,
    } );

    # supplied the object, get the uuid from it
    $uuid = $uuid->uuid if ( ref( $uuid ) );

    delete $PLUGINS{ $uuid };

    return;
}

sub add_component {
    my $self = shift;
    my $uuid = $_[ 0 ]->uuid;

    $COMPONENTS{ $uuid } = $_[ 0 ];
    weaken( $COMPONENTS{ $uuid } );

    $self->broadcast( 'sprocket.component.add', {
        source => $self,
        target => $_[ 0 ],
    } );

    return;
}

sub remove_component {
    my ( $self, $uuid ) = @_;

    $self->broadcast( 'sprocket.component.remove', {
        source => $self,
        target => $uuid,
    } );

    $uuid = $uuid->uuid if ( ref( $uuid ) );

    my $count = 0;
    delete $COMPONENTS{ $uuid };
    foreach my $id ( keys %COMPONENTS ) {
        next unless defined( $COMPONENTS{ $id } );
        $count++;
    }

    $self->finalize_shutdown() if ( $count == 0 );

    return $count;
}

sub finalize_shutdown {
    my $self = shift;

    # this will self elimiate double calls
    return if ( $self->{__SHUTDOWN__}++ );

    $sprocket_aio->shutdown()
        if ( $sprocket_aio );

    $self->broadcast( 'sprocket.shutdown', {
        source => $self,
    } );

    $self->clear_hooks();

    return;
}

sub get_components {
    # XXX does this make our refs strong again?
    return [ values %COMPONENTS ];
}

sub get_connection {
    my $uuid = $_[ 1 ];

    foreach my $id ( keys %COMPONENTS ) {
        next unless ( defined( $COMPONENTS{ $id } ) );
        if ( my $con = $COMPONENTS{ $id }->get_connection( $uuid, 1 ) ) {
            return $con;
        }
    }

    return undef;
}

sub shutdown_all {
    my $self = shift;

    my $count = 0;
    foreach my $id ( keys %COMPONENTS ) {
        next unless ( defined( $COMPONENTS{ $id } ) );
        $COMPONENTS{ $id }->shutdown( @_ );
        $count++;
    }

    $self->finalize_shutdown() if ( $count == 0 );

    return $count;
}

sub get_plugin {
    my $uuid = $_[ 1 ];

    return defined( $PLUGINS{ $uuid } ) ? $PLUGINS{ $uuid } : undef;
}

sub callback {
    my ( $self, $ses, $event, @etc ) = @_;

    my $id = $self->_resolve_session( $ses );

    return Sprocket::AnonCallback->new( sub {
        $poe_kernel->call( $id => $event => @etc => @_ );
    }, $id );
}

sub postback {
    my ( $self, $ses, $event, @etc ) = @_;

    my $id = $self->_resolve_session( $ses );

    return Sprocket::AnonCallback->new( sub {
        $poe_kernel->post( $id => $event => @etc => @_ );
        return;
    }, $id );
}

sub _resolve_session {
    my ( $self, $ses ) = @_;

    if ( defined( $ses ) && $ses =~ m/^\d+$/ ) {
        return $ses;
    } elsif ( UNIVERSAL::can( $ses, 'ID' ) ) {
        return $ses->ID();
    } else {
        my $s = $poe_kernel->alias_resolve( $ses );
        return $s->ID() if ( $s );
    }

    return $poe_kernel->get_active_session()->ID();
}

sub run {
    shift;
    return $poe_kernel->run( @_ );
}

1;

package Sprocket::AnonCallback;

use POE;

our %callback_ids;

sub new {
    my ( $class, $cb, $id ) = @_;

    my $self = bless( $cb, ref $class || $class );

    $poe_kernel->refcount_increment(
        $Sprocket::AnonCallback::callback_ids{$self} = $id,
        __PACKAGE__
    );

    return $self;
}

sub DESTROY {
    my $self = shift;
    my $id = delete $Sprocket::AnonCallback::callback_ids{"$self"};

    if ( defined( $id ) ) {
        $poe_kernel->refcount_decrement( $id, __PACKAGE__ );
    } else {
        warn "connection callback DESTROY without session_id to refcount_decrement";
    }

    return;
}

1;

__END__