add xchat r1489

1 files changed, 257 insertions, 0 deletions

diff --git a/plugins/perl/lib/IRC.pm b/plugins/perl/lib/IRC.pm
new file mode 100644
index 00000000..c22a8e73
--- /dev/null
+++ b/plugins/perl/lib/IRC.pm
@@ -0,0 +1,257 @@
+
+package IRC;
+sub IRC::register {
+  my ($script_name, $version, $callback) = @_;
+  my $package = caller;
+  $callback = Xchat::Embed::fix_callback( $package, $callback) if $callback;
+  Xchat::register( $script_name, $version, undef, $callback );
+}
+
+
+sub IRC::add_command_handler {
+  my ($command, $callback) = @_;
+  my $package = caller;
+
+  $callback = Xchat::Embed::fix_callback( $package, $callback );
+
+  # starting index for word_eol array
+  # this is for compatibility with '' as the command
+  my $start_index = $command ? 1 : 0;
+
+  Xchat::hook_command( $command,
+		       sub {
+			 no strict 'refs';
+			 return &{$callback}($_[1][$start_index]);
+		       }
+		     );
+  return;
+}
+
+sub IRC::add_message_handler {
+  my ($message, $callback) = @_;
+  my $package = caller;
+  $callback = Xchat::Embed::fix_callback( $package, $callback );
+
+  Xchat::hook_server( $message,
+		      sub {
+			no strict 'refs';
+			return &{$callback}( $_[1][0] );
+		      }
+		    );
+  return;
+}
+
+sub IRC::add_print_handler {
+  my ($event, $callback) = @_;
+  my $package = caller;
+  $callback = Xchat::Embed::fix_callback( $package, $callback );
+  Xchat::hook_print( $event,
+		     sub {
+		       my @word = @{$_[0]};
+		       no strict 'refs';
+		       return &{$callback}( join( ' ', @word[0..3] ), @word );
+		     }
+		   );
+  return;
+}
+
+sub IRC::add_timeout_handler {
+  my ($timeout, $callback) = @_;
+  my $package = caller;
+  $callback = Xchat::Embed::fix_callback( $package, $callback );
+  Xchat::hook_timer( $timeout,
+		     sub {
+		       no strict 'refs';
+		       &{$callback};
+		       return 0;
+		     }
+		   );
+  return;
+}
+
+sub IRC::command {
+  my $command = shift;
+  if( $command =~ m{^/} ) {
+    $command =~ s{^/}{};
+    Xchat::command( $command );
+  } else {
+    Xchat::command( qq[say $command] );
+  }
+}
+
+sub IRC::command_with_channel {
+  my ($command, $channel, $server) = @_;
+  my $old_ctx = Xchat::get_context;
+  my $ctx = Xchat::find_context( $channel, $server );
+
+  if( $ctx ) {
+    Xchat::set_context( $ctx );
+    IRC::command( $command );
+    Xchat::set_context( $ctx );
+  }
+}
+
+sub IRC::command_with_server {
+  my ($command, $server) = @_;
+  my $old_ctx = Xchat::get_context;
+  my $ctx = Xchat::find_context( undef, $server );
+
+  if( $ctx ) {
+    Xchat::set_context( $ctx );
+    IRC::command( $command );
+    Xchat::set_context( $ctx );
+  }
+}
+
+sub IRC::dcc_list {
+  my @dccs;
+  for my $dcc ( Xchat::get_list( 'dcc' ) ) {
+    push @dccs, $dcc->{nick};
+    push @dccs, $dcc->{file} ? $dcc->{file} : '';
+    push @dccs, @{$dcc}{qw(type status cps size)};
+    push @dccs, $dcc->{type} == 0 ? $dcc->{pos} : $dcc->{resume};
+    push @dccs, $dcc->{address32};
+    push @dccs, $dcc->{destfile} ? $dcc->{destfile} : '';
+  }
+  return @dccs;
+}
+
+sub IRC::channel_list {
+  my @channels;
+  for my $channel ( Xchat::get_list( 'channels' ) ) {
+    push @channels, @{$channel}{qw(channel server)},
+      Xchat::context_info( $channel->{context} )->{nick};
+  }
+  return @channels;
+}
+
+sub IRC::get_info {
+  my $id = shift;
+  my @ids = qw(version nick channel server xchatdir away network host topic);
+  
+  if( $id >= 0 && $id <= 8 && $id != 5 ) {
+    my $info = Xchat::get_info($ids[$id]);
+    return defined $info ? $info : '';
+  } else {
+    if( $id == 5 ) {
+      return Xchat::get_info( 'away' ) ? 1 : 0;
+    } else {
+      return 'Error2';
+    }
+  }
+}
+
+sub IRC::get_prefs {
+  return 'Unknown variable' unless defined $_[0];
+  my $result = Xchat::get_prefs(shift);
+  return defined $result ? $result : 'Unknown variable';
+}
+
+sub IRC::ignore_list {
+  my @ignores;
+  for my $ignore ( Xchat::get_list( 'ignore' ) ) {
+    push @ignores, $ignore->{mask};
+    my $flags = $ignore->{flags};
+    push @ignores, $flags & 1, $flags & 2, $flags & 4, $flags & 8, $flags & 16,
+      $flags & 32, ':';
+  }
+  return @ignores;
+}
+
+sub IRC::print {
+  Xchat::print( $_ ) for @_;
+  return;
+}
+
+sub IRC::print_with_channel {
+  Xchat::print( @_ );
+}
+
+sub IRC::send_raw {
+  Xchat::commandf( qq[quote %s], shift );
+}
+
+sub IRC::server_list {
+  my @servers;
+  for my $channel ( Xchat::get_list( 'channels' ) ) {
+    push @servers, $channel->{server} if $channel->{server};
+  }
+  return @servers;
+}
+
+sub IRC::user_info {
+  my $user;
+  if( @_ > 0 ) {
+    $user = Xchat::user_info( shift );
+  } else {
+    $user = Xchat::user_info();
+  }
+
+  my @info;
+  if( $user ) {
+    push @info, $user->{nick};
+    if( $user->{host} ) {
+      push @info, $user->{host};
+    } else {
+      push @info, 'FETCHING';
+    }
+    push @info, $user->{prefix} eq '@' ? 1 : 0;
+    push @info, $user->{prefix} eq '+' ? 1 : 0;
+  }
+  return @info;
+}
+
+sub IRC::user_list {
+  my ($channel, $server) = @_;
+  my $ctx = Xchat::find_context( $channel, $server );
+  my $old_ctx = Xchat::get_context;
+
+  if( $ctx ) {
+    Xchat::set_context( $ctx );
+    my @users;
+    for my $user ( Xchat::get_list( 'users' ) ) {
+      push @users, $user->{nick};
+      if( $user->{host} ) {
+	push @users, $user->{host};
+      } else {
+	push @users, 'FETCHING';
+      }
+      push @users, $user->{prefix} eq '@' ? 1 : 0;
+      push @users, $user->{prefix} eq '+' ? 1 : 0;
+      push @users, ':';
+    }
+    Xchat::set_context( $old_ctx );
+    return @users;
+  } else {
+    return;
+  }
+}
+
+sub IRC::user_list_short {
+  my ($channel, $server) = @_;
+  my $ctx = Xchat::find_context( $channel, $server );
+  my $old_ctx = Xchat::get_context;
+
+  if( $ctx ) {
+    Xchat::set_context( $ctx );
+    my @users;
+    for my $user ( Xchat::get_list( 'users' ) ) {
+      my $nick = $user->{nick};
+      my $host = $user->{host} || 'FETCHING';
+      push @users, $nick, $host;
+    }
+    Xchat::set_context( $old_ctx );
+    return @users;
+  } else {
+    return;
+  }
+
+}
+
+sub IRC::add_user_list {}
+sub IRC::sub_user_list {}
+sub IRC::clear_user_list {}
+sub IRC::notify_list {}
+sub IRC::perl_script_list {}
+
+1