/* gv.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
GV *
-Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
+Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) {
+ STRLEN len = strlen (nambeg);
+ return gv_fetchpvn_flags(nambeg, len, add, sv_type);
+}
+
+GV *
+Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type) {
+ STRLEN len;
+ const char *nambeg = SvPV(name, len);
+ return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type);
+}
+
+GV *
+Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
+ I32 sv_type)
{
register const char *name = nambeg;
register GV *gv = 0;
I32 len;
register const char *namend;
HV *stash = 0;
+ I32 add = flags & ~SVf_UTF8;
if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
name++;
/* set up magic where warranted */
if (len > 1) {
+#ifndef EBCDIC
if (*name > 'V' ) {
/* Nothing else to do.
The compiler will probably turn the switch statement into a
branch table. Make sure we avoid even that small overhead for
the common case of lower case variable names. */
- } else {
+ } else
+#endif
+ {
const char *name2 = name + 1;
switch (*name) {
case 'A':
if (strEQ(name2, "AINT"))
goto ro_magicalize;
break;
- case '\025': /* $^UNICODE */
+ case '\025': /* ${^UNICODE}, ${^UTF8LOCALE} */
if (strEQ(name2, "NICODE"))
goto ro_magicalize;
+ if (strEQ(name2, "TF8LOCALE"))
+ goto ro_magicalize;
break;
case '\027': /* $^WARNING_BITS */
if (strEQ(name2, "ARNING_BITS"))
/*
=for apidoc is_gv_magical
+Returns C<TRUE> if given the name of a magical GV. Calls is_gv_magical.
+
+=cut
+*/
+
+bool
+Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags)
+{
+ STRLEN len;
+ char *temp = SvPV(name, len);
+ return is_gv_magical(temp, len, flags);
+}
+
+/*
+=for apidoc is_gv_magical
+
Returns C<TRUE> if given the name of a magical GV.
Currently only useful internally when determining if a GV should be
Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags)
{
if (len > 1) {
+ const char *name1 = name + 1;
switch (*name) {
case 'I':
- if (len == 3 && strEQ(name, "ISA"))
+ if (len == 3 && name1[1] == 'S' && name[2] == 'A')
goto yes;
break;
case 'O':
- if (len == 8 && strEQ(name, "OVERLOAD"))
+ if (len == 8 && strEQ(name1, "VERLOAD"))
goto yes;
break;
case 'S':
- if (len == 3 && strEQ(name, "SIG"))
+ if (len == 3 && name[1] == 'I' && name[2] == 'G')
goto yes;
break;
/* Using ${^...} variables is likely to be sufficiently rare that
it seems sensible to avoid the space hit of also checking the
length. */
case '\017': /* ${^OPEN} */
- if (strEQ(name, "\017PEN"))
+ if (strEQ(name1, "PEN"))
goto yes;
break;
case '\024': /* ${^TAINT} */
- if (strEQ(name, "\024AINT"))
+ if (strEQ(name1, "AINT"))
goto yes;
break;
case '\025': /* ${^UNICODE} */
- if (strEQ(name, "\025NICODE"))
+ if (strEQ(name1, "NICODE"))
+ goto yes;
+ if (strEQ(name1, "TF8LOCALE"))
goto yes;
break;
case '\027': /* ${^WARNING_BITS} */
- if (strEQ(name, "\027ARNING_BITS"))
+ if (strEQ(name1, "ARNING_BITS"))
goto yes;
break;
case '1':