view release on metacpan or  search on metacpan

t/ts6_25_list1.t  view on Meta::CPAN

      my $filter = POE::Filter::Stackable->new();
      $filter->push( POE::Filter::Line->new( InputRegexp => '\015?\012', OutputLiteral => "\015\012" ),
                POE::Filter::IRCD->new( debug => 0 ), );
      push @{ $heap->{testc} }, Test::POE::Client::TCP->spawn( alias => $tag, filter => $filter, address => '127.0.0.1', port => $heap->{port}, prefix => $tag );
   }
   return;
}

sub _launch_harpo {
  my ($kernel,$heap) = @_[KERNEL,HEAP];
  foreach my $tag ( qw[harpo] ) {
      my $filter = POE::Filter::Stackable->new();
      $filter->push( POE::Filter::Line->new( InputRegexp => '\015?\012', OutputLiteral => "\015\012" ),
                POE::Filter::IRCD->new( debug => 0 ), );
      push @{ $heap->{testc} }, Test::POE::Client::TCP->spawn( alias => $tag, filter => $filter, address => '127.0.0.1', port => $heap->{port}, prefix => $tag );
   }
   return;
}

sub _launch_client {
  my ($kernel,$heap) = @_[KERNEL,HEAP];
  my $filter = POE::Filter::Stackable->new();
  $filter->push( POE::Filter::Line->new( InputRegexp => '\015?\012', OutputLiteral => "\015\012" ),
             POE::Filter::IRCD->new( debug => 0 ), );
  my $tag = 'client';
  $heap->{client} = Test::POE::Client::TCP->spawn( alias => $tag, filter => $filter, address => '127.0.0.1', port => $heap->{port}, prefix => $tag );
  return;
}

sub testc_registered {
  my ($kernel,$sender) = @_[KERNEL,SENDER];
  pass($_[STATE]);
  $kernel->post( $sender, 'connect' );
  return;
}

sub client_connected {
  my ($kernel,$heap,$sender) = @_[KERNEL,HEAP,SENDER];
  pass($_[STATE]);
  $kernel->post( $sender, 'send_to_server', { command => 'NICK', params => [ 'bobbins' ], colonify => 0 } );
  $kernel->post( $sender, 'send_to_server', { command => 'USER', params => [ 'bobbins', '*', '*', 'bobbins along' ], colonify => 1 } );
  return;
}

sub groucho_connected {
  my ($kernel,$heap,$sender) = @_[KERNEL,HEAP,SENDER];
  pass($_[STATE]);
  $kernel->post( $sender, 'send_to_server', { command => 'PASS', params => [ 'foo', 'TS', '6', '7UP' ], } );
  $kernel->post( $sender, 'send_to_server', { command => 'CAPAB', params => [ 'KNOCK UNDLN DLN TBURST GLN ENCAP UNKLN KLN CHW IE EX HOPS SVS CLUSTER EOB QS' ], colonify => 1 } );
  $kernel->post( $sender, 'send_to_server', { command => 'SERVER', params => [ 'groucho.server.irc', '1', 'Open the door and come in!!!!!!' ], colonify => 1 } );
  $kernel->post( $sender, 'send_to_server', { command => 'SVINFO', params => [ '6', '6', '0', time() ], colonify => 1 } );
  $uidts = time() - 20;
  $kernel->post( $sender, 'send_to_server', { prefix => '7UP', command => 'SID', params => [ 'fake.server.irc', 2, '4AK', 'This is a fake server' ] } );
  $kernel->post( $sender, 'send_to_server', { prefix => '7UP', command => 'UID', params => [ 'groucho', '1', $uidts, '+aiow', 'groucho', 'groucho.marx', '0', $g_gen->_state_gen_uid(), '0', 'Groucho Marx' ], colonify => 1 } );
  $kernel->post( $sender, 'send_to_server', { prefix => '7UPAAAAAA', command => 'AWAY', params => [ 'A minute and a huff' ], colonify => 1 } );
  my $i = 0;
  my @uids;
  while( $i++ < 150 ) {
    my $str = shift @users;
    next if !$str;
    my ($nick,$usr,$host) = split m/[!@]/, $str;
    my $uid = $g_gen->_state_gen_uid();
    push @uids, $uid;
    $kernel->post( $sender, 'send_to_server', { prefix => '7UP', command => 'UID', params => [ $nick, '1', ($uidts-int(rand(1000))), '+i', $usr, $host, '0', $uid, '0', $usr ], colonify => 1 } );
  }
  $kernel->post( $sender, 'send_to_server', { prefix => '7UP', command => 'SJOIN', params => [ ( time() - 50 ), '#marxbros', '+nt', '@7UPAAAAAA' ], colonify => 1 } );
  foreach my $chan ( sort keys %channels ) {
    my $len = 28 + length $chan;
    my $mode = ( $channels{$chan}{mode} || '+nt' );
    my $rec = [ $channels{$chan}{ts}, $chan, $mode ];
    my $j = 0; my $buf = '';
    UID: while ( $j < $channels{$chan}{users} ) {
      my $uid = $uids[$j];
      $j++;
      if (length(join ' ', $buf, '1', $uid)+$len+1 > 510) {
         $kernel->post( $sender, 'send_to_server',
                  {
                      prefix   => '7UP',
                      command  => 'SJOIN',
                      params   => [ @$rec, $buf ],
                      colonify => 1,
                  }
          );
          $buf = $uid;
          next UID;
      }
      $buf = join ' ', $buf, $uid;
      $buf =~ s!^\s+!!;
    }
    if ($buf) {
         $kernel->post( $sender, 'send_to_server',
                  {
                      prefix   => '7UP',
                      command  => 'SJOIN',
                      params   => [ @$rec, $buf ],
                      colonify => 1,
                  }
          );
    }
    if ( $channels{$chan}{topic} ) {
        $kernel->post( $sender, 'send_to_server', { prefix => '7UP', command => 'TBURST',
          params => [ $channels{$chan}{ts}, $chan, $channels{$chan}{tts}, $channels{$chan}{setby}, $channels{$chan}{topic} ], colonify => 1 } );
    }
  }
  $kernel->post( $sender, 'send_to_server', { command => 'EOB', prefix => '7UP' } );
  $kernel->post( $sender, 'send_to_server', { command => 'EOB', prefix => '4AK' } );
  $kernel->post( $sender, 'send_to_server', { command => 'PING', params => [ '7UP' ], colonify => 1 } );
  return;
}

