Skip to content

Commit

Permalink
SL 2.8 migration improvements (ledgersmb#7629)
Browse files Browse the repository at this point in the history 
Fix broken 2.8 upgrades
  • Loading branch information
@ehuelsmann
ehuelsmann committed Sep 30, 2023
1 parent 5bd39bf commit 8a92445
Show file tree
Hide file tree
Showing 8 changed files with 251 additions and 45 deletions.
28 changes: 17 additions & 11 deletions lib/LedgerSMB/Database.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -271,12 +271,16 @@ sub get_info {
local $@ = undef;

my $dbh = eval { $self->connect({PrintError => 0, AutoCommit => 0}) };
if (!$dbh){ # Could not connect, try to validate existance by connecting
# to postgres and checking
if ( !$dbh ) {
# Could not connect, try to validate existance by connecting
# to postgres and checking

$self->logger->debug(
"Can't connect to database; falling through to $authdb"
);
$dbh = $self->new($self->export, (dbname => $authdb))
->connect({PrintError=>0});
return $retval unless $dbh;
$self->logger->debug("DBI->connect dbh=$dbh");
_set_system_info($dbh, $retval);

# don't assign to App_State::DBH, since we're a fallback connection,
Expand All @@ -299,15 +303,14 @@ sub get_info {
$dbh->disconnect();

return $retval;
} else { # Got a db handle... try to find the version and app by a few
# different means
$self->logger->debug("DBI->connect dbh=$dbh");

}
else {
# Got a db handle... try to find the version and app by a few
# different means
$retval->{status} = 'exists';
_set_system_info($dbh, $retval);

my $sth;
$sth = $dbh->prepare('SELECT SESSION_USER');
my $sth = $dbh->prepare('SELECT SESSION_USER');
$sth->execute;
$retval->{username} = $sth->fetchrow_array();
$sth->finish();
Expand All @@ -327,12 +330,12 @@ sub get_info {
}
);
$sth->execute();
my ($have_version_column) =
$sth->fetchrow_array();
my ($have_version_column) = $sth->fetchrow_array();
$sth->finish();

if ($have_version_column) {
# Legacy SL and LSMB
$self->logger->trace( 'Legacy SL or LSMB database' );
$sth = $dbh->prepare(
'SELECT version FROM defaults'
);
Expand Down Expand Up @@ -375,11 +378,14 @@ 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' );
$retval->{appname} = 'sql-ledger';
$retval->{full_version} = $ref->{fldvalue};
$retval->{version} = $ref->{fldvalue};
$retval->{version} =~ s/(\d+\.\d+).*/$1/g;
} else {
my $schema = $self->schema;
$self->logger->debug( "SL; possibly no version set; $schema" );
$retval->{appname} = 'unknown';
}
$dbh->rollback;
Expand Down
3 changes: 3 additions & 0 deletions lib/LedgerSMB/Database/Loadorder.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@ use warnings;

use Cwd;
use List::Util qw| any |;
use Log::Any qw($log);

use LedgerSMB::Database::Change;
use LedgerSMB::Database::ChangeChecks qw/load_checks run_checks/;
Expand Down Expand Up @@ -106,6 +107,8 @@ sub scripts {
map { $self->_limit_by_tag($_) }
<$fh>;
close $fh or die "Cannot open file $self->{_path}";
$log->tracef( 'Considering schema patches: %s',
join(', ', map { $_->path } @scripts) );
$self->{_scripts} = \@scripts;
return @scripts;
}
Expand Down
16 changes: 12 additions & 4 deletions lib/LedgerSMB/Database/Upgrade.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,6 +75,12 @@ has type => (is => 'ro', required => 1);
has language => (is => 'ro', default => 'en');


=head2 logfiles
=cut

has logfiles => (is => 'ro', default => sub { {} });


=head1 METHODS
Expand Down Expand Up @@ -235,6 +241,8 @@ sub run_upgrade_script {

my $dbh = $self->database->connect({ PrintError => 0, AutoCommit => 0 });
my $temp = $self->database->loader_log_filename();
$self->logfiles->{out} = $temp . '_stdout';
$self->logfiles->{err} = $temp . '_stderr';

my $schema = $self->database->schema;
my $guard = Scope::Guard->new(
Expand All @@ -254,8 +262,8 @@ sub run_upgrade_script {
$dbh->commit;

$self->database->load_base_schema(
log => $temp . '_stdout',
errlog => $temp . '_stderr',
log => $self->logfiles->{out},
errlog => $self->logfiles->{err},
upto_tag=> $upto
);

Expand Down Expand Up @@ -289,8 +297,8 @@ sub run_upgrade_script {

$self->database->run_file(
file => $tempfile->filename,
stdout_log => $temp . '_stdout',
errlog => $temp . '_stderr'
stdout_log => $self->logfiles->{out},
errlog => $self->logfiles->{err},
);

my $sth = $dbh->prepare(q(select value='yes'
Expand Down
70 changes: 60 additions & 10 deletions lib/LedgerSMB/Scripts/setup.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,10 +26,12 @@ use strict;
use warnings;
use version;

use Carp;
use Digest::MD5 qw(md5_hex);
use Encode;
use File::Spec;
use HTTP::Status qw( HTTP_OK HTTP_UNAUTHORIZED );
use HTML::Escape;
use HTTP::Status qw( HTTP_OK HTTP_INTERNAL_SERVER_ERROR HTTP_UNAUTHORIZED );
use Log::Any;
use MIME::Base64;
use Scope::Guard;
Expand Down Expand Up @@ -681,7 +683,7 @@ sub _dispatch_upgrade_workflow {
return __PACKAGE__->can($next)->($request);
}

die "Upgrade workflow error: no next step for '$step_name'";
croak "Upgrade workflow error: no next step for '$step_name'";
}

sub _select_coa {
Expand All @@ -700,17 +702,62 @@ sub _process_and_run_upgrade_script {

my $hdr = $request->{_req}->header( 'Accept-Language' );
my $lang = $request->{_wire}->get( 'default_locale' )->from_header( $hdr );

my $upgrade = LedgerSMB::Database::Upgrade->new(
database => $database,
type => $type,
language => $lang
);
$upgrade->run_upgrade_script(
{
%{$request}{qw( default_country default_ap default_ar
slschema lsmbschema lsmbversion)}
});
$upgrade->run_post_upgrade_steps;
try {
my $info = $database->get_info();
$upgrade->run_upgrade_script(
{
sl_version => version->parse($info->{full_version}),
%{$request}{qw( default_country default_ap default_ar
slschema lsmbschema lsmbversion)}
});
$upgrade->run_post_upgrade_steps;
}
catch ($e) {
my $error_text = escape_html( $e );
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' ],
[ <<~EMBEDDED_HTML ] ];
<html>
<body>
<h1>Error!</h1>
<p><b>$error_text</b></p>
<h3>STDERR</h3>
<pre style="max-height:30em;overflow:scroll">$stderr</pre>
<h3>STDOUT</h3>
<pre style="max-height:30em;overflow:scroll">$stdout</pre>
</body>
</html>
EMBEDDED_HTML
};

return;
}
Expand Down Expand Up @@ -835,6 +882,7 @@ sub upgrade {
);

my $rv;
$logger->debug( "Running upgrade tests for '$upgrade_type'" );
$upgrade->run_tests(
sub {
my ($check, $dbh, $sth) = @_;
Expand Down Expand Up @@ -989,14 +1037,15 @@ sub fix_tests {
my $settings = $request->{_wire}->get( 'setup_settings' );
my $auth_db = ($settings and $settings->{auth_db}) // 'postgres';
my $dbinfo = $database->get_info($auth_db);
my $upgrade_type = "$dbinfo->{appname}/$dbinfo->{version}";
my $dbh = $request->{dbh};
$dbh->{AutoCommit} = 0;

my $hdr = $request->{_req}->header( 'Accept-Language' );
my $lang = $request->{_wire}->get( 'default_locale' )->from_header( $hdr );
my $upgrade = LedgerSMB::Database::Upgrade->new(
database => $database,
type => '.../...',
type => $upgrade_type,
language => $lang
);

Expand All @@ -1005,7 +1054,7 @@ sub fix_tests {
. 'found no applicable tests for given identifier'
unless $check;

die "Inconsistent state fixing date for $request->{check}: "
die "Inconsistent state fixing data for $request->{check}: "
. 'found different test by the same name while fixing data'
if $request->{verify_check} ne md5_hex($check->test_query);

Expand All @@ -1014,6 +1063,7 @@ sub fix_tests {
my %row_data;
for my $key (@{$check->columns}) {
$row_data{$key} = $request->{"${key}_$count"};
$logger->trace( "Setting row $count field $key to $row_data{$key}" );
}
@row_data{@{$check->id_columns}} =
map {
Expand Down
37 changes: 27 additions & 10 deletions lib/LedgerSMB/Upgrade_Tests.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,13 +18,17 @@ This module has a single function that returns upgrade tests.
use strict;
use warnings;

use JSON::PP;
use Log::Any qw($log);
use Moose;
use Moose::Util::TypeConstraints;
use namespace::autoclean;
use List::Util qw( first );

use LedgerSMB::Locale qw(marktext);

my $json = JSON::PP->new;

=head1 FUNCTIONS
=over
Expand Down Expand Up @@ -274,11 +278,11 @@ sub fix {
if ($self->insert) {
my $columns =
join ', ',
map { $dbh->quote_identifier($_) } @{$self->columns};
map { $dbh->quote_identifier($_) } (@{$self->columns}, @{$self->id_columns});
my $values =
join ', ', map { '?' } @{$self->columns};
join ', ', map { '?' } (@{$self->columns}, @{$self->id_columns});
$query = qq{INSERT INTO $table ($columns) VALUES ($values)};
@bind_columns = @{$self->columns};
@bind_columns = (@{$self->columns}, @{$self->id_columns});
}
else {
my $setters =
Expand All @@ -294,6 +298,7 @@ sub fix {

my $sth = $dbh->prepare($query)
or die "Failed to compile query ($query) to apply fixes: " . $dbh->errstr;
$log->debug( "Running fix-query: $query" . $json->encode( { columns => \@bind_columns, values => $fixes } ) );
for my $row (@$fixes) {
my $rv = $sth->execute(map { $row->{$_} } @bind_columns);
if (not $rv) {
Expand Down Expand Up @@ -699,27 +704,39 @@ push @tests, __PACKAGE__->new(
);

push @tests, __PACKAGE__->new(
test_query => q{select name, contact from customer
test_query => q{select id, name, contact from customer
where arap_accno_id is null
order by name},
instructions => marktext(
'Select and assign the missing AR accounts'),
selectable_values => {
arap_accno_id => q/SELECT description as text, id as value FROM chart WHERE (':' || link || ':') like '%:AR:%'/,
},
display_name => marktext('Empty AR account'),
name => 'no_null_ar_accounts',
display_cols => [ 'name', 'contact' ],
instructions => marktext(q(Please go into the SQL-Ledger UI and correct the empty AR accounts)),
display_cols => [ 'name', 'contact', 'arap_accno_id' ],
columns => [ 'arap_accno_id' ],
appname => 'sql-ledger',
table => 'customer',
min_version => '2.7',
max_version => '3.0'
);

push @tests, __PACKAGE__->new(
test_query => q{select name, contact from vendor
test_query => q{select id, name, contact from vendor
where arap_accno_id is null
order by name},
instructions => marktext(
'Select and assign the missing AP accounts'),
selectable_values => {
arap_accno_id => q/SELECT description as text, id as value FROM chart WHERE (':' || link || ':') like '%:AP:%'/,
},
display_name => marktext('Empty AP account'),
name => 'no_null_ap_accounts',
display_cols => [ 'name', 'contact' ],
instructions => marktext(q(Please go into the SQL-Ledger UI and correct the empty AP accounts)),
display_cols => [ 'name', 'contact', 'arap_accno_id' ],
columns => [ 'arap_accno_id' ],
appname => 'sql-ledger',
table => 'vendor',
min_version => '2.7',
max_version => '3.0'
);
Expand Down Expand Up @@ -1019,7 +1036,7 @@ push @tests, __PACKAGE__->new(
);

push @tests, __PACKAGE__->new(
test_query => 'select partnumber, description, sellprice
test_query => 'select id, partnumber, description, sellprice
from parts where obsolete is not true
and partnumber in
(select partnumber from parts
Expand Down
1 change: 1 addition & 0 deletions sql/upgrade/sl2.8.sql
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
sl3.0.sql
Loading

0 comments on commit 8a92445

Please sign in to comment.