Koha-community/Koha
15
7
Fork 0
Code Issues Releases Wiki Activity

Bug 39149: Tidy .PL files

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

1082
Makefile.PL
View file

File diff suppressed because it is too large Load diff

62
fix-perl-path.PL
View file

@ -20,15 +20,15 @@ use ExtUtils::MakeMaker::Config;
use Tie::File; use Tie::File;
my $basedir = (shift); my $basedir = (shift);
my $DEBUG = 0; my $DEBUG = 0;
$DEBUG = 1 if $basedir eq 'test'; $DEBUG = 1 if $basedir eq 'test';
my $bindir = $Config{installbin}; my $bindir = $Config{installbin};
$bindir =~ s!\\!/!g; # make all directory separators uniform since Win32 does not care and *nix does... $bindir =~ s!\\!/!g; # make all directory separators uniform since Win32 does not care and *nix does...
my $shebang = "#!$bindir\/perl"; my $shebang = "#!$bindir\/perl";
warn "Perl binary located in $bindir on this system.\n" if $DEBUG; warn "Perl binary located in $bindir on this system.\n" if $DEBUG;
warn "The shebang line for this sytems should be $shebang\n\n" if $DEBUG; warn "The shebang line for this sytems should be $shebang\n\n" if $DEBUG;
die if $basedir eq 'test'; die if $basedir eq 'test';
@ -59,25 +59,26 @@ in a manner similar to 'fixshebang (foodir)' but may be supplied with any direct
=cut =cut
sub fixshebang{ sub fixshebang {
my $dir = shift; my $dir = shift;
opendir my $dh, $dir or die $!; opendir my $dh, $dir or die $!;
warn "Reading $dir contents.\n" if $DEBUG; 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
# this may be used to exclude any desired files from the scan
# if ( $file =~ /foo/ ) { next; } # if ( $file =~ /foo/ ) { next; }
# handle files... other extensions could be substituted/added if needed # handle files... other extensions could be substituted/added if needed
if ( $file =~ /\.pl$/ ) { if ( $file =~ /\.pl$/ ) {
my @filearray; my @filearray;
my $pathfile =$dir . '/' . $file; my $pathfile = $dir . '/' . $file;
warn "Found a perl script named $pathfile\n" if $DEBUG; warn "Found a perl script named $pathfile\n" if $DEBUG;
# At this point, file is in 'blib' and by default # At this point, file is in 'blib' and by default
# has mode a-w. Therefore, must change permission # has mode a-w. Therefore, must change permission
# to make it writable. Note that stat and chmod # to make it writable. Note that stat and chmod
# (the Perl functions) should work on Win32 # (the Perl functions) should work on Win32
my $old_perm; my $old_perm;
$old_perm = (stat $pathfile)[2] & oct(7777); $old_perm = ( stat $pathfile )[2] & oct(7777);
my $new_perm = $old_perm | oct(200); my $new_perm = $old_perm | oct(200);
chmod $new_perm, $pathfile; chmod $new_perm, $pathfile;
@ -88,30 +89,29 @@ sub fixshebang{
tie @filearray, 'Tie::File', $pathfile, recsep => "\x0a" or die $!; tie @filearray, 'Tie::File', $pathfile, recsep => "\x0a" or die $!;
warn "First line of $file is $filearray[0]\n\n" if $DEBUG; warn "First line of $file is $filearray[0]\n\n" if $DEBUG;
if ( ( $filearray[0] =~ /#!.*perl/ ) && ( $filearray[0] !~ /$shebang|"$shebang -w"/ ) ) { if ( ( $filearray[0] =~ /#!.*perl/ ) && ( $filearray[0] !~ /$shebang|"$shebang -w"/ ) ) {
warn "\n\tRe-writing shebang line for $pathfile\n" if $DEBUG; warn "\n\tRe-writing shebang line for $pathfile\n" if $DEBUG;
warn "\tOriginal shebang line: $filearray[0]\n" if $DEBUG; warn "\tOriginal shebang line: $filearray[0]\n" if $DEBUG;
$filearray[0] =~ /-w$/ ? $filearray[0] = "$shebang -w" : $filearray[0] = $shebang; $filearray[0] =~ /-w$/ ? $filearray[0] = "$shebang -w" : $filearray[0] = $shebang;
warn "\tNew shebang line is: $filearray[0]\n\n" if $DEBUG; 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; warn "\n\tShebang line is correct.\n\n" if $DEBUG;
} } else {
else {
warn "\n\tNo shebang line found in $pathfile\n\n" if $DEBUG; warn "\n\tNo shebang line found in $pathfile\n\n" if $DEBUG;
} }
untie @filearray; untie @filearray;
chmod $old_perm, $pathfile; chmod $old_perm, $pathfile;
} }
# handle directories
elsif ( -d ($dir . '/' . $file) && $file !~ /^\.{1,2}/ ) { # handle directories
my $dirpath = $dir . '/' . $file; elsif ( -d ( $dir . '/' . $file ) && $file !~ /^\.{1,2}/ ) {
warn "Found a subdir named $dirpath\n" if $DEBUG; my $dirpath = $dir . '/' . $file;
fixshebang ($dirpath); warn "Found a subdir named $dirpath\n" if $DEBUG;
} fixshebang($dirpath);
} }
closedir $dh; }
closedir $dh;
} }
fixshebang ($basedir); fixshebang($basedir);

