hbytes/hook.c

   1 /*
   2  */
   3
   4 #include "hbytes.h"
   5 #include "tables.h"
   6
   7 int staticerr(Tcl_Interp *ip, const char *m) {
   8   Tcl_SetResult(ip, (char*)m, TCL_STATIC);
   9   return TCL_ERROR;
  10 }
  11
  12 void objfreeir(Tcl_Obj *o) {
  13   if (o->typePtr && o->typePtr->freeIntRepProc)
  14     o->typePtr->freeIntRepProc(o);
  15   o->typePtr= 0;
  16 }
  17
  18 int do_hbytes_rep_info(ClientData cd, Tcl_Interp *ip,
  19                        HBytes_Value v, Tcl_Obj **result) {
  20   const char *tn;
  21   int nums[3], i;
  22   Tcl_Obj *objl[4];
  23
  24   memset(nums,0,sizeof(nums));
  25   nums[1]= hbytes_len(&v);
  26
  27   if (HBYTES_ISEMPTY(&v)) tn= "empty";
  28   else if (HBYTES_ISSENTINEL(&v)) tn= "sentinel!";
  29   else if (HBYTES_ISSIMPLE(&v)) tn= "simple";
  30   else {
  31     HBytes_ComplexValue *cx= v.begin_complex;
  32     tn= "complex";
  33     nums[0]= cx->prespace;
  34     nums[2]= cx->avail - cx->len;
  35   }
  36
  37   objl[0]= Tcl_NewStringObj((char*)tn,-1);
  38   for (i=0; i<3; i++) objl[i+1]= Tcl_NewIntObj(nums[i]);
  39   *result= Tcl_NewListObj(4,objl);
  40   return TCL_OK;
  41 }
  42
  43 static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
  44   objfreeir(dup);
  45   hbytes_array(OBJ_HBYTES(dup),
  46                hbytes_data(OBJ_HBYTES(src)),
  47                hbytes_len(OBJ_HBYTES(src)));
  48 }
  49
  50 static void hbytes_t_free(Tcl_Obj *o) {
  51   hbytes_free(OBJ_HBYTES(o));
  52 }
  53
  54 static void hbytes_t_ustr(Tcl_Obj *o) {
  55   int l;
  56   char *str;
  57   const Byte *byte;
  58
  59   byte= hbytes_data(OBJ_HBYTES(o));
  60   l= hbytes_len(OBJ_HBYTES(o));
  61   str= o->bytes= TALLOC(l*2+1);
  62   o->length= l*2;
  63   while (l>0) {
  64     sprintf(str,"%02x",*byte);
  65     str+=2; byte++; l--;
  66   }
  67   *str= 0;
  68 }
  69
  70 static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  71   char *str, *ep, *os;
  72   Byte *startbytes, *bytes;
  73   int l;
  74   char cbuf[3];
  75
  76   os= str= Tcl_GetStringFromObj(o,&l);  assert(str);
  77   objfreeir(o);
  78
  79   if (l & 1) return staticerr(ip, "hbytes: conversion from hex:"
  80                               " odd length in hex");
  81
  82   startbytes= bytes= hbytes_arrayspace(OBJ_HBYTES(o), l/2);
  83
  84   cbuf[2]= 0;
  85   while (l>0) {
  86     cbuf[0]= *str++;
  87     cbuf[1]= *str++;
  88     *bytes++= strtoul(cbuf,&ep,16);
  89     if (ep != cbuf+2) {
  90       hbytes_free(OBJ_HBYTES(o));
  91       return staticerr(ip, "hbytes: conversion from hex:"
  92                        " bad hex digit");
  93     }
  94     l -= 2;
  95   }
  96
  97   o->typePtr = &hbytes_type;
  98   return TCL_OK;
  99 }
 100
 101 Tcl_ObjType hbytes_type = {
 102   "hbytes",
 103   hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
 104 };
 105
 106 int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
 107                     Tcl_Obj *binary, HBytes_Value *result) {
 108   const char *str;
 109   int l;
 110
 111   str= Tcl_GetStringFromObj(binary,&l);
 112   hbytes_array(result, str, l);
 113   return TCL_OK;
 114 }
 115
 116 int do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
 117                     HBytes_Value hex, Tcl_Obj **result) {
 118   *result= Tcl_NewStringObj(hbytes_data(&hex), hbytes_len(&hex));
 119   return TCL_OK;
 120 }
 121
 122 int do_hbytes_length(ClientData cd, Tcl_Interp *ip,
 123                      HBytes_Value v, int *result) {
 124   *result= hbytes_len(&v);
 125   return TCL_OK;
 126 }
 127
 128 int do__hbytes(ClientData cd, Tcl_Interp *ip,
 129                const HBytes_SubCommand *subcmd,
 130                int objc, Tcl_Obj *const *objv) {
 131   return subcmd->func(0,ip,objc,objv);
 132 }
 133
 134 int Hbytes_Init(Tcl_Interp *ip) {
 135   Tcl_RegisterObjType(&hbytes_type);
 136   Tcl_RegisterObjType(&enum_nearlytype);
 137   Tcl_RegisterObjType(&enum1_nearlytype);
 138   Tcl_CreateObjCommand(ip,"hbytes", pa__hbytes,0,0);
 139   return TCL_OK;
 140 }