plugins/perl/lib/IRC.pm

   1
   2 package IRC;
   3 sub IRC::register {
   4   my ($script_name, $version, $callback) = @_;
   5   my $package = caller;
   6   $callback = Xchat::Embed::fix_callback( $package, undef, $callback) if $callback;
   7   Xchat::register( $script_name, $version, undef, $callback );
   8 }
   9
  10
  11 sub IRC::add_command_handler {
  12   my ($command, $callback) = @_;
  13   my $package = caller;
  14
  15   $callback = Xchat::Embed::fix_callback( $package, undef, $callback );
  16
  17   # starting index for word_eol array
  18   # this is for compatibility with '' as the command
  19   my $start_index = $command ? 1 : 0;
  20
  21   Xchat::hook_command( $command,
  22                        sub {
  23                          no strict 'refs';
  24                          return &{$callback}($_[1][$start_index]);
  25                        }
  26                      );
  27   return;
  28 }
  29
  30 sub IRC::add_message_handler {
  31   my ($message, $callback) = @_;
  32   my $package = caller;
  33   $callback = Xchat::Embed::fix_callback( $package, undef, $callback );
  34
  35   Xchat::hook_server( $message,
  36                       sub {
  37                         no strict 'refs';
  38                         return &{$callback}( $_[1][0] );
  39                       }
  40                     );
  41   return;
  42 }
  43
  44 sub IRC::add_print_handler {
  45   my ($event, $callback) = @_;
  46   my $package = caller;
  47   $callback = Xchat::Embed::fix_callback( $package, undef, $callback );
  48   Xchat::hook_print( $event,
  49                      sub {
  50                        my @word = @{$_[0]};
  51                        no strict 'refs';
  52                        return &{$callback}( join( ' ', @word[0..3] ), @word );
  53                      }
  54                    );
  55   return;
  56 }
  57
  58 sub IRC::add_timeout_handler {
  59   my ($timeout, $callback) = @_;
  60   my $package = caller;
  61   $callback = Xchat::Embed::fix_callback( $package, undef, $callback );
  62   Xchat::hook_timer( $timeout,
  63                      sub {
  64                        no strict 'refs';
  65                        &{$callback};
  66                        return 0;
  67                      }
  68                    );
  69   return;
  70 }
  71
  72 sub IRC::command {
  73   my $command = shift;
  74   if( $command =~ m{^/} ) {
  75     $command =~ s{^/}{};
  76     Xchat::command( $command );
  77   } else {
  78     Xchat::command( qq[say $command] );
  79   }
  80 }
  81
  82 sub IRC::command_with_channel {
  83   my ($command, $channel, $server) = @_;
  84   my $old_ctx = Xchat::get_context;
  85   my $ctx = Xchat::find_context( $channel, $server );
  86
  87   if( $ctx ) {
  88     Xchat::set_context( $ctx );
  89     IRC::command( $command );
  90     Xchat::set_context( $ctx );
  91   }
  92 }
  93
  94 sub IRC::command_with_server {
  95   my ($command, $server) = @_;
  96   my $old_ctx = Xchat::get_context;
  97   my $ctx = Xchat::find_context( undef, $server );
  98
  99   if( $ctx ) {
 100     Xchat::set_context( $ctx );
 101     IRC::command( $command );
 102     Xchat::set_context( $ctx );
 103   }
 104 }
 105
 106 sub IRC::dcc_list {
 107   my @dccs;
 108   for my $dcc ( Xchat::get_list( 'dcc' ) ) {
 109     push @dccs, $dcc->{nick};
 110     push @dccs, $dcc->{file} ? $dcc->{file} : '';
 111     push @dccs, @{$dcc}{qw(type status cps size)};
 112     push @dccs, $dcc->{type} == 0 ? $dcc->{pos} : $dcc->{resume};
 113     push @dccs, $dcc->{address32};
 114     push @dccs, $dcc->{destfile} ? $dcc->{destfile} : '';
 115   }
 116   return @dccs;
 117 }
 118
 119 sub IRC::channel_list {
 120   my @channels;
 121   for my $channel ( Xchat::get_list( 'channels' ) ) {
 122     push @channels, @{$channel}{qw(channel server)},
 123       Xchat::context_info( $channel->{context} )->{nick};
 124   }
 125   return @channels;
 126 }
 127
 128 sub IRC::get_info {
 129   my $id = shift;
 130   my @ids = qw(version nick channel server xchatdir away network host topic);
 131
 132   if( $id >= 0 && $id <= 8 && $id != 5 ) {
 133     my $info = Xchat::get_info($ids[$id]);
 134     return defined $info ? $info : '';
 135   } else {
 136     if( $id == 5 ) {
 137       return Xchat::get_info( 'away' ) ? 1 : 0;
 138     } else {
 139       return 'Error2';
 140     }
 141   }
 142 }
 143
 144 sub IRC::get_prefs {
 145   return 'Unknown variable' unless defined $_[0];
 146   my $result = Xchat::get_prefs(shift);
 147   return defined $result ? $result : 'Unknown variable';
 148 }
 149
 150 sub IRC::ignore_list {
 151   my @ignores;
 152   for my $ignore ( Xchat::get_list( 'ignore' ) ) {
 153     push @ignores, $ignore->{mask};
 154     my $flags = $ignore->{flags};
 155     push @ignores, $flags & 1, $flags & 2, $flags & 4, $flags & 8, $flags & 16,
 156       $flags & 32, ':';
 157   }
 158   return @ignores;
 159 }
 160
 161 sub IRC::print {
 162   Xchat::print( $_ ) for @_;
 163   return;
 164 }
 165
 166 sub IRC::print_with_channel {
 167   Xchat::print( @_ );
 168 }
 169
 170 sub IRC::send_raw {
 171   Xchat::commandf( qq[quote %s], shift );
 172 }
 173
 174 sub IRC::server_list {
 175   my @servers;
 176   for my $channel ( Xchat::get_list( 'channels' ) ) {
 177     push @servers, $channel->{server} if $channel->{server};
 178   }
 179   return @servers;
 180 }
 181
 182 sub IRC::user_info {
 183   my $user;
 184   if( @_ > 0 ) {
 185     $user = Xchat::user_info( shift );
 186   } else {
 187     $user = Xchat::user_info();
 188   }
 189
 190   my @info;
 191   if( $user ) {
 192     push @info, $user->{nick};
 193     if( $user->{host} ) {
 194       push @info, $user->{host};
 195     } else {
 196       push @info, 'FETCHING';
 197     }
 198     push @info, $user->{prefix} eq '@' ? 1 : 0;
 199     push @info, $user->{prefix} eq '+' ? 1 : 0;
 200   }
 201   return @info;
 202 }
 203
 204 sub IRC::user_list {
 205   my ($channel, $server) = @_;
 206   my $ctx = Xchat::find_context( $channel, $server );
 207   my $old_ctx = Xchat::get_context;
 208
 209   if( $ctx ) {
 210     Xchat::set_context( $ctx );
 211     my @users;
 212     for my $user ( Xchat::get_list( 'users' ) ) {
 213       push @users, $user->{nick};
 214       if( $user->{host} ) {
 215         push @users, $user->{host};
 216       } else {
 217         push @users, 'FETCHING';
 218       }
 219       push @users, $user->{prefix} eq '@' ? 1 : 0;
 220       push @users, $user->{prefix} eq '+' ? 1 : 0;
 221       push @users, ':';
 222     }
 223     Xchat::set_context( $old_ctx );
 224     return @users;
 225   } else {
 226     return;
 227   }
 228 }
 229
 230 sub IRC::user_list_short {
 231   my ($channel, $server) = @_;
 232   my $ctx = Xchat::find_context( $channel, $server );
 233   my $old_ctx = Xchat::get_context;
 234
 235   if( $ctx ) {
 236     Xchat::set_context( $ctx );
 237     my @users;
 238     for my $user ( Xchat::get_list( 'users' ) ) {
 239       my $nick = $user->{nick};
 240       my $host = $user->{host} || 'FETCHING';
 241       push @users, $nick, $host;
 242     }
 243     Xchat::set_context( $old_ctx );
 244     return @users;
 245   } else {
 246     return;
 247   }
 248
 249 }
 250
 251 sub IRC::add_user_list {}
 252 sub IRC::sub_user_list {}
 253 sub IRC::clear_user_list {}
 254 sub IRC::notify_list {}
 255 sub IRC::perl_script_list {}
 256
 257 1