POE-Component-Server-IRC

 view release on metacpan or  search on metacpan

lib/POE/Component/Server/IRC.pm  view on Meta::CPAN

            if ( $lastuse && $pacewait && ( $lastuse + $pacewait ) > time() ) {
                push @$ref, ['263', 'HELP'];
                last SWITCH;
            }
            $self->{state}{lastuse}{help} = time();
        }
        my $item = shift @$args || 'index';
        if (!$self->{_help}) {
            require POE::Component::Server::IRC::Help;
            $self->{_help} = POE::Component::Server::IRC::Help->new();
        }
        $item = lc $item;
        my @lines = $self->{_help}->topic($item);
        if (!scalar @lines) {
            push @$ref, [ '524', $item ];
            last SWITCH;
        }
        my $reply = '704';
        foreach my $line (@lines) {
            push @$ref, {
                prefix  => $server,
                command => $reply,
                params  => [
                    $nick,
                    $item,
                    $line,
                ],
            };
            $reply = '705';
        }
        push @$ref, {
            prefix  => $server,
            command => '706',
            params  => [
               $nick,
               $item,
               'End of /HELP.',
            ],
        };
    }

    return @$ref if wantarray;
    return $ref;
}

sub _daemon_cmd_watch {
    my $self   = shift;
    my $nick   = shift || return;
    my $server = $self->server_name();
    my $ref    = [ ];
    my $args   = [@_];
    my $count  = @$args;

    SWITCH: {
        if (!$count) {
            $args->[0] = 'l';
        }
        my $uid = $self->state_user_uid($nick);
        my $watches = $self->{state}{uids}{$uid}{watches} || { };
        my $list = 0;
        ITEM: foreach my $item ( split m!,!, $args->[0] ) {
            if ( $item =~ m!^\+! ) {
               $item =~ s!^\+!!;
               if ( keys %$watches >= $self->{config}{max_watch} ) {
                  push @$ref, ['512', $self->{config}{max_watch}];
                  next ITEM;
               }
               next ITEM if !$item || !is_valid_nick_name($item);
               # Add_to_watch_list
               $watches->{uc_irc $item} = $item;
               $self->{state}{watches}{uc_irc $item}{uids}{$uid} = 1;
               # Show_watch possible refactor here
               if ( my $tuid = $self->state_user_uid($item) ) {
                  my $rec = $self->{state}{uids}{$tuid};
                  push @$ref, {
                      prefix  => $server,
                      command => '604',
                      params  => [
                          $nick,
                          $rec->{nick},
                          $rec->{auth}{ident},
                          $rec->{auth}{hostname},
                          $rec->{ts},
                          'is online',
                      ],
                  };
               }
               else {
                  my $laston = $self->{state}{watches}{uc_irc $item}{laston} || 0;
                  push @$ref, {
                      prefix  => $server,
                      command => '605',
                      params  => [
                          $nick, $item, '*', '*', $laston, 'is offline'
                      ],
                  };
               }
               next ITEM;
            }
            if ( $item =~ m!^\-! ) {
               $item =~ s!^\-!!;
               next ITEM if !$item;
               $item = uc_irc $item;
               my $pitem = delete $watches->{$item};
               delete $self->{state}{watches}{$item}{uids}{$uid};
               if ( my $tuid = $self->state_user_uid($item) ) {
                  my $rec = $self->{state}{uids}{$tuid};
                  push @$ref, {
                      prefix  => $server,
                      command => '602',
                      params  => [
                          $nick,
                          $rec->{nick},
                          $rec->{auth}{ident},
                          $rec->{auth}{hostname},
                          $rec->{ts},
                          'stopped watching',
                      ],
                  };
               }
               else {

lib/POE/Component/Server/IRC.pm  view on Meta::CPAN

                          $record->{name},
                          {
                              prefix   => ($full || $server),
                              command  => 'MODE',
                              colonify => 0,
                              params   => [
                                  $record->{name},
                                  $parsed_line,
                                  @breply_args,
                              ],
                          },
                          '','-oh',
                       );
                    }
                }
            }
    } # SWITCH

    return @$ref if wantarray;
    return $ref;
}

