view release on metacpan or  search on metacpan

Amethyst/Connection/Anarres.pm  view on Meta::CPAN

package Amethyst::Connection::Anarres;

use strict;
use vars qw(@ISA);
use POE;
use Data::Dumper;
use Parse::Lex;
use Amethyst::Connection;
use Amethyst::Message;

@ISA = qw(Amethyst::Connection);

# Offsets into the IST_COMPUTER format for machine readable messages.
sub MS_CLASS	() { 0; }
sub MS_CONTENT	() { 1; }	# Might be removed
sub MS_FORMAT	() { 2; }
sub MS_SOURCE	() { 3; }
sub MS_ARGBASE	() { 4; }

# Token type and value, from Parse::Lex->analyze
sub MT_TYPE		() { 0; }
sub MT_VALUE	() { 1; }

sub unescape_string {
	my ($token, $string) = @_;

	$string =~ s/^"//;
	$string =~ s/"$//;
	$string =~ s/\\a/\a/g;
	$string =~ s/\\n/\n/g;
	$string =~ s/\\r/\r/g;
	$string =~ s/\\b/\b/g;
	$string =~ s/\\t/\t/g;
	$string =~ s/\\t/\t/g;
	# $string =~ s/\\v/\v/g;
	$string =~ s/\\\\/\\/g;
	$string =~ s/\\//g;

	return $string;
}

sub handler_init {
	my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];

	my @INTEGER = qw(INTEGER [0-9]+);
	my @OBJECT = ('OBJECT', '(?:/[^#:=]+)+(?:#[0-9]+)?(?:=[^:]+)?');
	my @STRING = ('STRING', [ '"', '(?s:[^"\\\\]+|\\\\.)*', '"', ], \&unescape_string);
	my @DTUPLE = qw(DTUPLE [a-z][a-z\.]+[a-z]);
	my @ERROR = ('ERROR', '(?s:.*)', sub { die "Can't analyse $_[1]";});

	my $clexer = new Parse::Lex(
	                @INTEGER,
					@OBJECT,
					@STRING,
					@DTUPLE,
					@ERROR  
						);
	$clexer->skip(':');

	$heap->{ConnectionLexer} = $clexer;

	$heap->{Keepalive} = 60;

	$session->register_state('mung', __PACKAGE__, 'handler_mung');
}