Script 'mail_helper' called by obssrc
Hello community,

here is the log from the commit of package perl-Sereal-Decoder for 
openSUSE:Factory checked in at 2022-08-16 17:08:27
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Sereal-Decoder (Old)
 and      /work/SRC/openSUSE:Factory/.perl-Sereal-Decoder.new.1521 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Package is "perl-Sereal-Decoder"

Tue Aug 16 17:08:27 2022 rev:11 rq:997340 version:4.025

Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Sereal-Decoder/perl-Sereal-Decoder.changes  
2022-02-24 18:24:44.154638441 +0100
+++ 
/work/SRC/openSUSE:Factory/.perl-Sereal-Decoder.new.1521/perl-Sereal-Decoder.changes
        2022-08-16 17:08:32.720021931 +0200
@@ -1,0 +2,14 @@
+Fri Jul 29 03:09:01 UTC 2022 - Tina M??ller <[email protected]>
+
+- updated to 4.025
+   see /usr/share/doc/packages/perl-Sereal-Decoder/Changes
+
+  4.025 Thr Jul 28, 2022
+      * Release with build fixes for threaded perls and MANIFEST
+        update. Oops.
+
+  4.024 Wed Jul 27, 2022
+      * Total rework of how THAW is invoked to resolve issues with
+        frozen representations containing blessed objects.
+
+-------------------------------------------------------------------

Old:
----
  Sereal-Decoder-4.023.tar.gz

New:
----
  Sereal-Decoder-4.025.tar.gz

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ perl-Sereal-Decoder.spec ++++++
--- /var/tmp/diff_new_pack.lny6qb/_old  2022-08-16 17:08:33.204023379 +0200
+++ /var/tmp/diff_new_pack.lny6qb/_new  2022-08-16 17:08:33.212023402 +0200
@@ -18,7 +18,7 @@
 
 %define cpan_name Sereal-Decoder
 Name:           perl-Sereal-Decoder
-Version:        4.023
+Version:        4.025
 Release:        0
 License:        Artistic-1.0 OR GPL-1.0-or-later
 Summary:        Binary serialization module for Perl (decoder part)

++++++ Sereal-Decoder-4.023.tar.gz -> Sereal-Decoder-4.025.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/Changes 
new/Sereal-Decoder-4.025/Changes
--- old/Sereal-Decoder-4.023/Changes    2022-02-20 05:05:20.000000000 +0100
+++ new/Sereal-Decoder-4.025/Changes    2022-07-28 13:57:13.000000000 +0200
@@ -5,6 +5,15 @@
 *          of the decoder before upgrading to version 4 of the *
 *          encoder!                                            *
 ****************************************************************
+4.025 Thr Jul 28, 2022
+    * Release with build fixes for threaded perls and MANIFEST
+      update. Oops.
+
+4.024 Wed Jul 27, 2022
+    * Total rework of how THAW is invoked to resolve issues with
+      frozen representations containing blessed objects.
+
+
 4.023 Sun Feb 20, 2022
     * Make it possible to upgrade with passing tests when using
       Sereal::Decoder 4.015 - 4.019 on threaded debugging perls.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/Decoder.xs 
new/Sereal-Decoder-4.025/Decoder.xs
--- old/Sereal-Decoder-4.023/Decoder.xs 2022-02-20 04:51:47.000000000 +0100
+++ new/Sereal-Decoder-4.025/Decoder.xs 2022-07-28 13:04:56.000000000 +0200
@@ -346,6 +346,7 @@
         SRL_INIT_OPTION( SRL_DEC_OPT_IDX_MAX_NUM_ARRAY_ENTRIES,      
SRL_DEC_OPT_STR_MAX_NUM_ARRAY_ENTRIES      );
         SRL_INIT_OPTION( SRL_DEC_OPT_IDX_MAX_STRING_LENGTH,          
SRL_DEC_OPT_STR_MAX_STRING_LENGTH          );
         SRL_INIT_OPTION( SRL_DEC_OPT_IDX_MAX_UNCOMPRESSED_SIZE,      
SRL_DEC_OPT_STR_MAX_UNCOMPRESSED_SIZE      );
+        SRL_INIT_OPTION( SRL_DEC_OPT_IDX_NO_THAW_OBJECTS,            
SRL_DEC_OPT_STR_NO_THAW_OBJECTS            );
     }
 #if USE_CUSTOM_OPS
     {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/MANIFEST 
new/Sereal-Decoder-4.025/MANIFEST
--- old/Sereal-Decoder-4.023/MANIFEST   2022-02-20 05:14:06.000000000 +0100
+++ new/Sereal-Decoder-4.025/MANIFEST   2022-07-28 14:05:36.000000000 +0200
@@ -53,6 +53,7 @@
 t/070_alias_options.t
 t/071_alias_reserealize.t
 t/080_set_readonly.t
+t/090_thaw.t
 t/110_nobless.t
 t/150_dec_exception.t
 t/155_zipbomb.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/META.json 
new/Sereal-Decoder-4.025/META.json
--- old/Sereal-Decoder-4.023/META.json  2022-02-20 05:14:06.000000000 +0100
+++ new/Sereal-Decoder-4.025/META.json  2022-07-28 14:05:36.000000000 +0200
@@ -4,7 +4,7 @@
       "Steffen Mueller <[email protected]>, Yves Orton <[email protected]>"
    ],
    "dynamic_config" : 1,
