fix-perl-path.PL

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