]> git.ipfire.org Git - thirdparty/freeswitch.git/commitdiff
add mod_perl
authorAnthony Minessale <anthony.minessale@gmail.com>
Fri, 3 Mar 2006 16:57:21 +0000 (16:57 +0000)
committerAnthony Minessale <anthony.minessale@gmail.com>
Fri, 3 Mar 2006 16:57:21 +0000 (16:57 +0000)
git-svn-id: http://svn.freeswitch.org/svn/freeswitch/trunk@740 d0543943-73ff-0310-b7d9-9358b9ac24b2

src/include/switch_channel.h
src/include/switch_core.h
src/mod/applications/mod_skel/mod_skel.c
src/mod/languages/mod_perl/Makefile [new file with mode: 0644]
src/mod/languages/mod_perl/freeswitch.pm [new file with mode: 0644]
src/mod/languages/mod_perl/fs_perl.pm [new file with mode: 0644]
src/mod/languages/mod_perl/mod_perl.c [new file with mode: 0644]
src/mod/languages/mod_perl/switch_swig.c [new file with mode: 0644]
src/mod/languages/mod_perl/switch_swig_wrap.c [new file with mode: 0644]
src/switch_channel.c
src/switch_core.c

index 008b39a112671a21e8d564182034b09336b23e86..272eeb1ce1c94e6c9c53f9e49ff9c181ff961dec 100644 (file)
@@ -219,6 +219,13 @@ SWITCH_DECLARE(switch_status) switch_channel_clear_flag(switch_channel *channel,
 */
 SWITCH_DECLARE(switch_status) switch_channel_answer(switch_channel *channel);
 
+/*!
+  \brief Indicate progress on a channel to attempt early media
+  \param channel channel to pre-answer
+  \return SWITCH_STATUS_SUCCESS
+*/
+SWITCH_DECLARE(switch_status) switch_channel_pre_answer(switch_channel *channel);
+
 /*!
   \brief add a state handler table to a given channel
   \param channel channel on which to add the state handler table
index 35ec99a5e2c77bf7e3a2a81721ceca6c4c5f946f..ec8d6d3c8a1941ecb696d7b23b13ef10ed358627 100644 (file)
@@ -271,6 +271,13 @@ SWITCH_DECLARE(void) switch_core_session_signal_state_change(switch_core_session
 */
 SWITCH_DECLARE(char *) switch_core_session_get_uuid(switch_core_session *session);
 
+/*! 
+  \brief Locate a session based on it's uuiid
+  \param uuid_str the unique id of the session you want to find
+  \return the session or NULL
+*/
+SWITCH_DECLARE(switch_core_session *) switch_core_session_locate(char *uuid_str);
+
 /*! 
   \brief Send a message to another session using it's uuid
   \param uuid_str the unique id of the session you want to send a message to
@@ -921,14 +928,6 @@ SWITCH_DECLARE(void) switch_core_launch_thread(void *(*func)(switch_thread *, vo
 SWITCH_DECLARE(void) switch_core_set_globals(void);
 ///\}
 
-#ifdef USE_PERL
-/*! 
-  \brief Execute some perl when compiled with perl support
-  \return SWITCH_STATUS_SUCCESS on success
-*/
-SWITCH_DECLARE(switch_status) switch_core_do_perl(char *txt);
-#endif 
-
 /*!
   \}
 */
index 0bd9aa6b032d4e9d20fe520283ae0628ed172829..e99f238d03b5f787df474e4f94e38a378a2101e3 100644 (file)
@@ -46,7 +46,7 @@ static switch_loadable_module_interface skel_module_interface = {
        /*.directory_interface */ NULL
 };
 
-switch_status switch_module_load(const switch_loadable_module_interface **interface, char *filename)
+SWITCH_MOD_DECLARE(switch_status) switch_module_load(const switch_loadable_module_interface **interface, char *filename)
 {
        /* connect my internal structure to the blank pointer passed to me */
        *interface = &skel_module_interface;
@@ -56,3 +56,19 @@ switch_status switch_module_load(const switch_loadable_module_interface **interf
        /* indicate that the module should continue to be loaded */
        return SWITCH_STATUS_SUCCESS;
 }
+
+/*
+  Called when the system shuts down
+  SWITCH_MOD_DECLARE(switch_status) switch_module_shutdown(void)
+  {
+  return SWITCH_STATUS_SUCCESS;
+  }
+*/
+
+/*
+  If it exists, this is called in it's own thread when the module-load completes
+  SWITCH_MOD_DECLARE(switch_status) switch_module_shutdown(void)
+  {
+  return SWITCH_STATUS_SUCCESS;
+  }
+*/
diff --git a/src/mod/languages/mod_perl/Makefile b/src/mod/languages/mod_perl/Makefile
new file mode 100644 (file)
index 0000000..5675583
--- /dev/null
@@ -0,0 +1,46 @@
+PERL        =/usr/local/bin/perl
+PERL_LIBDIR =-L$(shell perl -MConfig -e 'print $$Config{archlib}')/CORE
+PERL_LIBS   =$(shell perl -MConfig -e 'print $$Config{libs}')
+CFLAGS  +=  -DMULTIPLICITY $(shell $(PERL) -MExtUtils::Embed -e ccopts)
+CFLAGS  += -DEMBED_PERL
+LDFLAGS +=  $(shell $(PERL) -MExtUtils::Embed -e ldopts)
+LDFLAGS +=  $(shell $(PERL) -MConfig -e 'print $$Config{libs}')  
+OBJS += perlxsi.o
+
+all:   depends $(MODNAME).so fs_perl.so
+
+.perlok:
+       @(${PERL} -V | grep -i usemultiplicity=define >/dev/null && echo Phew, You have the right perl.) \
+       || ((echo Sorry, you need to compile perl with threads and multiplicity.&& exit 1))
+       @touch .perlok
+
+perlxsi.c: .perlok
+       perl -MExtUtils::Embed -e xsinit
+
+depends: perlxsi.c
+
+%.o:  %.c
+       $(CC) $(CFLAGS) -fPIC -c $< -o $@
+
+reswig: 
+       rm switch_swig_wrap.c
+       swig -DMULTIPLICITY -perl5 -module fs_perl switch_swig.c
+
+switch_swig_wrap.o: switch_swig_wrap.c
+       $(CC) -w $(CFLAGS) -fPIC -c $< -o $@
+
+
+fs_perl.so: $(MODNAME).so switch_swig_wrap.o switch_swig.o perlxsi.o
+       $(CC) $(SOLINK) -o fs_perl.so switch_swig_wrap.o switch_swig.o perlxsi.o $(LDFLAGS)
+
+
+$(MODNAME).so: $(MODNAME).c $(MODNAME).o $(OBJS)
+       $(CC) $(SOLINK) -o $(MODNAME).so  $(MODNAME).o $(OBJS) $(LDFLAGS)
+
+clean:
+       rm -fr *.so *.o *~ perlxsi.c .perlok
+
+install:
+       mkdir -p $(PREFIX)/perl
+       cp -f $(MODNAME).so $(PREFIX)/mod
+       cp -f fs_perl.so fs_perl.pm $(PREFIX)/perl
diff --git a/src/mod/languages/mod_perl/freeswitch.pm b/src/mod/languages/mod_perl/freeswitch.pm
new file mode 100644 (file)
index 0000000..784cf29
--- /dev/null
@@ -0,0 +1,11 @@
+package fs_perl;
+use Data::Dumper;
+
+sub wazzup() {
+  fs_console_log("WOOHOO!\n");
+  $session = fs_core_session_locate($SWITCH_ENV{UUID});
+  fs_channel_answer($session);
+  fs_ivr_play_file($session, "/root/siriusraw.raw", "");
+}
+
+1;
diff --git a/src/mod/languages/mod_perl/fs_perl.pm b/src/mod/languages/mod_perl/fs_perl.pm
new file mode 100644 (file)
index 0000000..1bc4288
--- /dev/null
@@ -0,0 +1,63 @@
+# This file was automatically generated by SWIG
+package fs_perl;
+require Exporter;
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+package fs_perlc;
+bootstrap fs_perl;
+package fs_perl;
+@EXPORT = qw( );
+
+# ---------- BASE METHODS -------------
+
+package fs_perl;
+
+sub TIEHASH {
+    my ($classname,$obj) = @_;
+    return bless $obj, $classname;
+}
+
+sub CLEAR { }
+
+sub FIRSTKEY { }
+
+sub NEXTKEY { }
+
+sub FETCH {
+    my ($self,$field) = @_;
+    my $member_func = "swig_${field}_get";
+    $self->$member_func();
+}
+
+sub STORE {
+    my ($self,$field,$newval) = @_;
+    my $member_func = "swig_${field}_set";
+    $self->$member_func($newval);
+}
+
+sub this {
+    my $ptr = shift;
+    return tied(%$ptr);
+}
+
+
+# ------- FUNCTION WRAPPERS --------
+
+package fs_perl;
+
+*fs_console_log = *fs_perlc::fs_console_log;
+*fs_console_clean = *fs_perlc::fs_console_clean;
+*fs_core_session_locate = *fs_perlc::fs_core_session_locate;
+*fs_channel_answer = *fs_perlc::fs_channel_answer;
+*fs_channel_pre_answer = *fs_perlc::fs_channel_pre_answer;
+*fs_channel_hangup = *fs_perlc::fs_channel_hangup;
+*fs_channel_set_variable = *fs_perlc::fs_channel_set_variable;
+*fs_channel_get_variable = *fs_perlc::fs_channel_get_variable;
+*fs_channel_set_state = *fs_perlc::fs_channel_set_state;
+*fs_ivr_play_file = *fs_perlc::fs_ivr_play_file;
+
+# ------- VARIABLE STUBS --------
+
+package fs_perl;
+
+1;
diff --git a/src/mod/languages/mod_perl/mod_perl.c b/src/mod/languages/mod_perl/mod_perl.c
new file mode 100644 (file)
index 0000000..f3c2d07
--- /dev/null
@@ -0,0 +1,132 @@
+/* 
+ * FreeSWITCH Modular Media Switching Software Library / Soft-Switch Application
+ * Copyright (C) 2005/2006, Anthony Minessale II <anthmct@yahoo.com>
+ *
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (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.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is FreeSWITCH Modular Media Switching Software Library / Soft-Switch Application
+ *
+ * The Initial Developer of the Original Code is
+ * Anthony Minessale II <anthmct@yahoo.com>
+ * Portions created by the Initial Developer are Copyright (C)
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ * 
+ * Anthony Minessale II <anthmct@yahoo.com>
+ *
+ *
+ * mod_perl.c -- Perl
+ *
+ */
+#include <switch.h>
+#include <EXTERN.h>
+#include <perl.h>
+static char *embedding[] = { "", "-e", "" };
+EXTERN_C void xs_init(pTHX);
+
+static const char modname[] = "mod_perl";
+
+static struct {
+       PerlInterpreter *my_perl;
+} globals;
+
+
+static void destroy_perl(PerlInterpreter **to_destroy)
+{
+       perl_destruct(*to_destroy);
+       perl_free(*to_destroy);
+       *to_destroy = NULL;
+}
+
+static PerlInterpreter *clone_perl(void)
+{
+       return perl_clone(globals.my_perl, CLONEf_COPY_STACKS|CLONEf_KEEP_PTR_TABLE);
+}
+
+
+static void perl_function(switch_core_session *session, char *data)
+{
+       char *uuid = switch_core_session_get_uuid(session);
+       char code[1024];
+       PerlInterpreter *my_perl = clone_perl();
+       sprintf(code, "package fs_perl;\n"
+                       "$SWITCH_ENV{UUID} = \"%s\";\n"
+                       "chdir(\"%s/perl\");\n",
+                       uuid, SWITCH_GLOBAL_dirs.base_dir);
+
+       Perl_eval_pv(my_perl, code, TRUE);
+
+
+       Perl_eval_pv(my_perl, data, TRUE);
+       destroy_perl(&my_perl);
+}
+
+static const switch_application_interface perl_application_interface = {
+       /*.interface_name */ "perl",
+       /*.application_function */ perl_function
+};
+
+static switch_loadable_module_interface perl_module_interface = {
+       /*.module_name */ modname,
+       /*.endpoint_interface */ NULL,
+       /*.timer_interface */ NULL,
+       /*.dialplan_interface */ NULL,
+       /*.codec_interface */ NULL,
+       /*.application_interface */ &perl_application_interface,
+       /*.api_interface */ NULL,
+       /*.file_interface */ NULL,
+       /*.speech_interface */ NULL,
+       /*.directory_interface */ NULL
+};
+
+
+SWITCH_MOD_DECLARE(switch_status) switch_module_shutdown(void) 
+{
+       if (globals.my_perl) {
+               perl_destruct(globals.my_perl);
+               perl_free(globals.my_perl);
+               globals.my_perl = NULL;
+               switch_console_printf(SWITCH_CHANNEL_CONSOLE, "Unallocated perl interpreter.\n");
+       }
+       return SWITCH_STATUS_SUCCESS;
+}
+
+SWITCH_MOD_DECLARE(switch_status) switch_module_load(const switch_loadable_module_interface **interface, char *filename)
+{
+
+       PerlInterpreter *my_perl;
+       char code[1024];
+       
+       if (!(my_perl = perl_alloc())) {
+               switch_console_printf(SWITCH_CHANNEL_CONSOLE, "Could not allocate perl intrepreter\n");
+               switch_core_destroy();
+               return SWITCH_STATUS_MEMERR;
+       }
+       switch_console_printf(SWITCH_CHANNEL_CONSOLE, "Allocated perl intrepreter.\n");
+
+       PERL_SET_CONTEXT(my_perl);
+       perl_construct(my_perl);
+       perl_parse(my_perl, xs_init, 3, embedding, NULL);
+       perl_run(my_perl);
+       globals.my_perl = my_perl;
+       sprintf(code, "use lib '%s/perl';use fs_perl;use freeswitch\n", SWITCH_GLOBAL_dirs.base_dir);
+    Perl_eval_pv(my_perl, code, TRUE);
+
+
+       /* connect my internal structure to the blank pointer passed to me */
+       *interface = &perl_module_interface;
+
+       /* indicate that the module should continue to be loaded */
+       return SWITCH_STATUS_SUCCESS;
+}
diff --git a/src/mod/languages/mod_perl/switch_swig.c b/src/mod/languages/mod_perl/switch_swig.c
new file mode 100644 (file)
index 0000000..f57c73a
--- /dev/null
@@ -0,0 +1,68 @@
+#include <switch.h>
+
+void fs_console_log(char *msg)
+{
+       switch_console_printf(SWITCH_CHANNEL_CONSOLE, msg);
+}
+
+void fs_console_clean(char *msg)
+{
+       switch_console_printf(SWITCH_CHANNEL_CONSOLE_CLEAN, msg);
+}
+
+struct switch_core_session *fs_core_session_locate(char *uuid)
+{
+       return switch_core_session_locate(uuid);
+}
+
+void fs_channel_answer(struct switch_core_session *session)
+{
+       switch_channel *channel = switch_core_session_get_channel(session);
+       switch_channel_answer(channel);
+}
+
+void fs_channel_pre_answer(struct switch_core_session *session)
+{
+       switch_channel *channel = switch_core_session_get_channel(session);
+       switch_channel_pre_answer(channel);
+}
+
+void fs_channel_hangup(struct switch_core_session *session)
+{
+       switch_channel *channel = switch_core_session_get_channel(session);
+       switch_channel_hangup(channel);
+}
+
+void fs_channel_set_variable(struct switch_core_session *session, char *var, char *val)
+{
+       switch_channel *channel = switch_core_session_get_channel(session);
+       switch_channel_set_variable(channel, var, val);
+}
+
+void fs_channel_get_variable(struct switch_core_session *session, char *var)
+{
+       switch_channel *channel = switch_core_session_get_channel(session);
+       switch_channel_get_variable(channel, var);
+}
+
+void fs_channel_set_state(struct switch_core_session *session, char *state)
+{
+       switch_channel *channel = switch_core_session_get_channel(session);
+       switch_channel_state fs_state = switch_channel_get_state(channel);
+
+       if (!strcmp(state, "EXECUTE")) {
+               fs_state = CS_EXECUTE;
+       } else  if (!strcmp(state, "TRANSMIT")) {
+               fs_state = CS_TRANSMIT;
+       }
+       
+       switch_channel_set_state(channel, fs_state);
+}
+
+int fs_ivr_play_file(struct switch_core_session *session, char *file, char *timer_name_in) 
+{
+       char *timer_name = switch_strlen_zero(timer_name_in) ? NULL : timer_name;
+       switch_status status = switch_ivr_play_file(session, NULL, file, timer_name, NULL, NULL, 0);
+       return status == SWITCH_STATUS_SUCCESS ? 1 : 0;
+}
+
diff --git a/src/mod/languages/mod_perl/switch_swig_wrap.c b/src/mod/languages/mod_perl/switch_swig_wrap.c
new file mode 100644 (file)
index 0000000..fc2c2dd
--- /dev/null
@@ -0,0 +1,1556 @@
+/* ----------------------------------------------------------------------------
+ * This file was automatically generated by SWIG (http://www.swig.org).
+ * Version 1.3.26
+ * 
+ * This file is not intended to be easily readable and contains a number of 
+ * coding conventions designed to improve portability and efficiency. Do not make
+ * changes to this file unless you know what you are doing--modify the SWIG 
+ * interface file instead. 
+ * ----------------------------------------------------------------------------- */
+
+/***********************************************************************
+ *
+ *  This section contains generic SWIG labels for method/variable
+ *  declarations/attributes, and other compiler dependent labels.
+ *
+ ************************************************************************/
+
+/* template workaround for compilers that cannot correctly implement the C++ standard */
+#ifndef SWIGTEMPLATEDISAMBIGUATOR
+#  if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560)
+#    define SWIGTEMPLATEDISAMBIGUATOR template
+#  else
+#    define SWIGTEMPLATEDISAMBIGUATOR 
+#  endif
+#endif
+
+/* inline attribute */
+#ifndef SWIGINLINE
+# if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__))
+#   define SWIGINLINE inline
+# else
+#   define SWIGINLINE
+# endif
+#endif
+
+/* attribute recognised by some compilers to avoid 'unused' warnings */
+#ifndef SWIGUNUSED
+# if defined(__GNUC__) || defined(__ICC)
+#   define SWIGUNUSED __attribute__ ((unused)) 
+# else
+#   define SWIGUNUSED 
+# endif
+#endif
+
+/* internal SWIG method */
+#ifndef SWIGINTERN
+# define SWIGINTERN static SWIGUNUSED
+#endif
+
+/* internal inline SWIG method */
+#ifndef SWIGINTERNINLINE
+# define SWIGINTERNINLINE SWIGINTERN SWIGINLINE
+#endif
+
+/* exporting methods for Windows DLLs */
+#ifndef SWIGEXPORT
+# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__)
+#   if defined(STATIC_LINKED)
+#     define SWIGEXPORT
+#   else
+#     define SWIGEXPORT __declspec(dllexport)
+#   endif
+# else
+#   define SWIGEXPORT
+# endif
+#endif
+
+/* calling conventions for Windows */
+#ifndef SWIGSTDCALL
+# if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__)
+#   define SWIGSTDCALL __stdcall
+# else
+#   define SWIGSTDCALL
+# endif 
+#endif
+
+
+/***********************************************************************
+ * swigrun.swg
+ *
+ *     This file contains generic CAPI SWIG runtime support for pointer
+ *     type checking.
+ *
+ ************************************************************************/
+
+/* This should only be incremented when either the layout of swig_type_info changes,
+   or for whatever reason, the runtime changes incompatibly */
+#define SWIG_RUNTIME_VERSION "2"
+
+/* define SWIG_TYPE_TABLE_NAME as "SWIG_TYPE_TABLE" */
+#ifdef SWIG_TYPE_TABLE
+# define SWIG_QUOTE_STRING(x) #x
+# define SWIG_EXPAND_AND_QUOTE_STRING(x) SWIG_QUOTE_STRING(x)
+# define SWIG_TYPE_TABLE_NAME SWIG_EXPAND_AND_QUOTE_STRING(SWIG_TYPE_TABLE)
+#else
+# define SWIG_TYPE_TABLE_NAME
+#endif
+
+/*
+  You can use the SWIGRUNTIME and SWIGRUNTIMEINLINE macros for
+  creating a static or dynamic library from the swig runtime code.
+  In 99.9% of the cases, swig just needs to declare them as 'static'.
+  
+  But only do this if is strictly necessary, ie, if you have problems
+  with your compiler or so.
+*/
+
+#ifndef SWIGRUNTIME
+# define SWIGRUNTIME SWIGINTERN
+#endif
+
+#ifndef SWIGRUNTIMEINLINE
+# define SWIGRUNTIMEINLINE SWIGRUNTIME SWIGINLINE
+#endif
+
+#include <string.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+typedef void *(*swig_converter_func)(void *);
+typedef struct swig_type_info *(*swig_dycast_func)(void **);
+
+/* Structure to store inforomation on one type */
+typedef struct swig_type_info {
+  const char             *name;                        /* mangled name of this type */
+  const char             *str;                 /* human readable name of this type */
+  swig_dycast_func        dcast;               /* dynamic cast function down a hierarchy */
+  struct swig_cast_info  *cast;                        /* linked list of types that can cast into this type */
+  void                   *clientdata;          /* language specific type data */
+} swig_type_info;
+
+/* Structure to store a type and conversion function used for casting */
+typedef struct swig_cast_info {
+  swig_type_info         *type;                        /* pointer to type that is equivalent to this type */
+  swig_converter_func     converter;           /* function to cast the void pointers */
+  struct swig_cast_info  *next;                        /* pointer to next cast in linked list */
+  struct swig_cast_info  *prev;                        /* pointer to the previous cast */
+} swig_cast_info;
+
+/* Structure used to store module information
+ * Each module generates one structure like this, and the runtime collects
+ * all of these structures and stores them in a circularly linked list.*/
+typedef struct swig_module_info {
+  swig_type_info         **types;              /* Array of pointers to swig_type_info structures that are in this module */
+  size_t                 size;                 /* Number of types in this module */
+  struct swig_module_info *next;               /* Pointer to next element in circularly linked list */
+  swig_type_info         **type_initial;       /* Array of initially generated type structures */
+  swig_cast_info         **cast_initial;       /* Array of initially generated casting structures */
+  void                    *clientdata;         /* Language specific module data */
+} swig_module_info;
+
+
+/* 
+  Compare two type names skipping the space characters, therefore
+  "char*" == "char *" and "Class<int>" == "Class<int >", etc.
+
+  Return 0 when the two name types are equivalent, as in
+  strncmp, but skipping ' '.
+*/
+SWIGRUNTIME int
+SWIG_TypeNameComp(const char *f1, const char *l1,
+                 const char *f2, const char *l2) {
+  for (;(f1 != l1) && (f2 != l2); ++f1, ++f2) {
+    while ((*f1 == ' ') && (f1 != l1)) ++f1;
+    while ((*f2 == ' ') && (f2 != l2)) ++f2;
+    if (*f1 != *f2) return (int)(*f1 - *f2);
+  }
+  return (l1 - f1) - (l2 - f2);
+}
+
+/*
+  Check type equivalence in a name list like <name1>|<name2>|...
+  Return 0 if not equal, 1 if equal
+*/
+SWIGRUNTIME int
+SWIG_TypeEquiv(const char *nb, const char *tb) {
+  int equiv = 0;
+  const char* te = tb + strlen(tb);
+  const char* ne = nb;
+  while (!equiv && *ne) {
+    for (nb = ne; *ne; ++ne) {
+      if (*ne == '|') break;
+    }
+    equiv = (SWIG_TypeNameComp(nb, ne, tb, te) == 0) ? 1 : 0;
+    if (*ne) ++ne;
+  }
+  return equiv;
+}
+
+/*
+  Check type equivalence in a name list like <name1>|<name2>|...
+  Return 0 if equal, -1 if nb < tb, 1 if nb > tb
+*/
+SWIGRUNTIME int
+SWIG_TypeCompare(const char *nb, const char *tb) {
+  int equiv = 0;
+  const char* te = tb + strlen(tb);
+  const char* ne = nb;
+  while (!equiv && *ne) {
+    for (nb = ne; *ne; ++ne) {
+      if (*ne == '|') break;
+    }
+    equiv = (SWIG_TypeNameComp(nb, ne, tb, te) == 0) ? 1 : 0;
+    if (*ne) ++ne;
+  }
+  return equiv;
+}
+
+
+/* think of this as a c++ template<> or a scheme macro */
+#define SWIG_TypeCheck_Template(comparison, ty)         \
+  if (ty) {                                             \
+    swig_cast_info *iter = ty->cast;                    \
+    while (iter) {                                      \
+      if (comparison) {                                 \
+        if (iter == ty->cast) return iter;              \
+        /* Move iter to the top of the linked list */   \
+        iter->prev->next = iter->next;                  \
+        if (iter->next)                                 \
+          iter->next->prev = iter->prev;                \
+        iter->next = ty->cast;                          \
+        iter->prev = 0;                                 \
+        if (ty->cast) ty->cast->prev = iter;            \
+        ty->cast = iter;                                \
+        return iter;                                    \
+      }                                                 \
+      iter = iter->next;                                \
+    }                                                   \
+  }                                                     \
+  return 0
+
+/*
+  Check the typename
+*/
+SWIGRUNTIME swig_cast_info *
+SWIG_TypeCheck(const char *c, swig_type_info *ty) {
+  SWIG_TypeCheck_Template(strcmp(iter->type->name, c) == 0, ty);
+}
+
+/* Same as previous function, except strcmp is replaced with a pointer comparison */
+SWIGRUNTIME swig_cast_info *
+SWIG_TypeCheckStruct(swig_type_info *from, swig_type_info *into) {
+  SWIG_TypeCheck_Template(iter->type == from, into);
+}
+
+/*
+  Cast a pointer up an inheritance hierarchy
+*/
+SWIGRUNTIMEINLINE void *
+SWIG_TypeCast(swig_cast_info *ty, void *ptr) {
+  return ((!ty) || (!ty->converter)) ? ptr : (*ty->converter)(ptr);
+}
+
+/* 
+   Dynamic pointer casting. Down an inheritance hierarchy
+*/
+SWIGRUNTIME swig_type_info *
+SWIG_TypeDynamicCast(swig_type_info *ty, void **ptr) {
+  swig_type_info *lastty = ty;
+  if (!ty || !ty->dcast) return ty;
+  while (ty && (ty->dcast)) {
+    ty = (*ty->dcast)(ptr);
+    if (ty) lastty = ty;
+  }
+  return lastty;
+}
+
+/*
+  Return the name associated with this type
+*/
+SWIGRUNTIMEINLINE const char *
+SWIG_TypeName(const swig_type_info *ty) {
+  return ty->name;
+}
+
+/*
+  Return the pretty name associated with this type,
+  that is an unmangled type name in a form presentable to the user.
+*/
+SWIGRUNTIME const char *
+SWIG_TypePrettyName(const swig_type_info *type) {
+  /* The "str" field contains the equivalent pretty names of the
+     type, separated by vertical-bar characters.  We choose
+     to print the last name, as it is often (?) the most
+     specific. */
+  if (type->str != NULL) {
+    const char *last_name = type->str;
+    const char *s;
+    for (s = type->str; *s; s++)
+      if (*s == '|') last_name = s+1;
+    return last_name;
+  }
+  else
+    return type->name;
+}
+
+/* 
+   Set the clientdata field for a type
+*/
+SWIGRUNTIME void
+SWIG_TypeClientData(swig_type_info *ti, void *clientdata) {
+  swig_cast_info *cast = ti->cast;
+  /* if (ti->clientdata == clientdata) return; */
+  ti->clientdata = clientdata;
+  
+  while (cast) {
+    if (!cast->converter) {
+      swig_type_info *tc = cast->type;
+      if (!tc->clientdata) {
+       SWIG_TypeClientData(tc, clientdata);
+      }
+    }    
+    cast = cast->next;
+  }
+}
+
+/*
+  Search for a swig_type_info structure only by mangled name
+  Search is a O(log #types)
+  
+  We start searching at module start, and finish searching when start == end.  
+  Note: if start == end at the beginning of the function, we go all the way around
+  the circular list.
+*/
+SWIGRUNTIME swig_type_info *
+SWIG_MangledTypeQueryModule(swig_module_info *start, 
+                            swig_module_info *end, 
+                           const char *name) {
+  swig_module_info *iter = start;
+  do {
+    if (iter->size) {
+      register size_t l = 0;
+      register size_t r = iter->size - 1;
+      do {
+       /* since l+r >= 0, we can (>> 1) instead (/ 2) */
+       register size_t i = (l + r) >> 1; 
+       const char *iname = iter->types[i]->name;
+       if (iname) {
+         register int compare = strcmp(name, iname);
+         if (compare == 0) {       
+           return iter->types[i];
+         } else if (compare < 0) {
+           if (i) {
+             r = i - 1;
+           } else {
+             break;
+           }
+         } else if (compare > 0) {
+           l = i + 1;
+         }
+       } else {
+         break; /* should never happen */
+       }
+      } while (l <= r);
+    }
+    iter = iter->next;
+  } while (iter != end);
+  return 0;
+}
+
+/*
+  Search for a swig_type_info structure for either a mangled name or a human readable name.
+  It first searches the mangled names of the types, which is a O(log #types)
+  If a type is not found it then searches the human readable names, which is O(#types).
+  
+  We start searching at module start, and finish searching when start == end.  
+  Note: if start == end at the beginning of the function, we go all the way around
+  the circular list.
+*/
+SWIGRUNTIME swig_type_info *
+SWIG_TypeQueryModule(swig_module_info *start, 
+                     swig_module_info *end, 
+                    const char *name) {
+  /* STEP 1: Search the name field using binary search */
+  swig_type_info *ret = SWIG_MangledTypeQueryModule(start, end, name);
+  if (ret) {
+    return ret;
+  } else {
+    /* STEP 2: If the type hasn't been found, do a complete search
+       of the str field (the human readable name) */
+    swig_module_info *iter = start;
+    do {
+      register size_t i = 0;
+      for (; i < iter->size; ++i) {
+       if (iter->types[i]->str && (SWIG_TypeEquiv(iter->types[i]->str, name)))
+         return iter->types[i];
+      }
+      iter = iter->next;
+    } while (iter != end);
+  }
+  
+  /* neither found a match */
+  return 0;
+}
+
+
+/* 
+   Pack binary data into a string
+*/
+SWIGRUNTIME char *
+SWIG_PackData(char *c, void *ptr, size_t sz) {
+  static const char hex[17] = "0123456789abcdef";
+  register const unsigned char *u = (unsigned char *) ptr;
+  register const unsigned char *eu =  u + sz;
+  for (; u != eu; ++u) {
+    register unsigned char uu = *u;
+    *(c++) = hex[(uu & 0xf0) >> 4];
+    *(c++) = hex[uu & 0xf];
+  }
+  return c;
+}
+
+/* 
+   Unpack binary data from a string
+*/
+SWIGRUNTIME const char *
+SWIG_UnpackData(const char *c, void *ptr, size_t sz) {
+  register unsigned char *u = (unsigned char *) ptr;
+  register const unsigned char *eu = u + sz;
+  for (; u != eu; ++u) {
+    register char d = *(c++);
+    register unsigned char uu = 0;
+    if ((d >= '0') && (d <= '9'))
+      uu = ((d - '0') << 4);
+    else if ((d >= 'a') && (d <= 'f'))
+      uu = ((d - ('a'-10)) << 4);
+    else 
+      return (char *) 0;
+    d = *(c++);
+    if ((d >= '0') && (d <= '9'))
+      uu |= (d - '0');
+    else if ((d >= 'a') && (d <= 'f'))
+      uu |= (d - ('a'-10));
+    else 
+      return (char *) 0;
+    *u = uu;
+  }
+  return c;
+}
+
+/* 
+   Pack 'void *' into a string buffer.
+*/
+SWIGRUNTIME char *
+SWIG_PackVoidPtr(char *buff, void *ptr, const char *name, size_t bsz) {
+  char *r = buff;
+  if ((2*sizeof(void *) + 2) > bsz) return 0;
+  *(r++) = '_';
+  r = SWIG_PackData(r,&ptr,sizeof(void *));
+  if (strlen(name) + 1 > (bsz - (r - buff))) return 0;
+  strcpy(r,name);
+  return buff;
+}
+
+SWIGRUNTIME const char *
+SWIG_UnpackVoidPtr(const char *c, void **ptr, const char *name) {
+  if (*c != '_') {
+    if (strcmp(c,"NULL") == 0) {
+      *ptr = (void *) 0;
+      return name;
+    } else {
+      return 0;
+    }
+  }
+  return SWIG_UnpackData(++c,ptr,sizeof(void *));
+}
+
+SWIGRUNTIME char *
+SWIG_PackDataName(char *buff, void *ptr, size_t sz, const char *name, size_t bsz) {
+  char *r = buff;
+  size_t lname = (name ? strlen(name) : 0);
+  if ((2*sz + 2 + lname) > bsz) return 0;
+  *(r++) = '_';
+  r = SWIG_PackData(r,ptr,sz);
+  if (lname) {
+    strncpy(r,name,lname+1);
+  } else {
+    *r = 0;
+  }
+  return buff;
+}
+
+SWIGRUNTIME const char *
+SWIG_UnpackDataName(const char *c, void *ptr, size_t sz, const char *name) {
+  if (*c != '_') {
+    if (strcmp(c,"NULL") == 0) {
+      memset(ptr,0,sz);
+      return name;
+    } else {
+      return 0;
+    }
+  }
+  return SWIG_UnpackData(++c,ptr,sz);
+}
+
+#ifdef __cplusplus
+}
+#endif
+
+/* ---------------------------------------------------------------------- -*- c -*-
+ * perl5.swg
+ *
+ * Perl5 runtime library
+ * $Header: /cvsroot/swig/SWIG/Lib/perl5/perlrun.swg,v 1.21 2005/02/01 00:08:17 wuzzeb Exp $
+ * ----------------------------------------------------------------------------- */
+
+#define SWIGPERL
+#define SWIGPERL5
+#ifdef __cplusplus
+/* Needed on some windows machines---since MS plays funny games with the header files under C++ */
+#include <math.h>
+#include <stdlib.h>
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* Get rid of free and malloc defined by perl */
+#undef free
+#undef malloc
+
+#ifndef pTHX_
+#define pTHX_
+#endif
+
+#include <string.h>
+#ifdef __cplusplus
+}
+#endif
+
+/* Macro to call an XS function */
+
+#ifdef PERL_OBJECT 
+#  define SWIG_CALLXS(_name) _name(cv,pPerl) 
+#else 
+#  ifndef MULTIPLICITY 
+#    define SWIG_CALLXS(_name) _name(cv) 
+#  else 
+#    define SWIG_CALLXS(_name) _name(PERL_GET_THX, cv) 
+#  endif 
+#endif 
+
+/* Contract support */
+
+#define SWIG_contract_assert(expr,msg) if (!(expr)) { SWIG_croak(msg); } else
+
+/* Note: SwigMagicFuncHack is a typedef used to get the C++ compiler to just shut up already */
+
+#ifdef PERL_OBJECT
+#define MAGIC_PPERL  CPerlObj *pPerl = (CPerlObj *) this;
+typedef int (CPerlObj::*SwigMagicFunc)(SV *, MAGIC *);
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+typedef int (CPerlObj::*SwigMagicFuncHack)(SV *, MAGIC *);
+#ifdef __cplusplus
+}
+#endif
+
+#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
+#define SWIGCLASS_STATIC
+#else
+#define MAGIC_PPERL
+#define SWIGCLASS_STATIC static
+#ifndef MULTIPLICITY
+#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
+typedef int (*SwigMagicFunc)(SV *, MAGIC *);
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+typedef int (*SwigMagicFuncHack)(SV *, MAGIC *);
+#ifdef __cplusplus
+}
+#endif
+
+
+#else
+#define SWIG_MAGIC(a,b) (struct interpreter *interp, SV *a, MAGIC *b)
+typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *);
+#ifdef __cplusplus
+extern "C" {
+#endif
+typedef int (*SwigMagicFuncHack)(struct interpreter *, SV *, MAGIC *);
+#ifdef __cplusplus
+}
+#endif
+
+#endif
+#endif
+
+#if defined(WIN32) && defined(PERL_OBJECT) && !defined(PerlIO_exportFILE)
+#define PerlIO_exportFILE(fh,fl) (FILE*)(fh)
+#endif
+
+/* Modifications for newer Perl 5.005 releases */
+
+#if !defined(PERL_REVISION) || ((PERL_REVISION >= 5) && ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 50))))
+#  ifndef PL_sv_yes
+#    define PL_sv_yes sv_yes
+#  endif
+#  ifndef PL_sv_undef
+#    define PL_sv_undef sv_undef
+#  endif
+#  ifndef PL_na
+#    define PL_na na
+#  endif
+#endif
+
+#include <stdlib.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define SWIG_OWNER 1
+#define SWIG_SHADOW 2
+
+/* Common SWIG API */
+
+#ifdef PERL_OBJECT
+#  define SWIG_ConvertPtr(obj, pp, type, flags) \
+     SWIG_Perl_ConvertPtr(pPerl, obj, pp, type, flags)
+#  define SWIG_NewPointerObj(p, type, flags) \
+     SWIG_Perl_NewPointerObj(pPerl, p, type, flags)
+#  define SWIG_MakePackedObj(sv, p, s, type)   \
+     SWIG_Perl_MakePackedObj(pPerl, sv, p, s, type)
+#  define SWIG_ConvertPacked(obj, p, s, type, flags) \
+     SWIG_Perl_ConvertPacked(pPerl, obj, p, s, type, flags)
+
+#else
+#  define SWIG_ConvertPtr(obj, pp, type, flags) \
+     SWIG_Perl_ConvertPtr(obj, pp, type, flags)
+#  define SWIG_NewPointerObj(p, type, flags) \
+     SWIG_Perl_NewPointerObj(p, type, flags)
+#  define SWIG_MakePackedObj(sv, p, s, type)   \
+     SWIG_Perl_MakePackedObj(sv, p, s, type )
+#  define SWIG_ConvertPacked(obj, p, s, type, flags) \
+     SWIG_Perl_ConvertPacked(obj, p, s, type, flags)
+#endif
+
+/* Runtime API */
+#define SWIG_GetModule(clientdata) SWIG_Perl_GetModule()
+#define SWIG_SetModule(clientdata, pointer) SWIG_Perl_SetModule(pointer)
+
+/* Perl-specific API */
+#ifdef PERL_OBJECT
+#  define SWIG_MakePtr(sv, ptr, type, flags) \
+     SWIG_Perl_MakePtr(pPerl, sv, ptr, type, flags)
+#  define SWIG_SetError(str) \
+     SWIG_Perl_SetError(pPerl, str)
+#else
+#  define SWIG_MakePtr(sv, ptr, type, flags) \
+     SWIG_Perl_MakePtr(sv, ptr, type, flags)
+#  define SWIG_SetError(str) \
+     SWIG_Perl_SetError(str)
+#  define SWIG_SetErrorSV(str) \
+     SWIG_Perl_SetErrorSV(str)
+#endif
+
+#define SWIG_SetErrorf SWIG_Perl_SetErrorf
+
+
+#ifdef PERL_OBJECT
+#  define SWIG_MAYBE_PERL_OBJECT CPerlObj *pPerl,
+#else
+#  define SWIG_MAYBE_PERL_OBJECT
+#endif
+
+static swig_cast_info *
+SWIG_Perl_TypeCheckRV(SWIG_MAYBE_PERL_OBJECT SV *rv, swig_type_info *ty) {
+  SWIG_TypeCheck_Template(sv_derived_from(rv, (char *) iter->type->name), ty);
+}
+
+/* Function for getting a pointer value */
+
+static int
+SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) {
+  swig_cast_info *tc;
+  void *voidptr = (void *)0;
+
+  /* If magical, apply more magic */
+  if (SvGMAGICAL(sv))
+    mg_get(sv);
+
+  /* Check to see if this is an object */
+  if (sv_isobject(sv)) {
+    SV *tsv = (SV*) SvRV(sv);
+    IV tmp = 0;
+    if ((SvTYPE(tsv) == SVt_PVHV)) {
+      MAGIC *mg;
+      if (SvMAGICAL(tsv)) {
+        mg = mg_find(tsv,'P');
+        if (mg) {
+          sv = mg->mg_obj;
+          if (sv_isobject(sv)) {
+            tmp = SvIV((SV*)SvRV(sv));
+          }
+        }
+      } else {
+        return -1;
+      }
+    } else {
+      tmp = SvIV((SV*)SvRV(sv));
+    }
+    voidptr = (void *)tmp;
+    if (!_t) {
+      *(ptr) = voidptr;
+      return 0;
+    }
+  } else if (! SvOK(sv)) {            /* Check for undef */
+    *(ptr) = (void *) 0;
+    return 0;
+  } else if (SvTYPE(sv) == SVt_RV) {  /* Check for NULL pointer */
+    *(ptr) = (void *) 0;
+    if (!SvROK(sv))
+      return 0;
+    else
+      return -1;
+  } else {                            /* Don't know what it is */
+    *(ptr) = (void *) 0;
+    return -1;
+  }
+  if (_t) {
+    /* Now see if the types match */
+    char *_c = HvNAME(SvSTASH(SvRV(sv)));
+    tc = SWIG_TypeCheck(_c,_t);
+    if (!tc) {
+      *ptr = voidptr;
+      return -1;
+    }
+    *ptr = SWIG_TypeCast(tc,voidptr);
+    return 0;
+  }
+  *ptr = voidptr;
+  return 0;
+}
+
+static void
+SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, int flags) {
+  if (ptr && (flags & SWIG_SHADOW)) {
+    SV *self;
+    SV *obj=newSV(0);
+    HV *hash=newHV();
+    HV *stash;
+    sv_setref_pv(obj, (char *) t->name, ptr);
+    stash=SvSTASH(SvRV(obj));
+    if (flags & SWIG_OWNER) {
+      HV *hv;
+      GV *gv=*(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
+      if (!isGV(gv))
+        gv_init(gv, stash, "OWNER", 5, FALSE);
+      hv=GvHVn(gv);
+      hv_store_ent(hv, obj, newSViv(1), 0);
+    }
+    sv_magic((SV *)hash, (SV *)obj, 'P', Nullch, 0);
+    SvREFCNT_dec(obj);
+    self=newRV_noinc((SV *)hash);
+    sv_setsv(sv, self);
+    SvREFCNT_dec((SV *)self);
+    sv_bless(sv, stash);
+  }
+  else {
+    sv_setref_pv(sv, (char *) t->name, ptr);
+  }
+}
+
+static SWIGINLINE SV *
+SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int flags) {
+  SV *result = sv_newmortal();
+  SWIG_MakePtr(result, ptr, t, flags);
+  return result;
+}
+
+static void
+  SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, swig_type_info *type) {
+  char result[1024];
+  char *r = result;
+  if ((2*sz + 1 + strlen(type->name)) > 1000) return;
+  *(r++) = '_';
+  r = SWIG_PackData(r,ptr,sz);
+  strcpy(r,type->name);
+  sv_setpv(sv, result);
+}
+
+/* Convert a packed value value */
+static int
+SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, swig_type_info *ty, int flags) {
+  swig_cast_info *tc;
+  const char  *c = 0;
+
+  if ((!obj) || (!SvOK(obj))) return -1;
+  c = SvPV(obj, PL_na);
+  /* Pointer values must start with leading underscore */
+  if (*c != '_') return -1;
+  c++;
+  c = SWIG_UnpackData(c,ptr,sz);
+  if (ty) {
+    tc = SWIG_TypeCheck(c,ty);
+    if (!tc) return -1;
+  }
+  return 0;
+}
+
+static SWIGINLINE void
+SWIG_Perl_SetError(SWIG_MAYBE_PERL_OBJECT const char *error) {
+  if (error) sv_setpv(perl_get_sv("@", TRUE), error);
+}
+
+static SWIGINLINE void
+SWIG_Perl_SetErrorSV(SWIG_MAYBE_PERL_OBJECT SV *error) {
+  if (error) sv_setsv(perl_get_sv("@", TRUE), error);
+}
+
+static void
+SWIG_Perl_SetErrorf(const char *fmt, ...) {
+  va_list args;
+  va_start(args, fmt);
+  sv_vsetpvfn(perl_get_sv("@", TRUE), fmt, strlen(fmt), &args, Null(SV**), 0, Null(bool*));
+  va_end(args);
+}
+
+/* Macros for low-level exception handling */
+#define SWIG_fail       goto fail
+#define SWIG_croak(x)   { SWIG_SetError(x); goto fail; }
+#define SWIG_croakSV(x) { SWIG_SetErrorSV(x); goto fail; }
+/* most preprocessors do not support vararg macros :-( */
+/* #define SWIG_croakf(x...) { SWIG_SetErrorf(x); goto fail; } */
+
+
+typedef XS(SwigPerlWrapper);
+typedef SwigPerlWrapper *SwigPerlWrapperPtr;
+
+/* Structure for command table */
+typedef struct {
+  const char         *name;
+  SwigPerlWrapperPtr  wrapper;
+} swig_command_info;
+
+/* Information for constant table */
+
+#define SWIG_INT     1
+#define SWIG_FLOAT   2
+#define SWIG_STRING  3
+#define SWIG_POINTER 4
+#define SWIG_BINARY  5
+
+/* Constant information structure */
+typedef struct swig_constant_info {
+    int              type;
+    const char      *name;
+    long             lvalue;
+    double           dvalue;
+    void            *pvalue;
+    swig_type_info **ptype;
+} swig_constant_info;
+
+#ifdef __cplusplus
+}
+#endif
+
+/* Structure for variable table */
+typedef struct {
+  const char   *name;
+  SwigMagicFunc   set;
+  SwigMagicFunc   get;
+  swig_type_info  **type;
+} swig_variable_info;
+
+/* Magic variable code */
+#ifndef PERL_OBJECT
+#define swig_create_magic(s,a,b,c) _swig_create_magic(s,a,b,c)
+  #ifndef MULTIPLICITY
+     static void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *)) {
+  #else
+     static void _swig_create_magic(SV *sv, char *name, int (*set)(struct interpreter*, SV *, MAGIC *), int (*get)(struct interpreter*, SV *,MAGIC *)) {
+  #endif
+#else
+#  define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c)
+static void _swig_create_magic(CPerlObj *pPerl, SV *sv, const char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *)) {
+#endif
+  MAGIC *mg;
+  sv_magic(sv,sv,'U',(char *) name,strlen(name));
+  mg = mg_find(sv,'U');
+  mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
+  mg->mg_virtual->svt_get = (SwigMagicFuncHack) get;
+  mg->mg_virtual->svt_set = (SwigMagicFuncHack) set;
+  mg->mg_virtual->svt_len = 0;
+  mg->mg_virtual->svt_clear = 0;
+  mg->mg_virtual->svt_free = 0;
+}
+
+
+static swig_module_info *
+SWIG_Perl_GetModule() {
+  static void *type_pointer = (void *)0;
+  SV *pointer;
+
+  /* first check if pointer already created */
+  if (!type_pointer) {
+    pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, FALSE);
+    if (pointer && SvOK(pointer)) {
+      type_pointer = INT2PTR(swig_type_info **, SvIV(pointer));
+    }
+  }
+
+  return (swig_module_info *) type_pointer;
+}
+
+static void
+SWIG_Perl_SetModule(swig_module_info *module) {
+  SV *pointer;
+
+  /* create a new pointer */
+  pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, TRUE);
+  sv_setiv(pointer, PTR2IV(module));
+}
+
+#ifdef do_open
+  #undef do_open
+#endif
+#ifdef do_close
+  #undef do_close
+#endif
+#ifdef scalar
+  #undef scalar
+#endif
+#ifdef list
+  #undef list
+#endif
+#ifdef apply
+  #undef apply
+#endif
+#ifdef convert
+  #undef convert
+#endif
+#ifdef Error
+  #undef Error
+#endif
+#ifdef form
+  #undef form
+#endif
+#ifdef vform
+  #undef vform
+#endif
+#ifdef LABEL
+  #undef LABEL
+#endif
+#ifdef METHOD
+  #undef METHOD
+#endif
+#ifdef Move
+  #undef Move
+#endif
+#ifdef yylex
+  #undef yylex
+#endif
+#ifdef yyparse
+  #undef yyparse
+#endif
+#ifdef yyerror
+  #undef yyerror
+#endif
+#ifdef invert
+  #undef invert
+#endif
+#ifdef ref
+  #undef ref
+#endif
+#ifdef ENTER
+  #undef ENTER
+#endif
+#ifdef read
+  #undef read
+#endif
+#ifdef write
+  #undef write
+#endif
+#ifdef eof
+  #undef eof
+#endif
+#ifdef bool
+  #undef bool
+#endif
+
+
+
+/* -------- TYPES TABLE (BEGIN) -------- */
+
+#define SWIGTYPE_p_switch_core_session swig_types[0]
+static swig_type_info *swig_types[2];
+static swig_module_info swig_module = {swig_types, 1, 0, 0, 0, 0};
+#define SWIG_TypeQuery(name) SWIG_TypeQueryModule(&swig_module, &swig_module, name)
+#define SWIG_MangledTypeQuery(name) SWIG_MangledTypeQueryModule(&swig_module, &swig_module, name)
+
+/* -------- TYPES TABLE (END) -------- */
+
+#define SWIG_init    boot_fs_perl
+
+#define SWIG_name   "fs_perlc::boot_fs_perl"
+#define SWIG_prefix "fs_perlc::"
+
+#ifdef __cplusplus
+extern "C"
+#endif
+#ifndef PERL_OBJECT
+#ifndef MULTIPLICITY
+SWIGEXPORT void SWIG_init (CV* cv);
+#else
+SWIGEXPORT void SWIG_init (pTHXo_ CV* cv);
+#endif
+#else
+SWIGEXPORT void SWIG_init (CV *cv, CPerlObj *);
+#endif
+
+#ifdef PERL_OBJECT
+#define MAGIC_CLASS _wrap_fs_perl_var::
+class _wrap_fs_perl_var : public CPerlObj {
+public:
+#else
+#define MAGIC_CLASS
+#endif
+SWIGCLASS_STATIC int swig_magic_readonly(pTHX_ SV *sv, MAGIC *mg) {
+    MAGIC_PPERL
+    sv = sv; mg = mg;
+    croak("Value is read-only.");
+    return 0;
+}
+
+
+#ifdef PERL_OBJECT
+};
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+XS(_wrap_fs_console_log) {
+    {
+        char *arg1 = (char *) 0 ;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 1) || (items > 1)) {
+            SWIG_croak("Usage: fs_console_log(msg);");
+        }
+        if (!SvOK((SV*) ST(0))) arg1 = 0;
+        else arg1 = (char *) SvPV(ST(0), PL_na);
+        fs_console_log(arg1);
+        
+        
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_console_clean) {
+    {
+        char *arg1 = (char *) 0 ;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 1) || (items > 1)) {
+            SWIG_croak("Usage: fs_console_clean(msg);");
+        }
+        if (!SvOK((SV*) ST(0))) arg1 = 0;
+        else arg1 = (char *) SvPV(ST(0), PL_na);
+        fs_console_clean(arg1);
+        
+        
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_core_session_locate) {
+    {
+        char *arg1 = (char *) 0 ;
+        struct switch_core_session *result;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 1) || (items > 1)) {
+            SWIG_croak("Usage: fs_core_session_locate(uuid);");
+        }
+        if (!SvOK((SV*) ST(0))) arg1 = 0;
+        else arg1 = (char *) SvPV(ST(0), PL_na);
+        result = (struct switch_core_session *)fs_core_session_locate(arg1);
+        
+        ST(argvi) = sv_newmortal();
+        SWIG_MakePtr(ST(argvi++), (void *) result, SWIGTYPE_p_switch_core_session, 0|0);
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_channel_answer) {
+    {
+        struct switch_core_session *arg1 = (struct switch_core_session *) 0 ;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 1) || (items > 1)) {
+            SWIG_croak("Usage: fs_channel_answer(session);");
+        }
+        {
+            if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_switch_core_session,0) < 0) {
+                SWIG_croak("Type error in argument 1 of fs_channel_answer. Expected _p_switch_core_session");
+            }
+        }
+        fs_channel_answer(arg1);
+        
+        
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_channel_pre_answer) {
+    {
+        struct switch_core_session *arg1 = (struct switch_core_session *) 0 ;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 1) || (items > 1)) {
+            SWIG_croak("Usage: fs_channel_pre_answer(session);");
+        }
+        {
+            if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_switch_core_session,0) < 0) {
+                SWIG_croak("Type error in argument 1 of fs_channel_pre_answer. Expected _p_switch_core_session");
+            }
+        }
+        fs_channel_pre_answer(arg1);
+        
+        
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_channel_hangup) {
+    {
+        struct switch_core_session *arg1 = (struct switch_core_session *) 0 ;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 1) || (items > 1)) {
+            SWIG_croak("Usage: fs_channel_hangup(session);");
+        }
+        {
+            if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_switch_core_session,0) < 0) {
+                SWIG_croak("Type error in argument 1 of fs_channel_hangup. Expected _p_switch_core_session");
+            }
+        }
+        fs_channel_hangup(arg1);
+        
+        
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_channel_set_variable) {
+    {
+        struct switch_core_session *arg1 = (struct switch_core_session *) 0 ;
+        char *arg2 = (char *) 0 ;
+        char *arg3 = (char *) 0 ;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 3) || (items > 3)) {
+            SWIG_croak("Usage: fs_channel_set_variable(session,var,val);");
+        }
+        {
+            if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_switch_core_session,0) < 0) {
+                SWIG_croak("Type error in argument 1 of fs_channel_set_variable. Expected _p_switch_core_session");
+            }
+        }
+        if (!SvOK((SV*) ST(1))) arg2 = 0;
+        else arg2 = (char *) SvPV(ST(1), PL_na);
+        if (!SvOK((SV*) ST(2))) arg3 = 0;
+        else arg3 = (char *) SvPV(ST(2), PL_na);
+        fs_channel_set_variable(arg1,arg2,arg3);
+        
+        
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_channel_get_variable) {
+    {
+        struct switch_core_session *arg1 = (struct switch_core_session *) 0 ;
+        char *arg2 = (char *) 0 ;
+        char *arg3 = (char *) 0 ;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 3) || (items > 3)) {
+            SWIG_croak("Usage: fs_channel_get_variable(session,var,val);");
+        }
+        {
+            if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_switch_core_session,0) < 0) {
+                SWIG_croak("Type error in argument 1 of fs_channel_get_variable. Expected _p_switch_core_session");
+            }
+        }
+        if (!SvOK((SV*) ST(1))) arg2 = 0;
+        else arg2 = (char *) SvPV(ST(1), PL_na);
+        if (!SvOK((SV*) ST(2))) arg3 = 0;
+        else arg3 = (char *) SvPV(ST(2), PL_na);
+        fs_channel_get_variable(arg1,arg2,arg3);
+        
+        
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_channel_set_state) {
+    {
+        struct switch_core_session *arg1 = (struct switch_core_session *) 0 ;
+        char *arg2 = (char *) 0 ;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 2) || (items > 2)) {
+            SWIG_croak("Usage: fs_channel_set_state(session,state);");
+        }
+        {
+            if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_switch_core_session,0) < 0) {
+                SWIG_croak("Type error in argument 1 of fs_channel_set_state. Expected _p_switch_core_session");
+            }
+        }
+        if (!SvOK((SV*) ST(1))) arg2 = 0;
+        else arg2 = (char *) SvPV(ST(1), PL_na);
+        fs_channel_set_state(arg1,arg2);
+        
+        
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+XS(_wrap_fs_ivr_play_file) {
+    {
+        struct switch_core_session *arg1 = (struct switch_core_session *) 0 ;
+        char *arg2 = (char *) 0 ;
+        char *arg3 = (char *) 0 ;
+        int result;
+        int argvi = 0;
+        dXSARGS;
+        
+        if ((items < 3) || (items > 3)) {
+            SWIG_croak("Usage: fs_ivr_play_file(session,file,timer_name_in);");
+        }
+        {
+            if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_switch_core_session,0) < 0) {
+                SWIG_croak("Type error in argument 1 of fs_ivr_play_file. Expected _p_switch_core_session");
+            }
+        }
+        if (!SvOK((SV*) ST(1))) arg2 = 0;
+        else arg2 = (char *) SvPV(ST(1), PL_na);
+        if (!SvOK((SV*) ST(2))) arg3 = 0;
+        else arg3 = (char *) SvPV(ST(2), PL_na);
+        result = (int)fs_ivr_play_file(arg1,arg2,arg3);
+        
+        ST(argvi) = sv_newmortal();
+        sv_setiv(ST(argvi++), (IV) result);
+        XSRETURN(argvi);
+        fail:
+        ;
+    }
+    croak(Nullch);
+}
+
+
+
+/* -------- TYPE CONVERSION AND EQUIVALENCE RULES (BEGIN) -------- */
+
+static swig_type_info _swigt__p_switch_core_session = {"_p_switch_core_session", "struct switch_core_session *", 0, 0, 0};
+
+static swig_type_info *swig_type_initial[] = {
+  &_swigt__p_switch_core_session,
+};
+
+static swig_cast_info _swigc__p_switch_core_session[] = {  {&_swigt__p_switch_core_session, 0, 0, 0},{0, 0, 0, 0}};
+
+static swig_cast_info *swig_cast_initial[] = {
+  _swigc__p_switch_core_session,
+};
+
+
+/* -------- TYPE CONVERSION AND EQUIVALENCE RULES (END) -------- */
+
+static swig_constant_info swig_constants[] = {
+{0,0,0,0,0,0}
+};
+#ifdef __cplusplus
+}
+#endif
+static swig_variable_info swig_variables[] = {
+{0,0,0,0}
+};
+static swig_command_info swig_commands[] = {
+{"fs_perlc::fs_console_log", _wrap_fs_console_log},
+{"fs_perlc::fs_console_clean", _wrap_fs_console_clean},
+{"fs_perlc::fs_core_session_locate", _wrap_fs_core_session_locate},
+{"fs_perlc::fs_channel_answer", _wrap_fs_channel_answer},
+{"fs_perlc::fs_channel_pre_answer", _wrap_fs_channel_pre_answer},
+{"fs_perlc::fs_channel_hangup", _wrap_fs_channel_hangup},
+{"fs_perlc::fs_channel_set_variable", _wrap_fs_channel_set_variable},
+{"fs_perlc::fs_channel_get_variable", _wrap_fs_channel_get_variable},
+{"fs_perlc::fs_channel_set_state", _wrap_fs_channel_set_state},
+{"fs_perlc::fs_ivr_play_file", _wrap_fs_ivr_play_file},
+{0,0}
+};
+/*************************************************************************
+ * Type initialization:
+ * This problem is tough by the requirement that no dynamic 
+ * memory is used. Also, since swig_type_info structures store pointers to 
+ * swig_cast_info structures and swig_cast_info structures store pointers back
+ * to swig_type_info structures, we need some lookup code at initialization. 
+ * The idea is that swig generates all the structures that are needed. 
+ * The runtime then collects these partially filled structures. 
+ * The SWIG_InitializeModule function takes these initial arrays out of 
+ * swig_module, and does all the lookup, filling in the swig_module.types
+ * array with the correct data and linking the correct swig_cast_info
+ * structures together.
+
+ * The generated swig_type_info structures are assigned staticly to an initial 
+ * array. We just loop though that array, and handle each type individually.
+ * First we lookup if this type has been already loaded, and if so, use the
+ * loaded structure instead of the generated one. Then we have to fill in the
+ * cast linked list. The cast data is initially stored in something like a
+ * two-dimensional array. Each row corresponds to a type (there are the same
+ * number of rows as there are in the swig_type_initial array). Each entry in
+ * a column is one of the swig_cast_info structures for that type.
+ * The cast_initial array is actually an array of arrays, because each row has
+ * a variable number of columns. So to actually build the cast linked list,
+ * we find the array of casts associated with the type, and loop through it 
+ * adding the casts to the list. The one last trick we need to do is making
+ * sure the type pointer in the swig_cast_info struct is correct.
+
+ * First off, we lookup the cast->type name to see if it is already loaded. 
+ * There are three cases to handle:
+ *  1) If the cast->type has already been loaded AND the type we are adding
+ *     casting info to has not been loaded (it is in this module), THEN we
+ *     replace the cast->type pointer with the type pointer that has already
+ *     been loaded.
+ *  2) If BOTH types (the one we are adding casting info to, and the 
+ *     cast->type) are loaded, THEN the cast info has already been loaded by
+ *     the previous module so we just ignore it.
+ *  3) Finally, if cast->type has not already been loaded, then we add that
+ *     swig_cast_info to the linked list (because the cast->type) pointer will
+ *     be correct.
+**/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+    
+    SWIGRUNTIME void
+    SWIG_InitializeModule(void *clientdata) {
+        swig_type_info *type, *ret;
+        swig_cast_info *cast;
+        size_t i;
+        swig_module_info *module_head;
+        static int init_run = 0;
+        
+        clientdata = clientdata;
+        
+        if (init_run) return;
+        init_run = 1;
+        
+        /* Initialize the swig_module */
+        swig_module.type_initial = swig_type_initial;
+        swig_module.cast_initial = swig_cast_initial;
+        
+        /* Try and load any already created modules */
+        module_head = SWIG_GetModule(clientdata);
+        if (module_head) {
+            swig_module.next = module_head->next;
+            module_head->next = &swig_module;
+        } else {
+            /* This is the first module loaded */
+            swig_module.next = &swig_module;
+            SWIG_SetModule(clientdata, &swig_module);
+        }
+        
+        /* Now work on filling in swig_module.types */
+        for (i = 0; i < swig_module.size; ++i) {
+            type = 0;
+            
+            /* if there is another module already loaded */
+            if (swig_module.next != &swig_module) {
+                type = SWIG_MangledTypeQueryModule(swig_module.next, &swig_module, swig_module.type_initial[i]->name);
+            }
+            if (type) {
+                /* Overwrite clientdata field */
+                if (swig_module.type_initial[i]->clientdata) type->clientdata = swig_module.type_initial[i]->clientdata;
+            } else {
+                type = swig_module.type_initial[i];
+            }
+            
+            /* Insert casting types */
+            cast = swig_module.cast_initial[i];
+            while (cast->type) {
+                /* Don't need to add information already in the list */
+                ret = 0;
+                if (swig_module.next != &swig_module) {
+                    ret = SWIG_MangledTypeQueryModule(swig_module.next, &swig_module, cast->type->name);
+                }
+                if (ret && type == swig_module.type_initial[i]) {
+                    cast->type = ret;
+                    ret = 0;
+                }
+                
+                if (!ret) {
+                    if (type->cast) {
+                        type->cast->prev = cast;
+                        cast->next = type->cast;
+                    }
+                    type->cast = cast;
+                }
+                
+                cast++;
+            }
+            
+            /* Set entry in modules->types array equal to the type */
+            swig_module.types[i] = type;
+        }
+        swig_module.types[i] = 0;
+    }
+    
+    /* This function will propagate the clientdata field of type to
+    * any new swig_type_info structures that have been added into the list
+    * of equivalent types.  It is like calling
+    * SWIG_TypeClientData(type, clientdata) a second time.
+    */
+    SWIGRUNTIME void
+    SWIG_PropagateClientData(void) {
+        size_t i;
+        swig_cast_info *equiv;
+        static int init_run = 0;
+        
+        if (init_run) return;
+        init_run = 1;
+        
+        for (i = 0; i < swig_module.size; i++) {
+            if (swig_module.types[i]->clientdata) {
+                equiv = swig_module.types[i]->cast;
+                while (equiv) {
+                    if (!equiv->converter) {
+                        if (equiv->type && !equiv->type->clientdata)
+                        SWIG_TypeClientData(equiv->type, swig_module.types[i]->clientdata);
+                    }
+                    equiv = equiv->next;
+                }
+            }
+        }
+    }
+    
+#ifdef __cplusplus
+}
+#endif
+
+
+
+#ifdef __cplusplus
+extern "C"
+#endif
+
+XS(SWIG_init) {
+    dXSARGS;
+    int i;
+    
+    SWIG_InitializeModule(0);
+    
+    /* Install commands */
+    for (i = 0; swig_commands[i].name; i++) {
+        newXS((char*) swig_commands[i].name,swig_commands[i].wrapper, (char*)__FILE__);
+    }
+    
+    /* Install variables */
+    for (i = 0; swig_variables[i].name; i++) {
+        SV *sv;
+        sv = perl_get_sv((char*) swig_variables[i].name, TRUE | 0x2);
+        if (swig_variables[i].type) {
+            SWIG_MakePtr(sv,(void *)1, *swig_variables[i].type,0);
+        } else {
+            sv_setiv(sv,(IV) 0);
+        }
+        swig_create_magic(sv, (char *) swig_variables[i].name, swig_variables[i].set, swig_variables[i].get); 
+    }
+    
+    /* Install constant */
+    for (i = 0; swig_constants[i].type; i++) {
+        SV *sv;
+        sv = perl_get_sv((char*)swig_constants[i].name, TRUE | 0x2);
+        switch(swig_constants[i].type) {
+            case SWIG_INT:
+            sv_setiv(sv, (IV) swig_constants[i].lvalue);
+            break;
+            case SWIG_FLOAT:
+            sv_setnv(sv, (double) swig_constants[i].dvalue);
+            break;
+            case SWIG_STRING:
+            sv_setpv(sv, (char *) swig_constants[i].pvalue);
+            break;
+            case SWIG_POINTER:
+            SWIG_MakePtr(sv, swig_constants[i].pvalue, *(swig_constants[i].ptype),0);
+            break;
+            case SWIG_BINARY:
+            SWIG_MakePackedObj(sv, swig_constants[i].pvalue, swig_constants[i].lvalue, *(swig_constants[i].ptype));
+            break;
+            default:
+            break;
+        }
+        SvREADONLY_on(sv);
+    }
+    
+    ST(0) = &PL_sv_yes;
+    XSRETURN(1);
+}
+
index 188e7e4734c644740ef3c4fdd764ad9b6ea48238..cc60d33f06be435d58c8e4b1a10c2d292c65fa29 100644 (file)
@@ -565,6 +565,21 @@ SWITCH_DECLARE(switch_status) switch_channel_hangup(switch_channel *channel)
        return channel->state;
 }
 
