# Infobot extensions inside the distribution.
# Local extensions go in myRoutines.pl

# Kevin A. Lenzo

sub Extras {
    # called after it decides if it's been addressed.
    # you have access tothe global variables here, 
    # which is bad, but anyway.

    # you can return 'NOREPLY' if you want to stop
    # processing past this point but don't want 
    # an answer. if you don't return NOREPLY, it
    # will let all the rest of the default processing
    # go to it. think of it as 'catching' the event.

    # $addressed is whether the infobot has been 
    #			named or, if a private or standalone
    #			context, addressed is always 'true'

    # $msgType can be 'public', 'private', maybe 'dcc_chat'

    # $who is the sender of the message

    # $message is the current state of the input, after
    #		  the addressing stuff stripped off the name

    # $origMessage is the text of the original message before
    #			  any normalization or processing

    # you have access to all the routines in urlIrc.pl too,
    # of course.


    if ($param{'zippy'}) {
	if (my $resp = zippy::get($message)) {
	    return $resp;
	}
    }

    # HYPEREXPERIMENTAL PURLDOC ROUTINES
    # 'purldoc keyword' - Might make sense to require
    # 'purldoc -q keyword' instead...the purldoc subroutine
    # filters out the -q (or -tq or -f ...) and it might
    # keep the infobot from butting in on descriptive
    # conversation.

    # I'd really like to memoize this, but I'm not sure
    # there would be much benefit.  I was just going to 
    # do it, but I'm tired now, so you're out.  Let me know 
    # if it is something you would like to see in the future.

    if (defined $param{'purldoc'} and $message =~ /^\s*$param{'purldoc_trigger'}\s+-?\w+/) {
        $message =~ s/^\s*$param{'purldoc_trigger'}\s+//; 
        &purldoc();		# Yes, this is almost silly, but it keeps this file
	# QUITE a bit smaller. 
        return 'NOREPLY';
    }

    # from Chris Tessone: slashdot headlines
    # "slashdot" or "slashdot headlines"
    if (defined($param{'slash'}) and $message =~
	/^\s*slashdot( headlines)?\W*\s*$/) {
	my $headlines = &getslashdotheads();
	return $headlines;
    } 

    # internic or RIPE whois
    if ($param{allowInternic}) {
	if ($message =~ /^(internic|ripe)(?: for)?\s+(\S+)$/i) {
	    my $where = $1;
	    my $what = $2;
	    &domain_summary($what, $where);

	    return 'NOREPLY';
	}
    }

    # currency exchanger, bobby@bofh.dk
    if( defined($param{exchange})
       and $param{exchange}
       and $message =~ /^\s*(?:ex)?change\s+/i ){

	&status("message($message)");
	my $response='';

	if ($pid = fork) {
	    # this takes some time, so fork.
	    return 'NOREPLY';
	}

	if ($message =~ /^\s*(?:ex)?change\s+([\d\.\,]+)\s+(\S+)\s+(?:into|to|for)\s+(\S+)/) {
	    my($Amount,$From,$To) = ($1,$2,$3);
	    &status("calling exchange($From, $To, $Amount) ...");
	    $response = &exchange($From, $To, $Amount);
	} elsif( $message =~ /^\s*(?:ex)?change ([\w\s]+)/) {
	    # looking up the currency for a country
	    my $Country = $1;
	    &status("calling exchange($Country) ...");
	    $response = &exchange($Country);
	} else {
	    $response = "that doesn't look right";
	}

	&status("exchange got response($response)");

	if($response =~ /^EXCHANGE/) {
	    &status($response);
	} elsif ($msgType eq 'public') {
	    &say("$who: $response");
	} else{
	    &msg($who, $response);
	}

	# exit the child or it gets weird
	exit 0;
    }

    # Jonathan Feinberg's babel-bot  -- jdf++
    if (defined $param{babel} && 
	(1 or $addressed) && 
	$message =~ m{
	    ^\s*
		(?:babel(?:fish)?|x|xlate|translate)
		    \s+
			(to|from) # direction of translation (through)
			    \s+
				($babel::lang_regex)\w*	# which language?
				    \s*
					(.+) # The phrase to be translated
					}xoi) {           
	my $whom = $who;	# building a closure, need lexical
	my $callback = $msgType eq 'public' ? 
	    sub{say("$who: $_[0]")} : sub{msg($who, $_[0])};
	&babel::forking_babelfish(lc $1, lc $2, $3, $callback);
	return 'NOREPLY';
    }

    # insult server. patch thanks to michael@limit.org
    if ($param{'insult'} and ($message =~ /^\s*insult (.*)\s*$/)) {
	my $person = $1;
	my $language = "english";
	if ($person =~ s/ in \s*($babel::lang_regex)\w*\s*$//xi) {
	    $language = lc($1);
	}
	$person = $who if $person =~ /^\s*me\s*$/i;

	my $insult = &insult();
	if ($person ne $who) {
	    $insult =~ s/^\s*You are/$person is/i;
	}

	if ($insult =~ /\S/) { 
	    if ($param{'babel'} and ($language ne "english")) {
		my $whom = $who; # building a closure, need lexical
		my $callback = $msgType eq 'public' ? 
		    sub{say("$_[0]")} : sub{msg($whom, $_[0])};
		&babel::forking_babelfish("to", $language, $insult, $callback);
		return 'NOREPLY';
	    }
	} else {
	    $insult = "No luck, $who";
	}

	return $insult;
    }

    if ($param{'weather'} and ($message =~ /^\s*weather\s+(?:for\s+)?(.*?)\s*\?*\s*$/)) {
	my $code = $1;
	my $weath ;
	if ($code =~ /^[a-zA-Z][a-zA-Z0-9]{3,4}$/) {
	    $weath = &Weather::NOAA::get($code);
	} else {
	    $weath = "Try a 4-letter station code (see http://weather.noaa.gov/weather/curcond.html for locations and codes)";
	}
#	if ($msgType eq 'public') {
#	    &say("$who: $weath");
#	} else {
	&msg($who, $weath);
#	}
	return 'NOREPLY';
    }

    if (defined $param{'metar'}) {
	my $metar = &metar::get($message);
	if ($metar) {
#	    if ($msgType eq 'public') {
#		&say("$who: $metar");
#	    } else {
	    &msg($who, $metar);
#	    }
	    return 'NOREPLY';
	}
    }

    if (defined $param{'uaflight'}) {
	if ($message =~ /usair\s+flight\s+(\d+)/i) {
	    my $res = &UAFlight::get_ua_flight_status($1);
	    if ($res) {
		return $res;
	    }
	}
    }

# from Simon: google searching
# modified to fork and generally search by oznoid

    if(defined($param{'wwwsearch'}) and 
       $message =~  /^\s*(?:search\s+)?($W3Search::regex)\s+for\s+['"]?(.*?)['"]?\s*\?*\s*$/i ) {
	 my $callback = $msgType eq 'public' ? 
            sub{say("$who: $_[0]")} : sub{msg($who, $_[0])};
         &W3Search::forking_W3Search($1,$2,$param{'wwwsearch'}, $callback);
       return "NOREPLY";
    }

    # Adam Spiers nickometer
    if ($message =~ /^\s*(?:lame|nick)-?o-?meter(?: for)? (\S+)/i) {
	my $term = $1;
	if (lc($term) eq 'me') {
	    $term = $who;
	}

	$term =~ s/\?+\s*//;

	my $percentage = &nickometer($term);

	if ($percentage =~ /NaN/) {
	    $percentage = "off the scale";
	} else {
	    $percentage = sprintf("%0.4f", $percentage);
	    $percentage =~ s/\.?0+$//;
	    $percentage .= '%';
	}
	
	if ($msgType eq 'public') {
	    &say("'$term' is $percentage lame, $who");
	} else {
	    &msg($who, "the 'lame nick-o-meter' reading for $term is $percentage, $who");
	}

	return 'NOREPLY';
    }

    if ($message =~ /^foldoc(?: for)?\s+(.*)/i) {
	my ($terms) = $1;
	$terms =~ s/\?\W*$//;
	
	my $key= $terms;
	$key =~ s/\s+$//;
	$key =~ s/^\s+//;
	$key =~ s/\W+/+/g;

	my $reply = "$terms may be sought in foldoc at http://wombat.doc.ic.ac.uk/foldoc/foldoc.cgi?query=$key";

	return $reply;
    }

    if ($message =~ /^(?:quote|stock price)(?: of| for)? ([A-Z]{1,6})\?*$/) {
	my $reply = "stock quotes for $1 may be sought at http://quote.yahoo.com/q?s=$1\&d=v1";

	return $reply;
    }


    if ($message =~ /^rot13\s+(.*)/i) {
	# rot13 it
	my $reply = $1;
	$reply =~ y/A-Za-z/N-ZA-Mn-za-m/;
	return $reply;
    }

    # divine added routine (boojum++)
    if ($message =~ /^(8-?ball|divine)\s+(.*)/i) {
        my %m8ball = ('original'  => 'shakes the psychic black sphere...',
                      'sarcastic' => 'shakes the psychic purple sphere...',
                      'userdef'   => 'shakes the psychic prismatic sphere...',
                     );

        if (!@m8_answers) {
          my $answer_file  =  $param{'magic8_answers'} || "$param{miscdir}/magic8.txt";

          print "reading from $answer_file\n";

          if (open MAGIC8, "<$answer_file") {
            while (<MAGIC8>) {
               chomp;
               push @m8_answers, $_;
            }
          } else {
            @m8_answers = ('the Magic Ball is cloudy or missing a fact file.');
          }
        }

        my ($type, $reply) = split /\s+=>\s+/, $m8_answers[rand(@m8_answers)];

        if ($msgType eq 'public') {
            &say("\cAACTION $m8ball{$type}\cA");
            &say("It says '$reply,' $who");
        } else {
            &msg($who, "\cAACTION $m8ball{$type} \cA");
            &msg($who, "It says '$reply'."); 
        }        
	return 'NOREPLY';
    }

	# search imdb
	if ($message =~ s/^\s*(search )?imdb (for )?//) {
	    $check = $message;
	    my $url = $message;

	    # freeside++ for URL cleanup code

	    my $date = "";
	    if ($url =~ s/( \(\d+\))$//) { $date = $1; }
	    $url =~ s/^(The|A|An|Les) (.*)/$2, $1/i;
	    $url = "http://www.imdb.com/M/title-substring?title=$url$date&type=fuzzy";
	    $url =~ s/ /+/g;
	    $V = "-> "; $orig_lhs = $message; $theVerb= "is";
	    return "$message can be found at $url";
	}

	if ($message =~ s/^\s*(search )?hyperarchive (for )?//) {
	    $message =~ /\w+/;
	    $check = $message;
	    my $q = $message;
	    $q =~ s/\W+//g;
	    $result = "http://hyperarchive.lcs.mit.edu/cgi-bin/NewSearch?key=$q";
	    $V = "-> "; $orig_lhs = $message; $theVerb= "is";
	    return "$message may be sought at $result";
	}

	# websters
	if ($message =~ s/^\s*(search )?websters? (for )?//) {
	    $message =~ /\w+/;
	    $word = $&;
	    $check = $message;
	    my $q = $message;
	    $q =~ s/\W+/+/g;
	    $result = "http://work.ucsd.edu:5141/cgi-bin/http_webster?$word";
	    $V = "-> "; $orig_lhs = $message; $theVerb= "is";
	    return "$message may be sought at $result";
	}

    # excuse server. bobby@bofh.dk
    if ($param{'excuse'} and 
        ($message =~ /^\s*(?:give\s+(.*)\s+an\s+excuse|excuse\s*(.*))\s*$/)) {
	&status("excuses...");
        if ($1 ne 'in') {
	  $person = $1 || "me";
        } 

	$person = $who if $person =~ /^\s*me\s*$/i;

	&status("calling &excuse()...");
	my $excuse = "$who: " . &excuse();
	if ($person ne $who) {
	    $excuse =~ s/^\s*Your excuse is/$who\'s excuse is/i;
	}

	if (not $excuse) { 
	    $excuse = "No luck getting an excuse, $who";
	}

	if ($msgType eq 'public') {
	    &say($excuse);
	} else {
	    &msg($who, $excuse);
	}
	return "NOREPLY";
    }

    return '';	# do nothing and let the other routines have a go
}

1;