You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@uima.apache.org by ea...@apache.org on 2007/02/03 17:50:57 UTC

svn commit: r503244 - in /incubator/uima/uimacpp/trunk/scriptators/perl: ./ Makefile Perl.html PerlSample.xml Perltator.cpp sample.pl

Author: eae
Date: Sat Feb  3 08:50:56 2007
New Revision: 503244

URL: http://svn.apache.org/viewvc?view=rev&rev=503244
Log:
Initial entry

Added:
    incubator/uima/uimacpp/trunk/scriptators/perl/
    incubator/uima/uimacpp/trunk/scriptators/perl/Makefile   (with props)
    incubator/uima/uimacpp/trunk/scriptators/perl/Perl.html
    incubator/uima/uimacpp/trunk/scriptators/perl/PerlSample.xml
    incubator/uima/uimacpp/trunk/scriptators/perl/Perltator.cpp   (with props)
    incubator/uima/uimacpp/trunk/scriptators/perl/sample.pl

Added: incubator/uima/uimacpp/trunk/scriptators/perl/Makefile
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/perl/Makefile?view=auto&rev=503244
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/perl/Makefile (added)
+++ incubator/uima/uimacpp/trunk/scriptators/perl/Makefile Sat Feb  3 08:50:56 2007
@@ -0,0 +1,58 @@
+ifeq ($(UIMACPP_HOME),)
+  $(error UIMACPP_HOME not set)
+endif
+
+SWIGVERSION:=$(subst SWIG Version ,,$(filter SWIG Version 1.3.%,$(shell swig -version 2>&1)))
+
+ifeq ($(SWIGVERSION),)
+  $(error unable to determine SWIGVERSION)
+endif
+ifeq ($(SWIGVERSION),1.3.29)
+SWIGDEPS=uimaperlwrap.h
+SWIGFLAGS=-DSWIG$(subst .,_,$(SWIGVERSION))
+else
+SWIGFLAGS=-DSWIG_GLOBAL -DSWIG$(subst .,_,$(SWIGVERSION))
+endif
+
+###################################
+# This portion was divined by looking at the base.mak file
+
+# name of the annotator to be created
+TARGET_FILE=perltator
+
+# list of user's object files to be linked when building the annotator
+OBJS=Perltator.o uima_wrap.o
+
+#Use this var to pass additional user-defined parameters to the compiler
+USER_CFLAGS=-fPIC -g `perl -MExtUtils::Embed -e ccopts` $(SWIGFLAGS) -I..
+
+#Use this var to pass additional user-defined parameters to the linker
+USER_LINKFLAGS=-g `perl -MExtUtils::Embed -e ldopts` 
+
+# Define the symbol DEBUG=1 if you want to build a debug version
+DEBUG=1
+
+# build a shared library
+DLL_BUILD=1
+
+# include file with generic compiler instructions
+include $(UIMACPP_HOME)/lib/base.mak
+###################################
+
+test:
+	echo "$(SWIGVERSION)"
+	echo done
+
+perltator.pm uima_wrap.cxx: ../uima.i
+	swig -o uima_wrap.cxx -outdir . -c++ -perl ../uima.i
+
+uimaperlwrap.h:
+	swig -outdir . -c++ -perl -external-runtime $@
+
+Perltator.o: $(SWIGDEPS) ../ThreadAnnotator.h
+
+uima_wrap.o: uima_wrap.cxx
+	$(CC) $(CFLAGS) -c $<
+
+distclean: clean
+	rm -f uima_wrap.cxx perltator.pm uimaperlwrap.h perltator.so

Propchange: incubator/uima/uimacpp/trunk/scriptators/perl/Makefile
------------------------------------------------------------------------------
    svn:eol-style = native