-   "generated_by" : "ExtUtils::MakeMaker version 7.38, CPAN::Meta::Converter 
version 2.150010",
+   "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter 
version 2.150010",
    "license" : [
       "perl_5"
    ],
@@ -70,6 +70,6 @@
          "url" : "git://github.com/Sereal/Sereal.git"
       }
    },
-   "version" : "4.023",
-   "x_serialization_backend" : "JSON::PP version 4.04"
+   "version" : "4.025",
+   "x_serialization_backend" : "JSON::PP version 4.07"
 }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/META.yml 
new/Sereal-Decoder-4.025/META.yml
--- old/Sereal-Decoder-4.023/META.yml   2022-02-20 05:14:06.000000000 +0100
+++ new/Sereal-Decoder-4.025/META.yml   2022-07-28 14:05:36.000000000 +0200
@@ -18,7 +18,7 @@
 configure_requires:
   ExtUtils::MakeMaker: '7.0'
 dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 7.38, CPAN::Meta::Converter version 
2.150010'
+generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 
2.150010'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -34,5 +34,5 @@
 resources:
   bugtracker: https://github.com/Sereal/Sereal/issues
   repository: git://github.com/Sereal/Sereal.git
-version: '4.023'
+version: '4.025'
 x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/lib/Sereal/Decoder/Constants.pm 
new/Sereal-Decoder-4.025/lib/Sereal/Decoder/Constants.pm
--- old/Sereal-Decoder-4.023/lib/Sereal/Decoder/Constants.pm    2022-02-20 
05:06:44.000000000 +0100
+++ new/Sereal-Decoder-4.025/lib/Sereal/Decoder/Constants.pm    2022-07-28 
13:57:13.000000000 +0200
@@ -4,7 +4,7 @@
 require Exporter;
 our @ISA= qw(Exporter);
 
-our $VERSION= '4.023'; # Don't forget to update the TestCompat set for testing 
against installed encoders!
+our $VERSION= '4.025'; # Don't forget to update the TestCompat set for testing 
against installed encoders!
 
 our ( @EXPORT_OK, %DEFINE, %TAG_INFO_HASH, @TAG_INFO_ARRAY );
 
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/lib/Sereal/Decoder.pm 
new/Sereal-Decoder-4.025/lib/Sereal/Decoder.pm
--- old/Sereal-Decoder-4.023/lib/Sereal/Decoder.pm      2022-02-20 
05:06:44.000000000 +0100
+++ new/Sereal-Decoder-4.025/lib/Sereal/Decoder.pm      2022-07-28 
13:57:13.000000000 +0200
@@ -5,7 +5,7 @@
 use Carp qw/croak/;
 use XSLoader;
 
-our $VERSION= '4.023'; # Don't forget to update the TestCompat set for testing 
against installed encoders!
+our $VERSION= '4.025'; # Don't forget to update the TestCompat set for testing 
against installed encoders!
 our $XS_VERSION= $VERSION; $VERSION= eval $VERSION;
 
 # not for public consumption, just for testing.
@@ -246,6 +246,12 @@
 If set, the decoder will deserialize any objects in the input stream but 
without
 blessing them. Defaults to off. See the section C<ROBUSTNESS> below.
 
+=head3 no_thaw_objects
+
+If set, the decoder will deserialize frozen objects in the objects stream as an
+array ref of arguments that would be passed into the THAW subroutine instead of
+calling THAW itself.
+
 =head3 validate_utf8
 
 If set, the decoder will refuse invalid UTF-8 byte sequences. This is off
@@ -674,6 +680,43 @@
 you may want to use the C<refuse_objects> option. For more details on
 the C<FREEZE/THAW> mechanism, please refer to L<Sereal::Encoder>.
 
+=head1 FREEZE/THAW CALLBACK MECHANISM
+
+Some objects do not lend themselves naturally to naive perl
+datastructure level serialization. For instance XS code might use a
+hidden structure that would not get serialized, or an object may contain
+volatile data like a filehandle that would not be reconstituted
+properly. To support cases like this C<Sereal> supports a FREEZE and
+THAW api. When objects are serialized their FREEZE method is asked for a
+replacement representation, and when objects are deserialized their THAW
+method is asked to convert that replacement back to something useful.
+
+For security reasons decoding an object will NOT autoload any modules
+to support THAW, however if the classes and methods are preloaded it
+will invoke THAW as required and an exception will be thrown if the class
+has not been loaded. It is possible to disable THAW in the decoder by using
+the C<no_thaw_objects> option, which when true causes frozen objects to
+be blessed into a special utility class "Sereal::Decoder::THAW_args"
+for debugging. The objects themselves are an array, whose last member
+will contain the class name the arguments are for.
+
+Prior to v4.024 the decoder had issues with frozen representations that
+contained other objects and did not define a specific order that items
+would be thawed and blessed, making it impractical to put an object
+inside of the frozen representation of another object.
+
+As of v4.024 frozen representations may contain other objects, and the
+order in which they are thawed is defined to be LIFO, thus the arguments
+to a THAW method will themselves be thawed (if need be) before the call
+to the containing objects THAW method. Thawing occurs only after all
+simple objects have been blessed into their appropriate object form.
+
+The FREEZE/THAW mechanism is inspired by the equivalent mechanism in
+L<CBOR::XS>. The general mechanism is documented in the
+I<A GENERIC OBJECT SERIALIATION PROTOCOL> section of L<Types::Serialiser>.
+Similar to CBOR using C<CBOR>, Sereal uses the string C<Sereal> as a
+serializer identifier for the callbacks.
+
 =head1 PERFORMANCE
 
 Please refer to the L<Sereal::Performance> document
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/ptable.h 
new/Sereal-Decoder-4.025/ptable.h
--- old/Sereal-Decoder-4.023/ptable.h   2017-10-03 19:46:10.000000000 +0200
+++ new/Sereal-Decoder-4.025/ptable.h   2022-07-28 13:04:56.000000000 +0200
@@ -70,7 +70,6 @@
     struct PTABLE_entry     *cur_entry;
 };
 
