summary refs log tree commit diff stats
path: root/plugins
AgeCommit message (Expand)Author
2014-01-08Rewrite dns commandTingPing
2013-10-20sysinfo: Fix showing debian version on ubuntuTingPing
2013-10-13Perl: fixed crash when a script exits abnormallyFarow
2013-10-12Rename Strawberry to Hexchat in Perl error messageEustachy Kapusta
2013-10-10Fix a few cppcheck warnings.XhmikosR
2013-10-07Rebrand Perl plugin to HexChat,Farow
2013-10-05some Typos causing lintian moaning: {R,r}eciev.. -> {R,r}eceiv..Alf Gaida
2013-09-30Fix crash in hexchat_pluginpref_list()TingPing
2013-09-29Remove unused gtk-prefs projectTingPing
2013-09-27Update link to site in perl pluginEustachy Kapusta
2013-09-25Make Python version consistent on both platformsTingPing
2013-09-24Remove hextrayTingPing
2013-09-15plugins: fishlim: VS2013 comes with a working stdbool.hArnavion
2013-09-15Convert project files to vs2013Eustachy Kapusta
2013-09-10Exec: Print help on empty stringTingPing
2013-08-26Fix /exec -o on WindowsTingPing
2013-08-26Sysinfo: Add announce optionTingPing
2013-08-26Sysinfo: Fix gentoo detectionhasufell
2013-08-12Fixed munging of whitespace in sysinfo's matching functionsJoshua Theze
2013-08-04Add reload command for plugins and add to guiTingPing
2013-07-30python: Set VERSION using existing VERSION_MAJOR and VERSION_MINOR macros and...Arnavion
2013-07-26Fix some warningsTingPing
2013-07-26Python: Fix callbacks for the "special" print hooksTingPing
2013-07-25Upd: Properly handle http errorsTingPing
2013-07-24Move optimization settings from all subsequent projects to hexchat.propsEustachy Kapusta
2013-07-21Python: return hooks with PyLong_FromVoidPtrTingPing
2013-07-19Python: Use keywords for attributes in emit_print()TingPing
2013-07-19Python: Add support for attributes in hooksTingPing
2013-07-16Updater: fix download linksTingPing
2013-06-22perl: Fixed get_list('networks') to work with new servlist.conf syntax for au...Arnavion
2013-06-04Python: revert 43bd9483ceTingPing
2013-06-02Python: return true/false from set/del_pluginprefTingPing
2013-06-02Python: Save pluginprefs to seperate filesTingPing
2013-06-01be more specific about sysinfo menu entryTingPing
2013-05-30fix crashTingPing
2013-05-22Python: Allow unhooking commands and prints by nameTingPing
2013-05-18Rebrand python about messageTingPing
2013-05-18Support time lists via pythonTingPing
2013-05-17Fix warning from hwmon.c in plugins/sysinfoRichard Hitt
2013-05-14python: Hold a reference to plugin instead of dereferencing hook to get to it.Arnavion
2013-05-10Added help text for sysinfo plugin.Rahat Ahmed
2013-05-09Import hexchat automatically when calling /py execTingPing
2013-05-09Fix returning gtkwin_ptr from python apiTingPing
2013-05-04TypofixBerke Viktor
2013-05-04Use system include syntaxBerke Viktor
2013-05-04Add Python major version to plugin descriptionBerke Viktor
2013-05-04python: fully delete failed pluginsTingPing
2013-05-04fix possible crashTingPing
2013-05-04Fix output nameBerke Viktor
2013-05-03Merge branch 'py3k' of git://github.com/TingPing/hexchatTingPing
generated by cgit-pink 1.4.1 (git 2.36.1) at 2025-01-21 17:07:12 +0000
='n398' href='#n398'>398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 
BEGIN {
	$INC{'Xchat.pm'} = 'DUMMY';
}

$SIG{__WARN__} = sub {
	my $message = shift @_;
	my ($package) = caller;
	
	# redirect Gtk/Glib errors and warnings back to STDERR
	my $message_levels =	qr/ERROR|CRITICAL|WARNING|MESSAGE|INFO|DEBUG/i;
	if( $message =~ /^(?:Gtk|GLib|Gdk)(?:-\w+)?-$message_levels/i ) {
		print STDERR $message;
	} else {

		if( defined &Xchat::Internal::print ) {
			Xchat::print( $message );
		} else {
			warn $message;
		}
	}
};

use File::Spec ();
use File::Basename ();
use File::Glob ();
use List::Util ();
use Symbol();
use Time::HiRes ();
use Carp ();

package Xchat;
use base qw(Exporter);
use strict;
use warnings;

