# showtitle2.pl -- Irssi script to show <title> of URLs
## Copyright (c) 2010 Tamara Temple <tamouse@gmail.com>

## Released under license GPLv2

use Irssi qw();
use LWP::UserAgent;
use Data::Dumper::Names;
use strict;
use vars qw($VERSION %IRSSI);

$VERSION = "2.93";

%IRSSI = (
	  'authors'	=> 'Tamara Temple, Jess',
	  'contact'	=> 'tamouse\@gmail.com',
	  'name'	=> 'showtitle2',
	  'description'	=> 'Show the <title> from a URL in the given window. this version has channel specificity and filters, adds in-channel !commands, user management',
	  'license'	=> 'GPL',
	  'url'		=> 'http://public.tamaratemple.com/irssi/showtitle2.pl.txt'
	 );
	
my $debug = 0;
sub DebugPrint {
	my ($debugmsg) = @_;
	Irssi::print("%Y[$IRSSI{name}]%n %R[debug]%n " . $debugmsg) if $debug;
}
sub irssi_safe {
	my $s = $_[0];
	$s =~ s/%/%%/g;
	return $s;
}
#### Datastructures
#
# %listen_on - determines where we are listening = (chatnet => {channel => listening,})
#
# %filters - filters to apply on a per-channel basis = (chatnet => {channel => (filter_regexp)})
#
# %validusers - which users are allowed to do certain commands
#	= (chatnet => {channel => (address)})

our %listen_on = ();
our %filters = ();
our %validusers = ();

our $database     = Irssi::get_irssi_dir . "/showtitle2.dat";
our $database_tmp = Irssi::get_irssi_dir . "/showtitle2.tmp";
our $database_old = Irssi::get_irssi_dir . "/showtitle2.dat~";

######### Some utilities ##########

sub say_message {
	my ($server, $target, $msg) = @_;
	$server->command("msg $target [$IRSSI{name}] $msg");
}

sub lc_irc($) {
    my ($str) = @_;
    $str =~ tr/A-Z[\\]/a-z{|}/;
    return $str;
}

sub uc_irc($) {
    my ($str) = @_;
    $str =~ tr/a-z{|}/A-Z[\\]/;
    return $str;
}

######## Reading and parsing the database ########

sub do_listen {
	my ($chatnet, $channel, $status) = @_;
	if ($status eq "on") {
		$listen_on{$chatnet}{$channel} = $status;
	} else {
		delete $listen_on{$chatnet}{$channel};
	}
}

sub do_filter {
	my ($chatnet, $channel, $filter) = @_;
	@{$filters{$chatnet}{$channel}} = () unless defined $filters{$chatnet}{$channel};
	push @{$filters{$chatnet}{$channel}}, $filter;
}

sub do_user {
	my ($chatnet, $channel, $user) = @_;
	@{$validusers{$chatnet}{$channel}} = () unless defined $validusers{$chatnet}{$channel};
	push @{$validusers{$chatnet}{$channel}}, ($user);
}

sub syntax_error {
	die "[$IRSSI{name} Syntax error reading database";
}


our %parse_database = (
    listen => sub {
        $_[0] =~ /^ (on|off) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_listen $2, $3, $1;
    },
	filter => sub {
		$_[0] =~ /^ ([^ ]*) ([^ ]*) (.*)$/ or syntax_error;
		do_filter $1, $2, $3;
	},
	user => sub {
		$_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
		do_user $1, $2, $3;
	}
);


sub read_database() {
	%listen_on = ();
	%filters = ();
	%validusers = ();
    open DATABASE, $database or return;
    while (<DATABASE>) {
        chomp;
        /^([^ ]*)(| .*)$/ or syntax_error;
        my $func = $parse_database{$1} or syntax_error;
        $func->($2);
    }
    close DATABASE;
}


######## Writing the database to file ########

