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:52:36 UTC
svn commit: r503246 - in /incubator/uima/uimacpp/trunk/scriptators/tcl: ./
Makefile Tcl.html TclSample.xml Tclator.cpp sample.tcl
Author: eae
Date: Sat Feb 3 08:52:35 2007
New Revision: 503246
URL: http://svn.apache.org/viewvc?view=rev&rev=503246
Log:
Initial entry
Added:
incubator/uima/uimacpp/trunk/scriptators/tcl/
incubator/uima/uimacpp/trunk/scriptators/tcl/Makefile (with props)
incubator/uima/uimacpp/trunk/scriptators/tcl/Tcl.html
incubator/uima/uimacpp/trunk/scriptators/tcl/TclSample.xml
incubator/uima/uimacpp/trunk/scriptators/tcl/Tclator.cpp (with props)
incubator/uima/uimacpp/trunk/scriptators/tcl/sample.tcl
Added: incubator/uima/uimacpp/trunk/scriptators/tcl/Makefile
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/tcl/Makefile?view=auto&rev=503246
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/tcl/Makefile (added)
+++ incubator/uima/uimacpp/trunk/scriptators/tcl/Makefile Sat Feb 3 08:52:35 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=uimatclwrap.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=tclator
+
+# list of user's object files to be linked when building the annotator
+OBJS=Tclator.o uima_wrap.o
+
+#Use this var to pass additional user-defined parameters to the compiler
+USER_CFLAGS=-fPIC -g $(SWIGFLAGS) -I..
+
+#Use this var to pass additional user-defined parameters to the linker
+USER_LINKFLAGS=-g -ltcl8.4 -lpthread
+
+# 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
+
+tclator.pm uima_wrap.cxx: ../uima.i
+ swig -o uima_wrap.cxx -outdir . -c++ -tcl ../uima.i
+
+uimatclwrap.h:
+ swig -outdir . -c++ -tcl -external-runtime $@
+
+Tclator.o: $(SWIGDEPS)
+
+uima_wrap.o: uima_wrap.cxx
+ $(CC) $(CFLAGS) -c $<
+
+distclean: clean
+ rm -f uima_wrap.cxx uimatclwrap.h
Propchange: incubator/uima/uimacpp/trunk/scriptators/tcl/Makefile
------------------------------------------------------------------------------
svn:eol-style = native
Added: incubator/uima/uimacpp/trunk/scriptators/tcl/Tcl.html
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/tcl/Tcl.html?view=auto&rev=503246
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/tcl/Tcl.html (added)
+++ incubator/uima/uimacpp/trunk/scriptators/tcl/Tcl.html Sat Feb 3 08:52:35 2007
@@ -0,0 +1,79 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+
+<html>
+<head>
+ <title>UIMA Tcl Annotators and the Tclator</title>
+</head>
+
+<body>
+<h1>UIMA Tcl Annotators and the Tclator</h1>
+
+<h2>What is a Tcl Annotator?</h2>
+<p>A Tcl Annotator is a UIMA annotator component written in Tcl that can be used within the
+UIMA SDK framework.
+</p>
+
+<h2>What is the Tclator?</h2>
+<p>The Tclator is the linkage between the UIMA framework and a Tcl Annotator.
+The Tclator 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 Tcl 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 Tclator tracing. Values 1-100 are reserved for annotator developer use.
+ </ul>
+When the Tclator is initialized, e.g. at CPE initialization, the C++ code creates a Tcl interpreter, imports the specified script and calls the script's initialization method. Similarly, when other Tclator methods such as process() are called by the UIMA framework, the associated methods in the Tcl script are called.
+</p>
+<p>The Tclator also provides a Tcl library implementing an interface between Tcl and the UIMA APIs of the UIMA C++ Enablement layer.
+</p>
+
+<h2>Supported Platforms</h2>
+<p>The Tclator has been tested with Tcl version 8.4 on Linux and with ActiveTcl8.4.13.0.261555-win32-ix86-threaded.exe on Windows XP.
+</p>
+
+<h2>Prerequisites</h2>
+<p>The Tclator uses SWIG (http://www.swig.org/) to implement the Tcl library interface to UIMA. SWIG version 1.3.29 or later is required.</p>
+<p>The UIMA C++ Enablement layer is required. This Tclator has been tested with uimacpp version 1.4.4.
+</p>
+
+<h2>Tclator Distribution</h2>
+<p>Tclator code is distributed in source form and must be built on the target platform.</p>
+<p>Tclator source and sample code is located in the $UIMACPP_HOME/scriptators directory.</p>
+
+<h2>Setting Environment Variables</h2>
+<p>The Tclator requires the standard environment for UIMA C++ components.
+</p>
+
+
+<h2>Building and Installing the Tclator</h2>
+Recursively copy the scriptators directory from the uimacpp distribution to a writable directory tree. CD to the writable scriptators/tcl directory.
+
+<h3>On Linux</h3>
+ <ul>
+ <li><code>Check that you have the required Tcl 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 Tcl and Swig installs</code></li>
+ <li><code>winmake</code></li>
+ </ul>
+<p>Build results are the C++ annotator, tclator.so on Linux or tclator.dll on Windows.
+</p>
+<p>If you have write access to UIMA C++ distribution tree, on Linux copy tclator.so to $UIMACPP_HOME/lib, and on Windows copy tclator.dll to $UIMACPP_HOME/bin.</p>
+<p>If you don't have write access, make sure that tclator.so|.dll is in the LD_LIBRARY_PATH or PATH, as appropriate.
+</p>
+
+<h2>Testing the Tclator</h2>
+</>A simple Tcl regular expression annotator <code>sample.tcl</code> with descriptor <code>TclSample.xml</code> is included in the distribution. Use the descriptor as with any other UIMA annotator descriptor. Note that the Tcl script specified by the descriptor must be explicitly located, either with an absolute path or a path relative to the descriptor file.</p>
+
+<h2>Known Tclator 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>UIMA Java components such as the CPE and the Vinci and SOAP service wrappers call analytics on different threads at different times. The Tcltator creates a "worker thread" for each Tcl analytic that is used to call into the interpreter.
+ </ul>
+</p>
+
+</body>
+</html>
Added: incubator/uima/uimacpp/trunk/scriptators/tcl/TclSample.xml
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/tcl/TclSample.xml?view=auto&rev=503246
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/tcl/TclSample.xml (added)
+++ incubator/uima/uimacpp/trunk/scriptators/tcl/TclSample.xml Sat Feb 3 08:52:35 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>tclator</annotatorImplementationName>
+
+
+<analysisEngineMetaData>
+ <name>Tcl Sample</name>
+ <description>Generic Tcl 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>Tcl code to be loaded</description>
+ <type>String</type>
+ <multiValued>false</multiValued>
+ <mandatory>true</mandatory>
+ </configurationParameter>
+ <configurationParameter>
+ <name>matchString</name>
+ <description>Tcl 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.tcl</string>
+ </value>
+ </nameValuePair>
+ <nameValuePair>
+ <name>DebugLevel</name>
+ <value>
+ <integer>101</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/tcl/Tclator.cpp
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/tcl/Tclator.cpp?view=auto&rev=503246
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/tcl/Tclator.cpp (added)
+++ incubator/uima/uimacpp/trunk/scriptators/tcl/Tclator.cpp Sat Feb 3 08:52:35 2007
@@ -0,0 +1,421 @@
+/*
+ * 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 <tcl.h>
+#include "uima/api.hpp"
+
+#define THREAD_PROTECTION
+#ifdef THREAD_PROTECTION
+#include "ThreadAnnotator.h"
+#endif
+
+using namespace uima;
+using namespace std;
+
+#define MODULENAME "Tclator"
+
+extern "C" { int Tclator_Init(Tcl_Interp * interp); }
+
+#ifdef LINUX
+// Allow use of single threaded Tcl interpreter in multithreaded environments
+#define MUTEX_DEFINE static pthread_mutex_t mutex;
+#define MUTEX_INIT pthread_mutex_init(&mutex,0);
+#define MUTEX_LOCK pthread_mutex_lock(&mutex);
+#define MUTEX_UNLOCK pthread_mutex_unlock(&mutex);
+#define MUTEX_ALLOCATE pthread_mutex_t Tclator::mutex = PTHREAD_MUTEX_INITIALIZER;
+#else
+// Not supported yet
+#define MUTEX_DEFINE
+#define MUTEX_INIT
+#define MUTEX_LOCK
+#define MUTEX_UNLOCK
+#define MUTEX_ALLOCATE
+#endif
+
+// 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
+#if !defined(SWIG_GLOBAL) && !defined(SWIGRUNTIME)
+// SWIG 1.3.29 or better
+#include "uimatclwrap.h"
+#endif
+
+const char *default_methods =
+ "proc initialize {ac} {}\n"
+ "proc typeSystemInit {ts} {}\n"
+ "proc destroy {} {}\n"
+ "proc process {cas rs} {}\n"
+ "proc reconfigure {} {}\n"
+ "proc batchProcessComplete {} {}\n"
+ "proc collectionProcessComplete {} {}\n";
+
+class Tclator : public Annotator {
+ int debug;
+ MUTEX_DEFINE
+ swig_type_info *cas_type, *rs_type, *ts_type;
+ Tcl_Interp *interp;
+ Tcl_Obj *commands[7];
+ enum CMDS { INITIALIZE, TYPESYSTEMINIT, DESTROY, PROCESS, RECONFIGURE, BATCHPROCESSCOMPLETE, COLLECTIONPROCESSCOMPLETE };
+
+public:
+
+ Tclator() : interp(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 > 0) {
+ cerr<< MODULENAME ": Initialize - debug=" << debug <<endl;
+ }
+ if (!ac.isParameterDefined("SourceFile")) {
+ cerr<< MODULENAME ": Missing Tcl SourceFile" <<endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+
+ UnicodeString fn;
+ ac.extractValue(UnicodeString("SourceFile"), fn);
+ if (fn == "") {
+ cerr<< MODULENAME ": Empty Tcl SourceFile" <<endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+
+ // cerr << fn << endl;
+
+ 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 (interp == 0) {
+ // this seems to make windows work
+ // would be nice to know argv[0] somehow
+ Tcl_FindExecutable( 0 );
+
+ interp = Tcl_CreateInterp();
+ if (interp == 0) {
+ cerr << MODULENAME ": failed to create interpreter" << endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+
+ int tclret = Tcl_Init(interp);
+ if (tclret != TCL_OK) {
+ cerr << MODULENAME ": failed to init interpreter - " <<
+ Tcl_GetStringResult(interp) << endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+
+ if (Tclator_Init(interp) != TCL_OK) {
+ cerr << MODULENAME ": failed to init tclator package" << endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+
+ commands[INITIALIZE] = Tcl_NewStringObj("initialize", -1);
+ commands[TYPESYSTEMINIT] = Tcl_NewStringObj("typeSystemInit", -1);
+ commands[RECONFIGURE] = Tcl_NewStringObj("reconfigure", -1);
+ commands[PROCESS] = Tcl_NewStringObj("process", -1);
+ commands[DESTROY] = Tcl_NewStringObj("destroy", -1);
+ commands[BATCHPROCESSCOMPLETE] = Tcl_NewStringObj("batchProcessComplete", -1);
+ commands[COLLECTIONPROCESSCOMPLETE] = Tcl_NewStringObj("collectionProcessComplete", -1);
+
+ for (unsigned int i=0; i<7; ++i) Tcl_IncrRefCount(commands[i]);
+
+ if (Tcl_Eval(interp, default_methods) != TCL_OK) {
+ cerr << MODULENAME << ": Error - " <<
+ Tcl_GetStringResult(interp) << endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+
+ if (Tcl_EvalFile(interp, srcfile) != TCL_OK) {
+ cerr << MODULENAME << ": Error - " <<
+ Tcl_GetStringResult(interp) << endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+
+ // this is a static variable because of the way that SWIG's
+ // initialization code is written.
+ static swig_module_info *module = 0;
+ if (module == 0) {
+ MUTEX_INIT
+ MUTEX_LOCK
+ module = SWIG_Tcl_GetModule(interp);
+ } else {
+ MUTEX_LOCK
+ SWIG_Tcl_SetModule(interp, module);
+ }
+
+ if (!module) {
+ cerr << MODULENAME ": could not get Tcl swig module" << endl;
+ MUTEX_UNLOCK
+ 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;
+ MUTEX_UNLOCK
+ 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;
+ MUTEX_UNLOCK
+ 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;
+ MUTEX_UNLOCK
+ 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;
+ MUTEX_UNLOCK
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+ }
+
+ Tcl_Obj *args[2];
+ args[0] = commands[INITIALIZE];
+ args[1] = SWIG_Tcl_NewPointerObj(
+ reinterpret_cast<void *>( const_cast<AnnotatorContext *>(&ac)),
+ ac_type, 0);
+ Tcl_IncrRefCount(args[0]);
+ Tcl_IncrRefCount(args[1]);
+ int rc = Tcl_EvalObjv(interp, 2, args, 0);
+ Tcl_DecrRefCount(args[0]);
+ Tcl_DecrRefCount(args[1]);
+ if (rc != TCL_OK) {
+ cerr << MODULENAME " initialize error " <<
+ Tcl_GetStringResult(interp) << endl;
+ MUTEX_UNLOCK
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+ MUTEX_UNLOCK
+ return UIMA_ERR_NONE;
+ }
+
+ TyErrorId reconfigure() {
+ if (interp == 0) {
+ cerr << MODULENAME ": not initialized in reconfigure" << endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+ if (debug > 100) {
+ cerr<< MODULENAME ": reconfigure" <<endl;
+ }
+
+ MUTEX_LOCK
+ Tcl_Obj *args[1];
+ args[0] = commands[RECONFIGURE];
+ Tcl_IncrRefCount(args[0]);
+ int rc = Tcl_EvalObjv(interp, 1, args, 0);
+ Tcl_DecrRefCount(args[0]);
+ if ( rc != TCL_OK) {
+ cerr << MODULENAME " reconfigure error " <<
+ Tcl_GetStringResult(interp) << endl;
+ MUTEX_UNLOCK
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+ MUTEX_UNLOCK
+ return UIMA_ERR_NONE;
+ }
+
+ TyErrorId typeSystemInit(TypeSystem const &ts) {
+ if (interp == 0) {
+ cerr << MODULENAME ": not initialized in typeSystemInit" << endl;
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+ if (debug > 100) {
+ cerr<< MODULENAME ": typeSystemInit" <<endl;
+ }
+
+ MUTEX_LOCK
+ Tcl_Obj *args[2];
+ args[0] = commands[TYPESYSTEMINIT];
+ args[1] =
+ SWIG_Tcl_NewPointerObj(
+ reinterpret_cast<void *>( const_cast<TypeSystem *>(&ts)),
+ ts_type, 0);
+ Tcl_IncrRefCount(args[0]);
+ Tcl_IncrRefCount(args[1]);
+ int rc = Tcl_EvalObjv(interp, 2, args, 0);
+ Tcl_DecrRefCount(args[1]);
+ Tcl_DecrRefCount(args[0]);
+ if (rc != TCL_OK) {
+ cerr << MODULENAME " typeSystemInit error " <<
+ Tcl_GetStringResult(interp) << endl;
+ MUTEX_UNLOCK
+ return UIMA_ERR_USER_ANNOTATOR_COULD_NOT_INIT;
+ }
+ MUTEX_UNLOCK
+ 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 > 100) {
+ cerr<< MODULENAME ": destroy " << endl;
+ }
+ if (interp != 0) {
+ MUTEX_LOCK
+ Tcl_Obj *args[1];
+ args[0] = commands[DESTROY];
+ Tcl_IncrRefCount(args[0]);
+ if (Tcl_EvalObjv(interp, 1, args, 0) != TCL_OK) {
+ cerr << MODULENAME " destroy error (ignored) " <<
+ Tcl_GetStringResult(interp) << endl;
+ }
+ Tcl_DecrRefCount(args[0]);
+
+ for (unsigned int i=0; i<7; ++i) {
+ if (commands[i]) Tcl_DecrRefCount(commands[i]);
+ commands[i] = 0;
+ }
+ Tcl_DeleteInterp(interp);
+ interp = 0;
+ MUTEX_UNLOCK
+ }
+ 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 > 100) {
+ cerr<< MODULENAME ": process " << endl;
+ }
+
+ TyErrorId rc = UIMA_ERR_NONE;
+
+ MUTEX_LOCK
+ Tcl_Obj *args[3];
+ args[0] = commands[PROCESS];
+ args[1] =
+ SWIG_Tcl_NewPointerObj(
+ reinterpret_cast<void *>( &_cas), cas_type, 0);
+ args[2] =
+ SWIG_Tcl_NewPointerObj(
+ reinterpret_cast<void *>(
+ const_cast<ResultSpecification *>(&_rs)),
+ rs_type, 0);
+ Tcl_IncrRefCount(args[0]);
+ Tcl_IncrRefCount(args[1]);
+ Tcl_IncrRefCount(args[2]);
+ int trc = Tcl_EvalObjv(interp, 3, args, 0);
+ Tcl_DecrRefCount(args[2]);
+ Tcl_DecrRefCount(args[1]);
+ Tcl_DecrRefCount(args[0]);
+
+ if (trc != TCL_OK) {
+ cerr << MODULENAME " process error (ignored) " <<
+ Tcl_GetStringResult(interp) << endl;
+ rc = UIMA_ERR_USER_ANNOTATOR_COULD_NOT_PROCESS;
+ }
+ MUTEX_UNLOCK
+ return rc;
+ }
+
+/**
+ * call the UIMA Annotator batchProcessComplete method
+ * and return a UIMA error code
+ */
+ TyErrorId batchProcessComplete()
+ {
+ if (debug > 100) {
+ cerr<< MODULENAME ": batchProcessComplete " << endl;
+ }
+
+ TyErrorId rc = UIMA_ERR_NONE;
+
+ MUTEX_LOCK
+ Tcl_Obj *args[1];
+ args[0] = commands[BATCHPROCESSCOMPLETE];
+ Tcl_IncrRefCount(args[0]);
+ int trc = Tcl_EvalObjv(interp, 1, args, 0);
+ Tcl_DecrRefCount(args[0]);
+
+ if (trc != TCL_OK) {
+ cerr << MODULENAME " batchProcessComplete error (ignored) " <<
+ Tcl_GetStringResult(interp) << endl;
+ rc = UIMA_ERR_USER_ANNOTATOR_COULD_NOT_PROCESS;
+ }
+ MUTEX_UNLOCK
+ return rc;
+ }
+
+/**
+ * call the UIMA Annotator collectionProcessComplete method
+ * and return a UIMA error code
+ */
+ TyErrorId collectionProcessComplete()
+ {
+ if (debug > 100) {
+ cerr<< MODULENAME ": collectionProcessComplete " << endl;
+ }
+
+ TyErrorId rc = UIMA_ERR_NONE;
+ MUTEX_LOCK
+
+ Tcl_Obj *args[1];
+ args[0] = commands[COLLECTIONPROCESSCOMPLETE];
+ Tcl_IncrRefCount(args[0]);
+ int trc = Tcl_EvalObjv(interp, 1, args, 0);
+ Tcl_DecrRefCount(args[0]);
+
+ if (trc != TCL_OK) {
+ cerr << MODULENAME " collectionProcessComplete error (ignored) " <<
+ Tcl_GetStringResult(interp) << endl;
+ rc = UIMA_ERR_USER_ANNOTATOR_COULD_NOT_PROCESS;
+ }
+ MUTEX_UNLOCK
+ return rc;
+ }
+
+};
+
+MUTEX_ALLOCATE
+
+#ifdef THREAD_PROTECTION
+MAKE_AE(ThreadAnnotator<Tclator>);
+#else
+MAKE_AE(Tclator);
+#endif
+
+
+/* <EOF> */
+
Propchange: incubator/uima/uimacpp/trunk/scriptators/tcl/Tclator.cpp
------------------------------------------------------------------------------
svn:eol-style = native
Added: incubator/uima/uimacpp/trunk/scriptators/tcl/sample.tcl
URL: http://svn.apache.org/viewvc/incubator/uima/uimacpp/trunk/scriptators/tcl/sample.tcl?view=auto&rev=503246
==============================================================================
--- incubator/uima/uimacpp/trunk/scriptators/tcl/sample.tcl (added)
+++ incubator/uima/uimacpp/trunk/scriptators/tcl/sample.tcl Sat Feb 3 08:52:35 2007
@@ -0,0 +1,81 @@
+ # 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.
+
+proc initialize {annotContext} {
+ global matchString thisScript ac debug
+ AnnotatorContext ac -this $annotContext
+ set matchString [ac extractValue "matchString"]
+ set thisScript [ac extractValue "SourceFile"]
+ set debug [ac extractIntegerValue "DebugLevel"]
+ if {$debug > 0} then {
+ puts "$thisScript: initialize match string = $matchString"
+ }
+}
+
+proc typeSystemInit {ts} {
+ TypeSystem ts -this $ts
+ global keywordtype thisScript ac debug
+ if {$debug > 10} then {
+ puts "$thisScript: Type sytem init called"
+ }
+ set keywordtype [ts getType "com.ibm.uima.examples.keyword"]
+ if {![$keywordtype isValid]} then {
+ set error "$thisScript: com.ibm.uima.examples.keyword NOT found in type system\n"
+ ac logError "$error"
+ error "$error"
+ }
+}
+
+#
+# the process method is passed two parameters, the CAS and
+# the ResultsSpecification
+proc process {cas rs} {
+ global keywordtype thisScript matchString debug
+ CAS cas -this $cas
+ if {$debug > 10} then {
+ puts "$thisScript: This is a process function"
+ }
+
+ set text [cas getDocumentText]
+ set indexRep [cas getIndexRepository]
+ set total 0
+ set matches [regexp -nocase -indices -all -inline -- $matchString $text]
+ foreach pair $matches {
+ set begin [lindex $pair 0]
+ set end [expr [lindex $pair 1]+1]
+ set fs [cas createAnnotation $keywordtype $begin $end]
+ $indexRep addFS $fs
+ $fs -delete
+ incr total
+ }
+ $indexRep -delete
+ if {$debug > 0} then {
+ puts "$thisScript: created $total annotations"
+ }
+ if {$debug > 20} then {
+ set annots 0
+ set anIndex [cas getAnnotationIndex $keywordtype]
+ set iterator [$anIndex iterator]
+ while {[$iterator isValid]} {
+ incr annots
+ $iterator moveToNext
+ }
+ puts "$thisScript: found $annots annotations"
+ $anIndex -delete
+ $iterator -delete
+ }
+}