From a8354e6aeb0c44c0bb346807f2ae5f7172321f5f Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@cpanel.net>
Date: Thu, 26 Nov 2015 12:05:57 +0100
Subject: [PATCH] fix convert_blessed <= 5.8 and enable test

with 5.8 we need to rebless the rv to set AMG.
For safety recalc the overload magic methods also.

Fixes GH #37 for 5.8
---
 XS.xs            | 17 +++++++++++++++++
 t/12_blessed.t   |  8 ++++++--
 t/54_stringify.t | 17 +++++------------
 3 files changed, 28 insertions(+), 14 deletions(-)

diff --git a/XS.xs b/XS.xs
index 0a8c866..bf1bc40 100644
--- a/XS.xs
+++ b/XS.xs
@@ -860,12 +860,21 @@ encode_stringify(pTHX_ enc_t *enc, SV *sv)
   SV *pv = NULL;
   svtype type = SvTYPE(sv);
   int amg = 0;
+#if PERL_VERSION <= 8
+  MAGIC *mg;
+#endif
 
 /* SvAMAGIC without the ref */
 #if PERL_VERSION > 17
 #define MyAMG(sv) (SvOBJECT(sv) && HvAMAGIC(SvSTASH(sv)))
 #else
+#if PERL_VERSION > 8
 #define MyAMG(sv) (SvOBJECT(sv) && (SvFLAGS(sv) & SVf_AMAGIC))
+#else
+#define MyAMG(sv) (SvOBJECT(sv) && ((SvFLAGS(sv) & SVf_AMAGIC) \
+        || ((mg = mg_find((SV*)SvSTASH(sv), PERL_MAGIC_overload_table)) \
+            && mg->mg_ptr && AMT_AMAGIC((AMT*)mg->mg_ptr))))
+#endif
 #endif
 
   /* if no string overload found, check allow_blessed */
@@ -897,6 +906,14 @@ encode_stringify(pTHX_ enc_t *enc, SV *sv)
     if (SvGMAGICAL(sv)) mg_get(sv);
     if (MyAMG(sv)) { /* force a RV here */
       SV* rv = newRV(SvREFCNT_inc(sv));
+#if PERL_VERSION <= 8
+      HV *stash = SvSTASH(sv);
+      if (!SvSTASH(rv) || !(SvFLAGS(sv) & SVf_AMAGIC)) {
+        sv_bless(rv, stash);
+        Gv_AMupdate(stash);
+        SvFLAGS(sv) |= SVf_AMAGIC;
+      }
+#endif
 #if PERL_VERSION > 13
       pv = AMG_CALLunary(rv, string_amg);
 #else
diff --git a/t/12_blessed.t b/t/12_blessed.t
index 773aea5..5ddfeeb 100644
--- a/t/12_blessed.t
+++ b/t/12_blessed.t
@@ -41,7 +41,11 @@ ok ($js->encode ($o1) eq '{"__":""}');
 ok ($js->encode ($o2) eq "null");
 $js->allow_blessed->convert_blessed;
 ok ($js->encode ($o1) eq '{"__":""}');
-ok ($js->encode ($o2) == 1) or print STDERR "# ",$js->encode ($o2),"\n";
+if ($] < 5.008) {
+  print "ok ",++$test," # skip 5.6\n"
+} else {
+  ok ($js->encode ($o2) == 1) or print STDERR "# ",$js->encode ($o2),"\n";
+}
 
 $js->filter_json_object (sub { 5 });
 $js->filter_json_single_key_object (a => sub { shift });
@@ -64,7 +68,7 @@ $js->filter_json_single_key_object ("a");
 ok (4 == $js->decode ('[{"a":4}]')->[0]{a});
 
 if ($]<5.008) {
-  print "ok 16 # skip 5.6\n";
+  print "ok 18 # skip 5.6\n";
 } else {
   $js->filter_json_single_key_object (a => sub { });
   ok (4 == $js->decode ('[{"a":4}]')->[0]{a});
diff --git a/t/54_stringify.t b/t/54_stringify.t
index 0f7b491..f09a183 100644
--- a/t/54_stringify.t
+++ b/t/54_stringify.t
@@ -10,8 +10,7 @@ BEGIN {
   }
 }
 use Time::Piece;
-plan tests => 5;
-#$] < 5.008 ? (skip_all => "5.6") : (tests => 5);
+plan $] < 5.008 ? (skip_all => "5.6 no AMG yet") : (tests => 5);
 use Cpanel::JSON::XS;
 
 my $time = localtime;
@@ -32,20 +31,14 @@ package main;
 my $object = bless ["foo"], 'Foo';
 my $enc = $json->encode( { obj => $object } );
 
-TODO: {
-  #local $TODO = 'Not yet ready';
-  is( $enc, '{"obj":"Foo <foo>"}', "mg object stringified" )
-    or diag($enc);
-}
+is( $enc, '{"obj":"Foo <foo>"}', "mg object stringified" )
+  or diag($enc);
 
 $enc = $json->encode( { time => $time } );
 isa_ok($time, "Time::Piece");
 
-TODO: {
-  #local $TODO = 'Not yet ready';
-  # my $dec = $json->decode($enc);
-  is( $enc, qq({"time":"$time"}), 'mg Time::Piece object was stringified' );
-}
+# my $dec = $json->decode($enc);
+is( $enc, qq({"time":"$time"}), 'mg Time::Piece object was stringified' );
 
 $object = bless [], 'main';
 $json->allow_blessed;