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:
parent
63cba14abd
commit
50d1acb3de
3 changed files with 710 additions and 622 deletions
1082
Makefile.PL
1082
Makefile.PL
File diff suppressed because it is too large
Load diff
|
@ -20,15 +20,15 @@ use ExtUtils::MakeMaker::Config;
|
|||
use Tie::File;
|
||||
|
||||
my $basedir = (shift);
|
||||
my $DEBUG = 0;
|
||||
my $DEBUG = 0;
|
||||
|
||||
$DEBUG = 1 if $basedir eq 'test';
|
||||
|
||||
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";
|
||||
|
||||
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;
|
||||
|
||||
die if $basedir eq 'test';
|
||||
|
@ -59,25 +59,26 @@ in a manner similar to 'fixshebang (foodir)' but may be supplied with any direct
|
|||
|
||||
=cut
|
||||
|
||||
sub fixshebang{
|
||||
my $dir = shift;
|
||||
sub fixshebang {
|
||||
my $dir = shift;
|
||||
opendir my $dh, $dir or die $!;
|
||||
warn "Reading $dir contents.\n" if $DEBUG;
|
||||
while( my $file = readdir($dh) ) {
|
||||
# this may be used to exclude any desired files from the scan
|
||||
warn "Reading $dir contents.\n" if $DEBUG;
|
||||
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$/ ) {
|
||||
# handle files... other extensions could be substituted/added if needed
|
||||
if ( $file =~ /\.pl$/ ) {
|
||||
my @filearray;
|
||||
my $pathfile =$dir . '/' . $file;
|
||||
warn "Found a perl script named $pathfile\n" if $DEBUG;
|
||||
my $pathfile = $dir . '/' . $file;
|
||||
warn "Found a perl script named $pathfile\n" if $DEBUG;
|
||||
|
||||
# At this point, file is in 'blib' and by default
|
||||
# has mode a-w. Therefore, must change permission
|
||||
# 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;
|
||||
|
||||
|
@ -88,30 +89,29 @@ sub fixshebang{
|
|||
tie @filearray, 'Tie::File', $pathfile, recsep => "\x0a" or die $!;
|
||||
|
||||
warn "First line of $file is $filearray[0]\n\n" if $DEBUG;
|
||||
if ( ( $filearray[0] =~ /#!.*perl/ ) && ( $filearray[0] !~ /$shebang|"$shebang -w"/ ) ) {
|
||||
warn "\n\tRe-writing shebang line for $pathfile\n" if $DEBUG;
|
||||
warn "\tOriginal shebang line: $filearray[0]\n" if $DEBUG;
|
||||
if ( ( $filearray[0] =~ /#!.*perl/ ) && ( $filearray[0] !~ /$shebang|"$shebang -w"/ ) ) {
|
||||
warn "\n\tRe-writing shebang line for $pathfile\n" if $DEBUG;
|
||||
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}/ ) {
|
||||
my $dirpath = $dir . '/' . $file;
|
||||
warn "Found a subdir named $dirpath\n" if $DEBUG;
|
||||
fixshebang ($dirpath);
|
||||
}
|
||||
}
|
||||
closedir $dh;
|
||||
}
|
||||
|
||||
# handle directories
|
||||
elsif ( -d ( $dir . '/' . $file ) && $file !~ /^\.{1,2}/ ) {
|
||||
my $dirpath = $dir . '/' . $file;
|
||||
warn "Found a subdir named $dirpath\n" if $DEBUG;
|
||||
fixshebang($dirpath);
|
||||
}
|
||||
}
|
||||
closedir $dh;
|
||||
}
|
||||
|
||||
fixshebang ($basedir);
|
||||
fixshebang($basedir);
|
||||
|
||||
|
|
|
@ -16,7 +16,7 @@
|
|||
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
||||
#
|
||||
# Current maintainer MJR http://mjr.towers.org.uk/
|
||||
#
|
||||
#
|
||||
# 2007/11/12 Added DB_PORT and changed other keywords to reflect multi-dbms support. -fbcit
|
||||
|
||||
use Modern::Perl;
|
||||
|
@ -71,107 +71,107 @@ if ( $myhost = $ENV{WEBSERVER_HOST} || hostname ) {
|
|||
|
||||
my $myip;
|
||||
unless ( $myip = $ENV{WEBSERVER_IP} ) {
|
||||
my $byname = gethostbyname( $myhost )
|
||||
or die "Could not get the IP address of $myhost, DNS fault? ($!)";
|
||||
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 ($!)";
|
||||
or die "can't inet_ntoa ($!)";
|
||||
}
|
||||
|
||||
|
||||
my $prefix = $ENV{'INSTALL_BASE'} || "/usr";
|
||||
|
||||
# These are our configuration guesses
|
||||
# Keys were extracted by
|
||||
# <grep -o '__.*__' etc/* | cut -f2 -d: | sort -u | sed -e 's/^/ "/;s/$/" => "",/'
|
||||
my %configuration = (
|
||||
"__KOHA_INSTALLED_VERSION__" => "no_version_found",
|
||||
"__LOG_DIR__" => "/var/log",
|
||||
"__PLUGINS_DIR__" => "/var/lib/koha/plugins",
|
||||
"__DB_TYPE__" => "mysql",
|
||||
"__DB_NAME__" => "koha",
|
||||
"__DB_HOST__" => $myhost,
|
||||
"__DB_PORT__" => "3306",
|
||||
"__DB_USER__" => "kohaadmin",
|
||||
"__DB_PASS__" => "katikoan",
|
||||
"__DB_USE_TLS__" => "no",
|
||||
"__DB_TLS_CA_CERTIFICATE__" => "",
|
||||
"__DB_TLS_CLIENT_CERTIFICATE__" => "",
|
||||
"__DB_TLS_CLIENT_KEY__"=>"",
|
||||
"__WEBMASTER_EMAIL__" => 'webmaster@'.$mydomain,
|
||||
"__WEBSERVER_DOMAIN__" => $mydomain,
|
||||
"__WEBSERVER_HOST__" => $myhost,
|
||||
"__WEBSERVER_IP__" => $myip,
|
||||
"__WEBSERVER_PORT__" => "80",
|
||||
"__WEBSERVER_PORT_LIBRARIAN__" => "8080",
|
||||
"__ZEBRA_SRU_HOST__" => $myhost,
|
||||
"__ZEBRA_SRU_BIBLIOS_PORT__" => "9998",
|
||||
"__ZEBRA_SRU_AUTHORITIES_PORT__" => "9999",
|
||||
"__KOHA_USER__" => "koha",
|
||||
"__KOHA_GROUP__" => "koha",
|
||||
"__ZEBRA_PASS__" => "zebrastripes",
|
||||
"__ZEBRA_USER__" => "kohauser",
|
||||
'__BACKUP_DIR__' => "$prefix/var/spool",
|
||||
'__API_CGI_DIR__' => "$prefix/api",
|
||||
'__INTRANET_CGI_DIR__' => "$prefix/intranet/cgi-bin",
|
||||
'__INTRANET_TMPL_DIR__' => "$prefix/intranet/templates",
|
||||
'__INTRANET_WWW_DIR__' => "$prefix/intranet/www",
|
||||
'__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",
|
||||
'__KOHA_CONF_DIR__' => "$prefix/etc/koha",
|
||||
'__ZEBRA_CONF_DIR__' => "$prefix/etc/koha/zebradb",
|
||||
'__MISC_DIR__' => "$prefix/misc",
|
||||
'__SCRIPT_DIR__' => "$prefix/bin",
|
||||
'__SCRIPT_NONDEV_DIR__' => "$prefix/bin",
|
||||
'__MAN_DIR__' => "$prefix/man",
|
||||
'__DOC_DIR__' => "$prefix/doc",
|
||||
'__ZEBRA_LOCK_DIR__' => "$prefix/var/lock/zebradb",
|
||||
'__ZEBRA_DATA_DIR__' => "$prefix/var/lib/zebradb",
|
||||
'__ZEBRA_RUN_DIR__' => "$prefix/var/run/zebradb",
|
||||
'__ZEBRA_MARC_FORMAT__' => 'marc21',
|
||||
'__ZEBRA_LANGUAGE__' => 'en',
|
||||
'__ZEBRA_TOKENIZER__' => 'chr',
|
||||
'__ZEBRA_TOKENIZER_STMT__' => 'charmap word-phrase-utf.chr',
|
||||
'__ZEBRA_PTOKENIZER_STMT__' => 'charmap word-phrase-utf.chr',
|
||||
'__AUTH_RETRIEVAL_CFG__' => 'retrieval-info-auth-dom.xml',
|
||||
'__BIB_RETRIEVAL_CFG__' => 'retrieval-info-bib-dom.xml',
|
||||
'__ZEBRA_AUTH_CFG__' => 'zebra-authorities-dom.cfg',
|
||||
'__ZEBRA_BIB_CFG__' => 'zebra-biblios-dom.cfg',
|
||||
"__MERGE_SERVER_HOST__" => $myhost,
|
||||
"__INSTALL_MODE__" => 'standard',
|
||||
"__INSTALL_BASE__" => '/usr/share/koha',
|
||||
"__INSTALL_SRU__" => 'yes',
|
||||
"__RUN_DATABASE_TESTS__" => 'no',
|
||||
"__PATH_TO_ZEBRA__" => "",
|
||||
"__USE_MEMCACHED__" => 'yes',
|
||||
"__MEMCACHED_SERVERS__" => "",
|
||||
"__MEMCACHED_NAMESPACE__" => "",
|
||||
"__USE_ELASTICSEARCH__" => 'no',
|
||||
"__ELASTICSEARCH_SERVERS__" => "localhost:9200",
|
||||
"__ELASTICSEARCH_INDEX__" => "koha",
|
||||
"__FONT_DIR__" => "/usr/share/fonts/truetype/dejavu",
|
||||
"__TEMPLATE_CACHE_DIR__" => "/tmp/koha",
|
||||
'__SMTP_HOST__' => 'localhost',
|
||||
'__SMTP_PORT__' => '25',
|
||||
'__SMTP_TIMEOUT__' => '120',
|
||||
'__SMTP_SSL_MODE__' => 'disabled',
|
||||
'__SMTP_USER_NAME__' => '',
|
||||
'__SMTP_PASSWORD__' => '',
|
||||
'__SMTP_DEBUG__' => '0',
|
||||
'__PERL_MODULE_LIB_DIR__' => "$prefix/lib",
|
||||
'__PERL5LIB_DIRS__' => "$prefix/lib",
|
||||
"__KOHA_INSTALLED_VERSION__" => "no_version_found",
|
||||
"__LOG_DIR__" => "/var/log",
|
||||
"__PLUGINS_DIR__" => "/var/lib/koha/plugins",
|
||||
"__DB_TYPE__" => "mysql",
|
||||
"__DB_NAME__" => "koha",
|
||||
"__DB_HOST__" => $myhost,
|
||||
"__DB_PORT__" => "3306",
|
||||
"__DB_USER__" => "kohaadmin",
|
||||
"__DB_PASS__" => "katikoan",
|
||||
"__DB_USE_TLS__" => "no",
|
||||
"__DB_TLS_CA_CERTIFICATE__" => "",
|
||||
"__DB_TLS_CLIENT_CERTIFICATE__" => "",
|
||||
"__DB_TLS_CLIENT_KEY__" => "",
|
||||
"__WEBMASTER_EMAIL__" => 'webmaster@' . $mydomain,
|
||||
"__WEBSERVER_DOMAIN__" => $mydomain,
|
||||
"__WEBSERVER_HOST__" => $myhost,
|
||||
"__WEBSERVER_IP__" => $myip,
|
||||
"__WEBSERVER_PORT__" => "80",
|
||||
"__WEBSERVER_PORT_LIBRARIAN__" => "8080",
|
||||
"__ZEBRA_SRU_HOST__" => $myhost,
|
||||
"__ZEBRA_SRU_BIBLIOS_PORT__" => "9998",
|
||||
"__ZEBRA_SRU_AUTHORITIES_PORT__" => "9999",
|
||||
"__KOHA_USER__" => "koha",
|
||||
"__KOHA_GROUP__" => "koha",
|
||||
"__ZEBRA_PASS__" => "zebrastripes",
|
||||
"__ZEBRA_USER__" => "kohauser",
|
||||
'__BACKUP_DIR__' => "$prefix/var/spool",
|
||||
'__API_CGI_DIR__' => "$prefix/api",
|
||||
'__INTRANET_CGI_DIR__' => "$prefix/intranet/cgi-bin",
|
||||
'__INTRANET_TMPL_DIR__' => "$prefix/intranet/templates",
|
||||
'__INTRANET_WWW_DIR__' => "$prefix/intranet/www",
|
||||
'__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",
|
||||
'__KOHA_CONF_DIR__' => "$prefix/etc/koha",
|
||||
'__ZEBRA_CONF_DIR__' => "$prefix/etc/koha/zebradb",
|
||||
'__MISC_DIR__' => "$prefix/misc",
|
||||
'__SCRIPT_DIR__' => "$prefix/bin",
|
||||
'__SCRIPT_NONDEV_DIR__' => "$prefix/bin",
|
||||
'__MAN_DIR__' => "$prefix/man",
|
||||
'__DOC_DIR__' => "$prefix/doc",
|
||||
'__ZEBRA_LOCK_DIR__' => "$prefix/var/lock/zebradb",
|
||||
'__ZEBRA_DATA_DIR__' => "$prefix/var/lib/zebradb",
|
||||
'__ZEBRA_RUN_DIR__' => "$prefix/var/run/zebradb",
|
||||
'__ZEBRA_MARC_FORMAT__' => 'marc21',
|
||||
'__ZEBRA_LANGUAGE__' => 'en',
|
||||
'__ZEBRA_TOKENIZER__' => 'chr',
|
||||
'__ZEBRA_TOKENIZER_STMT__' => 'charmap word-phrase-utf.chr',
|
||||
'__ZEBRA_PTOKENIZER_STMT__' => 'charmap word-phrase-utf.chr',
|
||||
'__AUTH_RETRIEVAL_CFG__' => 'retrieval-info-auth-dom.xml',
|
||||
'__BIB_RETRIEVAL_CFG__' => 'retrieval-info-bib-dom.xml',
|
||||
'__ZEBRA_AUTH_CFG__' => 'zebra-authorities-dom.cfg',
|
||||
'__ZEBRA_BIB_CFG__' => 'zebra-biblios-dom.cfg',
|
||||
"__MERGE_SERVER_HOST__" => $myhost,
|
||||
"__INSTALL_MODE__" => 'standard',
|
||||
"__INSTALL_BASE__" => '/usr/share/koha',
|
||||
"__INSTALL_SRU__" => 'yes',
|
||||
"__RUN_DATABASE_TESTS__" => 'no',
|
||||
"__PATH_TO_ZEBRA__" => "",
|
||||
"__USE_MEMCACHED__" => 'yes',
|
||||
"__MEMCACHED_SERVERS__" => "",
|
||||
"__MEMCACHED_NAMESPACE__" => "",
|
||||
"__USE_ELASTICSEARCH__" => 'no',
|
||||
"__ELASTICSEARCH_SERVERS__" => "localhost:9200",
|
||||
"__ELASTICSEARCH_INDEX__" => "koha",
|
||||
"__FONT_DIR__" => "/usr/share/fonts/truetype/dejavu",
|
||||
"__TEMPLATE_CACHE_DIR__" => "/tmp/koha",
|
||||
'__SMTP_HOST__' => 'localhost',
|
||||
'__SMTP_PORT__' => '25',
|
||||
'__SMTP_TIMEOUT__' => '120',
|
||||
'__SMTP_SSL_MODE__' => 'disabled',
|
||||
'__SMTP_USER_NAME__' => '',
|
||||
'__SMTP_PASSWORD__' => '',
|
||||
'__SMTP_DEBUG__' => '0',
|
||||
'__PERL_MODULE_LIB_DIR__' => "$prefix/lib",
|
||||
'__PERL5LIB_DIRS__' => "$prefix/lib",
|
||||
);
|
||||
|
||||
# Override configuration from the environment
|
||||
foreach my $key (keys %configuration) {
|
||||
if (defined($ENV{$key})) {
|
||||
$configuration{$key} = $ENV{$key};
|
||||
}
|
||||
foreach my $key ( keys %configuration ) {
|
||||
if ( defined( $ENV{$key} ) ) {
|
||||
$configuration{$key} = $ENV{$key};
|
||||
}
|
||||
}
|
||||
|
||||
my $fname = $ARGV[0];
|
||||
my $file = &read_file($fname);
|
||||
my $file = &read_file($fname);
|
||||
$file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg;
|
||||
|
||||
# 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
|
||||
# (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);
|
||||
|
||||
|
@ -191,11 +191,11 @@ chmod $old_perm, $fname;
|
|||
|
||||
# Idea taken from perlfaq5
|
||||
sub read_file {
|
||||
local $/;
|
||||
open(my $fh , '<', $_[0]) || die "Can't open $_[0] for read";
|
||||
my $file = <$fh>;
|
||||
close $fh;
|
||||
return $file;
|
||||
local $/;
|
||||
open( my $fh, '<', $_[0] ) || die "Can't open $_[0] for read";
|
||||
my $file = <$fh>;
|
||||
close $fh;
|
||||
return $file;
|
||||
}
|
||||
|
||||
__END__
|
||||
|
|
Loading…
Reference in a new issue