sub harpo_connected {
  my ($kernel,$heap,$sender) = @_[KERNEL,HEAP,SENDER];
  pass($_[STATE]);
  $kernel->post( $sender, 'send_to_server', { command => 'PASS', params => [ 'foo', 'TS', '6', '9T9' ], } );
  $kernel->post( $sender, 'send_to_server', { command => 'CAPAB', params => [ 'KNOCK UNDLN DLN TBURST GLN ENCAP UNKLN KLN CHW IE EX HOPS SVS CLUSTER EOB QS' ], colonify => 1 } );
  $kernel->post( $sender, 'send_to_server', { command => 'SERVER', params => [ 'harpo.server.irc', '1', 'Open the door and come in!!!!!!' ], colonify => 1 } );
  $kernel->post( $sender, 'send_to_server', { command => 'SVINFO', params => [ '6', '6', '0', time() ], colonify => 1 } );
  $uidts = time() - 50;
  $kernel->post( $sender, 'send_to_server', { prefix => '9T9', command => 'UID', params => [ 'harpo', '1', $uidts, '+aiow', 'harpo', 'harpo.marx', '0', $h_gen->_state_gen_uid(), '0', 'Harpo Marx' ], colonify => 1 } );
  my $i = 0;
  my @uids;
  while( $i++ < 150 ) {
    my $str = shift @users;
    next if !$str;
    my ($nick,$usr,$host) = split m/[!@]/, $str;
    my $uid = $h_gen->_state_gen_uid();
    push @uids, $uid;
    $kernel->post( $sender, 'send_to_server', { prefix => '9T9', command => 'UID', params => [ $nick, '1', ($uidts-int(rand(1000))), '+i', $usr, $host, '0', $uid, '0', $usr ], colonify => 1 } );
  }
  $kernel->post( $sender, 'send_to_server', { prefix => '9T9', command => 'SJOIN', params => [ ( time() - 50 ), '#marxbros', '+nt', '@9T9AAAAAA' ], colonify => 1 } );
  foreach my $chan ( sort keys %channels ) {
    my $len = 27 + length $chan;
    my $rec = [ $channels{$chan}{ts}, $chan, '+nt' ];
    my $j = 0; my $buf = '';
    UID: while ( $j < $channels{$chan}{users} ) {
      my $uid = $uids[$j];
      $j++;
      if (length(join ' ', $buf, '1', $uid)+$len+1 > 510) {
         $kernel->post( $sender, 'send_to_server',
                  {
                      prefix   => '9T9',
                      command  => 'SJOIN',
                      params   => [ @$rec, $buf ],
                      colonify => 1,
                  }
          );
          $buf = $uid;
          next UID;
      }
      $buf = join ' ', $buf, $uid;
      $buf =~ s!^\s+!!;
    }
    if ($buf) {
         $kernel->post( $sender, 'send_to_server',
                  {
                      prefix   => '9T9',
                      command  => 'SJOIN',
                      params   => [ @$rec, $buf ],
                      colonify => 1,
                  }
          );
    }
    if ( $channels{$chan}{topic} ) {
        $kernel->post( $sender, 'send_to_server', { prefix => '9T9', command => 'TBURST',
          params => [ $channels{$chan}{ts}, $chan, $channels{$chan}{tts}, $channels{$chan}{setby}, $channels{$chan}{topic} ], colonify => 1 } );
    }
  }
  $kernel->post( $sender, 'send_to_server', { command => 'EOB', prefix => '9T9' } );
  $kernel->post( $sender, 'send_to_server', { command => 'PING', params => [ '9T9' ], colonify => 1 } );
  return;
}

sub client_input {
  my ($heap,$sender,$in) = @_[HEAP,SENDER,ARG0];
  #diag($in->{raw_line}, "\n");
  my $prefix = $in->{prefix};
  my $cmd    = $in->{command};
  my $params = $in->{params};
  if ( $cmd eq 'MODE' && $prefix =~ m!^bobbins! ) {
    pass($cmd);
    $heap->{322} = 0;
    $poe_kernel->post($sender, 'send_to_server', { command => 'LIST' } );
    return;
  }
  if ( $cmd eq '321' ) {