Changeset 5826


Ignore:
Timestamp:
07/04/09 15:27:42 (3 years ago)
Author:
submersible_toaster
Message:

TWHACK! shuffle methods around like crazy . add tests . Transport::IRC almost.......

Location:
trunk/Padre-Plugin-Swarm
Files:
4 added
8 edited
1 moved

Legend:

Unmodified
Added
Removed

  • trunk/Padre-Plugin-Swarm/Makefile.PL

    r5735 r5826  
    55requires      IO::Socket::Multicast 0 
    66requires      IO::Select 0 
     7requires      Params::Util 
     8requires      Class::XSAccessor 
     9requires      Class::AutoUse 
    710test_requires Test::More 0.42 
    811install_share 

  • trunk/Padre-Plugin-Swarm/irc_gw.pl

    r5739 r5826  
    4444 
    4545my $c = AnyEvent->condvar; 
    46  
    47 # display all irc messages for debugging 
    48 #$con->reg_cb ('irc_*' => sub { warn "DEBUG: " . join ('|', %{$_[1]}) . "\n"; }); 
    4946 
    5047$con->reg_cb ( 

  • trunk/Padre-Plugin-Swarm/lib/Padre/Plugin/Swarm.pm

    r5808 r5826  
    124124     
    125125    my $chatframe = Padre::Wx::Swarm::Chat->new($self->main); 
     126     
    126127    #my $sidebar = Padre::Wx::Swarm::VectorScope->new($self->main); 
    127      
    128128    #my $sidebar = Padre::Wx::Swarm::Foo->new($self->main); 
    129129    #$self->set_sidebar( $sidebar ); 
    … …  
    142142} 
    143143 
     144# private subroutine to return the current share directory location 
     145sub _sharedir { 
     146    return Cwd::realpath( 
     147        File::Spec->join(File::Basename::dirname(__FILE__),'Swarm/share') 
     148    ); 
     149} 
     150 
     151 
    144152#sub _start_transports { 
    145153#   my $self = shift; 

  • trunk/Padre-Plugin-Swarm/lib/Padre/Swarm/Service/Chat.pm

    r5822 r5826  
    66use Time::HiRes (); 
    77use Padre::Swarm::Transport::Multicast (); 
    8 use Padre::Service (); 
     8use Padre::Swarm::Service (); 
    99my $marshal = JSON::XS->new->allow_blessed->convert_blessed; 
    1010     
    11 our @ISA = 'Padre::Service'; 
     11our @ISA = 'Padre::Swarm::Service'; 
    1212 
    1313use Class::XSAccessor 
    … …  
    2626    my $self = shift; 
    2727    Padre::Util::debug('Starting chat service'); 
    28     my $mc = Padre::Swarm::Transport::Multicast->new(); 
    29     $mc->subscribe_channel( $_ ) 
     28    $self->_attach_transports; 
     29    Padre::Util::debug('Chat transports attached');   
     30    Padre::Util::debug( $self->transport ); 
     31     
     32    $self->transport->subscribe_channel( $_ ) 
    3033        for $self->service_channels; 
    31     $mc->start;  
    32     $self->set_transport( $mc );  
     34     
     35    Padre::Util::debug('Channels subscribed'); 
     36    $self->transport->start;  
    3337    Time::HiRes::sleep(0.5); # QUACKERY.. socket construction? 
    3438    $self->queue->enqueue( { type=>'disco' , want=>['chat'] } ); 
    … …  
    5054        my @messages; 
    5155        push @messages, 
    52             $self->transport->receive_from_sock($_) 
     56            $self->transport->receive_from_channel($_) 
    5357                for @ready; 
    5458        while ( my ($payload,$frame) = splice(@messages,0,2) ) { 
    … …  
    8892 
    8993sub new { 
    90     my ($class,$config) = @_; 
    91  
    92     my $running : shared = 0 ; 
    93     my $self = bless {running=>$running} , $class; 
     94    my ($class,%config) = @_; 
     95    my $self = bless {%config} , $class; 
    9496    return $self; 
    9597} 

  • trunk/Padre-Plugin-Swarm/lib/Padre/Swarm/Transport/IRC.pm

    r5825 r5826  
    1 package Padre::Transport::IRC; 
     1package Padre::Swarm::Transport::IRC; 
    22 
    33use strict; 
    44use warnings; 
     5use Padre::Swarm::Transport; 
    56 
     7use AnyEvent; 
     8use AnyEvent::IRC::Client; 
     9use Class::XSAccessor 
     10   getters => { 
     11       connection => 'connection', 
     12       condvar  => 'condvar', 
     13   }; 
     14    
    615use Carp; 
    716 
     17our @ISA = 'Padre::Swarm::Transport'; 
     18 
     19 
     20 
    821sub start { 
     22    my $self = shift; 
     23     
     24    my $con = AnyEvent::IRC::Client->new; 
     25    $con->connect ( 
     26        "irc.perl.org" => 6667 , 
     27        { nick => 'swarm_submersible' , 
     28          user => 'Padre-Swarm-Transport-IRC' , 
     29          real => getlogin()  
     30        } 
     31    ); 
     32    $self->{connection} = $con; 
     33    my $c = AnyEvent->condvar; 
     34    $self->{condvar} = $c; 
     35     
     36     
     37 
     38} 
     39 
     40sub shutdown { 
     41    my $self = shift; 
     42    $self->connection->disconnect; 
     43    delete $self->{connection}; 
     44} 
     45 
     46sub _register_irc_callbacks { 
     47    my ($self,$con) = @_; 
     48 
     49 
     50    $con->reg_cb ( 
     51       connect => sub { 
     52          my ($con, $err) = @_; 
     53          if (defined $err) { 
     54         warn "Connect ERROR! => $err\n"; 
     55         $self->condvar->broadcast; 
     56          } else { 
     57         warn "Connected! Yay!\n"; 
     58          } 
     59 
     60        $con->register(  
     61          $self->nickname, 
     62          'Padre-Swarm-Transport-IRC', 
     63          , getlogin()  
     64        ); 
     65        $con->send_srv( JOIN => '#padre' ); 
     66        
     67       }, 
     68       disconnect => sub { 
     69          warn "Oh, got a disconnect: $_[1], exiting...\n"; 
     70          $self->condvar->broadcast; 
     71       } 
     72    ); 
     73 
     74    $con->reg_cb( 
     75       publicmsg => sub { 
     76          my ($handle,$channel,$ircmsg)= @_; 
     77          my $nick = $con->nick; 
     78           
     79          my $body = join (' ',@{ $ircmsg->{params} } ); 
     80          my $msg = {  
     81            user => $ircmsg->{prefix},  
     82            message => $body ,  
     83            type => 'chat', 
     84           }; 
     85           my $frame = { 
     86               address => $handle, 
     87               channel => $channel, 
     88           }; 
     89           warn "Publick message in $channel from $handle"; 
     90           push @{ $self->{incoming_buffer}{$channel} }, [$msg,$frame]; 
     91             
     92       } 
     93    ); 
     94 
     95 
     96} 
     97 
     98 
     99sub _connect_channel { 
     100    my ($self,$channel) = @_; 
     101    my $con = $self->connection; 
     102    my $room = '#padre_swarm_' . $channel; 
     103    warn "Join #padre"; 
     104    $con->send_srv( JOIN => '#padre' ); 
     105} 
     106 
     107 
     108 
     109sub poll { 
     110    my ($self,$time) = @_; 
     111    warn "Polling for $time:"; 
     112    $self->condvar->recv(); 
     113    if ( keys %{ $self->{incoming_buffer} } ) { 
     114        return keys %{ $self->{incoming_buffer} }; 
     115    } 
     116 
     117} 
     118 
     119sub receive_from_channel { 
     120    my ($self,$channel) = @_; 
     121    return unless exists $self->{incoming_buffer}{$channel}; 
     122    shift @{ $self->{incoming_buffer}{$channel} }; 
    9123     
    10124} 
    11125 
    12  
    13 sub shutdown { 
     126sub tell_channel { 
     127    my ($self,$channel,$payload) = @_; 
     128    my $con = $self->connection; 
    14129     
    15      
     130    $con->send_chan( '#padre', 'PRIVMSG', 
     131        '#padre', 
     132        $payload 
     133    ); 
    16134} 
    17  
    18 sub poll { 
    19      
    20 } 
    21  
    221351; 

  • trunk/Padre-Plugin-Swarm/lib/Padre/Swarm/Transport/Multicast.pm

    r5815 r5826  
    55use IO::Select       (); 
    66use IO::Socket::Multicast; 
     7use Padre::Swarm::Transport; 
    78use Params::Util     qw( _INSTANCE _POSINT ); 
    89use Carp             qw( confess croak     ); 
    … …  
    1314        selector => 'selector', 
    1415        started  => 'started', 
     16        sockets  => 'sockets', 
    1517    }; 
    1618 
    1719use constant MCAST_GROUP => '239.255.255.1'; 
     20 
     21our @ISA = 'Padre::Swarm::Transport'; 
    1822 
    1923=pod 
    … …  
    6973    $obj{subscriptions} = {}; 
    7074    $obj{channels}      = {}; 
     75    $obj{sockets}       = {}; 
    7176    $obj{started}       = 0; 
    7277    $obj{selector}      = $selector; 
    … …  
    8186    croak "Transport already started" if $self->started; 
    8287    while ( my ($channel,$loopback) = each %{ $self->subscriptions } ) { 
    83         $self->_connect_socket( $channel, $loopback ); 
     88        $self->_connect_channel( $channel, $loopback ); 
    8489    } 
    8590    return $self->started( 1 ); 
    … …  
    9095    croak "Transport is not started" unless $self->started; 
    9196    while ( my ($channel,$socket) = each %{ $self->channels } ) { 
    92         $self->_shutdown_socket( $channel ); 
     97        $self->_shutdown_channel( $channel ); 
    9398    } 
    9499    $self->started(0); 
    … …  
    102107    { 
    103108        $self->subscriptions->{$channel} = $loopback; 
    104         $self->_connect_socket($channel,$loopback) if $self->started ; 
     109        $self->_connect_channel($channel,$loopback) if $self->started ; 
    105110    } 
    106111    else { 
    … …  
    115120    { 
    116121        delete $self->subscriptions->{$channel}; 
    117         $self->_shutdown_socket($channel); 
     122        $self->_shutdown_channel($channel); 
    118123    } 
    119124    else { 
    … …  
    126131    $timeout ||= 0; 
    127132    warn "Polling before service start!!" unless $self->started; 
    128     return $self->selector->can_read($timeout); 
    129      
     133    my @socks =  $self->selector->can_read($timeout); 
     134    my @channels = map { $self->sockets->{"$_"} } @socks; 
     135    return @channels; 
    130136} 
    131137 
    … …  
    143149} 
    144150 
    145 sub receive_from { 
     151sub receive_from_channel { 
    146152    my ($self,$channel) = @_; 
    147153    if ( exists $self->channels->{$channel} ) { 
    … …  
    159165    my $remote = $sock->recv( $buffer, 65535 ); 
    160166    if  ( $remote ) { 
     167        #warn "Got remote of '$remote'"; 
    161168        my ($rport,$raddr) = sockaddr_in $remote; 
    162169        my $ip = inet_ntoa $raddr; 
    … …  
    171178} 
    172179 
    173 sub _connect_socket { 
     180sub _connect_channel { 
    174181    my ($self,$port,$loopback) = @_; 
    175182    confess "Socket '$port' already connected"  
    … …  
    183190    $self->channels->{$port} = $socket; 
    184191    $self->selector->add( $socket ); 
    185     return 1; 
    186 } 
    187  
    188 sub _shutdown_socket { 
     192    $self->sockets->{"$socket"} = $port; 
     193    return 1; 
     194} 
     195 
     196sub _shutdown_channel { 
    189197    my ($self,$port) = @_; 
    190198    my $socket = delete $self->channels->{$port}; 
    191199    return 1 unless defined $socket; 
    192200    delete $self->subscriptions->{$port}; 
     201    delete $self->sockets->{"$socket"}; 
    193202    $self->selector->remove( $socket ); 
    194203    $socket->mcast_drop( MCAST_GROUP ); 

  • trunk/Padre-Plugin-Swarm/lib/Padre/Wx/Swarm/Chat.pm

    r5822 r5826  
    5656    $self->SetSizer($sizer); 
    5757     
    58     my $service = Padre::Swarm::Service::Chat->new(); 
     58    my $service = Padre::Swarm::Service::Chat->new( 
     59        use_transport => { 
     60            #'Padre::Swarm::Transport::Multicast'=>{}, 
     61            'Padre::Swarm::Transport::IRC'=>{}, 
     62        } 
     63    ); 
    5964    $self->service( $service ); 
    6065     

  • trunk/Padre-Plugin-Swarm/t/05_transport.t

    r5818 r5826  
    3333my @ready = $tr->poll; 
    3434ok( @ready , 'Poll should return some ready handles' ); 
    35 my ($message,$frame) = $tr->receive_from( CHAT ); 
     35my ($message,$frame) = $tr->receive_from_channel( CHAT ); 
    3636is_deeply( $message, $channel_data , 'Received channel data' ); 
    3737ok( !$tr->poll(1) , 'Poll should have no data to read' ); 
Note: See TracChangeset for help on using the changeset viewer.