File Coverage

blib/lib/E2/Message.pm

Criterion	Covered	Total	%
statement	18	175	10.2
branch	0	114	0.0
condition	0	15	0.0
subroutine	6	32	18.7
pod	15	15	100.0
total	39	351	11.1

# E2::Message
# Jose M. Weeks
# 18 June 2003
#
# See bottom for pod documentation.

package E2::Message;

use 5.006;
use strict;
use warnings;
use Carp;

use E2::Ticker;
use E2::Node;	# for set_room

our @ISA 	= "E2::Ticker";
our $VERSION	= "0.32";
our $DEBUG; *DEBUG = *E2::Interface::DEBUG;

our %room_name_to_id  = (
	"outside"		=> undef, # 1102338,
	"political asylum"	=> 553129,
	"noder's nursery"	=> 553146
);

# Methods

sub new;

sub list_public;
sub list_private;

sub reset_public;
sub reset_private;

sub room;
sub room_id;
sub topic;

sub set_room;
sub send;
sub blab;
sub delete;

# Private

sub list_messages;

# Methods

sub new {
	my $arg   = shift;
	my $class = ref( $arg ) || $arg;
	my $self  = $class->SUPER::new();
	return bless ($self, $class);
}

sub topic {
	my $self = shift	or croak "Usage: topic E2MESSAGE";
	return $self->{topic};
}

sub room {
	my $self = shift 	or croak "Usage: room E2MESSAGE";
	return $self->{room};
}

sub room_id {
	my $self = shift	or croak "Usage: room_id E2MESSAGE";
	return $self->{room_id};
}

sub reset_public {
	my $self = shift	or croak "Usage: reset_public E2MESSAGE";
	$self->{msglimit} = undef;
}

sub reset_private {
	my $self = shift	or croak "Usage: reset_private E2MESSAGE";
	$self->{p_msglimit} = undef;
}

sub list_public {
	my $self = shift	or croak "Usage: list_public E2MESSAGE";

	my %opt;
	my @list;

	warn "E2::Message::list_public\n"	if $DEBUG > 1;

	# We need to lock list_public, because there is a re-entrance issue
	# with msglimit (if we call this method a second time before the
	# first has completed, we'll have two list_publics with the same
	# msglimit, which means any messages retrieved will be retrieved
	# twice).

	return () if $self->{__lock_list_public};
	$self->{__lock_list_public} = 1;

	$opt{nosort}	= 1;
	$opt{backtime}	= 10;
	$opt{msglimit}	= $self->{msglimit} if $self->{msglimit};
	$opt{for_node}	= $self->{room_id}  if $self->{room_id};

	# This code is repeated in list_private (to some extent).

	my $handlers = {
		'messages/topic' => sub {
			(my $a, my $b) = @_;
			$self->{topic} = $b->text;
		},
		'messages/room' => sub {
			(my $a, my $b) = @_;

			# If we're in the process of changing rooms, don't
			# store any room values.

			return	if $self->{room_lock};

			$self->{room} =  $b->text;
			$self->{room_id} = $b->{att}->{room_id}
		},
		'messages/msglist/msg' => sub {
			(my $a, my $b) = @_;
			my $m = {};

			$m->{id}     = $b->{att}->{msg_id};
			$m->{time}   = $b->{att}->{msg_time};

			# Set 'author' and 'author_id' if they exist

			if( my $f = $b->first_child('from') ) {
				$m->{author} = $f->first_child('e2link')->text;
				$m->{author_id} = $f->first_child('e2link')->
					{att}->{node_id};
			}

			$m->{archive} = $b->{att}->{archive};

			$m->{text} = $b->first_child('txt')->text;

			if( !$self->{msglimit} ||
			    $m->{id} > $self->{msglimit} ) {
				$self->{msglimit} = $m->{id};
			}

			push @list, $m;
		}
	};

	# We need to do some post-processing (sorting), so we'll have to use
	# thread_then

	return $self->thread_then(
		[
			\&E2::Ticker::parse,
			$self,
			'messages',
			$handlers,
			[],		# It'll be more efficient to not pass
			%opt		# @list back and forth, so just pass a
		],			# dummy value.
		sub { return sort { $a->{id} <=> $b->{id} } @list }, # POST
		sub { delete $self->{__lock_list_public}          }  # FINISH
	);
}

sub list_private {
	my $self = shift	or croak "Usage: list_private E2MESSAGE [, DROP_ARCHIVED ]";
	my $drop_archived = shift;
	my @list;
	my %opt;

	warn "E2::Message::list_private\n"	if $DEBUG > 1;

	return () if $self->{__lock_list_private};
	$self->{__lock_list_private} = 1;

	$opt{msglimit}	= $self->{p_msglimit}	if $self->{p_msglimit};
	$opt{for_node}	= "me";

	my $handlers = {
		'messages/msglist/msg' => sub {
			(my $a, my $b) = @_;
			my $m = {};

			$m->{id}     = $b->{att}->{msg_id};
			$m->{time}   = $b->{att}->{msg_time};

			# Set 'author' and 'author_id' if they exist

			if( my $f = $b->first_child('from') ) {
				$m->{author} = $f->first_child('e2link')->text;
				$m->{author_id} = $f->first_child('e2link')->
					{att}->{node_id};
			}

			$m->{archive} = $b->{att}->{archive};

			$m->{text} = $b->first_child('txt')->text;

			# Do group stuff if this is a group message

			if( my $g = $b->first_child( 'grp' ) ) {
				$m->{group} = $g->first_child('e2link')->text;
				$m->{group_id} = $g->first_child('e2link')->
					{att}->{node_id};
				$m->{grouptype} = $g->{att}->{type};
			}

			if( !$self->{p_msglimit} ||
				$m->{id} > $self->{p_msglimit} ) {
				$self->{p_msglimit} = $m->{id};
			}

			# Don't store if we're dropping archived AND
			# this message is archived.

			if( $drop_archived && $m->{archive} ) {
				return;
			}

			push @list, $m;
		}
	};

	# We need to do some post-processing (sorting), so we'll have to use
	# thread_then

	return $self->thread_then(
		[
			\&E2::Ticker::parse,
			$self,
			'messages',
			$handlers,
			[],		# It'll be more efficient to not pass
			%opt		# @list back and forth, so just pass a
		],			# dummy value.
		sub { return sort { $a->{id} <=> $b->{id} } @list }, # POST
		sub { delete $self->{__lock_list_private}         }  # FINISH
	);
}

