__UNDEFINED__ /sv_\w+_mg/ sv_magic_portable

__UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END

__UNDEFINED__ PERL_MAGIC_sv '\0' __UNDEFINED__ PERL_MAGIC_overload 'A' __UNDEFINED__ PERL_MAGIC_overload_elem 'a' __UNDEFINED__ PERL_MAGIC_overload_table 'c' __UNDEFINED__ PERL_MAGIC_bm 'B' __UNDEFINED__ PERL_MAGIC_regdata 'D' __UNDEFINED__ PERL_MAGIC_regdatum 'd' __UNDEFINED__ PERL_MAGIC_env 'E' __UNDEFINED__ PERL_MAGIC_envelem 'e' __UNDEFINED__ PERL_MAGIC_fm 'f' __UNDEFINED__ PERL_MAGIC_regex_global 'g' __UNDEFINED__ PERL_MAGIC_isa 'I' __UNDEFINED__ PERL_MAGIC_isaelem 'i' __UNDEFINED__ PERL_MAGIC_nkeys 'k' __UNDEFINED__ PERL_MAGIC_dbfile 'L' __UNDEFINED__ PERL_MAGIC_dbline 'l' __UNDEFINED__ PERL_MAGIC_mutex 'm' __UNDEFINED__ PERL_MAGIC_shared 'N' __UNDEFINED__ PERL_MAGIC_shared_scalar 'n' __UNDEFINED__ PERL_MAGIC_collxfrm 'o' __UNDEFINED__ PERL_MAGIC_tied 'P' __UNDEFINED__ PERL_MAGIC_tiedelem 'p' __UNDEFINED__ PERL_MAGIC_tiedscalar 'q' __UNDEFINED__ PERL_MAGIC_qr 'r' __UNDEFINED__ PERL_MAGIC_sig 'S' __UNDEFINED__ PERL_MAGIC_sigelem 's' __UNDEFINED__ PERL_MAGIC_taint 't' __UNDEFINED__ PERL_MAGIC_uvar 'U' __UNDEFINED__ PERL_MAGIC_uvar_elem 'u' __UNDEFINED__ PERL_MAGIC_vstring 'V' __UNDEFINED__ PERL_MAGIC_vec 'v' __UNDEFINED__ PERL_MAGIC_utf8 'w' __UNDEFINED__ PERL_MAGIC_substr 'x' __UNDEFINED__ PERL_MAGIC_defelem 'y' __UNDEFINED__ PERL_MAGIC_glob '*' __UNDEFINED__ PERL_MAGIC_arylen '#' __UNDEFINED__ PERL_MAGIC_pos '.' __UNDEFINED__ PERL_MAGIC_backref '<' __UNDEFINED__ PERL_MAGIC_ext '~'

/* That's the best we can do... */ __UNDEFINED__ sv_catpvn_nomg sv_catpvn __UNDEFINED__ sv_catsv_nomg sv_catsv __UNDEFINED__ sv_setsv_nomg sv_setsv __UNDEFINED__ sv_pvn_nomg sv_pvn __UNDEFINED__ SvIV_nomg SvIV __UNDEFINED__ SvUV_nomg SvUV

#ifndef sv_catpv_mg # define sv_catpv_mg(sv, ptr) \ STMT_START { \ SV *TeMpSv = sv; \ sv_catpv(TeMpSv,ptr); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_catpvn_mg # define sv_catpvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_catpvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_catsv_mg # define sv_catsv_mg(dsv, ssv) \ STMT_START { \ SV *TeMpSv = dsv; \ sv_catsv(TeMpSv,ssv); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_setiv_mg # define sv_setiv_mg(sv, i) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setiv(TeMpSv,i); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_setnv_mg # define sv_setnv_mg(sv, num) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setnv(TeMpSv,num); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_setpv_mg # define sv_setpv_mg(sv, ptr) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setpv(TeMpSv,ptr); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_setpvn_mg # define sv_setpvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setpvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_setsv_mg # define sv_setsv_mg(dsv, ssv) \ STMT_START { \ SV *TeMpSv = dsv; \ sv_setsv(TeMpSv,ssv); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_setuv_mg # define sv_setuv_mg(sv, i) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setuv(TeMpSv,i); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

#ifndef sv_usepvn_mg # define sv_usepvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_usepvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif

__UNDEFINED__ SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)

/* Hint: sv_magic_portable * This is a compatibility function that is only available with * Devel::PPPort. It is NOT in the perl core. * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when * it is being passed a name pointer with namlen == 0. In that * case, perl 5.8.0 and later store the pointer, not a copy of it. * The compatibility can be provided back to perl 5.004. With * earlier versions, the code will not compile. */

