# Googlematic::IM
# (c) 2002 Matt Webb <matt@interconnected.org> All rights reserved
#
# Googlematic::IM runs as a single session under POE, and is started by the
# main script. It has three event loops:
#
# 1 - Maintain login
#     The login_aim state is first called by the _start state. It's triggered
#     to run every two hours and ensure the Net::AOLIM is still logged in (as
#     well as logging in to the service in the first place).
#
# 2 - Main loop
#     The loop state is first called on startup, and from then on always yields
#     only to itself. It's only function is to give time to the Net::AOLIM
#     event loop.
#
# 3 - Net::AOLIM
#     When initialised, Net::AOLIM is given a state in this session (called
#     handler_aim) to use as a callback. Net::AOLIM is given time by the main
#     loop, and hands off to handler_aim every time an event comes over the AIM
#     interface.
#
# The process after that is fairly simple.
# - handler_aim takes the messages coming, cleans them up and hands them to
#   spawner.
# - spawner takes care of existing Responders, starts new ones, and hands
#   incoming messages off to them (Responders maintain state for a user over
#   IM. They do the Google search, and figure out what messages to send back).
#
# There are sundry messages to facilitate sending IM messages back out to the
# outside world, and for communicating between IM sessions.


package Googlematic::IM;

use strict;
use POE::Session;
use Net::AOLIM;
use vars qw/$IM_ERR $IM_ERR_ARGS/;
use Googlematic::Responder;


# _start
# - Sets up some variables
# - Starts the login_aim event loop
# - Start the main event loop
sub _start {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];

    # Let other sessions refer to this one as 'im'
    my $status = $kernel->alias_set("im");

    # Keep buddy name to session id mapping here
    $heap->{responders} = {};
    $heap->{responders_count} = 0;

    # There are two AIM states: off,  on
    # We're being cautious - it's knocked down to 'off' if any kind
    # of error comes in. Only a successful login can put it in the
    # 'on' state again
    $heap->{aim_state} = 'off';
 
    # Start the login_aim event loop
    print "Attempting to login to AIM...\n";
    $kernel->yield("login_aim");
    
    # Start the main event loop. Delay it a little to give a little time
    # to login to AIM
    $kernel->delay('loop', 5);
}


# _stop
# - Called automatically when the session ends
# - Ends the AIM session
sub _stop {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];

    # Kill the AIM connection
    delete $heap->{aim};
}


# login_aim
# - Once called, will run every 2 hours
# - If not logged in, will instantiate the Net::AOLIM object and log in
# - AIM username, password kept in here
sub login_aim {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];

    if($heap->{aim_state} eq 'off') {
	
	$heap->{aim} = Net::AOLIM->new(
				       username => $Googlematic::CONFIG->{aim_username},
				       password => $Googlematic::CONFIG->{aim_password},
				       callback => $session->postback('handler_aim'),
				       # $session->postback('handler_aim')
				       # generates a subroutine reference
				       # that can be used as a callback. All
				       # AIM events will be sent there.
				       allow_srv_settings => 0,
				       login_timeout => 2
				       );
	
	# The connection needs to have itself in its buddy list.
	$heap->{aim}->add_buddies("friends", $Googlematic::CONFIG->{aim_username});
	
	# Try signing on... Method returns 0 on success
	
	if($heap->{aim}->signon ne 0) {
	    my $error = $Net::AOLIM::ERROR_MSGS{$IM_ERR};
	    $error =~ s/\$ERR_ARG/$IM_ERR_ARGS/g;
	    print STDERR "Signon error: $error\n";
	    
	    delete $heap->{aim};
	}
	else {
	    print STDERR "Signed on okay\n";
	    $heap->{aim_state} = 'on';
	}
    }

    # Make sure the connection is up in another 2 hours
    $kernel->delay("login_aim", 7200);
}


# loop
# - The main loop
# - Gives time to the Net::AOLIM event loop
sub loop {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    
    if($heap->{aim_state} eq 'on') {
	# Loop over the dataget for not very long at all, to give
	# POE a chance to hand time off to other events
	$heap->{aim}->ui_dataget(0.01);
    }

    # Keep loopin	
    $kernel->yield('loop');
}


