File: second_pkg.tcl

package info (click to toggle)
critcl 3.3.1%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 9,680 kB
  • sloc: ansic: 41,058; tcl: 12,090; sh: 7,230; pascal: 3,456; asm: 3,058; ada: 1,681; cpp: 1,001; cs: 879; makefile: 333; perl: 104; xml: 95; f90: 10
file content (131 lines) | stat: -rw-r--r-- 3,702 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
# -*- tcl -*-
# Critcl support, absolutely necessary.
package require critcl

# Bail out early if the compile environment is not suitable.
if {![critcl::compiling]} {
    error "Unable to build project, no proper compiler found."
}

# Information for the teapot.txt meta data file put into a generated package.
# Free form strings.
critcl::license {Andreas Kupries} {Under a BSD license}

critcl::summary {The second CriTcl-based package}

critcl::description {
    This package is the second example of a CriTcl-based package. It contains all the
    necessary and conventionally useful pieces for wrapping an external library.
}

critcl::subject {external library usage} example {critcl package}
critcl::subject {wrapping external library}

# Minimal Tcl version the package should load into.
critcl::tcl 8.6

# Locations for headers and shared library of the library to wrap.
# Required only for non-standard locations, i.e. where CC is not searching by default.
critcl::cheaders   -I/usr/include
critcl::clibraries -L/usr/lib/x86_64-linux-gnu
critcl::clibraries -lzstd

# Provide non-standard compiler and linker flags
#critcl::cflags -Dsome_define
#critcl::ldflags

# Import library API
critcl::include zstd.h

# ## #### ######### ################ #########################
## (De)compression using Zstd
## Data to (de)compress is passed in and returned as Tcl byte arrays.

critcl::cproc compress {
    Tcl_Interp* ip
    bytes       data
    int         {level ZSTD_CLEVEL_DEFAULT}
} object0 {
    /* critcl_bytes data; (.s, .len, .o) */
    Tcl_Obj* error_message;

    int max = ZSTD_maxCLevel();
    if ((level < 1) || (level > max)) {
	error_message = Tcl_ObjPrintf ("level must be integer between 1 and %d", max);
	goto err;
    }

    size_t dest_sz  = ZSTD_compressBound (data.len);
    void*  dest_buf = Tcl_Alloc(dest_sz);

    if (!dest_buf) {
	error_message = Tcl_NewStringObj ("can't allocate memory to compress data", -1);
	goto err;
    }

    size_t compressed_size = ZSTD_compress (dest_buf, dest_sz,
					    data.s,   data.len,
					    level);
    if (ZSTD_isError (compressed_size)) {
	Tcl_Free(dest_buf);
	error_message = Tcl_ObjPrintf ("zstd encoding error: %s",
				       ZSTD_getErrorName (compressed_size));
	goto err;
    }

    Tcl_Obj* compressed = Tcl_NewByteArrayObj (dest_buf, compressed_size);
    Tcl_Free (dest_buf);

    return compressed;
  err:
    Tcl_SetObjResult (ip, error_message);
    return 0;
}

critcl::cproc decompress {
    Tcl_Interp*  ip
    bytes        data
} object0 {
    Tcl_Obj* error_message;

    size_t dest_sz = ZSTD_getDecompressedSize (data.s, data.len);
    if (dest_sz == 0) {
        error_message = Tcl_NewStringObj("invalid data", -1);
	goto err;
    }

    void* dest_buf = Tcl_Alloc (dest_sz);
    if (!dest_buf) {
	error_message = Tcl_NewStringObj("failed to allocate decompression buffer", -1);
	goto err;
    }

    size_t decompressed_size = ZSTD_decompress (dest_buf, dest_sz,
						data.s,   data.len);
    if (decompressed_size != dest_sz) {
	Tcl_Free (dest_buf);
        error_message = Tcl_ObjPrintf("zstd decoding error: %s",
				      ZSTD_getErrorName (decompressed_size));
	goto err;
    }

    Tcl_Obj* decompressed = Tcl_NewByteArrayObj (dest_buf, dest_sz);
    Tcl_Free (dest_buf);

    return decompressed;

  err:
    Tcl_SetObjResult (ip, error_message);
    return 0;
}

# ## #### ######### ################ #########################

# Forcing compilation, link, and loading now.
critcl::msg -nonewline { Building ...}
if {![critcl::load]} {
    error "Building and loading the project failed."
}

# Name and version the package. Just like for every kind of Tcl package.
package provide critcl-example 1