-/*
 SRL_STATIC_INLINE PTABLE_t * PTABLE_new(void);
 SRL_STATIC_INLINE PTABLE_t * PTABLE_new_size(const U8 size_base2_exponent);
 SRL_STATIC_INLINE PTABLE_ENTRY_t * PTABLE_find(PTABLE_t *tbl, const void *key);
@@ -84,9 +83,9 @@
 
 SRL_STATIC_INLINE PTABLE_ITER_t * PTABLE_iter_new(PTABLE_t *tbl);
 SRL_STATIC_INLINE PTABLE_ITER_t * PTABLE_iter_new_flags(PTABLE_t *tbl, int 
flags);
+SRL_STATIC_INLINE PTABLE_ITER_t * PTABLE_iter_reset(PTABLE_ITER_t *iter);
 SRL_STATIC_INLINE PTABLE_ENTRY_t * PTABLE_iter_next(PTABLE_ITER_t *iter);
 SRL_STATIC_INLINE void PTABLE_iter_free(PTABLE_ITER_t *iter);
-*/
 
 /* create a new pointer => pointer table */
 SRL_STATIC_INLINE PTABLE_t *
@@ -302,11 +301,20 @@
     PTABLE_ITER_t *iter;
     Newx(iter, 1, PTABLE_ITER_t);
     iter->table = tbl;
-    iter->bucket_num = 0;
-    iter->cur_entry = NULL;
 
     if (flags & PTABLE_FLAG_AUTOCLEAN)
         tbl->cur_iter = iter;
+    return PTABLE_iter_reset(iter);
+}
+
+/* setup or reset new iterator object */
+SRL_STATIC_INLINE PTABLE_ITER_t *
+PTABLE_iter_reset(PTABLE_ITER_t *iter)
+{
+    PTABLE_t *tbl = iter->table;
+    iter->bucket_num = 0;
+    iter->cur_entry = NULL;
+
     if (tbl->tbl_items == 0) {
         /* Prevent hash bucket scanning.
          * This can be a significant optimization on large, empty hashes. */
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/srl_decoder.c 
new/Sereal-Decoder-4.025/srl_decoder.c
--- old/Sereal-Decoder-4.023/srl_decoder.c      2022-02-20 04:51:47.000000000 
+0100
+++ new/Sereal-Decoder-4.025/srl_decoder.c      2022-07-28 13:57:13.000000000 
+0200
@@ -131,6 +131,7 @@
 SRL_STATIC_INLINE void srl_read_frozen_object(pTHX_ srl_decoder_t *dec, HV 
*class_stash, SV *into);
 SRL_STATIC_INLINE SV * srl_follow_refp_alias_reference(pTHX_ srl_decoder_t 
*dec, UV offset);
 SRL_STATIC_INLINE AV * srl_follow_objectv_reference(pTHX_ srl_decoder_t *dec, 
UV offset);
+SRL_STATIC_INLINE void srl_thaw_object(pTHX_ srl_decoder_t *dec, HV 
*class_stash, SV *sv);
 
 /* FIXME unimplemented!!! */
 SRL_STATIC_INLINE SV *srl_read_extend(pTHX_ srl_decoder_t *dec, SV* into);
@@ -246,9 +247,22 @@
         if ( val && SvTRUE(val) )
             SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_REFUSE_OBJECTS);
 
-        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_NO_BLESS_OBJECTS);
-        if ( val && SvTRUE(val) )
-            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS);
+        {
+            int thaw_set = 0;
+            my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_NO_THAW_OBJECTS);
+            if ( val ) {
+                thaw_set= 1;
+                if (SvTRUE(val))
+                    SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NO_THAW_OBJECTS);
+            }
+
+            my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_NO_BLESS_OBJECTS);
+            if ( val && SvTRUE(val) ) {
+                SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS);
+                if (!thaw_set)
+                    SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NO_THAW_OBJECTS);
+            }
+        }
 
         my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_VALIDATE_UTF8);
         if ( val && SvTRUE(val) )
@@ -387,6 +401,10 @@
     }
     if (dec->ref_thawhash)
         PTABLE_free(dec->ref_thawhash);
