package Net::MSN;
use strict;
use warnings FATAL => ('all');

# MSN.pm, 0.2, amoe, 23/02/2002

use Digest::MD5 'md5_hex';
use IO::Select;
use IO::Socket;
use URI::Escape;

# remote line terminator
my $n = "\015\012";

# msn protocol versions we support
my %protos = (4 => 1,
			  5 => 1,
			  6 => 1,
			  7 => 1,
			 );

# commands that don't send transaction ids
my %exception = (RNG => 1,
				 MSG => 1,
				 );

# default notification server/port combo
my $def_ns = '64.4.13.58:1863';

# Public methods

sub new {
	my $class = shift;
	
	# allow caller to supply an alternative server
	my $notification_server = shift || $def_ns;
	my $socket = IO::Socket::INET->new($notification_server)
		or die "couldn't connect to $notification_server: $!";
	
	return bless {tids         => [-1],			# gets incremented to 1
				  notification => $socket,
				  logged_in    => 0}, $class;
}

sub login {
	my ($self, $email, $password) = @_;
	$self->email($email);					# stow the email for later
	
	my $res = $self->_authenticate($email);
	
	if ($res->[0] eq 'XFR') {
		# switch server
		my $new_ns = IO::Socket::INET->new($res->[2])
			or die "couldn't connect to $res->[2]: $!";
		$self->notification($new_ns);
		
		# try again
		$res = $self->_authenticate($email);
	}
	
	# hash the combinination of the password
	# and the hash the server sent us
	my $combined = md5_hex($res->[3], $password);
	$res = $self->send_cmd(qw{USR MD5 S}, $combined);
	
	return 0 if $res->[1] ne 'OK';
	
	$self->logged_in(1);
	return uri_unescape($res->[3]);
}

# Building block methods

sub send_cmd {
	my $self   = shift;
	my $setup  = {};
	
	# if the last param is a hashref,
	# pop it and treat it as config
	$setup     = pop if ref $_[-1] eq 'HASH';
	
	# the rest is the raw command
	my @bits   = @_;
	
	# assume a server if not provided
	$setup->{socket} ||= $self->logged_in
		? $self->switchboard
		: $self->notification;
	$setup->{tid} ||= -1;
	
	my $server = $setup->{socket};
	
	# increment tid
	$self->tids($setup->{tid}, $self->tids($setup->{tid}) + 1);
	
	# put in the transaction id and join
	my $req = join(' ', do { splice @bits, 1, 0, $self->tids($setup->{tid}); @bits }) . $n;
	
	print "sending $req";			# for debug
	print $server $req;
	
	my $selecta = IO::Select->new($server);
	my @res;
	while ((my $conn) = $selecta->can_read(1)) {
		defined(my $line = <$conn>) or last;
		my @words = split /\s+/,
						  do { local $/ = $n; chomp $line; $line };
		
		# splice out the tid if it was sent
		splice @words, 1, 1
			if $words[0] && !$exception{$words[0]};
		push @res, @words;
	}
	
	print "received @res\n";			# for debug
	return \@res;
}

# wield() - wait for the server to send us something, then call the client

sub wield {
	my ($self, $dispatch, $timeout, @sockets) = @_;
	
	my $selecta = IO::Select->new(@sockets);
	while (1) {
		while (my @ready = $selecta->can_read($timeout)) {
			for (@ready) {
				defined(my $line = <$_>) or next;
				
				# parse
				my @words = split /\s+/,
					  do { local $/ = $n; chomp $line; $line };
				
				my $command = $words[0];
				my $coderef;
				
				# splice out the tid
				splice @words, 1, 1
					unless $exception{$command};
				
				# call the relavent callback
				$coderef->(@words)
					if defined($coderef = $dispatch->{$command});
			}
		}
	}
}

# wieldcap() - a wrapper around wield for simple wielding

sub wieldcap {
	my ($self, $command, $timeout) = @_;
	
	# call wield with an instruction to die as soon as we get sent
	# the command. bundle up what we were sent in the die message.
	
	unless (eval {
				$self->wield({$command => sub { die "WIELDCAP: @_" }}, $timeout);
				1;
			}) {
			
		# make sure it was really our message
		die unless (my $res = $@) =~ s/^WIELDCAP: //;
		
		# resurrect the message
		return split /\s+/, $res;
	}
	
	return;		# undef
}

# Accessors

# autoload accessors
sub AUTOLOAD {
	my $self = shift;
	my $name = our $AUTOLOAD;
	return if $name =~ /::DESTROY$/;
	$name =~ s/^Net::MSN:://;
	
	return @_
		? ($self->{$name} = shift)
		: $self->{$name};
}

# select-a-tid

sub tids {
	my $self = shift;
	my $index = shift;
	
	if (defined $index) {
		return @_
			? ($self->{tids}->[$index] = shift)
			: $self->{tids}->[$index];
	} else { return $self->{tids} }
}

# Private methods

# authenticate someone to some server
sub _authenticate {
	my ($self, $email) = @_;
	
	# agree on a protocol (list operator heaven?)
	my $res = $self->send_cmd('VER',
							  map({ "MSNP$_" } sort { $b <=> $a } keys %protos),
							  'CVRO');
	die "protocol incompatibility: @$res"
		if !grep { $protos{$_} } map { substr($_, 4) } do { shift @$res; @$res };
	
	# agree on an encryption scheme
	$res = $self->send_cmd(qw{INF});
	die "encryption incompatibility: $res->[1]"
		if $res->[1] ne 'MD5';
	
	# ask if this man know who we are
	$res = $self->send_cmd(qw{USR MD5 I}, $email);
	
	# return what he said
	return $res;
}

__END__
pod goes here (or should i splice it in with the code?)