The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
/* --8<--8<--8<--8<--
 *
 * Copyright (C) 2000-2009 Smithsonian Astrophysical Observatory
 *
 * This file is part of IPC-XPA
 *
 * IPC-XPA is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *
 * -->8-->8-->8-->8-- */

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

#include "util.h"

/* convert a hash to a string, with the format "key=val,key=val" */
char *
hash2str( HV* hash )
{
  SV*   val;		/* temp for iterating over hash */
  char* key;		/* temp for iterating over hash */
  I32   keylen;		/* temp for iterating over hash */

  int   len = 0;	/* length of final string, including EOS */
  int   n;		/* number of elements in hash */

  char* str;		/* final string */
  char* ptr;		/* temp ptr */

  /* iterate over hash, determining the length of the final string */
  hv_iterinit(hash);
  while( val = hv_iternextsv(hash, &key, &keylen) )
  {
    /* complain if the value is undefined or if it's a reference */
    if ( !SvOK(val) || SvROK(val) )
      croak( "hash entry for `%s' not a scalar", key );

    n++;
    len += keylen + SvCUR(val);
  }
	  
  len +=   n		/* '=' */
         + n-1		/* ',' */
         + 1;		/* EOS */

  /* now, fill in string */
  New( 0, str, len, char );
  ptr = str;

  hv_iterinit(hash);
  while( val = hv_iternextsv(hash, &key, &keylen) )
  {
    STRLEN cur;
    char *pv;
	    
    strcpy(ptr, key);
    ptr += keylen;
    *ptr++ = '=';
    pv = SvPV(val, cur);
    strncpy(ptr, pv, cur);
    ptr += cur;
    *ptr++ = ',';
  }

  /* the EOS position now contains a ',', and ptr is one
     past that.  fix that */
  *--ptr = '\0';

  return str;
}


/* convert XPAGet client data to a Perl hash */
HV *
cdata2hash_Get( char *buf, int len, char *name, char *message )
{
  SV *sv;
  SV *ref;
  /* create hash which will contain buf, name, message */
  HV *hash = newHV();
	
  /* buf may be big, so try to get perl to use it directly */
  sv = NEWSV(0,0);
  sv_usepvn( sv, buf, len );
  if ( NULL == hv_store( hash, "buf", 3, sv, 0 ) )
    croak( "error storing length for response\n" );
	
  if ( NULL == hv_store( hash, "name", 4, newSVpv( name, 0 ), 0 ) )
    croak( "error storing name for response\n" );
		   	 
  if ( message )
  {
    if ( NULL == hv_store( hash, "message", 7, newSVpv( message, 0 ), 0 ) )
      croak( "error storing message for response\n" );
  }

  return hash;
}

/* convert XPASet/XPAInfo/XPAAccess client data to a Perl hash */
HV *
cdata2hash_Set( char *name, char *message )
{
  /* create hash which will contain name, message */
  HV *hash = newHV();
	
  if ( NULL == hv_store( hash, "name", 4, newSVpv( name, 0 ), 0 ) )
    croak( "error storing name for response\n" );
		   	 
  if ( message )
  {
    if ( NULL == hv_store( hash, "message", 7, newSVpv( message, 0 ), 0 ) )
      croak( "error storing message for response\n" );
  }
  return hash;
}

/* convert XPALookup client data to a Perl hash */
HV *
cdata2hash_Lookup( char *class, char *name, char *method, char *info )
{
  /* create hash which will contain name, message */
  HV *hash = newHV();
	
  if ( NULL == hv_store( hash, "name", 4, newSVpv(name,0), 0 ) )
    croak( "error storing name for response\n" );
		   	 
  if ( NULL == hv_store( hash, "class", 5, newSVpv(class,0), 0 ) )
    croak( "error storing class for response\n" );

  if ( NULL == hv_store( hash, "method", 6, newSVpv(method,0), 0 ) )
    croak( "error storing method for response\n" );

  if ( NULL == hv_store( hash, "info", 4, newSVpv(info,0), 0 ) )
    croak( "error storing info for response\n" );

  return hash;
}