sub PRI_HIGHEST ();
sub PRI_HIGH ();
sub PRI_NORM ();
sub PRI_LOW ();
sub PRI_LOWEST ();

sub EAT_NONE ();
sub EAT_XCHAT ();
sub EAT_PLUIN ();
sub EAT_ALL ();

sub KEEP ();
sub REMOVE ();
sub FD_READ ();
sub FD_WRITE ();
sub FD_EXCEPTION ();
sub FD_NOTSOCKET ();

sub get_context;
sub Xchat::Internal::context_info;
sub Xchat::Internal::print;

our %EXPORT_TAGS = (
	constants => [
		qw(PRI_HIGHEST PRI_HIGH PRI_NORM PRI_LOW PRI_LOWEST), # priorities
		qw(EAT_NONE EAT_XCHAT EAT_PLUGIN EAT_ALL), # callback return values
		qw(FD_READ FD_WRITE FD_EXCEPTION FD_NOTSOCKET), # fd flags
		qw(KEEP REMOVE), # timers
	],
	hooks => [
		qw(hook_server hook_command hook_print hook_timer hook_fd unhook),
	],
	util => [
		qw(register nickcmp strip_code send_modes), # misc
		qw(print prnt printf prntf command commandf emit_print), # output
		qw(find_context get_context set_context), # context
		qw(get_info get_prefs get_list context_info user_info), # input
	],
);

$EXPORT_TAGS{all} = [ map { @{$_} } @EXPORT_TAGS{qw(constants hooks util)}];
our @EXPORT = @{$EXPORT_TAGS{constants}};
our @EXPORT_OK = @{$EXPORT_TAGS{all}};

sub register {
	my $package = Xchat::Embed::find_pkg();
	my $pkg_info = Xchat::Embed::pkg_info( $package );
	my $filename = $pkg_info->{filename};
	my ($name, $version, $description, $callback) = @_;
	
	if( defined $pkg_info->{gui_entry} ) {
		Xchat::print( "Xchat::register called more than once in "
			. $pkg_info->{filename} );
		return ();
	}
	
	$description = "" unless defined $description;
	$pkg_info->{shutdown} = $callback;
	unless( $name && $name =~ /[[:print:]\w]/ ) {
		$name = "Not supplied";
	}
	unless( $version && $version =~ /\d+(?:\.\d+)?/ ) {
		$version = "NaN";
	}
	$pkg_info->{gui_entry} =
		Xchat::Internal::register( $name, $version, $description, $filename );
	# keep with old behavior
	return ();
}

sub _process_hook_options {
	my ($options, $keys, $store) = @_;

	unless( @$keys == @$store ) {
		die 'Number of keys must match the size of the store';
	}

	my @results;

	if( ref( $options ) eq 'HASH' ) {
		for my $index ( 0 .. @$keys - 1 ) {
			my $key = $keys->[$index];
			if( exists( $options->{ $key } ) && defined( $options->{ $key } ) ) {
				${$store->[$index]} = $options->{ $key };
			}
		}
	}

}

sub hook_server {
	return undef unless @_ >= 2;
	my $message = shift;
	my $callback = shift;
	my $options = shift;
	my $package = Xchat::Embed::find_pkg();
	
	$callback = Xchat::Embed::fix_callback( $package, $callback );
	
	my ($priority, $data) = ( Xchat::PRI_NORM, undef );
	_process_hook_options(
		$options,
		[qw(priority data)],
		[\($priority, $data)],
	);
	
	my $pkg_info = Xchat::Embed::pkg_info( $package );
	my $hook = Xchat::Internal::hook_server(
		$message, $priority, $callback, $data
	);
	push @{$pkg_info->{hooks}}, $hook if defined $hook;
	return $hook;
}

sub hook_command {
	return undef unless @_ >= 2;
	my $command = shift;
	my $callback = shift;
	my $options = shift;
	my $package = Xchat::Embed::find_pkg();

	$callback = Xchat::Embed::fix_callback( $package, $callback );
	
	my ($priority, $help_text, $data) = ( Xchat::PRI_NORM, undef, undef );
	_process_hook_options(
		$options,
		[qw(priority help_text data)],
		[\($priority, $help_text, $data)],
	);
	
	my $pkg_info = Xchat::Embed::pkg_info( $package );
	my $hook = Xchat::Internal::hook_command(
		$command, $priority, $callback, $help_text, $data
	);
	push @{$pkg_info->{hooks}}, $hook if defined $hook;
	return $hook;
}

