From 5a9ebf599043b6b88e97c2f0a6ca9f5cff50be5d Mon Sep 17 00:00:00 2001 From: Erik Huelsmann Date: Sat, 30 Sep 2023 11:36:41 +0200 Subject: [PATCH] Fix critique --- lib/LedgerSMB/Database.pm | 4 +-- lib/LedgerSMB/Database/Loadorder.pm | 4 +-- lib/LedgerSMB/Scripts/setup.pm | 45 ++++++++++++++++++++++++----- xt/01.1-critic.t | 2 +- 4 files changed, 42 insertions(+), 13 deletions(-) diff --git a/lib/LedgerSMB/Database.pm b/lib/LedgerSMB/Database.pm index 2868d43402..3dde27fda3 100644 --- a/lib/LedgerSMB/Database.pm +++ b/lib/LedgerSMB/Database.pm @@ -335,7 +335,7 @@ sub get_info { if ($have_version_column) { # Legacy SL and LSMB - $self->logger->trace( "Legacy SL or LSMB database" ); + $self->logger->trace( 'Legacy SL or LSMB database' ); $sth = $dbh->prepare( 'SELECT version FROM defaults' ); @@ -378,7 +378,7 @@ sub get_info { $sth = $dbh->prepare('SELECT fldvalue FROM defaults WHERE fldname = ?'); $sth->execute('version'); if (my $ref = $sth->fetchrow_hashref('NAME_lc')){ - $self->logger->trace( "SL" ); + $self->logger->trace( 'SL' ); $retval->{appname} = 'sql-ledger'; $retval->{full_version} = $ref->{fldvalue}; $retval->{version} = $ref->{fldvalue}; diff --git a/lib/LedgerSMB/Database/Loadorder.pm b/lib/LedgerSMB/Database/Loadorder.pm index aeb7808c71..21604b42c0 100644 --- a/lib/LedgerSMB/Database/Loadorder.pm +++ b/lib/LedgerSMB/Database/Loadorder.pm @@ -107,8 +107,8 @@ sub scripts { map { $self->_limit_by_tag($_) } <$fh>; close $fh or die "Cannot open file $self->{_path}"; - $log->trace( "Considering schema patches: " . join(', ', - map { $_->path } @scripts) ); + $log->tracef( 'Considering schema patches: %s', + join(', ', map { $_->path } @scripts) ); $self->{_scripts} = \@scripts; return @scripts; } diff --git a/lib/LedgerSMB/Scripts/setup.pm b/lib/LedgerSMB/Scripts/setup.pm index 7f8a236678..27f1fa56ff 100644 --- a/lib/LedgerSMB/Scripts/setup.pm +++ b/lib/LedgerSMB/Scripts/setup.pm @@ -31,7 +31,7 @@ use Digest::MD5 qw(md5_hex); use Encode; use File::Spec; use HTML::Escape; -use HTTP::Status qw( HTTP_OK HTTP_UNAUTHORIZED ); +use HTTP::Status qw( HTTP_OK HTTP_INTERNAL_SERVER_ERROR HTTP_UNAUTHORIZED ); use Log::Any; use MIME::Base64; use Scope::Guard; @@ -725,14 +725,43 @@ sub _process_and_run_upgrade_script { } catch ($e) { my $error_text = escape_html( $e ); - local $/; - open my $out, '<:encoding(UTF-8)', $upgrade->logfiles->{out}; - open my $err, '<:encoding(UTF-8)', $upgrade->logfiles->{err}; - my $stdout = escape_html( <$out> ); - my $stderr = escape_html( <$err> ); - return [ 500, + local $/ = undef; + my $stdout = ''; + if ( open( my $out, '<:encoding(UTF-8)', $upgrade->logfiles->{out} ) ) { + $stdout = escape_html( <$out> ); + } + else { + $logger->warn( + "Unable to open psql upgrade script STDOUT logfile: $!" + ); + } + + my $stderr = ''; + if ( open( my $err, '<:encoding(UTF-8)', $upgrade->logfiles->{err} ) ) { + $stderr = escape_html( <$err> ); + } + else { + $logger->warn( + "Unable to open psql upgrade script STDERR logfile: $!" + ); + } + + return [ HTTP_INTERNAL_SERVER_ERROR, [ 'Content-Type' => 'text/html; charset=UTF-8' ], - [ "

Error!

$error_text

STDERR

$stderr

STDOUT

$stdout
" ] ]; + [ <<~EMBEDDED_HTML ] ]; + + +

Error!

+

$error_text

+ +

STDERR

+ 
$stderr
+ +

STDOUT

+ 
$stdout
+ + + EMBEDDED_HTML }; return; diff --git a/xt/01.1-critic.t b/xt/01.1-critic.t index 17e97fa85f..9409c5e455 100644 --- a/xt/01.1-critic.t +++ b/xt/01.1-critic.t @@ -22,7 +22,7 @@ sub test_files { Perl::Critic::Violation::set_format( 'S%s %p %f: %l\n'); for my $file (@$files) { - tests critique => { async => (! $ENV{COVERAGE}) }, sub { + tests "critique for $file" => { async => (! $ENV{COVERAGE}) }, sub { my @findings = map { "$_" } $critic->critique($file); ok(scalar(@findings) == 0, "Critique for $file");