Issue #2464: use only YAML::XS for loading

Thus eliminate usage of YAML::Any and the fallback to YAML.pm. Thus some code for special support of YAML.pm can be eliminated too.
RotherOSS · Aug 15, 2023 · 5196645 · 5196645
1 parent e318225
commit 5196645
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 120 deletions.
diff --git a/Kernel/System/YAML.pm b/Kernel/System/YAML.pm
@@ -19,9 +19,11 @@ package Kernel::System::YAML;
 use strict;
 use warnings;
 
+# core modules
 use Encode qw();
-use YAML::Any qw();
-use YAML qw();
+
+# CPAN modules
+use YAML::XS qw();
 
 our @ObjectDependencies = (
     'Kernel::System::Log',
@@ -48,10 +50,7 @@ sub new {
     my ( $Type, %Param ) = @_;
 
     # allocate new hash for object
-    my $Self = {};
-    bless( $Self, $Type );
-
-    return $Self;
+    return bless {}, $Type;
 }
 
 =head2 Dump()
@@ -73,15 +72,16 @@ sub Dump {
             Priority => 'error',
             Message  => 'Need Data!',
         );
+
         return;
     }
 
-    my $Result = YAML::Any::Dump( $Param{Data} ) || "--- ''\n";
+    my $String = YAML::XS::Dump( $Param{Data} ) || "--- ''\n";
 
     # Make sure the resulting string has the UTF-8 flag.
     Encode::_utf8_on($Result);
 
-    return $Result;
+    return $String;
 }
 
 =head2 Load()
