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