/* ------------------------------------------------------------------------
@NAME : BibTeX.xs
@INPUT :
@OUTPUT :
@RETURNS :
@DESCRIPTION: Glue between my `btparse' library and the Perl module
Text::BibTeX. Provides the following functions to Perl:
Text::BibTeX::constant
Text::BibTeX::initialize
Text::BibTeX::cleanup
Text::BibTeX::split_list
Text::BibTeX::purify_string
Text::BibTeX::Entry::_parse_s
Text::BibTeX::Entry::_parse
Text::BibTeX::Name::split
Text::BibTeX::Name::free
Text::BibTeX::add_macro_text
Text::BibTeX::delete_macro
Text::BibTeX::delete_all_macros
Text::BibTeX::macro_length
Text::BibTeX::macro_text
@GLOBALS :
@CALLS :
@CREATED : Jan/Feb 1997, Greg Ward
@MODIFIED :
@VERSION : $Id: BibTeX.xs 7399 2009-06-01 21:22:51Z ambs $
-------------------------------------------------------------------------- */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define BT_DEBUG 0
#include "btparse.h"
#include "btxs_support.h"
MODULE = Text::BibTeX PACKAGE = Text::BibTeX
# XSUBs with no corresponding functions in the C library (hence no prefix
# for this section):
# constant
SV *
constant(name)
char * name
CODE:
IV i;
if (constant(name, &i))
ST(0) = sv_2mortal(newSViv(i));
else
ST(0) = &PL_sv_undef;
MODULE = Text::BibTeX PACKAGE = Text::BibTeX PREFIX = bt_
# XSUBs that consist solely of calls to corresponding C functions in the
# library:
# initialize
# cleanup
void
bt_initialize()
void
bt_cleanup()
# XSUBs that still go right into the Text::BibTeX package (ie. they don't
# really belong in one of the subsidiary packages), but need a bit of work
# to convert the C data to Perl form:
# split_list
# purify_string
void
bt_split_list (string, delim, filename=NULL, line=0, description=NULL)
char * string
char * delim
char * filename
int line
char * description
PREINIT:
bt_stringlist *
names;
int i;
SV * sv_name;
PPCODE:
names = bt_split_list (string, delim, filename, line, description);
if (names == NULL)
XSRETURN_EMPTY; /* return empty list to perl */
EXTEND (sp, names->num_items);
for (i = 0; i < names->num_items; i++)
{
if (names->items[i] == NULL)
sv_name = &PL_sv_undef;
else
sv_name = sv_2mortal (newSVpv (names->items[i], 0));
PUSHs (sv_name);
}
bt_free_list (names);
SV *
bt_purify_string (instr, options=0)
char * instr
int options
CODE:
if (instr == NULL) /* undef in, undef out */
XSRETURN_EMPTY;
RETVAL = newSVpv (instr, 0);
bt_purify_string (SvPVX (RETVAL), (btshort) options);
SvCUR_set (RETVAL, strlen (SvPVX (RETVAL))); /* reset SV's length */
OUTPUT:
RETVAL
# Here's an alternate formulation of `purify_string' that acts more like
# the C function (and less like nice Perl): it modifies the input string
# in place, and returns nothing. In addition to being weird Perl,
# this contradicts the documentation. And it would be impossible
# to replicate this behaviour in a similar Python extension... all
# round, a bad idea!
## void
## bt_purify_string (str, options=0)
## char * str
## int options
## CODE:
## if (str != NULL)
## bt_purify_string (str, (btshort) options);
## sv_setpv (ST(0), str);
SV *
bt_change_case (transform, string, options=0)
char transform
char * string
int options
CODE:
DBG_ACTION
(1, printf ("XSUB change_case: transform=%c, string=%p (%s)\n",
transform, string, string))
if (string == NULL)
XSRETURN_EMPTY;
RETVAL = newSVpv (string, 0);
bt_change_case (transform, SvPVX (RETVAL), (btshort) options);
OUTPUT:
RETVAL
MODULE = Text::BibTeX PACKAGE = Text::BibTeX::Entry
# The two XSUBs that go to the Text::BibTeX::Entry package; both rely on
# ast_to_hash() to do the appropriate "convert to Perl form" work:
# _parse
# _parse_s
int
_parse (entry_ref, filename, file, preserve=FALSE)
SV * entry_ref;
char * filename;
FILE * file;
boolean preserve;
PREINIT:
btshort options = 0;
boolean status;
AST * top;
CODE:
top = bt_parse_entry (file, filename, options, &status);
DBG_ACTION
(2, dump_ast ("BibTeX.xs:parse: AST from bt_parse_entry():\n", top))
if (!top) /* at EOF -- return false to perl */
{
XSRETURN_NO;
}
ast_to_hash (entry_ref, top, status, preserve);
XSRETURN_YES; /* OK -- return true to perl */
int
_parse_s (entry_ref, text, preserve=FALSE)
SV * entry_ref;
char * text;
boolean preserve;
PREINIT:
btshort options = 0;
boolean status;
AST * top;
CODE:
top = bt_parse_entry_s (text, NULL, 1, options, &status);
if (!top) /* no entry found -- return false to perl */
{
XSRETURN_NO;
}
ast_to_hash (entry_ref, top, status, preserve);
XSRETURN_YES; /* OK -- return true to perl */
MODULE = Text::BibTeX PACKAGE = Text::BibTeX::Name
# The XSUBs that go in the Text::BibTeX::Name package (ie. that operate
# on name objects):
# split
# free
#if BT_DEBUG
void
dump_name (hashref)
SV * hashref
PREINIT:
HV * hash;
SV ** sv_name;
bt_name * name;
CODE:
hash = (HV *) SvRV (hashref);
sv_name = hv_fetch (hash, "_cstruct", 8, 0);
if (! sv_name)
{
warn ("Name::dump: no _cstruct member in hash");
}
else
{
name = (bt_name *) SvIV (*sv_name);
dump_name (name); /* currently in format_name.c */
}
#endif
void
_split (name_hashref, name, filename, line, name_num, keep_cstruct)
SV * name_hashref
char * name
char * filename
int line
int name_num
int keep_cstruct
PREINIT:
HV * name_hash;
SV * sv_old_name;
bt_name * old_name;
bt_name * name_split;
CODE:
if (! (SvROK (name_hashref) &&
SvTYPE (SvRV (name_hashref)) == SVt_PVHV))
croak ("name_hashref is not a hash reference");
name_hash = (HV *) SvRV (name_hashref);
DBG_ACTION (1,
{
printf ("XS Name::_split:\n");
printf (" name_hashref=%p, name_hash=%p\n",
(void *) name_hashref, (void *) name_hash);
printf (" name=%p (%s), filename=%p (%s)\n",
name, name, filename, filename);
printf (" line=%d, name_num=%d, keep_cstruct=%d\n",
line, name_num, keep_cstruct);
})
sv_old_name = hv_delete (name_hash, "_cstruct", 8, 0);
if (sv_old_name)
{
old_name = (bt_name *) SvIV (sv_old_name);
DBG_ACTION
(1, printf ("XS Name::_split: name hash had old C structure "
"(%d tokens, first was >%s<) -- freeing it\n",
old_name->tokens->num_items,
old_name->tokens->items[0]))
bt_free_name (old_name);
}
name_split = bt_split_name (name, filename, line, name_num);
DBG_ACTION (1, printf ("XS Name::_split: back from bt_split_name, "
"calling store_stringlist x 4\n"))
store_stringlist (name_hash, "first",
name_split->parts[BTN_FIRST],
name_split->part_len[BTN_FIRST]);
store_stringlist (name_hash, "von",
name_split->parts[BTN_VON],
name_split->part_len[BTN_VON]);
store_stringlist (name_hash, "last",
name_split->parts[BTN_LAST],
name_split->part_len[BTN_LAST]);
store_stringlist (name_hash, "jr",
name_split->parts[BTN_JR],
name_split->part_len[BTN_JR]);
DBG_ACTION (1,
{
char ** last = name_split->parts[BTN_LAST];
char ** first = name_split->parts[BTN_FIRST];
printf ("XS Name::_split: name has %d tokens; "
"last[0]=%s, first[0]=%s\n",
name_split->tokens->num_items,
last ? last[0] : "*no last name*",
first ? first[0] : "*no first name*");
})
if (keep_cstruct)
{
hv_store (name_hash, "_cstruct", 8, newSViv ((IV) name_split), 0);
DBG_ACTION
(1, printf ("XS Name::_split: storing pointer to structure %p\n",
name_split))
}
else
{
bt_free_name (name_split);
}
void
free (name_hashref)
SV * name_hashref
PREINIT:
HV * name_hash;
SV ** sv_name;
bt_name * name;
CODE:
name_hash = (HV *) SvRV (name_hashref);
sv_name = hv_fetch (name_hash, "_cstruct", 8, 0);
if (sv_name != NULL)
{
name = (bt_name *) SvIV (*sv_name);
DBG_ACTION (1, printf ("XS Name::free: freeing name %p\n", name))
bt_free_name (name);
}
#if BT_DEBUG >= 1
else
{
printf ("XS Name::free: no C structure to free!\n");
}
#endif
MODULE = Text::BibTeX PACKAGE = Text::BibTeX::NameFormat
IV
create (parts="fvlj", abbrev_first=FALSE)
char * parts
bool abbrev_first
PREINIT:
CODE:
DBG_ACTION
(1, printf ("XS NameFormat::create: "
"creating name format: parts=\"%s\", abbrev=%d\n",
parts, abbrev_first));
RETVAL = (IV) bt_create_name_format (parts, abbrev_first);
OUTPUT:
RETVAL
void
free (format)
bt_name_format * format
CODE:
bt_free_name_format ((bt_name_format *) format);
#if BT_DEBUG
void
dump_format (hashref)
SV * hashref
PREINIT:
HV * hash;
SV ** sv_format;
bt_name_format * format;
CODE:
hash = (HV *) SvRV (hashref);
sv_format = hv_fetch (hash, "_cstruct", 8, 0);
if (! sv_format)
{
warn ("NameFormat::dump: no _cstruct member in hash");
}
else
{
format = (bt_name_format *) SvIV (*sv_format);
dump_format (format); /* currently in format_name.c */
}
#endif
void
_set_text (format, part, pre_part, post_part, pre_token, post_token)
bt_name_format * format
bt_namepart part
char * pre_part
char * post_part
char * pre_token
char * post_token
CODE:
#if BT_DEBUG >= 2
{
static char * nameparts[] =
{ "first", "von", "last", "jr" };
static char * joinmethods[] =
{"may tie", "space", "force tie", "nothing"};
printf ("XS NameFormat::_set_text:\n");
printf (" format=%p, namepart=%d (%s)\n",
format, part, nameparts[part]);
printf (" format currently is:\n");
dump_format (format);
printf (" pre_part=%s, post_part=%s\n", pre_part, post_part);
printf (" pre_token=%s, post_token=%s\n", pre_token, post_token);
}
#endif
/*
* No memory leak here -- just copy the pointers. At first
* blush, it might seem that we're opening ourselves up to
* the possibility of dangling pointers if the Perl strings
* that these char *'s refer to ever go away. However, this
* is taken care of at the Perl level -- see the comment
* in BibTeX/NameFormat.pm, sub set_text.
*/
bt_set_format_text (format, part,
pre_part, post_part, pre_token, post_token);
#if BT_DEBUG >= 2
printf ("XS NameFormat::_set_text: after call, format is:\n");
dump_format (format);
#endif
void
_set_options (format, part, abbrev, join_tokens, join_part)
bt_name_format * format
bt_namepart part
bool abbrev
bt_joinmethod join_tokens
bt_joinmethod join_part
CODE:
DBG_ACTION (2,
printf ("XS _set_options: format=%p, part=%d, "
"abbrev=%d, join_tokens=%d, join_part=%d\n",
format, part, abbrev, join_tokens, join_part))
bt_set_format_options (format, part,
abbrev, join_tokens, join_part);
char *
format_name (name, format)
bt_name * name
bt_name_format * format
CODE:
DBG_ACTION
(2, printf ("XS format_name: name=%p, format=%p\n", name, format))
RETVAL = bt_format_name (name, format);
DBG_ACTION
(1, printf ("XS format_name: formatted name=%s\n", RETVAL))
OUTPUT:
RETVAL
MODULE = Text::BibTeX PACKAGE = Text::BibTeX PREFIX = bt_
void
bt_add_macro_text (macro, text, filename=NULL, line=0)
char * macro
char * text
char * filename
int line
void
bt_delete_macro (macro)
char * macro
void
bt_delete_all_macros ()
int
bt_macro_length (macro)
char * macro
char *
bt_macro_text (macro, filename=NULL, line=0)
char * macro
char * filename
int line
# This bootstrap code is used to make btparse do "minimal post-processing"
# on all entries. That way, we can control how much is done on a per-entry
# basis by simply calling bt_postprocess_entry() ourselves.
#
# The need to do this means that btparse is somewhat brain-damaged -- I
# should be able to specify the per-entry processing options when I call
# bt_parse_entry()! Shouldn't be too hard to fix....
BOOT:
bt_set_stringopts (BTE_MACRODEF, 0);
bt_set_stringopts (BTE_REGULAR, 0);
bt_set_stringopts (BTE_COMMENT, 0);
bt_set_stringopts (BTE_PREAMBLE, 0);