Merge pull request #7648 from ehuelsmann/feature/factored-initial-data

Factor initial data out of schema SQL file
ledgersmb · Oct 8, 2023 · 32e4d25 · 32e4d25
2 parents f35f6a0 + ffafb89
commit 32e4d25
Show file tree

Hide file tree

Showing 9 changed files with 571 additions and 337 deletions.
diff --git a/doc/company-setup/initial-data.xsd b/doc/company-setup/initial-data.xsd
@@ -0,0 +1,67 @@
+<?xml version="1.0" encoding="UTF-8" ?>
+
+<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema"
+           targetNamespace="http://ledgersmb.org/xml-schemas/initial-data"
+           xmlns:t="http://ledgersmb.org/xml-schemas/initial-data"
+           xmlns="http://ledgersmb.org/xml-schemas/initial-data"
+           elementFormDefault="qualified">
+
+  <xs:annotation>
+    <xs:documentation>
+    </xs:documentation>
+  </xs:annotation>
+
+  <xs:complexType name="contact-classes">
+    <xs:sequence>
+      <xs:element name="class" minOccurs="0" maxOccurs="unbounded">
+        <xs:complexType>
+          <xs:attribute name="name" type="xs:string" use="required" />
+        </xs:complexType>
+      </xs:element>
+    </xs:sequence>
+  </xs:complexType>
+
+  <xs:complexType name="countries">
+    <xs:sequence>
+      <xs:element name="country" minOccurs="0" maxOccurs="unbounded">
+        <xs:complexType>
+          <xs:attribute name="code" type="xs:string" use="required" />
+          <xs:attribute name="description" type="xs:string" />
+        </xs:complexType>
+      </xs:element>
+    </xs:sequence>
+  </xs:complexType>
+
+  <xs:complexType name="languages">
+    <xs:sequence>
+      <xs:element name="language" minOccurs="0" maxOccurs="unbounded">
+        <xs:complexType>
+          <xs:attribute name="code" type="xs:string" use="required" />
+          <xs:attribute name="description" type="xs:string" />
+        </xs:complexType>
+      </xs:element>
+    </xs:sequence>
+  </xs:complexType>
+
+  <xs:complexType name="salutations">
+    <xs:sequence>
+      <xs:element name="salutation" minOccurs="0" maxOccurs="unbounded">
+        <xs:complexType>
+          <xs:attribute name="text" type="xs:string" use="required" />
+        </xs:complexType>
+      </xs:element>
+    </xs:sequence>
+  </xs:complexType>
+
+  <xs:element name="initial">
+    <xs:complexType>
+      <xs:sequence>
+        <xs:element name="contact-classes" minOccurs="0" maxOccurs="1" type="contact-classes" />
+        <xs:element name="countries" minOccurs="0" maxOccurs="1" type="countries" />
+        <xs:element name="languages" minOccurs="0" maxOccurs="1" type="languages" />
+        <xs:element name="salutations" minOccurs="0" maxOccurs="1" type="salutations" />
+      </xs:sequence>
+    </xs:complexType>
+  </xs:element>
+
+</xs:schema>
diff --git a/doc/conf/ledgersmb.yaml b/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/

diff --git a/lib/LedgerSMB/Database.pm b/lib/LedgerSMB/Database.pm
@@ -34,12 +34,16 @@ C<PGObject::Util::DBAdmin>.
 use strict;
 use warnings;
 
+use Carp;
 use DateTime;
 use DBD::Pg;
 use DBI;
 use File::Spec;
 use File::Temp;
 use PGObject::Util::DBAdmin 'v1.6.1';
+use Scope::Guard;
+use XML::LibXML;
+use XML::LibXML::XPathContext;
 
 use Moose;
 use namespace::autoclean;
@@ -83,6 +87,15 @@ to be the root of the LedgerSMB source tree.
 
 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');
+
 =head2 default_connect_options
 
 =cut
@@ -486,6 +499,84 @@ tag in the LOADORDER file will be applied (the main use-case being migrations).
 
 =cut
 