188
rewrite-config.PL
View file

@ -16,7 +16,7 @@
# along with Koha; if not, see <http://www.gnu.org/licenses>. # along with Koha; if not, see <http://www.gnu.org/licenses>.
# #
# Current maintainer MJR http://mjr.towers.org.uk/ # Current maintainer MJR http://mjr.towers.org.uk/
# #
# 2007/11/12 Added DB_PORT and changed other keywords to reflect multi-dbms support. -fbcit # 2007/11/12 Added DB_PORT and changed other keywords to reflect multi-dbms support. -fbcit
use Modern::Perl; use Modern::Perl;
@ -71,107 +71,107 @@ if ( $myhost = $ENV{WEBSERVER_HOST} || hostname ) {
my $myip; my $myip;
unless ( $myip = $ENV{WEBSERVER_IP} ) { 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? ($!)"; or die "Could not get the IP address of $myhost, DNS fault? ($!)";
$myip = inet_ntoa $byname $myip = inet_ntoa $byname
or die "can't inet_ntoa ($!)"; or die "can't inet_ntoa ($!)";
} }
my $prefix = $ENV{'INSTALL_BASE'} || "/usr"; my $prefix = $ENV{'INSTALL_BASE'} || "/usr";
# These are our configuration guesses # These are our configuration guesses
# Keys were extracted by # Keys were extracted by
# <grep -o '__.*__' etc/* | cut -f2 -d: | sort -u | sed -e 's/^/ "/;s/$/" => "",/' # <grep -o '__.*__' etc/* | cut -f2 -d: | sort -u | sed -e 's/^/ "/;s/$/" => "",/'
my %configuration = ( my %configuration = (
"__KOHA_INSTALLED_VERSION__" => "no_version_found", "__KOHA_INSTALLED_VERSION__" => "no_version_found",
"__LOG_DIR__" => "/var/log", "__LOG_DIR__" => "/var/log",
"__PLUGINS_DIR__" => "/var/lib/koha/plugins", "__PLUGINS_DIR__" => "/var/lib/koha/plugins",
"__DB_TYPE__" => "mysql", "__DB_TYPE__" => "mysql",
"__DB_NAME__" => "koha", "__DB_NAME__" => "koha",
"__DB_HOST__" => $myhost, "__DB_HOST__" => $myhost,
"__DB_PORT__" => "3306", "__DB_PORT__" => "3306",
"__DB_USER__" => "kohaadmin", "__DB_USER__" => "kohaadmin",
"__DB_PASS__" => "katikoan", "__DB_PASS__" => "katikoan",
"__DB_USE_TLS__" => "no", "__DB_USE_TLS__" => "no",
"__DB_TLS_CA_CERTIFICATE__" => "", "__DB_TLS_CA_CERTIFICATE__" => "",
"__DB_TLS_CLIENT_CERTIFICATE__" => "", "__DB_TLS_CLIENT_CERTIFICATE__" => "",
"__DB_TLS_CLIENT_KEY__"=>"", "__DB_TLS_CLIENT_KEY__" => "",
"__WEBMASTER_EMAIL__" => 'webmaster@'.$mydomain, "__WEBMASTER_EMAIL__" => 'webmaster@' . $mydomain,
"__WEBSERVER_DOMAIN__" => $mydomain, "__WEBSERVER_DOMAIN__" => $mydomain,
"__WEBSERVER_HOST__" => $myhost, "__WEBSERVER_HOST__" => $myhost,
"__WEBSERVER_IP__" => $myip, "__WEBSERVER_IP__" => $myip,
"__WEBSERVER_PORT__" => "80", "__WEBSERVER_PORT__" => "80",
"__WEBSERVER_PORT_LIBRARIAN__" => "8080", "__WEBSERVER_PORT_LIBRARIAN__" => "8080",
"__ZEBRA_SRU_HOST__" => $myhost, "__ZEBRA_SRU_HOST__" => $myhost,
"__ZEBRA_SRU_BIBLIOS_PORT__" => "9998", "__ZEBRA_SRU_BIBLIOS_PORT__" => "9998",
"__ZEBRA_SRU_AUTHORITIES_PORT__" => "9999", "__ZEBRA_SRU_AUTHORITIES_PORT__" => "9999",
"__KOHA_USER__" => "koha", "__KOHA_USER__" => "koha",
"__KOHA_GROUP__" => "koha", "__KOHA_GROUP__" => "koha",
"__ZEBRA_PASS__" => "zebrastripes", "__ZEBRA_PASS__" => "zebrastripes",
"__ZEBRA_USER__" => "kohauser", "__ZEBRA_USER__" => "kohauser",
'__BACKUP_DIR__' => "$prefix/var/spool", '__BACKUP_DIR__' => "$prefix/var/spool",
'__API_CGI_DIR__' => "$prefix/api", '__API_CGI_DIR__' => "$prefix/api",
'__INTRANET_CGI_DIR__' => "$prefix/intranet/cgi-bin", '__INTRANET_CGI_DIR__' => "$prefix/intranet/cgi-bin",
'__INTRANET_TMPL_DIR__' => "$prefix/intranet/templates", '__INTRANET_TMPL_DIR__' => "$prefix/intranet/templates",
'__INTRANET_WWW_DIR__' => "$prefix/intranet/www", '__INTRANET_WWW_DIR__' => "$prefix/intranet/www",
'__OPAC_CGI_DIR__' => "$prefix/opac/cgi-bin", '__OPAC_CGI_DIR__' => "$prefix/opac/cgi-bin",
'__OPAC_TMPL_DIR__' => "$prefix/opac/templates", '__OPAC_TMPL_DIR__' => "$prefix/opac/templates",
'__OPAC_WWW_DIR__' => "$prefix/opac/www", '__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_CONF_DIR__' => "$prefix/etc/koha", . "/koha",
'__ZEBRA_CONF_DIR__' => "$prefix/etc/koha/zebradb", '__KOHA_CONF_DIR__' => "$prefix/etc/koha",
'__MISC_DIR__' => "$prefix/misc", '__ZEBRA_CONF_DIR__' => "$prefix/etc/koha/zebradb",
'__SCRIPT_DIR__' => "$prefix/bin", '__MISC_DIR__' => "$prefix/misc",
'__SCRIPT_NONDEV_DIR__' => "$prefix/bin", '__SCRIPT_DIR__' => "$prefix/bin",
'__MAN_DIR__' => "$prefix/man", '__SCRIPT_NONDEV_DIR__' => "$prefix/bin",
'__DOC_DIR__' => "$prefix/doc", '__MAN_DIR__' => "$prefix/man",
'__ZEBRA_LOCK_DIR__' => "$prefix/var/lock/zebradb", '__DOC_DIR__' => "$prefix/doc",
'__ZEBRA_DATA_DIR__' => "$prefix/var/lib/zebradb", '__ZEBRA_LOCK_DIR__' => "$prefix/var/lock/zebradb",
'__ZEBRA_RUN_DIR__' => "$prefix/var/run/zebradb", '__ZEBRA_DATA_DIR__' => "$prefix/var/lib/zebradb",
'__ZEBRA_MARC_FORMAT__' => 'marc21', '__ZEBRA_RUN_DIR__' => "$prefix/var/run/zebradb",
'__ZEBRA_LANGUAGE__' => 'en', '__ZEBRA_MARC_FORMAT__' => 'marc21',
'__ZEBRA_TOKENIZER__' => 'chr', '__ZEBRA_LANGUAGE__' => 'en',
'__ZEBRA_TOKENIZER_STMT__' => 'charmap word-phrase-utf.chr', '__ZEBRA_TOKENIZER__' => 'chr',
'__ZEBRA_PTOKENIZER_STMT__' => 'charmap word-phrase-utf.chr', '__ZEBRA_TOKENIZER_STMT__' => 'charmap word-phrase-utf.chr',
'__AUTH_RETRIEVAL_CFG__' => 'retrieval-info-auth-dom.xml', '__ZEBRA_PTOKENIZER_STMT__' => 'charmap word-phrase-utf.chr',
'__BIB_RETRIEVAL_CFG__' => 'retrieval-info-bib-dom.xml', '__AUTH_RETRIEVAL_CFG__' => 'retrieval-info-auth-dom.xml',
'__ZEBRA_AUTH_CFG__' => 'zebra-authorities-dom.cfg', '__BIB_RETRIEVAL_CFG__' => 'retrieval-info-bib-dom.xml',
'__ZEBRA_BIB_CFG__' => 'zebra-biblios-dom.cfg', '__ZEBRA_AUTH_CFG__' => 'zebra-authorities-dom.cfg',
"__MERGE_SERVER_HOST__" => $myhost, '__ZEBRA_BIB_CFG__' => 'zebra-biblios-dom.cfg',
"__INSTALL_MODE__" => 'standard', "__MERGE_SERVER_HOST__" => $myhost,
"__INSTALL_BASE__" => '/usr/share/koha', "__INSTALL_MODE__" => 'standard',
"__INSTALL_SRU__" => 'yes', "__INSTALL_BASE__" => '/usr/share/koha',
"__RUN_DATABASE_TESTS__" => 'no', "__INSTALL_SRU__" => 'yes',
"__PATH_TO_ZEBRA__" => "", "__RUN_DATABASE_TESTS__" => 'no',
"__USE_MEMCACHED__" => 'yes', "__PATH_TO_ZEBRA__" => "",
"__MEMCACHED_SERVERS__" => "", "__USE_MEMCACHED__" => 'yes',
"__MEMCACHED_NAMESPACE__" => "", "__MEMCACHED_SERVERS__" => "",
"__USE_ELASTICSEARCH__" => 'no', "__MEMCACHED_NAMESPACE__" => "",
"__ELASTICSEARCH_SERVERS__" => "localhost:9200", "__USE_ELASTICSEARCH__" => 'no',
"__ELASTICSEARCH_INDEX__" => "koha", "__ELASTICSEARCH_SERVERS__" => "localhost:9200",
"__FONT_DIR__" => "/usr/share/fonts/truetype/dejavu", "__ELASTICSEARCH_INDEX__" => "koha",
"__TEMPLATE_CACHE_DIR__" => "/tmp/koha", "__FONT_DIR__" => "/usr/share/fonts/truetype/dejavu",
'__SMTP_HOST__' => 'localhost', "__TEMPLATE_CACHE_DIR__" => "/tmp/koha",
'__SMTP_PORT__' => '25', '__SMTP_HOST__' => 'localhost',
'__SMTP_TIMEOUT__' => '120', '__SMTP_PORT__' => '25',
'__SMTP_SSL_MODE__' => 'disabled', '__SMTP_TIMEOUT__' => '120',
'__SMTP_USER_NAME__' => '', '__SMTP_SSL_MODE__' => 'disabled',
'__SMTP_PASSWORD__' => '', '__SMTP_USER_NAME__' => '',
'__SMTP_DEBUG__' => '0', '__SMTP_PASSWORD__' => '',
'__PERL_MODULE_LIB_DIR__' => "$prefix/lib", '__SMTP_DEBUG__' => '0',
'__PERL5LIB_DIRS__' => "$prefix/lib", '__PERL_MODULE_LIB_DIR__' => "$prefix/lib",
'__PERL5LIB_DIRS__' => "$prefix/lib",
); );
# Override configuration from the environment # Override configuration from the environment
foreach my $key (keys %configuration) { foreach my $key ( keys %configuration ) {
if (defined($ENV{$key})) { if ( defined( $ENV{$key} ) ) {
$configuration{$key} = $ENV{$key}; $configuration{$key} = $ENV{$key};
} }
} }
my $fname = $ARGV[0]; my $fname = $ARGV[0];
my $file = &read_file($fname); my $file = &read_file($fname);
$file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg; $file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg;
# At this point, file is in 'blib' and by default # At this point, file is in 'blib' and by default
@ -179,11 +179,11 @@ $file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg;
# to make it writable. Note that stat and chmod # to make it writable. Note that stat and chmod
# (the Perl functions) should work on Win32 # (the Perl functions) should work on Win32
my $old_perm; my $old_perm;
$old_perm = (stat $fname)[2] & oct(7777); $old_perm = ( stat $fname )[2] & oct(7777);
my $new_perm = $old_perm | oct(200); my $new_perm = $old_perm | oct(200);
chmod $new_perm, $fname; 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; print $output $file;
close($output); close($output);
@ -191,11 +191,11 @@ chmod $old_perm, $fname;
# Idea taken from perlfaq5 # Idea taken from perlfaq5
sub read_file { sub read_file {
local $/; 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>; my $file = <$fh>;
close $fh; close $fh;
return $file; return $file;
} }
__END__ __END__