1# -- 2# Copyright (C) 2001-2020 OTRS AG, https://otrs.com/ 3# -- 4# This software comes with ABSOLUTELY NO WARRANTY. For details, see 5# the enclosed file COPYING for license information (GPL). If you 6# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt. 7# -- 8 9package Kernel::System::JSON; 10 11use strict; 12use warnings; 13 14# on PerlEx JSON::XS causes problems so force JSON::PP as backend 15# see http://bugs.otrs.org/show_bug.cgi?id=7337 16BEGIN { 17 if ( $ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m{\A CGI-PerlEx}xmsi ) { 18 $ENV{PERL_JSON_BACKEND} = 'JSON::PP'; ## no critic 19 } 20} 21 22use JSON; 23 24our @ObjectDependencies = ( 25 'Kernel::System::Log', 26); 27 28=head1 NAME 29 30Kernel::System::JSON - the JSON wrapper lib 31 32=head1 DESCRIPTION 33 34Functions for encoding perl data structures to JSON. 35 36=head1 PUBLIC INTERFACE 37 38=head2 new() 39 40create a JSON object. Do not use it directly, instead use: 41 42 my $JSONObject = $Kernel::OM->Get('Kernel::System::JSON'); 43 44=cut 45 46sub new { 47 my ( $Type, %Param ) = @_; 48 49 # allocate new hash for object 50 my $Self = {}; 51 bless( $Self, $Type ); 52 53 return $Self; 54} 55 56=head2 Encode() 57 58Encode a perl data structure to a JSON string. 59 60 my $JSONString = $JSONObject->Encode( 61 Data => $Data, 62 SortKeys => 1, # (optional) (0|1) default 0, to sort the keys of the json data 63 Pretty => 1, # (optional) (0|1) default 0, to pretty print 64 ); 65 66=cut 67 68sub Encode { 69 my ( $Self, %Param ) = @_; 70 71 # check for needed data 72 if ( !defined $Param{Data} ) { 73 $Kernel::OM->Get('Kernel::System::Log')->Log( 74 Priority => 'error', 75 Message => 'Need Data!', 76 ); 77 return; 78 } 79 80 # create json object 81 my $JSONObject = JSON->new(); 82 83 $JSONObject->allow_nonref(1); 84 85 # sort the keys of the JSON data 86 if ( $Param{SortKeys} ) { 87 $JSONObject->canonical(1); 88 } 89 90 # pretty print - can be useful for debugging purposes 91 if ( $Param{Pretty} ) { 92 $JSONObject->pretty(1); 93 } 94 95 # get JSON-encoded presentation of perl structure 96 my $JSONEncoded = $JSONObject->encode( $Param{Data} ) || '""'; 97 98 # Special handling for unicode line terminators (\u2028 and \u2029), 99 # they are allowed in JSON but not in JavaScript 100 # see: http://timelessrepo.com/json-isnt-a-javascript-subset 101 # 102 # Should be fixed in JSON module, but bug report is still open 103 # see: https://rt.cpan.org/Public/Bug/Display.html?id=75755 104 # 105 # Therefore must be encoded manually 106 $JSONEncoded =~ s/\x{2028}/\\u2028/xmsg; 107 $JSONEncoded =~ s/\x{2029}/\\u2029/xmsg; 108 109 return $JSONEncoded; 110} 111 112=head2 Decode() 113 114Decode a JSON string to a perl data structure. 115 116 my $PerlStructureScalar = $JSONObject->Decode( 117 Data => $JSONString, 118 ); 119 120=cut 121 122sub Decode { 123 my ( $Self, %Param ) = @_; 124 125 # check for needed data 126 return if !defined $Param{Data}; 127 128 # create json object 129 my $JSONObject = JSON->new(); 130 131 $JSONObject->allow_nonref(1); 132 133 # decode JSON encoded to perl structure 134 my $Scalar; 135 136 # use eval here, as JSON::XS->decode() dies when providing a malformed JSON string 137 if ( !eval { $Scalar = $JSONObject->decode( $Param{Data} ) } ) { 138 139 $Kernel::OM->Get('Kernel::System::Log')->Log( 140 Priority => 'error', 141 Message => 'Decoding the JSON string failed: ' . $@, 142 ); 143 144 return; 145 } 146 147 # sanitize leftover boolean objects 148 $Scalar = $Self->_BooleansProcess( 149 JSON => $Scalar, 150 ); 151 152 return $Scalar; 153} 154 155=head2 True() 156 157returns a constant that can be mapped to a boolean true value 158in JSON rather than a string with "true". 159 160 my $TrueConstant = $JSONObject->True(); 161 162 my $TrueJS = $JSONObject->Encode( 163 Data => $TrueConstant, 164 ); 165 166This will return the string 'true'. 167If you pass the perl string 'true' to JSON, it will return '"true"' 168as a JavaScript string instead. 169 170=cut 171 172sub True { 173 174 # Use constant instead of JSON::false() as this can cause nasty problems with JSON::XS on some platforms. 175 # (encountered object '1', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled) 176 return \1; 177} 178 179=head2 False() 180 181like C<True()>, but for a false boolean value. 182 183=cut 184 185sub False { 186 187 # Use constant instead of JSON::false() as this can cause nasty problems with JSON::XS on some platforms. 188 # (encountered object '0', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled) 189 return \0; 190} 191 192=begin Internal: 193 194=cut 195 196=head2 _BooleansProcess() 197 198decode boolean values leftover from JSON decoder to simple scalar values 199 200 my $ProcessedJSON = $JSONObject->_BooleansProcess( 201 JSON => $JSONData, 202 ); 203 204=cut 205 206sub _BooleansProcess { 207 my ( $Self, %Param ) = @_; 208 209 # convert scalars if needed 210 if ( JSON::is_bool( $Param{JSON} ) ) { 211 $Param{JSON} = ( $Param{JSON} ? 1 : 0 ); 212 } 213 214 # recurse into arrays 215 elsif ( ref $Param{JSON} eq 'ARRAY' ) { 216 217 for my $Value ( @{ $Param{JSON} } ) { 218 $Value = $Self->_BooleansProcess( 219 JSON => $Value, 220 ); 221 } 222 } 223 224 # recurse into hashes 225 elsif ( ref $Param{JSON} eq 'HASH' ) { 226 227 for my $Value ( values %{ $Param{JSON} } ) { 228 $Value = $Self->_BooleansProcess( 229 JSON => $Value, 230 ); 231 } 232 } 233 234 return $Param{JSON}; 235} 236 2371; 238 239=end Internal: 240 241=head1 TERMS AND CONDITIONS 242 243This software is part of the OTRS project (L<https://otrs.org/>). 244 245This software comes with ABSOLUTELY NO WARRANTY. For details, see 246the enclosed file COPYING for license information (GPL). If you 247did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>. 248 249=cut 250