+    if (dec->thaw_av) {
+        SvREFCNT_dec(dec->thaw_av);
+        dec->thaw_av = NULL;
+    }
     if (dec->alias_cache)
         SvREFCNT_dec(dec->alias_cache);
     Safefree(dec);
@@ -684,10 +702,105 @@
     }
 }
 
+#define AV_PUSH(into_av, value_sv) STMT_START {     \
+    av_push(into_av, value_sv);                     \
+    SvREFCNT_inc(value_sv);                         \
+} STMT_END
+
+#define SAFE_NEW_AV(the_av) STMT_START {                            \
+    the_av= newAV();                                                \
+    if (!the_av)                                                    \
+        croak("out of memory at %s line %d.", __FILE__, __LINE__);   \
+} STMT_END
+
+#define SAFE_PTABLE_NEW(the_ptr_table) STMT_START {                 \
+    the_ptr_table= PTABLE_new();                                    \
+    if (!the_ptr_table)                                             \
+        croak("out of memory at %s line %d.", __FILE__, __LINE__);   \
+} STMT_END
+
+
+/* register a newly seen frozen object for THAWing later. */
+SRL_STATIC_INLINE void
+srl_track_frozen_object(pTHX_ srl_decoder_t *dec, HV *class_stash, SV *into)
+{
+    AV *info_av;
+    if (!dec->thaw_av)
+        SAFE_NEW_AV(dec->thaw_av);
+
+    AV_PUSH(dec->thaw_av, into);
+
+    if (!dec->ref_thawhash)
+        SAFE_PTABLE_NEW(dec->ref_thawhash);
+
+    PTABLE_store(dec->ref_thawhash, (void *)SvRV(into), (void *)class_stash);
+}
+
+
+/* Fetch or register a reference to an already seen frozen object.
+ * Called during deserialization (push=1) to handle duplicate references
+ * to the same frozen object. Called during finalization (push=) to get
+ * the data required to THAW the item, in this case the 'push' argument
+ * is false.
+ *
+ * Returns as an SV * either an HV or an AV (NULL is theoretically
+ * possibly also but should not occur in the current use). If an HV
+ * then it is the class stash for the item looked up, if an AV then it
+ * is a mortal array that contains a class stash as the first element,
+ * along with the additional items that need to be fixed to point at the
+ * unfrozen item. */
+SRL_STATIC_INLINE SV *
+srl_fetch_register_frozen_object(pTHX_ srl_decoder_t *dec, SV *item, const int 
push)
+{
+    if (dec->ref_thawhash) {
+        PTABLE_ENTRY_t *tblent = PTABLE_find(dec->ref_thawhash, SvRV(item));
+        if (tblent) {
+            AV *info_av = (AV*)tblent->value;
+            if (push) {
+                if (SvTYPE((SV*)info_av) != SVt_PVAV) {
+                    /* we have an HV* class_stash in the structure right now.
+                     * so we have to upgrade this case to be an AV containing 
the
+                     * class stash. */
+                    HV *class_stash= (HV*)info_av;
+                    SAFE_NEW_AV(info_av);
+                    sv_2mortal((SV*)info_av);
+                    AV_PUSH(info_av, (SV*)class_stash); /* push the old value 
into the array */
+                    tblent->value= (void *)info_av; /* point the tblent at 
this new value */
+                }
+                /* add the item as a duplicate reference for fixups later */
+                AV_PUSH(info_av, item);
+            }
+            return (SV*)info_av;
+        }
+    }
+    return NULL;
+}
+
 SRL_STATIC_INLINE void
 srl_finalize_structure(pTHX_ srl_decoder_t *dec)
 {
     int nobless = SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS);
+    int nothaw = SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NO_THAW_OBJECTS);
+
+    /* At this point the structure should be more or less reconstructed.
+     * The main exception is objects that need to be blessed. We defer
+     * this to as late as possible to avoid triggering DESTROY methods
+     * as part of our deserialization. The blessed objects can be
+     * divided into those which are frozen and thus require a call to
+     * THAW, and those which only required a call to bless.
+     *
+     * We handle the simple case first, as the frozen form of an object
+     * of one class might contain a simple object. In this case the
+     * order we call bless doesn't matter.
+     *
+     * Once all the simple bless operations have been performed we thaw
+     * the frozen items in LIFO order, replacing the referent of the
+     * reference to the frozen form with the thawed replacement. We may
+     * have to do this replacement operation multiple times if there are
+     * multiple references to the same frozen object in the data
+     * structure as the thaw operation occurs so late we cant use the
+     * normal cache mechanism to handle multiple references.
+     */
 
     if (dec->weakref_av)
         av_clear(dec->weakref_av);
@@ -738,39 +851,72 @@
                         SRL_RDR_ERROR(dec->pbuf, "object missing from 
ref_bless_av array?");
                     }
                 } else {
-                    warn("serialization contains a duplicated key, ignoring");
+                    warn("Not blessing object that would be DESTROYed 
immediately. Malformed packet?");
                 }
                 SvREFCNT_dec(obj);
             }
         }
         PTABLE_iter_free(it);
     }