sub hook_print {
	return undef unless @_ >= 2;
	my $event = shift;
	my $callback = shift;
	my $options = shift;
	my $package = Xchat::Embed::find_pkg();

	$callback = Xchat::Embed::fix_callback( $package, $callback );
	
	my ($priority, $run_after, $filter, $data) = ( Xchat::PRI_NORM, 0, 0, undef );
	_process_hook_options(
		$options,
		[qw(priority run_after_event filter data)],
		[\($priority, $run_after, $filter, $data)],
	);
	
	if( $run_after and $filter ) {
		Carp::carp( "Xchat::hook_print's run_after_event and filter options are mutually exclusive, you can only use of them at a time per hook" );
		return;
	}

	if( $run_after ) {
		my $cb = $callback;
		$callback = sub {
			my @args = @_;
			hook_timer( 0, sub {
				$cb->( @args );

				if( ref $run_after eq 'CODE' ) {
					$run_after->( @args );
				}
				return REMOVE;
			});
			return EAT_NONE;
		};
	}

	if( $filter ) {
		my $cb = $callback;
		$callback = sub {
			my @args = @{$_[0]};
			my $event_data = $_[1];
			my $event_name = $event;
			my $last_arg = @args - 1;

			my @new = $cb->( \@args, $event_data, $event_name );

			# allow changing event by returning the new value
			if( @new > @args ) {
				$event_name = pop @new;
			}

			# a filter can either return the new results or it can modify
			# @_ in place. 
			if( @new == @args ) {
				emit_print( $event_name, @new[ 0 .. $last_arg ] );
				return EAT_ALL;
			} elsif(
				join( "\0", @{$_[0]} ) ne join( "\0", @args[ 0 .. $last_arg ] )
			) {
				emit_print( $event_name, @args[ 0 .. $last_arg ] );
				return EAT_ALL;
			}

			return EAT_NONE;
		};

	}

	my $pkg_info = Xchat::Embed::pkg_info( $package );
	my $hook = Xchat::Internal::hook_print(
		$event, $priority, $callback, $data
	);
	push @{$pkg_info->{hooks}}, $hook if defined $hook;
	return $hook;
}

sub hook_timer {
	return undef unless @_ >= 2;
	my ($timeout, $callback, $data) = @_;
	my $package = Xchat::Embed::find_pkg();

	$callback = Xchat::Embed::fix_callback( $package, $callback );

	if(
		ref( $data ) eq 'HASH' && exists( $data->{data} )
		&& defined( $data->{data} )
	) {
		$data = $data->{data};
	}
	
	my $pkg_info = Xchat::Embed::pkg_info( $package );
	my $hook = Xchat::Internal::hook_timer( $timeout, $callback, $data, $package );
	push @{$pkg_info->{hooks}}, $hook if defined $hook;
	return $hook;
}

sub hook_fd {
	return undef unless @_ >= 2;
	my ($fd, $callback, $options) = @_;
	return undef unless defined $fd && defined $callback;

	my $fileno = fileno $fd;
	return undef unless defined $fileno; # no underlying fd for this handle
	
	my ($package) = Xchat::Embed::find_pkg();
	$callback = Xchat::Embed::fix_callback( $package, $callback );
	
	my ($flags, $data) = (Xchat::FD_READ, undef);
	_process_hook_options(
		$options,
		[qw(flags data)],
		[\($flags, $data)],
	);
	
	my $cb = sub {
		my $userdata = shift;
		return $userdata->{CB}->(
			$userdata->{FD}, $userdata->{FLAGS}, $userdata->{DATA},
		);
	};
	
	my $pkg_info = Xchat::Embed::pkg_info( $package );
	my $hook = Xchat::Internal::hook_fd(
		$fileno, $cb, $flags, {
			DATA => $data, FD => $fd, CB => $callback, FLAGS => $flags,
		}
	);
	push @{$pkg_info->{hooks}}, $hook if defined $hook;
	return $hook;
}

sub unhook {
	my $hook = shift @_;
	my $package = shift @_;
	($package) = caller unless $package;
	my $pkg_info = Xchat::Embed::pkg_info( $package );

	if( defined( $hook )
		&& $hook =~ /^\d+$/
		&& grep { $_ == $hook } @{$pkg_info->{hooks}} ) {
		$pkg_info->{hooks} = [grep { $_ != $hook } @{$pkg_info->{hooks}}];
		return Xchat::Internal::unhook( $hook );
	}
	return ();
}

