#!/pro/bin/perl

package IRC::Bot;

use strict;
use warnings;

# TODO:
#	Allow host lists to cycle through on connect failures
#		Server => [ ... ],
#		search for "reconnect"

use vars qw($VERSION @ISA @EXPORT $log);
$VERSION = "0.28_03";

use Carp;
use POE;
use POE::Component::IRC;
use POSIX qw(setsid strftime);
use Module::Refresh;
use IRC::Bot::Log;
use constant NICK => "bot";
use DB_File;
use Tie::Hash::DBD;
use Text::CSV_XS;
use Date::Calc qw(Delta_YMDHMS Delta_DHMS Add_Delta_YMDHMS Normalize_DHMS);
use DateTime;
use DateTime::TimeZone;
use Cwd qw(getcwd realpath);
use PROCURA::Diac;
use charnames ":alias" => ":pro";
use Unicode::UCD qw( charinfo );
use Encode qw(encode decode);
use Yahoo::Babelfish;
use Google::Translate;
use Lingua::Translate;
use LWP::Simple qw( :DEFAULT $ua );
use CPAN qw( autobundle bundle clean cvs_import expand force fforce
             notest perldoc readme recent recompile report shell upgrade );
use WWW::Shorten::TinyURL;
use WWW::Mechanize;	# Consider using POE::Component::HTTP::Client
use Proc::ProcessTable;
use Sys::Hostname;
use File::Basename;
use Module::CoreList;
use HTML::TreeBuilder;
use Data::Peek;
use XML::Simple;
use List::Util qw( max );

BEGIN { $V::NO_EXIT = $V::NO_EXIT = 1 } require V;

require Exporter;

@ISA     = qw(Exporter AutoLoader);
@EXPORT  = qw();

my $bua  = "clunker3/$VERSION";
my $aid  = "Mozilla/5.0"; # opera/9.50
$ua->agent ($bua);

### Helper subs

sub google_search {
    my @quest = @_;

    # Minimal safety
    for (@quest) {
	m/^[-\w+. ]+$/ or return (undef, "unsafe pattern");
	}

    my $google_search = "http://www.google.com/search?client=opera&rls=en";
    my $quest   = join "+", map {
	my $term = $_;
	$term =~ s/(\W)/sprintf "%%%02X", ord $1/ge;
	$term;
	} @quest;
    my $request = join "&", $google_search, "q=$quest", "sourceid=opera", "num=1", "ie=utf-8", "oe=utf-8";

    $ua->agent ($aid);
    my $result = get ($request);
    $ua->agent ($bua);

    $result or return (undef, "Cannot get the query");

    my ($url, $desc, $short) = ("", "", "");
    my $tree = HTML::TreeBuilder->new ();
    $tree->parse_content ($result) or return (undef, "Cannot parse result");
    foreach my $d ($tree->look_down (_tag => "div", id => "res")) {
	foreach my $l ($d->look_down (_tag => "a")) {
	    $url  = $l->attr ("href");
	    $desc = $l->as_text;
	    last;
	    }
	last;
	}
    $tree->delete;
    $url or return (undef, "Result had no links");

    eval {
	$url && length ($url) > 40 || $url !~ m{^[-\w:/.]+$} and
	    $short = makeashorterlink ($url);
	};
    ($url, $desc, $short);
    } # google_search

sub acronym_search {
    my $acro = lc shift;

    # Minimal safety
    $acro =~ m/^[-\w.]+$/ or return (undef, "unsafe pattern");

    my $quest = "http://www.acronymfinder.com";
    $ua->agent ($aid);
    #print STDERR "$quest/$acro.html\n";
    my $result = get ("$quest/$acro.html");
    unless ($result) {
	$quest = "http://www.netlingo.com/word";
	#print STDERR "$quest/$acro.php\n";
	my $result = get ("$quest/$acro.php");
	}
    $ua->agent ($bua);

    $result or return (undef, "Cannot get the query");

    my ($url, $desc, $short) = ("", "", "");
    my $tree = HTML::TreeBuilder->new ();
    $tree->parse_content ($result) or return (undef, "Cannot parse result");
    #print STDERR $tree->as_HTML (undef, "  ", {});

    if (my $tt = $tree->look_down (_tag => "table", id => "ListResults")) {
	my $tr = $tree->look_down (_tag => "tr", class => "odd");
	foreach my $td ($tr ? $tr->look_down (_tag => "td") : ()) {
	    my $txt = $td->as_text;
	    $txt =~ m/^\**$/ and next;
	    if (my $a = $td->look_down (_tag => "a")) {
		$url = $quest.$a->attr ("href");
		}
	    else {
		$desc = $txt;
		}
	    }
	}
    # If there is just one single hit, there is no ListResults
    elsif (my $h1 = $tree->look_down (_tag => "h1") and
	   my $h2 = $tree->look_down (_tag => "h2")) {
	# <h1 style="margin-bottom:0">What does <strong>TIMTOWTDI</strong> stand for?</h1>
	# <h2 style="margin-top:0;font:normal 1.2em"><strong>TIMTOWTDI</strong> stands for There Is More Than One Way To Do It</h2>
	if (my $acr = $h1->look_down (_tag => "strong")) {
	    my $x = $acr->as_text;
	    my $txt = $h2->as_text;
	    $txt =~ s/^\s*$x\s+stands\s+for\s*:?\s*// and
		$desc = $txt;
	    if (my $u = $tree->look_down (_tag => "link", rel => "canonical")) {
		$url = $u->attr ("href");
		}
	    }
	}
    # DDumper { url => $url, desc => $desc };

    $tree->delete;
#   $url or return (undef, "Result had no links");

    eval {	# short URL's should be no reason to die!
	$url and length ($url) > 40 || $url !~ m{^[-\w:/.]+$} and
	    $short = makeashorterlink ($url);
	};
    ($url, $desc, $short);
    } # acronym_search

sub perlbrowse {
    my ($kernel, $change) = @_;

#   my $url = "http://public.activestate.com/cgi-bin/perlbrowse/p/";
    my $url = "http://perl5.git.perl.org/perl.git/commit/";
    my $wua = WWW::Mechanize->new (agent => $bua, autocheck => 0);

    $wua->get ("$url$change");
    $wua->success or return;

    my $tree = HTML::TreeBuilder->new ();
    $tree->parse_content ($wua->content) or return;

    my ($porter, $subj, $author, $date);
    foreach my $a ($tree->look_down (_tag => "a",     class => "title")) {
	($subj   = $a->as_text) =~ s/\s+$//;
	last;
	}
    foreach my $t ($tree->look_down (_tag => "table", class => "object_header")) {
	foreach my $r ($t->look_down (_tag => "tr")) {
	    my $tag;
	    foreach my $d ($r->look_down (_tag => "td")) {
		(my $txt = $d->as_text) =~ s/\s+$//; $txt =~ s/^\s+//;
		if (defined $tag) {
		    $tag eq "author"    and ($author = $txt) =~ s/\s*[<@].*//;
		    $tag eq "committer" and ($porter = $txt) =~ s/\s*[<@].*//;
		    $tag eq "" && $txt  and ($date   = $txt) =~ s/\s+\+\d.*//;
		    undef $tag;
		    next;
		    }
		$tag = $txt;
		}
	    }
	last;
	}

    my $who = ($author//"AU") eq ($porter//"PO") ? $porter : "$author/$porter";
    return $porter
        ? "Commit $change ($who - $date): $subj - $url$change"
        : "Commit $change not found on perlbrowse";
    } # perlbrowse

sub rtbrowse {
    my ($kernel, $bugid) = @_;

    my $wua = WWW::Mechanize->new (agent => $bua, autocheck => 0);

    my @hit;

    for ( "https://rt.cpan.org/Public/Bug/Display.html?id",
	  "https://rt.perl.org/rt3/Public/Bug/Display.html?id" ) {

	$wua->get ("$_=$bugid");
	$wua->success or next;

	my $msg = $wua->title || "";
	$msg eq "RT Error" and next;

	$msg =~ s/#$bugid/rt #$bugid/ and $msg .= " - $_=$bugid";
	if (m/rt\.perl/) {
	    $msg =~ s/^rt\s*#+([0-9]+)\s*:?\s*/Perl rt #$1: /i;
	    }
	else {
	    $msg =~ s/^(?:Bug\s+)?rt\s*#+([0-9]+)\s*:?\s*/CPAN rt #$1: /i;
	    }
	push @hit, $msg;
	}

    return join "\n" => @hit;
    } # rtbrowse

sub cpan_full_url {
    my $mod = shift;
    $mod =~ s/::/-/g;
    return $mod =~ m{^(([A-Z])[A-Z])[A-Z]*/[^/]+\.t(?:ar\.)?gz$}
	? "http://search.cpan.org/CPAN/authors/id/$2/$1/$mod"
	: "";
    } # cpan_full_url

sub cpan_info {
    my ($modname, @vsn) = split m/\s+/, shift;

    $modname eq "reload" and return "";

    @vsn > 2 and $vsn[0] eq "diff" and shift @vsn;
    @vsn > 2 and return "usage: !cpan module [[diff] [vsn1 [vsn2]]]";
    my @lines = map +( split /\n/, $_ )
        => CPAN::Shell->format_result ("Module", $modname);

    grep m/^No objects of type Module/ => @lines and
	return "\cA\cANo result for $modname @vsn";

    my ($name) = grep m/\b(?: MANPAGE | DESCRIPTION )\s+/x => @lines;
    $name //= "";
    $name      =~   s/^\s+(?: MANPAGE | DESCRIPTION )\s+//x;
    length $name && $name =~ /\Q$modname/ or $name = "$modname - $name";

    my ($ver)  = grep m/\b CPAN_VERSION \s+/x	=> @lines;
        $ver   =~   s/^\s+ CPAN_VERSION \s+//x;

    my ($file) = grep m/\b CPAN_FILE \s+/x	=> @lines;
        $file  =~   s/^\s+ CPAN_FILE \s+//x;
    (my $author = $file) =~ s{.+/(\w+)/.+}{$1};

    @lines = map +( split /\n/, $_ )
        => CPAN::Shell->format_result ("Author", $author);

    my ($fullname) = grep m/\b FULLNAME \s+/x => @lines;
        $fullname  =~   s/^\s+ FULLNAME \s+//x;

    # Get the cpanRating
    (my $dist = basename $file) =~ s/-\d+(?:\.\d+)?\.(?:t(?:ar\.)?gz|bz2?|zip)$//;
#   print "Using '$dist' for distribution\n";
    my $mod_url = "http://search.cpan.org/dist/$dist";
    my $ua = WWW::Mechanize->new (agent => "CPANInfo/$VERSION", autocheck => 0);
    my ($stars, $count, $mod_page) = ("0.0", 0, "");
    eval {
	$ua->get ($mod_url);
	$mod_page = $ua->content;
	$mod_page =~ m{
	    s/img/stars\-(\d.\d)\.gif
	    .+?
	    (\d+) \s+ Reviews
	    }sx and ($stars, $count) = ($1, $2);
	};

    # Get Kwalitee
    my $kwalitee = "";
    eval {
	if ($ua->get ("http://cpants.perl.org/dist/$dist")) {
	    $ua->content =~ m{
		Kwalitee:
		.+?
		(\d+\.\d+%)
		}sx and $kwalitee = $1;
	    }
	};

    my $info = "$name (v$ver/$fullname)";
    $info .= " [Rating" . ($count ? "($count): $stars" : ": none");
    $info .= $kwalitee ? "; Kwalitee: $kwalitee]" : "]";

    if (@vsn) {
	my @other;
	if ($mod_page =~ m{Other Releases(.*?)</form>}is) {
	    my $list = $1;
	    @other = ($list =~ m{option value=".*?$dist-([^/"]+)}g);
	    }
	$vsn[0] eq "diff" and $vsn[0] = $ver;
	@vsn == 1 and push @vsn, $other[0];
	@vsn = sort @vsn;
	$mod_url = "http://search.cpan.org/diff?from=$dist-$vsn[0]&to=$dist-$vsn[1]";
	}
    $info .= " ". $mod_url;

    return $info;
    } # cpan_info

sub p3rl {
    my $req = shift;

    my $xua = LWP::UserAgent->new (
	agent		=> $bua,
	max_redirect	=> 0,
	);

    my $url = "http://p3rl.org/$req";
    print STDERR "Requesting $url\n";
    my $rsp = $xua->request (HTTP::Request->new (GET => "$url"));
    $rsp->is_redirect and return $rsp->header ("Location");
    $rsp->is_success  or  return $rsp->status_line;

    my $tree = HTML::TreeBuilder->new ();
    $tree->parse_content ($rsp->content);
    my @link;
    foreach my $a ($tree->look_down (_tag => "a")) {
	my $h = $a->attr ("href") or next;
	$h =~ m/:/ and push @link, $h;	# Filter local links like /
	}
    $tree->delete;

    return "@link";
    } # p3rl

sub hudson {
    my $re = shift || qr/^./;

    my $xua = LWP::UserAgent->new (
	agent		=> $bua,
	max_redirect	=> 0,
	);

    my $url = "http://sv01:8082/api/xml?wrapper=jobs&xpath=//job";
    my $rsp = $xua->request (HTTP::Request->new (GET => "$url"));
    $rsp->is_redirect and return $rsp->header ("Location");
    $rsp->is_success  or  return $rsp->status_line;

    my $ref = XMLin ($rsp->content);
    ref $ref eq "HASH" and exists $ref->{job} or return "List failed";
    $ref = $ref->{job};
    return
	grep { (join "=", @$_) =~ m/$re/ }
	map  { [ $_, $ref->{$_}{color} ] }
	sort keys %$ref;
    } # hudson

