package Net::OSCAR;

$VERSION = 0.50;

=head1 NAME

Net::OSCAR - Implementation of AOL's OSCAR protocol for instant messaging

=head1 SYNOPSIS

	use Net::OSCAR qw(:standard);
	use Net::OSCAR::OldPerl; # You may need to use this perls older than 5.6.

	$oscar = Net::OSCAR->new();
	$oscar->set_callback_foo(\&foo);
	$oscar->signon($screenname, $password);
	while(1) {
		$oscar->do_one_loop();
		# Do stuff
	}

=head1 INSTALLATION

	perl Makefile.PL
	make
	make test
	make install

See C<perlmodinstall> for details.

=head1 DEPENDENCIES

This modules requires C<Digest::MD5> and C<Scalar::Util>.

=head1 ABSTRACT

C<Net::OSCAR> implements the OSCAR protocol which is used by AOL's AOL Instant
Messenger service.  To use the module, you create a C<Net::OSCAR> object,
register some functions as handlers for various events by using the module's
callback mechanism, and then continually make calls to the module's event
processing methods.

You probably want to use the :standard parameter when importing this module
in order to have a few important constants added to your namespace.  See
L<"CONSTANTS"> below for a list of the constants exported by the C<:standard> tag.

No official documentation exists for the OSCAR protocol, so it had to be figured
out by analyzing traffic generated by AOL's official AOL Instant Messenger client.
That doesn't really help this module's stability much.

This module strives to be as compatible with C<Net::AIM> as possible, but some
protocol-level differences prevent total compatibility.  The TOC protocol implemented
by C<Net::AIM> is simpler and more well-documented but less-powerful protocol then
C<OSCAR>.  See the section on L<Net::AIM Compatibility> for more information.

=head1 EVENT PROCESSING

There are two main ways for the module to handle event processing.  The first is to
call the L<do_one_loop> method, which performs a C<select> call on all the object's
sockets and reads incoming commands from the OSCAR server on any connections which
have them.  The C<select> call has a default timeout of 0.01 seconds which can
be adjust using the L<timeout> method.

The other way of doing event processing is designed to make it easy to integrate
C<Net::OSCAR> into an existing C<select>-based event loop, especially one where you
have many C<Net::OSCAR> objects.  Simply call the L<"process_connections"> method
with references to the lists of readers, writers, and errors given to you by
C<select>.  Connections that don't belong to the object will be ignored, and
connections that do belong to the object will be removed from the C<select> lists
so that you can use the lists for your own purposes.  Here is an example that
demonstrates how to use this method with multiple C<Net::OSCAR> objects:

	my($rin, $win) = (0, 0);
	foreach my $oscar(@oscars) {
		my($thisrin, $thiswin) = $oscar->selector_filenos;
		$rin |= $thisrin;
		$win |= $thiswin;
	}
	# Add in any other file descriptors you care about using vec().
	my $ein = $rin | $win;
	select($rin, $win, $ein, 0.01);
	foreach my $oscar(@oscars) {
		$oscar->process_connections(\$rin, \$win, \$ein);
	}

	# Now $rin, $win, and $ein only have the file descriptors not
	# associated with any of the OSCAR objects in them - we can
	# process our events.

=head1 FUNCTIONALITY

C<Net::OSCAR> pretends to be WinAIM 4.3.2229.  It supports remote buddylists
including permit and deny settings.  It also supports chat.  At the present
time, setting and retrieving of directory information is not supported; nor
are email privacy settings, buddy icons, voice chat, stock ticker, and
many other of the official AOL Instant Messenger client's features.

=head1 TERMINOLOGY/METHODOLOGY

When you sign on with the OSCAR service, you are establishing an OSCAR session.
C<Net::OSCAR> connects to the login server and requests a random challenge
string.  It then sends the MD5 sum of the challenge string,
C<AOL Instant Messenger (SM)>, and your password to the server.  If the login
is successful, the login server gives you an IP address and an authorization
cookie to use to connect with the BOS (Basic OSCAR Services) server.

C<Net::OSCAR> proceeds to disconnect from the login server and connect to the
BOS server.  The two go through a handshaking process which includes the
server sending us our buddylist.

C<Net::OSCAR> supports privacy controls.  Our visibility setting, along
with the contents of the permit and deny lists, determines who can
contact us.  Visibility can be set to permit or deny everyone, permit only
those on the permit list, deny only those on the deny list, or permit
everyone on our buddylist.

=head1 METHODS

=over 4

=cut

use strict;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
use Carp;
use Scalar::Util;
use Net::OSCAR::Common qw(:all);
use Net::OSCAR::Connection;
use Net::OSCAR::Callbacks;
use Net::OSCAR::TLV;
use Net::OSCAR::Buddylist;
use Net::OSCAR::Screenname;
use Net::OSCAR::Chat;
use Net::OSCAR::_BLInternal;
use Net::OSCAR::OldPerl;

require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = @Net::OSCAR::Common::EXPORT_OK;
%EXPORT_TAGS = %Net::OSCAR::Common::EXPORT_TAGS;

=pod

=item new

Creates a new C<Net::OSCAR> object.

=cut

sub new($) {
	my $class = ref($_[0]) || $_[0] || "Net::OSCAR";
	shift;
	my $self = { };
	bless $self, $class;
	$self->{LOGLEVEL} = 0;
	$self->{SNDEBUG} = 0;
	$self->{description} = "OSCAR session";

	$self->{timeout} = 0.01;

	return $self;
}


=pod

=item timeout ([NEW TIMEOUT])

Gets or sets the timeout value used by the L<do_one_loop> method.
The default timeout is 0.01 seconds.

=cut

sub timeout($;$) {
	my($self, $timeout) = @_;
	return $self->{timeout} unless $timeout;
	$self->{timeout} = $timeout;
}

=pod

=item signon (SCREENNAME, PASSWORD[, HOST, PORT])

Sign on to the OSCAR service.
You can specify an alternate host/port to connect to.
The default is login.oscar.aol.com port 5190.

=cut

sub signon($$$;$$) {
	my($self, $screenname, $password, $host, $port) = @_;
	$self->{screenname} = new Net::OSCAR::Screenname $screenname;

	# We set BOS to the login connection so that our error handlers pick up errors on this connection as fatal.
	$host ||= "login.oscar.aol.com";
	$port ||= 5190;
	$self->{port} = $port;
	$self->{bos} = $self->addconn($password, CONNTYPE_LOGIN, "login", $host);
	push @{$self->{connections}}, $self->{bos};
}

=pod

=item signoff

Sign off from the OSCAR service.

=cut

sub signoff($) {
	my $self = shift;
	foreach my $connection(@{$self->{connections}}) {
		$self->delconn($connection);
	}
	my $screenname = $self->{screenname};
	%$self = ();
	$self->{screename} = $screenname; # Useful for post-mortem processing in multiconnection apps
}

=pod

=item loglevel ([LOGLEVEL[, SCREENNAME DEBUG]])