# handler_aim
# - This is the callback for all events coming from AIM
# - Interprets messages, and hands them off to the generic spawner
# - Doesn't try to cope with evil warnings or flood warnings
# - Other handlers can operate in the same way, handing off to the
#   same spawner
sub handler_aim {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];

    # Net::AOLIM hands all its parameters over in this single argument
    # See Net::AOLIM documentation for information
    my $params = $_[ARG1];

    my $aim_event_type = $params->[0];

    if($aim_event_type eq 'IM_IN') {
	# That's an incoming buddy message.
	# This is really the only event we're very interested in.
	my ($buddy_name, $message) = @{$params}[1, 3];
	$message =~ s/<.+?>//g; # remove HTML from the message
	$kernel->yield("spawner", "aim", $buddy_name, $message);
    }
    elsif ($aim_event_type eq 'ERROR') {
	# That's an error, surprise. Print it, don't do anything
	my $error = $Net::AOLIM::ERROR_MSGS{$IM_ERR};
	$error =~ s/\$ERR_ARG/$IM_ERR_ARGS/g;
	print STDERR "AIM error: $error\n";
    }
    elsif(!defined($aim_event_type) || $aim_event_type =~ m/^\s*$/) {
    	# An unlabelled event is a sign of bad things. Take down the
    	# AIM connection, and bump login_aim so it happens in 10
    	# minutes. The reason not to log back in immediately is the AIM
    	# server will block the user if there's a rush of signins, and if
    	# the connection has come down because we've been flooding 10
    	# minutes gives time for the limit to come down.
	print STDERR "Undefined AIM event!\n";
	$heap->{aim_state} = 'off';
	delete $heap->{aim};
	$kernel->delay("login_aim", 1200);
    }
}

# spawner
# - Generic interface for any incoming message
# - Given a buddy name and a message, does the following:
#   - If it's a buddy name with a Responder open, hands the message to
#     the Responder
#   - If it's a new buddy name and there aren't too many Responders
#     already, starts a new Responder (which is a POE Session) and gives
#     it the message
#   - If there are too many Responders open already, sends back an apology
# - All incoming IM messages come this way. Outgoing messages go via the
#   send state.
sub spawner {
    my ($kernel, $heap, $sessions) = @_[KERNEL, HEAP, SESSION];
    my ($interface, $buddy_name, $message) = @_[ARG0, ARG1, ARG2];

    # Log this to STDOUT
    print "Got message <$message> from <$buddy_name> by <$interface>\n";

    if($heap->{responders_count} > $Googlematic::CONFIG->{max_user_sessions}) {
	print "Too busy.\n";
	$kernel->yield("send", $interface, $buddy_name, "Sorry, I'm too busy.");
    }
    elsif( exists $heap->{responders}->{$interface}->{$buddy_name} ) {
	print "Posted message to existing session.\n";
	$kernel->post(
		      $heap->{responders}->{$interface}->{$buddy_name},
		      "in",
		      $message
		      );
    }
    else {
	print "Creating a new session.\n";
	# When the Responder sessions in here die or are created, this
	# event is noticed by the _child session. The _child session is
	# what keeps the $heap->{responders} hash up to date
      POE::Session->create(
			   args => [ $interface, $buddy_name, $message ],
			   package_states => [
					    "Googlematic::Responder" => [
								       '_start', 'in', 'detail', 'list',
								       'remember', 'limit', 'error'
								       ]
					      ]
			   );
    }
    
}


# send($interface, $buddy_name, $message)
# - All outgoing IM messages go through this state
# - send is called by the Responders, and from other places in this session
sub send {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($interface, $buddy_name, $message) = @_[ARG0, ARG1, ARG2];
    
    # Log this outgoing message
    print "Sending <$message> to <$buddy_name> by <$interface>\n";
    
    if($interface eq 'aim' && ($heap->{aim_state} eq 'on')) {
	$heap->{aim}->toc_send_im(
				  $heap->{aim}->norm_uname($buddy_name),
				  $message,
				  0
				  );
    }
}


# _child
# - All child sessions (created in the spawner state) tell this automatic
#   POE state when they're created or when they finish
# - This state keeps the $heap->{responder} hash up to date, so spawner can
#   find a Responder responsible for a particular buddy name
sub _child {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];

    my $event = $_[ARG0];
    my $session_id = $_[ARG1]; # All POE sessions identified by one of these
    
    if($event eq 'create') {
	# The Responder returns these at the end of its _start state.
	# It returns the interface (ie, 'aim') it's listening on, and the
	# buddy name
	my $params = $_[ARG2];
	$heap->{responders}->{ $params->[0] }->{ $params->[1] } = $session_id;
	++$heap->{responders_count};
    }
    elsif($event eq 'lose') {
	# In the case a Responder disappears, only the session_id is returned.
	# Remove the Responder from the hash based on this.
	foreach my $interface ( qw/aim/ ) { # this can grow for more interfaces
	    foreach my $buddy ( keys %{$heap->{responders}->{$interface}} ) {
		if($session_id == $heap->{responders}->{$interface}->{$buddy}) {
		    delete $heap->{responders}->{$interface}->{$buddy};
		    --$heap->{responders_count};
		}
	    }
	}
    }

    # Log how many Responders we're left with
    print "The responder count is now " . $heap->{responders_count} . "\n";

}


# proxy
# - Any POE session can send post to any state within a Responder from here
# - Mainly use to post information back from the Google search session
sub proxy {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
	
    my $interface = $_[ARG0];
    my $buddy_name = $_[ARG1];
    my $state = $_[ARG2];
    my $struct = $_[ARG3];
    
    if(exists $heap->{responders}->{$interface}->{$buddy_name}) {
	$kernel->post(
		      $heap->{responders}->{$interface}->{$buddy_name},
		      $state,
		      $struct
		      );
    }
}


return 1;