File Coverage

blib/lib/Net/CyanChat.pm

Criterion	Covered	Total	%
statement	12	207	5.8
branch	0	68	0.0
condition	0	13	0.0
subroutine	4	28	14.2
pod	22	23	95.6
total	38	339	11.2

package Net::CyanChat;

#------------------------------------------------------------------------------#
# Net::CyanChat - Perl interface for connecting to Cyan Worlds' chat room.     #
#------------------------------------------------------------------------------#
# POD documentation is at the very end of this source code.                    #
#------------------------------------------------------------------------------#

use strict;
use warnings;
use IO::Socket;
use IO::Select;

our $VERSION = '0.06';

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	my $self = {
		host      => 'cho.cyan.com', # Default CC Host
		port      => 1812,           # Default CC Port (1813=debugging)
		debug     => 0,              # Debug Mode
		proto     => 1,              # Use Protocol 1 (not 0)
		sock      => undef,          # Socket Object
		select    => undef,          # Select Object
		pinged    => 0,              # Last Ping Time
		refresh   => 60,             # Ping Rate = 60 Seconds
		nickname  => '',             # Our Nickname
		handlers  => {},             # Handlers
		connected => 0,              # Are We Connected?
		accepted  => 0,              # Logged in?
		who       => {},             # Who List
		special   => {},             # Special who List
		ignored   => {},             # Ignored List
		nicks     => {},             # Nickname Lookup Table
		@_,
	};

	# Protocol support numbers: 0 and 1.
	if ($self->{proto} < 0 || $self->{proto} > 1) {
		die "Unsupported protocol version: must be 0 or 1!";
	}

	bless ($self,$class);
	return $self;
}

sub version {
	my ($self) = @_;
	return $VERSION;
}

sub debug {
	my ($self,$msg) = @_;

	return unless $self->{debug} == 1;
	print "Net::CyanChat::debug // $msg\n";
}

sub send {
	my ($self,$data) = @_;

	# Send the data.
	if (defined $self->{sock}) {
		$self->debug (">>> $data\n");

		# Send true CrLf
		$self->{sock}->send ("$data\x0d\x0a") or do {
			# We've been disconnected!
			$self->{sock}->close();
			$self->{sock} = undef;
			$self->{select} = undef;
			$self->{connected} = 0;
			$self->{nick} = '';
			$self->{pinged} = 0;
			$self->{who} = {};
			$self->{nicks} = {};
			$self->_event ('Disconnected');
		};
	}
	else {
		warn "Could not send \"$data\" to CyanChat: connection not established!";
	}
}

sub setHandler {
	my ($self,$event,$code) = @_;

	# Set this handler.
	$self->{handlers}->{$event} = $code;
}

sub connect {
	my ($self) = @_;

	# Connect to CyanChat.
	$self->{sock} = new IO::Socket::INET (
		PeerAddr => $self->{host},
		PeerPort => $self->{port},
		Proto    => 'tcp',
	);

	# Error?
	if (!defined $self->{sock}) {
		$self->_event ('Error', "00|Connection Error", "Net::CyanChat Connection Error: $!");
		return undef;
	}

	# Create a select object.
	$self->{select} = IO::Select->new ($self->{sock});
	return 1;
}

sub start {
	my ($self) = @_;

	while (1) {
		$self->do_one_loop or last;
	}

	return undef;
}

sub login {
	my ($self,$nick) = @_;

	# Remove newline characters.
	$nick =~ s/[\x0d\x0a]//ig;

	if (length $nick > 0) {
		# Sign in.
		$self->send ("10|$nick");
		$self->{nickname} = $nick;
		return 1;
	}

	return undef;
}

sub logout {
	my ($self) = @_;

	return undef unless length $self->{nickname} > 0;
	$self->{nickname} = '';
	$self->{accepted} = 0;
	$self->send ("15");
	return 1;
}

sub sendMessage {
	my ($self,$msg) = @_;

	# Remove newline characters.
	$msg =~ s/[\x0d\x0a]//ig;

	# Send the message.
	return undef unless length $msg > 0;
	$self->send ("30|^1$msg");
	return 1;
}

sub sendPrivate {
	my ($self,$to,$msg) = @_;

	# Remove newline characters.
	$to  =~ s/[\x0d\x0a]//ig;
	$msg =~ s/[\x0d\x0a]//ig;

	return undef unless (length $to > 0 && length $msg > 0);
	# Get the user's full nick.
	my $nick = $self->{nicks}->{$to};

	# Send this user a message.
	$self->send ("20|$nick|^1$msg");
	return 1;
}

