Query selectable countries from 'initial-data.xml'

Since no schema has been created yet, the
upgrade procedure has no way to query which
countries are available for selection...

So instead of offering the full (translated)
list, offer the list that intersects with the
list of countries used to seed the schema.

doc/conf/ledgersmb.yaml

@@ -11,6 +11,8 @@ db:
   $class: LedgerSMB::Database::Factory
   connect_data:
     sslmode: prefer
+  data_dir:
+    $ref: paths/sql_data
   source_dir:
     $ref: paths/sql
 
@@ -81,6 +83,7 @@ paths:
   config:
     locale: ./locale/po/
     sql: ./sql/
+    sql_data: ./locale/
     templates: ./templates/
     UI: ./UI/
     UI_cache: lsmb_templates/

lib/LedgerSMB/Database.pm

@@ -89,6 +89,9 @@ has source_dir => (is => 'ro', default => './sql');
 
 =head2 data_dir
 
+Indicates the path to the directory which holds the 'initial-data.xml' file
+containing the reference and static data to be loaded into the base schema.
+
 =cut
 
 has data_dir => (is => 'ro', default => './locale');

lib/LedgerSMB/Database/Factory.pm

@@ -61,6 +61,18 @@ have been loaded. When none is provided, the default ('public') is assumed.
 
 has schema => (is => 'ro', default => 'public');
 
+=head2 data_dir
+
+Indicates the path to the directory which holds the 'initial-data.xml' file
+containing the reference and static data to be loaded into the base schema.
+
+The default value is relative to the current directory, which is assumed
+to be the root of the LedgerSMB source tree.
+
+=cut
+
+has data_dir => (is => 'ro', default => './locale');
+
 =head2 source_dir
 
 Indicates the path to the directory which holds the 'Pg-database.sql' file
@@ -97,6 +109,7 @@ sub instance {
             %args
         },
         schema     => $self->schema,
+        data_dir   => $self->data_dir,
         source_dir => $self->source_dir);
 }
 

lib/LedgerSMB/Database/Upgrade.pm

@@ -15,10 +15,15 @@ use warnings;
 use LedgerSMB::I18N;
 use LedgerSMB::Upgrade_Tests;
 
+use Carp;
+use File::Spec;
 use File::Temp;
-use List::Util qw( first );
+use List::Util qw( any first );
+use Log::Any qw( $log );
 use Scope::Guard qw( guard );
 use Template;
+use XML::LibXML;
+use XML::LibXML::XPathContext;
 
 use Moose;
 use namespace::autoclean;
@@ -51,6 +56,18 @@ my %migration_upto = (
 
 =head1 ATTRIBUTES
 
+=head2 data_dir
+
+Indicates the path to the directory which holds the 'initial-data.xml' file
+containing the reference and static data to be loaded into the base schema.
+
+The default value is relative to the current directory, which is assumed
+to be the root of the LedgerSMB source tree.
+
+=cut
+
+has data_dir => (is => 'ro', default => './locale');
+
 =head2 database (required)
 
 
@@ -178,8 +195,7 @@ my %migration_required_vars = (
 my %required_vars_values = (
     default_ar      => sub { _linked_accounts($_[1], 'AR') },
     default_ap      => sub { _linked_accounts($_[1], 'AP') },
-    default_country => sub {
-        LedgerSMB::I18N::get_country_list($_[0]->language) },
+    default_country => sub { _filtered_languages($_[0]) },
     slschema        => sub { $migration_schema{$_[0]->type} },
     );
 
@@ -210,6 +226,31 @@ sub _linked_accounts {
     return \@accounts;
 }
 
+sub _filtered_languages {
+    my $self = shift;
+    my $initial = File::Spec->catfile( $self->data_dir, 'initial-data.xml' );
+    my $langs = LedgerSMB::I18N::get_country_list($self->language);
+
+    open( my $fh, '<:bytes', $initial )
+        or croak "Failed to open schema seed data file ($initial): $!";
+    my $doc = XML::LibXML->load_xml( IO => $fh );
+    my $xpc = XML::LibXML::XPathContext->new( $doc->documentElement );
+    $xpc->registerNs( 'x', 'http://ledgersmb.org/xml-schemas/initial-data' );
+    close( $fh ) or carp "Failed to close seed data file ($initial): $!";
+
+    my @lang_codes = map {
+        my $atts = $_->attributes;
+        lc($atts->getNamedItem( 'code' )->nodeValue)
+    } $xpc->findnodes( './x:countries/x:country' );
+    return [
+        sort { $a->{text} cmp $b->{text} }
+        grep {
+            my $value = lc($_->{value});
+            any { $value eq $_ } @lang_codes
+        } @$langs
+    ];
+}
+
 sub required_vars {
     my ($self) = @_;
     my $dbh = $self->database->connect({ PrintError => 0, AutoCommit => 0 });