+    /* And finally after all the simple blessing is done we need to handle any 
FROZEN
+     * objects by calling their THAW method. We have to do this last as their 
frozen
+     * representation may contain simple objects created during the bless 
phase above.
+     */
+    if (dec->thaw_av) {
+        IV thaw_av_len= av_len(dec->thaw_av) + 1;
+        HV *debug_class= NULL;
+
+        /* Everything should be blessed now, so call thaw on each FROZEN
+         * object in LIFO order. Each frozen object will have at least one
+         * reference to it that must be fixed, there may be more if the same
+         * object was referenced multiple times in the data structure.
+         * For each item in thaw_av there should be a corresponding av with
+         * the class stash and any additional items that need to be fixed
+         * in it.
+         */
+        for ( ; thaw_av_len > 0 ; thaw_av_len-- ) {
+            SV *sv = av_pop(dec->thaw_av);
+            HV *class_stash = (HV*)srl_fetch_register_frozen_object(aTHX_ dec, 
sv, 0);
+            AV *additional_refs= NULL;
+            IV fixups = 0;
+            if (SvTYPE(class_stash) == SVt_PVAV) {
+                additional_refs = (AV*)class_stash;
+                fixups = av_len(additional_refs); /* no +1 because we do it 
before the class_stash shift */
+                class_stash = (HV *)av_shift((AV*)additional_refs);
+                SvREFCNT_dec(class_stash);
+            }
+            if (nothaw) {
+                /* do not actually thaw. In order to make it easier to find 
these cases in a dump
+                 * we push the class name into the AV, and then bless it into 
a special class
+                 * private to the Sereal project. */
+                char *classname = HvNAME(class_stash);
+                AV *av= (AV*)SvRV(sv);
+                if (!debug_class) {
+                    debug_class = gv_stashpvs("Sereal::Decoder::THAW_args",1);
+                }
+                av_push(av,newSVpvn(classname, strlen(classname)));
+                sv_bless(sv,debug_class);
+            } else {
+                /* thaw the first ref. */
+                srl_thaw_object(aTHX_ dec, class_stash, sv);
+                /* if there are any additional refs then stitch them in */
+                for ( ; fixups > 0; fixups--) {
+                    SV* into = av_pop(additional_refs);
+                    SvREFCNT_dec(SvRV(into));
+                    SvRV_set(into, SvRV(sv));
+                    SvREFCNT_inc(SvRV(sv));
+                    SvREFCNT_dec(into);
+                }
+            }
+            SvREFCNT_dec(sv);
+        }
+    }
 }
 
 
 /* PRIVATE UTILITY FUNCTIONS */
 
 SRL_STATIC_INLINE void
-srl_track_thawed(srl_decoder_t *dec, const U8 *track_pos, SV *sv)
-{
-    if (!dec->ref_thawhash)
-        dec->ref_thawhash = PTABLE_new();
-    PTABLE_store(dec->ref_thawhash, (void *)(track_pos - dec->buf.body_pos), 
(void *)sv);
-}
-
-
-SRL_STATIC_INLINE SV *
-srl_fetch_thawed(srl_decoder_t *dec, UV item)
-{
-    if (dec->ref_thawhash) {
-        SV *sv= (SV *)PTABLE_fetch(dec->ref_thawhash, (void *)item);
-        return sv;
-    } else {
-        return NULL;
-    }
-}
-
-SRL_STATIC_INLINE void
 srl_track_sv(pTHX_ srl_decoder_t *dec, const U8 *track_pos, SV *sv)
 {
     PTABLE_store(dec->ref_seenhash, (void *)(track_pos - dec->buf.body_pos), 
(void *)sv);
@@ -1139,7 +1285,7 @@
         DEPTH_DECREMENT(dec);
 }
 
-
+/* read reference to next thing */
 SRL_STATIC_INLINE void
 srl_read_refn(pTHX_ srl_decoder_t *dec, SV* into)
 {
@@ -1224,22 +1370,17 @@
     return av;
 }
 
+/* reuse a reference to a previous item */
 SRL_STATIC_INLINE void
 srl_read_refp(pTHX_ srl_decoder_t *dec, SV* into)
 {
     /* something we did before */
-    UV item= srl_read_varint_uv_offset(aTHX_ dec->pbuf, " while reading REFP 
tag");
-    SV *thawed= srl_fetch_thawed(dec, item);
-    SV *referent;
-    if (thawed) {
-        sv_setsv(into, thawed);
-        return;
-    }
-    referent= srl_fetch_item(aTHX_ dec, item, "REFP");
+    UV ofs= srl_read_varint_uv_offset(aTHX_ dec->pbuf, " while reading REFP 
tag");
+    SV *referent= srl_fetch_item(aTHX_ dec, ofs, "REFP");
 
 #ifdef FOLLOW_REFERENCES_IF_NOT_STASHED
     if (referent == NULL)
-        referent = srl_follow_refp_alias_reference(aTHX_ dec, item);
+        referent = srl_follow_refp_alias_reference(aTHX_ dec, ofs);
 #endif
 
     (void)SvREFCNT_inc(referent);
@@ -1254,6 +1395,7 @@
             SvAMAGIC_on(into);
     }
 #endif
+    srl_fetch_register_frozen_object(aTHX_ dec, into, 1);
 }
 
 
@@ -1327,9 +1469,9 @@
         HV *class_stash= (HV *) PTABLE_fetch(dec->ref_stashes, (void *)ofs);
         if (expect_false( class_stash == NULL ))
             SRL_RDR_ERROR(dec->pbuf, "Corrupted packet. OBJECTV(_FREEZE) used 
without "
-                      "preceding OBJECT(_FREEZE) to define classname");
+                          "preceding OBJECT(_FREEZE) to define classname");
         srl_read_frozen_object(aTHX_ dec, class_stash, into);
