# This is a sample ICBM script file which starts out by
# defining and registering a single, completely nonsensical
# command, then registers an alias for it.

sub ploogie
{
    my ($input) = @_;

    if ($input)
    {
        docommand("/msg icbm Ploogie!  $input");
        docommand($input);
        out ("We can TOO get the wood!");
    }
    else
    {
        docommand('/msg icbm Ploogie!');
        docommand('Ploogie!');
        out ("You can't get the wood, you know.");
    }
    my $date = `date`;
    out ($date);
}
addcmd("ploogie");

docommand ("/alias yackaboo ploogie EEEEeeeeeeeyackabooooooo!!!");


# A quick, if objectionable, example on how to use inline color
# functions ...

set_color ('output', 'green', 'magenta', 'bold', 'reverse');
out ("Today's date is $date, ICBM time.");
sleep (2);
set_color ('output', 'green');
out ("My god, those colors were hideous beyond mortal imagination.\nPlease kill yourself now.");


# And now let's start doing some things that are actually USEFUL.

set ('readhistsize', 750);
set ('cc_msg_list', 1);

# Some useful aliases ...

alias ('.',      'who .');
alias ('unaway', 'noaway');


# Let's store our password in memory.  If you're going to do this,
# you should of course chmod 600 $HOME/.icbm/pass.

my $datadir = defined $ENV{'ICBM_DATA'} ? $ENV{'ICBM_DATA'} : $ENV{'HOME'}.'/.icbm';
my $password;
open (PASS, "$datadir/pass");
chomp($password = <PASS>);
close (PASS);

# and now that we have that, we can do this:

sub sendpass
{
    docommand("/m server p $password");
}
addcmd('sendpass');
alias ('reg',    'sendpass');

# you could now use the following in your hooks file:

# sub register
# {
#     sendpass;
# }
# addhook('connect', 'register');

# but it WON'T WORK HERE, because it has to be loaded with loadhook(),
# not with load().

# here's another handy thing using the password:

sub reclaim
{
    my $nick = @_[0];
    docommand("/drop $nick $password");
    docommand("/n $nick");
    reg;			# remember, this is an alias to sendpass()
}
addcmd("reclaim");


# a shortcut function:

sub wi
{
    foreach my $nick (split (' ', @_[0]))
    {
        docommand("/whois $nick");
    }
}
addcmd('wi');


# we'll overload the topic function to make it check for length ....

sub topic
{
    my $topic = @_[0];

    if (length($topic) > 30)
    {
        out(sprintf ("Topic too long by %d characters", length($topic) - 30));
    }
    else
    {
        docommand("/m server topic $topic");
    }
}
addcmd('topic');

# and, so long as we're at it ....

sub idlebootmsg
{
    my $idlebootmsg = @_[0];

    if (length($idlebootmsg) > 54)
    {
        out(sprintf ("Idleboot message too long by %d characters", length($idlebootmsg) - 54));
    }
    else
    {
        docommand("/status idlebootmsg $idlebootmsg");
    }
}
addcmd('idlebootmsg');
alias('idle', 'idlebootmsg');


# used to IRC?  Try this:

sub me
{
    my $out = '<-- '.@_[0];
    docommand($out);
}
addcmd('me');


# autocorrect 'teh' to 'the', and 'adn' to 'and', as a standalone
# word only, regardless of initial capitalization

correct ('/\b([Tt])eh\b/$1he/');
correct ('/\b([Aa])dn\b/$1nd/');



# This function uses the generic hook mechanism and the deadjim() hook function
# from sample_hooks to implement a single reclaim command (aliased as recover) to
# drop a zombie connection, or someone using your registered nick, and change your
# nick back to that nick.  (It is assumed that you have saved your password in the
# $password variable.)

