view release on metacpan or  search on metacpan

Param.xs  view on Meta::CPAN

/* --8<--8<--8<--8<--
 *
 * Copyright (C) 2006 Smithsonian Astrophysical Observatory
 *
 * This file is part of CIAO-Lib-Param
 *
 * CIAO-Lib-Param 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 2
 * of the License, or (at your option) any later version.
 *
 * CIAO-Lib-Param 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, write to the
 *       Free Software Foundation, Inc.
 *       51 Franklin Street, Fifth Floor
 *       Boston, MA  02110-1301, USA
 *
 * -->8-->8-->8-->8-- */

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

/* Global Data */

#define MY_CXT_KEY "CIAO::Lib::Param::_guts" XS_VERSION

typedef struct {
  int parerr;
  int level;
  char* errmsg;
} my_cxt_t;

START_MY_CXT



#include "ppport.h"

#ifdef FLAT_INCLUDES
#include <parameter.h>
#else
#include <cxcparam/parameter.h>
#endif

/* yes, this is gross, but it beats including pfile.h */
extern int parerr;

/* no choice here; these aren't prototyped anywhere from pfile.c */
typedef void (*vector)();
vector paramerract( void (*newact)() );

/* this is definitely overkill, as this could (and was) handled
   transparently by the XS typemap code. At one point it
   was thought that per-object data was required and the code
   was converted to use this structure as the basis for the
   object, rather than simply blessing the pointer to the paramfile
   structure
*/
typedef struct PFile
{
  paramfile *pf;
} PFile;

/* needed for typemap magic */
typedef PFile*  CIAO_Lib_ParamPtr;
typedef pmatchlist CIAO_Lib_Param_MatchPtr;

/* use Perl to get temporary space in interface routines; it'll
   get garbage collected automatically */
static void *
get_mortalspace( int nbytes )
{
  SV  *mortal = sv_2mortal( NEWSV(0, nbytes ) );
  char *ptr = SvPVX( mortal );

  /* set the extra NULL byte that Perl gives us to NULL
     to allow easy string overflow checking */
  ptr[nbytes] = '\0';

  return ptr;
}


static SV*
carp_shortmess( char* message )
{
  SV* short_message;
  int count;

  dSP;
  ENTER ;
  SAVETMPS ;

  /* ensure that Carp is loaded */
  load_module( PERL_LOADMOD_NOIMPORT, newSVpvn( "Carp", 4 ), (SV*) NULL );

  PUSHMARK(SP);
  XPUSHs( sv_2mortal(newSVpv(message,0)) );
  PUTBACK;

  /* make sure there's something to work with */
  count = call_pv( "Carp::shortmess", G_SCALAR );

  SPAGAIN ;

  if ( 1 != count )
    croak( "internal error passing message to Carp::shortmess" );

  short_message = newSVsv( POPs );

  PUTBACK ;
  FREETMPS ;
  LEAVE ;