#/yer/perl/here -w

# We should really have the -T switch enabled, but then the program simply fails on starup :
# Insecure dependency in eval while running with -T switch at /usr/local/lib/perl5/site_perl/5.005/Net/Jabber/IQ.pm line 510.

use strict;

=pod

=head1 NAME

Jabberdict

=head1 SUMMARY

$ /usr/local/bin/jabberdict -u dictionary_bob -p ****** &

=head1 DESCRIPTION

Jabberdict is a Perl script that logs on to a Jabber server and hangs around waiting to define words to people.

Jabberdict queries a Dict server with the body of incoming messages and returns the results to the sender.

=head1 EXAMPLE

aaron says: jabber

dictionary_bob says: web1913 Jabber \Jab"ber\, v. i. [imp. & p. p. {Jabbered};
p. pr. & vb.
n. {Jabbering}.] [Cf. {Gibber}, {Gabble}.]
To talk rapidly, indistinctly, or unintelligibly; to utter
gibberish or nonsense; to chatter. --Swift.
web1913 Jabber \Jab"ber\, v. t.
    To utter rapidly or indistinctly; to gabble; as, to jabber
French. --Addison.
web1913 Jabber \Jab"ber\, n.
Rapid or incoherent talk, with indistinct utterance;
gibberish. --Swift.
web1913 Jabber \Jab"ber\, n.
One who jabbers.
wn jabber
    n : rapid and indistinct speech [syn: {jabbering}, {gabble}]
    v : talk in a noisy, excited, or declamatory manner [syn: {rant},
{mouth off}, {spout}, {rabbit on}, {rave}]
foldoc jabber
<networking> An event that occurs when a device on a network
    using the {LAT} {protocol} continues to broadcast its
availability even though its availability status is known by
the network.
(1996-05-10)

=head1 OPTIONS

=over 4

=item B<-u> B<--username> I<string>

The username with which to connect to the Jabber server.

=item B<-pw> B<--password> I<string>

The password with which to authenticate to the Jabber server.

=item B<-r> B<--resource> I<string>

The resource with which to identify the user.

Default is : jabberdict

=item B<-s> B<--server> I<string>

The Jabber server where the user is registered.

Default is : jabber.com

=item B<-pt> B<--port> I<int>

The port that Jabberdict will use for connections.

Default is : 5222

=item B<-d> B<--dict> I<string>

The hostname for the Dict server that will be queried for definitions.

Default is : localhost

=item B<-m> B<--max> I<int>

The maximum number of lookups to accept before Jabber status is toggled to "unavailable" and susequent requests are simply ignored.

Default is : 10

=back

=cut

# Defaults

my $jabber_user     = "";
my $jabber_pswd     = "";
my $jabber_resource = "jabberdict";
my $jabber_host     = "jabber.com";
my $jabber_port     = "5222";

my $dict_server     = "localhost";

my $lookups     = 0;
my $max_lookups = 10;

my $help        = 0;

# Modules
use Net::Jabber;
use Net::Dict;

use Getopt::Long;
use Pod::Usage;

use Carp;
use Term::ReadKey;

# Objects
my $Jabber   = undef;
my $Presence = undef;
my $Log      = undef;

{
    &main();
    exit;
}

sub main {

    &load_up();
    &connect();
    &listen();

    return 1;
}

# sub load_up()
# Evalaute options and instantiate Jabber widgets.

sub load_up {

    &GetOptions(
		"username=s"    => \$jabber_user,
		"password|pw:s" => \$jabber_pswd,
		"resource:s"    => \$jabber_resource,
		"server:s"      => \$jabber_host,
		"port|pt:i"     => \$jabber_port,
		"dict:s"        => \$dict_server,
		"max:i"         => \$max_lookups,
		"help"          => \$help,
		);

    &usage() if ($help);
    &usage() if (! $jabber_user);

    if (! $jabber_pswd) {
        print "Password: ";

        ReadMode "noecho";
        $jabber_pswd = ReadLine 0;
        chomp $jabber_pswd;
        ReadMode "normal";
        print "\n";

    }

    $Jabber   = Net::Jabber::Client->new();
    $Presence = Net::Jabber::Presence->new();
    #$Log      = Net::Jabber::Log->new();

    $Log = Log->new();

    return 1;
}

