/* gv.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 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_IOadd(pTHX_ register GV *gv)
{
- if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
- Perl_croak(aTHX_ "Bad symbol for filehandle");
+ if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) {
+
+ /*
+ * if it walks like a dirhandle, then let's assume that
+ * this is a dirhandle.
+ */
+ const char *fh = PL_op->op_type == OP_READDIR ||
+ PL_op->op_type == OP_TELLDIR ||
+ PL_op->op_type == OP_SEEKDIR ||
+ PL_op->op_type == OP_REWINDDIR ||
+ PL_op->op_type == OP_CLOSEDIR ?
+ "dirhandle" : "filehandle";
+ Perl_croak(aTHX_ "Bad symbol for %s", fh);
+ }
+
if (!GvIOp(gv)) {
#ifdef GV_UNIQUE_CHECK
if (GvUNIQUE(gv)) {
/* UNIVERSAL methods should be callable without a stash */
if (!stash) {
level = -1; /* probably appropriate */
- if(!(stash = gv_stashpvn("UNIVERSAL", 9, FALSE)))
+ if(!(stash = gv_stashpvs("UNIVERSAL", FALSE)))
return 0;
}
/* if at top level, try UNIVERSAL */
if (level == 0 || level == -1) {
- HV* const lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE);
+ HV* const lastchance = gv_stashpvs("UNIVERSAL", FALSE);
if (lastchance) {
if ((gv = gv_fetchmeth(lastchance, name, len,
LEAVE;
varsv = GvSVn(vargv);
sv_setpvn(varsv, packname, packname_len);
- sv_catpvn(varsv, "::", 2);
+ sv_catpvs(varsv, "::");
sv_catpvn(varsv, name, len);
SvTAINTED_off(varsv);
return gv;
S_require_errno(pTHX_ GV *gv)
{
dVAR;
- HV* stash = gv_stashpvn("Errno",5,FALSE);
+ HV* stash = gv_stashpvs("Errno", FALSE);
if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
dSP;
ENTER;
save_scalar(gv); /* keep the value of $! */
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
- newSVpvn("Errno",5), Nullsv);
+ newSVpvs("Errno"), Nullsv);
LEAVE;
SPAGAIN;
- stash = gv_stashpvn("Errno",5,FALSE);
+ stash = gv_stashpvs("Errno", FALSE);
if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available");
}
HV*
Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
{
- char smallbuf[256];
+ char smallbuf[128];
char *tmpbuf;
HV *stash;
GV *tmpgv;
tmpbuf[namelen++] = ':';
tmpbuf[namelen++] = ':';
tmpbuf[namelen] = '\0';
- tmpgv = gv_fetchpv(tmpbuf, create, SVt_PVHV);
+ tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, create, SVt_PVHV);
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
if (!tmpgv)
len = namend - name;
if (len > 0) {
- char smallbuf[256];
+ char smallbuf[128];
char *tmpbuf;
if (len + 3 < sizeof (smallbuf))
if (USE_UTF8_IN_NAMES)
SvUTF8_on(err);
qerror(err);
- stash = GvHV(gv_fetchpv("<none>::", GV_ADDMULTI, SVt_PVHV));
+ stash = GvHV(gv_fetchpvn_flags("<none>::", 8, GV_ADDMULTI, SVt_PVHV));
}
else
return Nullgv;
{
SV * const sv = GvSVn(gv);
if (!sv_derived_from(PL_patchlevel, "version"))
- (void *)upg_version(PL_patchlevel);
+ upg_version(PL_patchlevel);
GvSV(gv) = vnumify(PL_patchlevel);
SvREADONLY_on(GvSV(gv));
SvREFCNT_dec(sv);
if (keepmain || strNE(name, "main")) {
sv_catpvn(sv,name,namelen);
- sv_catpvn(sv,"::", 2);
+ sv_catpvs(sv,"::");
}
sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
}
SvOBJECT_on(io);
/* Clear the stashcache because a new IO could overrule a package name */
hv_clear(PL_stashcache);
- iogv = gv_fetchpv("FileHandle::", 0, SVt_PVHV);
+ iogv = gv_fetchpvn_flags("FileHandle::", 12, 0, SVt_PVHV);
/* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
- iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
+ iogv = gv_fetchpvn_flags("IO::Handle::", 12, TRUE, SVt_PVHV);
SvSTASH_set(io, (HV*)SvREFCNT_inc(GvHV(iogv)));
return io;
}