more clean up

git-svn-id: http://svn.freeswitch.org/svn/freeswitch/trunk@14001 d0543943-73ff-0310-b7d9-9358b9ac24b2

scripts/perl/FreeSWITCH/Client.pm

@@ -0,0 +1,305 @@
+package FreeSWITCH::Client;
+$|=1;
+use IO::Socket::INET;
+use IO::Select;
+use Data::Dumper;
+
+$VERSION = "1.0";
+
+sub init($;$) {
+  my $proto = shift;
+  my $args = shift;
+  my $class = ref($proto) || $proto;
+  $self->{_host} = $args->{-host} || "localhost";
+  $self->{_port} = $args->{-port} || 8021;
+  $self->{_password} = $args->{-password} || undef; 
+  $self->{_tolerant} = $args->{-tolerant} || undef;
+
+  $self->{events} = [];
+  my $me = bless $self,$class;
+  if (!$self->{_password}) {
+    return $me;
+  }
+  if ($me->connect()) {
+    return $me;
+  } else {
+    return undef;
+  }
+}
+
+sub readhash($;$) {
+  my ($self,$to) = @_;
+  my ($can_read) = IO::Select::select($self->{_sel}, undef, undef, $to);
+  my $s = shift @{$can_read};
+  my @r = ();
+  my $crc = 0;
+  my $h;
+
+  if ($s) {
+    for (;;) {
+      my $line;
+      for (;;) {
+	my $i = 0;
+	recv $s, $i, 1, 0;
+	if ($i eq "") {	  
+	  $h->{socketerror} = "yes";
+	  return $h;
+	} elsif ($i eq "\n") {
+	  $crc++;
+	  last;
+	} else {
+	  $crc = 0;
+	}
+	$line .= $i;      
+      }
+
+      if (!$line) {
+	last;
+      }
+      push @r, $line;
+    }
+    
+    if (!@r) {
+      return undef;
+    }
+
+    foreach(@r) {
+      my ($var, $val) = /^([^:]+):[\s\t]*(.*)$/;
+      $h->{lc $var} = $val;
+    }
+    
+    if ($h->{'content-length'}) {
+      if(! defined $h->{body}) { $h->{body} = ""; }
+      while(length($h->{body}) < $h->{'content-length'}) {
+	my $buf;
+	recv $s, $buf, $h->{'content-length'} - length($h->{body}), 0;
+	if ($buf eq '') {
+	  $h->{socketerror} = "yes";
+	  return $h;	  
+	}
+	$h->{body} .= $buf;
+      }
+    }
+
+    if ($h->{'content-type'} eq "text/event-plain") {
+      my $e = $self->extract_event($h);
+      $h->{has_event} = 1;
+      $h->{event} = $e;
+    }    
+  }
+    
+
+
+  return $h;
+
+}
+
+sub error($$) {
+  my($self,$error) = @_;
+
+  if ($self->{"_tolerant"}) {
+      print "[DIE CROAKED] $error\n";
+      return 0;
+  }
+  else {
+      die $error;
+  }
+}
+
+
+sub output($$) {
+  my ($self,$data) = @_;
+  my $s = $self->{_sock};
+
+  print $s $data ;
+}
+
+sub get_events($) {
+  my $self = shift;
+  my $e = $self->{events};
+  $self->{events} = [];
+  return $e;
+}
+
+sub sendmsg($$$) {
+  my $self = shift;
+  my $sendmsg = shift;
+  my $to = shift;
+  my $e;
+
+  for(;;) {
+    $e = $self->readhash(.1);
+    if ($e && !$e->{socketerror}) {
+      push @{$self->{events}}, $e;
+    } else  {
+      last;
+    }
+  }
+
+  $self->output($sendmsg->{command} . "\n");
+  foreach(keys %{$sendmsg}) {
+    next if ($_ eq "command");
+    $self->output("$_" . ": " . $sendmsg->{$_} . "\n");
+  }
+  $self->output("\n");
+
+  return $self->readhash($to);
+}
+
+sub command($$) {
+  my $self = shift;
+  my $reply;
+
+  my $r = $self->sendmsg({ 'command' => "api " . shift });
+
+  if ($r->{body} ne '') {
+    $reply = $r->{body};
+  } elsif ($r->{'reply-text'} ne '') {
+    $reply = $r->{'reply-text'};
+  } else {
+    $reply = "socketerror";
+  }
+
+  return $reply;
+}
+
+sub disconnect($) {
+  my $self = shift;
+  if ($self->{_sock}) {
+    $self->{_sock}->shutdown(2);
+    $self->{_sock}->close();
+  }
+  undef $self->{_sock};
+  delete $self->{_sock};
+}
+
+sub raw_command($) {
+  my $self = shift;
+  return $self->sendmsg({ 'command' => shift });
+}
+
+sub htdecode($;$) {
+  my $urlin = shift;
+  my $url = (ref $urlin) ? \$$urlin : \$urlin;
+  $$url =~ s/%([0-9A-Z]{2})/chr hex $1/ieg;
+  $$url;
+}
+
+
+sub extract_event($$) {
+  my $self = shift;
+  my $r = shift;
+
+
+  my %h = $r->{body} =~ /^([^:]+)\s*:\s*([^\n]*)/mg;
+
+  foreach (keys %h) {
+    my $new = lc $_;
+    if (!($new eq $_)) {
+      # do not delete keys that were already lowercase
+      $h{$new} = $h{$_};
+      delete $h{$_};
+    }
+  }
+  foreach(keys %h) {
+    htdecode(\$h{$_});
+  }
+  return \%h;
+}
+
+
+sub call_command($$$) {
+  my $self = shift;
+  my $app = shift;
+  my $arg = shift;
+
+  my $hash = {
+	      'command' => "sendmsg",
+	      'call-command' => "execute",
+	      'execute-app-name' => $app,
+	      'execute-app-arg' => $arg 
+	     };
+
+  return $self->sendmsg($hash);
+}
+
+sub unicast($$$$$$) {
+  my $self = shift;
+
+  my $hash = {
+	      'command' => "sendmsg",
+	      'call-command' => "unicast",
+	      'local_ip' => $_[0],
+	      'local_port' => $_[1],
+	      'remote_ip' => $_[2],
+	      'remote_port' => $_[3],
+	      'transport' => $_[4]
+	     };
+
+  return $self->sendmsg($hash);
+}
+
+sub call_data($) {
+  my $self = shift;
+
+  return $self->{call_data};
+}
+
+sub accept($;$$) {
+  my $self = shift;
+  my $ip = shift;
+  my $port = shift || 8084;
+
+  if (!$self->{_lsock}) {
+    $self->{_lsock} = IO::Socket::INET->new(Listen => 10000,
+					    LocalAddr => $ip,
+					    LocalPort => $port,
+					    Reuse => 1,
+					    Proto     => "tcp") or return $self->error("Cannot listen");
+
+  }
+  
+  $self->{_sock} = $self->{_lsock}->accept();
+  $self->{_sock}->autoflush(1);
+  $self->{_sel} = new IO::Select( $self->{_sock} );
+
+  $self->{call_data} = $self->sendmsg({ 'command' => "connect"});
+  foreach(keys %{$self->{call_data}}) {
+    htdecode(\$self->{call_data}->{$_});
+  }
+  if ($self->{call_data} =~ /socketerror/) {
+    return 0;
+  }
+
+  return 1;
+
+};
+
+sub connect($) {
+  my $self = shift;
+
+  $self->{_sock} = new IO::Socket::INET( Proto => 'tcp',
+					 PeerAddr => $self->{_host},
+					 PeerPort => $self->{_port}
+				       ) or return $self->error("Connection refused $self->{_host} port $self->{_port}");
+
+  $self->{_sock}->autoflush(1);
+  #$self->{_sock}->blocking(0);
+  $self->{_sel} = new IO::Select( $self->{_sock} );
+
+
+  my $h = $self->readhash(undef);
+
+  if ($h->{"content-type"} eq "auth/request") {
+    my $pass = $self->{"_password"};
+    $h = $self->sendmsg({command => "auth $pass"});
+  }
+
+  if ($h->{'reply-text'} =~ "OK") {
+    return 1;
+  }
+
+  return 0;
+}
+
+1;