sub write_database {
    open DATABASE, ">$database_tmp";
    foreach my $chatnet (keys %listen_on) {
        foreach my $channel (keys %{$listen_on{$chatnet}}) {
            my $state = $listen_on{$chatnet}{$channel};
            print DATABASE "listen $state $chatnet $channel\n";
        }
    }
	foreach my $chatnet (keys %filters) {
		foreach my $channel (keys %{$filters{$chatnet}}) {
			if (defined $filters{$chatnet}{$channel}) {
				foreach my $filter (@{$filters{$chatnet}{$channel}}) {
					print DATABASE "filter $chatnet $channel $filter\n";
				}
			}
		}
	}
	foreach my $chatnet (keys %validusers) {
		foreach my $channel (keys %{$validusers{$chatnet}}) {
			if (defined $validusers{$chatnet}{$channel}) {
				foreach my $address (@{$validusers{$chatnet}{$channel}}) {
					print DATABASE "user $chatnet $channel $address\n";
				}
			}
		}
	}
    close DATABASE;
    rename $database, $database_old;
    rename $database_tmp, $database;
	Irssi::print("[$IRSSI{name}] wrote database");
}

sub append_to_database(@) {
    open DATABASE, ">>$database";
    print DATABASE map {"$_\n"} @_;
    close DATABASE;
}


############## URL Processing #############

sub grab_page {
	my ($url) = @_;
	my $content = "";
	
	# Initialize LWP
	my $ua = new LWP::UserAgent;
	$ua->agent('Mozilla/5.0');
	$ua->from('someone@example.com');
	$ua->default_header('Accept-Language'=> "en");
	$ua->timeout(10);
	$ua->max_size(10240);

	# First get the page header
	my $head = $ua->head($url);
	DebugPrint(irssi_safe(Dumper($head)));
	DebugPrint("Is HTML") if $head->{_headers}->content_is_html;
	return '' unless $head->{_headers}->content_is_html;
	
	# Get the page
	my $page = $ua->get($url);
	DebugPrint(irssi_safe(Dumper($page)));
	return $page;
	
}


