POE::Filter::FSSocket - a POE filter that parses FreeSWITCH events into hashes

  #!/usr/bin/perl

  use warnings;
  use strict;

  use POE qw(Component::Client::TCP Filter::FSSocket);
  use Data::Dumper;

  POE::Component::Client::TCP->new(
          'RemoteAddress' => '127.0.0.1',
          'RemotePort'    => '8021',
          'ServerInput'   => \&handle_server_input,
          'Filter'        => 'POE::Filter::FSSocket',
  );

  POE::Kernel->run();
  exit;

  my $auth_sent = 0;
  my $password = "ClueCon";

  sub handle_server_input {
          my ($heap,$input) = @_[HEAP,ARG0];

          print Dumper $input;

  


          if($input->{'Content-Type'} eq "auth/request") {
                  $auth_sent = 1;
                  $heap->{'server'}->put("auth $password");
          } elsif ($input->{'Content-Type'} eq "command/reply") {
                  if($auth_sent == 1) {
                          $auth_sent = -1;

                          #do post auth stuff
                          $heap->{'server'}->put("events plain all");
                  }
          }
  }

  CUSTOM
  CHANNEL_CREATE
  CHANNEL_DESTROY
  CHANNEL_STATE
  CHANNEL_ANSWER
  CHANNEL_HANGUP
  CHANNEL_EXECUTE
  CHANNEL_BRIDGE
  CHANNEL_UNBRIDGE
  CHANNEL_PROGRESS
  CHANNEL_OUTGOING
  CHANNEL_PARK
  CHANNEL_UNPARK
  API
  LOG
  INBOUND_CHAN
  OUTBOUND_CHAN
  STARTUP
  SHUTDOWN
  PUBLISH
  UNPUBLISH
  TALK
  NOTALK
  SESSION_CRASH
  MODULE_LOAD
  DTMF
  MESSAGE
  CODEC
  BACKGROUND_JOB
  ALL

  auth/request
  command/response
  text/event-plain
  api/response (data in __DATA__ variable)
  log/data (data in __DATA__ variable)

package POE::Filter::FSSocket;

use warnings;
use strict;

use Carp qw(carp croak);
use vars qw($VERSION);
use base qw(POE::Filter);

$VERSION = '0.07';

use Data::Dumper;

#self array
sub FRAMING_BUFFER()   {0}
sub PARSER_STATE()     {1}
sub PARSER_STATENEXT() {2}
sub PARSED_RECORD()    {3}
sub CURRENT_LENGTH()   {4}
sub STRICT_PARSE()     {5}
sub DEBUG_LEVEL()      {6}

#states of the parser
sub STATE_WAITING()     {1} #looking for new input
sub STATE_CLEANUP()     {2} #wipe out record separators
sub STATE_GETDATA()     {3} #have header, get data
sub STATE_FLUSH()       {4} #puts us back in wait state and tells us to kill the parsed_record
sub STATE_TEXTRESPONSE() {5} #used for api output

sub new {
	my $class = shift;
	my %args = @_;

	my $strict = 0;
	my $debug  = 0;

	if(defined($args{'debug'})) {
		$debug = $args{'debug'};
	}

	if(defined($args{'strict'}) && $args{'strict'} == 1) {
		$strict = $args{'strict'};
	}

	my $self = bless [
		"",            #framing buffer
		STATE_WAITING, #PARSER_STATE
		undef,         #PARSER_STATE
		{},            #PARSED_RECORD
		0,             #length tracking (for Content-Length when needed)
		$strict,       #whether we should bail on a bad parse or try and save the session
		$debug,        #debug level
	], ref($class) || $class;

	return $self;
}


sub get_one_start {
	my ($self, $stream) = @_;

	#take all the chunks and put them in the buffer
	$self->[FRAMING_BUFFER] .= join('', @{$stream});
}