sub reclaim
{
    my $nick = @_[0];
    my $result;

# Set up the generic trigger

    set_trig_mask("$nick .* disconnected");
    set_trig_result(0);
    set_trig_status(1);

    docommand("/drop $nick $password");

# Sleep on trigger

    until (($r = get_trig_result()) =~ /disconnected|found/)
    {
        out("Result: $r");
        sleep (1);
    }

# Clear the trigger

    set_trig_status(0);
    set_trig_result(0);
    set_trig_mask('');

    docommand("/nick $nick");
    docommand("/m server p $password");
}
addcmd("reclaim");
alias('recover', 'reclaim');



# load some hooks

loadhook('sample_hooks');

# The following is an example of using the now-internal URL grabber
# and pulling data out of it to use in user-side functions.  The mozilla()
# function uses Mozilla's -remote functionality to direct an existing
# Mozilla instance to open a specifed URL in a new window (or to open the
# Mozilla Messenger mail window).  Adaptation of this code for any other
# browser is left as an exercise to the reader.
#
# Two option strings are recognized, both of which are passed along to and
# eventually parsed by mozilla().  The -v command causes mozilla() to
# display the actual browser command line executed; the -a command causes
# mozilla() to open all URLs matching a particular key (the default behavior
# is to warn the user that the key is ambiguous and drop it).


sub net
{
    mozilla(split(/\s+/, @_[0]));
}
addcmd("net");


sub google
{
    my $url = sprintf('http://www.google.com/search?q=%s&hl=en&ie=ISO-8859-1',
                      join('+', split(/ /, @_[0])));
    mozilla ($url);
}
addcmd("google");


sub mail
{
    mozilla('mail');
}
addcmd("mail");


sub mozilla
{
    my (@urls) = @_;
    my $urls = @urls;
    my @urllist = get_urls;
    my $cmd, $i, $all = 0;

    if (grep(/^-a$/, @urls))
    {
        @urls = grep(!/^-a$/, @urls);
        $all = 1;
    }

    for ($i = 0; $i < @urls; $i++)
    {
        my $url = @urls[$i];
        next if ($url =~ /^http:/);

        $matches = @matches = grep(/$url/, grep(!/^$url$/, @urllist));
        if ($matches == 1)
        {
            @urls[$i] = @matches[0];
            out(sprintf ("%s -> %s", $url, @urls[$i]));
        }
        elsif ($matches)
        {
            if ($all)
            {
                splice(@urls,$i,1,@matches);
                out(sprintf ("%s -> %s\n",
                              $url,
                              join(', ', @matches)));
            }
            else
            {
                splice(@urls,$i,1);
                out (sprintf ("Ambiguous key %s matches these URLs:", $url));
                foreach my $u (sort @matches)
                {
                    out("    $u");
                }
                $i--;
            }
        }
    }

    if (@urls)
    {
        my $procs = `ps x`;

        if ($procs =~ /mozilla\/mozilla/)
        {
            sleep (1);
            foreach my $url (@urls)
            {
                $url = sprintf("http://%s", $url) unless ($url =~ /:\/\// || $url eq 'mail');
                my $cmd = ($url eq 'mail')
                          ? "nice -5 /opt/mozilla/mozilla -remote 'xfeDoCommand (openInbox)' >/dev/null 2>/dev/null"
                          : "nice -5 /opt/mozilla/mozilla -remote 'openURL($url, new-window)' >/dev/null 2>/dev/null";
                out("MOZILLA COMMAND: $cmd\n") if ($verbose);
                system($cmd);
            }
        }
        else
        {
            out("Mozilla is not running!");
        }
    }
}


# In theory, we should be able to use "mozilla -remote 'ping()'" to find out if there's
# another running Mozilla process.  Unfortunately, if we spawn this command directly,
# we can't redirect the stdout/stderr noise away, and if we spawn it in a subshell, we
# can't get the return value from the actual command back, only the subshell's return
# value -- which doesn't help us much.  Hence the dinking around with ps.  If you find
# a better way, let me know.