# sub connect()
# Connect to the Jabber server and send presence.

sub connect {
    
    $Log->SetLog(
		 from=>$$,
		 type=>"notice",
		 data=>"connecting"
		 );

    $Jabber->Connect(
		     hostname => $jabber_host,
		     port     => $jabber_port,
		     );
    
    my @connect = $Jabber->AuthSend(
				    username => $jabber_user,
				    password => $jabber_pswd,
				    resource => $jabber_resource,
				    );

    if ($connect[0] ne "ok") {

	$Log->SetLog(
		     from=>$$,
		     type=>"error",
		     data=>"$connect[0] - $connect[1]"
		     );

	croak "Ident/Auth with server failed: $connect[0] - $connect[1]\n";
    }

    $Log->SetLog(
		 from=>$$,
		 type=>"notice",
		 data=>"connected."
		 );

    $Presence->SetType("available");
    $Presence->SetStatus("Ask me! Ask me, now!");
    $Jabber->Send($Presence);
    
    return 1;
}

# sub listen()
# Register callbacks and then hang around waiting for requests. 
# Toggles status relative to current number of lookups.

sub listen {
    $Jabber->SetCallBacks(message=>\&lookup);
    
    while (defined($Jabber->Process())) { 
	
	my $current_type = $Presence->GetType();

	if (($lookups >= $max_lookups) && ($current_type ne "unavailable")) {
	    $Presence->SetType("unavailable");
	    $Presence->SetStatus("I am helping someone else right now.");
	    $Jabber->Send($Presence);
    	}

	if ( ($lookups < $max_lookups) && ($current_type ne "available")) {
	    $Presence->SetType("available");
	    $Presence->SetStatus("Ask me! Ask me, now!");
	    $Jabber->Send($Presence);
	}

    }

    $Log->SetLog(
		 from=>$$,
		 type=>"notice",
		 data=>"disconnecting"
		 );

    $Jabber->Disconnect();
    return 1;
}

# sub lookup()

sub lookup {
    my $jid = shift || return;
    my $msg = shift || return;

    return if ($lookups >= $max_lookups);

    $lookups++;

    my $word   = $msg->GetBody();
    my $sender = $msg->GetFrom();

    $Log->SetLog(
		 from=>$sender,
		 type=>"notice",
		 data=>"$word"
		 );

    my $reply = Net::Jabber::Message->new();

    $reply->SetMessage(
		       to   => $sender,
		       body => &define($word),
		       );

    $Jabber->Send($reply);

    $lookups--;
    return 1;
}

# sub define()
# Returns 0 or more definitions, as defined by a Dict server, for $word.

sub define {
    my $word = shift;

    if (! $word) { 
	return "How can have any pudding if you don't eat all your meat?!";
    }

    my $dict = Net::Dict->new($dict_server);

    if (! $dict) {
	return $@;
    }

    my $defs = $dict->define($word);

    return "No definition for $word." unless ($defs->[0]);

    map { $_ = "$_->[0] $_->[1]"; } @$defs;
    return join("\n",@$defs);
}

sub usage {
    # This is a total hack.
    # pod2usage() is not returning 
    # anything and I don't know why.
    system "perldoc $0";
    exit;
}

# This is a quick hack until I figure out
# why Net::Jabber::Log doesn't think it has
# a "new" method.

package Log;

sub new {
    my $pkg  = shift;
    return bless {},$pkg;
}

sub SetLog {
    my $self = shift;
    my $args = { @_ };

    my $timestamp = time;
    
    warn "jabberdict: $args->{'type'} | $timestamp |  $args->{'from'} | [ $args->{'data'} ] \n";
}

return 1;

=pod

=head1 TO DO

=over 4

=item 

Get logging working.

=item 

Figure out why pod2usage() isn't returning anything.

=back

=head1 VERSION

1.0b1

=head1 AUTHOR

Aaron Straup Cope

=head1 SEE ALSO 

L<Net::Jabber>

L<Net::Dict>

=head1 LICENSE

This is free software. You may distribute it under the same terms as Perl itself.

=cut