Merge pull request #34 from paulissoft/development

Development
paulissoft · Jun 12, 2022 · d1273fd · d1273fd
2 parents 3faedfe + b0e6249
commit d1273fd
Show file tree

Hide file tree

Showing 7 changed files with 236 additions and 107 deletions.
diff --git a/db/src/scripts/generate_ddl.pl b/db/src/scripts/generate_ddl.pl
@@ -165,6 +165,10 @@ =head1 HISTORY
 
 =over 4
 
+=item 2022-04-26
+
+Solved bug for objects named like "name" where name is not totally upper case.
+
 =item 2021-08-27
 
 Create the file in the output directory only when it is different from the
@@ -247,7 +251,6 @@ =head1 HISTORY
 use 5.016003; # Strawberry perl: 5.18.2, Jenkins server: 5.16.3
 
 use Carp;
-use Data::Dumper;
 use English;
 use File::Basename;
 use File::Compare;
@@ -269,7 +272,7 @@ =head1 HISTORY
 
 # VARIABLES
 
-my $VERSION = "2021-08-27";
+my $VERSION = "2022-04-26";
 
 my $program = &basename($0);
 my $encoding = ''; # was :crlf:encoding(UTF-8)
@@ -395,12 +398,14 @@ =head1 HISTORY
 sub remove_trailing_empty_lines ($);
 sub beautify_line ($$$$$$);
 sub split_single_output_file($);
+sub get_object_seq ($);
 sub add_object_seq ($;$);
 sub read_object_seq ();
 sub error (@);
 sub warning (@);
 sub info (@);
 sub debug (@);
+sub trace (@);
 
 # MAIN
 
@@ -409,15 +414,20 @@ =head1 HISTORY
 # SUBROUTINES
 
 sub main () {
+    trace((caller(0))[3]);
+
+    eval "use Data::Dumper; 1" or warn("Could not load Data::Dumper");
+
     info("\@ARGV: @ARGV");
     process_command_line();
     print_run_info(\*STDERR, 0);
 
     process();
 }
 
-sub process_command_line ()
-{
+sub process_command_line () {
+    trace((caller(0))[3]);
+
     # Windows FTYPE and ASSOC cause the command 'generate_ddl -h -c file'
     # to have ARGV[0] == ' -h -c file' and number of arguments 1.
     # Hence strip the spaces from $ARGV[0] and recreate @ARGV.
@@ -457,6 +467,8 @@ ()
 }
 
 sub process () {
+    trace((caller(0))[3]);
+
     my $install_sql = ($skip_install_sql ? undef : File::Spec->catfile($output_directory, 'install.sql'));
     my $in;
 
@@ -472,9 +484,9 @@ ()
     # These files are not needed anymore since the directory contents are used to determine the object sequence for interface V5
     unlink(File::Spec->catfile($output_directory, OLD_INSTALL_SEQUENCE_TXT),
            File::Spec->catfile($output_directory, NEW_INSTALL_SEQUENCE_TXT));
-    
+
     # always make the output directory
-    make_path($output_directory, { verbose => 0 });
+    make_path($output_directory, { verbose => $verbose > 0 });
 
     # turn autoflush on for both STDOUT and STDERR
     select(STDERR);
@@ -516,7 +528,7 @@ ()
         # read interface (first line with '-- ')
         #
         my $interface_expr = '^-- (' . PKG_DDL_UTIL_V4 . '|' . PKG_DDL_UTIL_V5 . ')$';
-        
+
       INTERFACE:
         while (defined(my $line = <$in>)) {
             print $fh $line
@@ -533,7 +545,7 @@ ()
         }
 
         $interface = '' unless defined($interface);
-        
+
         error("Unknown interface: $interface")
             unless ( $interface eq PKG_DDL_UTIL_V4 ||
                      $interface eq PKG_DDL_UTIL_V5 );
@@ -589,7 +601,9 @@ ()
         }
     }
 
-    debug(Data::Dumper->Dump([%sql_statements], [qw(sql_statements)]));
+    eval {
+        debug(Data::Dumper->Dump([%sql_statements], [qw(sql_statements)]));
+    };
 
     all_sql_statements_flush($fh_install_sql, \$fh, \$nr_sql_statements, \%sql_statements);
     smart_close($fh)