-    }  else {
+    } else {
         /* SRL_HDR_OBJECTV, not SRL_HDR_OBJECTV_FREEZE */
         /* now deparse the thing we are going to bless */
         srl_read_single_value(aTHX_ dec, into, NULL);
@@ -1349,6 +1491,7 @@
         }
 #endif
     }
+
 }
 
 SRL_STATIC_INLINE void
@@ -1476,15 +1619,16 @@
     assert(obj_tag != 0);
 #endif
 
+    SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NEEDS_FINALIZE);
     if (expect_false( obj_tag == SRL_HDR_OBJECT_FREEZE )) {
         srl_read_frozen_object(aTHX_ dec, class_stash, into);
-    }  else {
+    } else {
+
         /* We now have a stash so we /could/ bless... except that
          * we don't actually want to do so right now. We want to defer blessing
          * until the full packet has been read. Yes it is more overhead, but
          * we really dont want to trigger DESTROY methods from a partial
          * deparse. So we insert the item into an array to be blessed later. */
-        SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NEEDS_FINALIZE);
         av_push(av, SvREFCNT_inc(into));
 
         /* now deparse the thing we are going to bless */
@@ -1495,35 +1639,32 @@
         if (!SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS))
             sv_bless(into, class_stash);
 #endif
-
     }
 }
 
+
+SRL_STATIC_INLINE void
+srl_read_frozen_object(pTHX_ srl_decoder_t *dec, HV *class_stash, SV *into)
+{
+    const unsigned char *fixup_pos= dec->buf.pos + 1; /* get the tag for the 
WHATEVER */
+    srl_read_single_value(aTHX_ dec, into, NULL);
+
+    srl_track_frozen_object(aTHX_ dec, class_stash, into);
+}
+
 /* Invoke a THAW callback on the given class. Pass in the next item in the
  * decoder stream. This is implementing the FREEZE/THAW part of
  * SRL_HDR_OBJECT_FREEZE and SRL_HDR_OBJECTV_FREEZE. */
-
 SRL_STATIC_INLINE void