# :<SID> BMASK <TS> <CHANNAME> <TYPE> :<MASKS>
sub _daemon_peer_bmask {
    my $self        = shift;
    my $peer_id     = shift || return;
    my $prefix      = shift || return;
    my $ref     = [ ];
    my $args    = [ @_ ];
    my $count   = scalar @$args;
    my %map     = qw(b bans e excepts I invex);

    SWITCH: {
        if ( !$count || $count < 4 ) {
            last SWITCH;
        }
        my ($ts,$chan,$trype,$masks) = @$args;
        if ( !$self->state_chan_exists($chan) ) {
            last SWITCH;
        }
        my $chanrec = $self->{state}{chans}{uc_irc($chan)};
        # Simple TS rules apply
        if ( $ts > $chanrec->{ts} ) {
          # Drop MODE
          last SWITCH;
        }
        $self->send_output(
          {
              prefix  => $prefix,
              command => 'BMASK',
              params  => $args,
          },
          grep { $_ ne $peer_id } $self->_state_connected_peers(),
        );
        my $mode_u_set = ( $chanrec->{mode} =~ /u/ );
        my $sid = $self->server_sid();
        my $server = $self->server_name();
        my @local_users = map { $self->_state_uid_route( $_ ) }
                           grep { !$mode_u_set || $chanrec->{users}{$_} =~ /[oh]/ }
                           grep { $_ =~ m!^$sid! } keys %{ $chanrec->{users} };
        my @mask_list = split m!\s+!, $masks;
        my @marsk_list;
        foreach my $marsk ( @mask_list ) {
            my $mask = normalize_mask($marsk);
            my $umask = uc_irc($mask);
            next if $chanrec->{ $map{ $trype } }{$umask};
            $chanrec->{ $map{ $trype } }{$umask} =
              [ $mask, $server, time() ];
            push @marsk_list, $marsk;
        }
        # Only bother with the next bit if we have local users on the channel
        # OR masks to announce
        if ( !@local_users || !@marsk_list ) {
          last SWITCH;
        }
        my @types;
        push @types, "+$trype" for @marsk_list;
        my @output_modes;
        my $length = length($server) + 4
                     + length($chan) + 4;
        my @buffer = ('', '');
        for my $type (@types) {
            my $arg = shift @marsk_list;
            my $mode_line = unparse_mode_line($buffer[0].$type);
            if (length(join ' ', $mode_line, $buffer[1],
                       $arg) + $length > 510) {
               push @output_modes, {
                  prefix   => $server,
                  command  => 'MODE',
                  colonify => 0,
                  params   => [
                    $chanrec->{name},
                    $buffer[0],
                    split /\s+/,
                    $buffer[1],
                  ],
               };
               $buffer[0] = $type;
               $buffer[1] = $arg;
               next;
            }
            $buffer[0] = $mode_line;
            if ($buffer[1]) {
               $buffer[1] = join ' ', $buffer[1], $arg;
            }
            else {
               $buffer[1] = $arg;
            }
        }
        push @output_modes, {
            prefix   => $server,
            command  => 'MODE',
            colonify => 0,
            params   => [
               $chanrec->{name},
               $buffer[0],
               split /\s+/, $buffer[1],
            ],
        };
        $self->send_output($_, @local_users)
               for @output_modes;

lib/POE/Component/Server/IRC.pm  view on Meta::CPAN

        }
        $rec->{auth}{hostname} = $nhost;
        if ($local) {
           $self->send_output(
              {
                  prefix  => $server,
                  command => '396',
                  params  => [
                      $rec->{nick},
                      $nhost,
                      'is now your visible host',
                  ],
              },
              $rec->{route_id},
           );
        }
        $full = $rec->{full}->();
        CHAN: foreach my $uchan ( keys %{ $rec->{chans} } ) {
           my $chan = $self->{state}{chans}{$uchan}{name};
           my $modeline;
           MODES: {
              my $modes = $rec->{chans}{$uchan};
              last MODES if !$modes;
              $modes = join '',
                map { $_->[1] }
                sort { $a->[0] cmp $b->[0] }
                map { my $w = $_; $w =~ tr/ohv/ABC/; [$w, $_] }
                split //, $modes;
              my @args;
              push @args, $_ for
                 map { $rec->{nick} } split //, $modes;
              $modeline = join ' ', "+$modes", @args;
           }
           $self->_send_output_channel_local(
              $chan,
              {
                prefix   => $full,
                command  => 'JOIN',
                colonify => 0,
                params   => [ $chan ],
              },
              $conn_id, '', '', [ qw[chghost extended-join] ]
           );
           $self->_send_output_channel_local(
              $chan,
              {
                prefix   => $full,
                command  => 'JOIN',
                colonify => 0,
                params   => [ $chan, $rec->{account}, $rec->{ircname} ],
              },
              $conn_id, '', 'extended-join', 'chghost'
           );
           if ($modeline) {
              $self->_send_output_channel_local(
                  $chan,
                  {
                      prefix   => $server,
                      command  => 'MODE',
                      colonify => 0,
                      params   => [ $chan, split m! !, $modeline ],
                  },
                  $conn_id, '', '', 'chghost'
              );
           }
           if ($rec->{away}) {
              $self->_send_output_channel_local(
                  $chan,
                  {
                      prefix   => $full,
                      command  => 'AWAY',
                      params   => [ $rec->{away} ],
                  },
                  $conn_id, '', 'away-notify', 'chghost'
              );
           }
        }
    }

    return @$ref if wantarray;
    return $ref;
}

sub _state_do_map {
    my $self   = shift;
    my $nick   = shift || return;
    my $psid   = shift || return;
    my $isoper = shift;
    my $plen   = shift;
    my $ctn    = shift;
    my $ref    = [ ];
    return if !$self->state_sid_exists($psid);
    my $rec = $self->{state}{sids}{$psid};

    SWITCH: {
        my $global = scalar keys %{ $self->{state}{uids} };
        my $local  = scalar keys %{ $rec->{uids} };
        my $suffix = sprintf(" | Users: %5d (%1.2f%%)", $local, ( 100 * $local / $global ) );

        my $prompt = ' ' x $plen;
        substr $prompt, -2, 2, '|-' if $plen;
        substr $prompt, -2, 2, '`-' if !$ctn && $plen;
        my $buffer = $rec->{name} . ( $isoper ? "[$psid]" : '' ) . ' ';
        $buffer .= '-' x ( 64 - length($buffer) - length($prompt) );
        $buffer .= $suffix;

        if ( $plen && $plen > 60 ) {
            push @$ref, {
                prefix  => $self->server_name(),
                command => '016',
                params  => [
                    $nick,
                    join '', $prompt, $rec->{name}
                ],
            };
            last SWITCH;
        }

        push @$ref, {
            prefix  => $self->server_name(),
            command => '015',