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

## Released under license GPLv2

## CHANGED using external curl program instead of LWP
## CHANGED added ignore feature (affects many places)
# TODO do version checking on the database
# TODO (maybe) SQLite database?
# CHANGED 2011-06-18 added two new function: shownotice and showerror. Added level tags to various printing options. Now all printing done from these three functions: DebugPring, shownotice and showerror.


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

$VERSION = "3.0";

%IRSSI = (
	  'authors'	=> 'Tamara Temple, Jess',
	  'contact'	=> 'tamouse\@gmail.com',
	  'name'	=> 'showtitle',
	  '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'	=> 'GPLv2',
	  'url'		=> 'http://public.tamaratemple.com/irssi/showtitle-'.$VERSION.'.pl.txt'
	 );
	
my $empty_re = qr/^\s*$/; # CHANGED create compiled regex for checking empty strings

my $debug = 0;

# ====================
# = UTILITY ROUTINES =
# ====================

sub DebugPrint { 
	my $debugmsg = shift;
	return undef unless $debug; # CHANGED check for debug flag at top and return if false. 2011-06-10
	return undef if (!$debugmsg || $debugmsg =~ $empty_re); # CHANGED check for empty debug message 2011-06-10
	Irssi::print("%Y[$IRSSI{name}]%n %R[debug]%n " . irssi_safe($debugmsg)); # CHANGED make debug message safe for irssi printing 2011-06-10
}


sub irssi_safe {
	my $s = shift;
	return '' if (!$s || $s =~ $empty_re); # CHANGED check if string is set, return empty string 2011-06-10
	
	$s =~ s/%/%%/g;
	return $s;
}

sub shownotice {
	my $msg = shift;
	return if (!$msg || $msg =~ $empty_re);
	Irssi::print("%Y[$IRSSI{name}]%n $msg");
	
}

sub showerror {
	my $msg = shift;
	return if (!$msg || $msg =~ $empty_re);
	Irssi::print("%Y[$IRSSI{name}]%n %RERROR!! $msg");
}


# ===================
# =  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)})
#
# %ignores - enforces ignore on specific chatnet channels = (chatnet  => {channel => ignoring (on/off)})

my %listen_on = ();
my %filters = ();
my %validusers = ();
my %ignores = (); 

# CHANGED made the database name reflect the version major number, and use package name
my ($major, $minor) = split(/\./,$VERSION);
my $database_basename = $IRSSI{'name'}.'-'.$major;
my $irssi_dir = Irssi::get_irssi_dir();
my $database     = $irssi_dir . "/".$database_basename.".dat";
my $database_tmp = $irssi_dir . "/".$database_basename.".tmp";
my $database_old = $irssi_dir . "/".$database_basename.".dat~";
shownotice("Database is $database");

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

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

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

sub printOnThisWindow {
	my ($server, $target, $msg) = @_;
	my $witem = $server->window_find_item($target);
	$witem->print("[$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};
	}
}

# TODO check to see if filter is already in filter list. if it is, skip it
sub do_filter {
	my ($chatnet, $channel, $filter) = @_;
	@{$filters{$chatnet}{$channel}} = () unless defined $filters{$chatnet}{$channel};
	push @{$filters{$chatnet}{$channel}}, $filter; # TODO why is this not a list?
}

# TODO check to see if user is already in user list, if they are, skip them
sub do_user {
	my ($chatnet, $channel, $user) = @_;
	@{$validusers{$chatnet}{$channel}} = () unless defined $validusers{$chatnet}{$channel};
	push @{$validusers{$chatnet}{$channel}}, ($user);
}

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

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


our %parse_database = (
    listen => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) (on|off)$/ or syntax_error;
        do_listen  $1, $2, $3;
    },
	filter => sub {
		$_[0] =~ /^ ([^ ]*) ([^ ]*) (.*)$/ or syntax_error;
		do_filter $1, $2, $3;
	},
	user => sub {
		$_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
		do_user $1, $2, $3;
	},
	ignore => sub {
		$_[0] =~ /^ ([^ ]*) ([^ ]*) (on|off)$/ or syntax_error;
		do_ignore $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 $chatnet $channel $state\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";
				}
			}
		}
	}
    foreach my $chatnet (keys %ignores) {
        foreach my $channel (keys %{$ignores{$chatnet}}) {
            my $state = $ignores{$chatnet}{$channel};
            print DATABASE "ignore $chatnet $channel $state\n";
        }
    }
    close DATABASE;
    rename $database, $database_old;
    rename $database_tmp, $database;
	shownotice("wrote database");
}

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


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