#if { VERSION < 5.004 }

  /* code that uses sv_magic_portable will not compile */

#elif { VERSION < 5.8.0 }

# define sv_magic_portable(sv, obj, how, name, namlen) \ STMT_START { \ SV *SvMp_sv = (sv); \ char *SvMp_name = (char *) (name); \ I32 SvMp_namlen = (namlen); \ if (SvMp_name && SvMp_namlen == 0) \ { \ MAGIC *mg; \ sv_magic(SvMp_sv, obj, how, 0, 0); \ mg = SvMAGIC(SvMp_sv); \ mg->mg_len = -42; /* XXX: this is the tricky part */ \ mg->mg_ptr = SvMp_name; \ } \ else \ { \ sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \ } \ } STMT_END

#else

# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)

#endif

void sv_catpv_mg(sv, string) SV *sv; char *string; CODE: sv_catpv_mg(sv, string);

void sv_catpvn_mg(sv, sv2) SV *sv; SV *sv2; PREINIT: char *str; STRLEN len; CODE: str = SvPV(sv2, len); sv_catpvn_mg(sv, str, len);

void sv_catsv_mg(sv, sv2) SV *sv; SV *sv2; CODE: sv_catsv_mg(sv, sv2);

void sv_setiv_mg(sv, iv) SV *sv; IV iv; CODE: sv_setiv_mg(sv, iv);

void sv_setnv_mg(sv, nv) SV *sv; NV nv; CODE: sv_setnv_mg(sv, nv);

void sv_setpv_mg(sv, pv) SV *sv; char *pv; CODE: sv_setpv_mg(sv, pv);

void sv_setpvn_mg(sv, sv2) SV *sv; SV *sv2; PREINIT: char *str; STRLEN len; CODE: str = SvPV(sv2, len); sv_setpvn_mg(sv, str, len);

void sv_setsv_mg(sv, sv2) SV *sv; SV *sv2; CODE: sv_setsv_mg(sv, sv2);

void sv_setuv_mg(sv, uv) SV *sv; UV uv; CODE: sv_setuv_mg(sv, uv);

void sv_usepvn_mg(sv, sv2) SV *sv; SV *sv2; PREINIT: char *str, *copy; STRLEN len; CODE: str = SvPV(sv2, len); New(42, copy, len+1, char); Copy(str, copy, len+1, char); sv_usepvn_mg(sv, copy, len);

int SvVSTRING_mg(sv) SV *sv; CODE: RETVAL = SvVSTRING_mg(sv) != NULL; OUTPUT: RETVAL

int sv_magic_portable(sv) SV *sv PREINIT: MAGIC *mg; const char *foo = "foo"; CODE: #if { VERSION >= 5.004 } sv_magic_portable(sv, 0, '~', foo, 0); mg = mg_find(sv, '~'); RETVAL = mg->mg_ptr == foo; #else sv_magic(sv, 0, '~', (char *) foo, strlen(foo)); mg = mg_find(sv, '~'); RETVAL = strEQ(mg->mg_ptr, foo); #endif sv_unmagic(sv, '~'); OUTPUT: RETVAL

use Tie::Hash; my %h; tie %h, 'Tie::StdHash'; $h{foo} = 'foo'; $h{bar} = '';

&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); ok($h{foo}, 'foobar');

&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); ok($h{bar}, 'baz');

&Devel::PPPort::sv_catsv_mg($h{foo}, '42'); ok($h{foo}, 'foobar42');

&Devel::PPPort::sv_setiv_mg($h{bar}, 42); ok($h{bar}, 42);

&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); ok(abs($h{PI} - 3.14159) < 0.01);

&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); ok($h{mhx}, 'mhx');

&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); ok($h{mhx}, 'Marcus');

&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); ok($h{sv}, 'SV');

&Devel::PPPort::sv_setuv_mg($h{sv}, 4711); ok($h{sv}, 4711);

&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); ok($h{sv}, 'Perl');

my $ver = eval qq[qv("v1.2.0")]; ok($[ < 5.009 || $@ eq ''); ok($@ || Devel::PPPort::SvVSTRING_mg($ver)); ok(!Devel::PPPort::SvVSTRING_mg(4711));

my $foo = 'bar'; ok(Devel::PPPort::sv_magic_portable($foo)); ok($foo eq 'bar');

cpanm mro

perl -MCPAN -e shell
install mro