File Coverage

blib/lib/Parse/Colloquy/Bot.pm

Criterion	Covered	Total	%
statement	32	102	31.3
branch	14	32	43.7
condition	13	36	36.1
subroutine	8	9	88.8
pod	1	3	33.3
total	68	182	37.3

############################################################
#
#   $Id: Bot.pm 483 2006-05-22 21:36:46Z nicolaw $
#   Parse::Colloquy::Bot - Parse Colloquy bot/client terminal output
#
#   Copyright 2006 Nicola Worthington
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
#
############################################################

package Parse::Colloquy::Bot;
# vim:ts=4:sw=4:tw=78

use strict;
use Exporter;
use Carp qw(croak cluck confess carp);

use vars qw($VERSION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA);

$VERSION = '0.02' || sprintf('%d.%02d', q$Revision: 457 $ =~ /(\d+)/g);

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(parse_line);
%EXPORT_TAGS = (all => \@EXPORT_OK);

$DEBUG = $ENV{DEBUG} ? 1 : 0;

BEGIN {
	# It would be nice to have high resolution times if possible
	eval { require Time::HiRes; import Time::HiRes qw(time); };
}

sub parse_line {
	my @out = ();
	for my $input (@_) {
		push @out, _parse_line($input);
	}
	if (wantarray) {
		return @out;
	} else {
		return $out[0] if @out == 1;
		return \@out;
	}
}

sub _parse_line {
	local $_ = $_[0];
	s/[\n\r]//g;
	s/^\s+|\s+$//g;

	my $raw = $_;
	$_ = "RAW $_" if m/^\+\+\+/;
	return unless m/^([A-Z]+\S*)(?:\s+(.+))?$/;

	my %args = (
			"time"    => time(),
			"raw"     => $raw,
			"msgtype" => $1 || '',
			"text"    => $2 || '',
			"args"    => [ split(/\s+/,$_||'') ],
			"command" => undef,
			"cmdargs" => undef,
			"list"    => undef,
			"person"  => undef,
			"respond" => undef,
		);
	local $_ = $args{text};

	if ($args{msgtype} =~ /^TALK|TELL$/ && /^(\S+)\s+[:>](.*)\s*$/) {
		TRACE('TALK|TELL');
		$args{person}  = $1;
		$args{text}    = $2;
		$args{args}    = [ split(/\s+/,$args{text}) ];
		$args{cmdargs} = [ @{$args{args}} ];
		$args{command} = shift @{$args{cmdargs}};

	} elsif ($args{msgtype} eq 'LISTINVITE' && /((\S+)\s+invites\s+you\s+to\s+(\S+)\s+To\s+respond,\s+type\s+(.+))\s*$/) {
		TRACE('LISTINVITE');
		$args{text}    = $1;
		$args{person}  = $2;
		$args{list}    = $3;
		$args{respond} = $4;
		$args{args}    = [ split(/\s+/,$args{text}) ];

	} elsif ($args{msgtype} eq 'LISTTALK' && /^(\S+)\s*%(.*)\s+{(.+?)}\s*$/) {
		TRACE('LISTTALK');
		$args{person}  = $1;
		$args{text}    = $2;
		$args{args}    = [ split(/\s+/,$args{text}) ];
		$args{cmdargs} = [ @{$args{args}} ];
		$args{command} = shift @{$args{cmdargs}};
		$args{list}    = '%'.$3;

	} elsif ($args{msgtype} eq 'LISTEMOTE' && /^%\s*(\S+)\s+(.*)\s+{(.+?)}\s*$/) {
		TRACE('LISTEMOTE');
		$args{person}  = $1;
		$args{text}    = $2;
		$args{args}    = [ split(/\s+/,$args{text}) ];
		$args{list}    = '%'.$3;

	} elsif ($args{msgtype} eq 'OBSERVED' && /^(\S+)\s+(\S+)\s+(\S+)\s+\@(.+)\s+{(\@.+?)}\s*$/) {
		TRACE("OBSERVED $2 (a)");
		$args{group}   = $args{list} = '@'.$1;
		$args{msgtype} = "OBSERVED $2";
		$args{person}  = $3;
		$args{text}    = $4;
		$args{args}    = [ split(/\s+/,$args{text}) ];
		$args{cmdargs} = [ @{$args{args}} ];
		$args{command} = shift @{$args{cmdargs}};

	} elsif ($args{msgtype} eq 'OBSERVED' && /^(\S+)\s+(\S+)\s+(?:\@\s+)(\S+)\s+(.+)\s+{(\@.+?)}\s*$/) {
		TRACE("OBSERVED $2 (b)");
		$args{group}   = $args{list} = '@'.$1;
		$args{msgtype} = "OBSERVED $2";
		$args{person}  = $3;
		$args{text}    = $4;
		$args{args}    = [ split(/\s+/,$args{text}) ];

	} elsif ($args{msgtype} eq 'OBSERVED' && /^(\S+)\s+GROUPCHANGE\s+(\S+)\s+(.*)\s*$/) {
		TRACE('OBSERVED GROUPCHANGE');
		$args{group}   = $args{list} = '@'.$1;
		$args{msgtype} = 'OBSERVED GROUPCHANGE';
		$args{person}  = $2;
		$args{text}    = $3;
		$args{args}    = [ split(/\s+/,$args{text}) ];

	} elsif ($args{msgtype} eq 'SHOUT' && /^(\S+)\s+\!(.*)\s*$/) {
		TRACE('SHOUT');
		$args{person}  = $1;
		$args{text}    = $2;
		$args{args}    = [ split(/\s+/,$args{text}) ];

	} elsif ($args{msgtype} eq 'CONNECT' && /^((\S+).+\s+(\S+)\.)\s*$/) {
		TRACE('CONNECT');
		$args{text}    = $1;
		$args{person}  = $2;
		$args{group}   = $args{list} = '@'.$3;
		$args{args}    = [ split(/\s+/,$args{text}) ];

	} elsif ($args{msgtype} eq 'IDLE' && /^((\S+)(.*))\s*$/) {
		TRACE('IDLE');
		$args{text}    = $1;
		$args{person}  = $2;
		$args{args}    = [ split(/\s+/,$args{text}) ];
	}

	DUMP('%args',\%args);
	return \%args;
}