sub tel {
    my $re = shift || "-?";

    chomp (my @list = qx{tel.pl $re});
    @list or return;
    $list[1] =~ m/^==+\s+=+/ and splice @list, 0, 2;
    return @list;
    } # tel

my %tr;
sub translate {
    my ($self, $nick, $src, $dst, $t, @result) = @_;

    $nick = canonical_nick ($nick);
    unless (tied %{$tr{prefer}}) {
	my $state_dir = "$self->{ConfigPath}/State";
	my @flags = -s "$state_dir/tr{prefer}" ? () : (O_RDWR|O_CREAT, 0666);
	tie  %{$tr{prefer}}, "DB_File", "$state_dir/tr_prefer", @flags;
	END { untie %{$tr{prefer}} }
	}

    eval {
	$tr{YB} //=  Yahoo::Babelfish->new or die "Cannot init: $@";
	$tr{GT} //= Google::Translate->new or die "Cannot init: $@";
	$tr{LT} //= Lingua::Translate::config (
			back_end	=> "Google",
			api_key		=> "ABQIAAAAARSs1QJW3Z7l9drahscc6BT2yXp_ZAY8_ufC3CFXhHIE1NvwkxSi6TER4J7-UkmtX9l0NL6gjw6Ovw",
			referer		=> "http://localhost",
			format		=> "text",
			userip		=> "127.0.0.1",
			);

	$tr{supported}{YB} //= $tr{YB}->get_translations;
	$tr{supported}{GT} //= $tr{GT}->get_translations;

	$tr{prefer}{$nick} //= "YB";
	my $tie; $tie = tied %{$tr{prefer}} and $tie->sync;

	if ($src eq "list") {
	    my $lang = lc ($dst // "..");
	    my %sup = map { $_ => 1 } grep m/\b$lang\b/ =>
		grep m/^[a-z][a-z]:[a-z][a-z]$/ =>
		    keys %{$tr{supported}{YB}}, keys %{$tr{supported}{GT}};
	    @result = (join " ", sort keys %sup);
	    return;
	    }

	if ($src eq "prefer") {
	    $dst =~ m/yb|yahoo|babel|fish/i	and $tr{prefer}{$nick} = "YB";
	    $dst =~ m/gt|google|translate/i	and $tr{prefer}{$nick} = "GT";
	    my $tie; $tie = tied %{$tr{prefer}} and $tie->sync;
	    return;
	    }

	my @tr = ("YB", "GT");
	$tr{prefer}{$nick} eq "GT" and @tr = reverse @tr;
	foreach my $tr (@tr) {
	    eval {
		$tr{$tr}->supported ("$src:$dst") or next;
		my $new = $tr{$tr}->do_translate (
		    src => $src,
		    dst => $dst,
		    txt => $t);
		$new =~ m/^[\s\0\r\n]*$/ and next;
		push @result, [ " $tr", encode ("utf8", $new) ];
		};
	    }
	eval {
	    my $xl8r = Lingua::Translate->new (src => $src, dest => $dst);
	    my $new = $xl8r->translate ($t);
	    $new =~ m/^[\s\0\r\n]*$/ and next;
	    push @result, [ " LT", encode ("utf8", $new) ];
	    };

	# If one (but not both) return the quest text ...
	@result == 2 and
	    lc $result[0][1] ne lc $result[1][1] &&
	    lc $result[1][1] eq lc $t and
		pop   @result;
	@result == 2 and
	    lc $result[0][1] ne lc $result[1][1] &&
	    lc $result[0][1] eq lc $t and
		shift @result;

	# If both give the same anser ...
	@result == 2 and
	    lc $result[0][1] eq lc $result[1][1] and
		@result = ([ "", $result[0][1] ]);
	};
    my $ft = $tr{supported}{GT}{"$src:$dst"} //
	     $tr{supported}{YB}{"$src:$dst"} //
	     "$src to $dst";
    (my $err_msg = $@) =~ s{ at /pro/lib.*}{};
    return ("Could not translate text $ft $err_msg", @result);
    } # translate

sub dict_en {
    my $query = shift; # Alternative: http://www.wordia.com/
    my $url = "http://www.yourdictionary.com/$query";

    my @info;
    my $result = get ($url) or return;
    my $tree = HTML::TreeBuilder->new () or return;
    $tree->parse_content ($result);
    my $pos = "";
    foreach my $d ($tree->look_down (_tag => "div", class => "entry dict")) {
	my @def;
	#print STDERR $d->as_HTML (undef, "  ", {});
	foreach my $p ($d->look_down (class => "pos")) {
	    $pos = $p->as_text;
	    last;
	    }
	my %seen;
	foreach my $s ($d->look_down (class => "sense")) {
	    $seen{$s}++ and next;
	    foreach my $l ($d->look_down (_tag => "li")) {
		$seen{$l}++ and next;
		my @l;
		foreach my $o ($l->look_down (_tag => "ol")) {
		    $seen{$o}++ and next;
		    foreach my $x ($o->look_down (_tag => "li")) {
			$seen{$x}++ and next;
			push @l, $x->as_text;
			}
		    last;
		    }
		@l or push @l, $l->as_text;
		push @def, @l;
		}
	    @def or push @def, $s->as_text;
	    last;
	    }
	@def or next;
	s/^\s*/ / for @def;
	if (@def > 1) {
	    $def[$_ - 1] =~ s/^/ $_./ for 1 .. scalar @def;
	    }
	push @info, "$query ($pos)", @def;
	}
    $tree->delete;
    return @info;
    } # dict_en

sub dict_nl {
    my $query = lc shift;
    my $url = "http://www.vandale.nl/vandale/opzoeken/woordenboek/?zoekwoord=$query";

    my @info;
    my $result = get ($url) or return;
    my $tree = HTML::TreeBuilder->new () or return;
    $tree->parse_content ($result);
    my ($hit, $pos) = ("", "");
    foreach my $d  ($tree->look_down (_tag => "div", id => "results")) {
	my @defs;
	foreach my $t ($d->look_down (_tag => "div", id => "pnn4web_")) {
	    $hit = $query;
	    foreach my $u ($t->look_down (_tag => "span", class => "pnn4web_d")) {
		$hit = $u->as_text;
		$hit =~ s/\s+$//;
		$hit =~ s/^\s+//;
		}
	    (my $word = lc $hit) =~ s/\s.*//;
	    $word =~ s/[\x80-\xff]//g;
	    #$word eq $query or next; # $query does not match $word
	    foreach my $g ($t->look_down (_tag => "span", class => "pnn4web_k")) {
		$pos = $g->as_text;
		$pos =~ s/\s+$//;
		$pos =~ s/^\s+//;
		}
	    my @def;
	    foreach my $g ($t->look_down (_tag => "div", class => "pnn4web_c")) {
		push @def, $g->as_text;
		}
	    s/^\s*[0-9]+\.?\s*// for @def;
	    push @defs, "$hit, $pos, ". join "\n", @def;
	    }
	if (@defs > 1) {
	    $defs[$_ - 1] =~ s/^/$_. / for 1 .. scalar @defs;
	    }
	s/^/ / for @defs;
	push @info, @defs;
	}
    $tree->delete;
    return @info;
    } # dict_nl

### Bot stuff

sub new {
    my $class = shift;
    my %args  = @_;
    $args{ConfigPath} //= getcwd;
    -d $args{ConfigPath} or mkdir $args{ConfigPath};
    $args{LogPath}    //= "Log";
    $args{LogPath} =~ m{^/} or $args{LogPath} = "$args{ConfigPath}/$args{LogPath}";
    -d $args{LogPath} or mkdir $args{LogPath};
    if (exists $args{BotID} && $args{BotID} =~ m/^\w+$/) {
	$args{LogPath} .= "/$args{BotID}";
	-d $args{LogPath} or mkdir $args{LogPath};
	}
    $args{IRCNAME}   = "tuxtux"   . int rand 100000;
    $args{ALIASNAME} = "clunker3" . int rand 100000;

    $args{State} = {};
    $args{Quote} = {};
    $args{Names} = {};
    $args{CPANi} = 0;
    $args{Rantd} = time;

    return bless \%args, $class;
    } # new

# Run the bot
sub run {
    my $self = shift;
    $self->{LogPath} =~ s{/*$}{/};	# Force trailing slash
    $log = IRC::Bot::Log->new (Path => $self->{LogPath});

    POE::Component::IRC->new (NICK) or
	croak "Cannot create new P::C::I object!\n";

    POE::Session->create (
        object_states => [ $self => {
	    _start           => "bot_start",
	    reconnect        => "reconnect",
	    irc_001          => "on_connect",
	    irc_disconnected => "on_disco",
	    irc_public       => "on_public",
	    irc_msg          => "on_msg",
	    irc_quit         => "on_quit",
	    irc_join         => "on_join",
	    irc_part         => "on_part",
	    irc_mode         => "on_mode",
	    irc_kick         => "on_kick",
	    irc_notice       => "on_notice",
	    irc_ctcp_ping    => "on_ping",
	    irc_ctcp_version => "on_ver",
	    irc_ctcp_finger  => "on_finger",
	    irc_ctcp_page    => "on_page",
	    irc_ctcp_time    => "on_time",
	    irc_ctcp_action  => "on_action",
	    irc_nick         => "on_nick",
	    keepalive        => "keepalive",
	    irc_433          => "on_nick_taken",
	    irc_353          => "on_names",
	    irc_dcc_request  => "on_dcc_ignore",
	    irc_dcc_error    => "on_dcc_ignore",
	    irc_dcc_done     => "on_dcc_ignore",
	    irc_dcc_start    => "on_dcc_ignore",
	    irc_dcc_chat     => "on_dcc_ignore",
	    }]
	);
    $poe_kernel->run ();
    } # run

sub channel_ties {
    my ($self, $ch) = @_;

    my $state_dir = "$self->{ConfigPath}/State";
    -d $state_dir or mkdir $state_dir, 0777 or return;

    my $dir = "$state_dir/$ch";
    -d $dir       or mkdir $dir,       0777 or return;

    foreach my $db (qw( trust believe ban )) {
	tied %{$self->{State}{$ch}{$db}} and next;

	my @flags = -s "$dir/$db" ? () : (O_RDWR|O_CREAT, 0666);
	tie  %{$self->{State}{$ch}{$db}}, "DB_File", "$dir/$db", @flags;
	$db eq "ban" or
	       $self->{State}{$ch}{$db}{":value_format:"} = "lA30A*";
	}
    } # channel_ties

# Start the bot things up
sub bot_start {
    my ($self, $kernel, $session) = @_[ OBJECT, KERNEL, SESSION ];
    $self->{Kernel}  = $kernel;
    $self->{Session} = $session;

    my $state_dir = "$self->{ConfigPath}/State";
    -d $state_dir or mkdir $state_dir, 0777 or return;
    if (-d "$self->{ConfigPath}/State") {
	my %ch;
	my @dir;
	if ($self->{Channels}) {
	    @dir = map { "$state_dir/$_" } @{$self->{Channels}};
	    }
	else {
	    @dir = <$state_dir/* >;
	    }
	foreach my $dir (grep { -d } @dir) {
	    (my $ch = $dir) =~ s{.*/}{};
	    channel_ties ($self, $ch);
	    $ch{$ch}++;
	    }
	delete $ch{all};
	foreach my $db (qw( trust believe )) {
	    -s "$state_dir/all/$db" or next;
	    tie my %db, "DB_File", "$state_dir/all/$db";
	    $db{":value_format:"} = "lA30A*";
	    $self->{State}{all}{$db} = { %db };
	    untie %db;
	    }
	$self->{Channels} //= [ sort keys %ch ];
	if (exists $self->{QuoteDB}) {
	    my $qdb = $self->{QuoteDB};
#	    tie %{$self->{Quote}}, "DB_File", "$state_dir/$qdb");
	    $qdb =~ s/^Quotes/Q_/;
	    tie %{$self->{Quote}}, "Tie::Hash::DBD", "dbi:Pg:dbname=clunker3",
		{ tbl => $qdb, ktp => "text", vtp => "text" };
	    }
	elsif (exists $self->{BotID}) {
	    tie %{$self->{Quote}}, "DB_File", "$state_dir/Quotes".($self->{BotID});
	    }
	if ($self->{SeenNoQuote}) {
	    # convert list to hash
	    $self->{SeenNoQuote} = { map { $_ => 1 } @{$self->{SeenNoQuote}} };
	    }
	else {
	    $self->{SeenNoQuote} = { };
	    }
	END {
	    $self && ref $self eq "HASH" && exists $self->{State} or return;
	    foreach my $ch (keys %{$self->{State}}) {
		foreach my $db (keys %{$self->{State}{$ch}}) {
		    my $tie;
		    $tie = tied %{$self->{State}{$ch}{$db}} and $tie->sync;
		    }
		}
	    }
	}

    my $ts = scalar localtime;
    $log->serv_log ("[$ts] Starting Up...");

    # Make an alias for our session, to keep it from getting GC'ed.
    $kernel->alias_set ($self->{ALIASNAME});

    $kernel->post  (NICK, "register", "all");
    $kernel->delay ("reconnect",  1);
    $kernel->delay ("keepalive", 30);
    } # bot_start

# From Bot::BasicBot

# Also used for first connect
sub reconnect {
    my ($self, $kernel, $session) = @_[ OBJECT, KERNEL, SESSION ];

    my $ts = scalar localtime;
    $log->serv_log ("[$ts] Connecting to $self->{Server} port $self->{Port} ...");
    my %args;
    for (qw( Debug Nick Server Password Port Username Ircname NSPass
	     UseSSL Flood )) {
	exists $self->{$_} && $self->{$_} =~ m/\S/ and $args{$_} = $self->{$_};
        }
    $kernel->post (NICK, "connect", \%args);
    # If the connect passes, you get some on_notice () events and then
    # the on_connect () event. If this does not happen, we have to reconnect
    # with a different host if available.
    } # reconnect

