view release on metacpan or  search on metacpan

Cwd.xs  view on Meta::CPAN

    } else if(p[0] == '.' && p[1] == '/') {
	do {
	    p++;
	    do { p++; } while(p[0] == '/');
	} while(p[0] == '.' && p[1] == '/');
	if(p == pe) *o++ = '.';
    }
    if(p == pe) goto end;
    while(1) {
	q = (const char *) memchr(p, '/', pe-p);
	if(!q) q = pe;
	l = q - p;
	memcpy(o, p, l);
	p = q;
	o += l;
	if(p == pe) goto end;
	while(1) {
	    do { p++; } while(p[0] == '/');
	    if(p == pe) goto end;
	    if(p[0] != '.') break;
	    if(p+1 == pe) goto end;
	    if(p[1] != '/') break;
	    p++;
	}
	*o++ = '/';
    }
    end: ;
    *o = 0;
    SvPOK_on(retval);
    SvCUR_set(retval, o - SvPVX(retval));
    SvTAINT(retval);
    return retval;
}

MODULE = Cwd		PACKAGE = Cwd

PROTOTYPES: DISABLE

BOOT:
#if USE_MY_CXT
{
    MY_CXT_INIT;
    POPULATE_MY_CXT;
}
#endif

#if USE_MY_CXT

void
CLONE(...)
CODE:
	PERL_UNUSED_VAR(items);
	{ MY_CXT_CLONE; POPULATE_MY_CXT; }

#endif

void
getcwd(...)
ALIAS:
    fastcwd=1
PPCODE:
{
    dXSTARG;
    /* fastcwd takes zero parameters:  */
    if (ix == 1 && items != 0)
	croak_xs_usage(cv,  "");
    getcwd_sv(TARG);
    XSprePUSH; PUSHTARG;
    SvTAINTED_on(TARG);
}

void
abs_path(pathsv=Nullsv)
    SV *pathsv
PPCODE:
{
    dXSTARG;
    char *const path = pathsv ? SvPV_nolen(pathsv) : (char *)".";
    char buf[MAXPATHLEN];

    if (
#ifdef VMS
	Perl_rmsexpand(aTHX_ path, buf, NULL, 0)
#else
	bsd_realpath(path, buf)
#endif
    ) {
	sv_setpv_mg(TARG, buf);
        SvPOK_only(TARG);
	SvTAINTED_on(TARG);
    }
    else
        sv_setsv(TARG, &PL_sv_undef);

    XSprePUSH; PUSHs(TARG);
    SvTAINTED_on(TARG);
}

#if defined(WIN32) && !defined(UNDER_CE)

void
getdcwd(...)
PROTOTYPE: ENABLE
PPCODE:
{
    dXSTARG;
    int drive;
    char *dir;

    /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */
    if ( items == 0 ||
        (items == 1 && (!SvOK(ST(0)) || (SvPOK(ST(0)) && !SvCUR(ST(0))))))
        drive = 0;
    else if (items == 1 && SvPOK(ST(0)) && SvCUR(ST(0)) &&
             isALPHA(SvPVX(ST(0))[0]))
        drive = toUPPER(SvPVX(ST(0))[0]) - 'A' + 1;
    else
        croak("Usage: getdcwd(DRIVE)");

    New(0,dir,MAXPATHLEN,char);
    if (_getdcwd(drive, dir, MAXPATHLEN)) {
        sv_setpv_mg(TARG, dir);
        SvPOK_only(TARG);
    }
    else
        sv_setsv(TARG, &PL_sv_undef);

    Safefree(dir);

    XSprePUSH; PUSHs(TARG);
    SvTAINTED_on(TARG);
}

#endif

MODULE = Cwd		PACKAGE = File::Spec::Unix

SV *
canonpath(SV *self, SV *path = &PL_sv_undef, ...)
CODE:
    PERL_UNUSED_VAR(self);
    RETVAL = unix_canonpath(path);
OUTPUT:
    RETVAL

SV *
_fn_canonpath(SV *path = &PL_sv_undef, ...)
CODE:
    RETVAL = unix_canonpath(path);
OUTPUT:
    RETVAL

SV *
catdir(SV *self, ...)
PREINIT:
    dUSE_MY_CXT;
    SV *joined;
CODE:
    EXTEND(SP, items+1);
    ST(items) = EMPTY_STRING_SV;
    joined = sv_newmortal();
    do_join(joined, SLASH_STRING_SV, &ST(0), &ST(items));
    if(invocant_is_unix(self)) {
	RETVAL = unix_canonpath(joined);