buncha MacPerl patches for bleadperl

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index ca7cacf..b6a8719 100644 (file)
--- a/util.c
+++ b/util.c
@@ -575,11 +575,18 @@ Perl_set_numeric_radix(pTHX)
     struct lconv* lc;
 
     lc = localeconv();
-    if (lc && lc->decimal_point)
-       /* We assume that decimal separator aka the radix
-        * character is always a single character.  If it
-        * ever is a string, this needs to be rethunk. */
-       PL_numeric_radix = *lc->decimal_point;
+    if (lc && lc->decimal_point) {
+       if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
+           SvREFCNT_dec(PL_numeric_radix);
+           PL_numeric_radix = 0;
+       }
+       else {
+           if (PL_numeric_radix)
+               sv_setpv(PL_numeric_radix, lc->decimal_point);
+           else
+               PL_numeric_radix = newSVpv(lc->decimal_point, 0);
+       }
+    }
     else
        PL_numeric_radix = 0;
 # endif /* HAS_LOCALECONV */
@@ -658,7 +665,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
      *   -1 = fallback to C locale failed
      */
 
-#ifdef USE_LOCALE
+#if defined(USE_LOCALE) && defined(USE_ENVIRON_ARRAY)
 
 #ifdef USE_LOCALE_CTYPE
     char *curctype   = NULL;
@@ -884,7 +891,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #endif /* USE_LOCALE_NUMERIC */
     }
 
-#endif /* USE_LOCALE */
+#endif /* USE_LOCALE && USE_ENVIRON_ARRAY */
 
 #ifdef USE_LOCALE_CTYPE
     if (curctype != NULL)
@@ -3990,3 +3997,40 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
                        func, pars);
     }
 }
+
+#ifdef EBCDIC
+int
+Perl_ebcdic_control(pTHX_ int ch)
+{
+       if (ch > 'a') {
+               char *ctlp;
+ 
+              if (islower(ch))
+                     ch = toupper(ch);
+ 
+              if ((ctlp = strchr(controllablechars, ch)) == 0) {
+                     Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
+              }
+ 
+               if (ctlp == controllablechars)
+                      return('\177'); /* DEL */
+               else
+                      return((unsigned char)(ctlp - controllablechars - 1));
+       } else { /* Want uncontrol */
+               if (ch == '\177' || ch == -1)
+                       return('?');
+               else if (ch == '\157')
+                       return('\177');
+               else if (ch == '\174')
+                       return('\000');
+               else if (ch == '^')    /* '\137' in 1047, '\260' in 819 */
+                       return('\036');
+               else if (ch == '\155')
+                       return('\037');
+               else if (0 < ch && ch < (sizeof(controllablechars) - 1))
+                       return(controllablechars[ch+1]);
+               else
+                       Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
+       }
+}
+#endif