# The part from Slavorg

sub canonical_nick {
    my ($self, $nick) = @_;
    $nick or return "";
    $nick = lc $nick;		# Tux
    $nick =~ s/[-_]*$//;	# tux_, tux-, [tux]_, [tux]-
#   $nick =~ s/^\[(.*)]$/$1/;	# [tux]
#   $nick =~ s/[-_]*$//;	# [tux_], [tux-]
    $nick =~ s/^q{1,2}[\[\{](.*?)[\]\}]/$1/; # qq{blech}
    $nick = "tux" if $nick =~ m/^[_{[]+Tux[\]}_]+$/i;
    return $nick;
    } # caconical_nick

# $self->relationship ("believe", "#panic", "foo"[, 0]);
sub relationship {
    my $self    = shift;
    my $type    = shift;
    my $channel = lc shift;
    my $nick    = shift;
    my $tie;

    # [Tux]!elektrans@hmbrand-adsl.xs4all.nl
    my ($n, $u, $s) = ($nick =~ m/^(\S+?)(?:!(\S+?)\@(\S+))?$/);
    $nick = $self->canonical_nick ($n);
    my @s = split m/\|/ => $s // "";

    $log->bot_log (qq{Relationship (n: "$n", u: "$u", t: $type, c: $channel, s: (@{[map { "\"$_\"" } @s]}), \@: (@_)});
    if (@_) {
	$self->{State}{$channel}{$type}{$nick} = shift;
	$log->bot_log ("I now $type $nick in $channel.");
	$tie = tied %{$self->{State}{$channel}{$type}} and $tie->sync;
	}

    my $state = 0;
#   for ($self->{State}{all}{$type}{$nick}, $self->{State}{$channel}{$type}{$nick}) {
#	$_ or next;
#	if (my ($n, $u, $s) = m/^(\S+?)!(\S+?)\@(\S+)/) {
#	    $n 
    $state = $self->{State}{all}{$type}{$nick}
	  || $self->{State}{$channel}{$type}{$nick}
	  || 0;
    return $state;
    } # relationship

sub trust {
    shift->relationship ("trust", @_);
    } # trust

sub believe {
    my $self    = shift;
    my $channel = shift;
    my $nick    = shift;
    @_ and return $self->relationship ("believe", $channel, $nick, @_);

    return $self->trust ($channel, $nick)
	|| $self->relationship ("believe", $channel, $nick);
    } # believe

# back to IRC::Bot

# Communicate with channel/nick
sub botspeak {
    my ($self, $kernel, $channel, $msg) = @_;
    $kernel->post (NICK, "privmsg", $channel, $msg);
    } # botspeak

# Communicate with nick only
sub nickspeak {
    my ($self, $kernel, $nick, $msg) = @_;
    $kernel->post (NICK, "notice", $nick, $msg);
    } # nickspeak

# Handle connect event
# Join specified channels
sub on_connect {
    my ($self, $kernel) = @_[ OBJECT, KERNEL ];
    $kernel->post (NICK, "mode", $self->{Nick}, "+B");
    if ($self->{NSPass}) {
	my $msg = "identify " . $self->{NSPass};
	$self->nickspeak ($kernel, "NickServ", $msg);
	}
    foreach my $chan (@{$self->{Channels}}) {
        $kernel->post (NICK, "join", $chan);
	}
    } # on_connect

# Someone pinged us, handle it.
sub on_ping {
    my ($self, $kernel, $who) = @_[ OBJECT, KERNEL, ARG0 ];
    my $nick = (split m/!/, $who)[0];
    $kernel->post (NICK, "ctcpreply", $nick, "PING", "PONG");
    } # on_ping

# Someone changed their nick, handle it.
sub on_nick {
    my ($self, $kernel, $who, $nnick) = @_[ OBJECT, KERNEL, ARG0, ARG1 ];
    my $nick = (split m/!/, $who)[0];
    } # on_nick

# Handle CTCP Version
sub on_ver {
    my ($self, $kernel, $who) = @_[ OBJECT, KERNEL, ARG0 ];
    my $nick = (split m/!/, $who)[0];
    $kernel->post (NICK, "ctcpreply", $nick, "VERSION", "Ima Bot");
    } # on_ver

# Handle CTCP Finger
sub on_finger {
    my ($self, $kernel, $who) = @_[ OBJECT, KERNEL, ARG0 ];
    my $nick = (split m/!/, $who)[0];
    $kernel->post (NICK, "ctcpreply", $nick, "FINGER",  "Ima Bot");
    } # on_finger

# Handle CTCP Page
sub on_page {
    my ($self, $kernel, $who) = @_[ OBJECT, KERNEL, ARG0 ];
    my $nick = (split m/!/, $who)[0];
    $kernel->post (NICK, "ctcpreply", $nick, "PAGE",    "Ima Bot");
    } # on_page

# Handle CTCP Time
sub on_time {
    my ($self, $kernel, $who) = @_[ OBJECT, KERNEL, ARG0 ];
    my $nick = (split m/!/, $who)[0];
    my $ts = scalar localtime;
    $kernel->post (NICK, "ctcpreply", $nick, "TIME",    $ts);
    } # on_time

# Log actions
sub on_action {
    my ($self, $kernel, $who, $where, $msg) =
	@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2 ];
    my $nick = (split m/!/, $who)[0];
    my $channel = $where->[0];
    my $time = sprintf "%02d:%02d", (localtime time)[2, 1];
    $log->chan_log ("[$channel $time] Action: *$nick $msg");
    } # on_actions

# Handle mode changes
sub on_mode {
    my ($self, $kernel, $who, $where, $mode, $nicks) =
	@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2, ARG3 ];
    my $nick = (split m/!/, $who)[0];
    my $time = sprintf "%02d:%02d", (localtime time)[2, 1];
    if ($self->{Nick} eq $where) {
        $log->bot_log  ("[$where $time] MODE: $mode");
	}
    elsif ($nicks) {
	$log->chan_log ("[$where $time] MODE: $mode $nicks by: $nick");
	}
    else {
	$log->chan_log ("[$where $time] MODE: $mode $where by: $nick");
	}
    } # on_mode

# Handle notices
sub on_notice {
    my ($self, $kernel, $who, $msg) = @_[ OBJECT, KERNEL, ARG0, ARG2 ];
    my $nick = (split m/!/, $who)[0];
    my $time = sprintf "%02d:%02d", (localtime time)[2, 1];
    $log->bot_log ("[$self->{Nick} $time] NOTICE: $nick: $msg");
    } # on_notice

# Handle kicks
sub on_kick {
    my ($self, $kernel, $who, $chan, $kickee, $msg) =
	@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2, ARG3 ];
    my $nick = (split m/!/, $who)[0];
    my $time = sprintf "%02d:%02d", (localtime time)[2, 1];
    $log->chan_log ("[$chan $time] KICK: $nick: $kickee ($msg)");
    } # on_kick

# Handle someone quitting.
sub on_quit {
    my ($self, $kernel, $who, $msg) = @_[ OBJECT, KERNEL, ARG0, ARG1 ];
    my $nick = (split m/!/, $who)[0];
    my $time = sprintf "%02d:%02d", (localtime time)[2, 1];
    $log->bot_log ("[$self->{Nick} $time] QUIT: $nick: $msg");
    } # on_quit

# Handle join event
sub on_join {
    my ($self, $kernel, $who, $where) = @_[ OBJECT, KERNEL, ARG0, ARG1 ];
    my ($nick, $addr) = (split m/!/, $who);
    my $time = sprintf "%02d:%02d", (localtime time)[2, 1];
    $log->chan_log ("[$where $time] JOIN: $nick $addr");
    if (tied %{$self->{State}{$where}{ban}} and
	exists $self->{State}{$where}{ban}{$addr}) {
	$kernel->post (NICK, "kick", $where, $nick);
	}
    elsif ($self->trust   ($where, $nick)) {
	$where eq "#itrc" && $addr !~ m/(procura|hmbrand)\.xs4all\.nl$/ and return;
	$kernel->post (NICK, "mode", $where, "+o", $nick);
	}
    elsif ($self->believe ($where, $nick)) {
	$kernel->post (NICK, "mode", $where, "+v", $nick);
	}
    } # on_join

# Handle part event
sub on_part {
    my ($self, $kernel, $who, $where) = @_[ OBJECT, KERNEL, ARG0, ARG1 ];
    my $nick = (split m/!/, $who)[0];
    my $time = sprintf "%02d:%02d", (localtime time)[2, 1];
    $log->chan_log ("[$where $time] PART: $nick");
    } # on_part

# Changes nick if current nick is taken
sub on_nick_taken {
    my ($self, $kernel) = @_[ OBJECT, KERNEL ];
    $log->chan_log ("nick_taken (@{[map{$_//'--undef--'}@_]})");
    my $nick = $self->{Nick};
    if (my $alt = $self->{AltNick}) {
	if (ref $alt) {
	    my @alt = @{$alt};
	    $nick = $alt[int rand scalar @alt];
	    }
	else {
	    $nick = $alt;
	    }
	}
    else {
	$nick .= int rand 999;
	}
    $kernel->post (NICK, "nick", $nick);
    if ($self->{NSPass} && $nick eq $self->{Nick}) {
	my $msg = "identify " . $self->{NSPass};
	$self->botspeak ($kernel, "NickServ", $msg);
	}
    } # on_nick_taken

sub keepalive {
    my ($self, $kernel, $heap) = @_[ OBJECT, KERNEL, HEAP ];
    $kernel->post  (NICK, "sl", "PING " . time);
    $kernel->delay ("keepalive", $heap->{keepalive_time} = 90);
    } # keepalive

# Dit is een encoding test
my $utf8line =
    "\N{DSTROKE_IDX}\N{i_ACUTE}\N{t_CARON} ".
    "\N{i_GRAVE}\N{s_CARON} ".
    "\N{e_ACUTE}\N{e_GRAVE}\N{n_TILDE} ".
    "\N{e_DIAERES}\N{n_CEDILLA}\N{c_DOT}\N{oSLASH_IDX}\N{d_CARON}\N{INODOT_IDX}\N{n_ACUTE}\N{g_BREVE}".
    "\N{t_STROKE}\N{e_OGONEK}\N{s_CIRCUM}\N{t_CEDILLA}\N{MDOT_IDX}";

