Bug 39149: Tidy .PL files

This patch is the result of running:

```shell
perl misc/devel/tidy.pl *.PL
```

Commiting raised an error about fix-perl-path.PL calling `warn` which I dismiss for the
time being.

Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
Signed-off-by: Victor Grousset/tuxayo <victor@tuxayo.net>
Signed-off-by: Katrin Fischer <katrin.fischer@bsz-bw.de>
This commit is contained in:
Tomás Cohen Arazi 2025-02-17 17:38:40 +00:00 committed by Katrin Fischer
parent 63cba14abd
commit 50d1acb3de
Signed by: kfischer
GPG key ID: 0EF6E2C03357A834
3 changed files with 710 additions and 622 deletions

File diff suppressed because it is too large Load diff

View file

@ -59,17 +59,18 @@ in a manner similar to 'fixshebang (foodir)' but may be supplied with any direct
=cut
sub fixshebang{
sub fixshebang {
my $dir = shift;
opendir my $dh, $dir or die $!;
warn "Reading $dir contents.\n" if $DEBUG;
while( my $file = readdir($dh) ) {
while ( my $file = readdir($dh) ) {
# this may be used to exclude any desired files from the scan
# if ( $file =~ /foo/ ) { next; }
# handle files... other extensions could be substituted/added if needed
if ( $file =~ /\.pl$/ ) {
my @filearray;
my $pathfile =$dir . '/' . $file;
my $pathfile = $dir . '/' . $file;
warn "Found a perl script named $pathfile\n" if $DEBUG;
# At this point, file is in 'blib' and by default
@ -77,7 +78,7 @@ sub fixshebang{
# to make it writable. Note that stat and chmod
# (the Perl functions) should work on Win32
my $old_perm;
$old_perm = (stat $pathfile)[2] & oct(7777);
$old_perm = ( stat $pathfile )[2] & oct(7777);
my $new_perm = $old_perm | oct(200);
chmod $new_perm, $pathfile;
@ -93,25 +94,24 @@ sub fixshebang{
warn "\tOriginal shebang line: $filearray[0]\n" if $DEBUG;
$filearray[0] =~ /-w$/ ? $filearray[0] = "$shebang -w" : $filearray[0] = $shebang;
warn "\tNew shebang line is: $filearray[0]\n\n" if $DEBUG;
}
elsif ( $filearray[0] =~ /$shebang|"$shebang -w"/ ) {
} elsif ( $filearray[0] =~ /$shebang|"$shebang -w"/ ) {
warn "\n\tShebang line is correct.\n\n" if $DEBUG;
}
else {
} else {
warn "\n\tNo shebang line found in $pathfile\n\n" if $DEBUG;
}
untie @filearray;
chmod $old_perm, $pathfile;
}
# handle directories
elsif ( -d ($dir . '/' . $file) && $file !~ /^\.{1,2}/ ) {
elsif ( -d ( $dir . '/' . $file ) && $file !~ /^\.{1,2}/ ) {
my $dirpath = $dir . '/' . $file;
warn "Found a subdir named $dirpath\n" if $DEBUG;
fixshebang ($dirpath);
fixshebang($dirpath);
}
}
closedir $dh;
}
fixshebang ($basedir);
fixshebang($basedir);

View file

@ -71,13 +71,12 @@ if ( $myhost = $ENV{WEBSERVER_HOST} || hostname ) {
my $myip;
unless ( $myip = $ENV{WEBSERVER_IP} ) {
my $byname = gethostbyname( $myhost )
my $byname = gethostbyname($myhost)
or die "Could not get the IP address of $myhost, DNS fault? ($!)";
$myip = inet_ntoa $byname
or die "can't inet_ntoa ($!)";
}
my $prefix = $ENV{'INSTALL_BASE'} || "/usr";
# These are our configuration guesses
@ -96,8 +95,8 @@ my %configuration = (
"__DB_USE_TLS__" => "no",
"__DB_TLS_CA_CERTIFICATE__" => "",
"__DB_TLS_CLIENT_CERTIFICATE__" => "",
"__DB_TLS_CLIENT_KEY__"=>"",
"__WEBMASTER_EMAIL__" => 'webmaster@'.$mydomain,
"__DB_TLS_CLIENT_KEY__" => "",
"__WEBMASTER_EMAIL__" => 'webmaster@' . $mydomain,
"__WEBSERVER_DOMAIN__" => $mydomain,
"__WEBSERVER_HOST__" => $myhost,
"__WEBSERVER_IP__" => $myip,
@ -118,7 +117,8 @@ my %configuration = (
'__OPAC_CGI_DIR__' => "$prefix/opac/cgi-bin",
'__OPAC_TMPL_DIR__' => "$prefix/opac/templates",
'__OPAC_WWW_DIR__' => "$prefix/opac/www",
'__PERL_MODULE_DIR__' => ($ENV{'INSTALLSITELIB'} || sprintf($prefix."/lib/perl5/site_perl/%vd",$^V))."/koha",
'__PERL_MODULE_DIR__' => ( $ENV{'INSTALLSITELIB'} || sprintf( $prefix . "/lib/perl5/site_perl/%vd", $^V ) )
. "/koha",
'__KOHA_CONF_DIR__' => "$prefix/etc/koha",
'__ZEBRA_CONF_DIR__' => "$prefix/etc/koha/zebradb",
'__MISC_DIR__' => "$prefix/misc",
@ -164,8 +164,8 @@ my %configuration = (
);
# Override configuration from the environment
foreach my $key (keys %configuration) {
if (defined($ENV{$key})) {
foreach my $key ( keys %configuration ) {
if ( defined( $ENV{$key} ) ) {
$configuration{$key} = $ENV{$key};
}
}
@ -179,11 +179,11 @@ $file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg;
# to make it writable. Note that stat and chmod
# (the Perl functions) should work on Win32
my $old_perm;
$old_perm = (stat $fname)[2] & oct(7777);
$old_perm = ( stat $fname )[2] & oct(7777);
my $new_perm = $old_perm | oct(200);
chmod $new_perm, $fname;
open(my $output, ">", $fname) || die "Can't open $fname for write: $!";
open( my $output, ">", $fname ) || die "Can't open $fname for write: $!";
print $output $file;
close($output);
@ -192,7 +192,7 @@ chmod $old_perm, $fname;
# Idea taken from perlfaq5
sub read_file {
local $/;
open(my $fh , '<', $_[0]) || die "Can't open $_[0] for read";
open( my $fh, '<', $_[0] ) || die "Can't open $_[0] for read";
my $file = <$fh>;
close $fh;
return $file;