-srl_read_frozen_object(pTHX_ srl_decoder_t *dec, HV *class_stash, SV *into)
+srl_thaw_object(pTHX_ srl_decoder_t *dec, HV *class_stash, SV *into)
 {
     GV *method = gv_fetchmethod_autoload(class_stash, "THAW", 0);
     char *classname = HvNAME(class_stash);
-    SV* referent;
-    SV *replacement;
-
-    /* At this point in the input stream we should have REFN WHATEVER. The 
WHATEVER
-     * may be referenced from multiple RV's in the data structure, which means 
that
-     * srl_read_single_value() will cache the *unthawed* representation when 
we finally
-     * process it. So we need to do some special bookkeeping here and then 
overwrite
-     * that representation in the refs hash.
-     */
-
-    const unsigned char *fixup_pos= dec->buf.pos + 1; /* get the tag for the 
WHATEVER */
+    SV *replacement = NULL;
+    AV *arg_av;
 
     if (expect_false( method == NULL ))
-        SRL_RDR_ERRORf1(dec->pbuf, "No THAW method defined for class '%s'", 
HvNAME(class_stash));
-
-    srl_read_single_value(aTHX_ dec, into, NULL);
+        SRL_RDR_ERRORf1(dec->pbuf, "No THAW method defined for class '%s'", 
classname);
 
     /* Assert that we got a top level array ref as the spec requires.
      * Not throwing an exception here violates expectations down the line and
@@ -1532,9 +1673,9 @@
         SRL_RDR_ERROR(dec->pbuf, "Corrupted packet. OBJECT(V)_FREEZE used 
without "
                   "being followed by an array reference");
 
+    arg_av= (AV*)SvRV(into);
     {
         int count;
-        AV *arg_av= (AV*)SvRV(into);
         int arg_av_len = av_len(arg_av)+1;
         dSP;
 
@@ -1542,10 +1683,11 @@
         SAVETMPS;
         PUSHMARK(SP);
 
-        EXTEND(SP, 3);
+        EXTEND(SP, 2+arg_av_len);
         /* TODO Consider more caching for some of this */
         PUSHs(sv_2mortal(newSVpvn(classname, strlen(classname))));
-        /* FIXME do not recreate the following SV. That's dumb and wasteful! - 
so long as it doesnt get modified! */
+        /* FIXME do not recreate the following SV. That's dumb and wasteful! -
+         * So long as it doesnt get modified! */
         PUSHs(sv_2mortal(newSVpvs("Sereal")));
         /* Push the args into the stack */
         for (count=0 ; count < arg_av_len; count++) {
@@ -1560,8 +1702,6 @@
         if (expect_true( count == 1 )) {
             replacement = POPs;
             SvREFCNT_inc(replacement);
-        } else {
-            replacement = &PL_sv_undef;
         }
         /* If count is not 1, then it's 0. Then into is already undef. */
 
@@ -1569,25 +1709,14 @@
         FREETMPS;
         LEAVE;
     }
+    SvREFCNT_dec(arg_av);
 
-    /* At this point "into" is an SvRV pointing at the *unthawed* 
representation.
-     * This means we need to a) remove the old unthawed item and dispose of it
-     * and b) make "into" point at the replacement, and c) if necessary store 
the
-     * replacement in the sv tracking hash so that future references to this 
item
-     * point at the *thawed* version. */
     if (SvROK(replacement)) {
-        SV *tmpsv= replacement;
-        replacement= SvRV(tmpsv);
-        SvREFCNT_inc(replacement);
-        SvREFCNT_dec(tmpsv);
-        referent= SvRV(into);
-        SvRV_set(into, replacement);
-        SvREFCNT_dec(referent);
-        if (*fixup_pos & SRL_HDR_TRACK_FLAG)
-            srl_track_sv(aTHX_ dec, fixup_pos, replacement);
-    } else if (*fixup_pos & SRL_HDR_TRACK_FLAG) {
-        srl_track_thawed(dec, fixup_pos, replacement);
-        sv_setsv(into, replacement);
+        SvRV_set(into,  SvRV(replacement));
+        SvREFCNT_inc(SvRV(replacement));
+        SvREFCNT_dec(replacement);
+    } else {
+        SvRV_set(into, newSV(0));
     }
 }
 
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/srl_decoder.h 
new/Sereal-Decoder-4.025/srl_decoder.h
--- old/Sereal-Decoder-4.023/srl_decoder.h      2022-02-20 04:51:47.000000000 
+0100
+++ new/Sereal-Decoder-4.025/srl_decoder.h      2022-07-28 13:04:56.000000000 
+0200
@@ -21,10 +21,17 @@
     UV max_string_length;               /* Configured maximum length of the 
string */
     UV max_uncompressed_size;           /* Configured maximum size for 
uncompressed data */
     ptable_ptr ref_seenhash;            /* ptr table for avoiding circular 
refs */
-    ptable_ptr ref_thawhash;            /* ptr table for dealing with non ref 
thawed items */
-    ptable_ptr ref_stashes;             /* ptr table for tracking stashes we 
will bless into - key: ofs, value: stash */
-    ptable_ptr ref_bless_av;            /* ptr table for tracking which 
objects need to be bless - key: ofs, value: mortal AV (of refs)  */
+    ptable_ptr ref_thawhash;            /* ptr table for tracking which 
objects need to be thawed.
+                                           key: AV* from thaw args
+                                           value: mortal AV, [ HV 
*class_stash, SV *ref, ... ]
+                                           note that the key is the SvRV() of 
the ref parameters
+                                         */
+    ptable_ptr ref_stashes;             /* ptr table for tracking stashes we 
will bless into.
+                                           key: ofs, value: stash */
+    ptable_ptr ref_bless_av;            /* ptr table for tracking which 
objects need to be blessed.
+                                           key: ofs, value: mortal AV (of 
refs)  */
     AV* weakref_av;
+    AV* thaw_av;                        /* AV of refs which have to be thawed 
*/
 
     AV* alias_cache; /* used to cache integers of different sizes. */
     IV alias_varint_under;
@@ -109,7 +116,7 @@
 #define SRL_F_DECODER_REFUSE_OBJECTS            0x00000080UL
 /* Persistent flag: Make the decoder validate UTT8 strings */
 #define SRL_F_DECODER_VALIDATE_UTF8             0x00000100UL
-/* Persistent flag: Make the encoder forget to bless */
+/* Persistent flag: Make the decoder forget to bless */
 #define SRL_F_DECODER_NO_BLESS_OBJECTS          0x00000200UL
 /* Persistent flag: Destructive incremental parsing */
 #define SRL_F_DECODER_DESTRUCTIVE_INCREMENTAL   0x00000400UL
@@ -129,6 +136,8 @@
 #define SRL_F_DECODER_DECOMPRESS_ZSTD           0x00020000UL
 /* Persistent flag: Make the decoder REFUSE zstd-compressed documents */
 #define SRL_F_DECODER_REFUSE_ZSTD               0x00040000UL
+/* Persistent flag: Make the decoder forget to thaw */
+#define SRL_F_DECODER_NO_THAW_OBJECTS           0x00080000UL
 
 
 #define SRL_F_DECODER_ALIAS_CHECK_FLAGS   ( SRL_F_DECODER_ALIAS_SMALLINT | 
SRL_F_DECODER_ALIAS_VARINT | SRL_F_DECODER_USE_UNDEF )
@@ -208,10 +217,13 @@
 #define SRL_DEC_OPT_STR_MAX_UNCOMPRESSED_SIZE       "max_uncompressed_size"
 #define SRL_DEC_OPT_IDX_MAX_UNCOMPRESSED_SIZE       16
 
+#define SRL_DEC_OPT_STR_NO_THAW_OBJECTS            "no_thaw_objects"
+#define SRL_DEC_OPT_IDX_NO_THAW_OBJECTS            17
+
 /* NOTE WELL: WHEN YOU ADD AN OPTION YOU **MUST** ADD A
  * CORRESPONDING CALL TO SRL_INIT_OPTION() to Decoder.xs */
 
