Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: 0.54
Fetching contributors…

Cannot retrieve contributors at this time

executable file 145 lines (124 sloc) 2.59 kb
/* neat.c */
#include "data-util.h"
#define PV_LIMIT 20
static int
is_identifier_cstr(const char* pv, const STRLEN len){
if(isIDFIRST(*pv)){
const char* const end = pv + len - 1 /* '\0' */;
while(pv != end){
++pv;
if(!isALNUM(*pv)){
return FALSE;
}
}
return TRUE;
}
return FALSE;
}
static void
du_neat_cat(pTHX_ SV* const dsv, SV* x, const int level){
if(level > 2){
sv_catpvs(dsv, "...");
return;
}
if(SvRXOK(x)){ /* regex */
Perl_sv_catpvf(aTHX_ dsv, "qr{%"SVf"}", x);
return;
}
else if(SvROK(x)){
x = SvRV(x);
if(SvOBJECT(x)){
Perl_sv_catpvf(aTHX_ dsv, "%s=%s(0x%p)",
sv_reftype(x, TRUE), sv_reftype(x, FALSE), x);
return;
}
else if(SvTYPE(x) == SVt_PVAV){
I32 const len = av_len((AV*)x);
sv_catpvs(dsv, "[");
if(len >= 0){
SV** const svp = av_fetch((AV*)x, 0, FALSE);
if(*svp){
du_neat_cat(aTHX_ dsv, *svp, level+1);
}
else{
sv_catpvs(dsv, "undef");
}
if(len > 0){
sv_catpvs(dsv, ", ...");
}
}
sv_catpvs(dsv, "]");
}
else if(SvTYPE(x) == SVt_PVHV){
I32 klen;
char* key;
SV* val;
hv_iterinit((HV*)x);
val = hv_iternextsv((HV*)x, &key, &klen);
sv_catpvs(dsv, "{");
if(val){
if(!is_identifier_cstr(key, klen)){
SV* const sv = sv_newmortal();
key = pv_display(sv, key, klen, klen, PV_LIMIT);
}
Perl_sv_catpvf(aTHX_ dsv, "%s => ", key);
du_neat_cat(aTHX_ dsv, val, level+1);
if(hv_iternext((HV*)x)){
sv_catpvs(dsv, ", ...");
}
}
sv_catpvs(dsv, "}");
}
else if(SvTYPE(x) == SVt_PVCV){
GV* const gv = CvGV((CV*)x);
Perl_sv_catpvf(aTHX_ dsv, "\\&%s::%s(0x%p)", HvNAME(GvSTASH(gv)), GvNAME(gv), x);
}
else{
sv_catpvs(dsv, "\\");
du_neat_cat(aTHX_ dsv, x, level+1);
}
}
else if(isGV(x)){
sv_catsv(dsv, x);
}
else if(SvOK(x)){
if(SvPOKp(x)){
STRLEN cur;
char* const pv = SvPV(x, cur); /* pv_sisplay requires char*, not const char* */
SV* const sv = sv_newmortal();
pv_display(sv, pv, cur, cur, PV_LIMIT);
sv_catsv(dsv, sv);
}
else{
NV const nv = SvNV(x);
if(nv == NV_INF){
sv_catpvs(dsv, "+Inf");
}
else if(nv == -NV_INF){
sv_catpvs(dsv, "-Inf");
}
else if(Perl_isnan(nv)){
sv_catpvs(dsv, "NaN");
}
else{
Perl_sv_catpvf(aTHX_ dsv, "%"NVgf, nv);
}
}
}
else{
sv_catpvs(dsv, "undef");
}
}
const char*
du_neat(pTHX_ SV* x){
SV* const dsv = newSV(100);
sv_2mortal(dsv);
sv_setpvs(dsv, "");
ENTER;
SAVETMPS;
SvGETMAGIC(x);
du_neat_cat(aTHX_ dsv, x, 0);
FREETMPS;
LEAVE;
return SvPVX(dsv);
}
Jump to Line
Something went wrong with that request. Please try again.