#!/usr/bin/perl <-- This is for magic only, thou shalt not invoke me directly
# -*- perl -*-   $Id: howl.pl,v 1.10 1999/01/11 20:53:16 urpo Exp urpo $
#
# HOWL! - Yet Another Some-Of-The-Features-*I*-Have-Always-Wanted
#         Script for sirc. Adds server list and some random
#         more-or-less useful features.
# 
#  .                      .
#  .                 ..   .|  | /-\ |    ; \     |
#   .       _     ./  /  . |--| | | |    |  |    |  The howlin' sirc thing
#    .   /     --'   / .   |  | \-/  \/\/  /___  o
#      /           / /|
#    /            |/ /
#    |/            /      |       |   |   |   |    | _  |  /
#    /           /    (c) |> \/    \/\ \/\ \/\ \/\/ <_> | |-
#                            /                            |
# 
# Why, oh why, people insist mucking around with this ASCII graphics
# rubbish? I DON'T EVEN NEED THE FIGLET dammit! I can make lousy graphics
# all by myself! ::grin::
#
# This script was written by Weyfour WWWWolf (an entity known in RL
# known as Urpo Lankinen). If you want to whine about this script (you
# will!) or just give some hints (you'd better...!), I can be reached
# at <wwwwolf@iki.fi>. My homepage is at <URL:http://www.iki.fi/wwwwolf/>.
# If you're *really* lucky, you can find me from IRCnet/GIMPnet/whatever.
# Most probable place to find me online is FurryMUCK after 22:00 EET or so.
#
# *Please* send me feedback! It's hard to fix stuff if I don't know
# what's wrong.
# 
#
#   DESIGN PHILOSOPHY:
#     I Shall Do Everything By Myself. Some of the features have
#          already been implemented, yea, but True Wulfids Do Their
#            Code With No Help From Others. (A certain amount of
#             stubbornness *is* required.)
#         The Implementation Shall Use Less Lines Than All Other
#               Implementations. Modulo the witless comments.
#            The Implementation Can Be Furr..., er, Hairier Than
#                   All Other Implementations, but it's just to
#                    Show How Great Language Perl Is And Why It Is
#                     Kewl To Write An IRC Client And All The Scripts
#                      Pertaining Thereunto Using Perl!
#                  Motto:
#                        Bring the Silliness to SIRC too. The IRC already
#                         is silly. (Trust me.)
#
#          "...if you're determined to reinvent the wheel, at least try
#           to invent a better one." -- Camel Book, 2nd ed.
#
#          And you DARE to call that hexagonal piece of wood a wheel?
#
# ::sigh:: I cheerfully admit that this source (and comments) may be
# funnier than the script itself.
#
# This *IS* GPL'd. No warranty. If it breaks you get to keep
# both... Wait a second, that's an old joke. No one will like it.
# 
# Okay, the usual blurb about Howl's Amazing Capabilities: howl.pl is a
# blah blah sirc blah blah extend functionality blah blah doesn't beat
# yiff.pl but is fun to hack on blah blah will have cool features
# someday, trust me blah blahhhhhhhh...
# 
#
# The Short, Short Feature List
# =============================
#  - Twiddlerance of the status line with on-fly customizable clock.
#    (can't speak of I18N, but it's better than nothing.)
#  - Qool server menu system! Accept *no* substitute! In 1.9,
#    the server menu is even cooler than what it used to be...
#  - No Reason to /quit? Worry not. Let the /rquit to do the job.
#    ("Slightly kewler" than the one script in the sirc dist...)
#  - URL support, fancier than the one in www.pl
#    (Allows you to save URLs to file, and give the browser spec in
#     env variable as normal text instead of using pre-set array notation
#     ... besides, it scans every line it sees.) Also includes
#    Just-save-all-URLs-to-the-file-I-don't-want-to-spend-my-time-
#    guessing-what-URLs-I-want-to-save-and-what-not option.
#  - elimination of "/msg NickServ foobar baz" for DALnet and such
#    (Does not echo the password to the screen - good for casually
#    paranoid users)
# 
# Bugs, mr. Rico! Zillions of 'em!
# ================================
#  - Full of obscurities (but remember da timtoady), badly 
#    documented, etc...
#  - The code is funnier than the-part-that-is-visible-to-the-user.
#  - I'm devastatingly absent-minded. Short answer: n+1 bugs that
#    I found but haven't fixed. Oh drats, now I remembered it. I have
#    to fix one. Bye...
# 
# Coming "Soon" To A howl.pl Near You
# ===================================
#  - *Automatic* nickname IDENTIFY issue (Security hole? Needs to be
#    optional? Well, on the other hand, you *do* know about chmod, right?)
#  - "FingerOfDeath<tm>" The Only True Finger Command - CTCP FINGER is for
#    WIMPS! (Well, maybe not...) You know, /finger from BotchX.
#    (Ach drats, they already have this. Well, I have to reimplement it!)
#  - Another royal pain I will probably not use, but hey, someone else
#    might: Automatic /whois when a user joins channel.
#  - URL completition a la "pop da URL from your list and send it to
#    channel/nick/etc..."
#  - CTCP/DCC logging (No one ctcps/dccs me (::sob::) so this will be
#    useless)
#  - The kewl file serf'er thingy from yiff.pl. Faster. Stealthier. More
#    efficient.
#  - Ummmmmmmm... hmmmmmmmm....... whatever?
# 
# This documentation doesn't include the Revision History, but as a
# reasonable facsimile of thereof, I present you this: I can mail you
# the rlog if you want it. Just ask me, I will not bite.
#
# Oh, did I mention that this is not your normal IRC script?
# Noooooo. You hafta get the qoolest qlient what this pathetic
# rock ball can offer. The Name is sirc. The URL is
# <URL:http://www.eleves.ens.fr:8080/home/espel/sirc.html>
# 
# Installation:
#  - You need a file called ~/.sirc/howl.rquits that lists your
#    /rquit reasons, one reason per line. (You probably won't need
#    this unless you plan to use rquit, of course...)
#    A file called ~/.sirc/howl.serlist will be generated automatically
#    if it doesn't exist. It will contain the server list. This file will
#    be in Perl format.)
#  - Drop this to any place that sirc thinks it sees. (~/.sirc/howl.pl
#    *is* an option...)
#  - Then, add something like this to your ~/.sircrc.pl:
#        $set{HOWLSERLIST} = "/path/to/your/serlist";
#        $set{HOWLRQUITS} = "/path/to/your/rquits";
#        &load("howl.pl");
#    (For complete list of $set{table} vars, see /wsethelp.)
#    You don't need to add those "set" lines if you use default locations
#    (~/.sirc/howl.{rquits,serlist}), of course.
#    And yes, you have to use $set{foo}="bar";, not &doset("foo","bar");...
#    So you'd better be careful that those variables are all right.
#    There's no way to check them - the script probably Needs to Know
#    the HOWLSERLIST when it starts, or it will use the default instead.
#  - Start thy sirc.
#
# Written with the almighty GNU Emacs. XEmacs dabugs when editing 
# perl (and otherwise) at the moment. Damned backspace...
#
# N.B.: ALL SANITY ABANDON, YE WHO ENTER HERE!
# This code is horrifying at times. Just look at the first three
# lines of the "meat" (remember the above mentioned rule!)
# Disclaimer: Larry Wall said I can do this. (Camel Book, 2nd ed, p. x)  


