View | Details | Raw Unified | Return to bug 5617
Collapse All | Expand All

(-)a/fix-perl-path.PL (-118 lines)
Lines 1-117 Link Here
1
#!/usr/bin/env 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.  Note that stat and chmod
78
            # (the Perl functions) should work on Win32
79
            my $old_perm;
80
            $old_perm = (stat $pathfile)[2] & 07777;
81
            my $new_perm = $old_perm | 0200;
82
            chmod $new_perm, $pathfile;
83
84
            # tie the file -- note that we're explicitly setting the line (record)
85
            # separator to hex 0A (the Unix newline) because that's what
86
            # the files copied to blib are using, regardless of whether the install
87
            # is under a Unix variant or Windows.
88
            tie @filearray, 'Tie::File', $pathfile, recsep => "\x0a" or die $!;
89
90
            warn "First line of $file is $filearray[0]\n\n" if $DEBUG;
91
			if ( ( $filearray[0] =~ /#!.*perl/ ) && ( $filearray[0] !~ /$shebang|"$shebang -w"/ ) ) {
92
				warn "\n\tRe-writing shebang line for $pathfile\n" if $DEBUG;
93
                warn "\tOriginal shebang line: $filearray[0]\n" if $DEBUG;
94
                $filearray[0] =~ /-w$/ ? $filearray[0] = "$shebang -w" : $filearray[0] = $shebang;
95
                warn "\tNew shebang line is: $filearray[0]\n\n" if $DEBUG;
96
			}
97
            elsif ( $filearray[0] =~ /$shebang|"$shebang -w"/ ) {
98
                warn "\n\tShebang line is correct.\n\n" if $DEBUG;
99
            }
100
			else {
101
                warn "\n\tNo shebang line found in $pathfile\n\n" if $DEBUG;
102
			}
103
            untie @filearray;
104
            chmod $old_perm, $pathfile;
105
		}
106
		# handle directories
107
		elsif ( -d ($dir . '/' . $file) && $file !~ /^\.{1,2}/ ) {
108
			my $dirpath = $dir . '/' . $file;
109
			warn "Found a subdir named $dirpath\n" if $DEBUG;
110
			fixshebang ($dirpath);
111
		}
112
	}
113
	closedir $dh;
114
}
115
116
fixshebang ($basedir);
117
118
- 

Return to bug 5617