Added: incubator/uima/uimacpp/trunk/scriptators/perl/Perl.html
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/perl/Perl.html?view=auto&rev=503244
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/perl/Perl.html (added)
+++ incubator/uima/uimacpp/trunk/scriptators/perl/Perl.html Sat Feb  3 08:50:56 2007
@@ -0,0 +1,82 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+
+<html>
+<head>
+	<title>UIMA Perl Annotators and the Perltator</title>
+</head>
+
+<body>
+<h1>UIMA Perl Annotators and the Perlator</h1>
+
+<h2>What is a Perl Annotator?</h2>
+<p>A Perl Annotator is a UIMA annotator component written in PERL that can be used within the
+UIMA SDK framework.
+</p>
+
+<h2>What is the Perltator?</h2>
+<p>The Perltator is the linkage between the UIMA framework and a Perl Annotator.
+The Perltator is actually a UIMA C++ annotator which can be referenced by primitive annotator or CAS consumer descriptors.
+The descriptor must define one configuration parameter, a second is optional:
+  <ul>
+    <code>SourceFile</code> (mandatory) - a string holding the name of the Perl module to run, and<br>
+    <code>DebugLevel</code> (optional) - an integer value that specifies the debug level for tracing. Default value is 0. A value of 101 turns on Perltator tracing. Values 1-100 are reserved for annotator developer use.
+  </ul>
+When the Perltator is initialized, e.g. at CPE initialization, the C++ code creates a PERL interpreter, sources the specified script and calls the script's initialization method. Similarly, when other Perltator methods such as process() are called by the UIMA framework, the subroutines of the same name in the PERL script are called.
+</p>
+<p>The Perltator also provides a PERL library implementing an interface between PERL and the UIMA APIs of the UIMA C++ Enablement layer.
+</p>
+
+<h2>Supported Platforms</h2>
+<p>The Perltator has been tested with PERL version 5.8 on Linux and with ActivePerl-5.8.8.816-MSWin32-x86-255195.msi on Windows XP.
+</p>
+<p>UIMA C++ now uses Apache APR as the platform portability library. There is an incompatibility between APR and ActivePerl typedefs which must be resolved by editing the ActivePerl header win32.h. Change uid_t and gid_t from "long" to "int".
+</p>
+
+<h2>Prerequisites</h2>
+<p>The Perltator uses SWIG (http://www.swig.org/) to implement the PERL library interface to UIMA. SWIG version 1.3.29 or later is required.</p>
+<p>The UIMA C++ Enablement layer is required. This Perltator has been tested with uimacpp version 1.4.4.
+</p>
+
+<h2>Perltator Distribution</h2>
+<p>Perltator code is distributed in source form and must be built on the target platform.</p>
+<p>Perltator source and sample code is located in the $UIMACPP_HOME/scriptators directory.</p>
+
+<h2>Setting Environment Variables</h2>
+<p>The Perltator requires the standard environment for UIMA C++ components.
+In addition, the PERLLIB environment variable should point to the path to the perltator.pm file.
+</p>
+
+
+<h2>Building and Installing the Perltator</h2>
+Recursively copy the scriptators directory from the uimacpp distribution to a writable directory tree. CD to the writable scriptators/perl directory.
+
+<h3>On Linux</h3>
+  <ul>
+    <li><code>Check that you have the required Perl and Swig packages installed</code></li>
+    <li><code>make</code></li>
+  </ul>
+
+<h3>On Windows</h3>
+  <ul>
+    <li><code>Modify winmake.cmd to set the paths for your Perl and Swig installs</code></li>
+    <li><code>winmake</code></li>
+  </ul>  
+<p>Build results are the C++ annotator, perltator.so on Linux or perlator.dll on Windows, and the Perl module interface to UIMA APIs, perltator.pm.
+</p>
+<p>If you have write access to UIMA C++ distribution tree, on Linux copy perltator.pm and perltator.so to $UIMACPP_HOME/lib and add this directory to PERLLIB. On Windows copy perltator.dll and perltator.pm to $UIMACPP_HOME/bin and add this directory to PERLLIB.</p>
+<p>If you don't have write access, make sure that perlator.so|.dll is in the LD_LIBRARY_PATH or PATH, as appropriate, and that perltator.pm is in PERLLIB.
+</p>
+
+<h2>Testing the Perltator</h2>
+</>A simple Perl regular expression annotator <code>sample.pl</code> with descriptor <code>PerlSample.xml</code> is included in the distribution. Perl annotators <EM>must be</EM> located in the environmental PATH, and on Linux the .pl files <EM>must be</EM> executable. Use the descriptor as with any other UIMA annotator descriptor.</p>
+
+<h2>Known Perltator Issues</h2>
+<p>
+  <ul>
+    <li>Not all of the UIMA C++ APIs have been swig'ed. Missing functions can be added by extending the source file uima.i.
+    <li>The Perl interpreter supports multiple scripts running concurrently on different threads in the same process. The interpreter saves the state of each script on the thread handle of the thread initiating each script. UIMA Java components such as the CPE and the Vinci and SOAP service wrappers call analytics on different threads at different times. In order to resolve this potential incompatibility, the Perltator creates a "worker thread" for each Perl analytic that is used to call into the interpreter.
+  </ul>
+</p>
+
+</body>
+</html>

Added: incubator/uima/uimacpp/trunk/scriptators/perl/PerlSample.xml
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/perl/PerlSample.xml?view=auto&rev=503244
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/perl/PerlSample.xml (added)
+++ incubator/uima/uimacpp/trunk/scriptators/perl/PerlSample.xml Sat Feb  3 08:50:56 2007
@@ -0,0 +1,100 @@
+<?xml version="1.0" encoding="UTF-8" ?> 
+<taeDescription xmlns="http://uima.apache.org/resourceSpecifier">
+  <frameworkImplementation>TAF</frameworkImplementation>
+  <primitive>true</primitive>
+<annotatorImplementationName>perltator</annotatorImplementationName>
+
+
+<analysisEngineMetaData>
+  <name>Perl Sample</name>
+  <description>Generic Perl Annotator.</description>
+  <version>1.0</version>
+  <vendor>IBM</vendor>
+
+
+<!--
+  Configuration Parameter Definitions
+-->
+        <configurationParameters>
+            <configurationParameter>
+                <name>DebugLevel</name>
+                <description>Sets the perl annotators debug level</description>
+                <type>Integer</type>
+                <multiValued>false</multiValued>
+                <mandatory>true</mandatory>
+            </configurationParameter>
+            <configurationParameter>
+                <name>SourceFile</name>
+                <description>Perl code to be loaded</description>
+                <type>String</type>
+                <multiValued>false</multiValued>
+                <mandatory>true</mandatory>
+            </configurationParameter>
+            <configurationParameter>
+                <name>matchString</name>
+                <description>Perl regular expression</description>
+                <type>String</type>
+                <multiValued>false</multiValued>
+                <mandatory>true</mandatory>
+            </configurationParameter>
+        </configurationParameters>
+
+<!--
+        Values for the configuration parameters
+-->
+        <configurationParameterSettings>
+          <nameValuePair>
+            <name>SourceFile</name>
+            <value>
+              <string>sample.pl</string>
+            </value>
+          </nameValuePair>
+          <nameValuePair>
+            <name>DebugLevel</name>
+            <value>
+              <integer>100</integer>
+            </value>
+          </nameValuePair>
+          <nameValuePair>
+            <name>matchString</name>
+            <value>
+              <string>Dave|David|human\s+rights</string>
+            </value>
+          </nameValuePair>
+        </configurationParameterSettings>
+ 
+
+<!--
+        TypeSystem Definition
+-->
+
+<typeSystemDescription>
+  <types>
+    <typeDescription>
+      <name>com.ibm.uima.examples.keyword</name>
+      <description></description>
+      <supertypeName>uima.tcas.Annotation</supertypeName>
+      <features>
+      </features>
+    </typeDescription>
+  </types>
+</typeSystemDescription>
+
+
+<!--
+Capabilities: Inputs, Outputs, and Preconditions
+-->
+<capabilities>
+  <capability>
+    <inputs/>
+    <outputs>
+      <type allAnnotatorFeatures="true">com.ibm.uima.examples.keyword</type>
+    </outputs> 
+    <languagesSupported>
+      <language>x-unspecified</language>
+    </languagesSupported>
+  </capability>
+</capabilities>
+
+</analysisEngineMetaData>
+</taeDescription>

Added: incubator/uima/uimacpp/trunk/scriptators/perl/Perltator.cpp
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/perl/Perltator.cpp?view=auto&rev=503244
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/perl/Perltator.cpp (added)
+++ incubator/uima/uimacpp/trunk/scriptators/perl/Perltator.cpp Sat Feb  3 08:50:56 2007
@@ -0,0 +1,382 @@
+/*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements.  See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership.  The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License.  You may obtain a copy of the License at
+ *
+ *   http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied.  See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ */
+
+#include "uima/api.hpp"
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#define THREAD_PROTECTION
+#ifdef THREAD_PROTECTION
+#include "ThreadAnnotator.h"
+#endif
+
+using namespace uima;
+using namespace std;
+
+#define MODULENAME "Perltator"
+
+// copied from SwigGenerated code
+
+// this function requires the SWIG code to be compiled with
+// SWIGRUNTIME defined to be "", otherwise this function is static
+// and does not scope outside of the library
+#ifndef SWIG_GLOBAL 
+// SWIG 1.3.25 or better
+#include "uimaperlwrap.h" 
+#else
+// Oh so last week, SWIG 1.3.21 style
+struct swig_type_info;
+struct swig_module_info;
+extern "C" SV *SWIG_Perl_NewPointerObj(void *, swig_type_info *, int);
+extern "C" swig_type_info * SWIG_Perl_TypeQuery(const char *);
+#define SWIG_Perl_NewPointerObj(a,b,c) SWIG_Perl_NewPointerObj(a,b,c)
+#define SWIG_TypeQueryModule(a,b,c) SWIG_Perl_TypeQuery(c)
+#define SWIG_Perl_GetModule() ((swig_module_info *) 1)
+#endif
+
+
+EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
+EXTERN_C void boot_perltator (pTHX_ CV* cv);
+
+EXTERN_C void
+xs_init(pTHX)
+{
+  char *file = __FILE__;
+  /* DynaLoader is a special case */
+  newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+  /* we will always need UIMA */
+  newXS("uimac::boot_perltator", boot_perltator, file);
+}
+
+class Perltator : public Annotator {
+  int debug;
+  swig_type_info *cas_type, *rs_type, *ts_type;
+  PerlInterpreter *my_perl;
+
+public:
+  Perltator() : my_perl(0) {}
+
+  // We construct a perl interpreter in initialize - it lives for the
+  // life of the annotator - even if reconfigure happens.  Reconfigure
+  // and intialize both set dirty so the source code in the source file
+  // and contained in the type system are evaluated.
+
+  TyErrorId initialize(AnnotatorContext &ac) {
+    swig_type_info *ac_type;
+    char srcfile[1000 + 256];
+
+    if (ac.isParameterDefined("DebugLevel")) {
+      ac.extractValue("DebugLevel", debug);
+    }
+    if (debug > 1) {
+      cerr<< MODULENAME ": Initialize - debug=" << debug <<endl;
+    }
+    if (!ac.isParameterDefined("SourceFile")) {
+      cerr<< MODULENAME ": Missing Perl SourceFile" <<endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+    }
+
+    UnicodeString fn;
+    ac.extractValue(UnicodeString("SourceFile"), fn);
+    if (fn == "") {
+      cerr<< MODULENAME ": Empty Perl SourceFile" <<endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+    }
+
+    UErrorCode err = U_ZERO_ERROR;
+    fn.extract(srcfile,sizeof(srcfile),0,err);
+    if (U_FAILURE(err)) {
+      cerr << MODULENAME ": Unable to extract parameter, got " << u_errorName(err) << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+    }
+
+    if (my_perl == 0) {
+      my_perl = perl_alloc();
+      perl_construct(my_perl);
+      
+      char * my_argv[] = { "", "-S", srcfile };
+      perl_parse(my_perl, xs_init, 3, my_argv, (char **) NULL);
+      PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+
+      perl_run(my_perl);
+
+
+      // convert cas and rs to python variables (parameters) 
+      swig_module_info *module = SWIG_Perl_GetModule();
+      if (!module) {
+        cerr << MODULENAME ": could not get Perl swig module" << endl;
+        return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+      }
+
+      ts_type = SWIG_TypeQueryModule(module,module, "TypeSystem *");
+      if (!ts_type) {
+        cerr << MODULENAME ": could lookup TypeSystem type in swig" << endl;
+        return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+      }
+      ac_type = SWIG_TypeQueryModule(module,module, "AnnotatorContext *");
+      if (!ac_type) {
+        cerr << MODULENAME ": could lookup AnnotatorContext type in swig" << endl;
+        return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+      }
+      cas_type = SWIG_TypeQueryModule(module,module, "CAS *");
+      if (!cas_type) {
+        cerr << MODULENAME ": could lookup cas type in swig" << endl;
+        return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+      }
+      rs_type = SWIG_TypeQueryModule(module,module, 
+	"ResultSpecification *");
+      if (!rs_type) {
+        cerr << MODULENAME ": could lookup rs type in swig" << endl;
+        return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+      }
+    }
+
+    dSP ;
+
+    ENTER ;
+    SAVETMPS ;
+
+    PUSHMARK(SP) ;
+    XPUSHs(SWIG_Perl_NewPointerObj(
+       reinterpret_cast<void *>( const_cast<AnnotatorContext *>(&ac)),
+       ac_type, 0));
+
+    PUTBACK ;
+    call_pv("initialize", G_DISCARD);
+
+    FREETMPS ;
+    LEAVE ;
+
+    if (SvTRUE(ERRSV)) {
+      cerr << MODULENAME  " initialize error " 
+           << SvPV_nolen(ERRSV) << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+    }
+
+    return UIMA_ERR_NONE;
+  }
+
+  TyErrorId reconfigure() {
+    if (my_perl == 0) {
+      cerr << MODULENAME ": not initialized in reconfigure" << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+    }
+    if (debug > 1) {
+      cerr<< MODULENAME ": reconfigure" <<endl;
+    }
+
+    dSP ;
+    ENTER ;
+    SAVETMPS ;
+
+    PUSHMARK(SP) ;
+    PUTBACK ;
+    call_pv("reconfigure", G_DISCARD);
+
+    FREETMPS ;
+    LEAVE ;
+
+    if (SvTRUE(ERRSV)) {
+      cerr << MODULENAME " reconfigure error " 
+           << SvPV_nolen(ERRSV) << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+    }
+
+    return UIMA_ERR_NONE;
+  }
+  
+  TyErrorId batchProcessComplete() {
+    if (my_perl == 0) {
+      cerr << MODULENAME 
+           ": not initialized in batchProcessComplete" << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_PROCESS;
+    }
+    if (debug > 1) {
+      cerr<< MODULENAME ": batchProcessComplete" <<endl;
+    }
+
+    dSP ;
+    ENTER ;
+    SAVETMPS ;
+
+    PUSHMARK(SP) ;
+    PUTBACK ;
+    call_pv("batchProcessComplete", G_DISCARD);
+
+    FREETMPS ;
+    LEAVE ;
+
+    if (SvTRUE(ERRSV)) {
+      cerr << MODULENAME " batchProcessComplete error "
+	   << SvPV_nolen(ERRSV) << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_PROCESS;
+    }
+
+    return UIMA_ERR_NONE;
+  }
+
+  TyErrorId collectionProcessComplete() {
+    if (my_perl == 0) {
+      cerr << MODULENAME 
+           ": not initialized in collectionProcessComplete" << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_PROCESS;
+    }
+    if (debug > 1) {
+      cerr<< MODULENAME ": collectionProcessComplete" <<endl;
+    }
+
+    dSP ;
+    ENTER ;
+    SAVETMPS ;
+
+    PUSHMARK(SP) ;
+    PUTBACK ;
+    call_pv("collectionProcessComplete", G_DISCARD);
+
+    FREETMPS ;
+    LEAVE ;
+
+    if (SvTRUE(ERRSV)) {
+      cerr << MODULENAME " collectionProcessComplete error "
+	   << SvPV_nolen(ERRSV) << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_PROCESS;
+    }
+
+    return UIMA_ERR_NONE;
+  }
+
+  TyErrorId typeSystemInit(TypeSystem const &ts) {
+    if (my_perl == 0) {
+      cerr << MODULENAME ": not initialized in typeSystemInit" << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+    }
+    if (debug > 1) {
+      cerr<< MODULENAME ": typeSystemInit" <<endl;
+    }
+
+    dSP ;
+    ENTER ;
+    SAVETMPS ;
+
+    PUSHMARK(SP) ;
+    XPUSHs(SWIG_Perl_NewPointerObj(
+       reinterpret_cast<void *>( const_cast<TypeSystem *>(&ts)),
+       ts_type, 0));
+
+    PUTBACK ;
+    call_pv("typeSystemInit", G_DISCARD);
+
+    FREETMPS ;
+    LEAVE ;
+
+    if (SvTRUE(ERRSV)) {
+      cerr << MODULENAME  " typeSystemInit error " << SvPV_nolen(ERRSV)
+           << endl;
+      return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+    }
+
+    return UIMA_ERR_NONE;
+  }
+
+/** 
+ * call the UIMA Annotator to deinitialize itself based on a UIMA engine
+ * and return a UIMA error code
+ */
+  TyErrorId destroy()
+  { 
+    if (debug > 1) {
+      cerr<< MODULENAME ": destroy " << endl;
+    }
+
+    dSP ;
+    ENTER ;
+    SAVETMPS ;
+
+    PUSHMARK(SP) ;
+    PUTBACK ;
+    call_pv("destroy", G_DISCARD);
+
+    FREETMPS ;
+    LEAVE ;
+
+    if (SvTRUE(ERRSV)) {
+      cerr << MODULENAME  " destory error (ignored) " 
+           << SvPV_nolen(ERRSV) << endl;
+    }
+
+    PL_perl_destruct_level = 0;
+    perl_destruct(my_perl);
+    perl_free(my_perl);
+    my_perl = 0;
+    return (TyErrorId)UIMA_ERR_NONE;
+  }
+
+/**
+ * call the UIMA Annotator to perform its duty based on a UIMA engine
+ * and return a UIMA error code
+ */
+  TyErrorId process(CAS &_cas, ResultSpecification const & _rs) { 
+    if (debug > 1) {
+      cerr<< MODULENAME ": process " << endl;
+    }
+
+    TyErrorId rc = UIMA_ERR_NONE;
+ 
+    dSP ;
+    ENTER ;
+    SAVETMPS ;
+
+    PUSHMARK(SP) ;
+    XPUSHs(
+       SWIG_Perl_NewPointerObj(
+       reinterpret_cast<void *>( &_cas), cas_type, 0));
+    XPUSHs(
+       SWIG_Perl_NewPointerObj(
+       reinterpret_cast<void *>( 
+		const_cast<ResultSpecification *>(&_rs)),
+       rs_type, 0));
+
+    PUTBACK ;
+    call_pv("process", G_DISCARD);
+
+    FREETMPS ;
+    LEAVE ;
+
+    if (SvTRUE(ERRSV)) {
+      cerr << MODULENAME " process error " 
+	   << SvPV_nolen(ERRSV) << endl;
+      rc = UIMA_ERR_USER_ANNOTATOR_COULD_NOT_PROCESS;
+    }
+
+    return rc;
+  }
+
+};
+
+
+#ifdef THREAD_PROTECTION
+MAKE_AE(ThreadAnnotator<Perltator>);
+#else
+MAKE_AE(Perltator);
+#endif
+
+
+/* <EOF> */
+

Propchange: incubator/uima/uimacpp/trunk/scriptators/perl/Perltator.cpp
------------------------------------------------------------------------------
    svn:eol-style = native

Added: incubator/uima/uimacpp/trunk/scriptators/perl/sample.pl
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/perl/sample.pl?view=auto&rev=503244
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/perl/sample.pl (added)
+++ incubator/uima/uimacpp/trunk/scriptators/perl/sample.pl Sat Feb  3 08:50:56 2007
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+ # Licensed to the Apache Software Foundation (ASF) under one
+ # or more contributor license agreements.  See the NOTICE file
+ # distributed with this work for additional information
+ # regarding copyright ownership.  The ASF licenses this file
+ # to you under the Apache License, Version 2.0 (the
+ # "License"); you may not use this file except in compliance
+ # with the License.  You may obtain a copy of the License at
+ # 
+ #   http://www.apache.org/licenses/LICENSE-2.0
+ # 
+ # Unless required by applicable law or agreed to in writing,
+ # software distributed under the License is distributed on an
+ # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ # KIND, either express or implied.  See the License for the
+ # specific language governing permissions and limitations
+ # under the License.
+
+use perltator;
+use strict;
+
+sub initialize {
+  $main::ac = shift;
+  $main::matchString = $main::ac->extractValue("matchString");
+  $main::thisScript = $main::ac->extractValue("SourceFile");
+  $main::debug = $main::ac->extractIntegerValue("DebugLevel");
+  if ($main::debug > 0) { 
+    print "$main::thisScript: Using match string = $main::matchString \n";
+  }
+}
+
+sub typeSystemInit {
+  my $ts = shift;
+  if ($main::debug > 10) {
+    print "$main::thisScript: Type sytem init called"
+  }
+  my $keytype = "com.ibm.uima.examples.keyword";
+  $main::keywordtype = $ts->getType($keytype);
+  if (!$main::keywordtype->isValid()) {
+    my $error = "$main::thisScript: $keytype is NOT found in type system!";
+    $main::ac->logError($error);
+    # set eval error to cause annotator to exit prematurely
+    $@ = $error;
+  }
+}
+
+#
+# the process method is passed two parameters, the CAS and
+# the ResultsSpecification
+sub process {
+  my ($tcas, $rs) = @_;
+  if ($main::debug > 10) {
+    print "$main::thisScript: This is a process function\n";
+  }
+  my $text = $tcas->getDocumentText();
+  my $index = $tcas->getIndexRepository();
+  my $annotCount = 0;
+  while ($text =~ m/($main::matchString)/igo) {
+    my $length = length($1);
+    my $end= pos($text);
+    my $fs = $tcas->createAnnotation($main::keywordtype, $end-$length, $end);
+    $index->addFS($fs);
+    $annotCount++;
+  }
+  if ($main::debug > 10) {
+    print "$main::thisScript: created $annotCount annotations\n";
+  }
+  if ($main::debug > 20) {
+    my $annots = 0;
+    my $iterator = $tcas->getAnnotationIndex($main::keywordtype)->iterator();
+    while ($iterator->isValid()) {
+	$annots += 1;
+	if ($main::debug > 30) {
+	    my $anno = $iterator->get();
+	    my $text = $anno->getCoveredText();
+	    if (length($text)>40) {
+		$text = substr($text,0,20) . "...";
+	    }
+	    $text =~ s/\n+/ /g;
+	    print "Annotation type=", $main::keywordtype->getName(),": \"$text\"\n"; 
+	}
+	$iterator->moveToNext();
+    }
+    print "$main::thisScript: found $annots annotations\n";
+  }
+}