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::SysConfig::ValueType::PerlModule;
10## nofilter(TidyAll::Plugin::OTRS::Perl::LayoutObject)
11
12use strict;
13use warnings;
14
15use Kernel::System::VariableCheck qw(:all);
16
17use parent qw(Kernel::System::SysConfig::BaseValueType);
18
19our @ObjectDependencies = (
20    'Kernel::Config',
21    'Kernel::Language',
22    'Kernel::Output::HTML::Layout',
23    'Kernel::System::Log',
24    'Kernel::System::Main',
25);
26
27=head1 NAME
28
29Kernel::System::SysConfig::ValueType::PerlModule - System configuration perl module value type backed.
30
31=head1 PUBLIC INTERFACE
32
33=head2 new()
34
35Create an object. Do not use it directly, instead use:
36
37    use Kernel::System::ObjectManager;
38    local $Kernel::OM = Kernel::System::ObjectManager->new();
39    my $ValueTypeObject = $Kernel::OM->Get('Kernel::System::SysConfig::ValueType::PerlModule');
40
41=cut
42
43sub new {
44    my ( $Type, %Param ) = @_;
45
46    # Allocate new hash for object.
47    my $Self = {};
48    bless( $Self, $Type );
49
50    return $Self;
51}
52
53=head2 SettingEffectiveValueCheck()
54
55Check if provided EffectiveValue matches structure defined in XMLContentParsed.
56
57    my %Result = $ValueTypeObject->SettingEffectiveValueCheck(
58        XMLContentParsed => {
59            Value => [
60                {
61                    'Item' => [
62                        {
63                            'Content'     => 'Kernel::System::Log::SysLog',
64                            'ValueFilter' => 'Kernel/System/Log/*.pm',
65                            'ValueType'   => 'PerlModule',
66                        },
67                    ],
68                },
69            ],
70        },
71        EffectiveValue => 'Kernel::System::Log::SysLog',
72    );
73
74Result:
75    %Result = (
76        EffectiveValue => 'Kernel::System::Log::SysLog',        # Note for PerlModule ValueTypes EffectiveValue is not changed.
77        Success => 1,
78        Error   => undef,
79    );
80
81=cut
82
83sub SettingEffectiveValueCheck {
84    my ( $Self, %Param ) = @_;
85
86    for my $Needed (qw(XMLContentParsed)) {
87        if ( !$Param{$Needed} ) {
88            $Kernel::OM->Get('Kernel::System::Log')->Log(
89                Priority => 'error',
90                Message  => "Need $Needed!"
91            );
92
93            return;
94        }
95    }
96
97    my %Result = (
98        Success => 0,
99    );
100
101    # Data should be scalar.
102    if ( ref $Param{EffectiveValue} ) {
103        $Result{Error} = 'EffectiveValue for PerlModule must be a scalar!';
104        return %Result;
105    }
106
107    # Check if EffectiveValue matches ValueFilter.
108    my $MainObject = $Kernel::OM->Get('Kernel::System::Main');
109    my $Home       = $Kernel::OM->Get('Kernel::Config')->Get('Home');
110
111    my $ValueFilter = $Param{XMLContentParsed}->{Value}->[0]->{Item}->[0]->{ValueFilter};
112
113    my @ValidValue = $MainObject->DirectoryRead(
114        Directory => $Home,
115        Filter    => $ValueFilter,
116    );
117
118    for my $Value (@ValidValue) {
119
120        # Convert to the relative path.
121        $Value =~ s{^$Home/*(.*?)$}{$1}gsmx;
122
123        # Replace '/' with '::'.
124        $Value =~ s{/}{::}gsmx;
125
126        # Remove extension.
127        $Value =~ s{\..*$}{}gsmx;
128    }
129
130    if ( !grep { $_ eq $Param{EffectiveValue} } @ValidValue ) {
131        $Result{Error} = "$Param{EffectiveValue} doesn't satisfy ValueFilter($ValueFilter)!";
132        return %Result;
133    }
134
135    my $Loaded = $MainObject->Require(
136        $Param{EffectiveValue},
137        Silent => 1,
138    );
139
140    if ( !$Loaded ) {
141        $Result{Error} = "$Param{EffectiveValue} not exists!";
142        return %Result;
143    }
144
145    $Result{Success}        = 1;
146    $Result{EffectiveValue} = $Param{EffectiveValue};
147
148    return %Result;
149}
150
151=head2 SettingRender()
152
153Extracts the effective value from a XML parsed setting.
154
155    my $SettingHTML = $ValueTypeObject->SettingRender(
156        Name           => 'SettingName',
157        EffectiveValue => '3 medium',       # (optional)
158        DefaultValue   => '3 medium',       # (optional)
159        Class          => 'My class'        # (optional)
160        RW             => 1,                # (optional) Allow editing. Default 0.
161        Item           => [                 # (optional) XML parsed item
162            {
163                'ValueType' => 'PerlModule',
164                'ValueFilter' => '"Kernel/System/Log/*.pm',
165                'Content' => 'Kernel::System::Log::SysLog',
166            },
167        ],
168        IsArray => 1,                       # (optional) Item is part of the array
169        IsHash  => 1,                       # (optional) Item is part of the hash
170        SkipEffectiveValueCheck => 1,       # (optional) If enabled, system will not perform effective value check.
171                                            #            Default: 1.
172    );
173
174Returns:
175
176    $SettingHTML = '<div class "Field"...</div>';
177
178=cut
179
180sub SettingRender {
181    my ( $Self, %Param ) = @_;
182
183    if ( !defined $Param{Name} ) {
184        $Kernel::OM->Get('Kernel::System::Log')->Log(
185            Priority => 'error',
186            Message  => "Need Name",
187        );
188        return;
189    }
190
191    $Param{Class}        //= '';
192    $Param{DefaultValue} //= '';
193    $Param{IDSuffix}     //= '';
194
195    my $LanguageObject = $Kernel::OM->Get('Kernel::Language');
196
197    my $Value = $Param{XMLContentParsed}->{Value};
198
199    my $EffectiveValue = $Param{EffectiveValue};
200    if (
201        !defined $EffectiveValue
202        && $Param{Item}
203        && $Param{Item}->[0]->{Content}
204        )
205    {
206        $EffectiveValue = $Param{Item}->[0]->{Content};
207    }
208
209    my $ConfigObject = $Kernel::OM->Get('Kernel::Config');
210
211    my $Home = $ConfigObject->Get('Home');
212
213    my $Filter;
214
215    if (
216        $Param{Item}
217        && $Param{Item}->[0]->{ValueFilter}
218        )
219    {
220        $Filter = $Param{Item}->[0]->{ValueFilter};
221    }
222    elsif ( $Value->[0]->{Item} ) {
223        $Filter = $Value->[0]->{Item}->[0]->{ValueFilter};
224    }
225    elsif ( $Value->[0]->{Array} ) {
226        $Filter = $Value->[0]->{Array}->[0]->{DefaultItem}->[0]->{ValueFilter};
227    }
228    elsif ( $Value->[0]->{Hash} ) {
229        if (
230            $Value->[0]->{Hash}->[0]->{DefaultItem}
231            && $Value->[0]->{Hash}->[0]->{DefaultItem}->[0]->{ValueFilter}
232            )
233        {
234
235            # take ValueFilter from DefaultItem
236            $Filter = $Value->[0]->{Hash}->[0]->{DefaultItem}->[0]->{ValueFilter};
237        }
238        else {
239            # check if there is definition for certain key
240            ITEM:
241            for my $Item ( @{ $Value->[0]->{Hash}->[0]->{Item} } ) {
242                if ( $Item->{Key} eq $Param{Key} ) {
243                    $Filter = $Item->{ValueFilter} || '';
244                    last ITEM;
245                }
246            }
247        }
248    }
249
250    my @PerlModules = $Kernel::OM->Get('Kernel::System::Main')->DirectoryRead(
251        Directory => $Home,
252        Filter    => $Filter,
253    );
254
255    for my $Module (@PerlModules) {
256
257        # Convert to the relative path.
258        $Module =~ s{^$Home/*(.*?)$}{$1}gsmx;
259
260        # Replace '/' with '::'.
261        $Module =~ s{/}{::}gsmx;
262
263        # Remove extension.
264        $Module =~ s{\..*$}{}gsmx;
265    }
266
267    my $Name = $Param{Name};
268
269    # When displaying diff between current and old value, it can happen that value is missing
270    #    since it was renamed, or removed. In this case, we need to add this "old" value also.
271    if (
272        $EffectiveValue
273        && !grep { $_ eq $EffectiveValue } @PerlModules
274        )
275    {
276        push @PerlModules, $EffectiveValue;
277    }
278
279    my %EffectiveValueCheck = (
280        Success => 1,
281    );
282
283    if ( !$Param{SkipEffectiveValueCheck} ) {
284        %EffectiveValueCheck = $Self->SettingEffectiveValueCheck(
285            EffectiveValue   => $EffectiveValue,
286            XMLContentParsed => {
287                Value => [
288                    {
289                        Item => $Param{Item},
290                    },
291                ],
292            },
293        );
294    }
295
296    my $HTML = "<div class='SettingContent'>\n";
297    $HTML .= $Kernel::OM->Get('Kernel::Output::HTML::Layout')->BuildSelection(
298        Data          => \@PerlModules,
299        Name          => $Name,
300        ID            => $Param{Name} . $Param{IDSuffix},
301        Disabled      => $Param{RW} ? 0 : 1,
302        SelectedValue => $EffectiveValue,
303        Title         => $Param{Name},
304        OptionTitle   => 1,
305        Class         => "$Param{Class} Modernize",
306    );
307
308    if ( !$EffectiveValueCheck{Success} ) {
309        my $Message = $LanguageObject->Translate("Value is not correct! Please, consider updating this field.");
310
311        $HTML .= $Param{IsValid} ? "<div class='BadEffectiveValue'>\n" : "<div>\n";
312        $HTML .= "<p>* $Message</p>\n";
313        $HTML .= "</div>\n";
314    }
315
316    $HTML .= "</div>\n";
317
318    if ( !$Param{IsArray} && !$Param{IsHash} ) {
319        my $DefaultText = $LanguageObject->Translate('Default');
320
321        $HTML .= <<"EOF";
322                                <div class=\"WidgetMessage Bottom\">
323                                    $DefaultText: $Param{DefaultValue}
324                                </div>
325EOF
326    }
327
328    return $HTML;
329}
330
331=head2 AddItem()
332
333Generate HTML for new array/hash item.
334
335    my $HTML = $ValueTypeObject->AddItem(
336        Name           => 'SettingName',    (required) Name
337        DefaultItem    => {                 (required) DefaultItem hash
338            'ValueType' => 'PerlModule',
339            'Content' => 'Kernel::System::Log::SysLog',
340            'ValueFilter' => 'Kernel/System/Log/*.pm'
341        },
342        IDSuffix       => '_Array1',        (optional) IDSuffix is needed for arrays and hashes.
343    );
344
345Returns:
346
347    $HTML = '<select class="Modernize" id="SettingName" name="SettingName" title="SettingName">
348        ...
349        </select>';
350
351=cut
352
353sub AddItem {
354    my ( $Self, %Param ) = @_;
355
356    # Check needed stuff.
357    for my $Needed (qw(Name DefaultItem)) {
358        if ( !$Param{$Needed} ) {
359            $Kernel::OM->Get('Kernel::System::Log')->Log(
360                Priority => 'error',
361                Message  => "Need $Needed!",
362            );
363            return;
364        }
365    }
366
367    $Param{Class}    //= '';
368    $Param{IDSuffix} //= '';
369
370    my $Home = $Kernel::OM->Get('Kernel::Config')->Get('Home');
371
372    my @PerlModules = $Kernel::OM->Get('Kernel::System::Main')->DirectoryRead(
373        Directory => $Home,
374        Filter    => $Param{DefaultItem}->{ValueFilter},
375    );
376
377    for my $Module (@PerlModules) {
378
379        # Convert to the relative path.
380        $Module =~ s{^$Home/*(.*?)$}{$1}gsmx;
381
382        # Replace '/' with '::'.
383        $Module =~ s{/}{::}gsmx;
384
385        # Remove extension.
386        $Module =~ s{\..*$}{}gsmx;
387    }
388
389    my $Result = $Kernel::OM->Get('Kernel::Output::HTML::Layout')->BuildSelection(
390        Data          => \@PerlModules,
391        Name          => $Param{Name},
392        ID            => $Param{Name} . $Param{IDSuffix},
393        SelectedValue => $Param{DefaultItem}->{Content},
394        Title         => $Param{Name},
395        OptionTitle   => 1,
396        Class         => "$Param{Class} Modernize Entry",
397    );
398
399    return $Result;
400}
401
4021;
403
404=head1 TERMS AND CONDITIONS
405
406This software is part of the OTRS project (L<https://otrs.org/>).
407
408This software comes with ABSOLUTELY NO WARRANTY. For details, see
409the enclosed file COPYING for license information (GPL). If you
410did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>.
411
412=cut
413