String::Index de Jeff Pinyan provee funciones que permiten
calcular el índice de aparición de un conjunto de caracteres en una cadena dada:
lhp@nereida:~/Lperl/src/XSUB/cpanexamples/String-Index-0.02$ perl -de 0
main::(-e:1): 0
DB<1> use String::Index qw( cindex ncindex crindex ncrindex )
DB<2> x $first_vowel = cindex("broadcast", "aeiouy")
0 2
DB<3> x $last_vowel = crindex("broadcast", "aeiouy")
0 6
DB<4> x $first_nonvowel = ncindex("eerily", "aeiouy")
0 2
DB<5> x $last_nonvowel = ncrindex("eerily", "aeiouy")
0 4
DB<6> x cindex("broadcast", "xyz")
0 '-1'
El módulo implanta las cuatro funciones usando una única función XSUB.
Esta posibilidad la ofrece la directiva
ALIAS:
la cual permite asociar varios
identificadores Perl con una XSUB. Permite además conocer con que nombre fué
invocada la XSUB. A cada alias se le da un índice. Dentro de la
XSUB es posible consultar dicho índice através de la variable predeclarada
ix. Cuando la XSUB es llamada con su nombre oficial
el valor de ix es 0.
lhp@nereida:~/Lperl/src/XSUB/cpanexamples/String-Index-0.02$ cat -n Index.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include "ppport.h"
6
7 #define SI_NOT 0x01
8 #define SI_REV 0x02
9
10
11 MODULE = String::Index PACKAGE = String::Index
12
13
14 int
15 cindex(SV *str, SV *cc, ...)
16 PROTOTYPE: $$;$
17 ALIAS:
18 ncindex = 1
19 crindex = 2
20 ncrindex = 3
21 CODE:
22 {
23 STRLEN s_len;
24 STRLEN c_len;
25 char *s = SvPV(str,s_len);
26 char *c = SvPV(cc,c_len);
27 int seen_null = 0;
28 int p = (items == 3 ? (int)SvIV(ST(2)) : 0);
29 int i;
30
31 /* see if there is an INTERNAL null in the char str */
32 for (i = 0; i < c_len; ) {
33 if (c[i] == '\0' && (seen_null = 1)) c[i] = c[--c_len];
34 else ++i;
35 }
36 c[c_len] = '\0';
37
38 if (ix & SI_REV) {
39 s += (p ? p : s_len - 1);
40 for (i = p ? p : (s_len - 1); i >= 0; --i, --s)
41 if ((*s ? strchr(c, *s) > 0 : seen_null) != (ix & SI_NOT)) break;
42 }
43 else {
44 s += p;
45 for (i = p; i < s_len; ++i, ++s)
46 if ((*s ? strchr(c, *s) > 0 : seen_null) != (ix & SI_NOT)) break;
47 }
48
49 RETVAL = (i == ((ix & SI_REV) ? -1 : s_len) ? -1 : i);
50 }
51 OUTPUT:
52 RETVAL
El prototipo de la línea 16 indica que el tercer argumento es opcional.
La aparición de ; en un prototipo separa los argumentos requeridos
de los argumentos opcionales.
El tercer argumento es opcional ya que las funciones
cindex tienen dos formatos de llamada:
cindex(STR, CHARS, POSITION) cindex(STR, CHARS)
POSITION indica en que posición se comienza la búsqueda.
Si se omite se comienza desde el principio.
La función retorna -1 si ninguno de los caracteres en CHARS es encontrado.
STRLEN usado en las líneas 23 y 24
es un tipo entero lo suficientemente grande como para representar
el tamaño de cualquier cadena que Perl pueda manejar:
lhp@nereida:~/Lperl/src/perlcompilerssource/perl-5.8.8$ grep 'MEM_SIZE\>' perl.h #define MEM_SIZE Size_t typedef MEM_SIZE STRLEN;
char* SvPV(SV* sv, STRLEN len).
Devuelve un puntero a la cadena en sv o bien el resultado
de convertir sv en una cadena (por ejemplo, si es una referencia o
un objeto).
char *strchr(const char *s, int c);La función devuelve un puntero a la primera ocurrencia del carácter
c en la cadena de caracteres s.
Casiano Rodríguez León
