wait/cvs-head/WAIT.xs

#define PERL_POLLUTE

/*                               -*- Mode: C -*- 
 * $Basename: WAIT.xs $
 * $Revision: 1.6 $
 * Author          : Ulrich Pfeifer
 * Created On      : Thu Aug 15 18:01:00 1996
 * Last Modified By: Ulrich Pfeifer
 * Last Modified On: Wed Nov  5 17:01:30 1997
 * Language        : C
 * Update Count    : 106
 * Status          : Unknown, Use with caution!
 * 
 * (C) Copyright 1997, Ulrich Pfeifer, all rights reserved.
 * 
 */

#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#ifdef __cplusplus
}
#endif

#include "soundex.h"
#include "stemmer.h"
#include "metaphone.h"
#include "levenstein.h"

static unsigned char *lchars = 
        "abcdefghijklmnopqrstuvwxyzàáâãäåæçèéêëìíîïñòóôõöøùúûüýß";
static unsigned char *uchars = 
        "ABCDEFGHIJKLMNOPQRSTUVWXYZÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝß";
static          char *scodes =
        "01230120022455012623010202000000  00000000500000 000002";
static          char *pcodes =
        "01230720022455012683070808000000  00000000500000 000008";
static unsigned char tou[256];
static unsigned char tol[256];
static unsigned char tos[256];
static          char scd[256];
static          char pcd[256];
static unsigned char *nums = "0123456789";

void init_lcuc ()
{
  short i;
  short l = strlen(lchars);

  for(i=0;i<256;i++) {
    tou[i] = (unsigned char)i;
    tol[i] = (unsigned char)i;
    tos[i] = (unsigned char)' ';
    scd[i] = ' ';
    pcd[i] = ' ';
  }
  for (i=0;i<l;i++) {
    tou[lchars[i]] = uchars[i];
    tol[uchars[i]] = lchars[i];
    tos[uchars[i]] = uchars[i];
    tos[lchars[i]] = lchars[i];
    scd[uchars[i]] = scodes[i];
    scd[lchars[i]] = scodes[i];
    pcd[uchars[i]] = pcodes[i];
    pcd[lchars[i]] = pcodes[i];
  }
  for (i=0;i<10;i++) {
    tos[nums[i]] = nums[i];
  }
}

unsigned char ToUpper(c)
     unsigned char c;
{
  return (tou[c]);
}

unsigned char ToLower(c)
     unsigned char c;
{
  return (tol[c]);
}

#define ToUpper(c) (tou[c])
#define ToLower(c) (tol[c])
#define SoundexLen 4      /* length of a soundex code */
#define SoundexKey "Z000" /* default key for soundex code */

bool IsAlpha(c)
     unsigned char c;
{
  return ((bool) scd[c] != ' ');
}

bool IsVowel(c)
     unsigned char c;
{
  return ((bool) scd[c] == '0');
}

static char SCode(c)
unsigned char c;
{
  return (scd[c]);
}

#define IsAlpha(c) (scd[c] != ' ')
#define IsVowel(c) (scd[c] == '0')
#define SCode(c)   (scd[c])

char PCode(c)
unsigned char c;
{
  return (pcd[c]);
}

void SoundexCode (Name, Key)
unsigned char *Name;
unsigned char *Key;
{
  unsigned char LastLetter;
  int  Index;

  /* set default key */
  strcpy(Key, SoundexKey);
  
  /* keep first letter */
  Key[0] = *Name;
  LastLetter = *Name;
  Name++;

  /* scan rest of string */
  for (Index = 1; (Index < SoundexLen) && *Name; Name++)
  {
    /* use only letters */
    if (IsAlpha(*Name))
    {
      /* ignore duplicate successive chars */
      if (LastLetter != *Name)
      {
        /* new LastLetter */
        LastLetter = *Name;

        /* ignore letters with code 0 */
        if (!IsVowel(*Name) && (SCode(*Name) != 0))
        {
          Key[Index] = SCode(*Name);
          Index++;
        }
      }
    }
  }
}

static unsigned char * isolc (s, l)
unsigned char * s;
int l;
{
  int i;
  for (i=0;i<l;i++) {
    s[i] = tol[s[i]];
  }
  return(s);
}

static unsigned char * isouc (s, l)
unsigned char * s;
int l;
{
  int i;

  for (i=0;i<l;i++) {
    s[i] = tou[s[i]];
  }
  return(s);
}

static unsigned char * isotr (s, l)
unsigned char * s;
int l;
{
  int i;

  for (i=0;i<l;i++) {
    s[i] = tos[s[i]];
  }
  return(s);
}

MODULE = WAIT           PACKAGE = WAIT::Filter          