-#define SRL_DEC_OPT_COUNT                           17
+#define SRL_DEC_OPT_COUNT                           18
 
 #if ((PERL_VERSION > 10) || (PERL_VERSION == 10 && PERL_SUBVERSION > 1 ))
 #   define MODERN_REGEXP
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/Sereal-Decoder-4.023/t/090_thaw.t 
new/Sereal-Decoder-4.025/t/090_thaw.t
--- old/Sereal-Decoder-4.023/t/090_thaw.t       1970-01-01 01:00:00.000000000 
+0100
+++ new/Sereal-Decoder-4.025/t/090_thaw.t       2022-07-28 14:02:45.000000000 
+0200
@@ -0,0 +1,117 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use File::Spec;
+use lib File::Spec->catdir(qw(t lib));
+
+BEGIN {
+    lib->import('lib')
+        if !-d 't';
+}
+use Test::More;
+use Sereal::TestSet qw(:all);
+use Sereal::Decoder qw(decode_sereal);
+use Data::Dumper;
+
+if ( !have_encoder_and_decoder() ) {
+    plan skip_all => 'Did not find right version of encoder';
+}
+
+my $last_thaw_arg;
+package Matcher {
+       sub new {
+               my ($class, $pattern) = @_;
+               bless { pattern => $pattern }, $class;
+       }
+
+       sub FREEZE {
+               my ($self, $serializer) = @_;
+               return [$self->{pattern}],"22";
+       }
+
+       sub THAW {
+               my ($class, $serializer, @data) = @_;
+                $last_thaw_arg= Data::Dumper::Dumper(\@data);
+               return $class->new( $data[0][0] );
+       }
+}
+
+
+my $encoder_plain  = Sereal::Encoder->new();
+my $encoder_freeze = Sereal::Encoder->new({ freeze_callbacks => 1 });
+
+sub strip_white {
+    my $s= $_[0];
+    $s=~s/\s+/ /g;
+    $s=~s/\A\s+//;
+    $s=~s/\s+\z//;
+    return $s
+}
+sub no_warnings(&) {
+    my @warn;
+    local $SIG{__WARN__}= sub { push @warn, $_[0] };
+    $_[0]->();
+    return @warn == 0
+}
+
+
+my $string = 'string';
+my $blessed = bless {}, 'Bespoke';
+my $qr= qr/foo/;
+
+my @test_data = (
+       { data => $string,
+               description => 'Str' },
+       { data => $blessed,
+               description => 'Object without FREEZE/THAW' },
+        { data => Matcher->new( $qr ),
+                description => 'Object without FREEZE/THAW (regexp)' },
+       { data => Matcher->new( $string ),
+               description => '(Object with FREEZE/THAW) containing a Str' },
+       { data => Matcher->new( $blessed ),
+               description => '(Object with FREEZE/THAW) containing an (Object 
without FREEZE/THAW)' },
+);
+
+for my $data (@test_data) {
+       ok no_warnings {
+               decode_sereal(  $encoder_plain->encode($data->{data})  );
+       }, "Plain round-trip on $data->{description}";
+
+       ok no_warnings {
+                my $encoded= $encoder_freeze->encode($data->{data});
+               decode_sereal($encoded);
+       }, "FREEZE/THAW round-trip on $data->{description}";
+}
+my $want= strip_white(<<'EOF_THAW_ARG');
+$VAR1 = [
+           [
+             bless( {}, 'Bespoke' )
+           ],
+           '22'
+         ];
+EOF_THAW_ARG
+is(strip_white($last_thaw_arg),$want, "Last Thaw Args look as expected");
+
+$want= strip_white(<<'EOF_STRUCT');
+$VAR1 = bless(
+     [  [ bless( {}, 'Bespoke' ) ], '22', 'Matcher' ],
+    'Sereal::Decoder::THAW_args'
+);
+EOF_STRUCT
+my $decoded= 
decode_sereal($encoder_freeze->encode($test_data[-1]{data}),{no_thaw_objects=>1});
+is(strip_white(Dumper($decoded)), $want, "no_thaw_objects=1 worked as 
expected");
+
+$want= strip_white(<<'EOF_STRUCT');
+$VAR1 = bless( { 'pattern' => {} }, 'Matcher' );
+EOF_STRUCT
+$decoded= 
decode_sereal($encoder_freeze->encode($test_data[-1]{data}),{no_thaw_objects=>0,no_bless_objects=>1});
+is(strip_white(Dumper($decoded)), $want, "no_thaw_objects=0 no_bless_objects 
worked as expected");
+
+$want= strip_white(<<'EOF_STRUCT');
+$VAR1 = bless( [ [ {} ], '22', 'Matcher' ], 'Sereal::Decoder::THAW_args' );
+EOF_STRUCT
+$decoded= 
decode_sereal($encoder_freeze->encode($test_data[-1]{data}),{no_bless_objects=>1});
+is(strip_white(Dumper($decoded)), $want, "no_bless_objects=1 worked as 
expected");
+done_testing;
+__END__

Reply via email to