$rev = '$Revision: 1.10 $ ';  # RCS wants this, so we trim it thusly:
$rev =~ tr/eRsinov\$: //d;   # shorter than substitution and RCS will not get 
$rev = "v$rev";              # confused!

# That was the Violent Overture. Do you still think you want to continue?
# Don't go in there. It's dark in there! WAIT! ::shrug:: Okay, go there,
# you fool... But remember that *I WARNED YOU*!

$add_ons .= "+HOWL $rev" unless $add_ons =~ /\+HOWL $rev/;

$blt = "*\cbW\cb*";               # A bullet, y'know, *peoooow*

$ver = $blt.' Howlin\' sirc (c) Weyfour WWWWolf <wwwwolf@iki.fi> '.$rev;
&tell("$ver");
# Hah, "Bleedin' sirc" would be more edged

&tell("$blt Type /whelp (no pun intended) to get help with howl.pl.");

# Hooboy, this is getting hairy...
srand(time()^($$+($$<<15)));
# ...on the other hand, camels *are* hairy, but the Camel *Book* is not.

#######################################################################
# Some file locations and other defaults.

# Cowardly assuming we're under UNIX (and hey, who cares if we aren't?
# UNIX is the best alternative, anyway, anytime. At least for me.)

$sircdir = "$ENV{HOME}/.sirc";

# /me wonders if these are valid constructs? They seem to work.
$set{HOWLSERLIST} = $set{HOWLSERLIST} || "$sircdir/howl.serlist";

$set{HOWLRQUITS} = $set{HOWLRQUITS} || "$sircdir/howl.rquits";
$set{HOWLURLS} = $set{HOWLURLS} || "$ENV{HOME}/howlurls.txt";

$set{HOWLTIMEFMT} = $set{HOWLTIMEFMT} || "%H:%M";
$set{W3BROWSER} = $set{W3BROWSER} || "netscape -remote openURL(%URL)";

# This might annoy the hell out of the newbies, so the default is...
$set{URLAUTOSAVE} = "OFF";

# I said the script needs to know a few things. Now you know why.
# Well, maybe not the *real* reason yet... read on!

# in W3BROWSER, the string %URL will be replaced with the URL.

$lasturl = $ENV{WWW_HOME} || "http://www.iki.fi/wwwwolf/"; # ::giggle::

#######################################################################
# Here we set the ServerList, with cool defaults as defaults!
#

%howlservers = ( "Bogus" => [ { "Name" => "Default server",
					"Server" => "$server",
					"Default" => "YES" } ] );

