1 #define PERL_NO_GET_CONTEXT
2 #define PERL_EXT
3 #define PERL_EXT_LANGINFO
4 
5 #include "EXTERN.h"
6 #include "perl.h"
7 #include "XSUB.h"
8 
9 #ifdef I_LANGINFO
10 #   define __USE_GNU 1 /* Enables YESSTR, otherwise only __YESSTR. */
11 #   include <langinfo.h>
12 #else
13 #   include <perl_langinfo.h>
14 #endif
15 
16 #include "const-c.inc"
17 
18 MODULE = I18N::Langinfo	PACKAGE = I18N::Langinfo
19 
20 PROTOTYPES: ENABLE
21 
22 INCLUDE: const-xs.inc
23 
24 SV*
25 langinfo(code)
26 	int	code
27   PREINIT:
28         const   char * value;
29         STRLEN  len;
30   PROTOTYPE: _
31   CODE:
32 #ifdef HAS_NL_LANGINFO
33 	if (code < 0) {
34 	    SETERRNO(EINVAL, LIB_INVARG);
35 	    RETVAL = &PL_sv_undef;
36 	} else
37 #endif
38         {
39             value = Perl_langinfo(code);
40             len = strlen(value);
41             RETVAL = newSVpvn(Perl_langinfo(code), len);
42 
43             /* Now see if the UTF-8 flag should be turned on */
44 #ifdef USE_LOCALE_CTYPE     /* No utf8 strings if not using LC_CTYPE */
45 
46             /* If 'value' is ASCII or not legal UTF-8, the flag doesn't get
47              * turned on, so skip the followin code */
48             if (is_utf8_non_invariant_string((U8 *) value, len)) {
49                 int category;
50 
51                 /* Check if the locale is a UTF-8 one.  The returns from
52                  * Perl_langinfo() are in different locale categories, so check the
53                  * category corresponding to this item */
54                 switch (code) {
55 
56                     /* This should always return ASCII, so we could instead
57                      * legitimately panic here, but soldier on */
58                     case CODESET:
59                         category = LC_CTYPE;
60                         break;
61 
62                     case RADIXCHAR:
63                     case THOUSEP:
64 #  ifdef USE_LOCALE_NUMERIC
65                         category = LC_NUMERIC;
66 #  else
67                         /* Not ideal, but the best we can do on such a platform */
68                         category = LC_CTYPE;
69 #  endif
70                         break;
71 
72                     case CRNCYSTR:
73 #  ifdef USE_LOCALE_MONETARY
74                         category = LC_MONETARY;
75 #  else
76                         category = LC_CTYPE;
77 #  endif
78                         break;
79 
80                     default:
81 #  ifdef USE_LOCALE_TIME
82                         category = LC_TIME;
83 #  else
84                         category = LC_CTYPE;
85 #  endif
86                         break;
87                 }
88 
89                 /* Here the return is legal UTF-8.  Turn on that flag if the
90                  * locale is UTF-8.  (Otherwise, could just be a coincidence.)
91                  * */
92                 if (_is_cur_LC_category_utf8(category)) {
93                     SvUTF8_on(RETVAL);
94                 }
95             }
96 #endif /* USE_LOCALE_CTYPE */
97         }
98 
99   OUTPUT:
100         RETVAL
101