view release on metacpan or  search on metacpan

mg.c  view on Meta::CPAN

#else
           int maxgrp = NGROUPS;
#endif

            while (isSPACE(*p))
                ++p;
            if (grok_atoUV(p, &uv, &endptr))
                new_egid = (Gid_t)uv;
            else {
                new_egid = INVALID_GID;
                endptr = NULL;
            }
            for (i = 0; i < maxgrp; ++i) {
                if (endptr == NULL)
                    break;
                p = endptr;
                endptr = p_end;
                while (isSPACE(*p))
                    ++p;
                if (!*p)
                    break;
                if (!gary)
                    Newx(gary, i + 1, Groups_t);
                else
                    Renew(gary, i + 1, Groups_t);
                if (grok_atoUV(p, &uv, &endptr))
                    gary[i] = (Groups_t)uv;
                else {
                    gary[i] = INVALID_GID;
                    endptr = NULL;
                }
            }
            if (i)
                PERL_UNUSED_RESULT(setgroups(i, gary));
            Safefree(gary);
        }
#else  /* HAS_SETGROUPS */
        new_egid = SvGID(sv);
#endif /* HAS_SETGROUPS */
        PL_delaymagic_egid = new_egid;
        if (PL_delaymagic) {
            PL_delaymagic |= DM_EGID;
            break;				/* don't do magic till later */
        }
#ifdef HAS_SETEGID
        PERL_UNUSED_RESULT(setegid(new_egid));
#elif defined(HAS_SETREGID)
        PERL_UNUSED_RESULT(setregid((Gid_t)-1, new_egid));
#elif defined(HAS_SETRESGID)
        PERL_UNUSED_RESULT(setresgid((Gid_t)-1, new_egid, (Gid_t)-1));
#else
        if (new_egid == PerlProc_getgid())			/* special case $) = $( */
            PERL_UNUSED_RESULT(PerlProc_setgid(new_egid));
        else {
            croak("setegid() not implemented");
        }
#endif
        break;
        }
    case ':':
        PL_chopset = SvPV_force(sv,len);
        break;
    case '$': /* $$ */
        /* Store the pid in mg->mg_obj so we can tell when a fork has
           occurred.  mg->mg_obj points to *$ by default, so clear it. */
        if (isGV(mg->mg_obj)) {
            if (mg->mg_flags & MGf_REFCOUNTED) /* probably never true */
                SvREFCNT_dec(mg->mg_obj);
            mg->mg_flags |= MGf_REFCOUNTED;
            mg->mg_obj = newSViv((IV)PerlProc_getpid());
        }
        else sv_setiv(mg->mg_obj, (IV)PerlProc_getpid());
        break;
    case '0':
        if (!sv_utf8_downgrade(sv, /* fail_ok */ TRUE)) {

            /* Since we are going to set the string's UTF8-encoded form
               as the process name we should update $0 itself to contain
               that same (UTF8-encoded) value. */
            sv_utf8_encode(GvSV(mg->mg_obj));

            ck_warner_d(packWARN(WARN_UTF8), "Wide character in %s", "$0");
        }

        LOCK_DOLLARZERO_MUTEX;
        S_set_dollarzero(aTHX_ sv);
        UNLOCK_DOLLARZERO_MUTEX;
        break;
    }
    return 0;
}

/*
=for apidoc_section $signals
=for apidoc whichsig
=for apidoc_item whichsig_pv
=for apidoc_item whichsig_pvn
=for apidoc_item whichsig_sv

These all convert a signal name into its corresponding signal number;
returning -1 if no corresponding number was found.

They differ only in the source of the signal name:

C<whichsig_pv> takes the name from the C<NUL>-terminated string starting at
C<sig>.

C<whichsig> is merely a different spelling, a synonym, of C<whichsig_pv>.

C<whichsig_pvn> takes the name from the string starting at C<sig>, with length
C<len> bytes.

C<whichsig_sv> takes the name from the PV stored in the SV C<sigsv>.

=cut
*/

I32
Perl_whichsig_sv(pTHX_ SV *sigsv)
{
    const char *sigpv;