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::Main; 10## nofilter(TidyAll::Plugin::OTRS::Perl::Dumper) 11## nofilter(TidyAll::Plugin::OTRS::Perl::Require) 12 13use strict; 14use warnings; 15 16use Digest::MD5 qw(md5_hex); 17use Data::Dumper; 18use File::stat; 19use Unicode::Normalize; 20use List::Util qw(); 21use Fcntl qw(:flock); 22use Encode; 23use Math::Random::Secure qw(); 24 25use Kernel::System::VariableCheck qw(IsStringWithData); 26 27our @ObjectDependencies = ( 28 'Kernel::System::Encode', 29 'Kernel::System::Log', 30 'Kernel::System::Storable', 31); 32 33=head1 NAME 34 35Kernel::System::Main - main object 36 37=head1 DESCRIPTION 38 39All main functions to load modules, die, and handle files. 40 41=head1 PUBLIC INTERFACE 42 43=head2 new() 44 45create new object. Do not use it directly, instead use: 46 47 my $MainObject = $Kernel::OM->Get('Kernel::System::Main'); 48 49=cut 50 51sub new { 52 my ( $Type, %Param ) = @_; 53 54 # allocate new hash for object 55 my $Self = {}; 56 bless( $Self, $Type ); 57 58 return $Self; 59} 60 61=head2 Require() 62 63require/load a module 64 65 my $Loaded = $MainObject->Require( 66 'Kernel::System::Example', 67 Silent => 1, # optional, no log entry if module was not found 68 ); 69 70=cut 71 72sub Require { 73 my ( $Self, $Module, %Param ) = @_; 74 75 if ( !$Module ) { 76 $Kernel::OM->Get('Kernel::System::Log')->Log( 77 Priority => 'error', 78 Message => 'Need module!', 79 ); 80 return; 81 } 82 83 eval { 84 my $FileName = $Module =~ s{::}{/}smxgr; 85 require $FileName . '.pm'; 86 }; 87 88 # Handle errors. 89 if ($@) { 90 91 if ( !$Param{Silent} ) { 92 my $Message = $@; 93 $Kernel::OM->Get('Kernel::System::Log')->Log( 94 Caller => 1, 95 Priority => 'error', 96 Message => $Message, 97 ); 98 } 99 100 return; 101 } 102 103 return 1; 104} 105 106=head2 RequireBaseClass() 107 108require/load a module and add it as a base class to the 109calling package, if not already present (this check is needed 110for persistent environments). 111 112 my $Loaded = $MainObject->RequireBaseClass( 113 'Kernel::System::Example', 114 ); 115 116=cut 117 118sub RequireBaseClass { 119 my ( $Self, $Module ) = @_; 120 121 # Load the module, if not already loaded. 122 return if !$Self->Require($Module); 123 124 no strict 'refs'; ## no critic 125 my $CallingClass = caller(0); 126 127 # Check if the base class was already loaded. 128 # This can happen in persistent environments as mod_perl (see bug#9686). 129 if ( List::Util::first { $_ eq $Module } @{"${CallingClass}::ISA"} ) { 130 return 1; # nothing to do now 131 } 132 133 push @{"${CallingClass}::ISA"}, $Module; 134 135 return 1; 136} 137 138=head2 Die() 139 140to die 141 142 $MainObject->Die('some message to die'); 143 144=cut 145 146sub Die { 147 my ( $Self, $Message ) = @_; 148 149 $Message = $Message || 'Died!'; 150 151 # log message 152 $Kernel::OM->Get('Kernel::System::Log')->Log( 153 Caller => 1, 154 Priority => 'error', 155 Message => $Message, 156 ); 157 158 exit; 159} 160 161=head2 FilenameCleanUp() 162 163to clean up filenames which can be used in any case (also quoting is done) 164 165 my $Filename = $MainObject->FilenameCleanUp( 166 Filename => 'me_to/alal.xml', 167 Type => 'Local', # Local|Attachment|MD5 168 ); 169 170 my $Filename = $MainObject->FilenameCleanUp( 171 Filename => 'some:file.xml', 172 Type => 'MD5', # Local|Attachment|MD5 173 ); 174 175=cut 176 177sub FilenameCleanUp { 178 my ( $Self, %Param ) = @_; 179 180 if ( !IsStringWithData( $Param{Filename} ) ) { 181 $Kernel::OM->Get('Kernel::System::Log')->Log( 182 Priority => 'error', 183 Message => 'Need Filename!', 184 ); 185 return; 186 } 187 188 # escape if cleanup is not needed 189 if ( $Param{NoFilenameClean} ) { 190 return $Param{Filename}; 191 } 192 193 my $Type = lc( $Param{Type} || 'local' ); 194 195 if ( $Type eq 'md5' ) { 196 $Kernel::OM->Get('Kernel::System::Encode')->EncodeOutput( \$Param{Filename} ); 197 $Param{Filename} = md5_hex( $Param{Filename} ); 198 } 199 200 # replace invalid token for attachment file names 201 elsif ( $Type eq 'attachment' ) { 202 203 # trim whitespace 204 $Param{Filename} =~ s/^\s+|\r|\n|\s+$//g; 205 206 # strip leading dots 207 $Param{Filename} =~ s/^\.+//; 208 209 # only whitelisted characters allowed in filename for security 210 $Param{Filename} =~ s/[^\w\-+.#_]/_/g; 211 212 # Enclosed alphanumerics are kept on older Perl versions, make sure to replace them too. 213 $Param{Filename} =~ s/[\x{2460}-\x{24FF}]/_/g; 214 215 # replace utf8 and iso 216 $Param{Filename} =~ s/(\x{00C3}\x{00A4}|\x{00A4})/ae/g; 217 $Param{Filename} =~ s/(\x{00C3}\x{00B6}|\x{00B6})/oe/g; 218 $Param{Filename} =~ s/(\x{00C3}\x{00BC}|\x{00FC})/ue/g; 219 $Param{Filename} =~ s/(\x{00C3}\x{009F}|\x{00C4})/Ae/g; 220 $Param{Filename} =~ s/(\x{00C3}\x{0096}|\x{0096})/Oe/g; 221 $Param{Filename} =~ s/(\x{00C3}\x{009C}|\x{009C})/Ue/g; 222 $Param{Filename} =~ s/(\x{00C3}\x{009F}|\x{00DF})/ss/g; 223 $Param{Filename} =~ s/-+/-/g; 224 225 # separate filename and extension 226 my $FileName = $Param{Filename}; 227 my $FileExt = ''; 228 if ( $Param{Filename} =~ /(.*)\.+([^.]+)$/ ) { 229 $FileName = $1; 230 $FileExt = '.' . $2; 231 } 232 233 if ( length $FileName ) { 234 my $ModifiedName = $FileName . $FileExt; 235 236 while ( length encode( 'UTF-8', $ModifiedName ) > 220 ) { 237 238 # Remove character by character starting from the end of the filename string 239 # until we get acceptable 220 byte long filename size including extension. 240 if ( length $FileName > 1 ) { 241 chop $FileName; 242 } 243 244 # If we reached minimum filename length, remove characters from the end of the extension string. 245 else { 246 chop $FileExt; 247 } 248 249 $ModifiedName = $FileName . $FileExt; 250 } 251 $Param{Filename} = $ModifiedName; 252 } 253 } 254 else { 255 256 # trim whitespace 257 $Param{Filename} =~ s/^\s+|\r|\n|\s+$//g; 258 259 # strip leading dots 260 $Param{Filename} =~ s/^\.+//; 261 262 # only whitelisted characters allowed in filename for security 263 if ( !$Param{NoReplace} ) { 264 $Param{Filename} =~ s/[^\w\-+.#_]/_/g; 265 266 # Enclosed alphanumerics are kept on older Perl versions, make sure to replace them too. 267 $Param{Filename} =~ s/[\x{2460}-\x{24FF}]/_/g; 268 } 269 270 # separate filename and extension 271 my $FileName = $Param{Filename}; 272 my $FileExt = ''; 273 if ( $Param{Filename} =~ /(.*)\.+([^.]+)$/ ) { 274 $FileName = $1; 275 $FileExt = '.' . $2; 276 } 277 278 if ( length $FileName ) { 279 my $ModifiedName = $FileName . $FileExt; 280 281 while ( length encode( 'UTF-8', $ModifiedName ) > 220 ) { 282 283 # Remove character by character starting from the end of the filename string 284 # until we get acceptable 220 byte long filename size including extension. 285 if ( length $FileName > 1 ) { 286 chop $FileName; 287 } 288 289 # If we reached minimum filename length, remove characters from the end of the extension string. 290 else { 291 chop $FileExt; 292 } 293 294 $ModifiedName = $FileName . $FileExt; 295 } 296 297 $Param{Filename} = $ModifiedName; 298 } 299 } 300 301 return $Param{Filename}; 302} 303 304=head2 FileRead() 305 306to read files from file system 307 308 my $ContentSCALARRef = $MainObject->FileRead( 309 Directory => 'c:\some\location', 310 Filename => 'file2read.txt', 311 # or Location 312 Location => 'c:\some\location\file2read.txt', 313 ); 314 315 my $ContentARRAYRef = $MainObject->FileRead( 316 Directory => 'c:\some\location', 317 Filename => 'file2read.txt', 318 # or Location 319 Location => 'c:\some\location\file2read.txt', 320 321 Result => 'ARRAY', # optional - SCALAR|ARRAY 322 ); 323 324 my $ContentSCALARRef = $MainObject->FileRead( 325 Directory => 'c:\some\location', 326 Filename => 'file2read.txt', 327 # or Location 328 Location => 'c:\some\location\file2read.txt', 329 330 Mode => 'binmode', # optional - binmode|utf8 331 Type => 'Local', # optional - Local|Attachment|MD5 332 Result => 'SCALAR', # optional - SCALAR|ARRAY 333 DisableWarnings => 1, # optional 334 ); 335 336=cut 337 338sub FileRead { 339 my ( $Self, %Param ) = @_; 340 341 my $FH; 342 if ( $Param{Filename} && $Param{Directory} ) { 343 344 # filename clean up 345 $Param{Filename} = $Self->FilenameCleanUp( 346 Filename => $Param{Filename}, 347 Type => $Param{Type} || 'Local', # Local|Attachment|MD5 348 ); 349 $Param{Location} = "$Param{Directory}/$Param{Filename}"; 350 } 351 elsif ( $Param{Location} ) { 352 353 # filename clean up 354 $Param{Location} =~ s{//}{/}xmsg; 355 } 356 else { 357 $Kernel::OM->Get('Kernel::System::Log')->Log( 358 Priority => 'error', 359 Message => 'Need Filename and Directory or Location!', 360 ); 361 362 } 363 364 # set open mode 365 my $Mode = '<'; 366 if ( $Param{Mode} && $Param{Mode} =~ m{ \A utf-?8 \z }xmsi ) { 367 $Mode = '<:utf8'; 368 } 369 370 # return if file can not open 371 if ( !open $FH, $Mode, $Param{Location} ) { ## no critic 372 my $Error = $!; 373 374 if ( !$Param{DisableWarnings} ) { 375 376 # Check if file exists only if system was not able to open it (to get better error message). 377 if ( !-e $Param{Location} ) { 378 $Kernel::OM->Get('Kernel::System::Log')->Log( 379 Priority => 'error', 380 Message => "File '$Param{Location}' doesn't exist!", 381 ); 382 } 383 else { 384 $Kernel::OM->Get('Kernel::System::Log')->Log( 385 Priority => 'error', 386 Message => "Can't open '$Param{Location}': $Error", 387 ); 388 } 389 } 390 return; 391 } 392 393 # lock file (Shared Lock) 394 if ( !flock $FH, LOCK_SH ) { 395 if ( !$Param{DisableWarnings} ) { 396 $Kernel::OM->Get('Kernel::System::Log')->Log( 397 Priority => 'error', 398 Message => "Can't lock '$Param{Location}': $!", 399 ); 400 } 401 } 402 403 # enable binmode 404 if ( !$Param{Mode} || $Param{Mode} =~ m{ \A binmode }xmsi ) { 405 binmode $FH; 406 } 407 408 # read file as array 409 if ( $Param{Result} && $Param{Result} eq 'ARRAY' ) { 410 411 # read file content at once 412 my @Array = <$FH>; 413 close $FH; 414 415 return \@Array; 416 } 417 418 # read file as string 419 my $String = do { local $/; <$FH> }; 420 close $FH; 421 422 return \$String; 423} 424 425=head2 FileWrite() 426 427to write data to file system 428 429 my $FileLocation = $MainObject->FileWrite( 430 Directory => 'c:\some\location', 431 Filename => 'file2write.txt', 432 # or Location 433 Location => 'c:\some\location\file2write.txt', 434 435 Content => \$Content, 436 ); 437 438 my $FileLocation = $MainObject->FileWrite( 439 Directory => 'c:\some\location', 440 Filename => 'file2write.txt', 441 # or Location 442 Location => 'c:\some\location\file2write.txt', 443 444 Content => \$Content, 445 Mode => 'binmode', # binmode|utf8 446 Type => 'Local', # optional - Local|Attachment|MD5 447 Permission => '644', # optional - unix file permissions 448 ); 449 450Platform note: MacOS (HFS+) stores filenames as Unicode C<NFD> internally, 451and DirectoryRead() will also report them as C<NFD>. 452 453=cut 454 455sub FileWrite { 456 my ( $Self, %Param ) = @_; 457 458 if ( $Param{Filename} && $Param{Directory} ) { 459 460 # filename clean up 461 $Param{Filename} = $Self->FilenameCleanUp( 462 Filename => $Param{Filename}, 463 Type => $Param{Type} || 'Local', # Local|Attachment|MD5 464 NoFilenameClean => $Param{NoFilenameClean}, 465 NoReplace => $Param{NoReplace}, 466 ); 467 $Param{Location} = "$Param{Directory}/$Param{Filename}"; 468 } 469 elsif ( $Param{Location} ) { 470 471 # filename clean up 472 $Param{Location} =~ s/\/\//\//g; 473 } 474 else { 475 $Kernel::OM->Get('Kernel::System::Log')->Log( 476 Priority => 'error', 477 Message => 'Need Filename and Directory or Location!', 478 ); 479 } 480 481 # set open mode (if file exists, lock it on open, done by '+<') 482 my $Exists; 483 if ( -f $Param{Location} ) { 484 $Exists = 1; 485 } 486 my $Mode = '>'; 487 if ($Exists) { 488 $Mode = '+<'; 489 } 490 if ( $Param{Mode} && $Param{Mode} =~ /^(utf8|utf\-8)/i ) { 491 $Mode = '>:utf8'; 492 if ($Exists) { 493 $Mode = '+<:utf8'; 494 } 495 } 496 497 # return if file can not open 498 my $FH; 499 if ( !open $FH, $Mode, $Param{Location} ) { ## no critic 500 $Kernel::OM->Get('Kernel::System::Log')->Log( 501 Priority => 'error', 502 Message => "Can't write '$Param{Location}': $!", 503 ); 504 return; 505 } 506 507 # lock file (Exclusive Lock) 508 if ( !flock $FH, LOCK_EX ) { 509 $Kernel::OM->Get('Kernel::System::Log')->Log( 510 Priority => 'error', 511 Message => "Can't lock '$Param{Location}': $!", 512 ); 513 } 514 515 # empty file first (needed if file is open by '+<') 516 truncate $FH, 0; 517 518 # enable binmode 519 if ( !$Param{Mode} || lc $Param{Mode} eq 'binmode' ) { 520 521 # make sure, that no utf8 stamp exists (otherway perl will do auto convert to iso) 522 $Kernel::OM->Get('Kernel::System::Encode')->EncodeOutput( $Param{Content} ); 523 524 # set file handle to binmode 525 binmode $FH; 526 } 527 528 # write file if content is not undef 529 if ( defined ${ $Param{Content} } ) { 530 print $FH ${ $Param{Content} }; 531 } 532 533 # write empty file if content is undef 534 else { 535 print $FH ''; 536 } 537 538 # close the filehandle 539 close $FH; 540 541 # set permission 542 if ( $Param{Permission} ) { 543 if ( length $Param{Permission} == 3 ) { 544 $Param{Permission} = "0$Param{Permission}"; 545 } 546 chmod( oct( $Param{Permission} ), $Param{Location} ); 547 } 548 549 return $Param{Filename} if $Param{Filename}; 550 return $Param{Location}; 551} 552 553=head2 FileDelete() 554 555to delete a file from file system 556 557 my $Success = $MainObject->FileDelete( 558 Directory => 'c:\some\location', 559 Filename => 'me_to/alal.xml', 560 # or Location 561 Location => 'c:\some\location\me_to\alal.xml' 562 563 Type => 'Local', # optional - Local|Attachment|MD5 564 DisableWarnings => 1, # optional 565 ); 566 567=cut 568 569sub FileDelete { 570 my ( $Self, %Param ) = @_; 571 572 if ( $Param{Filename} && $Param{Directory} ) { 573 574 # filename clean up 575 $Param{Filename} = $Self->FilenameCleanUp( 576 Filename => $Param{Filename}, 577 Type => $Param{Type} || 'Local', # Local|Attachment|MD5 578 NoReplace => $Param{NoReplace}, 579 ); 580 $Param{Location} = "$Param{Directory}/$Param{Filename}"; 581 } 582 elsif ( $Param{Location} ) { 583 584 # filename clean up 585 $Param{Location} =~ s/\/\//\//g; 586 } 587 else { 588 $Kernel::OM->Get('Kernel::System::Log')->Log( 589 Priority => 'error', 590 Message => 'Need Filename and Directory or Location!', 591 ); 592 } 593 594 # try to delete file 595 if ( !unlink( $Param{Location} ) ) { 596 my $Error = $!; 597 598 if ( !$Param{DisableWarnings} ) { 599 600 # Check if file exists only in case that delete failed. 601 if ( !-e $Param{Location} ) { 602 $Kernel::OM->Get('Kernel::System::Log')->Log( 603 Priority => 'error', 604 Message => "File '$Param{Location}' doesn't exist!", 605 ); 606 } 607 else { 608 $Kernel::OM->Get('Kernel::System::Log')->Log( 609 Priority => 'error', 610 Message => "Can't delete '$Param{Location}': $Error", 611 ); 612 } 613 } 614 615 return; 616 } 617 618 return 1; 619} 620 621=head2 FileGetMTime() 622 623get timestamp of file change time 624 625 my $FileMTime = $MainObject->FileGetMTime( 626 Directory => 'c:\some\location', 627 Filename => 'me_to/alal.xml', 628 # or Location 629 Location => 'c:\some\location\me_to\alal.xml' 630 ); 631 632=cut 633 634sub FileGetMTime { 635 my ( $Self, %Param ) = @_; 636 637 my $FH; 638 if ( $Param{Filename} && $Param{Directory} ) { 639 640 # filename clean up 641 $Param{Filename} = $Self->FilenameCleanUp( 642 Filename => $Param{Filename}, 643 Type => $Param{Type} || 'Local', # Local|Attachment|MD5 644 ); 645 $Param{Location} = "$Param{Directory}/$Param{Filename}"; 646 } 647 elsif ( $Param{Location} ) { 648 649 # filename clean up 650 $Param{Location} =~ s{//}{/}xmsg; 651 } 652 else { 653 $Kernel::OM->Get('Kernel::System::Log')->Log( 654 Priority => 'error', 655 Message => 'Need Filename and Directory or Location!', 656 ); 657 658 } 659 660 # get file metadata 661 my $Stat = stat( $Param{Location} ); 662 663 if ( !$Stat ) { 664 my $Error = $!; 665 666 if ( !$Param{DisableWarnings} ) { 667 668 # Check if file exists only if system was not able to open it (to get better error message). 669 if ( !-e $Param{Location} ) { 670 $Kernel::OM->Get('Kernel::System::Log')->Log( 671 Priority => 'error', 672 Message => "File '$Param{Location}' doesn't exist!" 673 ); 674 } 675 else { 676 $Kernel::OM->Get('Kernel::System::Log')->Log( 677 Priority => 'error', 678 Message => "Cannot stat file '$Param{Location}': $Error", 679 ); 680 } 681 } 682 return; 683 } 684 685 return $Stat->mtime(); 686} 687 688=head2 MD5sum() 689 690get an C<MD5> sum of a file or a string 691 692 my $MD5Sum = $MainObject->MD5sum( 693 Filename => '/path/to/me_to_alal.xml', 694 ); 695 696 my $MD5Sum = $MainObject->MD5sum( 697 String => \$SomeString, 698 ); 699 700 # note: needs more memory! 701 my $MD5Sum = $MainObject->MD5sum( 702 String => $SomeString, 703 ); 704 705=cut 706 707sub MD5sum { 708 my ( $Self, %Param ) = @_; 709 710 if ( !$Param{Filename} && !defined( $Param{String} ) ) { 711 $Kernel::OM->Get('Kernel::System::Log')->Log( 712 Priority => 'error', 713 Message => 'Need Filename or String!', 714 ); 715 return; 716 } 717 718 # md5sum file 719 if ( $Param{Filename} ) { 720 721 # open file 722 my $FH; 723 if ( !open $FH, '<', $Param{Filename} ) { ## no critic 724 my $Error = $!; 725 726 # Check if file exists only if system was not able to open it (to get better error message). 727 if ( !-e $Param{Filename} ) { 728 $Kernel::OM->Get('Kernel::System::Log')->Log( 729 Priority => 'error', 730 Message => "File '$Param{Filename}' doesn't exist!", 731 ); 732 } 733 else { 734 $Kernel::OM->Get('Kernel::System::Log')->Log( 735 Priority => 'error', 736 Message => "Can't read '$Param{Filename}': $Error", 737 ); 738 } 739 return; 740 } 741 742 binmode $FH; 743 my $MD5sum = Digest::MD5->new()->addfile($FH)->hexdigest(); 744 close $FH; 745 746 return $MD5sum; 747 } 748 749 # get encode object 750 my $EncodeObject = $Kernel::OM->Get('Kernel::System::Encode'); 751 752 # md5sum string 753 if ( !ref $Param{String} ) { 754 $EncodeObject->EncodeOutput( \$Param{String} ); 755 return md5_hex( $Param{String} ); 756 } 757 758 # md5sum scalar reference 759 if ( ref $Param{String} eq 'SCALAR' ) { 760 $EncodeObject->EncodeOutput( $Param{String} ); 761 return md5_hex( ${ $Param{String} } ); 762 } 763 764 $Kernel::OM->Get('Kernel::System::Log')->Log( 765 Priority => 'error', 766 Message => "Need a SCALAR reference like 'String => \$Content' in String param.", 767 ); 768 769 return; 770} 771 772=head2 Dump() 773 774dump variable to an string 775 776 my $Dump = $MainObject->Dump( 777 $SomeVariable, 778 ); 779 780 my $Dump = $MainObject->Dump( 781 { 782 Key1 => $SomeVariable, 783 }, 784 ); 785 786 dump only in ascii characters (> 128 will be marked as \x{..}) 787 788 my $Dump = $MainObject->Dump( 789 $SomeVariable, 790 'ascii', # ascii|binary - default is binary 791 ); 792 793=cut 794 795sub Dump { 796 my ( $Self, $Data, $Type ) = @_; 797 798 # check needed data 799 if ( !defined $Data ) { 800 $Kernel::OM->Get('Kernel::System::Log')->Log( 801 Priority => 'error', 802 Message => "Need \$String in Dump()!" 803 ); 804 return; 805 } 806 807 # check type 808 if ( !$Type ) { 809 $Type = 'binary'; 810 } 811 if ( $Type ne 'ascii' && $Type ne 'binary' ) { 812 $Kernel::OM->Get('Kernel::System::Log')->Log( 813 Priority => 'error', 814 Message => "Invalid Type '$Type'!" 815 ); 816 return; 817 } 818 819 # mild pretty print 820 $Data::Dumper::Indent = 1; 821 822 # sort hash keys 823 $Data::Dumper::Sortkeys = 1; 824 825 # This Dump() is using Data::Dumper with a utf8 workarounds to handle 826 # the bug [rt.cpan.org #28607] Data::Dumper::Dumper is dumping utf8 827 # strings as latin1/8bit instead of utf8. Use Storable module used for 828 # workaround. 829 # -> http://rt.cpan.org/Ticket/Display.html?id=28607 830 if ( $Type eq 'binary' ) { 831 832 # Clone the data because we need to disable the utf8 flag in all 833 # reference variables and do not to want to do this in the orig. 834 # variables because they will still used in the system. 835 my $DataNew = $Kernel::OM->Get('Kernel::System::Storable')->Clone( Data => \$Data ); 836 837 # Disable utf8 flag. 838 $Self->_Dump($DataNew); 839 840 # Dump it as binary strings. 841 my $String = Data::Dumper::Dumper( ${$DataNew} ); ## no critic 842 843 # Enable utf8 flag. 844 Encode::_utf8_on($String); 845 846 return $String; 847 } 848 849 # fallback if Storable can not be loaded 850 return Data::Dumper::Dumper($Data); ## no critic 851 852} 853 854=head2 DirectoryRead() 855 856reads a directory and returns an array with results. 857 858 my @FilesInDirectory = $MainObject->DirectoryRead( 859 Directory => '/tmp', 860 Filter => 'Filenam*', 861 ); 862 863 my @FilesInDirectory = $MainObject->DirectoryRead( 864 Directory => $Path, 865 Filter => '*', 866 ); 867 868read all files in subdirectories as well (recursive): 869 870 my @FilesInDirectory = $MainObject->DirectoryRead( 871 Directory => $Path, 872 Filter => '*', 873 Recursive => 1, 874 ); 875 876You can pass several additional filters at once: 877 878 my @FilesInDirectory = $MainObject->DirectoryRead( 879 Directory => '/tmp', 880 Filter => \@MyFilters, 881 ); 882 883The result strings are absolute paths, and they are converted to utf8. 884 885Use the 'Silent' parameter to suppress log messages when a directory 886does not have to exist: 887 888 my @FilesInDirectory = $MainObject->DirectoryRead( 889 Directory => '/special/optional/directory/', 890 Filter => '*', 891 Silent => 1, # will not log errors if the directory does not exist 892 ); 893 894Platform note: MacOS (HFS+) stores filenames as Unicode C<NFD> internally, 895and DirectoryRead() will also report them as C<NFD>. 896 897=cut 898 899sub DirectoryRead { 900 my ( $Self, %Param ) = @_; 901 902 # check needed params 903 for my $Needed (qw(Directory Filter)) { 904 if ( !$Param{$Needed} ) { 905 $Kernel::OM->Get('Kernel::System::Log')->Log( 906 Message => "Needed $Needed: $!", 907 Priority => 'error', 908 ); 909 return; 910 } 911 } 912 913 # if directory doesn't exists stop 914 if ( !-d $Param{Directory} && !$Param{Silent} ) { 915 $Kernel::OM->Get('Kernel::System::Log')->Log( 916 Message => "Directory doesn't exist: $Param{Directory}: $!", 917 Priority => 'error', 918 ); 919 return; 920 } 921 922 # check Filter param 923 if ( ref $Param{Filter} ne '' && ref $Param{Filter} ne 'ARRAY' ) { 924 $Kernel::OM->Get('Kernel::System::Log')->Log( 925 Message => 'Filter param need to be scalar or array ref!', 926 Priority => 'error', 927 ); 928 return; 929 } 930 931 # prepare non array filter 932 if ( ref $Param{Filter} ne 'ARRAY' ) { 933 $Param{Filter} = [ $Param{Filter} ]; 934 } 935 936 # executes glob for every filter 937 my @GlobResults; 938 my %Seen; 939 940 for my $Filter ( @{ $Param{Filter} } ) { 941 my @Glob = glob "$Param{Directory}/$Filter"; 942 943 # look for repeated values 944 NAME: 945 for my $GlobName (@Glob) { 946 947 next NAME if !-e $GlobName; 948 if ( !$Seen{$GlobName} ) { 949 push @GlobResults, $GlobName; 950 $Seen{$GlobName} = 1; 951 } 952 } 953 } 954 955 if ( $Param{Recursive} ) { 956 957 # loop protection to prevent symlinks causing lockups 958 $Param{LoopProtection}++; 959 return if $Param{LoopProtection} > 100; 960 961 # check all files in current directory 962 my @Directories = glob "$Param{Directory}/*"; 963 964 DIRECTORY: 965 for my $Directory (@Directories) { 966 967 # return if file is not a directory 968 next DIRECTORY if !-d $Directory; 969 970 # repeat same glob for directory 971 my @SubResult = $Self->DirectoryRead( 972 %Param, 973 Directory => $Directory, 974 ); 975 976 # add result to hash 977 for my $Result (@SubResult) { 978 if ( !$Seen{$Result} ) { 979 push @GlobResults, $Result; 980 $Seen{$Result} = 1; 981 } 982 } 983 } 984 } 985 986 # if no results 987 return if !@GlobResults; 988 989 # get encode object 990 my $EncodeObject = $Kernel::OM->Get('Kernel::System::Encode'); 991 992 # compose normalize every name in the file list 993 my @Results; 994 for my $Filename (@GlobResults) { 995 996 # First convert filename to utf-8, with additional Check parameter 997 # to replace possible malformed characters and prevent further errors. 998 $Filename = $EncodeObject->Convert2CharsetInternal( 999 Text => $Filename, 1000 From => 'utf-8', 1001 Check => 1, 1002 ); 1003 1004 push @Results, $Filename; 1005 } 1006 1007 # always sort the result 1008 @Results = sort @Results; 1009 1010 return @Results; 1011} 1012 1013=head2 GenerateRandomString() 1014 1015generate a random string of defined length, and of a defined alphabet. 1016defaults to a length of 16 and alphanumerics ( 0..9, A-Z and a-z). 1017 1018 my $String = $MainObject->GenerateRandomString(); 1019 1020returns 1021 1022 $String = 'mHLOx7psWjMe5Pj7'; 1023 1024with specific length: 1025 1026 my $String = $MainObject->GenerateRandomString( 1027 Length => 32, 1028 ); 1029 1030returns 1031 1032 $String = 'azzHab72wIlAXDrxHexsI5aENsESxAO7'; 1033 1034with specific length and alphabet: 1035 1036 my $String = $MainObject->GenerateRandomString( 1037 Length => 32, 1038 Dictionary => [ 0..9, 'a'..'f' ], # hexadecimal 1039 ); 1040 1041returns 1042 1043 $String = '9fec63d37078fe72f5798d2084fea8ad'; 1044 1045 1046=cut 1047 1048sub GenerateRandomString { 1049 my ( $Self, %Param ) = @_; 1050 1051 my $Length = $Param{Length} || 16; 1052 1053 # The standard list of characters in the dictionary. Don't use special chars here. 1054 my @DictionaryChars = ( 0 .. 9, 'A' .. 'Z', 'a' .. 'z' ); 1055 1056 # override dictionary with custom list if given 1057 if ( $Param{Dictionary} && ref $Param{Dictionary} eq 'ARRAY' ) { 1058 @DictionaryChars = @{ $Param{Dictionary} }; 1059 } 1060 1061 my $DictionaryLength = scalar @DictionaryChars; 1062 1063 # generate the string 1064 my $String; 1065 1066 for ( 1 .. $Length ) { 1067 1068 my $Key = int Math::Random::Secure::rand $DictionaryLength; 1069 1070 $String .= $DictionaryChars[$Key]; 1071 } 1072 1073 return $String; 1074} 1075 1076=begin Internal: 1077 1078=cut 1079 1080sub _Dump { 1081 my ( $Self, $Data ) = @_; 1082 1083 # data is not a reference 1084 if ( !ref ${$Data} ) { 1085 Encode::_utf8_off( ${$Data} ); 1086 1087 return; 1088 } 1089 1090 # data is a scalar reference 1091 if ( ref ${$Data} eq 'SCALAR' ) { 1092 1093 # start recursion 1094 $Self->_Dump( ${$Data} ); 1095 1096 return; 1097 } 1098 1099 # data is a hash reference 1100 if ( ref ${$Data} eq 'HASH' ) { 1101 KEY: 1102 for my $Key ( sort keys %{ ${$Data} } ) { 1103 next KEY if !defined ${$Data}->{$Key}; 1104 1105 # start recursion 1106 $Self->_Dump( \${$Data}->{$Key} ); 1107 1108 my $KeyNew = $Key; 1109 1110 $Self->_Dump( \$KeyNew ); 1111 1112 if ( $Key ne $KeyNew ) { 1113 1114 ${$Data}->{$KeyNew} = ${$Data}->{$Key}; 1115 delete ${$Data}->{$Key}; 1116 } 1117 } 1118 1119 return; 1120 } 1121 1122 # data is a array reference 1123 if ( ref ${$Data} eq 'ARRAY' ) { 1124 KEY: 1125 for my $Key ( 0 .. $#{ ${$Data} } ) { 1126 next KEY if !defined ${$Data}->[$Key]; 1127 1128 # start recursion 1129 $Self->_Dump( \${$Data}->[$Key] ); 1130 } 1131 1132 return; 1133 } 1134 1135 # data is a ref reference 1136 if ( ref ${$Data} eq 'REF' ) { 1137 1138 # start recursion 1139 $Self->_Dump( ${$Data} ); 1140 1141 return; 1142 } 1143 1144 # data is a JSON::PP::Boolean 1145 if ( ref ${$Data} eq 'JSON::PP::Boolean' ) { 1146 1147 # start recursion 1148 $Self->_Dump( ${$Data} ); 1149 1150 return; 1151 } 1152 1153 $Kernel::OM->Get('Kernel::System::Log')->Log( 1154 Priority => 'error', 1155 Message => "Unknown ref '" . ref( ${$Data} ) . "'!", 1156 ); 1157 1158 return; 1159} 1160 11611; 1162 1163=end Internal: 1164 1165=head1 TERMS AND CONDITIONS 1166 1167This software is part of the OTRS project (L<https://otrs.org/>). 1168 1169This software comes with ABSOLUTELY NO WARRANTY. For details, see 1170the enclosed file COPYING for license information (GPL). If you 1171did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>. 1172 1173=cut 1174