Gets or sets the loglevel.  If this is non-zero, varing amounts of information will be printed
to standard error (unless you have a L<"log"> callback defined).  Higher loglevels will give you more information.
If the optional screenname debug parameter is non-zero,
debug messages will be prepended with the screenname of the OSCAR session which is generating
the message (but only if you don't have a L<"log"> callback defined).  This is useful when you have multiple C<Net::OSCAR> objects.

See the L<"log"> callback for more information.

=cut

sub loglevel($;$$) {
	my $self = shift;
	return $self->{LOGLEVEL} unless @_;
	$self->{LOGLEVEL} = shift;
	$self->{SNDEBUG} = shift if @_;
}

sub addconn($$$$$) {
	my $self = shift;
	my $conntype = $_[1];

	my $connection = ($conntype == CONNTYPE_CHAT) ? Net::OSCAR::Chat->new($self, @_) : Net::OSCAR::Connection->new($self, @_);
	if($_[1] == CONNTYPE_BOS) {
		$self->{bos} = $connection;
	} elsif($_[1] == CONNTYPE_ADMIN) {
		$self->{admin} = 1; # We're not quite ready yet - add to queue but don't send svcreq
	} elsif($_[1] == CONNTYPE_CHATNAV) {
		$self->{chatnav} = 1;
	}
	push @{$self->{connections}}, $connection;
	#print STDERR "After adding connection: ", Data::Dumper::Dumper($self->{connections}), "\n";
	$self->callback_connection_changed($connection, "write");
	return $connection;
}

sub delconn($$) {
	my($self, $connection) = @_;

	return unless $self->{connections};
	for(my $i = scalar @{$self->{connections}} - 1; $i >= 0; $i--) {
		next unless !$connection->{socket} or (fileno $connection->{socket} == fileno $self->{connections}->[$i]->{socket});
		next unless $connection->{conntype} == $self->{connections}->[$i]->{conntype}; # Just in case fileno is undef.
		$connection->log_print(OSCAR_DBG_NOTICE, "Closing.");
		splice @{$self->{connections}}, $i, 1;
		if(!$connection->{sockerr}) {
			eval {
				$connection->flap_put("", FLAP_CHAN_CLOSE) if $connection->{socket};
				close $connection->{socket} if $connection->{socket};
			};
		} else {
			if($connection->{conntype} == CONNTYPE_BOS) {
				$self->callback_connection_changed($connection, "deleted");
				delete $connection->{socket};
				return $self->crapout($connection, "Lost connection to BOS");
			} elsif($connection->{conntype} == CONNTYPE_CHATNAV) {
				delete $self->{chatnav};
			} elsif($connection->{conntype} == CONNTYPE_ADMIN) {
				delete $self->{admin};
				$self->callback_admin_error("all", ADMIN_ERROR_CONNREF, undef) if scalar(keys(%{$self->{adminreq}}));
			} elsif($connection->{conntype} == CONNTYPE_CHAT) {
				$self->callback_chat_closed($connection, "Lost connection to chat");
			}
		}
		$self->callback_connection_changed($connection, "deleted");
		delete $connection->{socket};
		return 1;
	}
	return 0;
}

=pod

=item findconn FILENO

Finds the connection that is using the specified file number, or undef
if the connection could not be found.  Returns a C<Net::OSCAR::Connection>
object.

=cut

sub findconn($$) {
	my($self, $target) = @_;
	my($conn) = grep { fileno($_->{socket}) == $target } @{$self->{connections}};
	return $conn;
}

sub DESTROY {
	my $self = shift;

	foreach my $connection(@{$self->{connections}}) {
		next unless $connection->{socket} and not $connection->{sockerr};
		$connection->flap_put("", FLAP_CHAN_CLOSE);
		close $connection->{socket} if $connection->{socket};
	}
}

=pod

=item process_connections (READERSREF, WRITERSREF, ERRORSREF)

Use this method when you want to implement your own C<select>
statement for event processing instead of using C<Net::OSCAR>'s
L<do_one_loop> method.  The parameters are references to the
readers, writers, and errors parameters used by the select
statement.  The method will ignore all connections which
are not C<Net::OSCAR::Connection> objects or which are
C<Net::OSCAR::Connection> objects from a different C<Net::OSCAR>
object.  It modifies its arguments so that its connections
are removed from the connection lists.  This makes it very
convenient for use with multiple C<Net::OSCAR> objects or
use with a C<select>-based event loop that you are also
using for other purposes.

See the L<selector_filenos> method for a way to get the necessary
bit vectors to use in your C<select>.

=cut

sub process_connections($\$\$\$) {
	my($self, $readers, $writers, $errors) = @_;

	# Filter out our connections and remove them from the to-do list
	foreach my $connection(@{$self->{connections}}) {
		next unless $connection->fileno;
		if($connection->{connected}) {
			next unless vec($$readers | $$errors, $connection->fileno, 1);
			vec($$readers, $connection->fileno, 1) = 0;
		} else {
			next unless vec($$writers | $$errors, $connection->fileno, 1);
			vec($$writers, $connection->fileno, 1) = 0;
		}
		if(vec($$errors, $connection->fileno, 1)) {
			vec($$errors, $connection->fileno, 1) = 0;
			$connection->{sockerr} = 1;
			$connection->disconnect();
		} else {
			$connection->process_one();
		}
	}
}

=pod

=item do_one_loop

Processes incoming data from our connections to the various
OSCAR services.  This method reads one command from any
connections which have data to be read.  See the
L<timeout> method to set the timeout interval used
by this method.

=cut

sub do_one_loop($) {
	my $self = shift;
	my $timeout = $self->{timeout};

	undef $timeout if $timeout == -1;

	my($rin, $win, $ein) = ('', '', '');

	foreach my $connection(@{$self->{connections}}) {
		next unless exists($connection->{socket});
		if($connection->{connected}) {
			vec($rin, fileno $connection->{socket}, 1) = 1;
		} else {
			vec($win, fileno $connection->{socket}, 1) = 1;
		}
	}
	$ein = $rin | $win;

	my $nfound = select($rin, $win, $ein, $timeout);
	$self->process_connections(\$rin, \$win, \$ein) if $nfound;
}

sub findgroup($$) {
	my($self, $groupid) = @_;
	my($group, $currgroup, $currid);

	my $thegroup = undef;

	$self->log_printf(OSCAR_DBG_DEBUG, "findgroup 0x%04X", $groupid);
	while(($group, $currgroup) = each(%{$self->{buddies}})) {
		$self->log_printf(OSCAR_DBG_DEBUG, "\t$group == 0x%04X", $currgroup->{groupid});
		next unless exists($currgroup->{groupid}) and $groupid == $currgroup->{groupid};
		$thegroup = $group;
		last;
	}
	my $a = keys %{$self->{buddies}}; # reset the iterator
	return $thegroup;
}

=pod

=item findbuddy (BUDDY)

Returns the name of the group that BUDDY is in, or undef if
BUDDY could not be found in any group.  If BUDDY is in multiple
groups, will return the first one we find.

=cut


sub findbuddy($$) {
	my($self, $buddy) = @_;

	#$self->log_print(OSCAR_DBG_DEBUG, "findbuddy $buddy");
	foreach my $group(keys %{$self->{buddies}}) {
		#$self->debug_print("\t$buddy? ", join(",", keys %{$self->{buddies}->{$group}->{members}}));
		return $group if $self->{buddies}->{$group}->{members}->{$buddy};
	}
	return undef;
}

sub findbuddy_byid($$$) {
	my($self, $buddies, $bid) = @_;

	while(my($buddy, $value) = each(%$buddies)) {
		return $buddy if $value->{buddyid} == $bid;
	}
	return undef;
}

sub newid($;$) {
	my($self, $group) = @_;
	my $id = 0;

	if($group) {
		do { ++$id; } while(grep { $_->{buddyid} == $id } values %$group);
	} else {
		do { $id = ++$self->{nextid}->{__GROUPID__}; } while($self->findgroup($id));
	}
	return $id;
}

=pod

=item commit_buddylist

Sends your modified buddylist to the OSCAR server.  Changes to the buddylist
won't actually take effect until this method is called.  Methods that change
the buddylist have a warning about needing to call this method in their
documentation.

=item rollback_buddylist

Revert changes you've made to the buddylist, assuming you haven't called
L<"commit_buddylist"> since making them.

=item reorder_groups GROUPS

Changes the ordering of the groups in your buddylist.  Call L<"commit_buddylist"> to
save the
new order on the OSCAR server.

=item reorder_buddies GROUP BUDDIES

Changes the ordering of the buddies in a group on your buddylist.
Call L<"commit_buddylist"> to save the new order on the OSCAR server.

=item add_permit (BUDDIES)

Add buddies to your permit list.  Call L<"commit_buddylist"> for the
change to take effect.

=item add_deny (BUDDIES)

See L<add_permit>.

=item remove_permit (BUDDIES)

See L<add_permit>.

=item remove_deny (BUDDIES)

See L<add_permit>.

=item get_permitlist

Returns a list of all members of the permit list.

=item get_denylist

Returns a list of all members of the deny list.

=cut

sub commit_buddylist($) {
	my($self) = shift;
	return must_be_on($self) unless $self->{is_on};
	Net::OSCAR::_BLInternal::NO_to_BLI($self);
}

sub reorder_groups($@) {
	my $self = shift;
	return must_be_on($self) unless $self->{is_on};
	my @groups = @_;
	tied(%{$self->{buddies}})->setorder(@groups);
}

sub reorder_buddies($$@) {
	my $self = shift;
	return must_be_on($self) unless $self->{is_on};
	my $group = shift;
	my @buddies = @_;
	tied(%{$self->{buddies}->{$group}->{members}})->setorder(@buddies);
}

sub add_permit($@) { shift->mod_permit(MODBL_ACTION_ADD, "permit", @_); }
sub add_deny($@) { shift->mod_permit(MODBL_ACTION_ADD, "deny", @_); }
sub remove_permit($@) { shift->mod_permit(MODBL_ACTION_DEL, "permit", @_); }
sub remove_deny($@) { shift->mod_permit(MODBL_ACTION_DEL, "deny", @_); }
sub get_permitlist($) { return keys %{shift->{permit}}; }
sub get_denylist(@) { return keys %{shift->{deny}}; }

=pod

=item rename_group (OLDNAME, NEWNAME)

Renames a group.  Call L<"commit_buddylist"> for the change to take effect.

=item add_buddy (GROUP, BUDDIES)

Adds buddies to the given group on your buddylist.  Call L<"commit_buddylist">
for the change to take effect.

=item remove_buddy (GROUP, BUDDIES)

See L<add_buddy>.

=cut

sub rename_group($$$) {
	my($self, $oldgroup, $newgroup) = @_;
	return must_be_on($self) unless $self->{is_on};
	return send_error($self, $self->{bos}, 0, "That group does not exist", 0) unless exists $self->{buddies}->{$oldgroup};
	$self->{buddies}->{$newgroup} = $self->{buddies}->{$oldgroup};
	delete $self->{buddies}->{$oldgroup};
}

sub add_buddy($$@) {
	my($self, $group, @buddies) = @_;
	$self->mod_buddylist(MODBL_ACTION_ADD, MODBL_WHAT_BUDDY, $group, @buddies);
}

sub remove_buddy($$@) {
	my($self, $group, @buddies) = @_;
	$self->mod_buddylist(MODBL_ACTION_DEL, MODBL_WHAT_BUDDY, $group, @buddies);
}

=pod

=item set_visibility (MODE)

Sets the visibility mode, which determines how the permit and deny lists
are interpreted.  The visibility mode may be:

=over 4

=item *

VISMODE_PERMITALL: Permit everybody.

=item *

VISMODE_DENYALL: Deny everybody.

=item *

VISMODE_PERMITSOME: Permit only those on your permit list.

=item *

VISMODE_DENYSOME: Deny only those on your deny list.

=item *

VISMODE_PERMITBUDS: Same as VISMODE_PERMITSOME, but your permit list is made to be
the same as the buddies from all the various groups in your
buddylist (except the deny group!)  Adding and removing buddies
maintains this relationship.  You shouldn't manually alter the
permit or deny groups when using this visibility mode.

=back

These constants are contained in the C<Net::OSCAR::Common> package,
and will be imported into your namespace if you import C<Net::OSCAR>
with the C<:standard> parameter.

When someone is permitted, they can see when you are online and
send you messages.  When someone is denied, they can't see when
you are online or send you messages.  You cannot see them or
send them messages.  You can talk to them if you are in the same
chatroom, although neither of you can invite the other one into
a chatroom.

Call L<"commit_buddylist"> for the change to take effect.

=cut

sub set_visibility($$) {
	my($self, $vismode) = @_;

	return must_be_on($self) unless $self->{is_on};
	$self->{visibility} = $vismode;
}

=pod

=item set_group_permissions NEWPERMS

Set group permissions.  This lets you block any OSCAR users or any AOL users.
C<NEWPERMS> should be a list of zero or more of the following constants:

=over 4

=item GROUPPERM_OSCAR

Permit AOL Instant Messenger users to contact you.

=item GROUPPERM_AOL

Permit AOL subscribers to contact you.

=back

Call L<"commit_buddylist"> for the change to take effect.

=cut

sub set_group_permissions($@) {
	my($self, @perms) = @_;
	my $perms = 0xFFFFFF00;

	return must_be_on($self) unless $self->{is_on};
	foreach my $perm (@perms) { $perms |= $perm; }
	$self->{groupperms} = $perms;
}

=pod

=item group_permissions

Returns current group permissions.  The return value is a list like the one
that L<"set_group_permissions"> wants.

=cut

sub group_permissions($) {
	my $self = shift;
	my @retval = ();

	foreach my $perm (GROUPPERM_OSCAR, GROUPPERM_AOL) {
		push @retval, $perm if $self->{groupperms} & $perm;
	}
	return @retval;
}

=pod

=item profile

Returns your current profile.

=cut

sub profile($) { return shift->{profile}; }

=pod

=item get_app_data [GROUP[, BUDDY]]

Gets application-specific data.  Returns a hashref whose keys are app-data IDs.
IDs with high-order byte 0x0001 are reserved for non-application-specific usage
and must be registered with the C<libfaim-aim-protocol@lists.sourceforge.net> list.
If you wish to set application-specific data, you should reserve a high-order
byte for your application by emailing C<libfaim-aim-protocol@lists.sourceforge.net>.
This data is stored in your server-side buddylist and so will be persistent,
even across machines.

If C<GROUP> is present, a hashref for accessing data specific to that group
is returned.

If C<BUDDY> is present, a hashref for accessing data specific to that buddy
is returned.

Call L<"commit_buddylist"> to have the new data saved on the OSCAR server.

=cut

sub get_app_data($;$$) {
	my($self, $group, $buddy) = @_;

	return $self->{appdata} unless $group;
	return $self->{buddies}->{$group}->{data} unless $buddy;
	return $self->{buddies}->{$group}->{members}->{$buddy}->{data};
}

sub mod_permit($$$@) {
	my($self, $action, $group, @buddies) = @_;

	return must_be_on($self) unless $self->{is_on};
	if($action == MODBL_ACTION_ADD) {
		foreach my $buddy(@buddies) {
			next if exists($self->{$group}->{$buddy});
			$self->{$group}->{$buddy}->{buddyid} = $self->newid($self->{group});
		}
	} else {
		foreach my $buddy(@buddies) {
			delete $self->{$group}->{$buddy};
		}
	}
}

sub mod_buddylist($$$$;@) {
	my($self, $action, $what, $group, @buddies) = @_;
	return must_be_on($self) unless $self->{is_on};

	@buddies = ($group) if $what == MODBL_WHAT_GROUP;

	if($what == MODBL_WHAT_GROUP and $action == MODBL_ACTION_ADD) {
		return if exists $self->{buddies}->{$group};
		$self->{buddies}->{$group} = {
			groupid => $self->newid(),
			members => bltie,
			data => tlvtie
		};
	} elsif($what == MODBL_WHAT_GROUP and $action == MODBL_ACTION_DEL) {
		return unless exists $self->{buddies}->{$group};
		delete $self->{buddies}->{$group};
	} elsif($what == MODBL_WHAT_BUDDY and $action == MODBL_ACTION_ADD) {
		$self->mod_buddylist(MODBL_ACTION_ADD, MODBL_WHAT_GROUP, $group) unless exists $self->{buddies}->{$group};
		@buddies = grep {not exists $self->{buddies}->{$group}->{members}->{$_}} @buddies;
		return unless @buddies;
		foreach my $buddy(@buddies) {
			$self->{buddies}->{$group}->{members}->{$buddy} = {
				buddyid => $self->newid($self->{buddies}->{$group}->{members}),
				data => tlvtie,
				online => 0,
				comment => undef
			};
		}
	} elsif($what == MODBL_WHAT_BUDDY and $action == MODBL_ACTION_DEL) {
		return unless exists $self->{buddies}->{$group};
		@buddies = grep {exists $self->{buddies}->{$group}->{members}->{$_}} @buddies;
		return unless @buddies;
		foreach my $buddy(@buddies) {
			delete $self->{buddies}->{$group}->{members}->{$buddy};
		}
		$self->mod_buddylist(MODBL_ACTION_DEL, MODBL_WHAT_GROUP, $group) unless scalar keys %{$self->{buddies}->{$group}->{members}};
	}
}

sub extract_userinfo($$) {
	my($self, $data) = @_;
	my $retval = {};
	my $tlvcnt;

	($retval->{screenname}, $retval->{evil}, $tlvcnt) = unpack("C/a* n n", $data);
	$retval->{screenname} = new Net::OSCAR::Screenname $retval->{screenname};
	$retval->{evil} /= 10;
	substr($data, 0, 5+length($retval->{screenname})) = "";
	$self->log_print(OSCAR_DBG_DEBUG, "Decoding userinfo TLV with tlvcnt $tlvcnt.");

	my($tlv, $chainlen) = tlv_decode($data, $tlvcnt);
	#$chainlen--;

	$self->log_print(OSCAR_DBG_DEBUG, "Done decoding userinfo TLV - chainlen $chainlen.");
	my($flags) = unpack("n", $tlv->{1});
	$retval->{trial} = $flags & 0x1;
	$retval->{admin} = $flags & 0x2;
	$retval->{aol} = $flags & 0x4;
	$retval->{pay} = $flags & 0x8;
	$retval->{free} = $flags & 0x10;
	$retval->{away} = $flags & 0x20;

	($retval->{membersince}) = unpack("N", $tlv->{2}) if exists($tlv->{2});
	($retval->{onsince}) = unpack("N", $tlv->{3}) if exists($tlv->{3});
	($retval->{idle}) = unpack("n", $tlv->{4}) if exists($tlv->{4});
	($retval->{capabilities}) = $tlv->{0xD} if exists($tlv->{0xD});

	substr($data, 0, $chainlen) = "";

	if($data) {
		$tlv = tlv_decode($data);
		$retval->{profile} = $tlv->{0x2} if $tlv->{0x2};
		$retval->{awaymsg} = $tlv->{0x4} if $tlv->{0x4};
		$retval->{chatdata} = $tlv->{0x5} if $tlv->{0x5};
	}

	$chainlen += 5+length($retval->{screenname});
	return wantarray ? ($retval, $chainlen) : $retval;
}

=pod

=item get_info (WHO)

Requests a user's information, which includes their profile and idle time.
See the L<buddy_info> callback for more information.

=item get_away (WHO)

Similar to L<get_info>, except requests the user's away message instead of
their profile.

=cut

sub get_info($$) {
	my($self, $screenname) = @_;
	return must_be_on($self) unless $self->{is_on};

	$self->{bos}->snac_put(reqdata => $screenname, family => 0x2, subtype => 0x5, data => pack("nCa*", 1, length($screenname), $screenname));
}

sub get_away($$) {
	my($self, $screenname) = @_;
	return must_be_on($self) unless $self->{is_on};

	$self->{bos}->snac_put(reqdata => $screenname, family => 0x2, subtype => 0x5, data => pack("nCa*", 3, length($screenname), $screenname));
}

=pod

=item send_im(WHO, MESSAGE[, AWAY])

Sends someone an instant message.  If the message is an automated reply generated,
perhaps, because you have an away message set, give the AWAY parameter a non-zero
value.  Note that C<Net::OSCAR> will not handle sending away messages to people who
contact you when you are away - you must perform this yourself if you want it done.

=cut

sub send_im($$$;$) {
	my($self, $to, $msg, $away) = @_;
	return must_be_on($self) unless $self->{is_on};
	my $packet = "";
	my $reqid = 0;

	return 0 if length($msg) >= 7987;

	$packet = randchars(8);
	$packet .= pack("n", 1); # channel
	$packet .= pack("Ca*", length($to), $to);

	$packet .= tlv(2 => pack("n3 C n C n3 a*", 0x501, 4, 0x101, 1, 0x201, 1, length($msg)+4, 0, 0, $msg));

	if($away) {
		$packet .= tlv(4 => "");
	} else {
		$packet .= tlv(3 => ""); #request server confirmation
	}

	$self->{bos}->snac_put(reqdata => $to, family => 0x4, subtype => 0x6, data => $packet);
	return 1;
}

=pod

=item buddyhash

Returns a reference to a tied hash which automatically normalizes its keys upon a fetch.
Use this for hashes whose keys are AIM screennames since AIM screennames with different
capitalization and spacing are considered equivalent.

The keys of the hash as returned by the C<keys> and C<each> functions will be
C<Net::OSCAR::Screenname> objects, so you they will automagically be compared
without regards to case and whitespace.

=cut

sub buddyhash($) { bltie; }

sub im_parse($$) {
	my($self, $data) = @_;
	my($from, $msg, $away) = ("", "", 0);
	my $chat = undef;
	my $chaturl = undef;

	my $cookie = substr($data, 0, 8, ""); #OSCAR is so nice, it feeds us BLTs and cookies as SNACs.
	my($channel) = unpack("n", substr($data, 0, 2, ""));
	if($channel != 1 and $channel != 2) {
		carp "Got ICBM on unsupported channel $channel - ignoring.";
		return;
	} else {
		$self->log_print(OSCAR_DBG_DEBUG, "Incoming ICBM on channel $channel.");
	}

	$self->log_print(OSCAR_DBG_DEBUG, "Extracting user info.");
	my ($senderinfo, $tlvlen) = $self->extract_userinfo($data);
	$from = $senderinfo->{screenname};

	# Copying gAIM/libfaim is *so* much easier than understanding stuff.
	if($channel == 1) {
		substr($data, 0, $tlvlen) = "";
		$self->log_print(OSCAR_DBG_DEBUG, "Decoding ICBM secondary TLV.");

		my $tlv = tlv_decode($data);
		$msg = $tlv->{2};

		substr($msg, 0, 2) = "";
		my($y) = unpack("n", substr($msg, 0, 2, ""));
		substr($msg, 0, $y+2) = "";

		my($msglen, $flags1, $flags2) = unpack("nnn", substr($msg, 0, 6, ""));
		$msglen -= 4;

		$away = 1 if exists $tlv->{4};
		if($tlv->{3}) { # server ack requested
			#$self->log_print(OSCAR_DBG_DEBUG, "Sending message ack.");
			#$self->{bos}->snac_put(family => 0x4, subtype => 0xC, data =>
			#	$cookie . pack("nCa*", 1, length($from), $from)
			#);
		}
	} else {
		$data = $senderinfo->{chatdata};
		$away = 0;

		substr($data, 0, 26) = "";
		my $tlv = tlv_decode($data);
		$msg = $tlv->{0xC};
		if($tlv->{0x2711}) {
			($chaturl) = unpack("xx C/a*", $tlv->{0x2711});

			$chaturl =~ /-.*?-(.*)/;
			$chat = $1;
			$chat =~ s/%([0-9A-Z]{1,2})/chr(hex($1))/eig;
		}

		$self->{chatinvites}->{$chaturl} = {
			cookie => $cookie,
			sender => $from
		};
	}

	return ($from, $msg, $away, $chat, $chaturl);
}

=pod

=item evil (WHO[, ANONYMOUSLY])

C<Evils>, or C<warns>, a user.  Evilling a user increases their evil level,
which makes them look bad and decreases the rate at which they can send
messages.  Evil level gradually decreases over time.  If the second
parameter is non-zero, the evil will be done anonymously, which does
not increase the user's evil level by as much as a standard evil.

You can't always evil someone.  You can only do it when they do something
like send you an instant message.

=cut

sub evil($$;$) {
	my($self, $who, $anon) = @_;
	return must_be_on($self) unless $self->{is_on};

	$self->{bos}->snac_put(reqdata => $who, family => 0x04, subtype => 0x08, data =>
		pack("n C a*", ($anon ? 1 : 0), length($who), $who)
	);
}

sub capabilities($) {
	my $self = shift;
	my $caps;

	#AIM_CAPS_CHAT
	$caps .= pack("C*", map{hex($_)} split(/[ \t\n]+/,
		"74 8F 24 20  62 87 11 D1   82 22 44 45  53 54 00 00"));	

	return $caps;
}

=pod

=item set_away (MESSAGE)

Set's the users away message, also marking them as being away.
If the message is undef or the empty string, the user will be
marked as no longer being away.

=cut

sub set_away($$) {
	my($self, $awaymsg) = @_;
	return must_be_on($self) unless $self->{is_on};
	shift->set_info(undef, $awaymsg);
}

=pod

=item set_info (PROFILE)

Sets the user's profile.  Call L<"commit_buddylist"> to have
the new profile stored on the OSCAR server.

=cut

sub set_info($$;$) {
	my($self, $profile, $awaymsg) = @_;

	my %tlv;
	tie %tlv, "Net::OSCAR::TLV";

	if(defined($profile)) {
		$tlv{0x1} = ENCODING;
		$tlv{0x2} = $profile;
		$self->{profile} = $profile;
	}

	if(defined($awaymsg)) {
		$tlv{0x3} = ENCODING;
		$tlv{0x4} = $awaymsg;
	}

	$tlv{0x5} = $self->capabilities();

	$self->log_print(OSCAR_DBG_NOTICE, "Setting user information.");
	$self->{bos}->snac_put(family => 0x02, subtype => 0x04, data => tlv_encode(\%tlv));
}

sub svcdo($$%) {
	my($self, $service, %snac) = @_;
	my $svcname = "";
	if($service == CONNTYPE_ADMIN) {
		$svcname = "admin";
	} elsif($service == CONNTYPE_CHATNAV) {
		$svcname = "chatnav";
	}

	if($self->{$svcname} and ref($self->{$svcname})) {
		$self->{$svcname}->snac_put(%snac);
	} else {
		push @{$self->{"${svcname}_queue"}}, \%snac;
		$self->svcreq($service) unless $self->{$svcname};
	}
}

sub svcreq($$) {
        my($self, $svctype) = @_;

        $self->log_print(OSCAR_DBG_INFO, "Sending service request for servicetype $svctype.");
        $self->{bos}->snac_put(family => 0x1, subtype => 0x4, data => pack("n", $svctype));
}

=pod

=item change_password (CURRENT PASSWORD, NEW PASSWORD)

Changes the user's password.

=cut

sub change_password($$$) {
	my($self, $currpass, $newpass) = @_;
	return must_be_on($self) unless $self->{is_on};

	if($self->{adminreq}->{ADMIN_TYPE_PASSWORD_CHANGE}++) {
		$self->callback_admin_error(ADMIN_TYPE_PASSWORD_CHANGE, ADMIN_ERROR_REQPENDING);
		return;
	}

	my %tlv;
	tie %tlv, "Net::OSCAR::TLV";

	%tlv = (
		0x02 => $newpass,
		0x12 => $currpass
	);

	$self->svcdo(CONNTYPE_ADMIN, family => 0x07, subtype => 0x04, data => tlv_encode(\%tlv));
}

=pod

=item confirm_account

Confirms the user's account.  This can be used when the user's account is in the trial state,
as determined by the presence of the C<trial> key in the information given when the user's
information is requested.

=cut

sub confirm_account($) {
	my($self) = shift;
	return must_be_on($self) unless $self->{is_on};

	if($self->{adminreq}->{ADMIN_TYPE_ACCOUNT_CONFIRM}++) {
		$self->callback_admin_error(ADMIN_TYPE_ACCOUNT_CONFIRM, ADMIN_ERROR_REQPENDING);
		return;
	}
	$self->svcdo(CONNTYPE_ADMIN, family => 0x07, subtype => 0x06);
}

=pod

=item change_email (NEW EMAIL)

Requests that the email address registered to the user's account be changed.
This causes the OSCAR server to send an email to both the new address and the
old address.  To complete the change, the user must follow instructions contained
in the email sent to the new address.  The email sent to the old address contains
instructions which allow the user to cancel the change within three days of the
change request.  It is important that the user's current email address be
known to the OSCAR server so that it may email the account password if the
user forgets it.

=cut

sub change_email($$) {
	my($self, $newmail) = @_;
	return must_be_on($self) unless $self->{is_on};

	if($self->{adminreq}->{ADMIN_TYPE_EMAIL_CHANGE}++) {
		$self->callback_admin_error(ADMIN_TYPE_EMAIL_CHANGE, ADMIN_ERROR_REQPENDING);
		return;
	}
	$self->svcdo(CONNTYPE_ADMIN, family => 0x07, subtype => 0x04, data => tlv(0x11 => $newmail));
}

=pod

=item format_screenname (NEW FORMAT)

Allows the capitalization and spacing of the user's screenname to be changed.
The new format must be the same as the user's current screenname, except that
case may be changed and spaces may be inserted or deleted.

=cut

sub format_screenname($$) {
	my($self, $newname) = @_;
	return must_be_on($self) unless $self->{is_on};

	if($self->{adminreq}->{ADMIN_TYPE_SCREENNAME_FORMAT}++) {
		$self->callback_admin_error(ADMIN_TYPE_SCREENNAME_FORMAT, ADMIN_ERROR_REQPENDING);
		return;
	}
	$self->svcdo(CONNTYPE_ADMIN, family => 0x07, subtype => 0x04, data => tlv(1 => $newname));
}

=pod

=item chat_join(NAME[, EXCHANGE])

Creates (or joins?) a chatroom.  The exchange parameter should probably not be
specified unless you know what you're doing.  Do not use this method
to accept invitations to join a chatroom - use the L<"chat_accept"> method
for that.

=cut

sub chat_join($$; $) {
	my($self, $name, $exchange) = @_;
	return must_be_on($self) unless $self->{is_on};
	$exchange ||= 4;

	$self->log_print(OSCAR_DBG_INFO, "Creating chatroom $name ($exchange).");
	my $reqid = (8<<16) | (unpack("n", randchars(2)))[0];
	$self->{chats}->{pack("N", $reqid)} = $name;
	$self->svcdo(CONNTYPE_CHATNAV, family => 0x0D, subtype => 0x08, reqid => $reqid, data =>
		#pack("n Ca*n3C na*", $exchange,
		#	length("create"), "create", 0xFFFF, 0x100, 0x100, 0xD3,
		#	length($name), $name
		#)

		pack("n Ca*n2C a*", $exchange,
			length("create"), "create", 0xFFFF, 0x100, 0x03,
			tlv(
				0xD7 => "en",
				0xD6 => "us-ascii",
				0xD3 => $name
			)
		)
	);
}

=pod

=item chat_accept (CHAT)

Use this to accept an invitation to join a chatroom.

=item chat_decline (CHAT)

Use this to decline an invitation to join a chatroom.

=cut

sub chat_accept($$) {
	my($self, $chat) = @_;
	return must_be_on($self) unless $self->{is_on};

	delete $self->{chatinvites}->{$chat};
	$self->log_print(OSCAR_DBG_NOTICE, "Accepting chat invite for $chat.");
	$self->svcdo(CONNTYPE_CHATNAV, family => 0x0D, subtype => 0x04, data =>
		pack("nca* Cn", 4, length($chat), $chat, 0, 2)
	);
}

sub chat_decline($$) {
	my($self, $chat) = @_;
	return must_be_on($self) unless $self->{is_on};

	my($invite) = delete $self->{chatinvites}->{$chat} or do {
		$self->log_print(OSCAR_DBG_WARN, "Chat invite for $chat doesn't exist, so we can't decline it.");
		return;
	};
	$self->log_print(OSCAR_DBG_NOTICE, "Declining chat invite for $chat.");
	$self->{bos}->snac_put(family => 0x04, subtype => 0x0B, data =>
		$invite->{cookie} .
		pack("n", 2) .
		pack("Ca*", length($invite->{sender}), $invite->{sender}) .
		pack("nnn", 3, 2, 1)
	);
}

sub crapout($$$) {
	my($self, $connection, $reason) = @_;
	send_error($self, $connection, 0, $reason, 1);
	$self->signoff();
}

sub must_be_on($) {
	my $self = shift;
	send_error($self, $self->{bos}, 0, "You have not finished signing on.", 0);
}

=pod

=item set_idle (TIME)

Sets the user's idle time in seconds.  Set to zero to mark the user as
not being idle.  Set to non-zero once the user becomes idle.  The OSCAR
server will automatically increment the user's idle time once you mark
the user as being idle.

=cut

sub set_idle($$) {
	my($self, $time) = @_;
	return must_be_on($self) unless $self->{is_on};
	$self->{bos}->snac_put(family => 0x1, subtype => 0x11, data => pack("N", $time));
}

=pod

=item clone

Clones the object.  This creates a new C<Net::OSCAR> object whose callbacks,
loglevel, screenname debugging, and timeout are the same as those of the
current object.  This is provided as a convenience when using multiple
C<Net::OSCAR> objects in order to allow you to set those parameters once
and then call the L<signon> method on the object returned by clone.

=cut

sub clone($) {
	my $self = shift;
	my $clone = $self->new(); 	# Born in a science lab late one night
					# Without a mother or a father
					# Just a test tube and womb with a view...

	# Okay, now we don't want to just copy the reference.
	# If we did that, changing ourself would change the clone.
	$clone->{callbacks} = { %{$self->{callbacks}} };

	$clone->{LOGLEVEL} = $self->{LOGLEVEL};
	$clone->{SNDEBUG} = $self->{SNDEBUG};
	$clone->{timeout} = $self->{timeout};

	return $clone;
}

=pod

=item selector_filenos

Returns a list whose first element is a vec of all filehandles that we care
about reading from and whose second element is a vec of all filehandles that
we care about writing to.  See the L<"process_connections"> method for details.

=cut

sub selector_filenos($) {
	my($rin, $win) = ('', '');

	foreach my $connection(@{shift->{connections}}) {
		next unless $connection->{socket};
		if($connection->{connected}) {
			vec($rin, fileno $connection->{socket}, 1) = 1;
		} else {
			vec($win, fileno $connection->{socket}, 1) = 1;
		}
	}
	return ($rin, $win);
}

=pod

=item visibility

Returns the user's current visibility setting.  See L<set_visibility>.

=item groups

Returns a list of groups in the user's buddylist.

=item buddies (GROUP)

Returns the names of the buddies in the specified group in the user's buddylist.
The names may not be formatted - that is, they may have spaces and capitalization
removed.  The names are C<Net::OSCAR::Screenname> objects, so you don't have to
worry that they're case and whitespace insensitive when using them for comparison.

=item buddy (BUDDY[, GROUP])

Returns information about a buddy on the user's buddylist.  This information is
a hashref which may have the following keys:

=over 4

=item online

The user is signed on.  If this key is not present, all of the other keys may not
be present.

=item screenname

The formatted version of the user's screenname.  This includes all spacing and
capitalization.  This is a C<Net::OSCAR::Screenname> object, so you don't have to
worry about the fact that it's case and whitespace insensitive when comparing it.

=item comment

A user-defined comment associated with the buddy.  See L<"set_buddy_comment">.
Note that this key will be present but undefined if there is no comment.

=item trial

The user's account has trial status.

=item aol

The user is accessing the AOL Instant Messenger service from America OnLine.

=item free

Opposite of aol.

=item away

The user is away.

=item admin

The user is an administrator.

=item membersince

Time that the user's account was created, in the same format as the C<time> function.

=item onsince

Time that the user signed on to the service, in the same format as the C<time> function.

=item idle

Time that the user has been idle for, in seconds.  If this key is present but zero,
the user is not idle.  If this key is not present, the user is not reporting idle time.

=back

=item email

Returns the email address currently assigned to the user's account.

=item screenname

Returns the user's current screenname, including all capitalization and spacing.

=cut

sub visibility($) { return shift->{visibility}; }
sub groups($) { return keys %{shift->{buddies}}; }
sub buddies($;$) {
	my($self, $group) = @_;

	return keys %{$self->{buddies}->{$group}->{members}} if $group;
	return map { keys %{$_->{members}} } values %{$self->{buddies}};
}
sub buddy($$;$) {
	my($self, $buddy, $group) = @_;
	$group ||= $self->findbuddy($buddy);
	return undef unless $group;
	return $self->{buddies}->{$group}->{members}->{$buddy};
}
sub email($) { return shift->{email}; }
sub screenname($) { return shift->{screenname}; }

=pod

=item set_buddy_comment(GROUP, BUDDY[, COMMENT])

Set a brief comment about a buddy.  This can be used for things such
as the buddy's real name.  You must call L<"commit_buddylist"> to save
the comment to the server.  If COMMENT is undefined, the comment is
deleted.

=cut

sub set_buddy_comment($$$;$) {
	my($self, $group, $buddy, $comment) = @_;
	return must_be_on($self) unless $self->{is_on};
	$self->{buddies}->{$group}->{members}->{$buddy}->{comment} = $comment;
}

=pod

=item chat_invite(CHAT, MESSAGE, WHO)

Deprecated.  Provided for compatibility with C<Net::AIM>.
Use the appropriate method of the C<Net::OSCAR::Chat> object
instead.

=cut

sub chat_invite($$$@) {
	my($self, $chat, $msg, @who) = @_;
	return must_be_on($self) unless $self->{is_on};
	foreach my $who(@who) { $chat->{connection}->invite($who, $msg); }
}

=pod

=item chat_leave(CHAT)

Deprecated.  Provided for compatibility with C<Net::AIM>.
Use the appropriate method of the C<Net::OSCAR::Chat> object
instead.

=item chat_send(CHAT, MESSAGE)

Deprecated.  Provided for compatibility with C<Net::AIM>.
Use the appropriate method of the C<Net::OSCAR::Chat> object
instead.

=cut

sub chat_leave($$) { $_[1]->part(); }
sub chat_send($$$) { $_[1]->chat_send($_[2]); }

=pod

=back

=head1 CALLBACKS

C<Net::OSCAR> uses a callback mechanism to notify you about different events.
A callback is registered by calling the C<set_callback_callbackname> method
with a code reference as a parameter.  For instance, you might call
C<$oscar->set_callback_error(\&got_error);>.  Your callback function will
be passed parameters which are different for each callback type (and are
documented below).  The first parameter to each callback function will be
the C<Net::OSCAR> object which generated the callback.  This is useful
when using multiple C<Net::OSCAR> objects.

=over 4

=item error (OSCAR, CONNECTION, ERROR, DESCRIPTION, FATAL)

Called when any sort of error occurs (except see L<admin_error> below.)

C<CONNECTION> is the particular connection which generated the error - the C<log_print> method of
C<Net::OSCAR::Connection> may be useful, as may be getting C<$connection->{description}>.
C<DESCRIPTION> is a nicely formatted description of the error.  C<ERROR> is an error number.

If C<FATAL> is non-zero, the error was fatal and the connection to OSCAR has been
closed.

=item rate_alert (OSCAR, LEVEL, CLEAR, WINDOW)

This is called when you are sending commands to OSCAR too quickly.

LEVEL is one of RATE_CLEAR, RATE_ALERT, RATE_LIMIT, or RATE_DISCONNECT from the C<Net::OSCAR::Common>
package (they are imported into your namespace if you import C<Net::OSCAR> with the C<:standard>
parameter.)  RATE_CLEAR means that you're okay.  RATE_ALERT means you should slow down.  RATE_LIMIT
means that the server is ignoring messages from you until you slow down.  RATE_DISCONNECT means you're
about to be disconnected.

CLEAR and WINDOW tell you the maximum speed you can send in order to maintain RATE_CLEAR standing.
You must send no more than WINDOW commands in CLEAR milliseconds.  If you just want to keep it
simple, you can just not send any commands for CLEAR milliseconds and you'll be fine.

=item buddylist_error (OSCAR, ERROR, WHAT)

This is called when there is an error commiting changes to the buddylist.
C<ERROR> is the error number.  C<WHAT> is a string describing which buddylist
change failed.  C<Net::OSCAR> will revert the failed change to
its state before C<commit_buddylist> was called.  Note that the
buddylist contains information other than the user's buddies - see 
any method which says you need to call C<commit_buddylist> to have its
changes take effect.

=item buddylist_ok (OSCAR)

This is called when your changes to the buddylist have been successfully commited.

=item admin_error (OSCAR, REQTYPE, ERROR, ERRURL)

This is called when there is an error performing an administrative function - changing
your password, formatting your screenname, changing your email address, or confirming your
account.  REQTYPE is a string describing the type of request which generated the error.
ERROR is an error message.  ERRURL is an http URL which the user may visit for more
information about the error.

=item admin_ok (OSCAR, REQTYPE)

This is called when an administrative function succeeds.  See L<admin_error> for more info.

=item chat_closed (OSCAR, CHAT, ERROR)

Your connection to CHAT (a C<Net::OSCAR::Chat> object) was severed due to ERROR.

=item buddy_in (OSCAR, SCREENNAME, GROUP, BUDDY DATA)

SCREENNAME (in buddy group GROUP) has signed on, or their information has
changed.  BUDDY DATA is the same as that returned by the L<buddy> method.

=item chat_buddy_in (OSCAR, SCREENNAME, CHAT, BUDDY DATA)

SCREENNAME has entered CHAT.  BUDDY DATA is the same as that returned by
the L<buddy> method.

=item buddy_out (OSCAR, SCREENNAME, GROUP)

Called when a buddy has signed off (or added us to their deny list.)

=item chat_buddy_out (OSCAR, SCREENNAME, CHAT)

Called when someone leaves a chatroom.

=item im_ok (OSCAR, TO)

Called when an IM to C<TO> is successfully sent.

=item im_in (OSCAR, FROM, MESSAGE[, AWAY])

Called when someone sends you an instant message.  If the AWAY parameter
is non-zero, the message was generated as an automatic reply, perhaps because
you sent that person a message and they had an away message set.

=item chat_im_in(OSCAR, FROM, CHAT, MESSAGE)

Called when someone says something in a chatroom.  Note that you
receive your own messages in chatrooms unless you specify the
NOREFLECT parameter in L<chat_send>.

=item chat_invite(OSCAR, WHO, MESSAGE, CHAT, CHATURL)

Called when someone invites us into a chatroom.  MESSAGE is the message
that they specified on the invitation.  CHAT is the name of the chatroom.
CHATURL is a chat URL and not a C<Net::OSCAR::Chat> object.  CHATURL can
be passed to the L<chat_accept> method to accept the invitation.

=item chat_joined(OSCAR, CHATNAME, CHAT)

Called when you enter a chatroom.  CHAT is the C<Net::OSCAR::Chat>
object for the chatroom.

=item evil(OSCAR, NEWEVIL[, FROM])

Called when your evil level changes.  NEWEVIL is your new evil level,
as a percentage (accurate to tenths of a percent.)  ENEMY is undef
if the evil was anonymous (or if the message was triggered because
your evil level naturally decreased), otherwise it is the screenname
of the person who sent us the evil.  See the L<"evil"> method for
more information on evils.

=item buddy_info(OSCAR, SCREENNAME, BUDDY DATA)

Called in response to a L<get_info> or L<get_away> request.
BUDDY DATA is the same as that returned by the L<buddy> method,
except that one of two additional keys, C<profile> and C<awaymsg>,
may be present.

=item signon_done(OSCAR)

Called when the user is completely signed on to the service.

=item log(OSCAR, LEVEL, MESSAGE)

Use this callback if you don't want the log_print methods to just print to STDERR.
It is called when even C<MESSAGE> of level C<LEVEL> is called.  The levels are,
in order of increasing importance:

=over 4

=item OSCAR_DBG_NONE

Really only useful for setting in the L<"loglevel"> method.  No information will
be logged.  The default loglevel.

=item OSCAR_DBG_PACKETS

Hex dumps of all incoming/outgoing packets.

=item OSCAR_DBG_DEBUG

Information useful for debugging C<Net::OSCAR>, and precious little else.

=item OSCAR_DBG_SIGNON

Like C<OSCAR_DBG_NOTICE>, but only for the signon process; this is where
problems are most likely to occur, so we provide this for the common case of
people who only want a lot of information during signon.  This may be deprecated
some-day and be replaced by a more flexible facility/level system, ala syslog.

=item OSCAR_DBG_NOTICE

=item OSCAR_DBG_INFO

=item OSCAR_DBG_WARN

=back

Note that these symbols are imported into your namespace if and only if you use
the C<:loglevels> or <:all> tags when importing the module (e.g. C<use Net::OSCAR qw(:standard :loglevels)>.)

Also note that this callback is only triggered for events whose level is greater
than or equal to the loglevel for the OSCAR session.  The L<"loglevel"> method
allows you to get or set the loglevel.

=item connection_changed OSCAR CONNECTION STATUS

Called when the status of a connection changes.  The status is "read" if we
should call C<process_one> on the connection when C<select> indicates that
the connection is ready for reading, "write" if we should call
C<process_one> when the connection is ready for writing, or "deleted" if the
connection has been deleted.

C<CONNECTION> is a C<Net::OSCAR::Connection> object.

Users of this callback may also be interested in the L<"get_filehandle">
method of C<Net::OSCAR::Connection>.

=cut

sub do_callback($@) {
	my $callback = shift;
	return unless $_[0]->{callbacks}->{$callback};
	&{$_[0]->{callbacks}->{$callback}}(@_);
}
sub set_callback { $_[1]->{callbacks}->{$_[0]} = $_[2]; }

sub callback_error(@) { do_callback("error", @_); }
sub callback_buddy_in(@) { do_callback("buddy_in", @_); }
sub callback_buddy_out(@) { do_callback("buddy_out", @_); }
sub callback_im_in(@) { do_callback("im_in", @_); }
sub callback_chat_joined(@) { do_callback("chat_joined", @_); }
sub callback_chat_buddy_in(@) { do_callback("chat_buddy_in", @_); }
sub callback_chat_buddy_out(@) { do_callback("chat_buddy_out", @_); }
sub callback_chat_im_in(@) { do_callback("chat_im_in", @_); }
sub callback_chat_invite(@) { do_callback("chat_invite", @_); }
sub callback_buddy_info(@) { do_callback("buddy_info", @_); }
sub callback_evil(@) { do_callback("evil", @_); }
sub callback_chat_closed(@) { do_callback("chat_closed", @_); }
sub callback_buddylist_error(@) { do_callback("buddylist_error", @_); }
sub callback_buddylist_ok(@) { do_callback("buddylist_ok", @_); }
sub callback_admin_error(@) { do_callback("admin_error", @_); }
sub callback_admin_ok(@) { do_callback("admin_ok", @_); }
sub callback_rate_alert(@) { do_callback("rate_alert", @_); }
sub callback_signon_done(@) { do_callback("signon_done", @_); }
sub callback_log(@) { do_callback("log", @_); }
sub callback_im_ok(@) { do_callback("im_ok", @_); }
sub callback_connection_changed(@) { do_callback("connection_changed", @_); }

sub set_callback_error($\&) { set_callback("error", @_); }
sub set_callback_buddy_in($\&) { set_callback("buddy_in", @_); }
sub set_callback_buddy_out($\&) { set_callback("buddy_out", @_); }
sub set_callback_im_in($\&) { set_callback("im_in", @_); }
sub set_callback_chat_joined($\&) { set_callback("chat_joined", @_); }
sub set_callback_chat_buddy_in($\&) { set_callback("chat_buddy_in", @_); }
sub set_callback_chat_buddy_out($\&) { set_callback("chat_buddy_out", @_); }
sub set_callback_chat_im_in($\&) { set_callback("chat_im_in", @_); }
sub set_callback_chat_invite($\&) { set_callback("chat_invite", @_); }
sub set_callback_buddy_info($\&) { set_callback("buddy_info", @_); }
sub set_callback_evil($\&) { set_callback("evil", @_); }
sub set_callback_chat_closed($\&) { set_callback("chat_closed", @_); }
sub set_callback_buddylist_error($\&) { set_callback("buddylist_error", @_); }
sub set_callback_buddylist_ok($\&) { set_callback("buddylist_ok", @_); }
sub set_callback_admin_error($\&) { set_callback("admin_error", @_); }
sub set_callback_admin_ok($\&) { set_callback("admin_ok", @_); }
sub set_callback_rate_alert($\&) { set_callback("rate_alert", @_); }
sub set_callback_signon_done($\&) { set_callback("signon_done", @_); }
sub set_callback_log($\&) { set_callback("log", @_); }
sub set_callback_im_ok($\&) { set_callback("im_ok", @_); }
sub set_callback_connection_changed($\&) { set_callback("connection_changed", @_); }

=pod

=back

=head1 CHATS

Aside from the methods listed here, there are a couple of methods of the
C<Net::OSCAR::Chat> object that are important for implementing chat
functionality.  C<Net::OSCAR::Chat> is a descendent of C<Net::OSCAR::Connection>.

=over 4

=item invite (WHO, MESSAGE)

Invite somebody into the chatroom.

=item chat_send (MESSAGE[, NOREFLECT[, AWAY]])

Sends a message to the chatroom.  If the NOREFLECT parameter is
present, you will not receive the message as an incoming message
from the chatroom.  If AWAY is present, the message was generated
as an automatic reply, perhaps because you have an away message set.

=item part

Leave the chatroom.

=item url

Returns the URL for the chatroom.  Use this to associate a chat invitation
with the chat_joined that C<Net::OSCAR> sends when you've join the chatroom.

=item name

Returns the name of the chatroom.

=item exchange

Returns the exchange of the chatroom.
This is normally 4 but can be 5 for certain chatrooms.

=back

=head1 CONSTANTS

The following constants are defined when C<Net::OSCAR> is imported with the
C<:standard> tag.  Unless indicated otherwise, the constants are magical 
scalars - they return different values in string and numeric contexts (for
instance, an error message and an error number.)

=over 4

=item ADMIN_TYPE_PASSWORD_CHANGE

=item ADMIN_TYPE_EMAIL_CHANGE

=item ADMIN_TYPE_SCREENNAME_FORMAT

=item ADMIN_TYPE_ACCOUNT_CONFIRM

=item ADMIN_ERROR_UNKNOWN

=item ADMIN_ERROR_BADPASS

=item ADMIN_ERROR_BADINPUT

=item ADMIN_ERROR_BADLENGTH

=item ADMIN_ERROR_TRYLATER

=item ADMIN_ERROR_REQPENDING

=item ADMIN_ERROR_CONNREF

=item VISMODE_PERMITALL

=item VISMODE_DENYALL

=item VISMODE_PERMITSOME

=item VISMODE_DENYSOME

=item VISMODE_PERMITBUDS

=item RATE_CLEAR

=item RATE_ALERT

=item RATE_LIMIT

=item RATE_DISCONNECT

=item GROUPPERM_OSCAR

=item GROUPPERM_AOL

=back

=head1 Net::AIM Compatibility

Here are the major differences between the C<Net::OSCAR> interface
and the C<Net::AIM> interface:

=over 4

=item *

No get/set method.

=item *

No newconn/getconn method.

=item *

No group parameter for add_permit or add_deny.

=item *

Many differences in chat handling.

=item *

No chat_whisper.

=item *

No encode method - it isn't needed.

=item *

No send_config method - it isn't needed.

=item *

No send_buddies method - we don't keep a separate local buddylist.

=item *

No normalize method - it isn't needed.  Okay, there is a normalize
function in C<Net::OSCAR::Common>, but I can't think of any reason
why it would need to be used outside of the module internals.

=item *

Different callbacks with different parameters.

=back

=head1 MISCELLANEOUS

There are two programs included with the C<Net::OSCAR> distribution.
oscartest is a minimalist implementation of a C<Net::OSCAR> client.
snacsnatcher is a tool designed for analyzing the OSCAR protocol from
libpcap-format packet captures.

There is a class C<Net::OSCAR::Screenname>.  OSCAR screennames
are case and whitespace insensitive, and if you do something like
C<$buddy = new Net::OSCAR::Screenname "Matt Sachs"> instead of
C<$buddy = "Matt Sachs">, this will be taken care of for you when
you use the string comparison operators (eq, ne, cmp, etc.)

C<Net::OSCAR::Connection>, the class used for connection objects,
has a C<get_filehandle> method which returns the filehandle
(in the current implementation, a globref created via C<gensym>/C<socket>)
used for the connection.

=over 4

=item get_filehandle

Returns the filehandle used for the connection.  Note that this is a method
of C<Net::OSCAR::Connection>, not C<Net::OSCAR>.

=back

=head1 HISTORY

=over 4

=item *

0.50, 2001-12-23

=over 4

=item *

Fixes for the "crap out on 'connection reset by peer'" and "get stuck and slow down in Perl_sv_2bool" bugs!

=item *

Correct handling of very large (over 100 items) buddylists.

=item *

We can now join exchange 5 chats.

=item *

Fixes in modifying permit mode.

=item *

Updated copyright notice courtesy of AOL's lawyers.

=item *

Switch to IO::Socket for portability in set_blocking.

=back

=item *

0.25, 2001-11-26

=over 4

=item *

Net::OSCAR is now in beta!

=item *

We now work with perl 5.005 and even 5.004

=item *

Try to prevent weird Net::OSCAR::Screenname bug where perl gets stuck in Perl_sv_2bool

=item *

Fixed problems with setting visibility mode and adding to deny list (thanks, Philip)

=item *

Added some methods to allow us to be POE-ified

=item *

Added guards around a number of methods to prevent the user from trying to do stuff before s/he's finished signing on.

=item *

Fix *incredibly* stupid error in NO_to_BLI that ate group names

=item *

Fixed bad bug in log_printf

=item *

Buddylist error handling changes

=item *

Added chat_decline command

=item *

Signon, signoff fixes

=item *

Allow AOL screennames to sign on

=item *

flap_get crash fixes

=back

=item *

0.09, 2001-10-01

=over 4

=item *

Crash and undefined value fixes

=item *

New method: im_ok

=item *

New method: rename_group, should fix "Couldn't get group name" error.

=item *

Fix for buddy_in callback and data

=item *

Better error handling when we can't resolve a host

=item *

Vastly improved logging infrastructure - debug_print(f) replaced with log_print(f). debug_print callback is now called log and has an extra parameter.

=item *

Fixed MANIFEST - we don't actually use Changes (and we do use Screenname.pm)

=item *

blinternal now automagically enforces the proper structure (the right things become Net::OSCAR::TLV tied hashes and the name and data keys are automatically created) upon vivification.  So, you can do $bli->{0}->{1}->{2}->{data}->{0x3} = "foo" without worrying if 0, 1, 2, or data have been tied.  Should close bug #47.

=back

=item *

0.08, 2001-09-07

=over 4

=item *

Totally rewritten buddylist handling.  It is now much cleaner, bug-resistant,
and featureful.

=item *

Many, many internal changes that I don't feel like enumerating.
Hey, there's a reason that I haven't declared the interface stable yet! ;)

