[TimLinux] TCL 自定义包

1. 包

很多功能存放在一起，定义为一个包，在iTcl（Incr TCL）之后，可以定义一个类，类可以放在一个包里面，包为一个独立的文件，可以为TCL文件，也可以为C/C++语言实现的动态库。

2. 代码结构

.
├── env.sh  // 提供了 TCL_PACKAGE_ROOT 环境变量
├── lib
│   ├── init.tcl  // tcl 执行时，source 该变量，提供auto_path寻找包的路径
│   ├── libpkg.so  // C语言提供的包
│   ├── pkg.c  // C代码，编译成libpkg.so
│   ├── pkgIndex.tcl  // 包导出方法，该文件生成命令为tclsh环境中执行：pkg_mkIndex -- ./ *.so tools/*.tcl
│   └── tools
│       └── basic.tcl  // Tcl提供的包
└── tst
    └── test.tcl  // 测试代码

3. 各文件内容

3.1. env.sh

#!/bin/bash

export TCL_PACKAGE_ROOT=$(pwd)

3.2. lib/init.tcl

if {[info exists env(TCL_PACKAGE_ROOT)] && (string trim $env(TCL_PACKAGE_ROOT) != "")} {
    lappend auto_path $env(TCL_PACKAGE_ROOT)
} else {
    puts "Need TCL_PACKAGE_ROOT env."
}

3.3. lib/pkg.c

// gcc -I/path/to/tcl/include -shared -o libpkg.so pkg.c
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "tcl.h"

int Pkg_Init(Tcl_Interp *Interp);
int Pkg_Unload(Tcl_Interp *Interp, int flags);

int newcmd(int notUsed, Tcl_Interp *interp, int argc, char **argv)
{
    if (argc != 2) {
        Tcl_SetResult(interp, "Usage::newcmd arg1", TCL_VOLATILE);
        return TCL_ERROR;
    }

    printf("argv[1] is %s.
", argv[1]);
    Tcl_SetResult(interp, "This is my return", TCL_VOLATILE);
    return TCL_OK;
}

int Pkg_Init(Tcl_Interp *Interp)
{
    if (Tcl_PkgProvide(Interp, "pkg", "1.0") == TCL_ERROR) {
        return TCL_ERROR;
    }

    Tcl_CreateCommand(Interp, "newcmd", (Tcl_CmdProc *)newcmd, 0, 0);
    return TCL_OK;
}

int Pkg_Unload(Tcl_Interp *Interp, int flags)
{
    return TCL_OK;
}

3.4. lib/tools/basic.tcl

package provide Tools 1.0

namespace eval tools {
    proc Test {args} {}
}

proc tools::Test {args} {
    puts "In tools::Test"
}

3.5. tst/test.tcl

#!/usr/bin/env tclsh

source $env(TCL_PACKAGE_ROOT)/lib/init.tcl

package require Tools
package require pkg

tools::Test
set retStr [newcmd "hehe"]
puts "==$retStr=="

3.6. lib/pkgIndex.tcl

该文件通过如下方式自动生成:

$ cd lib/
$ tclsh
% pkg_mkIndex -- ./ tools/*.tcl *.so

$ cat pkgIndex.tcl
# Tcl package index file, version 1.1
# This file is generated by the "pk_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script. It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands. When this
# script is sourced, the variable $dir must contain the
# full path name of this files's directory.
package ifneeded Tools 1.0 [list source [file join $dir tools/basic.tcl]]
package ifneeded pkg 1.0 [list load [file join $dir libpkg.so]]

4. 测试

$ source env.sh
$ cd tst/
$ chmod +x ./test.tcl
$ ./test.tcl
In tools::Test
argv[1] is hehe
==This is my return==