PROTOTYPES: ENABLE

BOOT:
        init_lcuc ();


char *
isolc(word)
        char *  word
CODE:
{
  char *copy;
  ST(0) = sv_mortalcopy(ST(0));
  copy = (char *)SvPV(ST(0),PL_na);
  (void) isolc(copy, (int)PL_na);
}

char *
isouc(word)
        char *  word
CODE:
{
  char *copy;
  ST(0) = sv_mortalcopy(ST(0));
  copy = (char *)SvPV(ST(0),PL_na);
  (void) isouc(copy, (int)PL_na);
}

char *
isotr(word)
        char *  word
CODE:
{
  char *copy;
  ST(0) = sv_mortalcopy(ST(0));
  copy = (char *)SvPV(ST(0),PL_na);
  (void) isotr(copy, (int)PL_na);
}

char *
disolc(word)
        char *  word
CODE:
{
  (void) isolc(word, (int)PL_na);
}

char *
disouc(word)
        char *  word
CODE:
{
  (void) isouc(word, (int)PL_na);
}

char *
disotr(word)
        char *  word
CODE:
{
  (void) isotr(word, (int)PL_na);
}

char *
Soundex(word)
        char *  word
CODE:   
{
  char key[5];
  Soundex (word, key);
  ST(0) = sv_newmortal();
  sv_setpv((SV *) ST(0), key);
}

char *
Phonix (word)
        char *  word
CODE:   
{
  char key[9];
  Phonix (word, key);
  ST(0) = sv_newmortal();
  sv_setpv((SV *) ST(0), key);
}

char *
Stem (word)     
        char *  word
CODE:   
{
  char copy[80];
  strncpy(copy, word, 79);
  if (Stem(copy)) {
    ST(0) = sv_newmortal();
    sv_setpv((SV *) ST(0), copy);
  }
}

char *
Metaphone (word)        
        char *  word
CODE:   
{
  char metaph[80];
  metaph[0] = '\0';
  phonetic(word,metaph,79);
  ST(0) = sv_newmortal();
  sv_setpv((SV *) ST(0), metaph);
}

void
split_pos(ipair)
        SV *    ipair;
PPCODE:
{
  AV *   aipair  = (AV *) SvRV(ipair);
  char * word    = (char *)SvPV(*av_fetch(aipair, 0, 0),PL_na);
  int    offset  = (av_len(aipair)?SvIV(*av_fetch(aipair, 1, 0)):0);
  char * begin   = word;
  SV   * pair[2];

  pair[0] = newSV((STRLEN)20);
  pair[1] = newSV((STRLEN)0);

  while (*word) {
    char * start;
    AV *   apair;
    SV *   ref;
    while (*word && isspace(*word)) word++;
    if (!*word)  break;
    start = word;
    while (*word && !isspace(*word)) word++;
    EXTEND(sp, 1);
    sv_setpvn(pair[0], start, (STRLEN)(word-start));
    sv_setiv(pair[1],offset + start - begin);
    apair   = av_make(2, pair);
    ref     = newRV_inc((SV*) apair);
    SvREFCNT_dec(apair);
    PUSHs(sv_2mortal(ref));
  }
  /* free pair */
  SvREFCNT_dec(pair[0]);
  SvREFCNT_dec(pair[1]);
}

MODULE = WAIT           PACKAGE = WAIT::Table
int
max(left,right=0)
        int     left
        int     right
CODE:
{
  RETVAL = (left>right)?left:right;
  ST(0) = sv_newmortal();
  sv_setiv(ST(0), (IV)RETVAL);
}


MODULE = WAIT           PACKAGE = WAIT::Metric

int
WLD(word,towards,mode=' ',limit=0)
        char *  word
        char *  towards
        char    mode
        int     limit