sub getBuddies {
	my ($self) = @_;

	# Return the buddylist.
	my $buddies = {};
	foreach my $key (keys %{$self->{who}}) {
		$buddies->{who}->{$key} = $self->{who}->{$key};
	}
	foreach my $key (keys %{$self->{special}}) {
		$buddies->{special}->{$key} = $self->{special}->{$key};
	}
	return $buddies;
}

sub getUsername {
	my ($self,$who) = @_;

	# Return this user's full name.
	return $self->{nicks}->{who}->{$who} || $self->{nicks}->{special}->{$who} || undef;
}
sub getFullName {
	my ($self,$who) = @_;

	# Alias for getUsername.
	return $self->getUsername ($who);
}

sub getAddress {
	my ($self,$who) = @_;

	# Return this user's address.
	return $self->{who}->{$who} || (
		exists $self->{special}->{$who} ? "Cyan Worlds" : undef
	) || undef;
}

sub protocol {
	my ($self) = @_;
	return $self->{proto};
}

sub nick {
	my ($self) = @_;

	return $self->{nickname};
}

sub ignore {
	my ($self,$who) = @_;

	# Remove newline characters.
	$who =~ s/[\x0d\x0a]//ig;

	# Ignore this user.
	return undef unless length $who > 0;
	$self->{ignored}->{$who} = 1;
	$self->send ("70|$who");
	return 1;
}
sub unignore {
	my ($self,$who) = @_;

	# Remove newline characters.
	$who =~ s/[\x0d\x0a]//ig;

	# Unignore this user.
	return undef unless length $who > 0;
	delete $self->{ignored}->{$who};
	$self->send ("70|$who");
	return 1;
}

sub authenticate {
	my ($self,$password) = @_;

	# Remove newline characters.
	$password =~ s/[\x0d\x0a]//ig;

	# Authenticate with a CC password.
	$self->send ("50|$password");
	return 1;
}

sub promote {
	my ($self,$user) = @_;

	# Remove newline characters.
	$user =~ s/[\x0d\x0a]//ig;

	# Promote this user to Special Guest.
	$self->send ("60|$user|4");
	return 1;
}

sub demote {
	my ($self,$user) = @_;

	# Remove newline characters.
	$user =~ s/[\x0d\x0a]//ig;

	# Demote this user.
	$self->send ("60|$user|0");
	return 1;
}

sub _event {
	my ($self,$event,@data) = @_;

	return unless exists $self->{handlers}->{$event};
	&{$self->{handlers}->{$event}} ($self,@data);
}