sub is_html {
	my $url = shift;
	return 0 if (!$url || $url =~ $empty_re);
	my $curl_cmd = "curl";
	my @curlopts = (
	    "--fail",
		"-I",
		"--insecure",			# don't worry if a certificate doesn't pass
	    '-A "Mozilla"', 
		"--connect-timeout 2",
	    "--location",
		"--max-time 10",
	    "--silent"
	);
	my $cmd = $curl_cmd . ' ' . join( ' ', @curlopts ) . ' ' . "'" . $url . "'";
	DebugPrint("cmd=$cmd");
	my @result = `$cmd`;
	if ($!) {
		## OOPS, curl command returned an error
		my $curl_error=$!;
		DebugPrint("Curl command returned an error: $curl_error");
		return 0;
	}
	chomp(@result);
	DebugPrint("Size of result: " . ( $#result + 1 ));
	for (my $i = 0 ; $i <= $#result ; $i++ ) {
	    DebugPrint("$i: $result[$i]");
	}
	my @content_type = grep(/^Content-Type:/,@result);
	DebugPrint("Matches: ".($#content_type+1));
	
	for (my $i = 0; $i < $#content_type+1; $i++) {
		DebugPrint("$i: $content_type[$i]");
		if ($content_type[$i] =~ m:text/x?html:) {
			DebugPrint("It's html!");
			return 1;
		}
	}
	return 0;
}

sub grab_page {
	my $url = shift;
	return undef if (!$url || $url =~ $empty_re);
	my $outputfile = '/tmp/curl.'.time; # cheap way to make a unique file?
	unlink($outputfile); # just to be sure
	my $curl_cmd = "curl";
	my @curlopts = (
	    "--fail", 
		"--insecure",			# don't worry if a certificate doesn't pass
		"-o $outputfile", 
		#"--max-filesize 10240",
	    '-A "Mozilla"', 
		"--connect-timeout 5",
	    "--location",			# follow 302 returns
		"--max-time 15",
	    "--silent", 
		"--show-error"
	);
	my $cmd = $curl_cmd . ' ' . join( ' ', @curlopts ) . ' ' . "'" . $url . "'".' 2>&1';
	DebugPrint("cmd=$cmd");
	my @result = `$cmd`;
	if ($!) {
		## OOPS, curl command returned an error
		my $curl_error=$!;
		showerror("Curl command returned an error: $curl_error");
		return undef;
	}
	DebugPrint("Value of \$#result=$#result");
	if ($#result+1 > 0) {
		shownotice("curl said soething...");
		for (my $i = 0; $i <= $#result; $i++) {
			shownotice("[$i] $result[$i]");
		}
		return;
	}
	
	# grab the contents from the returned file
	unless (open(FH,"< $outputfile"))  {
		showerror("Could not open $outputfile for reading: $!");
		return undef;
	}
	@result = <FH>;
	close(FH);
	unlink($outputfile) unless $debug;
	chomp(@result);

	DebugPrint(($#result+1)." lines returned");
	for (my $i = 0; $i < 20; $i++) {
		if (length($result[$i])>50) {
			my $shorter = substr($result[$i],0,49)."...";
			DebugPrint("$i: $shorter");
		} else {
			DebugPrint("$i: $result[$i]");
		}
	}
	
	return join(' ',@result);
}


sub get_title {
	my $content = shift;
	return "No Title" if (!$content || $content =~ $empty_re);
	my @lines;
	my $title = "No Title";

    $content =~ /<\s*title\s*[^>]*>(.*?)<\/\s*title\s*>/msgi;
	DebugPrint("Match: $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=$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) {
		DebugPrint("url = $url ; filter = $filter");
		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 && is_html($url)) {
		my $page = grab_page($url);
		if ($page && $page !~ $empty_re) {
			my $title = get_title($page);
			if ($title && $title !~ $empty_re) {
				if (pass_filter($server, $target, $url)) {
					me_action($server, $target, "URL <title>: $title");
				} else {
					printOnThisWindow($server,$target,"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 $chatnet $channel $status"); # CHANGED order of keywords in data base to conform to other entries
	} 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 ignored {
	my ($server, $target) = @_;
	my $chatnet = lc_irc $server->{chatnet};
	my $channel = lc_irc $target;
	return ($ignores{$chatnet}{$channel} eq "on") ? 1 : 0;  # good old ternary operator!!

}

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

sub sig_own_showtitle {
	my ($server, $msg, $target) = @_;
	unless ($server && $server->{connected}) {
		showerror("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 =~ /^!/ && !ignored($server,$target)) {
		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");

# CHANGED make showtitle respond to url's in actions as well as messages
#"message irc own_action", SERVER_REC, char *msg, char *target
#"message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target

Irssi::signal_add_last("message irc action", "sig_showtitle");
Irssi::signal_add_last("message irc own_action", "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 =~ $empty_re) {
		# nothing given, just add the current user to this channel
		$address = $witem->{ownnick}->{host};
		$chatnet = lc $server->{chatnet};
		$channel = lc $witem->{name};
	} elsif ($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;
	}
	DebugPrint("address=$address ; chatnet=$chatnet ; channel=$channel (in cmd_stuser_add)");
	
	do_user $chatnet, $channel, $address;
	append_to_database "user $chatnet $channel $address";
	shownotice("$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;
	shownotic("$address removed from $chatnet $channel");
}

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

sub cmd_stuser_list {
	my ($data, $server, $witem) = @_;
	shownotice("User list");
	foreach my $chatnet (keys %validusers) {
		shownotice("$chatnet :");
		foreach my $channel (keys %{$validusers{$chatnet}}) {
			shownotice("  $channel :");
			if (defined $validusers{$chatnet}{$channel}) {
				foreach my $user (@{$validusers{$chatnet}{$channel}}) {
					shownotice("    $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";
	shownotice("$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;
	shownotice("$filter removed from $chatnet $channel");
}

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

sub cmd_stfilter_list {
	my ($data, $server, $witem) = @_;
	shownotice("Filter list");
	foreach my $chatnet (keys %filters) {
		shownotice("$chatnet :");
		foreach my $channel (keys %{$filters{$chatnet}}) {
			shownotice("  $channel :");
			if (defined $filters{$chatnet}{$channel}) {
				foreach my $filter (@{$filters{$chatnet}{$channel}}) {
					shownotice("    $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 $chatnet $channel on";
	shownotice("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;
	shownotice("Listening off $chatnet $channel");
}

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

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

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

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

Irssi::command_bind('stignore', 'cmd_stignore');

sub cmd_stignore_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_ignore $chatnet, $channel, "on";
	append_to_database "ignore on $chatnet $channel";
	shownotice("Ignoring $chatnet $channel");
}

Irssi::command_bind('stignore on', 'cmd_stignore_on');

sub cmd_stignore_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_ignore $chatnet, $channel, "off";
	write_database;
	shownotice("No longer ignoring $chatnet $channel");
}

Irssi::command_bind('stignore off', 'cmd_stignore_off');

sub cmd_stignore_list {
	my ($data, $server, $witem) = @_;
	shownotice("Ignores list");
	foreach my $chatnet (keys %ignores) {
		shownotice("$chatnet :");
		foreach my $channel (keys %{$ignores{$chatnet}}) {
			my $status = $ignores{$chatnet}{$channel} eq "on" ? "on" : "off";
			shownotice("  $channel : $status");
		}
	}
	
}

Irssi::command_bind('stignore list', 'cmd_stignore_list');

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

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

sub cmd_ststatus {
	cmd_stlisten_list(@_);
	cmd_stuser_list(@_);
	cmd_stfilter_list(@_);
	cmd_stignore_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; # do nothing, just report current state of debug
	}
	shownotice("Debug is " . ($debug ? "on" : "off") );
}

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


read_database;

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

cmd_ststatus();


shownotice("$IRSSI{name} $VERSION loaded");