view release on metacpan or  search on metacpan

GTM.xs  view on Meta::CPAN

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include "gtmxc_types.h"   // For GTM call-in function prototypes
#include "string.h"        // strlen(), memcpy(), strncmp()
#include "GTM.h"           // my prototypes
#include "stdlib.h"        // setenv

static void err_gtm(const GtmEnv *gt) {
  char *msgbuf = gt ? gt->errmsg : (char *)calloc(1024,sizeof(gtm_char_t)); 
  gtm_zstatus(msgbuf,1024); if(!gt || (gt && !(gt->flags & NO_WARN))) { 
    warn("GTM ERROR: (%d) %s\n", gt->last_err, msgbuf); 
  }
  if(!gt) free(msgbuf); return;
}

// Returns 1 if you should free the GVN after you're done with it
int packgvn(GtmEnv *gtenv, unsigned len,strpack strs[],
            const unsigned flags, gtm_string_t *gvn) {
  unsigned i,xlen=(gtenv && !(flags & NO_PREFIX))?gtenv->pfx_elem:0,sz,tmp; 
  unsigned err=0,freestrs=0; char *ret=NULL,*loc; strpack *seek;

  if(!gvn) return; sz = ((len+xlen)>1) ? (len+xlen)*3 : 2; if(xlen) {
    sz += (unsigned)gtenv->pfx_length;  
    for(i=xlen;i--;) if(gtenv->prefix[i].num) sz -= 2;
  }
  if((flags & TIED) && len == 1 && strchr(strs[0].address,'\034')) {
    // Multidimensional array with \034 separators
    loc = strs[0].address; while( loc = index(loc,'\034') ) { len++; loc++; }
    loc = strs[0].address; freestrs=len; i = 0; sz += (len-1)*3;
    strs = (strpack *)calloc(len,sizeof(strpack)); 
    while( loc ) {
      ret = index(loc,'\034'); if(ret) *ret = '\0'; tmp = strlen(loc);
      strs[i].address = (char *)calloc(tmp+1,sizeof(char));
      strs[i].length  = tmp; memcpy(strs[i].address, loc, tmp); 
      loc = ret ? ret+1 : ret; i++;
    }
  } 
  // Validate global, calculate final GLVN size
  if(len||xlen) ret = (xlen) ? gtenv->prefix->address : strs[0].address; 
  if(len == 1 && *strs[0].address == '^') { 
    gvn->address = strs[0].address; gvn->length  = strs[0].length; return 0;
  } else if(!(len || xlen) || !ret ||
          !(xlen || (strs[0].length && strs[0].length <= _GT_MAX_GVNSIZE)) || 
          !((*ret >= 'a' && *ret <= 'z') || (*ret >= 'A' && *ret <= 'Z')) 
  ) err++; else for(i=len;i--;) {
      if(!strs[i].length && !((flags & ZEROLEN_OK) && i==(len-1))) err++;
      else sz += strs[i].length; 
      if(is_number(strs[i].address)) { sz -= 2; strs[i].num++; }
  }
  if(err || !sz || sz > _GT_MAX_GVNLENGTH) {
    if(!(flags & NO_WARN)) warn("ERROR: Poorly-specified node name.\n"); 
    if(gtenv) {
      gtenv->last_err = 1;
      sprintf(gtenv->errmsg,"ERROR: Poorly-specified node name.");
    }
    if(freestrs) strpack_clear(strs,len); gvn->address = NULL; return 0;
  } else ret = (char *)calloc(sz+1,sizeof(char)); loc = ret; 

  *loc = '^'; loc++; for(i=0;i<(len+xlen);i++) {
    seek = (i<xlen) ? &gtenv->prefix[i] : &strs[i-xlen];
    if(i) {
      if(!seek->num) { *loc = '"'; loc++; }
      memcpy(loc, seek->address, seek->length); loc += seek->length;
      if(!seek->num) { *loc = '"'; loc++; }
      *loc = ((i+1) == (len+xlen)) ? ')' : ','; loc++;
    } else {

GTM.xs  view on Meta::CPAN

new(...)
	ALIAS:
	  TIEHASH = 1
	  TIESCALAR = 2
	  GtmEnvPtr::sub  = 3
	CODE:
	{
	  strpack *strp, *gvnprefix; 
	  GtmEnv *setup = (GtmEnv *)calloc(1,sizeof(GtmEnv)), *sub; 
	  unsigned i,len=0,tlen=0,err=0; char *test;
#ifdef _GT_NEED_SIGFIX
	  sig_t sigint;
#endif

	  setup->errmsg   = (char *)calloc(1024,sizeof(char));	
	  setup->xfer_buf = (char *)calloc(_GT_MAX_BLOCKSIZE,sizeof(char));	
          setup->flags &= (ix == 0 || ix == 3) ? NO_WARN : TIED;
	  if(items > 256) { warn("Init fail; excessive prefixes...\n"); err++; }
	  else if(items < 2) { warn("Init fail; no prefix given...\n"); err++; }
	  else {
	    if(ix == 3 && sv_isa(ST(0),"GtmEnvPtr") ) {
	      sub = (GtmEnv *)SvIV((SV*)SvRV(ST(0))); 
              len = sub->pfx_elem; tlen = sub->pfx_length;
	    } else {
              test = (char *)SvPV(ST(1),i); len = 0; tlen = 0;
	      if(!((*test>='a' && *test<='z')||(*test>='A' && *test<='Z'))) {
	        warn("Init fail; invalid starting prefix character.\n"); err++;
	      } 
	    }
	    setup->prefix = (strpack *)calloc(items+len-1,sizeof(strpack));
	    if(ix==3&&sv_isa(ST(0),"GtmEnvPtr")) for(i=sub->pfx_elem;i--;) {
	      strp = &sub->prefix[i]; gvnprefix = &setup->prefix[i];
	      gvnprefix->length = strp->length; gvnprefix->num = strp->num;
	      gvnprefix->address=(char *)calloc(strp->length+1,sizeof(char));
	      memcpy(gvnprefix->address, strp->address, strp->length);
	    }
	    for(i=1;i<items;i++) {
	      strp = &setup->prefix[i-1+len];
              test = (char *)SvPV(ST(i), strp->length);
              strp->address = (char *)calloc((strp->length)+1,sizeof(char));
	      memcpy(strp->address, test, strp->length);
	      strp->num = is_number(strp->address);
	      if(!strp->length) { warn("Init fail; null subscript.\n"); err++; }
              else tlen += strp->length;
	    }
            setup->pfx_elem = (items+len-1); setup->pfx_length = tlen; 
	    if(tlen > _GT_MAX_GVNLENGTH) { 
              warn("Init fail; prefix too long...\n"); err++; 
            }
	    if(err) { gtenv_clear(setup); }
          } 
          if(!err) { 
	    if(!_GTMinvoc) { // Save terminal settings to restore during END()
#ifdef _GT_NEED_TERMFIX
              _GTMterm = (struct termios *)calloc(1,sizeof(struct termios));
	      tcgetattr(STDIN_FILENO, _GTMterm);
#endif
#ifdef _GT_NEED_SIGFIX
	      sigint = signal(SIGINT, SIG_DFL); // Save SIGINT handler
#endif
	      setenv("GTMCI",_GT_GTMCI_LOC,0);
	      setenv("gtmroutines",_GT_GTMRTN_LOC,0);
	      setenv("gtmgbldir",_GT_GTMGBL_LOC,0);

              setup->last_err = gtm_init(); 
#ifdef _GT_NEED_SIGFIX
	      signal(SIGINT, sigint); // Restore SIGINT handler
#endif
            } else setup->last_err = 0;
            if(setup->last_err) { 
	      err_gtm(setup); gtenv_clear(setup); XSRETURN_UNDEF; 
	    } else { 
	      _GTMinvoc++; setup->gtmEnvId = _GTMinvoc; RETVAL = setup; 
            }
	  } else XSRETURN_UNDEF;
	}
	OUTPUT:
	RETVAL

void
gvn2list(...)
	ALIAS:
	  _str2list = 1
	  GTM::gvn2list  = 2
	  GTM::_str2list  = 3
	  GtmEnvPtr::gvn2list  = 4
	  GtmEnvPtr::_str2list  = 5
	PPCODE:
	{
          cppack *start = NULL, *next; SV *ret; unsigned s , x; char *glvn;
	  s = (ix < 4) ? 0 : 1; if(items < s) XSRETURN_UNDEF; 
	  start = unpackgvn( SvPV(ST(s),x) ); while(start) {
	    ret = sv_newmortal(); sv_setpv(ret, start->loc); XPUSHs(ret);
	    next = start->next; free(start); start = next;
          }
	}

void
list2gvn(...)
	ALIAS:
	  _list2str = 1
	  GTM::list2gvn = 2
	  GTM::_list2str = 3
	  GtmEnvPtr::list2gvn = 4
	  GtmEnvPtr::_list2str = 5
	  GtmEnvPtr::node = 6
	PPCODE:
	{
	  strpack *args; 
	  GtmEnv *pfx = (ix<4) ? NULL : (GtmEnv *)SvIV((SV*)SvRV(ST(0)));
	  unsigned i,s = (ix<4) ? 0 : 1, n; SV *ret;
	  gtm_string_t value, glvn;

	  EXTEND(SP,1); if(items>s) {
	    args = (strpack *)calloc(items-s,sizeof(strpack));
            for(i=s;i<items;i++) 
              args[i-s].address = (char *)SvPV(ST(i),args[i-s].length);
	    n=packgvn(pfx,items-s,args,(ix<4)?NO_PREFIX:0,&glvn); free(args); 
	  } else { n = packgvn(pfx,0,NULL,0,&glvn); }
	  if(glvn.address) { 
	    ret = sv_newmortal(); sv_setpv(ret, glvn.address); PUSHs(ret);
	    if(n) free(glvn.address);
	  } else PUSHs(&PL_sv_undef);