develooper Front page | perl.perl5.porters | Postings from March 2013

Re: File::Spec in XS

Thread Previous | Thread Next
From:
bulk88
Date:
March 1, 2013 19:33
Subject:
Re: File::Spec in XS
Message ID:
BLU0-SMTP3327FD0A342C31F9B2F84D3DFFF0@phx.gbl
Zefram wrote:
> For work purposes, last year I reimplemented parts of File::Spec in XS.
> It wasn't in a CPANable form initially, and File::Spec had core/CPAN
> version skew issues, so I didn't initially publish my work.  I've now
> cleaned it up and rebased it on PathTools-3.40, and the patch is attached.
> This is for review, and for whoever is currently maintaining File::Spec
> to merge it into blead at an appropriate juncture.  (I fear it's a bit
> too late to get into 5.18.)
> 
> -zefram
> 

see comment in code
___________________________________________________
+
+SV *
+catfile(SV *self, ...)
+PREINIT:
+    dUSE_MY_CXT;
+CODE:
+    if(invocant_is_unix(self)) {
+	if(items == 1) {
+	    RETVAL = &PL_sv_undef;
+	} else {
+	    SV *file = unix_canonpath(ST(items-1));
+	    if(items == 2) {
+		RETVAL = file;
+	    } else {
+		SV *dir = sv_newmortal();
+		sv_2mortal(file);
+		ST(items-1) = EMPTY_STRING_SV;
+		do_join(dir, SLASH_STRING_SV, &ST(0), &ST(items-1));
+		RETVAL = unix_canonpath(dir);
+		if(SvCUR(RETVAL) == 0 || SvPVX(RETVAL)[SvCUR(RETVAL)-1] != '/')
+		    sv_catsv(RETVAL, SLASH_STRING_SV);
+		sv_catsv(RETVAL, file);
+	    }
+	}
+    } else {
+	SV *file, *dir;
+	ENTER;
+	PUSHMARK(SP);
+	EXTEND(SP, 2);
+	PUSHs(self);
+	PUSHs(items == 1 ? &PL_sv_undef : ST(items-1));
+	PUTBACK;
+	call_method("canonpath", G_SCALAR);
+	SPAGAIN;
+	file = POPs;
+	LEAVE;
+	if(items <= 2) {
+	    RETVAL = SvREFCNT_inc(file);
+	} else {
+	    char const *pv;
+	    STRLEN len;
+	    bool need_slash;
+	    SP--;
+	    ENTER;
+	    PUSHMARK(&ST(-1));
+	    PUTBACK;
+	    call_method("catdir", G_SCALAR);
+	    SPAGAIN;
+	    dir = POPs;
+	    LEAVE;
+	    pv = SvPV(dir, len);
+	    need_slash = len == 0 || pv[len-1] != '/';
+	    RETVAL = newSVsv(dir); /* why make a copy here? isn't this already 
our scope's owned mortal ?  */
+	    if(need_slash) sv_catsv(RETVAL, SLASH_STRING_SV);
+	    sv_catsv(RETVAL, file);
+	}
+    }
+OUTPUT:
+    RETVAL
+
_______________________________________________________

for

_______________________________________________________
+#define invocant_is_unix(i) THX_invocant_is_unix(aTHX_ i)
+static
+bool
+THX_invocant_is_unix(pTHX_ SV *invocant)
+{
+    /*
+     * This is used to enable optimisations that avoid method calls
+     * by knowing how they would resolve.  False negatives, disabling
+     * the optimisation where it would actually behave correctly, are
+     * acceptable.
+     */
+    return SvPOK(invocant) && SvCUR(invocant) == 16 &&
+	!memcmp(SvPVX(invocant), "File::Spec::Unix", 16);
+}
+
_______________________________________________________
considered adding a newSVpvs_share("File::Spec::Unix") to MY_CXT, then 
comparing SvPVXes of SV* invocant and against the shared SV key name 
before doing the memcmp? It might prevent a memcmp.

I dont have any comments on the path handling stuff.

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About