irssi/replace.pl

# This script is no longer maintained, please use trigger.pl instead, it has all the features of this script and much more.
# There is a script for converting your replaces-file to a triggers-file on http://wouter.coekaerts.be/irssi/replace.html

use strict;
use Irssi 20020324 qw (command_bind command_runsub command signal_add_first signal_continue);
use Text::ParseWords;
use IO::File;
use Data::Dumper;
use vars qw($VERSION %IRSSI);

$VERSION = '0.1.4';
%IRSSI = (
	authors  	=> 'Wouter Coekaerts',
	contact  	=> 'wouter@coekaerts.be, coekie@#irssi',
	name    	=> 'replace',
	description 	=> '(replaces regexps in incoming events) Please use trigger.pl instead',
	license 	=> 'GPLv2',
	url     	=> 'http://wouter.coekaerts.be/irssi/',
	changed  	=> '20/09/03',
);

Irssi::print("%RThis script is no longer maintained, please use trigger.pl instead, it has all the features of this script and much more.");
Irssi::print("%RThere is a script for converting your replace-file to a trigger-file on http://wouter.coekaerts.be/irssi/replace.html");

my @replaces;

sub cmd_help {
	print ( <<EOF
	
REPLACE ADD [-[no]case] [-channels <channels>] [-masks <masks>] [-command]
            [-[no]<types>] <regexp> <replacement>
REPLACE DELETE <number>|<regexp>
REPLACE LIST
REPLACE SAVE 
REPLACE RELOAD

     -[no]case: regexp is [not] case sensitive
     -channels: only in <channels>. a space-delimited list. (use quotes)
     -masks: only for messages from someone mathing one of the masks
             (space seperated)
     -<[no]types>: [don't] replace these types. The different types are:
                    -publics,-privmsgs,-actions,-parts,-quits,-kicks,
                       -topics,-privactions,-all
                   -all is an alias for all of them, and is the default.
     -command: <replacement> isn't a replacement, but an irssi-command
                   \$S is expanded to the server tag, \$C to channelname
                   \$N to nickname, \$A to his address (foo\@bar.com), 
                   \$M to the message

Examples:
  replace every occurence of shit on #chan1 and #chan2 on ircnet with sh*t
     /REPLACE ADD -channels \"#chan1 ircnet/#chan2\" shit sh*t
  strip all colorcodes from *!lamer\@*
     /REPLACE ADD -masks *!lamer\@* '\\x03\\d?\\d?(,\\d\\d?)?|\\x02|\\x1f|\\x16|\\x06' ''
  strip backgroundcolors from quitmessages
     /REPLACE ADD -quits '\\003(\\d?\\d?),\\d\\d?' '\\003\\\$1'
  never let *!bot1\@foo.bar and *!bot2\@foo.bar hilight you
     /REPLACE ADD -masks '*!bot1\@foo.bar *!bot2\@foo.bar' mynick my\\x02\\x02nick
  avoid being hilighted by !top10 in eggdrops with stats.mod
     /REPLACE ADD -case '(Top.0\\(.*\\): 1.*)mynick' '\$1my\\x02\\x02nick'
  Convert a Windows-1252 Euro to an ISO-8859-15 Euro (same effect as euro.pl)
     /REPLACE ADD '\\x80' '\\xA4'
  Show tabs as spaces, not the inverted I (same effect as tab_stop.pl)
     /REPLACE ADD '\\t' '    '
  
EOF
    );
}

#switches in -all option
my @replace_all_switches = ('publics','privmsgs','actions','privactions','parts','quits','kicks','topics');
#list of all switches
my @replace_switches = ('case','command');
push @replace_switches,@replace_all_switches;
#list of all options (including switches)
my @replace_options = ('all','masks','channels');
push @replace_options, @replace_switches;



############################################
### catch the signals & do the replacing ###
############################################
 
# "message public", SERVER_REC, char *msg, char *nick, char *address, char *target
signal_add_first("message public" => sub {check_signal_message(\@_,1,4,2,3,'publics');});
# "message private", SERVER_REC, char *msg, char *nick, char *address
signal_add_first("message private" => sub {check_signal_message(\@_,1,-1,2,3,'privmsgs');});
# "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
signal_add_first("message irc action" => sub {
	if ($_[4] eq $_[0]->{nick}) {
		check_signal_message(\@_,1,-1,2,3,'actions');
	} else {
		check_signal_message(\@_,1,4,2,3,'actions');
	}
});
# "message part", SERVER_REC, char *channel, char *nick, char *address, char *reason
signal_add_first("message part" => sub {check_signal_message(\@_,4,1,2,3,'parts');});
# "message quit", SERVER_REC, char *nick, char *address, char *reason
signal_add_first("message quit" => sub {check_signal_message(\@_,3,-1,1,2,'quits');});
# "message kick", SERVER_REC, char *channel, char *nick, char *kicker, char *address, char *reason
signal_add_first("message kick" => sub {check_signal_message(\@_,5,1,3,4,'kicks');});
# "message topic", SERVER_REC, char *channel, char *topic, char *nick, char *address
signal_add_first("message topic" => sub {check_signal_message(\@_,2,1,3,4,'topics');});

# do the replaces on $signal's $parammessage parameter, for replaces with $condition set
# in $paramchannel, for $paramnick!$paramaddress
#  set $param* to -1 if not present
sub check_signal_message {
	my ($signal,$parammessage,$paramchannel,$paramnick,$paramaddress,$condition) = @_;
	my ($replace, $channel, $matches);
	my $changed = 0;
	my $server = $signal->[0];
	foreach $replace (@replaces) {
		if (!$replace->{"$condition"}) {
			next; # wrong type of message
		}
		if ($replace->{'channels'} && $paramchannel != -1) { # check if the channel matches
			$matches = 0;
			foreach $channel (split(/ /,$replace->{'channels'})) {
				if (lc($signal->[$paramchannel]) eq $channel
				  || lc($server->{'tag'}.'/'.$signal->[$paramchannel]) eq $channel
				  || lc($server->{'tag'}.'/') eq $channel) {
					$matches = 1;
					last; # this channel matches, stop checking channels
				}
			}
			if (!$matches) {
				next; # this replace doesn't match, try next replace...
			}
		}
			# check the mask
		if ($replace->{'masks'} && !$server->masks_match($replace->{'masks'}, $signal->[$paramnick], $signal->[$paramaddress])) {
			next; # this replace doesn't match
			
		}
		# if were here, this replace matches
		if (!$replace->{'command'}) { # normal replace
			if ($replace->{'case'}) {
				eval('$changed = ($signal->[$parammessage] =~ s<>'. $replace->{'regexp'} . '<27>' . $replace->{'replacement'} . '<27>g) || $changed;');
			} else {
				eval('$changed = ($signal->[$parammessage] =~ s<>'. $replace->{'regexp'} . '<27>' . $replace->{'replacement'} . '<27>gi) || $changed;');
			}
		} else { # command
			if (($replace->{'case'} && $signal->[$parammessage] =~ /$replace->{'regexp'}/)
			     ||(!$replace->{'case'} && $signal->[$parammessage] =~ /$replace->{'regexp'}/i)) {
			     	my $command = $replace->{'replacement'};
				$command =~ s/\$M/$signal->[$parammessage]/g;
				$command =~ s/\$S/$server->{'tag'}/g;
				if ($paramchannel != -1) {$command =~ s/\$C/$signal->[$paramchannel]/g;}
				if ($paramnick != -1) {$command =~ s/\$N/$signal->[$paramnick]/g;}
				if ($paramaddress != -1) {$command =~ s/\$A/$signal->[$paramaddress]/g;}
				$server->command($command);
			}
		}
		#
	}
	if ($changed) {
		signal_continue(@$signal);
	}
}
# expand($display,"C",$name,"N",$number,"M",$mode,"H",$hilight,"S","}{sb_background}")
# stolen from chanact :)
sub expand {
	my ($string, %format) = @_;
	my ($exp, $repl);
	$string =~ s/\$$exp/$repl/g while (($exp, $repl) = each(%format));
	return $string;
}
	
# ugly function, if you know a better way (where /replace add 'a(.)a' '$1' works)
sub do_replace {
	my ($text,$replace,$changed) = @_;
	if (!$replace->{'command'}) { # normal replace
		if ($replace->{'case'}) {
			eval('$_[2] = $_[0] =~ s/'. $replace->{'regexp'} . '/' . $replace->{'replacement'} . '/g || $changed;');
		} else {
			eval('$_[2] = $_[0] =~ s/'. $replace->{'regexp'} . '/' . $replace->{'replacement'} . '/gi || $changed;');
		}
	} else { # command
		#if ($replace->{'case'} {
			if ($text =~ /$replace->{'regexp'}/) {
				command($replace->{'replacement'});
			}
		#}
	}
}

################################
### manage the replaces-list ###
################################

# REPLACE SAVE
sub cmd_save {
	my $filename = Irssi::settings_get_str('replace_file');
	my $io = new IO::File $filename, "w";
	if (defined $io) {
		my $dumper = Data::Dumper->new([\@replaces]);
		$dumper->Purity(1)->Deepcopy(1);
		$io->print($dumper->Dump);
		$io->close;
	}
	Irssi::print("Replaces saved to ".$filename);
}

sub sig_command_script_unload {
	my $script = shift;
	if ($script =~ /(.*\/)?$IRSSI{'name'}\.pl$/) {
		cmd_save();
	}
}

# REPLACE LOAD
sub cmd_load {
	my $filename = Irssi::settings_get_str('replace_file');
	my $io = new IO::File $filename, "r";
	if (not defined $io) {
		print ERROR "error opening replaces file";
		return;
	}
	if (defined $io) {
		no strict 'vars';
		my $text;
		$text .= $_ foreach ($io->getlines);
		my $rep = eval "$text";
		@replaces = @$rep if ref $rep;
	}
	Irssi::print("Replaces loaded from ".$filename);
}

# converts a replace back to '-options "foo" "bar"' form
sub to_string {
	my ($replace) = @_;
	my $string = "\'$replace->{'regexp'}\' \'$replace->{'replacement'}\'";

	# check if all @replace_all_switches are set
	my $all_set = 1;
	foreach my $switch (@replace_all_switches) {
		if (!$replace->{$switch}) {
			$all_set = 0;
			last;
		}
	}
	if ($all_set) {
		$string = '-all '.$string;
		if ($replace->{'case'}) {
			$string = '-case '.$string;
		}
	} else {
		foreach my $switch (@replace_switches) {
			if ($replace->{$switch}) {
				$string = '-'.$switch.' '.$string;
			}
		}
	}
	if ($replace->{'channels'}) {
		$string = "-channels \"$replace->{'channels'}\" ".$string;
	}
	if ($replace->{'masks'}) {
		$string = "-masks \"$replace->{'masks'}\" ".$string;
	}
	
	return $string;
}

# find a replace (for ADD and DELETE), returns index of replace, or -1 if not found
sub find_replace {
	my ($regexp) = @_;
	for (my $i=0;$i<scalar(@replaces);$i++) {
		if ($replaces[$i]->{'regexp'} eq $regexp) {
			return $i;
		}
	}
	return -1; # not found
}


# REPLACE ADD [-options(@replace_options)] <regexp> <replacement> (see help for more)
sub cmd_add {
	my ($data, $server, $item) = @_;
	my @args = &shellwords($data);

	# get regexp and replacement
	my $replacement = pop @args;
	my $regexp = pop @args;
	if (not defined $regexp) {
		print ERROR "not enough parameters";
		return;
	}
	
	# find existing, or make new replace
	my $replace;
	my $index = find_replace($regexp);
	if ($index != -1) { # change existing replace
		$replace = $replaces[$index];
	} else { # new replace
		$replace = {'regexp' => $regexp};
	}
	$replace->{'replacement'} = $replacement;
	
	# parse options
	my $arg = shift @args;
	while ($arg) {
		# -channels <channels>
		if ($arg eq '-channels') {
			$replace->{'channels'} = lc(shift @args);
		}
		# -masks <masks>
		if ($arg eq '-masks') {
			$replace->{'masks'} = shift @args;
		}
		# -all
		if ($arg eq '-all') {
			foreach my $switch (@replace_all_switches) {
				$replace->{$switch} = 1;
			}
		}
		# -<switch>
		foreach my $switch (@replace_switches) {
			# -<switch>
			if ($arg eq '-'.$switch) {
				$replace->{$switch} = 1;
				last;
			}
			# -no<switch>
			elsif ($arg eq '-no'.$switch) {
				$replace->{$switch} = undef;
				last;
			}
		}
		$arg = shift @args;
	}

	#check if some switch from replace_all_switches is set
	my $some_switch = 0;
	foreach my $switch (@replace_all_switches) {
		if ($replace->{$switch}) {
			$some_switch = 1;
			last;
		}
	}

	# if no switch set, default to all
	if (not $some_switch) {
		foreach my $switch (@replace_all_switches) {
			$replace->{$switch} = 1;
		}
	}

	if ($index == -1) { # new replace
		push @replaces, $replace;
		Irssi::print("Added replace " . scalar(@replaces) .": ". to_string($replace));
	} else { # change existing replace
		$replaces[$index] = $replace;
		Irssi::print("Replace " . ($index+1) ." changed to: ". to_string($replace));
	}
}

# REPLACE DELETE <num>|<regexp>
sub cmd_del {
	my ($data, $server, $item) = @_;
	my @args = &shellwords($data);
	my $index = $data-1;
	if ((not $data =~ /^[0-9]*$/) or not exists($replaces[$index])) {
		$index = find_replace($data);
		if ($index == -1) {
			Irssi::print ("Replace $data not found.");
			return;
		}
	}
	print("Deleted ". ($index+1) .": ". to_string($replaces[$index]));
	splice (@replaces,$index,1);
}

# REPLACE LIST
sub cmd_list {
	#my (@args) = @_;
	print ("Replace list:");
	my $i=1;
	foreach my $replace (@replaces) {
		print(" ". $i++ .": ". to_string($replace));
	}
}

######################
### initialisation ###
######################

command_bind('replace help',\&cmd_help);
command_bind('help replace',\&cmd_help);
command_bind('replace add',\&cmd_add);
command_bind('replace list',\&cmd_list);
command_bind('replace delete',\&cmd_del);
command_bind('replace save',\&cmd_save);
command_bind('replace reload',\&cmd_load);
command_bind 'replace' => sub {
    my ( $data, $server, $item ) = @_;
    $data =~ s/\s+$//g;
    command_runsub ( 'replace', $data, $server, $item ) ;
};
signal_add_first 'default command timer' => sub {
	# gets triggered if called with unknown subcommand
	cmd_help();
};

Irssi::signal_add_first('command script load', 'sig_command_script_unload');
Irssi::signal_add_first('command script unload', 'sig_command_script_unload');
Irssi::signal_add('setup saved', 'cmd_save');

# This makes tab completion work
Irssi::command_set_options('replace add',join(' ',@replace_options));

Irssi::settings_add_str($IRSSI{'name'}, 'replace_file', Irssi::get_irssi_dir()."/replaces");

cmd_load();