#######################################################################
# Twiddlerance of the status line
#
# Hmmm.. Is it safe to use ANSI color codes? If it is, I will. If not,
# I will use them anyway. ::grins::
# Nope, apparently it isn't. (At least I think so - Lynx didn't worked
# too well from sirc. =)
#
# Note that I will not need mailcheck (I just *hate* biff and the
# relatives! Whoever invented this interesting way of annoying people
# should be fed to Sendmail... Did I said I want to tear the inventor
# limb to limb, bash his head against the nearest pine, disembowel him
# and serve his guts to him on a hot plate expecting him to say "Oh
# thank you, it was refreshing"?), but the clock will not hurt anyone
# (if I have to (er, I gladly will (Ah, the joys of LISP
# again. (Damnance.))) stay out of X, for instance.)

use POSIX; &POSIX::setlocale(POSIX::LC_ALL,"");

# I did the setlocale anyway. It's useless. <sob>
# Locales don't seem to deal with the "time separator"
# issue, and there's no "Just hour and minute in the preferred format"
# format for strftime... OUTRAGEOUS! DOWN WITH POSIX! =(

sub gettimestring {
    return &POSIX::strftime($set{HOWLTIMEFMT},localtime(time));
}

# One-liner. Beat that, Che. =)

sub hook_wstatus {
    my $proggy;

    # You don't see this...
    my $loggyname = getpwuid($<);
    if($loggyname =~ /(urpo|wwwwolf)/gi) {
	$proggy = "IrkkuVirveli(tm)";       # *I* need silliness!!!! YMMV!
    } else {
	$proggy = "sirc";
    }

    my $sleft = " [$proggy] "; # Dats what we use, dats what we code...
    if($haveops{$talkchannel}) { # If we are the Overlords, we need to be so
	$sleft .= "@";
    }
    $sleft .= "$nick"; # And who are we today?
    if($umode) { $sleft .= "(+$umode)"; } # And how we are doing...
    if($talkchannel eq '')  {  # And the channel we want to whine over...
	$sleft .= " on none";
    } else {
	$sleft .= " on ";
	$sleft .= $talkchannel;
	if($mode{$talkchannel}) {
	    $sleft .= "(+$mode{$talkchannel}) ";
	}
    }

    if($away) { $sleft .= " <Away> "; }
    if($query) { $sleft .= "<query: $query> "; }

    my $sright = "[".&gettimestring()."]";
    
    # Snazz-Funko-Kewl! GrrrrrWrrrgrgrrr! Arooooooooooooooo!
    # Should I add $scentered too? Nah... this code already stinks enough.
    my $space = " " x (79-length($sleft)-length($sright));
    my $statusline = $sleft . $space . $sright;
    $_[0] = $statusline;
}
addhook('status', 'wstatus');


#######################################################################
# Server list - let the WORLD babble.

if(-e $set{HOWLSERLIST}) {
    &load($set{HOWLSERLIST});
} else {
    &wsaveserlist(); # Saves the bogus default list...
    &load($set{HOWLSERLIST});
}
# Now you know why the HOWLSERLIST needs to be defined beforehand.

sub wprintfancyline {
    &tell($blt." "."=" x (79-length($blt." ")));
}

# "Voimaa... Nopeutta..." -- Sakke ja Speedy

