-=head2 fixshebang
-
-This sub will recurse through a given directory and its subdirectories checking for the existence of a shebang
-line in .pl files and replacing it with the correct line for the current OS if needed. It should be called
-in a manner similar to 'fixshebang (getcwd())' but may be supplied with any directory in absolute path form.
-
-=cut
-
-sub fixshebang{
- # NOTE: this might be dressed up a bit with File::Spec since we're using it here already.
- my $dir = shift;
- opendir my $dh, $dir or die $!;
- while( my $file = readdir($dh) ) {
- print "Reading $dir contents.\r\n" if $DEBUG;
- print "Current item = $file\r\n" if $DEBUG;
- # this may be used to exclude any desired files from the scan
- if ( $file =~ /shebang|wixgen/ ) { next; }
- # handle files... other extensions could be substituted/added if needed
- if ( $file =~ /\.pl$/ ) {
- my $pathfile =$dir . '/' . $file;
- print "Found a perl script named $pathfile\r\n" if $DEBUG;
- open FH, '+<', "$pathfile";
- my @file = <FH>;
- seek( FH, 0, 0 );
- truncate( FH, 0 );
- my $line = shift @file;
- print "Found shebang line: $line\r\n" if $DEBUG;
- # FIXME: these conditionals need to be modified to select shebang line based on OS ($^O)
- if ( $line =~ /#!c:\\strawberry-perl\\perl\\bin\\perl -w/ ) {
- # FIXME: This can probably be done with less of a hack. -fbcit
- print FH $line;
- print FH @file;
- close (FH);
- next;
- }
- elsif ( $line =~ /#!\/usr\/bin\/perl/ ) {
- print "Re-writing shebang line for $pathfile\r\n";
- print FH "#!c:\\strawberry-perl\\perl\\bin\\perl -w\n";
- print FH @file;
- close(FH);
- }
- else {
- # FIXME: This can probably be done with less of a hack. -fbcit
- print FH $line;
- print FH @file;
- close (FH);
- next;
- }
- }
- # handle directories
- elsif ( -d ($dir . '/' . $file) && $file !~ /^\.{1,2}/ ) {
- my $pathfile = $dir . '/' . $file;
- print "Found a subdir named $pathfile\r\n" if $DEBUG;
- &fixshebang ($pathfile);
-# closedir $dh; # I'm not really sure if this is necessary
- }
- }
- closedir $dh;
-}
-