sub _do_for_each {
	my ($cb, $channels, $servers) = @_;

	# not specifying any channels or servers is not the same as specifying
	# undef for both
	# - not specifying either results in calling the callback inthe current ctx
	# - specifying undef for for both results in calling the callback in the
	#   front/currently selected tab
	if( @_ == 3 && !($channels || $servers) ) { 
		$channels = [ undef ];
		$servers = [ undef ];
	} elsif( !($channels || $servers) ) {
		$cb->();
		return 1;
	}

	$channels = [ $channels ] unless ref( $channels ) eq 'ARRAY';

	if( $servers ) {
		$servers = [ $servers ] unless ref( $servers ) eq 'ARRAY';
	} else {
		$servers = [ undef ];
	}

	my $num_done = 0;
	my $old_ctx = Xchat::get_context();
	for my $server ( @$servers ) {
		for my $channel ( @$channels ) {
			if( Xchat::set_context( $channel, $server ) ) {
				$cb->();
				$num_done++
			}
		}
	}
	Xchat::set_context( $old_ctx );
	return $num_done;
}

sub print {
	my $text = shift @_;
	return "" unless defined $text;
	if( ref( $text ) eq 'ARRAY' ) {
		if( $, ) {
			$text = join $, , @$text;
		} else {
			$text = join "", @$text;
		}
	}
	
	return _do_for_each(
		sub { Xchat::Internal::print( $text ); },
		@_
	);
}

sub printf {
	my $format = shift;
	Xchat::print( sprintf( $format, @_ ) );
}

# make Xchat::prnt() and Xchat::prntf() as aliases for Xchat::print() and 
# Xchat::printf(), mainly useful when these functions are exported
sub prnt {
	goto &Xchat::print;
}

sub prntf {
	goto &Xchat::printf;
}

sub command {
	my $command = shift;
	return "" unless defined $command;
	my @commands;
	
	if( ref( $command ) eq 'ARRAY' ) {
		@commands = @$command;
	} else {
		@commands = ($command);
	}
	
	return _do_for_each(
		sub { Xchat::Internal::command( $_ ) foreach @commands },
		@_
	);
}

sub commandf {
	my $format = shift;
	Xchat::command( sprintf( $format, @_ ) );
}

sub set_context {
	my $context;
	if( @_ == 2 ) {
		my ($channel, $server) = @_;
		$context = Xchat::find_context( $channel, $server );
	} elsif( @_ == 1 ) {
		if( defined $_[0] && $_[0] =~ /^\d+$/ ) {
			$context = $_[0];
		} else {
			$context = Xchat::find_context( $_[0] );
		}
	} elsif( @_ == 0 ) {
		$context = Xchat::find_context();
	}
	return $context ? Xchat::Internal::set_context( $context ) : 0;
}

sub get_info {
	my $id = shift;
	my $info;
	
	if( defined( $id ) ) {
		if( grep { $id eq $_ } qw(state_cursor id) ) {
			$info = Xchat::get_prefs( $id );
		} else {
			$info = Xchat::Internal::get_info( $id );
		}
	}
	return $info;
}

sub user_info {
	my $nick = Xchat::strip_code(shift @_ || Xchat::get_info( "nick" ));
	my $user;
	for (Xchat::get_list( "users" ) ) {
		if ( Xchat::nickcmp( $_->{nick}, $nick ) == 0 ) {
			$user = $_;
			last;
		}
	}
	return $user;
}

sub context_info {
	my $ctx = shift @_ || Xchat::get_context;
	my $old_ctx = Xchat::get_context;
	my @fields = (
		qw(away channel charset host id inputbox libdirfs modes network),
		qw(nick nickserv server topic version win_ptr win_status),
		qw(xchatdir xchatdirfs state_cursor),
	);

	if( Xchat::set_context( $ctx ) ) {
		my %info;
		for my $field ( @fields ) {
			$info{$field} = Xchat::get_info( $field );
		}
		
		my $ctx_info = Xchat::Internal::context_info;
		@info{keys %$ctx_info} = values %$ctx_info;
		
		Xchat::set_context( $old_ctx );
		return %info if wantarray;
		return \%info;
	} else {
		return undef;
	}
}

sub get_list {
	unless( grep { $_[0] eq $_ } qw(channels dcc ignore notify users networks) ) {
		Carp::carp( "'$_[0]' does not appear to be a valid list name" );
	}
	if( $_[0] eq 'networks' ) {
		return Xchat::List::Network->get();
	} else {
		return Xchat::Internal::get_list( $_[0] );
	}
}

sub strip_code {
	my $pattern = qr<
		\cB| #Bold
		\cC\d{0,2}(?:,\d{1,2})?| #Color
		\e\[(?:\d{1,2}(?:;\d{1,2})*)?m| # ANSI color code
		\cG| #Beep
		\cO| #Reset
		\cV| #Reverse
		\c_  #Underline
	>x;
		
	if( defined wantarray ) {
		my $msg = shift;
		$msg =~ s/$pattern//g;
		return $msg;
	} else {
		$_[0] =~ s/$pattern//g if defined $_[0];
	}
}

1