=item *

New convenience object: Net::OSCAR::Screenname

=item *

Makefile.PL: Fixed perl version test and compatibility with BSD make

=back

=item *

0.07, 2001-08-13

=over 4

=item *

A bunch of Makefile.PL fixes

=item *

Fixed spurious admin_error callback and prevent user from having multiple
pending requests of the same type.  (closes #39)

=item *

Head off some potential problems with set_visibility.  (closes #34)

=item *

Removed connections method, added selector_filenos

=item *

Added error number 29 (too many recent signons from your site) to Net::OSCAR::Common.

=item *

We now explicitly perl 5.6.0 or newer.

=back

=item *

0.06, 2001-08-12

=over 4

=item *

Prevent sending duplicate signon_done messages

=item *

Don't addconn after crapping out!

=item *

Don't try to delconn unless we have connections.

=item *

delete returns the correct value now in Net::OSCAR::Buddylist.

=item *

Don't use warnings if $] <= 5.005

=item *

evil is a method, not a manpage (doc fix)

=item *

Added buddyhash method.

=item *

Added a debug_print callback.

=item *

Clarified process_connections method in documentation

=item *

You can now specify an alternate host/port in signon

=item *

Added name method to Chat.

=item *

permit list and deny list are no longer part of buddylist

=item *

Rewrote buddylist parsing (again!)

=item *

No more default profile.

=item *

Fix bug when storing into an already-existing key in Net::OSCAR::Buddylist.

=item *

snacsnatcher: Remove spurious include of Net::OSCAR::Common

=item *

We don't need to handle VISMODE_PERMITBUDS ourself - the server takes care of it.
Thanks, VB!

=item *

Makefile.PL: Lots of way cool enhancements to make dist:

=over 4

=item -

It modifies the version number for us

=item -

It does a CVS rtag

=item -

It updates the HTML documentation on zevils and the README.

=back

=item *

Added HISTORY and INSTALLATION section to POD.

=back

=item *

0.05, 2001-08-08

=over 4

=item *

Don't send signon_done until after we get buddylist.

=item *

Added signoff method.

=item *

Fixed typo in documentation

=item *

Fixed chat_invite parm count

=item *

Added Scalar::Utils::dualvar variables, especially to Common.pm.
dualvar variables return different values in numeric and string context.

=item *

Added url method for Net::OSCAR::Chat (closes #31)

=item *

Divide evil by 10 in extract_userinfo (closes #30)

=item *

chat_invite now exposes chatname (closes #32)

=item *

Removed unnecessary and warning-generating session length from extract_userinfo

=back

=item *

0.01, 2001-08-02

=over 4

=item *

Initial release.

=back

=back

=head1 SUPPORT

See http://www.zevils.com/programs/net-oscar/ for support, including
a mailing list and bug-tracking system.

=head1 AUTHOR

Matthew Sachs E<lt>matthewg@zevils.comE<gt>.

=head1 CREDITS

John "VBScript" for a lot of technical assistance, including the explanation of rates.

Adam Fritzler and the libfaim team for their documentation and an OSCAR implementation that
was used to help figure out a lot of the protocol details.  E<lt>http://www.zigamorph.net/faim/protocol/E<gt>

Mark Doliner for help with remote buddylists.  E<lt>http://kingant.net/libfaim/ReadThis.htmlE<gt>

The gaim team - the source to their libfaim client was also very helpful.  E<lt>http://gaim.sourceforge.net/E<gt>

The users of aimirc for being reasonably patient while this module was developed.  E<lt>http://www.zevils.com/programs/aimirc/E<gt>

Jayson Baker for some last-minute debugging help.

Rocco Caputo for helping to work out the hooks that let use be used with
POE.  E<lt>http://poe.perl.org/E<gt>

AOL, for creating the AOL Instant Messenger service, even though they aren't terribly helpful to
developers of third-party clients.

=head1 LEGAL

Copyright (c) 2001 Matthew Sachs.  All rights reserved.
This program is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.  B<AOL> and B<AMERICA ONLINE> are registered trademarks
owned by America Online, Inc.  The B<INSTANT MESSENGER> mark is owned by America
Online, Inc.  C<Net::OSCAR> is not endorsed by, or affiliated with, America Online, Inc.

=cut

1;