sub do_one_loop {
	my ($self) = @_;

	# Time to ping again?
	if ($self->{pinged} > 0) {
		# If connected...
		if ($self->{connected} == 1) {
			# If logged in...
			if ($self->{accepted} == 1) {
				# If refresh time has passed...
				if (time() - $self->{pinged} >= $self->{refresh}) {
					# To ping, send a private message to nobody.
					$self->send ("20||^1ping");
					$self->{pinged} = time();
				}
			}
		}
	}

	return undef unless defined $self->{select};

	# Loop with the server.
	my @ready = $self->{select}->can_read(.01);
	return 1 unless(@ready);

	foreach my $socket (@ready) {
		my $resp;
		$self->{sock}->recv ($resp,2048,0);
		my @in = split(/\n/, $resp);

		# The server has sent us a message!
		foreach my $said (@in) {
			$said =~ s/[\x0d\x0a]//ig;
			my ($command,@args) = split(/\|/, $said);

			$self->debug("<<< $said\n");

			# Go through the commands.
			if ($command == 10) {
				# 10 = Name is invalid.
				$self->_event ('Error', 10, "Your name is invalid.");
			}
			elsif ($command == 11) {
				# 11 = Name accepted.
				$self->{accepted} = 1;
				$self->_event ('Name_Accepted');
			}
			elsif ($command == 21) {
				# 21 = Private Message
				my $type = 0;
				my $fullNick = $args[0];
				my ($level) = $args[0] =~ /^(\d)/;
				$type = $args[1] =~ /^\^(\d)/;
				$args[0] =~ s/^(\d)//ig;
				$args[1] =~ s/^\^(\d)//ig;

				# Get the sender's nick and address.
				my ($nick,$addr) = split(/\,/, $args[0], 2);

				# Skip ignored users.
				next if exists $self->{ignored}->{$nick};

				shift (@args);
				my $text = join ('|',@args);

				# Call the event.
				$self->_event ('Private', {
					nick     => $nick,
					username => $fullNick,
					level    => $level,
					address  => $addr,
					message  => $text,
				});
			}
			elsif ($command == 31) {
				# 31 = Public Message.
				my $type = 1;
				my $fullNick = $args[0];
				my ($level) = $args[0] =~ /^(\d)/;
				($type) = $args[1] =~ /^\^(\d)/;
				$args[0] =~ s/^(\d)//i;
				$args[1] =~ s/^\^(\d)//i;

				# Get the sender's nick and address.
				my ($nick,$addr) = split(/\,/, $args[0], 2);

				# Skip ignored users.
				next if exists $self->{ignored}->{$nick};

				# Chop off spaces.
				$args[1] =~ s/^\s//ig;

				# Shift off data.
				shift (@args); # nickname
				my $text = join ('|',@args);

				# User has entered the room.
				if ($type == 2) {
					# Call the event.
					$self->_event ('Chat_Buddy_In', {
						nick     => $nick,
						username => $fullNick,
						level    => $level,
						address  => $addr,
						message  => $text,
					});
				}
				elsif ($type == 3) {
					# Call the event.
					$self->_event ('Chat_Buddy_Out', {
						nick     => $nick,
						username => $fullNick,
						level    => $level,
						address  => $addr,
						message  => $text,
					});
				}
				else {
					# Normal message.
					$self->_event ('Message', {
						nick     => $nick,
						username => $fullNick,
						level    => $level,
						address  => $addr,
						message  => $text,
					});
				}
			}
			elsif ($command == 35) {
				# 35 = Who List Update.

				# Keep track of all the FullNick's we found.
				my %this = ();

				# Keep running arrays of users for the WhoList event.
				my @list = ();

				# Go through each item received.
				foreach my $user (@args) {
					my ($nick,$addr) = split(/\,/, $user, 2);
					my $fullNick = $nick;

					# Get data about this user.
					my ($level) = $nick =~ /^(\d)/;
					$nick =~ s/^(\d)//i;

					# User is online.
					if ($level == 0) {
						# Add user to the normal users list.
						$self->{who}->{$nick} = $addr;
						$self->{nicks}->{who}->{$nick} = $fullNick;
					}
					else {
						# Add them to the Cyan & Guests list.
						$self->{special}->{$nick} = $addr;
						$self->{nicks}->{special}->{$nick} = $fullNick;
					}

					push (@list, {
						nick     => $nick,
						level    => $level,
						address  => $addr,
						username => $fullNick,
					});
					$this{$fullNick} = 1;
				}

				# New event: WhoList = sends the entire Who List at once.
				$self->_event ('WhoList', @list);

				# See if anybody should be dropped.
				foreach my $who (keys %{$self->{who}}) {
					my $fullNick = $self->{nicks}->{who}->{$who};
					if (!exists $this{$fullNick}) {
						# Buddy's gone.
						delete $self->{who}->{$who};
					}
				}
				foreach my $who (keys %{$self->{special}}) {
					my $fullNick = $self->{nicks}->{special}->{$who};
					if (!exists $this{$fullNick}) {
						# Buddy's gone.
						delete $self->{special}->{$who};
					}
				}

				# If we haven't been connected, now is the time to authenticate.
				if ($self->{connected} == 0) {
					$self->{connected} = 1;

					# Send event 40 to the server (40 = client ready).
					$self->send ("40|$self->{proto}");

					# The server is ready for us now.
					$self->_event ('Connected');

					# Start the pinging process.
					$self->{pinged} = time();
				}
			}
			elsif ($command == 40) {
				# 40 = Server welcome message (the "pong" of 40 from the client).
				$args[0] =~ s/^1//i;
				$self->_event ('Welcome', $args[0]);
			}
			elsif ($command == 70) {
				# 70 = Ignored/Unignored a user.
				my $user = $args[0];
				$self->_event ('Ignored', $user);
			}
			else {
				$self->debug ("Unknown event code from server: $command|"
					. join ('|', @args) );
			}
		}
	}

	return 1;
}

1;
__END__