1	ulpfr	13	#define PERL_POLLUTE
2
3	ulpfr	10	/* -- Mode: C --
4			* $Basename: WAIT.xs $
5	ulpfr	13	* $Revision: 1.6 $
6	ulpfr	10	* Author : Ulrich Pfeifer
7			* Created On : Thu Aug 15 18:01:00 1996
8			* Last Modified By: Ulrich Pfeifer
9			* Last Modified On: Wed Nov 5 17:01:30 1997
10			* Language : C
11			* Update Count : 106
12			* Status : Unknown, Use with caution!
13			*
14			* (C) Copyright 1997, Ulrich Pfeifer, all rights reserved.
15			*
16			*/
17
18			#ifdef __cplusplus
19			extern "C" {
20			#endif
21			#include "EXTERN.h"
22			#include "perl.h"
23			#include "XSUB.h"
24	ulpfr	13	#include "ppport.h"
25	ulpfr	10	#ifdef __cplusplus
26			}
27			#endif
28
29			#include "soundex.h"
30			#include "stemmer.h"
31			#include "metaphone.h"
32			#include "levenstein.h"
33
34			static unsigned char *lchars =
35			"abcdefghijklmnopqrstuvwxyzàáâãäåæçèéêëìíîïñòóôõöøùúûüýß";
36			static unsigned char *uchars =
37			"ABCDEFGHIJKLMNOPQRSTUVWXYZÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝß";
38			static char *scodes =
39			"01230120022455012623010202000000 00000000500000 000002";
40			static char *pcodes =
41			"01230720022455012683070808000000 00000000500000 000008";
42			static unsigned char tou[256];
43			static unsigned char tol[256];
44			static unsigned char tos[256];
45			static char scd[256];
46			static char pcd[256];
47			static unsigned char *nums = "0123456789";
48
49			void init_lcuc ()
50			{
51			short i;
52			short l = strlen(lchars);
53
54			for(i=0;i<256;i++) {
55			tou[i] = (unsigned char)i;
56			tol[i] = (unsigned char)i;
57			tos[i] = (unsigned char)' ';
58			scd[i] = ' ';
59			pcd[i] = ' ';
60			}
61			for (i=0;i<l;i++) {
62			tou[lchars[i]] = uchars[i];
63			tol[uchars[i]] = lchars[i];
64			tos[uchars[i]] = uchars[i];
65			tos[lchars[i]] = lchars[i];
66			scd[uchars[i]] = scodes[i];
67			scd[lchars[i]] = scodes[i];
68			pcd[uchars[i]] = pcodes[i];
69			pcd[lchars[i]] = pcodes[i];
70			}
71			for (i=0;i<10;i++) {
72			tos[nums[i]] = nums[i];
73			}
74			}
75
76			unsigned char ToUpper(c)
77			unsigned char c;
78			{
79			return (tou[c]);
80			}
81
82			unsigned char ToLower(c)
83			unsigned char c;
84			{
85			return (tol[c]);
86			}
87
88			#define ToUpper(c) (tou[c])
89			#define ToLower(c) (tol[c])
90			#define SoundexLen 4 /* length of a soundex code */
91			#define SoundexKey "Z000" /* default key for soundex code */
92
93			bool IsAlpha(c)
94			unsigned char c;
95			{
96			return ((bool) scd[c] != ' ');
97			}
98
99			bool IsVowel(c)
100			unsigned char c;
101			{
102			return ((bool) scd[c] == '0');
103			}
104
105			static char SCode(c)
106			unsigned char c;
107			{
108			return (scd[c]);
109			}
110
111			#define IsAlpha(c) (scd[c] != ' ')
112			#define IsVowel(c) (scd[c] == '0')
113			#define SCode(c) (scd[c])
114
115			char PCode(c)
116			unsigned char c;
117			{
118			return (pcd[c]);
119			}
120
121			void SoundexCode (Name, Key)
122			unsigned char *Name;
123			unsigned char *Key;
124			{
125			unsigned char LastLetter;
126			int Index;
127
128			/* set default key */
129			strcpy(Key, SoundexKey);
130
131			/* keep first letter */
132			Key[0] = *Name;
133			LastLetter = *Name;
134			Name++;
135
136			/* scan rest of string */
137			for (Index = 1; (Index < SoundexLen) && *Name; Name++)
138			{
139			/* use only letters */
140			if (IsAlpha(*Name))
141			{
142			/* ignore duplicate successive chars */
143			if (LastLetter != *Name)
144			{
145			/* new LastLetter */
146			LastLetter = *Name;
147
148			/* ignore letters with code 0 */
149			if (!IsVowel(Name) && (SCode(Name) != 0))
150			{
151			Key[Index] = SCode(*Name);
152			Index++;
153			}
154			}
155			}
156			}
157			}
158
159			static unsigned char * isolc (s, l)
160			unsigned char * s;
161			int l;
162			{
163			int i;
164			for (i=0;i<l;i++) {
165			s[i] = tol[s[i]];
166			}
167			return(s);
168			}
169
170			static unsigned char * isouc (s, l)
171			unsigned char * s;
172			int l;
173			{
174			int i;
175
176			for (i=0;i<l;i++) {
177			s[i] = tou[s[i]];
178			}
179			return(s);
180			}
181
182			static unsigned char * isotr (s, l)
183			unsigned char * s;
184			int l;
185			{
186			int i;
187
188			for (i=0;i<l;i++) {
189			s[i] = tos[s[i]];
190			}
191			return(s);
192			}
193
194			MODULE = WAIT PACKAGE = WAIT::Filter
195
196			PROTOTYPES: ENABLE
197
198			BOOT:
199			init_lcuc ();
200
201
202			char *
203			isolc(word)
204			char * word
205			CODE:
206			{
207			char *copy;
208			ST(0) = sv_mortalcopy(ST(0));
209	ulpfr	13	copy = (char *)SvPV(ST(0),PL_na);
210			(void) isolc(copy, (int)PL_na);
211	ulpfr	10	}
212
213			char *
214			isouc(word)
215			char * word
216			CODE:
217			{
218			char *copy;
219			ST(0) = sv_mortalcopy(ST(0));
220	ulpfr	13	copy = (char *)SvPV(ST(0),PL_na);
221			(void) isouc(copy, (int)PL_na);
222	ulpfr	10	}
223
224			char *
225			isotr(word)
226			char * word
227			CODE:
228			{
229			char *copy;
230			ST(0) = sv_mortalcopy(ST(0));
231	ulpfr	13	copy = (char *)SvPV(ST(0),PL_na);
232			(void) isotr(copy, (int)PL_na);
233	ulpfr	10	}
234
235			char *
236			disolc(word)
237			char * word
238			CODE:
239			{
240	ulpfr	13	(void) isolc(word, (int)PL_na);
241	ulpfr	10	}
242
243			char *
244			disouc(word)
245			char * word
246			CODE:
247			{
248	ulpfr	13	(void) isouc(word, (int)PL_na);
249	ulpfr	10	}
250
251			char *
252			disotr(word)
253			char * word
254			CODE:
255			{
256	ulpfr	13	(void) isotr(word, (int)PL_na);
257	ulpfr	10	}
258
259			char *
260			Soundex(word)
261			char * word
262			CODE:
263			{
264			char key[5];
265			Soundex (word, key);
266			ST(0) = sv_newmortal();
267			sv_setpv((SV *) ST(0), key);
268			}
269
270			char *
271			Phonix (word)
272			char * word
273			CODE:
274			{
275			char key[9];
276			Phonix (word, key);
277			ST(0) = sv_newmortal();
278			sv_setpv((SV *) ST(0), key);
279			}
280
281			char *
282			Stem (word)
283			char * word
284			CODE:
285			{
286			char copy[80];
287			strncpy(copy, word, 79);
288			if (Stem(copy)) {
289			ST(0) = sv_newmortal();
290			sv_setpv((SV *) ST(0), copy);
291			}
292			}
293
294			char *
295			Metaphone (word)
296			char * word
297			CODE:
298			{
299			char metaph[80];
300			metaph[0] = '\0';
301			phonetic(word,metaph,79);
302			ST(0) = sv_newmortal();
303			sv_setpv((SV *) ST(0), metaph);
304			}
305
306			void
307			split_pos(ipair)
308			SV * ipair;
309			PPCODE:
310			{
311			AV * aipair = (AV *) SvRV(ipair);
312	ulpfr	13	char * word = (char )SvPV(av_fetch(aipair, 0, 0),PL_na);
313	ulpfr	10	int offset = (av_len(aipair)?SvIV(*av_fetch(aipair, 1, 0)):0);
314			char * begin = word;
315			SV * pair[2];
316
317			pair[0] = newSV((STRLEN)20);
318			pair[1] = newSV((STRLEN)0);
319
320			while (*word) {
321			char * start;
322			AV * apair;
323			SV * ref;
324			while (word && isspace(word)) word++;
325			if (!*word) break;
326			start = word;
327			while (word && !isspace(word)) word++;
328			EXTEND(sp, 1);
329			sv_setpvn(pair[0], start, (STRLEN)(word-start));
330			sv_setiv(pair[1],offset + start - begin);
331			apair = av_make(2, pair);
332	ulpfr	13	ref = newRV_inc((SV*) apair);
333	ulpfr	10	SvREFCNT_dec(apair);
334			PUSHs(sv_2mortal(ref));
335			}
336			/* free pair */
337			SvREFCNT_dec(pair[0]);
338			SvREFCNT_dec(pair[1]);
339			}
340
341			MODULE = WAIT PACKAGE = WAIT::Table
342			int
343			max(left,right=0)
344			int left
345			int right
346			CODE:
347			{
348			RETVAL = (left>right)?left:right;
349			ST(0) = sv_newmortal();
350			sv_setiv(ST(0), (IV)RETVAL);
351			}
352
353
354			MODULE = WAIT PACKAGE = WAIT::Metric
355
356			int
357			WLD(word,towards,mode=' ',limit=0)
358			char * word
359			char * towards
360			char mode
361			int limit