sub send {
	my $self = shift		or croak "Usage: send E2MESSAGE, MESSAGE_TEXT";
	my $message = shift		or croak "Usage: send E2MESSAGE, MESSAGE_TEXT";

	warn "E2::Message::send\n"		if $DEBUG > 1;

	if( ! $self->logged_in ) {
		warn "Unable to send message: not logged in"	if $DEBUG;
		return undef;
	}

	return $self->thread_then(
		[
			\&E2::Interface::process_request,
			$self,
			op	=> "message",
			message	=> $message
		],
	sub {
		return 1;	# FIXME
	});
}

sub set_room {
	our $self = shift	or croak "Usage: set_room E2MESSAGE, ROOM_NAME";
	my $room = shift	or croak "Usage: set_room E2MESSAGE, ROOM_NAME";

	warn "E2::Message::set_room\n"	if $DEBUG > 1;

	return undef if $self->{__lock_set_room};
	$self->{__lock_set_room} = 1;

	if( ! $self->logged_in ) {
		warn "Unable to set room message: not logged in" if $DEBUG;
		return undef;
	}

	$room = lc( $room );

	# Return 0 if we're already in the specified room

	if( lc($self->{room}) eq $room ) {
		return 0;
	}

	# Change rooms

	our $n = new E2::Node;
	$n->clone( $self );

	return $self->thread_then(
		[
			\&E2::Node::load,
			$n,
			$room,
			'room'
		],
	sub {
		if( (!$n->type) || $n->type ne 'room' ) {
			return undef;
		}

		$self->{room}		= $n->title;
		$self->{room_id}	= $n->node_id;
		$self->{topic}		= $n->description;
		$self->{msglimit}	= undef;

		delete $self->{__lock_set_room};

		return 1;
	});
}

sub blab {
	my $self    = shift	or croak "Usage: blab E2MESSAGE, USER_ID, TEXT [ , CC_BOOL ]";
	my $user_id = shift	or croak "Usage: blab E2MESSAGE, USER_ID, TEXT [ , CC_BOOL ]";
	my $text    = shift	or croak "Usage: blab E2MESSAGE, USER_ID, TEXT [ , CC_BOOL ]";
	my $cc	    = shift;

	my %request;

	warn "E2::Message::blab\n"	if $DEBUG > 1;

	if( ! $self->logged_in ) {
		warn "Unable to blab: not logged in"	if $DEBUG;
		return undef;
	}

	$request{node_id} = $user_id;
	$request{"msguser_$user_id"} = $text;

	if( $cc ) {
		if( !$self->this_user_id ) {

			return $self->thread_then(
				[
					\&E2::Interface::verify_login,
					$self
				],
			sub {
				return undef	if !$self->this_user_id;

				$request{"ccmsguser_$self->{user_id}"} = 1;

				return process_request( %request );
			});

		} else {
			$request{"ccmsguser_$self->{user_id}"} = 1
		}
	}

	return $self->process_request( %request );
}

sub archive {
	my $self = shift	or croak "Usage: archive E2MESSAGE, MSG_ID ...";
	my @msgs = @_		or croak "Usage: archive E2MESSAGE, MSG_ID ...";

	warn "E2::Message::archive\n"	if $DEBUG > 1;

	my %req = ( op => 'message' );

	foreach( @msgs ) { $req{"archive_$_"} = 'yup' }

	return $self->process_request( %req );
}

sub unarchive {
	my $self = shift  or croak "Usage: unarchive E2MESSAGE, MSG_ID ...";
	my @msgs = @_	  or croak "Usage: unarchive E2MESSAGE, MSG_ID ...";

	warn "E2::Message::unarchive\n"	if $DEBUG > 1;

	my %req = ( op => 'message' );

	foreach( @msgs ) { $req{"unarchive_$_"} = 'yup' }

	return $self->process_request( %req );
}

sub delete {
	my $self = shift	or croak "Usage: delete E2MESSAGE, MSG_ID ...";
	my @msgs = @_		or croak "Usage: delete E2MESSAGE, MSG_ID ...";

	warn "E2::Message::delete\n"	if $DEBUG > 1;

	my %req = ( op => 'message' );

	foreach( @msgs ) { $req{"deletemsg_$_"} = 'yup' }

	return $self->process_request( %req );
}

sub perform {
	my $self = shift or croak "Usage: perform E2MESSAGE, HASH";
	my %ops = @_     or croak "Usage: perform E2MESSAGE, HASH";

	my %req = ( op => 'message' );

	foreach( keys %ops ) {
		if( lc($ops{$_}) eq 'delete' ) {
			$req{"deletemsg_$_"} = 'yup';
		} elsif( lc($ops{$_}) eq 'archive' ) {
			$req{"archive_$_"}   = 'yup';
		} elsif( lc($ops{$_}) eq 'unarchive' ) {
			$req{"unarchive_$_"} = 'yup';
		} else {
			croak "Invalid operation: $_";
		}
	}

	return $self->process_request( %req );
}

1;
__END__