@@ -629,6 +643,8 @@ ()
 } # process
 
 sub process_object_type ($$$$) {
+    trace((caller(0))[3]);
+
     my ($object_type, $r_object_type_lines, $r_ddl_no, $r_sql_statements) = @_;
 
     debug("Process object type $object_type with $#$r_object_type_lines lines") if (defined($object_type));
@@ -702,6 +718,8 @@ ($$$$)
 }
 
 sub get_object_type_line ($$) {
+    trace((caller(0))[3]);
+
     my ($object_type, $r_object_type_lines) = @_;
 
     # Remove a block like this:
@@ -731,6 +749,8 @@ ($$)
 }
 
 sub parse_object($) {
+    trace((caller(0))[3]);
+
     my ($owner, $name) = ($source_schema, @_);
 
     if ($name =~ qr/(?<owner>$id_expr)\s*\.\s*(?<name>$id_expr)/) {
@@ -748,6 +768,8 @@ ($)
 }
 
 sub get_object ($$$;$$$) {
+    trace((caller(0))[3]);
+
     my ($object_schema, $object_type, $object_name, $base_object_schema, $base_object_type, $base_object_name) = @_;
 
     my $sep = ':';
@@ -781,6 +803,8 @@ ($$$;$$$)
 }
 
 sub object_file_name ($$$) {
+    trace((caller(0))[3]);
+
     my ($object_schema, $object_type, $object_name) = @_;
 
     if (length($source_schema) > 0 && $object_schema !~ m/^(PUBLIC|$source_schema)$/) {
@@ -802,13 +826,13 @@ ($$$)
     my $object_file_name;
     my $nr_zeros = ($interface eq PKG_DDL_UTIL_V4 ? 2 : 4);
 
-    if (!exists($object_seq{$object_seq_key})) {
+    if (!defined(get_object_seq($object_seq_key))) {
         add_object_seq($object_seq_key);
     }
     $object_file_name = 
         uc(sprintf("%s%0${nr_zeros}d.%s%s.%s", 
                    ($object_type_info{$object_type}->{'repeatable'} ? 'R__' : ''),
-                   ($interface eq PKG_DDL_UTIL_V4 ? $object_type_info{$object_type}->{'seq'} : $object_seq{$object_seq_key}),
+                   ($interface eq PKG_DDL_UTIL_V4 ? $object_type_info{$object_type}->{'seq'} : get_object_seq($object_seq_key)),
                    (${strip_source_schema} && $source_schema eq $object_schema ? '' : $object_schema . '.'),
                    $object_type,
                    $object_name)) . '.sql';
@@ -817,6 +841,8 @@ ($$$)
 }
 
 sub open_file ($$$$) {
+    trace((caller(0))[3]);
+
     my ($file, $fh_install_sql, $r_fh, $ignore_warning_when_file_exists) = @_;
 
     if (defined $fh_install_sql && !$install_sql_preamble_printed) {
@@ -845,6 +871,8 @@ ($$$$)
 }
 
 sub close_file ($$) {
+    trace((caller(0))[3]);
+
     my ($file, $r_fh) = @_;
 
     # close before comparing/copying/removing
@@ -858,6 +886,8 @@ ($$)
 
 # open file for writing
 sub smart_open ($;$) {
+    trace((caller(0))[3]);
+
     my ($file, $append) = @_;
     my $basename = basename($file);
     my ($tmpfile, $fh) = (File::Spec->catfile($TMPDIR, $basename));
@@ -872,6 +902,8 @@ ($;$)
 }
 
 sub smart_close ($) {
+    trace((caller(0))[3]);
+
     my $fh = shift @_;
 
     error("File handle unknown")
@@ -901,6 +933,8 @@ ($)
 }
 
 sub add_sql_statement ($$$$;$) {
+    trace((caller(0))[3]);
+
     my ($r_sql_line, $r_sql_statements, $object, $ddl_no, $ddl_info) = @_;
 
     debug("Adding '$$r_sql_line' for object $object and statement $ddl_no");
@@ -929,6 +963,8 @@ ($$$$;$)
 }
 
 sub sort_sql_statements ($$$) {
+    trace((caller(0))[3]);
+
     my ($r_sql_statements, $a, $b) = @_;
     my $result;
 
@@ -937,13 +973,16 @@ ($$$)
         $result = ($r_sql_statements->{$a}->{seq} <=> $r_sql_statements->{$b}->{seq});
     } else {
         # $object_seq{$a} and $object_seq{$b} will exists do to call to add_object_seq() in add_sql_statement()
-        $result = ($object_seq{$a} <=> $object_seq{$b});
+        debug(sprintf("get_object_seq('%s'); '%s'; get_object_seq('%s'): '%s'", $a, get_object_seq($a), $b, get_object_seq($b)));
+        $result = (get_object_seq($a) <=> get_object_seq($b));
     }
 
     return $result;
 }
 
 sub sort_dependent_objects ($$$) {
+    trace((caller(0))[3]);
+
     my ($object_type, $a, $b) = @_;
 
     if ($object_type eq 'OBJECT_GRANT') {
@@ -959,6 +998,8 @@ ($$$)
 }
 
 sub all_sql_statements_flush ($$$$) {
+    trace((caller(0))[3]);
+
     my ($fh_install_sql, $r_fh, $r_nr_sql_statements, $r_sql_statements) = @_;
 
     debug("Flushing all objects");
@@ -976,6 +1017,8 @@ ($$$$)
 }
 
 sub object_sql_statements_flush ($$$$$) {
+    trace((caller(0))[3]);
+
     my ($fh_install_sql, $r_fh, $r_nr_sql_statements, $r_sql_statements, $object) = @_;
 
     my $ignore_warning_when_file_exists = 0;
@@ -1084,6 +1127,8 @@ ($$$$$)
 } # object_sql_statements_flush
 
 sub sql_statement_flush ($$$$$$) {
+    trace((caller(0))[3]);
+
     my ($fh, $r_nr_sql_statements, $r_sql_statement, $object, $ddl_no, $ddl_info) = @_;
 
     debug("Flushing statement for $object with ", scalar(@$r_sql_statement), " line(s)");
@@ -1308,6 +1353,8 @@ ($$$$$$)
 }
 
 sub print_run_info ($$) {
+    trace((caller(0))[3]);
+
     my ($fh, $install) = @_;
 
     error("File handle must be defined") unless defined($fh);
@@ -1324,12 +1371,16 @@ ($$)
 }
 
 sub remove_cr_lf ($) {
+    trace((caller(0))[3]);
+
     my $r_line = $_[0];
 
     $$r_line =~ s/\r?\n//mg;
 }
 
 sub remove_leading_empty_lines ($) {
+    trace((caller(0))[3]);
+
     my $r_lines = $_[0];
 
   REMOVE_LEADING_EMPTY_LINES: {
@@ -1346,6 +1397,8 @@ ($)
 }
 
 sub remove_trailing_empty_lines ($) {
+    trace((caller(0))[3]);
+
     my $r_lines = $_[0];
 
   REMOVE_TRAILING_EMPTY_LINES: {
@@ -1362,6 +1415,8 @@ ($)
 }
 
 sub beautify_line ($$$$$$) {
+    trace((caller(0))[3]);
+
     my ($matched_object, $object_schema, $object_name, $object_type, $line_no, $r_line) = @_;
 
     return
@@ -1411,6 +1466,8 @@ ($$$$$$)
 }
 
 sub split_single_output_file ($) {
+    trace((caller(0))[3]);
+
     my $input_file = shift @_;
 
     # only one SQL statement allowed
@@ -1444,14 +1501,34 @@ ($)
     unlink($input_file);
 }
 
-sub add_object_seq ($;$) {
+sub get_object_seq ($) {
+    trace((caller(0))[3]);
+
     my ($object, $object_seq) = @_;
+
+    $object = uc($object);
+
+    error("Object '$object' must be in upper case")
+        unless $object eq uc($object);
+
+    return exists($object_seq{$object}) ? $object_seq{$object} : undef;
+}
 
+sub add_object_seq ($;$) {
+    trace((caller(0))[3]);
+
+    my ($object, $object_seq) = @_;
+
+    $object = uc($object);
+
+    error("Object '$object' must be in upper case")
+        unless $object eq uc($object);
+
     error("Object '$object' should match 'SCHEMA:TYPE:NAME'")
         unless $object =~ m/^.+:.+:.+$/;
-    
+
     error("Object sequence for '$object' already exists.")
-        if exists($object_seq{$object});
+        if defined(get_object_seq($object));
 
     if (defined($object_seq)) {
         # strip leading zeros otherwise it will be treated as an octal number
@@ -1471,6 +1548,8 @@ ($;$)
 }
 
 sub read_object_seq () {
+    trace((caller(0))[3]);
+
     my %objects;
 
     opendir my $dh, $output_directory or die "Could not open '$output_directory' for reading '$!'\n";
@@ -1505,3 +1584,8 @@ (@)
     print STDERR "DEBUG: @_\n"
         if ($verbose >= 2);
 }
+
+sub trace (@) {
+    carp "TRACE: @_\n"
+        if ($verbose >= 3);
+}
diff --git a/jenkins/Jenkinsfile b/jenkins/Jenkinsfile
@@ -4,6 +4,10 @@ pipeline {
     options {
         skipDefaultCheckout()
     }
+    tools {
+        maven pipelineConfig.maven
+        jdk pipelineConfig.jdk
+    }
     stages {
         stage("dev") {
             steps {