@@ -99,7 +99,7 @@ sub Load {
     my ( $Self, %Param ) = @_;
 
     # check for needed data
-    return if !defined $Param{Data};
+    return unless defined $Param{Data};
 
     if ( Encode::is_utf8( $Param{Data} ) ) {
         Encode::_utf8_off( $Param{Data} );
@@ -117,11 +117,7 @@ sub Load {
     }
 
     my $Result;
-
-    # get used YAML implementation
-    my $YAMLImplementation = YAML::Any->implementation();
-
-    if ( !eval { $Result = YAML::Any::Load( $Param{Data} ) } ) {
+    if ( !eval { $Result = YAML::XS::Load( $Param{Data} ) } ) {
         $Kernel::OM->Get('Kernel::System::Log')->Log(
             Priority => 'error',
             Message  => 'Loading the YAML string failed: ' . $@,
@@ -132,84 +128,13 @@ sub Load {
         }
         $Kernel::OM->Get('Kernel::System::Log')->Log(
             Priority => 'error',
-            Message  => 'YAML data was: "' . $DumpString . '"',
-        );
-
-        # if used implementation is pure perl YAML there is nothing to do, but exit with error
-        return if $YAMLImplementation eq 'YAML';
-
-        # otherwise use pure-perl YAML as fallback if YAML::XS or other can't parse the data
-        # structure correctly
-        if ( !eval { $Result = YAML::Load( $Param{Data} ) } ) {
-            $Kernel::OM->Get('Kernel::System::Log')->Log(
-                Priority => 'error',
-                Message  => 'YAML data was not readable even by pure-perl YAML module',
-            );
-            return;
-        }
-        $Kernel::OM->Get('Kernel::System::Log')->Log(
-            Priority => 'error',
-            Message  => 'Data was only readable pure-perl YAML module, please contact the'
-                . ' System Administrator to update this record, as the stored data is still in a'
-                . ' wrong format!',
+            Message  => qq{YAML data was: "$DumpString"},
         );
     }
 
-    # YAML does not set the UTF8 flag on strings that need it, do that manually now.
-    if ( $YAMLImplementation eq 'YAML' && defined $Result ) {
-        _AddUTF8Flag( \$Result );
-    }
-
+    # The resulting data structure may contain strings
+    # that are internally encoded in latin1.
     return $Result;
 }
 
-=begin Internal:
-
-=head2 _AddUTF8Flag()
-
-adds the UTF8 flag to all elements in a complex data structure.
-
-=cut
-
-sub _AddUTF8Flag {
-    my ($Data) = @_;
-
-    if ( !ref ${$Data} ) {
-        Encode::_utf8_on( ${$Data} );
-        return;
-    }
-
-    if ( ref ${$Data} eq 'SCALAR' ) {
-        return _AddUTF8Flag( ${$Data} );
-    }
-
-    if ( ref ${$Data} eq 'HASH' ) {
-        KEY:
-        for my $Key ( sort keys %{ ${$Data} } ) {
-            next KEY if !defined ${$Data}->{$Key};
-            _AddUTF8Flag( \${$Data}->{$Key} );
-        }
-        return;
-    }
-
-    if ( ref ${$Data} eq 'ARRAY' ) {
-        KEY:
-        for my $Key ( 0 .. $#{ ${$Data} } ) {
-            next KEY if !defined ${$Data}->[$Key];
-            _AddUTF8Flag( \${$Data}->[$Key] );
-        }
-        return;
-    }
-
-    if ( ref ${$Data} eq 'REF' ) {
-        return _AddUTF8Flag( ${$Data} );
-    }
-
-    return;
-}
-
-=end Internal:
-
-=cut
-
 1;
diff --git a/scripts/test/YAML/YAML.t b/scripts/test/YAML/YAML.t
@@ -18,13 +18,14 @@ use strict;
 use warnings;
 use utf8;
 
-# Set up the test driver $Self when we are running as a standalone script.
-use Kernel::System::UnitTest::RegisterDriver;
+# core modules
 
-our $Self;
+# CPAN modules
+use Test2::V0;
+use YAML::XS qw();
 
-# get YAML object
-my $YAMLObject = $Kernel::OM->Get('Kernel::System::YAML');
+# OTOBO modules
+use Kernel::System::UnitTest::RegisterOM;    # set up $Kernel::OM
 
 my @Tests = (
     {
@@ -79,7 +80,6 @@ my @Tests = (
     {
         Name          => 'Very long string',      # see https://bugzilla.redhat.com/show_bug.cgi?id=192400
         Data          => ' äø<>"\'' x 40_000,
-        SkipEngine    => 'YAML',                  # This test does not run with plain YAML, see the bug above
         SuccessDecode => 1,
     },
     {
@@ -183,34 +183,24 @@ my @Tests = (
     },
 );
 
-ENGINE:
-for my $Engine (qw(YAML::XS YAML)) {
+for my $Test (@Tests) {
 
-    # locally override the internal engine of YAML::Any to force testing
-    local @YAML::Any::_TEST_ORDER = ($Engine);
+    my $YAMLString = $Test->{YAMLString} || YAML::XS::Dump( Data => $Test->{Data} );
+    my $YAMLData   = YAML::XS::Load( Data => $YAMLString );
 
-    TEST:
-    for my $Test (@Tests) {
-
-        next TEST if defined $Test->{SkipEngine} && $Engine eq $Test->{SkipEngine};
-
-        my $YAMLString = $Test->{YAMLString} || $YAMLObject->Dump( Data => $Test->{Data} );
-        my $YAMLData   = $YAMLObject->Load( Data => $YAMLString );
-
-        if ( $Test->{SuccessDecode} ) {
-            $Self->IsDeeply(
-                $YAMLData,
-                $Test->{Data},
-                "Engine $Engine - $Test->{Name}",
-            );
-        }
-        else {
-            $Self->False(
-                $YAMLData,
-                "Engine $Engine - $Test->{Name}",
-            );
-        }
+    if ( $Test->{SuccessDecode} ) {
+        is(
+            $YAMLData,
+            $Test->{Data},
+            "$Test->{Name} - got expected result",
+        );
+    }
+    else {
+        ok(
+            !$YAMLData,
+            "$Test->{Name} - failure reported",
+        );
     }
 }
 
-$Self->DoneTesting();
+done_testing;