+sub _load_contact_classes {
+    my ($self, $dbh, $xpc) = @_;
+    my @nodes = $xpc->findnodes( './x:contact-classes/x:class' );
+    return unless @nodes;
+
+    my $sth = $dbh->prepare(
+        q|INSERT INTO contact_class (class) VALUES (?)|
+        ) or die $dbh->errstr;
+    for my $node (@nodes) {
+        my $atts = $node->attributes;
+        my @vals = (
+            $atts->getNamedItem( 'name' )->nodeValue,
+            );
+        $self->logger->tracef( 'Inserting contact class "%s"', @vals );
+        $sth->execute( @vals )
+            or die $sth->errstr;
+    }
+}
+
+sub _load_countries {
+    my ($self, $dbh, $xpc) = @_;
+    my @nodes = $xpc->findnodes( './x:countries/x:country' );
+    return unless @nodes;
+
+    my $sth = $dbh->prepare(
+        q|INSERT INTO country (short_name, name) VALUES (?, ?)|
+        ) or die $dbh->errstr;
+    for my $node (@nodes) {
+        my $atts = $node->attributes;
+        my @vals = (
+            $atts->getNamedItem( 'code' )->nodeValue,
+            $atts->getNamedItem( 'description' )->nodeValue
+            );
+        $self->logger->tracef( 'Inserting country code "%s"/"%s"', @vals );
+        $sth->execute( @vals )
+            or die $sth->errstr;
+    }
+}
+
+sub _load_languages {
+    my ($self, $dbh, $xpc) = @_;
+    my @nodes = $xpc->findnodes( './x:languages/x:language' );
+    return unless @nodes;
+
+    my $sth = $dbh->prepare(
+        q|INSERT INTO language (code, description) VALUES (?, ?)|
+        ) or die $dbh->errstr;
+    for my $node (@nodes) {
+        my $atts = $node->attributes;
+        my @vals = (
+            $atts->getNamedItem( 'code' )->nodeValue,
+            $atts->getNamedItem( 'description' )->nodeValue
+            );
+        $self->logger->tracef( 'Inserting language code "%s"/"%s"', @vals );
+        $sth->execute( @vals )
+            or die $sth->errstr;
+    }
+}
+
+sub _load_salutations {
+    my ($self, $dbh, $xpc) = @_;
+    my @nodes = $xpc->findnodes( './x:salutations/x:salutation' );
+    return unless @nodes;
+
+    my $sth = $dbh->prepare(
+        q|INSERT INTO salutation (salutation) VALUES (?)|
+        ) or die $dbh->errstr;
+    for my $node (@nodes) {
+        my $atts = $node->attributes;
+        my @vals = (
+            $atts->getNamedItem( 'text' )->nodeValue,
+            );
+        $self->logger->tracef( 'Inserting salutation "%s"', @vals );
+        $sth->execute( @vals )
+            or die $sth->errstr;
+    }
+}
+
 sub load_base_schema {
     my ($self, %args) = @_;
 
@@ -516,6 +607,24 @@ sub load_base_schema {
     die 'Base schema failed to load'
         if ! $success;
 
+    $dbh->disconnect;
+    $dbh = $self->connect();
+    my $guard = Scope::Guard->new(sub { $dbh->disconnect if $dbh; });
+    my $initial = File::Spec->catfile( $self->data_dir, 'initial-data.xml' );
+    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): $!";
+    $self->_load_contact_classes( $dbh, $xpc );
+    $self->_load_countries( $dbh, $xpc );
+    $self->_load_languages( $dbh, $xpc );
+    $self->_load_salutations( $dbh, $xpc );
+    $dbh->commit;
+    $dbh->disconnect;
+    $dbh = undef;
+
     if (opendir(LOADDIR, "$self->{source_dir}/on_load")) {
         while (my $fname = readdir(LOADDIR)) {
             $self->run_file(

diff --git a/lib/LedgerSMB/Database/Factory.pm b/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);
 }
 

diff --git a/lib/LedgerSMB/Database/Upgrade.pm b/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 });