Main Koha release repository https://koha-community.org
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

118 regels
4.2 KiB

  1. #!/usr/bin/perl
  2. # This file is part of Koha.
  3. #
  4. # Koha is free software; you can redistribute it and/or modify it
  5. # under the terms of the GNU General Public License as published by
  6. # the Free Software Foundation; either version 3 of the License, or
  7. # (at your option) any later version.
  8. #
  9. # Koha is distributed in the hope that it will be useful, but
  10. # WITHOUT ANY WARRANTY; without even the implied warranty of
  11. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. # GNU General Public License for more details.
  13. #
  14. # You should have received a copy of the GNU General Public License
  15. # along with Koha; if not, see <http://www.gnu.org/licenses>.
  16. #
  17. use strict;
  18. use ExtUtils::MakeMaker::Config;
  19. use Tie::File;
  20. my $basedir = (shift);
  21. my $DEBUG = exists $ENV{'DEBUG'} ? $ENV{'DEBUG'} : 0;
  22. $DEBUG = 1 if $basedir eq 'test';
  23. my $bindir = $Config{installbin};
  24. $bindir =~ s!\\!/!g; # make all directory separators uniform since Win32 does not care and *nix does...
  25. my $shebang = "#!$bindir\/perl";
  26. warn "Perl binary located in $bindir on this system.\n" if $DEBUG;
  27. warn "The shebang line for this sytems should be $shebang\n\n" if $DEBUG;
  28. die if $basedir eq 'test';
  29. =head1 NAME
  30. fix-perl-path.PL - A script to correct the shebang line to match the current platform
  31. =head1 SYNOPSIS
  32. =head2 BASIC USAGE
  33. perl fix-perl-path.PL /absolute/path/to/foo
  34. =head1 DESCRIPTION
  35. This script should be run from the base of the directory
  36. structure which contains the file(s) that need the
  37. shebang line corrected. It will recurse through all
  38. directories below the one called from and modify all
  39. .pl files.
  40. =head2 fixshebang
  41. This sub will recurse through a given directory and its subdirectories checking for the existence of a shebang
  42. line in .pl files and replacing it with the correct line for the current OS if needed. It should be called
  43. in a manner similar to 'fixshebang (foodir)' but may be supplied with any directory.
  44. =cut
  45. sub fixshebang{
  46. my $dir = shift;
  47. opendir my $dh, $dir or die $!;
  48. warn "Reading $dir contents.\n" if $DEBUG;
  49. while( my $file = readdir($dh) ) {
  50. # this may be used to exclude any desired files from the scan
  51. # if ( $file =~ /foo/ ) { next; }
  52. # handle files... other extensions could be substituted/added if needed
  53. if ( $file =~ /\.pl$/ ) {
  54. my @filearray;
  55. my $pathfile =$dir . '/' . $file;
  56. warn "Found a perl script named $pathfile\n" if $DEBUG;
  57. # At this point, file is in 'blib' and by default
  58. # has mode a-w. Therefore, must change permission
  59. # to make it writable. Note that stat and chmod
  60. # (the Perl functions) should work on Win32
  61. my $old_perm;
  62. $old_perm = (stat $pathfile)[2] & oct(7777);
  63. my $new_perm = $old_perm | oct(200);
  64. chmod $new_perm, $pathfile;
  65. # tie the file -- note that we're explicitly setting the line (record)
  66. # separator to hex 0A (the Unix newline) because that's what
  67. # the files copied to blib are using, regardless of whether the install
  68. # is under a Unix variant or Windows.
  69. tie @filearray, 'Tie::File', $pathfile, recsep => "\x0a" or die $!;
  70. warn "First line of $file is $filearray[0]\n\n" if $DEBUG;
  71. if ( ( $filearray[0] =~ /#!.*perl/ ) && ( $filearray[0] !~ /$shebang|"$shebang -w"/ ) ) {
  72. warn "\n\tRe-writing shebang line for $pathfile\n" if $DEBUG;
  73. warn "\tOriginal shebang line: $filearray[0]\n" if $DEBUG;
  74. $filearray[0] =~ /-w$/ ? $filearray[0] = "$shebang -w" : $filearray[0] = $shebang;
  75. warn "\tNew shebang line is: $filearray[0]\n\n" if $DEBUG;
  76. }
  77. elsif ( $filearray[0] =~ /$shebang|"$shebang -w"/ ) {
  78. warn "\n\tShebang line is correct.\n\n" if $DEBUG;
  79. }
  80. else {
  81. warn "\n\tNo shebang line found in $pathfile\n\n" if $DEBUG;
  82. }
  83. untie @filearray;
  84. chmod $old_perm, $pathfile;
  85. }
  86. # handle directories
  87. elsif ( -d ($dir . '/' . $file) && $file !~ /^\.{1,2}/ ) {
  88. my $dirpath = $dir . '/' . $file;
  89. warn "Found a subdir named $dirpath\n" if $DEBUG;
  90. fixshebang ($dirpath);
  91. }
  92. }
  93. closedir $dh;
  94. }
  95. fixshebang ($basedir);