sub cmd_serlist {
    my ($network, $cnt, $servcount, $serv, $server, $port, $prline);
    &print("$blt Server list by network (" . scalar(keys %howlservers) .
	   " networks):");
    &wprintfancyline;

    foreach $network (sort keys %howlservers) {
	$servcount = scalar(@{$howlservers{$network}});
	print "$blt Network: $network ($servcount hosts)\n";
	for($cnt=0; $cnt < $servcount; $cnt++) {
	    $prline = "$blt  Name: " . $howlservers{$network}[$cnt]{Name};

	    $serv = $howlservers{$network}[$cnt]{Server};
	    if($serv =~ /:/) {
		($server,$port) = split(/:/,$serv);
	    } else {
		$server = $serv;
		$port = 6667;
	    }
	    $prline .= ", server: $server, port: $port";

	    if(exists $howlservers{$network}[$cnt]{Default}) {
		$prline .= " (default)";
	    }
	    &print("$prline\n");
	}
    }

    &wprintfancyline;
}
&addcmd("serlist");
&addhelp("serlist","Usage: \cbSERLIST\cb
List the servers on your server list.");
sub cmd_saveserlist {
    &wsaveserlist;
    &tell("$blt Server list saved, I think...");
}
&addcmd("saveserlist");
&addhelp("saveserlist","Usage: \cbSAVESERLIST\cb
Saves the server list to $set{HOWLSERLIST}.
Note that the server list is saved automatically when it is changed, so
this command is not very useful.");

# <STARCRAFT>
# "I'm just curious, why am I so good?
# You know, the best obfuscator in the sirc front is...
# ...yours truly."
# </STARCRAFT>

sub cmd_xser {
    # My, my, my... Oh *my* GOD!
    my ($trgn, $trgs, $trgp, $ser, $serv, $network, $name, $trash);

    $trgs=""; $trgp = 6667;

    if ($args) {
	if ($args =~ /:/) {
	    ($trgn, $ser, $trash) = split(/:/,$args);
	} else {
	    $trgn = $args;
	}
	# print "\$trgn=\"$trgn\", \$ser=\"$ser\"\n";
      FINDIT:
	foreach $network (keys %howlservers) {
	    my $servcount = scalar(@{$howlservers{$network}});
	    if($network =~ /$trgn/gi) {
		# Found our network
		if($ser eq '') { # User doesn't want to tell
		    # we use default
		    $trgs = "";
		    $trgp = "";
		  SEARCHFORDEFS:
		    for($cnt=0; $cnt < $servcount; $cnt++) {
			if(exists $howlservers{$network}[$cnt]{Default}) {
			    $serv = $howlservers{$network}[$cnt]{Server};
			    if($serv =~ /:/) {
				# W00H00! We're in the deepest indent of
				# this script!
				($trgs,$trgp) = split(/:/, $serv);
			    } else {
				$trgs = $serv;
				$trgp = 6667;
			    }
			    last SEARCHFORDEFS;
			}
		    }
		} else { # Oh, he knows, well, let's make up something....
		    $trgs = ""; $trgp = 6667;
		  SEARCHLOOP:
		    for($cnt=0; $cnt < $servcount; $cnt++) {
			$name = $howlservers{$network}[$cnt]{Name};
			if($name =~ /$ser/gi) {
			    $serv = $howlservers{$network}[$cnt]{Server};
			    if($serv =~ /:/) {
				($trgs,$trgp) = split(/:/, $serv);
			    } else {
				$trgs = $serv;
				$trgp = 6667;
			    }
			    last SEARCHLOOP;
			}
		    }
		}
		last FINDIT;
	    }
	}
	if($trgs ne '') {
	    &tell("$blt Connecting to: $trgs:$trgp");
	    &docommand("disconnect");
	    &docommand("server $trgs $trgp");
	}
	else {
	    &print("$blt '$args' not found.");
	}
    }
    else
    {
	&print("$blt Usage: XSER network[:host]");
    }
}

&addcmd("xser");
&addhelp("xser","Usage: \cbXSER\cb network[:host]
Connects to a server. Network name and host name (optional) are separated
with colon. Will connect to the first network matched by regex, using
default server if host is not specified. If you specify the host,
this will connect to the first blah blah... you got the idea.");


# Add a new empty network.
sub cmd_netadd {
    if(not exists $howlservers{$args}) {
	if($args !~ /^$/) {
	    $howlservers{$args} = [];
	    &tell("$blt Network '$args' added.");
	    &wsaveserlist;
	} else {
	    &print("$blt Oh please, don't get Zen-philosophical with me!");
	}
    } else {
	&print("$blt Network '$args' already exists.");
    }
}

&addcmd("netadd");
&addhelp("netadd","Usage: \cbNETADD\cb name
Adds a network named 'name' to the server list.");

# Deletes a network.
sub cmd_netdel {
    my ($network);
    foreach $network (keys %howlservers) {
	if($network =~ /$args/gi) {
	    &getuserline("$blt say 'y' to delete network \"$network\".",
			 "Delete? ");
	    if(/^y$/i) {
		delete $howlservers{$network};
		&tell("$blt \"$network\" deleted.");
		&wsaveserlist;
	    }
	}
    }
    &wsaveserlist;
}

&addcmd("netdel");
&addhelp("netdel","Usage: \cbNETDEL\cb regex
Nukes all networks matching 'regex' from server list and deletes all
servers associated with them. (Okay, you can choose what nets you nuke...)");


# Add server

sub cmd_seradd {
    my ($network, $name, $serdata, $sername, $seraddr, $newthing);

    if(($args =~ tr/\"//) == 4) {

	# ::wags tail and lolls out tongue::
	$args =~ s/\s+/ /g;
	$args =~ /"([^\)]+):([^\)]+)"\s+"([^\)]+)"/;
	# Excellent...

	$network = $1; $name = $2; $serdata = $3;
	if(exists $howlservers{$network}) {
	    if(length($serdata) != 0 or lenghth($network) != 0) {
		$serdata =~ s/\s+/:/g;    # repl. whitespace with colon
		if(($serdata =~ tr/://) <= 1) {
		    if(scalar(@{$howlservers{$network}}) < 1) {
			&print("$blt Adding as $network default server");
			$newthing = {
			    "Name" => "$name",
			    "Server" => "$serdata",
			    "Default" => "YES",
			};
		    } else {
			$newthing = {
			    "Name" => "$name",
			    "Server" => "$serdata",
			};
		    }
		    # This is one of those magical moments...
		    push @{$howlservers{$network}}, $newthing;
		    
		    &tell("$blt Added $network:$name:$serdata");
		    &wsaveserlist;
		    
		} else {
		    &tell("$blt strange whitespace or odd colony"); # ::grunt::
		}
	    } else {
		&print("$blt I'm a computer, not a Zen philosopher.\n");
	    }
	} else {
	    &print("$blt Never heard of a network called $network. "
		   ."Please create it first!");
	}
    } else {
	&print("$blt Are you SURE you have read the documentation?");
    }
}
    
&addcmd("seradd");
&addhelp("seradd","Usage: \cbSERADD\cb \"network:name\" \"server[:port]\"
Adds a server called \cbname\cb at \cbserver\cb (port 6667 unless specified)
to the server list. If the entry exists, it will be replaced.
Use the double quotes as indicated.");


sub cmd_serdel {
    my ($cnt, $serv);
    foreach $network (keys %howlservers) {
	for($cnt = 0; $cnt < scalar(@{$howlservers{$network}}); $cnt++) {
	    $serv = $howlservers{$network}[$cnt]{Name};

	    if($serv =~ /$args/gi) {
		&getuserline("$blt say 'y' to delete \"$network:$serv\"",
			     "Delete? ");
		if(/^y$/i) {
		    splice @{$howlservers{$network}}, $cnt, 1;
		    &tell("$blt \"$network:$serv\" deleted.");
		    &wsaveserlist;
		}
	    }
	}
    }
}
&addcmd("serdel");
&addhelp("serdel","Usage: \cbSERDEL\cb name
Deletes server(s) from the server list.");


# Rename the network

sub cmd_netren {
    my ($old, $new);
    if(($args =~ tr/\"//) == 4) {
	$args =~ /"([^\)]+)"\s+"([^\)]+)"/; $old = $1; $new = $2;
	if(length($old) != 0 or length($new) != 0) {
	    if(exists $howlservers{$old}) {
		$howlservers{$new} = $howlservers{$old};
		delete $howlservers{$old};
		&tell("$blt Renamed network \"$old\" to \"$new\".");
		&wsaveserlist;
	    } else {
		&print("$blt Couldn't find a network called \"$old\".");
	    }
	} else {
	    &print("$blt MU.");
	}
    } else {
	&print("$blt if(exists \$manual) { &read_immediately(\$manual); } ");
    }
}
&addcmd("netren");
&addhelp("netren","Usage: \cbNETREN\cb \"oldname\" \"newname\"
Renames network oldname to newname and saves the server list.
Both names must be in double quotes. NB: oldname must be an
EXACT match, not partial.");


# Rename a server
# Apparently works. *Apparently*.
sub cmd_serren {
    my ($net, $old, $new, $cnt);
    if(($args =~ tr/\"//) == 4) {
	# Ah, I llllllove this stuff...
	$args =~ /"([^\)]+):([^\)]+)"\s+"([^\)]+)"/;
	$net = $1; $old = $2; $new = $3;
	# Guess what was even stranger than that? It worked the first
	# time I tried it! Honest! I don't know why...
	if(length($new) != 0) {
	    for($cnt = 0; $cnt < scalar(@{$howlservers{$net}}); $cnt++) {
		if($howlservers{$net}[$cnt]{Name} eq $old) {
		    $howlservers{$net}[$cnt]{Name} = $new;
		    &tell("$blt Renamed $net server \"$old\" to \"$new\".");
		    &wsaveserlist();
		}
	    }
	} else {
	    # Ack! the user gave a null string! ("")
	    &print("$blt Don't get zen-philosophical with me.");
	    # When users do that, it is my duty to get silly.
	    # Those users too stupid to live and they're asking
	    # for trouble.
	}
    } else {
	&print("$blt RTFHelp error. ");
    }
}
&addcmd("serren");
&addhelp("serren","Usage: \cbSERREN\cb \"network:oldname\" \"newname\"
Renames server \cboldname\cb (in network \cbnetwork\cb to \cbnewname\cb and
saves the server list. Both names must be in double quotes. NB: \cbnetwork\cb
and \cboldname\cb must be EXACT matches, not partials.");

sub cmd_serdef {
    my ($cnt, $currdef, $toset, $ourname);
    if(($args =~ tr/\"//) == 2) {
	$args =~ /"([^\)]+):([^\)]+)"/;
	$net = $1; $ser = $2;
	if(length($ser) != 0 or length($net) != 0) {
	    if(exists $howlservers{$net}) {
		# Let's see what the current default is...
		$currdef = -1; $toset = -1;
		for($cnt=0; $cnt < scalar(@{$howlservers{$net}}); $cnt++) {
		    if(exists $howlservers{$net}[$cnt]{Default}) {
			$currdef = $cnt;
		    }
		    if($howlservers{$net}[$cnt]{Name} =~ /$ser/gi) {
			$ourname = $howlservers{$net}[$cnt]{Name};
			$toset = $cnt;
		    }
		}
		if($toset == -1) {
		    &print("$blt Server '$net:$ser' not found.");
		} elsif($currdef == -1) {
		    &tell("$blt Strange... we have no default server."
			  ." '$net:$ourname' will be default.");
		    $howlservers{$net}[$toset]{Default} = 'YES';
		    &wsaveserlist;
		} else {
		    &tell("$blt '$net:$ourname' will be the default server "
			  ."for that network.");
		    $howlservers{$net}[$toset]{Default} = 'YES';
		    delete $howlservers{$net}[$currdef]{Default};
		    &wsaveserlist;
		}
	    } else {
		&print("$blt Network $net not found.");
	    }
	} else {
	    &print("$blt Manual. It \cbdoes\cb exist. In an electronic form.");
	    &print("$blt Can't stand this anymore, dammit. Why you people "
		   ."do so many errors, anyway?");
	    &docommand("help serdef");
	    # Considered Silly(tm)
	}
    } else {
	&print("$blt 'Manual' means also a handbook, it's not just a "
	       ."primitive form of using things.");
    }
}
&addcmd("serdef");
&addhelp("serdef","Usage: \cbSERDEF\cb \"network:server\"
Makes the \cbserver\cb the default server of the \cbnetwork\cb.");

# This is used to generate the initial list file
sub wmakeserlist {
    %howlservers = ( "Default IRC server" => "$server", );    
    &wsaveserlist;
}

sub wsaveserlist {
    my ($network, $servcount, $prline, $cnt);

    # Make backup - IN CASE IT SCREWS UP THE SAVE. It has been known
    # to do that.
    system ("cp", "-f", "$set{HOWLSERLIST}", "$set{HOWLSERLIST}~");

    if(-e $set{HOWLSERLIST}) { unlink $set{HOWLSERLIST}; }
    open SERLIST, ">$set{HOWLSERLIST}";
    print SERLIST "\# -*- perl -*-\n";
    print SERLIST "\# HOWL server list file. Generated by HOWL $rev.\n";
    print SERLIST "\# for ".getpwuid($<)." -- ".`hostname --fqdn`;
    print SERLIST
	"\# In general, there is no need to edit this file by hand.\n";

    print SERLIST "\%howlservers = (\n";


    foreach $network (sort keys %howlservers) {
	$servcount = scalar(@{$howlservers{$network}});
	print SERLIST "  \"$network\" => [\n";
	for($cnt=0; $cnt < $servcount; $cnt++) {
	    $prline = "  { \"Name\" => \"";
	    $prline .= $howlservers{$network}[$cnt]{Name} . "\",\n";
	    $prline .= "    \"Server\" => \"";
	    $prline .= $howlservers{$network}[$cnt]{Server} ."\"";

	    if(exists $howlservers{$network}[$cnt]{Default}) {
		$prline .= ",\n    \"Default\" => \"YES\"\n";
	    } else {
		$prline .= "\n";
	    }
	    if($cnt < $servcount) {
		$prline .= "    },\n";
	    } else {
		$prline .= "    }\n";
	    }
	    print SERLIST $prline;
	}
	print SERLIST "  ],\n"
    }

    print SERLIST ");\n\n";
}

#######################################################################
# rquit feature. (Uh, feature indeed... <bletch>)

sub cmd_rquit {
    if(!-e $set{HOWLRQUITS}) {
	&tell("$blt $set{HOWLRQUITS} doesn't exist. Please create it.");
	&tell("$blt Quitting anyway...");
        &docommand("quit");
    } else {
	open(RQUITS, $set{HOWLRQUITS})
	    or die "Aiee. Opening $set{HOWLRQUITS} failed.\n$!\n";
	my @rquitlines = <RQUITS>; close RQUITS;
	my $reason = $rquitlines[int(rand(scalar @rquitlines))]; # clever...?
	$reason =~ s/\s/ /g;

	$reason .= "[sirc $version$add_ons]";

	&tell("$blt RQuit: $reason");
	&docommand("quit $reason");
    }
}
&addcmd("rquit");
&addhelp("rquit","Usage: \cbRQUIT\cb
Quits with a random signoff reason read from file
$set{HOWLRQUITS}.");

#######################################################################
# Hoox and stuff...
#

# Here we update the status line with a ... horrible efficiency.

sub timer_dostatus {
    &dostatus();
    &timer(1, "&timer_dostatus();");
}

#...and kick it going
&timer(1,"&timer_dostatus();");

# Hell. It seems to work. MUAHHAHAHHAHAHA!

# This was in yiff.pl too - but... does it do this automatically?
# At least ircnet did this automagically with other clients... ::shrugs::
sub hook_startup {
    &docommand("/mode $nick +i");
}
addhook '376', 'startup';

# Lasturl detection from www.pl by Roger Espel Llima
# Now it detects it from EVERY line it prints (i.e. from MOTDs and from
# what you said!) and it does gopher too! Hmmm... mailto:? telnet!
# That regexp clearly needs more work... mailto: and news:
# don't *usually* have the monstrous //, they resort to local mail/news
# servers.
# The too-greedy-matching should be now fixed.

sub hook_wprint {
    my $preurl = $lasturl;
    $lasturl=$& if (($_[1] || $_[0]) =~
		    /(http|ftp|telnet|gopher):\/\/[^ >\)\}\]]+/i);
    if($set{URLAUTOSAVE} eq "ON" && $lasturl ne $preurl) {
	&save_url($lasturl);
    }
    &dostatus();
}
addhook ('print', 'wprint');

#######################################################################
# Web browser stuff.
# See also the print hook. Right above this section, pal.

# This is a very generic function. Can be reused elsewhere! HA!
sub openurl {
    my $URL = shift; my $command = $set{W3BROWSER};
    my (@cmd, @cmdraw, $value);

    my @cmdraw = split / /, $command;
    foreach $value (@cmdraw) {
	$value =~ s/%URL/$URL/g;
	push @cmd, $value;
    }

    $command = join ' ', @cmd;
    &tell("$blt executing: $command");
    system(@cmd);
}

sub cmd_gourl {
    &openurl($lasturl);
}
&addcmd("gourl");
&addhelp("gourl","Usage: \cbGOURL\cb
Goes to the URL that was mentioned last. Will start a web browser
(or use existing process, depending on the seriousness and X'iness
of the browser)");


sub cmd_openurl {
    &openurl($args);
}
&addcmd("openurl");
&addhelp("openurl","Usage: \cbGOURL\cb url
Opens URL to a web browser. Will start a web browser
(or use existing process, depending on the seriousness and X'iness
of the browser)");


sub cmd_printurl {
    &tell("$blt The URL is: $lasturl");
}
&addcmd("printurl");
&addhelp("printurl","Usage: \cbPRINTURL\cb
Shows what URL was mentioned last.");

sub save_url {
    my $url = shift;
    open(URLS,">>$set{HOWLURLS}") or die "Error opening URL file.\n$!\n";
    print URLS "$url\n";
    close URLS;
}

sub cmd_saveurl {
    &saveurl($lasturl);
    &tell("$blt Saved.");
}
&addcmd("saveurl");
&addhelp("saveurl","Usage: \cbSAVEURL\cb
Saves the URL that was mentioned last to the URL file.");

# ... IF something goes snafu ... (I'm going to hell with this coding style)
# O Perl! Thy crypticity hast enthralled me...
sub cmd_purgeurl {
    my $file = $set{HOWLURLS};
    my $tmp = "/tmp/sirc.$$";
    qx/sort $file >$tmp/; qx/uniq $tmp $file/; unlink $tmp;
    &tell("$blt URL file purged.");
}
&addcmd("purgeurl");
&addhelp("purgeurl","Usage: \cbPURGEURL\cb
\"Purges\" the URL file - sorts the file and runs it through
uniq.");


#######################################################################
# NickServ identification
#
# This could be made automagical when connecting to DALnet via /xser
# or something...
#

sub sendid {
    my $pass = shift;
    if($silent) {
	&msg("NickServ","identify $pass");
    } else {
	$silent = 1; &msg("NickServ","identify $pass"); undef $silent;
    }
}

sub cmd_nickid {
    &getuserpass("$blt Enter password for nick $nick.", "Password:");
    &sendid($_);
}
&addcmd("nickid");
&addhelp("nickid","Usage: \cbNICKID\cb
Asks you for nickname password and identifies yourself to
the NickServ.");

#######################################################################
# SETtable things

sub set_W3BROWSER {
    my $newbrowser = $args;

    if($newbrowser !~ /%URL/g) {
	# &print("$blt Error: Web browser specification must have \"%URL\"");
    } else {
	$set{W3BROWSER} = $args;
	# &tell("$blt WWW browser is now \"$set{W3BROWSER}\"");
    }
}

&addset("W3BROWSER");

&addhelp("set w3browser","Usage: \cbSET W3BROWSER\cb command
Sets the WWW browser you want to use. The command string must have %URL
(will be replaced by the URL you want to see).
Please note that if you're on text terminal and the client is curses-based,
it is likely that the only result is a messed screen. If you're on Linux
console, you can avoid this by using open(1), like this:
    /set w3browser open -s lynx %URL
will start Lynx on a new VT and flip you to this new console.");

# Bah, this is strange... ::yawn:: who the hell uses this /set, anyway?
sub set_HOWLSERLIST {
    $set{HOWLSERLIST} = $args;
    if(!-e $args) {
	&wmakeserlist();
    }
}
&addset("HOWLSERLIST");
&addhelp("set howlserlist","Usage: \cbSET HOWLSERLIST\cb path
Sets the location of HOWL server list file. If the target file doesn't
exist, it will be created.");

sub set_HOWLTIMEFMT {
    $set{HOWLTIMEFMT} = $args;
}
&addset("HOWLTIMEFMT");
&addhelp("set howltimefmt","Usage: \cbSET HOWLTIMEFMT\cb string
Sets the format of the clock. See strftime(3) man page for more
information about the time format. Default: %H:%M (24H-Hours:Minutes)");

sub set_HOWLRQUITS {
    if(-e $args) {
	$set{HOWLRQUITS} = $args;
    }
}
&addset("HOWLRQUITS");
&addhelp("set howlrquits","Usage: \cbSET HOWLRQUITS\cb path
Sets the location of HOWL rquit list file. If the target file does
not exist, the value remains unchanged.");

# We're just appending... no need to check if it exists.
sub set_HOWLURLS {
    $set{HOWLURLS} = $args;
}
&addset("HOWLURLS");
&addhelp("set howlurls","Usage: \cbSET HOWLURLS\cb path
Sets the location of the file where the collected URLs will be saved.");

sub set_URLAUTOSAVE {
    if($args =~ /^on$/i) {
	$set{URLAUTOSAVE} = "ON";
    } else {
	$set{URLAUTOSAVE} = "OFF";
    }
}
&addset("URLAUTOSAVE");
&addhelp("set urlautosave","Usage: \cbSET URLAUTOSAVE\cb {ON,OFF}
Sets whether or not to save all URLs automatically.");

# New settables needed:
#  - serlistconfirm

#######################################################################
# "We're the help desk..."
# "...installthatdllgotohellpatchthatdllgotohell..." (whatever, I can't
# remember the lyrics)

sub cmd_whelp {
    &docommand("/help howl");
}
&addcmd("whelp");

# This is just as intelligent as the
#   Minor alarm
#   Critical Alarm
#   Alarm System Failure Alarm

&addhelp("whelp","Usage: \cbWHELP\cb
Get help with HOWL!. Just type it, don't ask!");

&addhelp("howl"," *\cb*\cb* \cbHOWL!\cb $rev *\cb*\cb*
(c) 1998-1999 Weyfour WWWWolf da silly lupine technomancer

A small set of more or less useful commands for sirc.
Written by Urpo Lankinen <wwwwolf\@iki.fi>. Distributed under
GPL v2 or later. NO WARRANTY OF ANY KIND.

Information:
 WHELP        WHELPSET       WHELPALIASES
Server list:
 SERLIST      SAVESERLIST    XSER           NETADD         NETDEL
 NETREN       SERADD         SERDEL         SERREN         SERDEF
Surfboard navigation:
 GOURL        PRINTURL       SAVEURL        OPENURL        PURGEURL
Identification:
 NICKID
Miscellaneous:
 RQUIT
");

sub cmd_whelpset {
    &docommand("/help howlsets");
}
&addcmd("whelpset");
&addhelp("whelpset","Usage: \cbWHELPSET\cb
Get help with whelp settable things. Just type it, wait no longer...");

&addhelp("howlsets","
 The following things can be /set in HOWL!:

  /set w3browser browser      Sets what WWW browser you want to use.
  /set howlrquits path        Sets where the /rquit reasons can be found.
  /set howlserlist path       Sets where the server list resides
  /set howlurls path          Sets where the URLs will be saved
  /set howltimefmt string     Sets the time format for status bar
  /set urlautosave {on,off}   Sets whether or not to save all URLs
                              automatically.

 (See /help set blahblah for more details about each.)
 The default values will be used if the values are invalid. Read help
 text for each one of those if you please.
");

sub cmd_whelpaliases {
    &docommand("/help howlaliases");
}
&addcmd("whelpaliases");
&addhelp("whelpaliases","Usage: \cbWHELPALIASES\cb
Get help with whelp aliases. Just type it, wait no longer...");
&addhelp("howlaliases","
 The following HOWL! aliases are there by default:

  sl    serlist        gu    gourl
  pu    printurl       su    saveurl

 The rest will get there as soon as I figure out what the hell is wrong
 with them.
");


#######################################################################
# Anti-aliasing? Bah.
# And why on Earth the argument-dribbling things don't work?

&docommand('^alias sl serlist');    # aulryght, goin' streetwise (slang/curses)
# &docommand('^alias sadd seradd'); # Worry not, thou shouldst be happy
# &docommand('^alias sdel serdel');
# &docommand('^alias sren serrename');
&docommand('^alias gu gourl');
&docommand('^alias pu printurl');
&docommand('^alias su saveurl');    # Security hole =)
# &docommand('^alias ni nickid');   # Not the famous Knights o' NI!
                                    # but a good imitation...

#######################################################################
# What shall we do with the drunken connection?
#

sub hook_wdisconnect {
    &wsaveserlist;
}
# Dunno why, but it just *had* to be done...

addhook('disconnect', 'wdisconnect');

#######################################################################
# Everything done. Move on... Nothing to see in here anymore...
#

print "$blt Done loading. And \cbhowl\cb on earth did you get in here?\n";

# Uu, cool... the end of the script... so, the traditional place for
# greetings and such. Well, then... Greetings to tigert the Grand
# Master Of Gradients (Methinks your things go beyond the horizon),
# Che_fox (if you read this I hope you can accept my gravest apologies
# for being an idiot), Tapio Laakso (Use the Source, Luke! =), the
# rest of the folks at #gimp, StarChaser, Larry Wall for the greatest
# scripting language ever made, All supporters of RGRNCA (and other
# pure-hearted nethackers, too), my "fans" in the depths of the
# Lurkerdom, Quentinus of AFD (hack this script to cutechat if you
# can! =), (PurpleMotion && Skaven) / FC for the GREAT music, Folks in
# sfnet.atk.linux, Juuso Sokura (have fun when fighting Sihvonen and
# hey, Hirttamattomat like, you know, rulez! =), ... and last but
# definitely not the least, orabidoo for the sirc client itself.