sub get_title {
	my ($content) = @_;
	my @lines;
	my $title = "No Title";

    $content =~ /<\s*title\s*[^>]*>(.*?)<\/\s*title\s*>/msgi;
	DebugPrint($1);
	$title = $1 if $1;
	$title =~ s/[[:cntrl:]]*//msg;
	$title =~ s/\n/ /msg;
	# handle certain entity codes
	$title =~ s/&nbsp;/ /msg;
	$title =~ s/&[rl]squo;/'/msg;
	$title =~ s/&amp;/&/msg;
	$title =~ s/&lt;/</msg;
	$title =~ s/&gt;/>/msg;
	$title =~ s/&(#39|apos);/'/msg;
	$title =~ s/&#x26;/&/msg;
	$title =~ s/&#8220;/"/msg;
	$title =~ s/&#8221;/"/msg;
	$title =~ s/&quot;/"/msg;

    # begin modifications by Jess
	$title =~ s/YouTube-/YouTube -/msg;
	# end modifications by Jess
	
	# handle all other entity codes
	$title =~ s/&[a-z0-9A-Z]+;//msg;
	$title =~ s/&#x?[0-9a-fA-F]+;//msg;
	
	# Strip repeated spaces
	$title =~ s/\s+/ /msg;
	
	DebugPrint($title);
	return $title;
	
}

sub find_url {
   my $text = shift;
   if($text =~ /\b((ftp|https?):\/\/[a-zA-Z0-9\/\\\:\?\%\.\&\;=#\-\_\!\+\~\,]*)/i){
		DebugPrint($1);
	  return $1;
   }elsif($text =~ /\b(www\.[a-zA-Z0-9\/\\\:\?\%\.\&\;=#\-\_\!\+\~\,]*)/i){
		DebugPrint($1);
	  return "http://".$1;
   }
   return undef;
}

sub pass_filter {
	my ($server, $target, $url) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	return 0 unless ($listen_on{$chatnet}{$channel} eq "on"); # returns false if we're not listening on this channel
	return 1 unless defined $filters{$chatnet}{$channel}; # returns true if there are no filters for this channel
	my @thesefilters = @{$filters{$chatnet}{$channel}};
	return 1 unless (@thesefilters); # returns true if there are no filters for this channel
	foreach my $filter (@thesefilters) {
		return 1 if $url =~ $filter; # returns true if there's a match
	}
	return 0; # no matches, return false
}

sub showtitle {
	my ($server, $msg, $target) = @_;
	my $url = find_url($msg);
	if ($url) {
		my $res = grab_page($url);
		DebugPrint(irssi_safe(Dumper($res)));
		if ($res && $res->{_headers}->content_is_html) {
			my $title = get_title($res->content);
	 		if (pass_filter($server, $target, $url)) {
				$server->command("ACTION $target URL <title>: $title");
			} else {
				my $witem = $server->window_find_item($target);
				$witem->print("URL <title>: $title");
			}
		}
	}
}

########## Command Processing ##########

sub is_validuser {
	my ($user, $chatnet, $channel) = @_;
	return 1 unless defined $validusers{$chatnet}{$channel};
	return 1 unless (@{$validusers{$chatnet}{$channel}});
	foreach my $channeluser (@{$validusers{$chatnet}{$channel}}) {
		return 1 if ($user eq $channeluser);
	}
	return 0;
}

sub process_listen {
	my ($status, $server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	unless(is_validuser($address, $chatnet, $channel)) {
		say_message($server, $nick, "You have insufficient privileges to do that");
		return;
	}
	if ($status eq "on") {
		do_listen $chatnet, $channel, $status;
		append_to_database("listen $status $chatnet $channel");
	} else {
		delete $listen_on{$chatnet}{$channel};
		write_database;
	}
	say_message($server, $target, "listening for $channel is turned $status");
	
}

sub show_listen {
	my ($server, $nick, $address, $target) = @_;
	say_message($server, $nick, "listening on:");
	# Restrict listing to just this chatnet - don't show I'm on other networks
	my $chatnet = lc $server->{chatnet};
	foreach my $channel (keys %{$listen_on{$chatnet}}) {
		my $state = $listen_on{$chatnet}{$channel};
		say_message($server, $nick, "$chatnet: $channel: listening is $state");
	}
}

sub listen_help {
	my ($server, $nick, $address, $target) = @_;
	my @help_msg = (
		"Control whether $IRSSI{name} is listening on a certain channel",
		"",
		"  !st listen on - turns listening on for the current channel/query",
		"  !st listen off - turns listening off for the current channel/query",
		"  !st listen help - displays this message",
		"  !st listen - displays current channel/query's listening status"
		);
	foreach my $m (@help_msg) {
		say_message($server, $nick, $m);
	}
}

sub show_listen_status {
	my ($server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	my $status = $listen_on{$chatnet}{$channel} eq "on" ? "on" : "off";
	say_message($server, $target, "listening is currently $status for $channel");
}

sub add_filter {
	my ($filter, $server, $nick, $address, $target) = @_;
	
	# Check to see if the filter is in a qr/../ form
	unless ($filter =~ /^qr\/.*\//) {
		$filter = eval "qr/" . $filter . "/"; # convert filter to qr/.../ form
	} else {
		$filter = eval $filter;
	}
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	unless(is_validuser($address, $chatnet, $channel)) {
		say_message($server, $nick, "You have insufficient privileges to do that");
		return;
	}
	do_filter $chatnet, $channel, $filter;
	append_to_database "filter $chatnet $channel $filter";
	say_message($server,$target,"added $filter to $channel")
}

sub delete_filter {
	my ($filter, $server, $nick, $address, $target) = @_;
	# Check to see if the filter is in a qr/../ form
	unless ($filter =~ /^qr\/.*\//) {
		$filter = eval "qr/" . $filter . "/"; # convert filter to qr/.../ form
	} else {
		$filter = eval $filter;
	}
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	unless(is_validuser($address, $chatnet, $channel)) {
		say_message($server, $nick, "You have insufficient privileges to do that");
		return;
	}
	my @new_filter_list = ();
	@{$filters{$chatnet}{$channel}} = () unless defined $filters{$chatnet}{$channel};
	foreach my $channelfilter (@{$filters{$chatnet}{$channel}}) {
		unless ($filter eq $channelfilter) {
			push @new_filter_list, ($channelfilter);
		}
	}
	@{$filters{$chatnet}{$channel}} = @new_filter_list;
	write_database;
	say_message($server, $target, "removed $filter from $channel");
}

sub show_filters {
	my ($server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	return unless defined $filters{$chatnet}{$channel};
	say_message($server, $nick, "Filters on $channel:");
	foreach my $filter (@{$filters{$chatnet}{$channel}}) {
		say_message($server, $nick, $filter);
	}
}

sub filter_help {
	my ($server, $nick, $address, $target) = @_;
	my @help_msg = (
		"Filter command help",
		"",
		"   !st filter - show current filtering status",
		"   !st filter add regex - add a regular expression filter to the current channel's filter list",
		"   !st filter delete regex - remove a filter from the current channel's filter list",
		"   !st filter list - list the current channel's filters",
		"   !st filter help - this message",
		"",
		"You can specify the filters either with or without the qr/.../ syntax.",
		"Specifying the qr/.../ syntax is especially useful when you want to include modifiers,",
		"such as setting case-insensitivity, which would be accomplished by:",
		"",
		"!st filter add qr/regex/i",
		"",
		"If you don't specify the qr/.../ syntax, the filter will be converted to use it.",
		"This is especially important to note if you want to delete the filter subsequently."
		);
	foreach my $m (@help_msg) {
		say_message($server, $nick, $m);
	}
}

sub show_filter_status {
	my ($server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	my $filter_status;
	if (defined $filters{$chatnet}{$channel}) {
	 	$filter_status = (@{$filters{$chatnet}{$channel}}) ? "on" : "off";
	} else {
		$filter_status = "off";
	}
	say_message($server, $target, "Filtering for $channel is currently $filter_status");
}

sub add_user {
	my ($user, $server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	unless(is_validuser($address, $chatnet, $channel)) {
		say_message($server, $nick, "You have insufficient privileges to do that");
		return;
	}
	do_user $chatnet, $channel, $user;
	append_to_database "user $chatnet $channel $user";
	say_message($server, $target, "added $user to $channel valid users");
}

sub delete_user {
	my ($user, $server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	unless(is_validuser($address, $chatnet, $channel)) {
		say_message($server, $nick, "You have insufficient privileges to do that");
		return;
	}
	@{$validusers{$chatnet}{$channel}} = () unless defined $validusers{$chatnet}{$channel};
	my @channelusers = @{$validusers{$chatnet}{$channel}};
	my @newuserlist = ();
	foreach my $channeluser (@channelusers) {
		unless ($user eq $channeluser) {
			push @newuserlist, ($channeluser);
		}
	}
	@{$validusers{$chatnet}{$channel}} = @newuserlist;
	write_database;
	say_message($server, $target, "deleted $user from $channel valid users");
}

sub list_users {
	my ($server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	return unless defined $validusers{$chatnet}{$channel};
	say_message($server, $nick, "Users on $chatnet $channel");
	foreach my $user (@{$validusers{$chatnet}{$channel}}) {
		say_message($server, $nick, $user);
	}
}

sub user_request {
	my ($user, $server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	my $botnick = $server->{nick};
	say_message($server,$botnick,"Request from $nick ($address):");
	say_message($server,$botnick,"Please add $user to $chatnet $channel user list");
}

sub user_help {
	my ($server, $nick, $address, $target) = @_;
	my @help_msg = (
		"Valid user help",
		"",
		"   !st user - show current (calling) user's status",
		"   !st user add hostmask - add the hostmask to current channel's valid user list",
		"   !st user delete hostmask - delete the hostmask from the current channel's valid user list",
		"   !st request - request the bot owner to add the current (calling) user's address",
		"	!st request hostmask - request the bot owner to add the given hostmask",
		"   !st user list - list the users for the current channel",
		"   !st user help - this message",
		"",
		"$IRSSI{name} implements a valid user concept that limits",
		"certain commands to people on the valid user list.",
		"Users are kept on a per-chatnet, per-channel basis",
		"and are based on the user's hostmask.",
		"Thus, if you change hostmasks, you will need to be added to",
		"the valid user database again for each channel you want",
		"control over.",
		"",
		"Note if no users are specified for a given channel on a network,",
		"all commands are available freely. This has the unfortunate side-effect",
		"that the first person who adds a user locks it down for everyone else.",
		"(except the bot owner)."
		);
	foreach my $m (@help_msg) {
		say_message($server, $nick, $m);
	}
}

sub show_user_status {
	my ($server, $nick, $address, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	my $status = (is_validuser($address, $chatnet, $channel)) ? " is " : " is not ";
	say_message($server, $target, $nick . $status . "a valid user on $chatnet $channel");
}

sub showtitle_help {
	my ($server, $nick, $address, $target) = @_;
	my @help_msg = (
		"$IRSSI{name} $VERSION help",
		"",
		"the following commands are available:",
		"  !st listen [on|off|list|help]",
		"  !st filter [add regex|delete regex|list|help] ",
		"  !st user [add address|delete address|list|help]",
		"  !st help",
		"",
		"you can also use !showtitle as the command prefix instead of !st"
		);
	foreach my $m (@help_msg) {
		say_message($server, $nick, $m);
	}
	say_message($server, $target, "help sent");
}



our %parse_command = (
	listen => sub {
		my ($data, $server, $nick, $address, $target) = @_;
		SWITCH: {
			$data =~ /^ (on|off)$/ && do {process_listen $1, $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ list$/ && do {show_listen $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ help$/ && do {listen_help $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^$/ && do {show_listen_status $server, $nick, $address, $target; last SWITCH;};
			say_message($server, $target, "Invalid syntax. Try !st listen help");
		}
	},
	filter => sub {
		my ($data, $server, $nick, $address, $target) = @_;
		SWITCH: {
			$data =~ /^ delete (.*)$/ && do {delete_filter $1, $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ list$/ && do {show_filters $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ help$/ && do {filter_help $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ add (.*)$/ && do {add_filter $1, $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^$/ && do {show_filter_status $server, $nick, $address, $target; last SWITCH;};
			say_message($server, $target, "Invalid syntax. Try !st filter help");
		}
	},
	user => sub {
		my ($data, $server, $nick, $address, $target) = @_;
		SWITCH: {
			$data =~ /^ add ([^ ]*)$/ && do {add_user $1, $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ delete ([^ ]*)$/ && do {delete_user $1, $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ request$/ && do {user_request $address, $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ request ([^ ]*)$/ && do {user_request $1, $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ list$/ && do {list_users $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^ help$/ && do {user_help $server, $nick, $address, $target; last SWITCH;};
			$data =~ /^$/ && do {show_user_status $server, $nick, $address, $target; last SWITCH;};
			say_message($server, $target, "Invalid syntax. Try !st user help");
		}
	},
	help => sub {
		my ($data, $server, $nick, $address, $target) = @_;
		showtitle_help($server, $nick, $address, $target);
	}
);

sub process_command {
	my ($server, $msg, $nick, $address, $target) = @_;
	SWITCH: {
	$msg =~ /^!(showtitle|st) ([^ ]*)(| .*)$/ && 
		do {
			my $cmd = $2;
			my $data = $3;
			my $func = $parse_command{$cmd} or 
				do {say_message($server, $target, "Syntax error. Try !st help"); return;};
			$func->($data, $server, $nick, $address, $target);
			last SWITCH;
		};
	$msg =~ /^!(showtitle|st)$/ &&
		do {
			say_message($server, $target, "for help type !st help");
			last SWITCH;
		};
	$msg =~ /^!help(| .*)$/ &&
		do {
			say_message($server, $target, "for help type !st help");
			last SWITCH;
		};
	}
}


sub sig_showtitle {
	my ($server, $msg, $nick, $address, $target) = @_;
	unless ($server && $server->{connected}) {
		Irssi::print "[$IRSSI{name}] not connected to server";
	}
	Irssi::signal_continue @_;
    
	$target = $nick if $target eq "";
	if ($msg =~ /^!/) {
		process_command($server, $msg, $nick, $address, $target);
	} else {
		showtitle($server, $msg, $target);
	}
}

sub sig_own_showtitle {
	my ($server, $msg, $target) = @_;
	unless ($server && $server->{connected}) {
		Irssi::print "[$IRSSI{name}] not connected to server";
	}
	Irssi::signal_continue @_;
	if ($msg =~ /URL <title>:/) {
		# message from me with the title -- ignore this message
		return;
	}
	my $nick = $server->{nick};
	my $address = $server->{userhost};
	if ($msg =~ /^!/) {
		process_command($server, $msg, $nick, $address, $target);
	} else {
		showtitle($server, $msg, $target);
	}
}



Irssi::signal_add_last("message public", "sig_showtitle");
Irssi::signal_add_last("message private", "sig_showtitle");
Irssi::signal_add_last("message own_public", "sig_own_showtitle");
Irssi::signal_add_last("message own_private", "sig_own_showtitle");

########## UI level commands ##########

sub cmd_stuser {
	my ($data, $server, $witem) = @_;
	Irssi::command_runsub "stuser", $data, $server, $witem;
}

Irssi::command_bind('stuser', 'cmd_stuser');

sub cmd_stuser_add {
	my ($data, $server, $witem) = @_;
	my ($chatnet, $channel, $address);
	if ($data =~ /^ *([^ ]+) *$/) {
		# just the hostmask given
		$address = $1;
		$chatnet = lc $server->{chatnet};
		$channel = lc $witem->{name};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) *$/) {
		# channel and hostmask given
		$channel = lc $1;
		$address = $2;
		$chatnet = lc $server->{chatnet};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) +([^ ]+) *$/) {
		# chatnet, channel and hostmask given
		$chatnet = lc $1;
		$channel = lc $2;
		$address = $3;
	}
	do_user $chatnet, $channel, $address;
	append_to_database "user $chatnet $channel $address";
	Irssi::print("[$IRSSI{name}] $address added to $chatnet $channel");
}

Irssi::command_bind('stuser add', 'cmd_stuser_add');

sub cmd_stuser_delete {
	my ($data, $server, $witem) = @_;
	my ($chatnet, $channel, $address);
	if ($data =~ /^ *([^ ]+) *$/) {
		# just the hostmask given
		$address = $1;
		$chatnet = lc $server->{chatnet};
		$channel = lc $witem->{name};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) *$/) {
		# channel and hostmask given
		$channel = lc $1;
		$address = $2;
		$chatnet = lc $server->{chatnet};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) +([^ ]+) *$/) {
		# chatnet, channel and hostmask given
		$chatnet = lc $1;
		$channel = lc $2;
		$address = $3;
	}
	return unless defined $validusers{$chatnet}{$channel};
	$validusers{$chatnet}{$channel} =
		[grep {lc $_ ne lc $address} @{$validusers{$chatnet}{$channel}}];
	write_database;
	Irssi::print("[$IRSSI{name}] $address removed from $chatnet $channel");
}

Irssi::command_bind('stuser delete', 'cmd_stuser_delete');

sub cmd_stuser_list {
	my ($data, $server, $witem) = @_;
	Irssi::print("User list");
	foreach my $chatnet (keys %validusers) {
		Irssi::print("$chatnet :");
		foreach my $channel (keys %{$validusers{$chatnet}}) {
			Irssi::print("  $channel :");
			if (defined $validusers{$chatnet}{$channel}) {
				foreach my $user (@{$validusers{$chatnet}{$channel}}) {
					Irssi::print("    $user");
				}
			}
		}
	}
}

Irssi::command_bind('stuser list', 'cmd_stuser_list');

sub cmd_stfilter {
	my ($data, $server, $witem) = @_;
	Irssi::command_runsub "stfilter", $data, $server, $witem;
}

Irssi::command_bind('stfilter', 'cmd_stfilter');

sub cmd_stfilter_add {
	my ($data, $server, $witem) = @_;
	my ($chatnet, $channel, $filter);
	if ($data =~ /^ *([^ ]+) *$/) {
		# just the filter given
		$filter = $1;
		$chatnet = lc $server->{chatnet};
		$channel = lc $witem->{name};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) *$/) {
		# channel and filter given
		$channel = lc $1;
		$filter = $2;
		$chatnet = lc $server->{chatnet};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) +([^ ]+) *$/) {
		# chatnet, channel and filter given
		$chatnet = lc $1;
		$channel = lc $2;
		$filter = $3;
	}
	unless ($filter =~ /^qr\//) {
		$filter = eval "qr/" . $filter . "/";
	} else {
		$filter = eval $filter;
	}
	do_filter $chatnet, $channel, $filter;
	append_to_database "filter $chatnet $channel $filter";
	Irssi::print("[$IRSSI{name}] $filter added to $chatnet $channel");
}

Irssi::command_bind('stfilter add', 'cmd_stfilter_add');

sub cmd_stfilter_delete {
	my ($data, $server, $witem) = @_;
	my ($chatnet, $channel, $filter);
	if ($data =~ /^ *([^ ]+) *$/) {
		# just the filter given
		$filter = $1;
		$chatnet = lc $server->{chatnet};
		$channel = lc $witem->{name};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) *$/) {
		# channel and filter given
		$channel = lc $1;
		$filter = $2;
		$chatnet = lc $server->{chatnet};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) +([^ ]+) *$/) {
		# chatnet, channel and filter given
		$chatnet = lc $1;
		$channel = lc $2;
		$filter = $3;
	}
	return unless defined $filters{$chatnet}{$channel};
	unless ($filter =~ /^qr\//) {
		$filter = eval "qr/" . $filter . "/";
	} else {
		$filter = eval $filter;
	}
	$filters{$chatnet}{$channel} =
		[grep {lc $_ ne lc $filter} @{$filters{$chatnet}{$channel}}];
	write_database;
	Irssi::print("[$IRSSI{name}] $filter removed from $chatnet $channel");
}

Irssi::command_bind('stfilter delete', 'cmd_stfilter_delete');

sub cmd_stfilter_list {
	my ($data, $server, $witem) = @_;
	Irssi::print("Filter list");
	foreach my $chatnet (keys %filters) {
		Irssi::print("$chatnet :");
		foreach my $channel (keys %{$filters{$chatnet}}) {
			Irssi::print("  $channel :");
			if (defined $filters{$chatnet}{$channel}) {
				foreach my $filter (@{$filters{$chatnet}{$channel}}) {
					Irssi::print("    $filter");
				}
			}
		}
	}
}

Irssi::command_bind('stfilter list', 'cmd_stfilter_list');

sub cmd_stlisten {
	my ($data, $server, $witem) = @_;
	Irssi::command_runsub "stlisten", $data, $server, $witem;
}

Irssi::command_bind('stlisten', 'cmd_stlisten');

sub cmd_stlisten_on {
	my ($data, $server, $witem) = @_;
	my ($chatnet, $channel);
	if ($data =~ /^ *$/) {
		# no arg, use current channel and chatnet
		$chatnet = lc $server->{chatnet};
		$channel = lc $witem->{name};
	} elsif ($data =~ /^ *([^ ]+) *$/) {
		# channel given
		$channel = lc $1;
		$chatnet = lc $server->{chatnet};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) *$/) {
		# chatnet, channel given
		$chatnet = lc $1;
		$channel = lc $2;
	}
	do_listen $chatnet, $channel, "on";
	append_to_database "listen on $chatnet $channel";
	Irssi::print("[$IRSSI{name}] Listening on $chatnet $channel");
}

Irssi::command_bind('stlisten on', 'cmd_stlisten_on');

sub cmd_stlisten_off {
	my ($data, $server, $witem) = @_;
	my ($chatnet, $channel);
	if ($data =~ /^ *$/) {
		# no arg, use current channel and chatnet
		$chatnet = lc $server->{chatnet};
		$channel = lc $witem->{name};
	} elsif ($data =~ /^ *([^ ]+) *$/) {
		# channel given
		$channel = lc $1;
		$chatnet = lc $server->{chatnet};
	} elsif ($data =~ /^ *([^ ]+) +([^ ]+) *$/) {
		# chatnet, channel given
		$chatnet = lc $1;
		$channel = lc $2;
	}
	do_listen $chatnet, $channel, "off";
	write_database;
	Irssi::print("[$IRSSI{name}] Listening off $chatnet $channel");
}

Irssi::command_bind('stlisten off', 'cmd_stlisten_off');

sub cmd_stlisten_list {
	my ($data, $server, $witem) = @_;
	Irssi::print("Listen list");
	foreach my $chatnet (keys %listen_on) {
		Irssi::print("$chatnet :");
		foreach my $channel (keys %{$listen_on{$chatnet}}) {
			my $status = $listen_on{$chatnet}{$channel} eq "on" ? "on" : "off";
			Irssi::print("  $channel : $status");
		}
	}
	
}

Irssi::command_bind('stlisten list', 'cmd_stlisten_list');

sub cmd_save {
	my ($data, $server, $witem) = @_;
	return 0 if (!$witem);
	write_database;
}

Irssi::command_bind('stsave', 'cmd_save');

sub cmd_ststatus {
	cmd_stlisten_list(@_);
	cmd_stuser_list(@_);
	cmd_stfilter_list(@_);
}

Irssi::command_bind('ststatus', 'cmd_ststatus');

sub cmd_debug {
	my ($data, $server, $witem) = @_;
	if ($data =~ /\bon\b/i) {
		$debug = 1;
	} elsif ($data =~ /\boff\b/i) {
		$debug = 0;
	} elsif ($data =~ /^\s*$/) {
		$debug = $debug ? 0 : 1;
	}
	my $state = $debug ? "on" : "off";
	Irssi::print("[$IRSSI{name}] Debug is " . $state );
}

Irssi::command_bind('stdebug', 'cmd_debug');


read_database;

Irssi::timeout_add 60*60*1000, sub {write_database}, undef;

cmd_ststatus();


Irssi::print("$IRSSI{name} $VERSION loaded");