scripts/perl/FreeSWITCH/Makefile.PL

@@ -0,0 +1,10 @@
+use ExtUtils::MakeMaker;
+require 5.008;
+WriteMakefile(
+	NAME => 'FreeSWITCH::Client',
+	VERSION_FROM => 'Client.pm',
+	PREREQ_PM => {
+		'IO::Socket::INET' => 1.16,
+		'IO::Select' => 1.16,
+	},
+);

scripts/perl/FreeSWITCH/debian/changelog

@@ -0,0 +1,6 @@
+libfreeswitch-client-perl (1.0-1) unstable; urgency=low
+
+  * New upstream release.
+
+ -- Massimo Cetra <devel@navynet.it>  Sat, 14 Jun 2008 17:38:34 +0200
+

scripts/perl/FreeSWITCH/debian/compat

@@ -0,0 +1 @@
+4

scripts/perl/FreeSWITCH/debian/control

@@ -0,0 +1,16 @@
+Source: libfreeswitch-client-perl
+Section: perl
+Priority: optional
+Build-Depends: debhelper (>= 5)
+Build-Depends-Indep: perl (>= 5.8.0-7), libmodule-install-perl,
+ libmodule-scandeps-perl (>= 0.51), libarchive-zip-perl,
+ libpar-dist-perl (>= 0.07), libdigest-sha1-perl, libmodule-signature-perl,
+ libgetopt-argvfile-perl (>= 1.06), gnupg, libinline-perl, libtest-pod-perl
+Maintainer: Massimo Cetra <devel@navynet.it>
+
+Package: libfreeswitch-client-perl
+Architecture: all
+Depends: ${perl:Depends}, ${misc:Depends}, libmodule-scandeps-perl (>=  0.51), libio-socket-ssl-perl (>= 0.97)
+Recommends: gnupg, libmodule-signature-perl, libpar-packer-perl
+Description: FreeSWITCH Client perl library
+    FreeSWITCH perl client library