sub TRACE {
	return unless $DEBUG;
	warn(shift());
}

sub DUMP {
	return unless $DEBUG;
	eval {
		require Data::Dumper;
		warn(shift().': '.Data::Dumper::Dumper(shift()));
	}
}

1;

=pod

=head1 NAME

Parse::Colloquy::Bot - Parse Colloquy bot/client terminal output

=head1 SYNOPSIS

 use strict;
 use Parse::Colloquy::Bot qw(:all);
 use Data::Dumper;

 # ... connect to Colloquy and read from the server ...
 my $parsed = parse_line($raw_input);
 print Dumper($parsed);

=head1 DESCRIPTION

This module will parse the raw "client" or "bot" terminal line
output from a connection to a Colloquy server.

=head1 FUNCTIONS

=head2 parse_line

Accepts a single scalar input line or an array of input. Will
return a hash reference or array of hash references for each
input line, depending on the context that the function called.

=head1 EXAMPLE

The following input line from Colloquy:

 LISTTALK neech2      %hello my name is neech {perl}

Will be parsed in to the following structure:

 $VAR1 = {
          'raw' => 'LISTTALK neech2      %hello my name is neech {perl}',
          'msgtype' => 'LISTTALK',
          'person' => 'neech2',
          'list' => '%perl'
          'text' => 'hello my name is neech',
          'args' => [
                      'hello',
                      'my',
                      'name',
                      'is',
                      'neech'
                    ],
          'command' => 'hello',
          'cmdargs' => [
                         'my',
                         'name',
                         'is',
                         'neech'
                       ],
          'respond' => undef,
          'time' => 1148224087,
        };

=head1 SEE ALSO

L, L, L

=head1 VERSION

$Id: Bot.pm 483 2006-05-22 21:36:46Z nicolaw $

=head1 AUTHOR

Nicola Worthington

L

=head1 COPYRIGHT

Copyright 2006 Nicola Worthington.

This software is licensed under The Apache Software License, Version 2.0.

L

=cut


__END__