+SWITCH_DECLARE(switch_status) switch_channel_pre_answer(switch_channel *channel)
+{
+       switch_core_session_message msg;
+       char *uuid = switch_core_session_get_uuid(channel->session);
+       switch_status status;
+
+       assert(channel != NULL);        
+       msg.message_id = SWITCH_MESSAGE_INDICATE_PROGRESS;
+       msg.from = channel->name;
+       status = switch_core_session_message_send(uuid, &msg);
+       switch_channel_set_flag(channel, CF_EARLY_MEDIA);
+
+       return status;
+}
+
 SWITCH_DECLARE(switch_status) switch_channel_answer(switch_channel *channel)
 {
        assert(channel != NULL);
index 4e0931fd7ad8e5a40e39b5d1c1ece9e6a79947b0..9ccb824e5d5736023a901783ad7235e3f66846b7 100644 (file)
  */
 #include <switch.h>
 
-#ifdef EMBED_PERL
-#include <EXTERN.h>
-#include <perl.h>
-
-static char *embedding[] = { "", "-e", "" };
-EXTERN_C void xs_init(pTHX);
-#endif
-
 struct switch_core_session {
        unsigned long id;
        char name[80];
@@ -87,9 +79,6 @@ struct switch_core_runtime {
        switch_core_db *db;
        const struct switch_state_handler_table *state_handlers[SWITCH_MAX_STATE_HANDLERS];
     int state_handler_index;
-#ifdef EMBED_PERL
-       PerlInterpreter *my_perl;
-#endif
        FILE *console;
 };
 
@@ -163,17 +152,6 @@ SWITCH_DECLARE(FILE *) switch_core_data_channel(switch_text_channel channel)
        return handle;
 }
 
-#ifdef EMBED_PERL
-/* test frontend to the perl interpreter */
-SWITCH_DECLARE(switch_status) switch_core_do_perl(char *txt)
-{
-       PerlInterpreter *my_perl = runtime.my_perl;
-       eval_pv(txt, TRUE);
-       return SWITCH_STATUS_SUCCESS;
-}
-#endif
-
-
 SWITCH_DECLARE(int) switch_core_add_state_handler(const switch_state_handler_table *state_handler)
 {
        int index = runtime.state_handler_index++;
@@ -196,6 +174,13 @@ SWITCH_DECLARE(const switch_state_handler_table *) switch_core_get_state_handler
        return runtime.state_handlers[index];
 }
 
+SWITCH_DECLARE(switch_core_session *) switch_core_session_locate(char *uuid_str)
+{
+       switch_core_session *session;
+       session = switch_core_hash_find(runtime.session_table, uuid_str);
+       return session;
+}
+
 SWITCH_DECLARE(switch_status) switch_core_session_message_send(char *uuid_str, switch_core_session_message *message)
 {
        switch_core_session *session = NULL;
@@ -2230,9 +2215,6 @@ SWITCH_DECLARE(switch_status) switch_core_init(char *console)
        
        switch_core_set_globals();
 
-#ifdef EMBED_PERL
-       PerlInterpreter *my_perl;
-#endif
        if(console) {
                if (*console != '/') {
                        char path[265];
@@ -2274,21 +2256,6 @@ SWITCH_DECLARE(switch_status) switch_core_init(char *console)
                }
        }
 
-#ifdef EMBED_PERL
-       if (!(my_perl = perl_alloc())) {
-               switch_console_printf(SWITCH_CHANNEL_CONSOLE, "Could not allocate perl intrepreter\n");
-               switch_core_destroy();
-               return SWITCH_STATUS_MEMERR;
-       }
-       switch_console_printf(SWITCH_CHANNEL_CONSOLE, "Allocated perl intrepreter.\n");
-
-       PERL_SET_CONTEXT(my_perl);
-       perl_construct(my_perl);
-       perl_parse(my_perl, xs_init, 3, embedding, NULL);
-       perl_run(my_perl);
-       runtime.my_perl = my_perl;
-#endif
-
        runtime.session_id = 1;
 
        switch_core_hash_init(&runtime.session_table, runtime.memory_pool);
@@ -2301,15 +2268,6 @@ SWITCH_DECLARE(switch_status) switch_core_init(char *console)
 SWITCH_DECLARE(switch_status) switch_core_destroy(void)
 {
 
-#ifdef EMBED_PERL
-       if (runtime.my_perl) {
-               perl_destruct(runtime.my_perl);
-               perl_free(runtime.my_perl);
-               runtime.my_perl = NULL;
-               switch_console_printf(SWITCH_CHANNEL_CONSOLE, "Unallocated perl interpreter.\n");
-       }
-#endif
-
        switch_console_printf(SWITCH_CHANNEL_CONSOLE, "Closing Event Engine.\n");
        switch_event_shutdown();