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