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
|
/* $Id: filesystem.c,v 1.9 2003/09/23 20:00:19 jfontain Exp $ */
/* to create the loadable library, use: cc -shared -o libfilesystem.so.1.1 -O2 -fPIC -Wall filesystem.c */
/* with stubs: cc -shared -o libfilesystem.so.1.1 -O2 -fPIC -Wall -DUSE_TCL_STUBS filesystem.c /usr/lib/libtclstub8.3.a */
/* pkgIndex.tcl: package ifneeded filesystem 1.1 [list load [file join $dir libfilesystem.so.1.1]] */
#include <tcl.h>
#include <sys/statvfs.h>
#include <errno.h>
#include <string.h>
static int fileSystemStatistics(ClientData clientData, Tcl_Interp *interpreter, int numberOfArguments, Tcl_Obj * CONST arguments[])
{
struct statvfs statistics;
Tcl_Obj *object;
if(numberOfArguments != 2){
Tcl_WrongNumArgs(interpreter, 1, arguments, "device");
return TCL_ERROR;
}
if(statvfs(Tcl_GetStringFromObj(arguments[1], 0), &statistics) < 0){
Tcl_SetObjResult(interpreter, Tcl_NewStringObj(strerror(errno), -1)); /* core takes care of freeing object */
return TCL_ERROR;
}
object = Tcl_NewObj();
Tcl_ListObjAppendElement(interpreter, object, Tcl_NewLongObj(statistics.f_bsize)); /* optimal transfer block size */
Tcl_ListObjAppendElement(interpreter, object, Tcl_NewLongObj(statistics.f_blocks)); /* total data blocks */
Tcl_ListObjAppendElement(interpreter, object, Tcl_NewLongObj(statistics.f_bavail)); /* free blocks available to normal users */
Tcl_ListObjAppendElement(interpreter, object, Tcl_NewLongObj(statistics.f_blocks - statistics.f_bfree)); /* used blocks */
#if defined(sunos4) || defined(sun)
Tcl_ListObjAppendElement(interpreter, object, Tcl_NewLongObj(statistics.f_frsize)); /* block size on Solaris */
#else
Tcl_ListObjAppendElement(interpreter, object, Tcl_NewObj()); /* on Linux, use optimal transfer block size instead */
#endif
Tcl_SetObjResult(interpreter, object); /* core takes care of freeing object */
return TCL_OK;
}
EXTERN int Filesystem_Init(Tcl_Interp *interpreter) /* create all commands in filesystem namespace */
{
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interpreter, "8.1", 0) == NULL) {
return TCL_ERROR;
}
#endif
Tcl_CreateObjCommand(interpreter, "::filesystem::statistics", fileSystemStatistics, 0, 0);
return Tcl_PkgProvide(interpreter, "filesystem", "1.1");
}
EXTERN int Filesystem_SafeInit(Tcl_Interp *interpreter)
{
return Filesystem_Init(interpreter); /* all commands are safe */
}
|
