File: Unaccent.xs

package info (click to toggle)
libtext-unaccent-perl 1.08-1.3
  • links: PTS
  • area: main
  • in suites: buster, sid, stretch
  • size: 640 kB
  • ctags: 254
  • sloc: ansic: 1,276; makefile: 49; perl: 12
file content (109 lines) | stat: -rw-r--r-- 2,643 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
/*
 * Copyright (C) 2000, 2001, 2002 Loic Dachary <loic@senga.org>
 *
 * This program 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.
 *
 * 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, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "perlio.h"

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif /* HAVE_CONFIG_H */

/*
 * Perl config.h defines HAS_VPRINTF if printf variants are 
 * available
 */
#ifdef HAS_VPRINTF
#define HAVE_VSNPRINTF
#endif /* HAS_VPRINTF */

#include "unac.h"

static char* buffer;
static size_t buffer_length;

static void unac_debug_print(const char* message, void* data)
{
  if(PerlIO_puts(PerlIO_stderr(), message) != strlen(message))
    perror("unac_debug_print");
}

MODULE = Text::Unaccent PACKAGE = Text::Unaccent PREFIX = perl_

BOOT:
	buffer = 0;
	buffer_length = 0;
	{
		SV* sv;
		sv = get_sv("Text::Unaccent::DEBUG_NONE", TRUE|GV_ADDMULTI);
		sv_setiv(sv, UNAC_DEBUG_NONE);
		sv = get_sv("Text::Unaccent::DEBUG_LOW", TRUE|GV_ADDMULTI);
		sv_setiv(sv, UNAC_DEBUG_LOW);
		sv = get_sv("Text::Unaccent::DEBUG_HIGH", TRUE|GV_ADDMULTI);
		sv_setiv(sv, UNAC_DEBUG_HIGH);
	}

SV*
perl_unac_string(charset,in)
	char* charset
	char* in
	PROTOTYPE: $$
	CODE:
		STRLEN in_length;
		in_length = SvCUR(ST(1));
		if(unac_string(charset,
			       in, in_length,
			       &buffer, &buffer_length) == 0) {
	          RETVAL = newSVpv(buffer, buffer_length);
		} else {
		  perror("unac_string");
		  RETVAL = &PL_sv_undef;
		}
         OUTPUT:
		RETVAL

SV*
perl_unac_string_utf16(in)
	char* in
	PROTOTYPE: $
	CODE:
		STRLEN in_length;
		in_length = SvCUR(ST(0));
		if(unac_string_utf16(in, in_length,
				     &buffer, &buffer_length) == 0) {
	          RETVAL = newSVpv(buffer, buffer_length);
		} else {
		  perror("unac_string_utf16");
		  RETVAL = &PL_sv_undef;
		}
	OUTPUT:
		RETVAL

SV*
perl_unac_version()
	CODE:
	        RETVAL = newSVpv((char*)unac_version(), 0);
	OUTPUT:
		RETVAL

void
perl_unac_debug(in)
	int in
	PROTOTYPE: $
	CODE:
	        unac_debug_callback(in, unac_debug_print, NULL);