scripts/perl/FreeSWITCH/debian/copyright

@@ -0,0 +1,12 @@
+This package was debianized by Massimo Cetra (CtRiX) <devel@navynet.it> on
+Sat, 14 Jun 2008 12:12:19 +0200.
+
+It was downloaded from: http://www.freeswitch.org/
+
+The upstream author is: ?
+
+Copyright 2008 by - ?
+
+This program is free software, you can redistribute it and/or modify it under
+the terms  ???.
+

scripts/perl/FreeSWITCH/debian/rules

@@ -0,0 +1,63 @@
+#!/usr/bin/make -f
+# This debian/rules file is provided as a template for normal perl
+# packages. It was created by Marc Brockschmidt <marc@dch-faq.de> for
+# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
+# be used freely wherever it is useful.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+# If set to a true value then MakeMaker's prompt function will
+# always return the default without waiting for user input.
+export PERL_MM_USE_DEFAULT=1
+
+PERL   ?= /usr/bin/perl
+PACKAGE = $(shell dh_listpackages)
+TMP     = $(CURDIR)/debian/$(PACKAGE)
+
+build: build-stamp
+build-stamp: $(QUILT_STAMPFN)
+	dh_testdir
+	$(PERL) Makefile.PL INSTALLDIRS=vendor
+	$(MAKE)
+	PERL_TEST_POD=1 $(MAKE) test
+	touch $@
+
+clean:
+	dh_testdir
+	dh_testroot
+	dh_clean build-stamp install-stamp
+	[ ! -f Makefile ] || $(MAKE) realclean
+
+install: install-stamp
+install-stamp: build-stamp
+	dh_testdir
+	dh_testroot
+	dh_clean -k
+	$(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
+	# lintian override for a long line with a hash
+	# dh_installdirs /usr/share/lintian/overrides/
+	#install -m 644 $(CURDIR)/debian/lintian-overrides $(TMP)/usr/share/lintian/overrides/$(PACKAGE)
+	#[ ! -d $(TMP)/usr/lib/perl5 ] || \
+	#	rmdir --ignore-fail-on-non-empty --parents --verbose \
+	#	$(TMP)/usr/lib/perl5
+	touch $@
+
+binary-arch:
+# We have nothing to do here for an architecture-independent package
+
+binary-indep: build install
+	dh_testdir
+	dh_testroot
+	dh_installdocs README
+	dh_installchangelogs ChangeLog
+	dh_perl
+	dh_compress
+	dh_fixperms
+	dh_installdeb
+	dh_gencontrol
+	dh_md5sums
+	dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install

scripts/perl/fs.pl

@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+use FreeSWITCH::Client;
+use Data::Dumper;
+use Term::ReadLine;
+my $password = "ClueCon";
+
+
+my $fs = init FreeSWITCH::Client {-password => $password} or die "Error $@";
+my $term = new Term::ReadLine "FreeSWITCH CLI";
+my $prompt = "FreeSWITCH>";
+my $OUT = $term->OUT .. \*STDOUT;
+my $pid;
+
+my $log = shift;
+
+$SIG{CHLD} = sub {$fs->disconnect(); die "done"};
+
+if ($log) {
+  $pid = fork;
+  if (!$pid) {
+    my $fs2 = init FreeSWITCH::Client {-password => $password} or die "Error $@";
+    
+
+    $fs2->sendmsg({ 'command' => "log $log" });
+    while (1) {
+      my $reply = $fs2->readhash(undef);
+      if ($reply->{socketerror}) {
+	die "socket error";
+      }
+      
+      if ($reply->{body}) {
+	print $reply->{body};
+      } 
+    }
+    exit;
+  }
+
+}
+
+while ( defined ($_ = $term->readline($prompt)) ) {
+  if ($_) {
+    if ($_ =~ /exit/) {
+      last;
+    }
+    my $reply = $fs->command($_);
+    if ($reply->{socketerror}) {
+      $fs2->disconnect();
+      die "socket error";
+    }
+    print "$reply\n";
+    
+  }
+  $term->addhistory($_) if /\S/;
+}
+  
+if ($pid) {
+  kill 9 => $pid;
+}

scripts/perl/fsconsole.pl

@@ -0,0 +1,369 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+sub POE::Kernel::ASSERT_DEFAULT () { 1 };
+sub Term::Visual::DEBUG () { 1 }
+sub Term::Visual::DEBUG_FILE () { 'test.log' }
+use IO::Socket;
+use POE qw/Filter::FSSocket Component::Client::TCP/;
+use Data::Dumper;
+use Term::Visual;
+
+
+local *D;
+if (Term::Visual::DEBUG) {
+    *D = *Term::Visual::ERRS;
+}
+
+#local *ERROR = *STDERR;
+
+
+$SIG{__DIE__} = sub {
+    if (Term::Visual::DEBUG) {
+        print Term::Visual::ERRS "Died: @_\n";
+    }
+};
+
+###############################################################################
+## BEGIN Globals ##############################################################
+###############################################################################
+our $server_address = "127.0.0.1";
+our $server_port    = "8021";
+our $server_secret  = "ClueCon";
+
+#this is where you can customize the color scheme
+our %Pallet = (
+	'warn_bullet' => 'bold yellow',
+	'err_bullet'  => 'bold red',
+	'out_bullet'  => 'bold green',
+	'access'      => 'bright red on blue',
+	'current'     => 'bright yellow on blue',
+);
+
+our $terminal;
+my %sockets;
+my %windows;
+my %unread_count;
+my %commands = (
+	'window' => 1,
+	'w'      => 1,
+	'win'    => 1,
+);
+###############################################################################
+##   END Globals ##############################################################
+###############################################################################
+
+#setup our session
+POE::Session->create(
+	'inline_states' => {
+		'_start'       => \&handle_start,        #session start
+		'_stop'        => \&handle_stop,         #session stop
+		'curses_input' => \&handle_curses_input, #input from the keyboard
+		'update_time'  => \&handle_update_time,  #update the status line clock
+		'quit'         => \&handle_quit,         #handler to do any cleanup
+		'server_input' => \&handle_server_input,
+		'_default'      => \&handle_default,
+	},
+	'heap' => {
+		'terminal'     => undef,
+		'freeswitch'   => undef,
+	},
+);
+
+#start the kernel a chugging along
+$poe_kernel->run;
+
+###############################################################################
+## BEGIN Handlers #############################################################
+###############################################################################
+#handles any startup functions for our session
+sub handle_default {
+}
+
+sub handle_start {
+	my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
+
+	#setup our terminal
+	 $heap->{'terminal'} = Term::Visual->new(
+		'Alias'        => 'terminal', #poe alias for this
+		'History_Size' => 300,        #number of things to keep in history
+		'Common_Input' => 1,          #all windows share input and history
+		'Tab_Complete' => \&tab_complete,
+	);
+
+	$terminal = $heap->{'terminal'};
+
+	#setup the color palette
+	$terminal->set_palette(%Pallet);
+
+	#create a base window
+	my $window_id = $terminal->create_window(
+		'Window_Name' => 'console',
+		'Buffer_Size' => 3000,
+		'Title'       => 'FreeSWITCH Console',
+		'Status'      => {
+			'0' => {
+				'format' => '%s',
+				'fields' => ['time'],
+			},
+			'1' => {
+				'format' => '%s',
+				'fields' => ['window_status'],
+			},
+		},
+	);
+
+	$windows{'console'} = $window_id;
+
+	$window_id = $terminal->create_window(
+		'Window_Name' => 'log',
+		'Buffer_Size' => 3000,
+		'Title'       => 'FreeSWITCH Logs',
+		'Status'      => {
+			'0' => {
+				'format' => '%s',
+				'fields' => ['time'],
+			},
+			'1' => {
+				'format' => '%s',
+				'fields' => ['window_status'],
+			},
+		},
+	);
+
+	$windows{'log'} = $window_id;
+
+	$window_id = $terminal->create_window(
+		'Window_Name' => 'event',
+		'Buffer_Size' => 3000,
+		'Title'       => 'FreeSWITCH Event',
+		'Status'      => {
+			'0' => {
+				'format' => '%s',
+				'fields' => ['time'],
+			},
+			'1' => {
+				'format' => '%s',
+				'fields' => ['window_status'],
+			},
+		},
+	);
+
+	$windows{'event'} = $window_id;
+
+	#tell the terminal what to call when there is input from the keyboard
+	$kernel->post('terminal' => 'send_me_input' => 'curses_input');
+
+	$terminal->change_window(0);
+	$kernel->delay_set('update_time' => 1);
+	$terminal->set_status_field(0, 'time' => scalar(localtime));
+	new_message('destination_window' => 0, 'message' =>  "
+Welcome to the FreeSWITCH POE Curses Console!
+  The console is split into three windows:
+    - 'console' for api response messages
+    - 'log'     for freeswitch log output (simply send the log level you want 
+                  to start seeing events eg: 'log all')
+    - 'event'   for freeswitch event output (must subscribe in plain format
+                  eg: 'event plain all')
+
+To switch between windows type 'w <windowname' so 'w log' for example.
+
+Coming soon:
+  - Tab completion
+  - command history
+  - window status in the bar (messages added since last view, etc...)
+
+Send any bug reports or comments to jackhammer\@gmail.com
+
+Thanks,
+Paul\n");
+
+	$terminal->set_status_field($terminal->current_window, 'window_status' => format_window_status());
+
+	#connect to freeswitch
+	$heap->{'freeswitch'} = POE::Component::Client::TCP->new(
+		'RemoteAddress' => $server_address,
+		'RemotePort'    => $server_port,
+		'ServerInput'   => \&handle_server_input,
+		'Connected'     => \&handle_fs_connected,
+		'ServerError'   => \&handle_server_error,
+		'Disconnected'  => \&handle_server_disconnect,
+		'Domain'        => AF_INET,
+		'Filter'       => POE::Filter::FSSocket->new(),
+	);
+
+}
+
+#called when users enter commands in a window
+sub handle_curses_input {
+	my ($kernel, $heap, $input, $context) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+	#get the id of the window that is responsible for the input
+	my $window = $heap->{'terminal'}->current_window;
+
+	open(ERROR, ">>error.log");
+
+	if($input eq "quit") {
+		$kernel->yield('quit');
+	} elsif ($input =~ /^w\ (.*)$/) {
+		#get the id of the requested window
+		eval {
+			my $window_id = $windows{$1};
+
+			#see if it's real
+			if(defined($window_id)) {
+				$unread_count{$window_id} = 0;
+				$terminal->change_window($window_id);
+				$terminal->set_status_field($window_id, 'window_status' => &format_window_status());
+			}
+		};
+		if($@) {
+			print ERROR "put error: $@\n";
+		}
+	} else {
+		#see if we got connected at some point
+		if(defined($sockets{'localhost'})) {
+		  my $cmd;
+		  if ($input =~ /^log|^event/) {
+		    $cmd = $input;
+		  } else {
+		    $cmd = "api $input";
+		  }
+		  #send the command
+		  $sockets{'localhost'}->put($cmd);
+		}
+	}
+}
+
+sub handle_fs_connected {
+	my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+	eval {
+		$sockets{'localhost'} = $heap->{'server'};
+	}
+}
+
+#this is responsible for doing any cleanup and returning the terminal to the previous
+#state before we mucked with it
+sub handle_quit {
+	my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+	#tell curses to clean up it's crap
+	$kernel->post('terminal' => 'shutdown');
+
+	#there is probably a more elegant way, but this works for now
+	exit;
+}
+
+#data from freeswitch
+sub handle_server_input {
+        my ($kernel,$heap,$input) = @_[KERNEL,HEAP,ARG0];
+
+	eval {
+		#terminal HATES null
+		if(defined($input->{'__DATA__'})) {
+			$input->{'__DATA__'} =~ s/[\x00]//g;
+		}
+
+		#handle the login
+		if($input->{'Content-Type'} eq "auth/request") {
+			$heap->{'server'}->put("auth $server_secret");
+		} elsif ($input->{'Content-Type'} eq "api/response") {
+			new_message('destination_window' => 0, 'message' => 'API Response: ');
+			new_message('destination_window' => 0, 'message' => $input->{'__DATA__'});
+		} elsif ($input->{'Content-Type'} eq "log/data") {
+			new_message('destination_window' => 1, 'message' => $input->{'__DATA__'});
+		} elsif ($input->{'Content-Type'} eq "text/event-plain") {
+			new_message('destination_window' => 2, 'message' => Dumper $input);
+		} elsif ($input->{'Content-Type'} eq "command/reply") {
+			new_message('destination_window' => 0, 'message' => 'Command Response: ' . $input->{'Reply-Text'});
+		}
+	};
+
+	if($@) {
+		open(ERROR, ">>error.log");
+		print ERROR "died: $@\n";
+		print ERROR Dumper $heap;
+		close(ERROR);
+	}
+}
+
+sub handle_server_error {
+}
+
+sub handle_server_disconnect {
+}
+
+sub tab_complete {
+	my $left = shift;
+
+	my @return;
+
+	if(defined($commands{$left})) {
+		return [$left . " "];
+	#} elsif () {
+	}
+		
+}
+
+sub handle_update_time {
+	my ($kernel, $heap) = @_[KERNEL, HEAP];
+	$terminal->set_status_field($terminal->current_window, 'time' => scalar(localtime));
+	$kernel->delay_set('update_time' => 1);
+}
+###############################################################################
+##   END Handlers #############################################################
+###############################################################################
+
+sub new_message {
+	my %args = @_;
+
+	my $message            = $args{'message'};
+	my $destination_window = $args{'destination_window'};
+
+	my $status_field;
+
+	#see if we are on the window being updated
+	if($terminal->current_window != $destination_window) {
+		#increment the unread count for the window
+		#FIXME, should we count messages or lines?
+		$unread_count{$destination_window}++;
+
+
+		#update the status bar
+		eval {
+			$terminal->set_status_field($terminal->current_window, 'window_status' => &format_window_status());
+		};
+
+		if($@) {
+			print $@;
+		}
+	}
+
+
+	#deliver the message
+	$terminal->print($destination_window, $message);
+}
+
+sub format_window_status {
+	my $status_field;
+
+	#put all the windows in the bar with their current unread count
+	foreach my $window (sort {$windows{$a} <=> $windows{$b}} keys %windows) {
+		#see if we are printing the current window
+		if($terminal->current_window == $windows{$window}) {
+			$status_field .= "[\0(current)$window\0(st_frames)";
+		} else {
+			$status_field .= "[$window";
+		}
+
+		if($unread_count{$windows{$window}}) {
+			$status_field .= " (" . $unread_count{$windows{$window}} . ")";
+		}
+
+		$status_field .= "] ";
+	}
+
+	return $status_field;
+}

scripts/perl/sock.pl

@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+use FreeSWITCH::Client;
+use Data::Dumper;
+
+my $fs = init FreeSWITCH::Client {} or die "Error $@";
+my $pid;
+
+for (;;) {
+  $fs->accept();
+
+  if (!($pid = fork)) {
+    last;
+  }
+}
+
+my $data = $fs->call_data();
+
+#print Dumper $data
+print "Call: $data->{'caller-channel-name'} $data->{'unique-id'}\n";
+
+
+$o = $fs->call_command("answer");
+#to turn on events when in async mode
+$o = $fs->raw_command("myevents");
+$o = $fs->call_command("playback", "/ram/swimp.raw");
+
+
+#comment exit in async mode
+#exit;
+
+while(my $r = $fs->readhash(undef)) {
+  if ($r->{socketerror}) {
+    last;
+  }
+
+  if ($r->{has_event}) {
+    print Dumper $r->{event};
+  }
+  if ($r->{event}->{'event-name'} !~ /execute/i) {
+    printf "uuid: $data->{'unique-id'}\n";
+    $o = $fs->call_command("break");
+    $o = $fs->call_command("hangup");
+  }
+}
+
+$fs->disconnect();
+print "done\n";
+
+