my @help;
my %help = map {
	(m{^\s*([^\t]+)\t+(.*)});
	push @help, $1;
	$1 => $2;
	} grep { !m/^#/ } split m/\s*\n+\s*/, <<'EOH';
    !help [long|<cmd>]	Show this help message
    !commands		Show available commands

    !ping		Ping bot
    !uptime		Displays current bot uptime
    !version		Display bot version
    !version_all	Display bot version and all used module versions

#   !exit		Stop bot
#   !restart		Restart bot
#   !reload		Reload bot internals

    !join    <channel>	Make bot join <channel>
    !part    <channel>	Make bot leave <channel>

    !calc       <expr>	Simple calculator
    !tran  <ft> <text>	Translate <text> using <ft> like en:nl
    !tran help		Show help on !tran
    !uchar      <text>	Unicode utility. Allows \x{...} and U+... notation
    !utf8		Show a test line in UTF-8
    !iso8859-1		Show a test line in ISO-8859-1
    !latin1		Show a test line in ISO-8859-1
    !hex        <text>	Give a hexdump representation of <text>
    !shorten     <url>	Generate a shortened URL
    !google    <query>	Return the first hit from a Google search
    !acronym <acronym>	Return the first found explanation for an acronym
    !dict      <query>	Look up [lang:]word in dictionary
    !smoker    <query>	Query the Smoquel database (perl5 core smokes)
    !change   <change>	Show perlbrowse's entry for perl5 change number
    !rt       <change>	Show RT's entry for perl RT entry
    !cpan     <module>	Show basic CPAN info for module
    !corelist <module>	Show as of when a CPAN module is shipped with perl
    !p3rl      <quest>	Show the related URL from http://p3rl.org
    !cents  [in <CUR>]	Show exchange rates. '!cents 2 USD to EUR' allowed

    !ban        <nick>	Ban <nick> from this channel
    !unban      <nick>	Remove ban for <nick> on this channel
    !trust      <nick>	Give <nick> operator rights
    !untrust    <nick>	Revoke ops from <nick>
    !believe    <nick>	Give <nick> voice
    !unbelieve  <nick>	Revoke voice for <nick>
    !seen       <nick>	Tell me when <nick> was last seen and what he said
    !summon     <nick>	Summon nick (with optional message)
    !greet     [<nick>]	Greet (the rest). see !greet help
EOH

sub Normalized_Delta_YMDHMS {
    my @d1 = @_[0.. 5];
    my @d2 = @_[6..11];

    my @delta = Delta_YMDHMS (@d1, @d2);
    while  ($delta[1] < 0 ||
	    $delta[2] < 0 or
	    $delta[3] < 0 ||
	    $delta[4] < 0 ||
	    $delta[5] < 0) {
	if ($delta[1] < 0) { $delta[0]--; $delta[1] += 12; }
	if ($delta[2] < 0) {
	    $delta[1]--;
	    @delta[2..5] = (0, 0, 0, 0);
	    @delta[2..5] = Delta_DHMS (Add_Delta_YMDHMS (@d1, @delta), @d2);
	    }
	if ($delta[3] < 0) { $delta[2]--; $delta[3] += 24; }
	if ($delta[4] < 0) { $delta[3]--; $delta[4] += 60; }
	if ($delta[5] < 0) { $delta[4]--; $delta[5] += 60; }
	}
    return @delta;
    } # Normalized_Delta_YMDHMS

sub x_speak {
    my ($self, $kernel, $channel, $nick, $msg) = @_;
    unless ($kernel) {	# CLI
	shift; shift;
	print STDERR "@_\n";
	return;
	}
    if ($channel) {
	$self->botspeak  ($kernel, $channel, $msg);
	}
    else {
	$self->nickspeak ($kernel, $nick,    $msg);
	}
    } # x_speak

sub on_priv_cmd {
    my ($self, $kernel, $channel, $nick, $msg) = @_;

    # H.Merijn's additions
    if ($msg =~ m/^!(un)?(trust|believe)\s+(\S+.*)/) {
	my ($un, $cmd, $target) = map { $_ // "" } $1, $2, $3;
	my $t_channel = $channel;
	$target  =~ s{\s+in\s+(\S+)$}{} and $t_channel = $1;
	$t_channel or return;
	my @target = grep m/\S/, split m/[\s,]+/, $target;
	if ($self->trust ($t_channel, $nick)) {
	    $log->bot_log ("$nick wants to $un$cmd (@target) in $t_channel");
	    foreach $target (@target) {
		if ($un) {
		    my $mode = $cmd eq "trust" ? "-o" : "-v";
		    if (!$self->$cmd ($t_channel, $target)) {
			$self->x_speak ($kernel, $channel, $nick,
			    "But I do not $cmd $target in $t_channel");
			}
		    else {
			$self->relationship ($cmd, $t_channel, $target, 0);
			$kernel->post (NICK, "mode", $t_channel, $mode, $target);
			}
		    }
		else {
		    my $mode = $cmd eq "trust" ? "+o" : "+v";
		    if ($self->trust ($t_channel, $target)) {
			$self->x_speak ($kernel, $channel, $nick,
			    "But I already trust $target in $t_channel");
			}
		    elsif ($cmd eq "believe" && $self->believe ($t_channel, $target)) {
			$self->x_speak ($kernel, $channel, $nick,
			    "But I already believe $target in $t_channel");
			}
		    else {
			$self->relationship ($cmd, $t_channel, $target, 1);
			$kernel->post (NICK, "mode", $t_channel, $mode, $target);
			}
		    }
		}
	    }
	else {
	    $self->x_speak ($kernel, $channel, $nick,
		"But I do not trust you $nick");
	    }
	return;
	}
    if ($msg =~ m/^!(un)?ban\s+(\S+)/i) {
	my ($un, $vilain, $ch, $tie) = ($1, $2, lc $channel);
	$msg  =~ s{\s+in\s+(\S+)$}{} and $ch = lc $1;
	$ch or return;
	unless ($self->trust ($channel, $nick)) {
	    $self->x_speak ($kernel, $channel, $nick,
		"Only trusted users can ban/unban");
	    return;
	    }
	$vilain =~ m/!/ or substr ($vilain, 0, 0) = "*!";
	my ($nick, $addr) = split m/!/, $vilain;
	unless (tied %{$self->{State}{$ch}{ban}}) {
	    my $dir = "$self->{ConfigPath}/State/$ch";
	    -d $dir or mkdir $dir, 0755;
	    tie %{$self->{State}{$ch}{ban}}, "DB_File", "$dir/ban";
	    }
	if ($un) {
	    exists $self->{State}{$ch}{ban}{$addr} or
		$self->x_speak ($kernel, $channel, $nick,
		    "But $vilain is not banned from $ch");
	    delete $self->{State}{$ch}{ban}{$addr};
	    $kernel->post (NICK, "mode", $channel, "-b", $vilain);
	    }
	else {
	    if (exists $self->{State}{$ch}{ban}{$addr}) {
		$self->x_speak ($kernel, $channel, $nick,
		    "But $vilain is already banned from $ch");
		}
	    else {
		$self->{State}{$ch}{ban}{$addr} = 1;
# /kick works on nick
# /ban  works on addr
#		$nick ne "*" and
#		$kernel->post (NICK, "kick", $channel, $nick, "You've been banned");
		$kernel->post (NICK, "mode", $channel, "+b", $vilain);
		}
	    }
	$tie = tied %{$self->{State}{$ch}{ban}} and $tie->sync;
	return;
	}
    if ($msg =~ m/^!nick\b/i) {
	$kernel->post (NICK, "nick", $self->{Nick});
	if ($self->{NSPass}) {
	    my $msg = "identify " . $self->{NSPass};
	    $self->botspeak ($kernel, "NickServ", $msg);
	    }
	return;
	}
    if ($msg =~ m/^!relations\b/i) {
	$self->trust ("all", $nick) or return;
	my $t_channel = $channel;
	$msg  =~ s{\s+in\s+(\S+)$}{} and $t_channel = $1;
	$t_channel or return;
	my @trust = sort grep {!m{^:value_format:$} && m{\S} }
	    keys %{$self->{State}{lc $t_channel}{trust}};
	my @belie = sort grep {!m{^:value_format:$} && m{\S} }
	    keys %{$self->{State}{lc $t_channel}{believe}};
	# Lines can be too long, should be split up
	$self->nickspeak ($kernel, $nick, "in $t_channel, I trust   (@trust).");
	$self->nickspeak ($kernel, $nick, "in $t_channel, I believe (@belie).");
	return;
	}
    if ($channel and $msg =~ m/^!names\b/i) {
	$self->{Names}{$channel} = {};	# Empty previous list
	$kernel->post (NICK, "names", $channel);
	return;
	}
    if ($msg =~ m/^!(join|part)\s+(\S+)/i) {
	my ($cmd, $chan) = ($1, $2);
	if ($self->trust ($channel || "all", $nick)) {
	    $kernel->post (NICK, $cmd, $chan);
	    if ($cmd eq "join") {
		channel_ties ($self, $chan);
		}
	    else {
		untie %{$self->{State}{$chan}{$_}} for keys %{$self->{State}{$chan}};
		}
	    }
	return;
	}
    if ($msg =~ m/^!(reload)\b/i) {
	$nick =~ m/^(merijn|tux(?:32|CM)?)[-_]*\b/i or return;

	my $ts = scalar localtime;
	$log->serv_log ("[$ts] Reload ...");
#	$kernel->delay ("uptime", 30);

	no warnings "redefine";
	#Module::Reload->check;
	Module::Refresh->refresh;
	return;
	}
    if ($msg =~ m/^!(stop|quit|exit|restart)\b/i) {
	$nick =~ m/^(?:\[_*)?(merijn|tux(?:32|CM)?_*)(?:_*\])?[-_]*\b/i or return;

	my $ts = scalar localtime;
	$log->serv_log ("[$ts] Disconnected ...");
	$kernel->delay ("reconnect", 30);

	foreach my $ch (keys %{$self->{State}}) {
	    untie %{$self->{State}{$ch}{$_}} for keys %{$self->{State}{$ch}};
	    }
	untie %{$self->{Quote}};
	print STDERR "$0 stops on ", getcwd (), " due to $msg command\n";
	$msg =~ m/^!restart/i and exec $0;
	exit 0;
	}
    if ($msg =~ s{^!calc\b}{}) {
	my $result = "Unsupported syntax for !calc";
	if ($msg =~ m{^\s+([-0-9(](?:[-+*/()0-9. ]|x[0-9a-fA-F]+\b)*)$}) {
	    eval "\$result = 0 + ($1)";
	    $@ and $result = $@;
	    # Hide the obvious fact that calc uses eval
	    $result =~ s{\s*at\s+.eval\s+\d+.\s+line.*}{};
	    $result =~ m/^[0-9]+$/ and
		$result = sprintf "0%o / %d / 0x%04x", $result, $result, $result;
	    $result =~ s/^/result: /;
	    }
	$self->x_speak ($kernel, $channel, $nick, $result);
	return;
	}
    if ($msg =~ m/^!?(no)?past[aey]\s*\??$/i) {
	$self->x_speak ($kernel, $channel, $nick, join " or ", qw(
	    http://poundperl.pastebin.com/
	    http://paste.scsys.co.uk/p5p
	    http://paste.scsys.co.uk/
	    http://pastie.org
	    ));
	return;
	}
    if ($msg =~ m/^!tr(?:a(?:n(?:s\w*)?)?)?\b(.*)/) {
	my $t = $1;
	my ($src, $dst);
	if ($t =~ m/^\s*(\?|help|versions?)$/i) {
	    $t =~ m/help/i and
		$self->x_speak ($kernel, $channel, $nick, "!tr help | version | list [lang] | en:nl text");
	    $self->x_speak ($kernel, $channel, $nick, join " ",
		"Yahoo::Babelfish $Yahoo::Babelfish::VERSION",
		"http://babelfish.yahoo.com/translate_txt",
		"Google::Translate $Google::Translate::VERSION",
		"http://translate.google.com/translate_t",
		"SysTran: http://www.systran.org/");
	    return;
	    }
	if ($t =~ m/^\s*list(?:\s+(\w\w))?$/i) {
	    my $foo = $self->translate ($nick, "list", $1);
	    $self->x_speak ($kernel, $channel, $nick, ($self->translate ($nick, "list", $1))[1]);
	    return;
	    }
	if ($t =~ m/^\s*prefer\s+(\S+)$/i) {
	    $self->translate ($nick, "prefer", $1);
	    return;
	    }
	$t =~ s/(?:\s+from)?\s+(\w\w)\s+to\s+(\w\w)\b//   and ($src, $dst) = ($1, $2);
	!$src && !$dst  && $t =~ s/\b(\w\w)[:_](\w\w)\b// and ($src, $dst) = ($1, $2);
	!$dst && $t =~ s/\s+to\s+(\w\w)\b//   and $dst = $1;
	!$src && $t =~ s/\s+from\s+(\w\w)\b// and $src = $1;
	 $src && !$dst and $dst = "nl";
	!$src &&  $dst and $src = "nl";
	!$src && !$dst and ($src, $dst) = ("en", "nl");
	$t =~ s/^\s+//;
	$t =~ s/\s+$//;
	unless ($t) {
	    $self->x_speak ($kernel, $channel, $nick,
		"$nick: usage: !tr from en to nl text");
	    return;
	    }
	unless ($src =~ m/^\w\w$/ && $dst =~ m/^\w\w$/) {
	    $self->x_speak ($kernel, $channel, $nick,
		"$nick: Cannot translate '$t' $src to $dst");
	    return;
	    }
	for ($src, $dst) {
	    s/ gr      /el/x;	# Greek    / Grieks
	    s/ jp      /ja/x;	# Japanese / Japans
	    s/ ch | ct /zt/x;	# Chinese  / Chinees (Traditional)
	    s/ cs      /zh/x;	# Chinese  / Chinees (Simplified)
	    s/ ge | du /de/x;	# German   / Duits
	    s/ sp      /es/x;	# Spanish  / Spaans
	    s/ dk      /da/x;	# Danish   / Deens
	    }
	my ($err, @new) = $self->translate ($nick, $src, $dst, $t);
	unless (@new) {
	    $kernel or $self->x_speak ($kernel, $channel, $nick, $@);
	    $self->x_speak ($kernel, $channel, $nick, "$nick: $err");
	    return;
	    }
	for (@new) {
	    my ($tr, $txt) = @$_;
	    $self->x_speak ($kernel, $channel, $nick, "$nick: $src:$dst$tr - $txt");
	    }
	return;
	}
    if ($msg =~ s/^!dict\b\s*//) {
	$msg =~ s/\s+$//;
	$msg or return;
	if ($msg eq "help") {
	    $self->x_speak ($kernel, $channel, $nick, "$nick: usage: !dict [en:]word");
	    return;
	    }
	if ($msg eq "sites") {
	    $self->x_speak ($kernel, $channel, $nick, "$nick: en: http://www.yourdictionary.com/");
	    $self->x_speak ($kernel, $channel, $nick, "$nick: nl: http://www.vandale.nl/vandale/opzoeken/woordenboek/");

	    return;
	    }
	my $dict = "en";
	$msg =~ s/^([a-z][a-z]):\s*// and $dict = $1;
	$msg =~ m/^[-\w.]+$/ or return;
	my @info = $dict eq "en" ? dict_en ($msg)
		 : $dict eq "nl" ? dict_nl ($msg)
		 : ("Dict $dict is not yet supported") or return;

	@info > 3 and $channel = "";
	$self->x_speak ($kernel, $channel, $nick, $_) for @info;
	return;
	}
    if ($msg =~ m/^!short(?:e(?:[rn])?)?\s+(.*)/) {
	eval {
	    my $short_url = makeashorterlink ($1);
	    $short_url and
		$self->x_speak ($kernel, $channel, $nick, $short_url);
	    };
	}
    if ($msg =~ m/^!purl/) {
	$self->x_speak ($kernel, $channel, $nick, "purl is a fantastic bot. It's source can be found at http://github.com/hachi/flooterbuck-purl/");
	}
    if ($msg =~ m/^!smoker?\s+(.*)/) {
	my $query = $1;
	$query =~ s/\s*\?\s*$//;
	$query =~ s/\b hpux \b/hp-ux/igx;
	$query =~ s/\b on \s+ (aix|hp-ux|linux) \b/for $1/igx;
	$query =~ s/\+/%2B/g;
	$query =~ s/\s+/+/g;
	$query or return;
	my $result = get ("http://gromit.test-smoke.org/cgi/smoquel?smql=$query;bot=1");
	!$result || $result =~ m/^cannot find|^dunno what/i and
	    $result = "Sorry, no (valid) reply for that query";
	$result =~ s/\s*\n\s*/ - /;
	$self->x_speak ($kernel, $channel, $nick, $result);
	return;
	}
    if ($msg =~ m{\bcpan:([A-Z]+/[\w.-]+z)\b} and my $url = cpan_full_url ($1)) {
	$self->x_speak ($kernel, $channel, $nick, $url);
	}
    if ($msg =~ s/^!cpan\s+(?=\S)//i) {
	my $time = time;
	if ($msg eq "reload" or $time - ($self->{CPANi}//0) > 3600) { # reload if older than 60 minutes
	    local *STDOUT;
	    open STDOUT, ">", "/dev/null";
	    CPAN::Index->reload;
	    $self->{CPANi} = time;
	    }
	if (my $url = cpan_full_url ($msg)) {
	    $self->x_speak ($kernel, $channel, $nick, $url);
	    return;
	    }
	if ($msg = cpan_info ($msg)) {
	    if ($msg =~ s/^\cA\cA//) {
		$self->x_speak ($kernel, "",       $nick, $msg);
		}
	    else {
		$self->x_speak ($kernel, $channel, $nick, $msg);
		}
	    }
	return;
	}
    if ($msg =~ s/^!p3(?:rl)?\s+(?=\S)//i) {
	$msg = p3rl ($msg) and
	    $self->x_speak ($kernel, $channel, $nick, $msg);
	return;
	}
    if ($msg =~ s/^!hudson\s*//i) {
	$self->{Server} =~ m/^(?:localhost|irc\.procura\.nl)$/ or return;
	my @list = hudson ($msg) or return
	    $self->x_speak ($kernel, $channel, $nick, "Request returned an empty list");

	my $klen = max (map { length $_->[0] } @list);
	my $repl = join "\n" => "", map { sprintf "%-${klen}s = %s", @$_ } @list;
	if (@list < 4) {
	    $self->x_speak ($kernel, $channel, $nick, $repl);
	    }
	else {
	    $self->x_speak ($kernel, "", $nick, $repl);
	    }
	return;
	}
    if ($msg =~ s/^!tel\s*//i) {
	$self->{Server} =~ m/^(?:localhost|irc\.procura\.nl)$/ or return;
	my @list = tel ($msg) or return
	    $self->x_speak ($kernel, $channel, $nick, "Sorry, geen resultaten");

	if (@list < 4) {
	    $self->x_speak ($kernel, $channel, $nick, $_) for @list;
	    }
	else {
	    $self->x_speak ($kernel, "",       $nick, $_) for @list;
	    }
	return;
	}
    if ($msg =~ s/^!corelist\s+(?=\S)//i) {
	$msg =~ s/-/::/g;
	my @mod;
	unless ($msg =~ m/^[\w:]+$/ and
		@mod = sort Module::CoreList->find_modules (qr/$msg/)) {
	    $self->x_speak ($kernel, $channel, $nick, "No info for module '$msg'");
	    return;
	    }
	if (@mod > 4) {
	    my @m;
	    if    (@m = grep m/^$msg$/ => @mod) {
		@mod = @m;
		}
	    elsif (@m = grep m/^$msg/  => @mod) {
		@mod = @m;
		}
	    elsif (@m = grep m/$msg$/  => @mod) {
		@mod = @m;
		}
	    }
	if (@mod > 4) {
	    $self->x_speak ($kernel, $channel, $nick, "'$msg' matches more than 4 modules");
	    return;
	    }

	foreach my $mod (@mod) {
	    my $pv = Module::CoreList->first_release ($mod);
	    my $mv = $Module::CoreList::version{$pv}{$mod};
	    $self->x_speak ($kernel, $channel, $nick,
		"Module $mod was first released with perl $pv as version $mv");
	    }
	return;
	}

    # !change 63 GBP to EUR	-> !cents 63 GBP to EUR
    $msg =~ m{^!(?: change | convert | cents ) \s+
	([0-9.]+)? \s* ([A-Z]{3}) \s+ to \s+ ([A-Z]{3})
	$}ix and $msg = join " " => grep { defined } "!cents", $1, $2, "to", $3;
    # !change GBP 63 to EUR	-> !cents 63 GBP to EUR
    $msg =~ m{^!(?: change | convert | cents ) \s+
	([A-Z]{3}) \s* ([0-9.]+)  \s+ to \s+ ([A-Z]{3})
	$}ix and $msg = join " " => grep { defined } "!cents", $2, $1, "to", $3;

    if ($msg =~ m/^!( bug | rt | p5p | changes? | perl ) (?: \# | \s+) /xi) {
	if ($msg =~ s{ \s* \b last \b \s* }{ }x) {
	    my $target = "perl";

	    # remove the command and the optional for
	    $msg =~ s{^!\w+\s+}{};
	    $msg =~ s{ \s* \b (?: for | on ) \b \s* }{}x;

	    # defaults for maint, devel, blead and bleed
	    $msg =~ s{ ^ maint (?: \s | $ )}{}x and $target = "maint-5.8";
	    $msg =~ s{ ^ (?: devel | ble[ea]d ) (?: \s | $ )}{}x;
	    # allow these version specs
	    $msg =~ s{ ^ (?: maint | perl ) -? 5\.0*4  \b }{}x and $target = "maint-5.004";
	    $msg =~ s{ ^ (?: maint | perl ) -? 5\.0*5  \b }{}x and $target = "maint-5.005";
	    $msg =~ s{ ^ (?: maint | perl ) -? 5\.0*6  \b }{}x and $target = "maint-5.6";
	    $msg =~ s{ ^ (?: maint | perl ) -? 5\.0*8  \b }{}x and $target = "maint-5.8";
	    $msg =~ s{ ^ (?: maint | perl ) -? 5\.0*10 \b }{}x and $target = "perl";
	    $self->x_speak ($kernel, $channel, $nick, "Sorry, perforce is not available anymore, and this function has not yet been rewritten for git");
	    # $self->x_speak ($kernel, $channel, $nick, "Last patch for $target: ".
		# p4command ($kernel, "changes -s submitted -m 1 //depot/$target/..."));
	    return;
	    }

	$msg =~ m{ (?: \b( perl | bug | rt ) \s* \#? ([0-9]+)\b )
	         | (?: \b( changes? ) \s+ \#? ([0-9a-fA-F]+)\b (?!\s+ \w+ \s+ (?:into|to|in)) )
	         | (?: (\#) ([a-fA-F0-9]+)\b )
	         }xi or return;
        my $what = $1 || $3 || $5;
        my $numb = $2 || $4 || $6;

        my $msg = $what =~ m/changes?|#/i
	    ? perlbrowse ($kernel, $numb) || rtbrowse ($kernel, $numb)
	    : rtbrowse   ($kernel, $numb) or return;
	$self->x_speak ($kernel, $channel, $nick, $_) for split m/\n+/ => $msg;
	return;
	}

    if ($msg =~ s/^!(?:pennies|currenc(?:y|ies)|euro|dollar|cents)\s*//) {
	# purl was requested to change from and to the following currencies
	# Supported   here: AUD CAD CHF EUR GBP JPY NOK NZD USD
	# Unsupported here: CYP DKK KWD MTL PHP SAR SGD VND XAU

	my $url1 = "http://www.oanda.com/rtrates";
	my $url2 = "http://utsl.gen.nz/pennies.cgi";
	my $url3 = "http://www.exchange-rates.org";
	my $url4 = "http://finance.yahoo.com";

	if ($msg =~ m/^(?:help|sites?)$/) {
	    $self->x_speak ($kernel, $channel, $nick,
		"Exchange info fetched from $url1 , $url2 and $url3 . Conversions from $url4");
	    return;
	    }

	if ($msg =~ m{^ (?: ([0-9.]+) \s*)?	# amount
			([A-Z]{3}) \s+		# from currency
			to \s+
			([A-Z]{3})		# to currency
			$}ix) {
	    my ($amount, $frm, $to, $info) = ($1 || 1, uc $2, uc $3);
	    if ($info = get ("http://download.finance.yahoo.com/d/quotes.csv?s=$frm$to=X&f=sl1d1t1c1ohgv&e=.csv")) {
		my $csv = Text::CSV_XS->new ({ binary => 1 });
		$csv->parse ($info) and $info = ($csv->fields ())[1];
		}
	    if ($info =~ m/^[0-9.]+$/) {
		$self->x_speak ($kernel, $channel, $nick, join " ",
		    $amount, $frm, "makes", $amount * $info, $to);
		}
	    else {
		$self->x_speak ($kernel, $channel, $nick, "Conversion from $amount $frm to $to failed\n");
		}

	    return;
	    }

	my @curr = qw( EUR USD );
	my %conv = (
	    ""				=> [ "",    ""		],
	    "Australian Dollar"		=> [ "AUD", "\x{0024}"	],
	    "British Pound"		=> [ "GBP", "\x{00a3}"	],
	    "Canadian Dollar"		=> [ "CAD", "\x{0024}"	],
	    "Danish Krone"		=> [ "DKK", "\x{00a4}"	],
	    "Euro"			=> [ "EUR", "\x{20ac}"	],
	    "Iceland Krona"		=> [ "ISK", "\x{00a4}"	],
	    "Japanese Yen"		=> [ "JPY", "\x{00a5}"	],
	    "New Zealand Dollar"	=> [ "NZD", "\x{0024}"	],
	    "Norwegian Krone"		=> [ "NOK", "\x{00a4}"	],
	    "Romanian Leu"		=> [ "RON", "\x{00a4}"	],
	    "Swiss Franc"		=> [ "CHF", "\x{00a4}"	],
	    "Taiwan Dollar"		=> [ "TWD", "\x{0024}"	],
	    "US Dollar"			=> [ "USD", "\x{0024}"	],
	    );
	$conv{$conv{$_}[0]} = [ $_, $conv{$_}[1] ] for keys %conv;

	if ($msg =~ m/^(?:in\s+)?\b([A-Z]{3}\b\W*)+$/i) {
	    my @c = grep { exists $conv{$_} } split m/\W+/, uc $msg;
	    @c and @curr = @c;
	    }

	my $wua = WWW::Mechanize->new (agent => $aid, autocheck => 0);
	my $tree = HTML::TreeBuilder->new ();

	my %curr;
	$wua->get ($url1);
	if ($wua->success && $tree->parse_content ($wua->content)) {
	    my @xchg;
	    foreach my $tr ($tree->look_down (_tag => "tr", class => "rates_row")) {
		push @xchg, [ map { $_->as_text } $tr->look_down (_tag => "td") ];
		}
	    my %exchg;
	    for (@xchg) {
		my ($cfromto, $bid, $offer, $time) = @$_;
		my ($cfrom, $cto) = split m{\s*/\s*}, $cfromto;
		$exchg{$cfrom}{$cto} = ($bid + $offer) / 2;
		$exchg{$cto}{$cfrom} = 2 / ($bid + $offer);
		}
	    # convert all to pennies
	    foreach my $curr (keys %exchg) {
		exists $exchg{$curr}{GBP} or next;
		$curr{$curr} = $exchg{$curr}{GBP} * 100;
		}
	    foreach my $curr (keys %exchg) {
		exists $curr{$curr}      and next;
		foreach my $cur2 (keys %{$exchg{$curr}}) {
		    exists $curr{$cur2} or next;
		    $curr{$curr} = $curr{$cur2} * $exchg{$curr}{$cur2};
		    }
		}
	    $tree->delete;
	    }
	elsif ($wua->get ($url2) && $wua->content =~ m/<title>(?=[A-Z]{3}=)([^<]+)/) {
	    my $info = $1;
	    %curr = ($info =~ m/([A-Z]+)=([0-9.]+)p/g);
	    }

	# Alternative 3: http://www.exchange-rates.org/
	# http://www.exchange-rates.org/currentRates/E/GBP : Pages per region.
	# /E/ is Europe, /P/ is Asia & Pacific, /A/ is US, /F/ is Africa, and
	# /M/ is Middle East & Central Asia
	$url3 .= "/GetCustomContent.aspx?sid=RT0000KT6&type=RatesTable&stk=-0OH4LGW122";
	$wua->get ($url3);
	if ($wua->success and ($wua->content =~ m{\bRATES ARRAY\b(.*?)\bDATES VARIABLE\b}s)) {
	    my $code = $1;
	    my %r = ($code =~ m/r\[([0-9]+)\]='([0-9.]+)'/g);
	    my %n = ($code =~ m/n\[([0-9]+)\]="\s*([^"(]*?)\s*\(/g);
	    my %a = ($code =~ m/n\[([0-9]+)\]="[^"(]*\((\w+)\)\s*"/g);
	    foreach my $key (keys %r) {
		$curr{$a{$key}} //= 100 / $r{$key};
		$conv{$n{$key}} //= [ $a{$key}, "\x{00a4}" ];
		$conv{$a{$key}} //= [ $n{$key}, "\x{00a4}" ];
		}
	    }

	# Alternative 4: http://money.ligfiets.net/rates.php

	# Remove unwanted currencies
	delete $curr{CNY};	# Chinese Yuan Renminbi
	delete $curr{TWD};	# Taiwan Dollar
	delete $curr{ZAR};	# South African Rand

	# Make sure all currencies in @curr are known (!cents in XXX)
	foreach my $cur (@curr) {
	    $curr{$cur} and next;
	    my $info;
	    if ($info = get ("$url4/q?s=GBP$cur=X") and
		$info =~ m{<big>[\s\r\n]*<b>[\s\r\n]*([0-9.]+)[\s\r\n]*</b>[\s\r\n]*</big>}is) {
		$curr{$cur} = 100 / $1;
		}
	    }

	unless (exists $curr{EUR}) {
	    $self->x_speak ($kernel, $channel, $nick,
		"could not get exchange info from any of my sources");
	    return;
	    }

	$curr{GBP} = "100";
	foreach my $cur (@curr) {
	    my $sigil = $conv{$cur}[1] or next;
	    exists $curr{$cur} or next;
	    my %cur =
		map { $_ => sprintf "%.3f", $curr{$_} / $curr{$cur} } keys %curr;
	    delete $cur{$cur};
	    my $s = encode ("utf8", join ", ",
		map { "$_=$sigil$cur{$_}" } sort keys %cur);
	    $self->x_speak ($kernel, $channel, $nick, "[$cur] $s");
	    }
	return;
	}
    } # on_priv_cmd

sub public_cmd {
    my ($self, $kernel, $channel, $nick, $msg) = @_;
    my $org_msg = $msg;
    $msg =~ s{^(?:!\s*)?(?:clunker[39]|opbots?|$self->{Nick})[,:]?\s*\b}{!};
    if ($msg =~ m/^!u2\b/i) {
	$self->{Rantd} = time;
	$self->x_speak ($kernel, $channel, $nick, [
	    "Death by U2: http://www.xs4all.nl/~hmbrand/DeathByU2.jpg",
	    "Eleven reasons why Bono sucks: http://roxanneroxanne.wordpress.com/2006/09/26/eleven-reason-why-bono-sucks/",
	    "I hate U2: http://www.firepitblog.com/2006/08/19/i-hate-u2/",
	    "I hate U2: http://www.last.fm/group/I+hate+U2+but+will+not+go+so+far+as+to+wish+them+dead",
	    "most annoying noise: http://www.radioparadise.com/content.php?name=Journal&file=show_entry&jid=1650&from=Tux",
	    "The eleven worst songs of 2004: http://www.thebestpageintheuniverse.net/c.cgi?u=11worst",
	    "U2 are Complete Shit: http://thenamelessthing.com/node/23",
	    "U2 produces the worst imagineable ether-pollution. Unbelievable that they dare to call it music",
	    "U2 sucks, and they don't deserve a Grammy: http://acrosstheboard.blogspot.com/2006/02/u2-sucks-and-they-dont-deserve-grammy.html",
	    "U2 sucks: http://eatliver.com/i.php?n=468",
	    "U2 sucks: http://groups.myspace.com/index.cfm?fuseaction=groups.groupProfile&groupID=100088555&MyToken=ce14c4db-3241-489c-b536-e77aff1223d2",
	    "U2 sucks: http://nl.myspace.com/index.cfm?fuseaction=vids.individual&VideoID=634898",
	    "U2 sucks: http://www.democraticunderground.com/discuss/duboard.php?az=view_all&address=105x2898903",
	    "U2 sucks: http://www.imagepoop.com/image/807/U2-Sucks-Graffiti.html",
	    "U2 sucks: http://www.mostfunnypictures.com/pictures.php?id=468",
	    "U2 sucks: http://www.redzeppelin.org/111605",
	    "U2 sucks: http://youtube.com/watch?v=tVuy1sFYCno",
	    "We hate U2: http://www.last.fm/group/We+Hate+U2",
	    "Why U2 Sucks: http://fivebestlist.blogspot.com/2008/04/why-u2-sucks.html",
	    "Why U2 Sucks: http://www.eurotrip.com/content/why-u2-sucks",
	    "Why U2 Sucks: http://www.oldskool.org/archives/u2sucks",
	    ]->[int rand 21]);
	}
    if    ($msg =~ m/^!help\s*(!?\w+)?$/i) {
	my $h = $1 || "short";
	if ($h eq "short") {
	    $self->x_speak ($kernel, $channel, $nick,
		"usage: !help [short|long|command] | !commands");
	    }
	else {
	    $h eq "long" and $h = ".";
	    $self->x_speak ($kernel, "", $nick, "Here is the help you requested:");
	    my @h = grep m/^ !? $h \b /ix => @help;
	       @h = grep m/^ !? $h    /ix => @help unless @h;
	       @h = grep m/  \b $h \b /ix => @help unless @h;
	       @h = grep m/  \b $h    /ix => @help unless @h;
	       @h = grep m/     $h    /ix => @help unless @h;
	    $self->x_speak ($kernel, "", $nick, $_) for map { sprintf "%-24s%s", $_, $help{$_} } @h;
	    }
        $self->x_speak ($kernel, $channel, $nick, "See http://www.xs4all.nl/~hmbrand/clunker3.html for a detailed description");
	}
    elsif ($msg =~ m/^!(cmds|commands)$/i) {
        my ($h, $c) = (int (@help / 2));
        ($c = join ", ", @help[0..$h++]) =~ s/\s+/ /g;
        $self->x_speak ($kernel, $channel, $nick, $c);
        ($c = join ", ", @help[$h..$#help]) =~ s/\s+/ /g;
        $self->x_speak ($kernel, $channel, $nick, $c);
        $self->x_speak ($kernel, $channel, $nick, "See http://www.xs4all.nl/~hmbrand/clunker3.html for a detailed description");
	}
    elsif ($msg =~ m/^!ping$/i) {
        $self->x_speak ($kernel, $channel, $nick, "Pong!");
	}
    elsif ($msg =~ m/^!(?:time|date|today)(?:\s+(?i:in\s+)?(\S.*))?$/i) {
        my $tzn = " (wk %V)";
        my $off = $1 ? do {
	    (my $ttz = $1) =~ tr/ /_/;
	    my @ttz = grep m/$ttz/i => DateTime::TimeZone->all_names;
	    $ttz = @ttz ? $ttz[0] : "UTC";
	    my $ltz = DateTime::TimeZone->new (name => "local");
	    my $lof = $ltz->offset_for_datetime (DateTime->now);
	    my $tz  = DateTime::TimeZone->new (name => $ttz);
	    $tzn = $tz->name;
	    $tz->offset_for_datetime (DateTime->now) - $lof;
	    } : 0;
        my @d = localtime (time + $off);
        my $now = strftime "%a %d %b %Y %H:%M:%S $tzn", @d;
        $self->x_speak ($kernel, $channel, $nick, $now);
	}
    elsif ($msg =~ m/^!(uptime|version(s|_all)?)$/i) {
        my $time = sprintf "%d Days, %02d:%02d:%02d",
            (gmtime (time - $^T))[7, 2, 1, 0];
        $self->x_speak ($kernel, $channel, $nick,
	    "I am IRC::OpBot $VERSION running on perl $], and I've been up for $time");
	if ($2) {
	    $self->x_speak ($kernel, $channel, $nick, join " ", "Modules used:",
		map { "$_ ".V::get_version ($_) } qw(
		    CPAN
		    Cwd
		    Date::Calc
		    DB_File
		    Encode
		    Google::Translate
		    HTML::TreeBuilder
		    IRC::Bot::Log
		    LWP::Simple
		    Module::CoreList
		    Module::Reload
		    Net::DNS
		    Net::IP
		    POSIX
		    ));
	    $self->x_speak ($kernel, $channel, $nick, join " ", "  +",
		map { "$_ ".V::get_version ($_) } qw(
		    PROCURA::Diac
		    POE
		    POE::Component::Client::DNS
		    POE::Component::Client::Ident
		    POE::Component::IRC
		    POE::Filter::IRCD
		    Unicode::UCD
		    WWW::Mechanize
		    WWW::Shorten::TinyURL
		    Yahoo::Babelfish
		    ));
	    }
	}
    elsif ($msg =~ m/^!?seen\s+\S/i) {
        my ($reply, $wc, @arg) = (1, 0, split m/ /, $msg);
        (my $name = $arg[1]) =~ s/\s*\??$//;
        if ($msg !~ m/^!/ && exists $self->{SkipSeen}) {
	    unless (exists $self->{Names}{$channel} &&
		    exists $self->{Names}{$channel}{$self->canonical_nick ($self->{Nick})}) {
		$self->{Names}{$channel} = {};	# Empty previous list
		$kernel->post (NICK, "names", $channel);
		}
	    if (ref $self->{Names}{$channel}) {
		my @bots = ref $self->{SkipSeen} ? @{$self->{SkipSeen}} : ($self->{SkipSeen});
		foreach my $bot (@bots) {
		    exists $self->{Names}{$channel}{lc $bot} or next;
		    ($reply, $name) = (0, "");
		    last;
		    }
		}
	    }
        if ($name) {
            #print STDERR "seen ($name)\n";
            my @nickname = ($self->canonical_nick ($name));
            #print STDERR "seen (@nickname)\n";
            if ((my $wcname = $name) =~ s/(^|\w)\*/$1.*/g) { # With wild cards
		@nickname = sort { lc $a cmp lc $b }
		    grep m/^$wcname$/i => keys %{$self->{Quote}};
		@nickname < 1 || @nickname > 6 and @nickname = ($name);
		$wc++;
		}
            #print STDERR "seen (@nickname)\n";

            my $name_pat = "^(?:".join ("|", $name, @nickname).")\$";
            my @qnicks;
            eval {
               @qnicks = grep { m/$name_pat/i } sort keys %{$self->{Quote}};
               };
            if    ($name eq $self->canonical_nick ($nick)) {
                $self->x_speak ($kernel, $channel, $nick,
		    "Looking for yourself, $nick?");
		}
            elsif ($name eq $self->canonical_nick ($self->{Nick})) {
                $self->x_speak ($kernel, $channel, $nick, "I'm right here!");
		}
            elsif (@qnicks) {
                if (@qnicks > 4) {
		    $self->x_speak ($kernel, $channel, $nick,
			"Sorry, $nick, that would match too many names.");
		    }
		else {
		    my @msg;
		    foreach my $nickname (@qnicks) {
			print STDERR "-- seen $nickname\n";
			exists $self->{Quote}{$nickname} or next;
			my @quote = unpack "A12A30A*", $self->{Quote}{$nickname};
			my @tm = localtime $quote[0];
			my @nw = localtime;
			my @df = Normalized_Delta_YMDHMS (
			    $tm[5] + 1900, $tm[4] + 1, @tm[3,2,1,0],
			    $nw[5] + 1900, $nw[4] + 1, @nw[3,2,1,0]);
    #		    $df[0] == 0 && $df[1] == 0 and
    #			@df[2..5] = Normalize_DHMS (@df[2..5]);
			my @per;
			my @tag = qw( year month day hour minute second );
			for (0 .. 5) {
			    $df[$_]  or next;
			    push @per, "$df[$_] $tag[$_]";
			    $df[$_] > 1 and $per[-1] =~ s/$/s/;
			    }
			@per > 1 and push @per, join " and ", splice @per, $#per - 1, 2;
			my $period = join ", ", @per;
			$period and $period .= " ago";
			my $quote = $self->{SeenNoQuote}{lc $channel} ? "" : " saying: $quote[2]";
			push @msg, "$nickname was last seen on $quote[1] $period$quote";
			}
		    my $ch_or_msg = $wc && @msg > 3 ? "" : $channel;
		    $self->x_speak ($kernel, $ch_or_msg, $nick, $_) for @msg;
		    }
		}
            else {
                $self->x_speak ($kernel, $channel, $nick,
		    "Sorry, $nick, I haven't seen $name.");
		}
	    }
        elsif ($reply) {
            $self->x_speak ($kernel, $channel, $nick,
		"Hey $nick, it's like this: $help{'!seen'}");
	    }
	}
    elsif ($msg =~ m/^!utf8/i) {
	$self->x_speak ($kernel, $channel, $nick, $utf8line);
	}
    elsif ($msg =~ m/^!(iso8859-1|latin1)/i) {
	$self->x_speak ($kernel, $channel, $nick,
	    Tex8859_1 (UnicodeTex ($utf8line)));
	}
    elsif ($msg =~ s/^!hex\s+//i) {
	my $s = join " ", map { sprintf "%02x", ord $_ } split //, $msg;
	$self->x_speak ($kernel, $channel, $nick, "$s\n");
	}
    elsif ($msg =~ s/^!uchar\s+//i) {
	my %u_url = (
	    adv	=> "http://juerd.nl/site.plp/perluniadvice",
	    faq	=> "http://tnx.nl/perlunifaq",
	    tut	=> "http://tnx.nl/perlunitut",
	    uni	=> "http://tnx.nl/UNI",

	    let	=> "http://www.eki.ee/letter",
	    duo	=> "http://www.decodeunicode.org/en",
	    guh => "http://www.unicode.org/cgi-bin/GetUnihanData.pl",
	    ffi => "http://www.fileformat.info/info/unicode/char", # /2020/index.htm
	    );
	if ($msg =~ m/^sites?$/i) {
	    $self->x_speak ($kernel, $channel, $nick, join " ",
		$u_url{adv}, $u_url{uni}, $u_url{ffi},
		"EUR \x{20ac}:",
		"$u_url{ffi}/20ac/",
		"$u_url{let}/chardata.cgi?ucode=20ac",
		"$u_url{duo}/u+20ac",
		"$u_url{guh}?codepoint=20ac",
		);
	    }
	elsif ($msg =~ m/^help$/i) {
	    $self->x_speak ($kernel, $channel, $nick, "usage: !uchar [-v[<level>]] <text> U+20ac \\x{20ac} \\N{EURO SIGN}");
	    $self->x_speak ($kernel, $channel, $nick, "       !uchar sites | tutorial | faq | unicode | advice");
	    }
	elsif ($msg =~ m/^( faq | advice | tut (?:orial)? | uni (?:code)? )$/ix) {
	    $self->x_speak ($kernel, $channel, $nick,
		$u_url{lc substr $msg, 0, 3});
	    }
	else {
	    my $u;
	    my $u_verbose = $msg =~ s/^-v([0-9]*)\s+// ? $1 || 1 : 0;
	    $msg =~ s{\\?U\+?([0-9A-Fa-f]{4,6})}{encode ("utf8", chr hex $1)}gie;
	    $msg =~ s{&#([0-9]+);?}{encode ("utf8", chr $1)}gie;
	    $msg =~ s{&#x([0-9A-Fa-f]+);?}{encode ("utf8", chr hex $1)}gie;
	    $msg =~ s{\\x(?:\{([0-9A-Fa-f]+)\}|([0-9A-Fa-f]{2}))}
		     { encode ("utf8", chr hex ($1//$2))}gie;
	    $msg =~ s{(\\N[{]([\w ]+)[}])}
	             { ( $u = charnames::vianame (uc $2) )
			 ? encode ("utf8", chr $u) : $1 }ge;
	    utf8::decode ($msg);
	    my $si = length ($msg) == 1 ? 1 : 0;
	    my @w = $si ? ($msg) : split m/ /, $msg;
	    foreach my $w (@w) {
		my $s = encode ("utf8", join " ", map {
		    my $c  = chr $_;
		    my $cs = sprintf "%s U%04x \\N{%s}", $c, $_, charnames::viacode $_;
		    if ($si and $si = charinfo ($_)) {
			$cs .= " (".join(", ",@{$si}{qw(category script name block)}).")";
			}
		    $u_verbose and
			$cs .= sprintf " http://www.eki.ee/letter/chardata.cgi?ucode=%04x", $_;
		    $cs;
		    } unpack "U*", $w);
		$self->x_speak ($kernel, $channel, $nick, "$s\n");
		}
	    }
	}
    elsif ($channel and $msg =~ s/^!summon\s*//i) {
	if ($msg =~ s/^(\S+)\s*//) {
	    my $tgt  = decode ("utf-8", $1);
	    my $call = uc $tgt;
	    $msg ||= "$nick needs you";
	    foreach my $n (0 .. 10) {
		$call .= int (rand 2) ? uc $_ : lc $_ for " ", split //, $tgt;
		}
	    $self->x_speak ($kernel, $channel, $nick, "$call, $msg\n");
	    }
	else {
	    $self->x_speak ($kernel, $channel, $nick, "$self->{Nick} hands $nick a mirror\n");
	    }
	}
    elsif ($msg =~ s/^!(g[maen]|gr(?:eet)?)\b//i) {
	my $greet = lc $1;
	if ($greet eq "gr" || $greet eq "greet") {
	    my $hour = (localtime)[2];
	    $hour >= 4 && $hour <= 11 and $greet = "gm";
	    $hour > 11 && $hour <= 17 and $greet = "ga";
	    $hour > 17 && $hour <= 21 and $greet = "ge";
	    $hour > 21 || $hour <   4 and $greet = "gn";
	    }
	my @greet = (
	    [ "nl", "goede morgen",	"goedenmiddag",
		    "goedenavond",	"goedenacht",
		    "wenst",		"allen",	"een"	],
	    [ "en", "good morning",	"good afternoon",
		    "good evening",	"good night",
		    "wishes",		"you all",	"a"	],
	    [ "de", "guten Morgen",	"guten Tag",
		    "guten Abend",	"gute Nacht",
		    "wünscht",		"Ihnen",	"einen"	],
	    [ "fr", "bonjour",		"bonjour",
		    "bonsoir",		"bonne nuit",
		    "souhaite",		"à tous",	"un"	],
	    [ "es", "buenos días",	"buenos tardes",
		    "buenos noches",	"buenos noches",
		    "desea",		"a todos",	"una"	],
	    [ "pt", "bom dia",		"boa tarde",
		    "boa noite",	"",
		    "deseja",		"a todos",	"um"	],
	    [ "no", "god morgen",	"god ettermiddag",
		    "god kveld",	"god natt",
		    "ønsker",		"alle",		"en"	],
	    [ "ro", "bun\x{0103} diminea\x{0163}a",
		    "o bun\x{0103} dupa-amiaz\x{0103}",
		    "bun\x{0103} seara","noapte bun\x{0103}",
		    "ureaz\x{0103}",	"lui",		""	],
	    [ "el", "\x{3ba}\x{3b1}\x{3bb}\x{3b7}\x{3bc}\x{3ad}\x{3c1}\x{3b1}",
		    "\x{3ba}\x{3b1}\x{3bb}\x{3b7}\x{3c3}\x{3c0}\x{3ad}\x{3c1}\x{3b1}",
		    "\x{3ba}\x{3b1}\x{3bb}\x{3b7}\x{3c3}\x{3c0}\x{3ad}\x{3c1}\x{3b1}",
		    "\x{3ba}\x{3b1}\x{3bb}\x{3b7}\x{3bd}\x{3cd}\x{3c7}\x{3c4}\x{3b1}",
		    ],
	    [ "pl", "dzie\x{144} dobry","dzie\x{144} dobry",
		    "dobry wiecz\x{0f3}r",	"dobranoc",		],
	    [ "fi", "hyvää huomenta",	"hyvää Päivää",
		    "hyvää iltaa",	"hyvää yötä",		],
	    [ "eo", "bonan matenon",	"bonan tagon",		# esperanto
		    "bonan vesperon",	"bonan nokton",		],
	    [ "it", "buon giorno",	"buon pomeriggio",
		    "buona sera",	"buona notte",
		    "augura",		"a tutti",	"un"	],
	    [ "ja", "ohayo gozaimasu",	"konnichiwa",
		    "konbanwa",		"oyasuminasai",		],
	    [ "is", "gott daginn",	"gott daginn",		# iceland
		    "gott kveldi\x{00f0}",
		    "gott daginn",				],
	    [ "zt", "zao shang h\x{0103}o", "xia wu h\x{0103}o",
		    "wan shang h\x{0103}o", "wan an" ],
	    [ "sk", "dobr\x{0e9} r\x{0e1}no",  "dobr\x{0e9} popoludnie",
		    "dobr\x{0fd} ve\x{10d}er", "dobr\x{0fa} noc",
		    "\x{17e}el\x{0e1}", "v\x{0e1}m v\x{161}etk\x{0fd}m", "" ],
	    [ "tr", "G\x{00fc}naydin",	"T\x{00fc}naydin",	# turkey
		    "Iyi aksamlar",	"Iyi geceler",
		    ],
	    );
	if ($msg =~ m/^\s*help\b/i) {
	    $self->x_speak ($kernel, $channel, $nick,
		"!greet|gm|ga|ge|gn [ nick [ in lang ]] (" . join (", ", map { $_->[0] } @greet) . ")");
	    }
	else {
	    my $dz = { gm => 0, ga => 1, ge => 2, gn => 3 }->{$greet};	# Day Zone
	    my %greet = map { $_->[0] => [ @{$_}[1..7] ] } @greet;
	    foreach my $l (keys %greet) {
		$greet{$l}[$_] //= $greet{en}[$_] for 4..6;
		}

	    my $lang  = "";
	    $msg =~ s{\s+(?:in\s+)?([a-zA-Z]{2}(?:,[a-zA-Z]{2})*)$}{}i and
		$lang = lc $1;
	    my @lang = split m/,/ => lc $lang // "";
	    for (@lang) {
		s/ gr      /el/x;	# Greek    / Grieks
		s/ jp      /ja/x;	# Japanese / Japans
		s/ ch | ct /zt/x;	# Chinese  / Chinees (Traditional)
		s/ cs      /zh/x;	# Chinese  / Chinees (Simplified)
		s/ ge | du /de/x;	# German   / Duits
		s/ sp      /es/x;	# Spanish  / Spaans
		s/ dk      /da/x;	# Danish   / Deens
		}
	    @lang = grep { exists $greet{$_} } @lang;
	    @lang or @lang = map { $_->[0] } @greet; # Order matters

	    my ($trgt) = ($msg =~ s/^\s+(\S+)//) ? $1 :
		@lang == 1 ? $greet{$lang[0]}[5] : "you all";
	    $trgt .= $msg;
	    $greet = join ", ", map { $greet{$_}[$dz] } @lang;
	    my ($ww, $lw) = ("wishes", "");
	    if (@lang == 1) {
		$ww = $greet{$lang[0]}[4];
		$lw = $greet{$lang[0]}[6];
		}
	    ($greet = "$nick $ww $trgt $lw $greet!") =~ s/\s+/ /g;
	    $self->x_speak ($kernel, $channel, $nick, encode ("utf8", $greet));
	    }
	}
    elsif ($msg =~ s/^!(?:google|search)\s*//i) {
	if ($msg =~ m/^(\S.*)\s*$/) {
	    my ($url, $desc, $short) = google_search (split m/\s+/, $1);
	    if ($url) {
		$short and $url = "$short | $url";
		$desc =~ s{</?b>}{\cB}gi;
		$desc =~ s{</?u>}{\cU}gi;
		$desc =~ s{</?i>}{}gi;
		$self->x_speak ($kernel, $channel, $nick,
		    "$nick: [ $url ] $desc");
		}
	    else {
		$self->x_speak ($kernel, $channel, $nick, "error: $desc");
		}
	    }
	else {
	    $self->x_speak ($kernel, $channel, $nick, "usage: !google query");
	    }
	}
    elsif ($msg =~ s/^!acro(?:nym)?\s*//i) {
	if ($msg =~ m/^(\S+)$/) {
	    my ($url, $desc, $short) = acronym_search (split m/\s+/, $1);
	    if ($url) {
		$short and $url = "$short | $url";
		$desc =~ s{</?b>}{\cB}gi;
		$desc =~ s{</?u>}{\cU}gi;
		$desc =~ s{</?i>}{}gi;
		$self->x_speak ($kernel, $channel, $nick,
		    "$nick: [ $url ] $desc");
		}
	    else {
		$self->x_speak ($kernel, $channel, $nick, "error: $desc");
		}
	    }
	else {
	    $self->x_speak ($kernel, $channel, $nick, "usage: !acronym acronym");
	    }
	}
    elsif ($channel eq "#itrc" || $channel eq "#bot-test" and $msg =~ s/^!stat\S*\s+//) {
	if ($msg =~ m/^([A-Z][A-Z][0-9]+)/i) {
	    my $id = uc $1;
	    my $stats = `ssh a5 cd /u/usr/merijn/tmp/itrc \\; id-grep-db -d $id`;
	       $stats =~ s/\s+/ /g;
	       $stats =~ s/^DB\s+//;
	       $stats =~ s/^-\s+//;
	    if ($stats =~ m/^\s*\d+\s+$id\b/) {
		$stats .= " http://www.itrcstats.info/user_details.php?user_id=$id&show_others=1";
		$self->botspeak ($kernel, $channel, $stats);
		}
	    else {
		$self->botspeak ($kernel, $channel, "No stats for $id;");
		}
	    }
	else {
	    $self->botspeak ($kernel, $channel, "usage: !stats ITRC-ID");
	    }
	}
    else {
	$self->on_priv_cmd ($kernel, $channel, $nick, $msg);
	}
    $self->{Quote}{$nick} = pack "A12A30A*", time, $channel, $org_msg;
    } # public_cmd

# Handle public events
sub on_public {
    my ($self, $kernel, $who, $where, $msg) = @_[ OBJECT, KERNEL, ARG0 .. $#_ ];
    my $nick    = (split m/!/, $who)[0];
    my $channel = $where->[0];
    my $time    = sprintf "%02d:%02d", (localtime time)[2, 1];
    $log->chan_log ("[$channel $time] <$nick> $msg");
    return $self->public_cmd ($kernel, $channel, $nick, $msg);
    } # on_public

# Handle privmsg communication.
sub on_msg {
    my ($self, $kernel, $sender, $who, $nicks, $msg) =
	@_[ OBJECT, KERNEL, SENDER, ARG0, ARG1, ARG2 ];
    my $nick = (split m/!/, $who)[0] or return;
    my $time = sprintf "%02d:%02d", (localtime time)[2, 1];
    $log->bot_log ("[$self->{Nick} $time] PMSG: <$nick> $msg");
# Do we want to restrict /msg clunker3 !command
# to janitors or not ...
#   $self->trust ("all", $nick) or return;
    $msg =~ s/^\s*!?\s*/!/;
    return $self->public_cmd ($kernel, "", $nick, $msg);
    } # on_msg

sub on_dcc_ignore {
    my ($self, $kernel, $id, $who, $type) =
	@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2 ];
    print STDERR "on_dcc (@_)\n";
    } # on_dcc_ignore

# Got back info from the NAMES command.
sub on_names {
    my ($self, $kernel, $sender, $server, $who) =
	@_[ OBJECT, KERNEL, SENDER, ARG0 .. ARG1 ];

    $who =~ s/^\s*NAMES\s*//;	# Don't think this is true (anymore), no harm
    $who =~ s/^\s*(:\s*)?(=\s*)?//;
    $who =~ /(\S+)\s*:\s*([^"]*)/;
    my $chan  = $1 or return;
    my $names = $2 or return;
    my $nick  = $self->{Nick};
    my @names = map { [ m/^([+@]?)(\S+)/ ] } split m/\s+/, $names;
    #DDumper { chan => $chan, nick => $nick, names => \@names };
    $self->{Names}{$chan}{lc $_->[1]} = $_->[0] for @names;
    $names =~ m{\@$nick\b}i or return; # Cannot take action: I am no op
    for (@names) {
	my ($mode, $usr) = @$_;
	$mode eq '@' and next;	# Already op
	#  [ '',  'AVL!arjanl@ANice-653-1-501-68.w86-205.abo.wanadoo.fr' ]
	#  [ '@', '[Tux]!elektrans@hmbrand-adsl.xs4all.nl'               ]
	if ($self->trust ($chan, $usr)) {
	    $kernel->post (NICK, "mode", $chan, "+o", $usr);
	    next;
	    }
	$self->believe ($chan, $usr) or next;
	$kernel->post (NICK, "mode", $chan, "+v", $usr);
	}
    } # on_names

# Daemonize process
# Got this off of perlmonks
# Node id: 121604 tailored to my needs
# Was trying to avoid more dependencies.
sub daemon {
    my $self = shift;

    my @fh = (\*STDIN, \*STDOUT);

    (my $path = $self->{LogPath} // $ENV{HOME}) =~ s{/*$}{/};
    my $botid = $self->{BotID} // "";
    open \*STDERR, ">${path}error$botid.log";
    select ((select (\*STDERR), $| = 1)[0]);

    my $ppid = $$;
    my $pid = fork && exit 0;

    defined $pid or croak "No Fork: ", $!;

    while (kill 0, $ppid) {
        select undef, undef, undef, .001;
	}

    my $session_id = POSIX::setsid ();
    #chdir "/" or croak "Could not cd to /", $!;
    my $oldmask = umask 00;
    close $_ || croak $! for @fh;
    } # daemon

sub DESTROY {
    my ($self) = shift;
    $self && ref $self eq "HASH" && exists $self->{State} or return;
    foreach my $ch (keys %{$self->{State}}) {
	foreach my $db (keys %{$self->{State}{$ch}}) {
	    untie %{$self->{State}{$ch}{$db}};
	    }
	}
    } # DESTROY

# Disconnected, clean up a bit
sub on_disco {
    my ($self, $kernel) = @_[ OBJECT, KERNEL ];
    my $ts = scalar localtime;
    $log->serv_log ("[$ts] Disconnectd ...");
    $kernel->delay ("reconnect", 30);
#   exit (0);
    } # on_disco

# Try a basic Command Line Interface. Way open for improvements
unless (caller) {
    my $user = getpwuid $<;
    my $self = IRC::Bot->new (
	Debug       => 1,
	Nick        => $user,
	Server      => "localhost",
	Username    => $user,
	Ircname     => $user,
	Channels    => [ ],
	ConfigDir   => "/pro/3gl/CPAN/clunker3",
	Flood       => 1,
	BotID       => "CLI",
	LogPath     => "Log/",
	QuoteDB     => "QuotesCLI",
	);
    $self->x_speak    (undef, "CLI $VERSION", @ARGV);
    $self->public_cmd (undef, "CLI", $user, "@ARGV");
    }

1;

__END__

=head1 NAME

IRC::OpBot - Channel Maintenance IRC bot.

=head1 SYNOPSIS

  #!/usr/bin/perl

  use strict;
  use warnings;

  use IRC::OpBot;

  # Initialize: Tell what, where, how, ...
  my $bot = IRC::Bot->new (
      Debug     => 1,
      Nick      => "OpBot",
  #   NSPass    => "killer18",          # NickServer password
      AltNick   => [ qw( OpBot_ OpBot__ clunker slavorg ) ],
      Server    => "my.ircnet.org",
      Password  => "",
      Port      => "6667",
      Username  => "IRC Bot, work in progress. Based on IRC::BOT + Slavorg",
      Ircname   => "OpBot",
      Channels  => [ "#test",
                     "#opbots",
                     "#mychan",
                     ],
      SkipSeen  => [ qw( slavorg clunker dipsy purl ) ],
      ConfigDir => "/var/Log/opbot",
      BotID     => "IRC",
      LogPath   => "Log/",
      QuoteDB   => "QuotesIRC",
      );

  # Daemonize process
  $bot->daemon ();

  # Run the bot
  $bot->run ();

  __END__

=head1 DESCRIPTION

A complete bot, similar to eggdrop using POE::Component::IRC, based
on a major rewrite of IRC::Bot.
Allows access to most channel user management modes.  Provides
!seen and !quote functions, a complete help system, logging,
and it runs as a daemon process.
IRC::OpBot utilizes DB_File for seen and quote functions, and
also for session handling.

=head1 METHODS/OPTIONS

=over

=item new ()

B<new ()> Initializes the object, takes bunches of parameters to make
things work, see SYNOPSIS for usage.

=back

=head2 Parameters

=over

I<Debug> Tells P::C::I to output the messaging between client/server.  Outputs to error.log.


I<Nick> The nick you want your bot to go by.


I<Server> The server you want to connect the bot to.


I<Password> ~Optional~ Sets the password for a password protected server.


I<Port> Port to connect on server.


I<Username> Username for display in /whois .


I<Ircname> Also for /whois display.


I<Channels> List of channels to join, takes as many as you want to fit.


I<LogPath> ~Optional~ The absolute path of where to open log files.  If
set to 'null', nothing is logged, and error.log will be put in your
$ENV{HOME} directory.

I<NSPass> ~Optional~ Password to send to NickServ for identification on connect.

=back

=over

=item daemon ()

B<daemon ()> Sets process as a daemon.

=item run ()

B<run ()> Starts bot up, registers events, and tons of other neat stuff.

=back

=head1 CREDITS

Benjamin Smith for providing IRC::Bot

=head1 AUTHOR

IRC::Bot   - Benjamin Smith <defitro@just-another.net>
IRC::OpBot - H.Merijn Brand <h.m.brand@xs4all.nl>

=head1 SEE ALSO

IRC::Bot, POE::Component::IRC

=cut

__END__

0.09_04	Added : as valid sep for adressing mode
	Kept {Names} from last Names
	No seen reply is $self->{SkipSeen} bots exist
0.09_05 !utf8, !latin1, !hex voor Johan
0.09_06 !seen abel* (wildcards in seen)
0.09_07 !reload
0.09_08 !join/part missing argument
0.09_09 !version_all
0.10_01 |relations
        changed all serv_log () to bot_log ()
0.10_02 Made logpath deeper based on BotID
0.10_03 Fixed trusting/believing
0.10_04 !ban and !unban
0.10_05 Send NSPass on !nick when set
0.10_06 Tie quotes the right way
0.11_00 Add translation
0.11_01 Help end decode for translation
0.11_02 uchar recognizes U....
        uchar reports in hex rather than dec
0.11_03 untrust and unbelieve
0.11_04 added !calc
0.12_00 removed IRC::Bot::Help and IRC::Bot::Quote
	Made !help useful and accept arg
	Added !commands
0.12_01	Added -v to uchar to show the URL for encodings
0.12_02 Error in trust relation assignment fixed. log_files++
0.12.03 Added !paste note
0.12.04 Passed the UseSSL request for reconnect ()
0.12.05 "Pass" isn't recognized by POE::Component::IRC. should be "Password"
0.13.00 Add !smoke functionality
0.13.01 Specific user agent for LWP::Simple
0.13.10 Added Normalized_Delta_YMDHMS ()
0.13.11 Allow &#nnnn; for !uchar
0.13.20 Add !summon
0.13.21 More versions to version_all; Aliassed versions to version_all
0.13.22 Removed IRC::Bot::Auth and IRC::Bot::Seen stuff
0.13.23 More !tr language aliassing (ch = zt)
0.13.24 Accept multiple targets on (un)?(trust|believe)
0.13.25 Auto-create channel-tie files
0.13.26 !tr alias ja for jp
0.13.27 encodingtest is één woord
0.13.28 Added !GM for good morning :)
0.13.30 Ban/Unban only by trusted users
0.13.31 Help goes to nick only (added nickspeak () for that)
0.13.32 Hide the fact that !calc uses perl's eval
0.13.33 Added !ga !ge !gn and !greet (not complete yet)
0.13.34 Added Esperanto for !greet, more updates on languages
0.13.35 Extended the help, incl typo
0.13.36 Greeting can be to a target and in a language
0.13.37 Language fixes + !greet help
0.13.40 Added google search
0.13.41 Added tinyurl in google result
0.14.00 64bit + calc allows 0x...
0.14.01 missing encoding in greet
0.15.00 incorporated perlbrowse/rt stuff from abeltje's P5Changes.pm
0.15.10 fetch last patchlevel on request
0.15.11 two syntax fixes for when p4 ssh was not running
0.15.12 !changes accepted for !change
0.16.00 step 1 to supporting /msg commands
0.16.01 allow !greet in multiple selected languages
0.16.02 !paste also reacts on past[ey] is single word on line
0.16.10 !cpan from CPANinfo.pm from abeltje
0.16.11 new regex for stars/count
0.16.12 Reversed order hist at bottom, !seen with ! doesn't skip SkipSeen
0.16.13 Cleanup some unused global vars
	!seen is now much better and case-insensitive
0.16.14 Allow more words in the greet target
0.16.15 Should not use my $ua when global $ua in focus
0.16.16 Guard against #itrc web-interface
0.16.20 Add cpan diff
0.17.00 Add !stats for #itrc
0.17.01 Add link to Alex' site for ITRC stats
0.17.02 Add TuxCM
0.17.03 Share the truth about U2
0.17.04 Forward the request for Flood from new ()
0.17.05 # optional for !perl !rt and friends
0.17.06 Removed TuxSC
0.18.00 Support for /msg clunker3 ...
	!calc now accepts single argument like !calc 3
	!relations now nickspeak ()'s
0.18.01 use nickspeak for IDENTIFY on connect instead of botspeak
0.19.00 added !corelist
0.19.01 fixed !corelist help line
0.19.10 added !shorten
0.19.11 DESTROY & untie in END
0.19.12 disable !reload/!exit/!restart in !help and !commands
0.19.20 !pennies
0.19.21 !pennies alias to !pennies, !currency, !euro, !dollar, !cents
0.19.22 Add GBP to pennies, and remove conv to self
0.19.23 Make !pennies fallback to another site
0.19.24 Added exchange-rates.org custom site for !pennies
0.19.25 Allow to specify what the base currency is, and encode to utf8
0.19.26 Change source sequence for !pennies
0.19.27 Don't flood channel on big replies from !seen
0.19.28 !calc to return octal and hex for integer results
0.19.29 Allow currency conversion
0.19.30 Added currency help
0.19.31 Unicode::UCD info for single char uchar requests
0.19.32 uchar help/sites info
0.19.33 added http://www.decodeunicode.org/en/u+20ac in the uchar help list
0.19.34 more uchar help
0.19.35 prefer www.fileformat.info/info/unicode over www.eki.ee/letter
0.19.50 Add basics for CLI testing
0.20.00 Switch to Yahoo::Babelfish (abeltje++)
0.20.01 Break !cmds in two lines
0.20.02 Better SkipSeen (I hope) because better !names parsing
0.21.00 Split !versions
	Add Google::Translate
	fixed !tr list
	added !tr prefer
0.21.01 Encode translations
0.21.02 Only return translations with text
0.21.03 return doesn't work from within eval { }
0.21.04 allow \N{EURO SIGN} in !uchar
0.21.05 translators offer more than what get_translations () returns
0.21.06 Make U2 suckage more widespread
0.21.07 Make !help available to CLI
0.21.08 Use the on-line docs
        Don't rant about U2 more than once every 15 secs to prevent bot loop
0.21.09 Repair help for translate
0.21.10 Anchor Corelist seaches on high match counts
0.21.11 /msg should work for everybody
0.21.12 comparing translate results in lower case to prevent dup output
0.21.20 Add !p3 to return url's from Juerd's p3rl.org
0.21.21 Don't shorten search results shorter than 40 characters
0.21.22 Small typo in help
0.21.23 Add DKK to !cents
0.21.30 Allow !cents in any currency
0.21.31 Wrong conversion to/from GBP for unknown currency
0.22.00 Added !dict (so far just english)
0.22.01 Added dk as alias for da in !tr
0.22.10 Added nl to !dict
0.22.11 Allow &#x20a0 in !uchar
	Allow a single whitespace character in !uchar
0.22.12 !change last gives perlbrowse URL if valid
0.22.13 !seen's regex protected with eval {}
0.22.14 Filter !help keyword to make minimal match
0.22.20 Fix Google search
0.22.21 Recognize variations of [Tux]
0.22.22 Default help shorter
0.22.23 U2 rant alleen op verzoek
0.23.00 Van Dale has changed. A lot :(
0.23.01 Greet mag ook via /msg
0.23.02 De ochtend loopt t/m 11:59 niet 12:59
0.23.03 Catch possible mis-fetch from cpants
0.23.04 Private message if !cpan fails
0.23.05 Improved on !greet
0.23.06 !greet did the lang aliasing too late
0.24.00 !cpan detects USERID/distro.tgz
0.24.01 filter untranslated test for !tr
0.24.02 Fix the result from finace.yahoo
0.24.03 Add url to purl's code base
0.24.04 p4/perforce is dead
0.24.05 do not reply to !seen without arg
0.24.10 new layout for exchange rates needed better/safer parsing
0.24.20 make perlbrowse use git
0.24.21 "Good afternoon" in NO
0.24.22 update itrc-stats call convention
0.24.23 Add hudson
0.24.24 guten Mittag -> guten Tag
0.24.25 dict help and sites
0.24.26 greet in italian
0.24.27 U+123456 is legal (6 positions)
0.24.28 agent shouldn't crash if checking self
0.25.00 Use public URL for RT tickets
0.25.01 Add !acronym
0.25.02 RT returns both CPAN and PERL tickets
0.25.10 Add (basics for) Lingua::Translate and fix fallbacks
0.25.11 Add !time, !date, !today
0.25.12 Switch from Module::Reload to Module::Refresh
0.25.13 Don't die on short-url crashes
0.25.14 Added iceland to greetings
0.25.15 Added chinese to greetings
0.25.16 Greet greek in Greek, add sk (Slovak) to greetings
0.25.20 !summon encodes target to utf-8 to allow up-casing of diacritics
0.26.00 [Tux] is also valid
0.26.01 Allow !rt#12345 and try RT if perlbrowse fails
0.26.02 paste.husk.org is no more (dmq)
0.26.03 !change 63 GBP to EUR == !change GBP 63 to EUR
0.26.04 Add tr in greet
0.26.05 pasta is dead and won't be coming back
0.27.00 Add tel for procura
0.27.10 Allow !seen to hide content for specific channels
0.27.11 !RT#12345 should be recognized as !rt#12345
0.27.12 actualized paste sites
0.27.20 Allow timezones for !time !date
0.28.00 Switch to Pg for quotes
0.28.01 Fix !acro for single-hit results
0.28.02 Fix polish greet (mmitek)