sub get_one {
	my $self = shift;

	my $line;

	while(1) {
		$line = "";

		#see if we are in line based or length based mode
		if($self->[PARSER_STATE] == STATE_TEXTRESPONSE) {
			my $length = $self->[PARSED_RECORD]{'Content-Length'};

			if($self->[FRAMING_BUFFER] =~ s/^(.{$length})//s) {
				$self->[PARSER_STATE] = STATE_FLUSH;
				$self->[PARSED_RECORD]->{'__DATA__'} = $1;
				return [ $self->[PARSED_RECORD] ];
			} else {
				#not engough in the buffer yet, come back later
				return;
			}
		} else { #we are in normal line based mode
			if($self->[FRAMING_BUFFER] =~ s/^(.*?)(\x0D\x0A?|\x0A\x0D?)//) {
				$line = $1;
			} else {
				#not enough off of the socket yet, come back later
				return [];
			}
		}
		
		if(($self->[PARSER_STATE] == STATE_WAITING) || ($self->[PARSER_STATE] == STATE_FLUSH)) {
			#see if we need to wipe out the parsed_record info
			if($self->[PARSER_STATE] == STATE_FLUSH) {
				delete $self->[PARSED_RECORD];
				$self->[CURRENT_LENGTH] = 0;

				$self->[PARSER_STATE] = STATE_WAITING;
			}

			if($line =~ /Content-Length:\ (\d+)$/) {
				#store the length
				$self->[PARSED_RECORD]{'Content-Length'} = $1;

				#see if we had a place to go from here (we should)
				if(defined($self->[PARSER_STATENEXT])) {
					$self->[PARSER_STATE] = $self->[PARSER_STATENEXT];
					$self->[PARSER_STATENEXT] = undef;
				}
			} elsif($line =~ /Content-Type:\ (.*)$/) {
				#store the type of request
				$self->[PARSED_RECORD]{'Content-Type'} = $1;

				if($1 eq "auth/request") {
					$self->[PARSER_STATE]     = STATE_CLEANUP;
					$self->[PARSER_STATENEXT] = STATE_FLUSH;
					return [ $self->[PARSED_RECORD] ];
				} elsif ($1 eq "command/reply") { #do something with this later
					$self->[PARSER_STATE] = STATE_GETDATA;
				} elsif ($1 eq "text/event-plain") {
					$self->[PARSER_STATE]     = STATE_CLEANUP;
					$self->[PARSER_STATENEXT] = STATE_GETDATA;
				} elsif ($1 eq "api/response") {
					$self->[PARSER_STATENEXT] = STATE_TEXTRESPONSE;
				} elsif ($1 eq "log/data") {
					$self->[PARSER_STATENEXT] = STATE_TEXTRESPONSE;
				} else { #unexpected input
					croak ref($self) . " unknown input [" . $self->[PARSER_STATE] . "] (" . $line . ")";
				}
			} else {
				#already in wait state, if we are not in strict, keep going
				if($self->[STRICT_PARSE]) {
					croak ref($self) . " unknown input [STATE_WAITING] (" . $line . ")";
				}
			}
		} elsif ($self->[PARSER_STATE] == STATE_CLEANUP) {
			if($line eq "") {
				if(defined($self->[PARSER_STATENEXT])) {
					$self->[PARSER_STATE] = $self->[PARSER_STATENEXT];
					$self->[PARSER_STATENEXT] = undef;
				} else {
					$self->[PARSER_STATE] = STATE_WAITING;
				}
			} else {
				#see if we should bail
				if($self->[STRICT_PARSE]) {
					croak ref($self) . " unknown input [STATE_CLEANUP] (" . $line . ")";
				} else {
					#we are not supposed to bail so try and save our session...
					#since we are think we should be cleaning up, flush it all away
					$self->[PARSER_STATE] = STATE_FLUSH;

					#parser fail should be considered critical, if any debug at all, print dump
					if($self->[DEBUG_LEVEL]) {
						print STDERR "Parse failed on ($line) in STATE_CLEANUP:\n";
						print STDERR Dumper $self->[PARSED_RECORD];
					}
				}
			}
		} elsif ($self->[PARSER_STATE] == STATE_GETDATA) {
			if($line =~ /^([^:]+):\ (.*)$/) {
				$self->[PARSED_RECORD]{$1} = $2;
			} elsif ($line eq "") { #end of event 
				$self->[PARSER_STATE] = STATE_FLUSH;

				return [ $self->[PARSED_RECORD] ];
			} else {
				if($self->[STRICT_PARSE]) {
					croak ref($self) . " unknown input [STATE_GETDATA] (" . $line . ")";
				} else {
					#flush and run
					$self->[PARSER_STATE] = STATE_FLUSH;

					#parser fail should be considered critical, if any debug at all, print dump
					if($self->[DEBUG_LEVEL]) {
						print STDERR "Parse failed on ($line) in STATE_GETDATA:\n";
						print STDERR Dumper $self->[PARSED_RECORD];
					}
				}
			}
		}
	}
}

sub put {
	my ($self, $lines)  = @_;

	my @row;
	foreach my $line (@$lines) {
		push @row, $line . "\n\n";
	}

	return \@row;
	
}

sub get_pending {
	my $self = shift;
	return $self->[FRAMING_BUFFER];
}

sub get {
	my ($self, $stream) = @_;
	my @return;

	$self->get_one_start($stream);
	while(1) {
		my $next = $self->get_one();
		last unless @$next;
		push @return, @$next;
	}

	return \@return;
}

1;