Merge develop for v1.3.1

Changes

@@ -1,5 +1,27 @@
 Revision history for Perl extension App::Sqitch
 
+1.3.1  2022-10-01T18:49:30Z
+     - Fixed a bug introduced in v1.3.0 where the Postgres engine would
+       always pass the port to `psql`, thus ignoring the `PGPORT` environment
+       variable. Thanks to Cam Feenstra for the spot (#675)!
+     - Fixed test failures on OSes where the local time zone cannot be
+       determined. Thanks to Slaven Rezić for the test reports, and to
+       Dave Rolsky for the solution (#672).
+     - Updated the MySQL deploy/revert lock to be specific to the target
+       database. This allows multiple instances of Sqitch to run at the
+       same time on the same server as long as they're connecting to different
+       databases. Thanks to Dmytro Kh for the report and discussion of the
+       options (#670).
+     - Fixed test failures where DBD::Mem was not installed. Likely only
+       occurred on some CPAN Testers nodes. Thanks to Slaven Rezić for those
+       (#673).
+     - Banned the backslash character (`\`) in change and tag names. It would
+       be ignored on Unix-style systems, but create unexpected subdirectories
+       on Windows systems.
+     - Banned the slash character (`/`) in tag names. They're still allowed
+       in change names to enable script organization, but can wreak havoc
+       when used in tag names. Thanks to @ewie for the report (#680)!
+
 1.3.0  2022-08-12T22:09:13Z
      - Fixed an issue when testing Firebird on a host with Firebird installed
        but no `isql`, and when using a local Firebird (e.g., the Engine12

README.md

@@ -1,4 +1,4 @@
-App/Sqitch version v1.3.0
+App/Sqitch version v1.3.1
 =========================
 
 | Release           | Coverage          | Database                              ||

dist.ini

@@ -2,7 +2,7 @@ name = App-Sqitch
 license = MIT
 copyright_holder = "iovation Inc., David E. Wheeler"
 copyright_year = 2012-2022
-version = v1.3.0
+version = v1.3.1
 
 [GatherDir]
 exclude_filename = dist/cpanfile
@@ -86,6 +86,9 @@ Time::Local = 0
 [Prereqs / DevelopSuggests]
 DBD::Oracle = 1.23
 
+[Prereqs / TestRequires]
+DBD::Mem = 0
+
 ;; Recommend author dependencies (dzil) in develop/recommends.
 [Prereqs::AuthorDeps]
 relation = recommends

dist/cpanfile

@@ -87,6 +87,7 @@ on 'build' => sub {
 on 'test' => sub {
   requires "Capture::Tiny" => "0.12";
   requires "Carp" => "0";
+  requires "DBD::Mem" => "0";
   requires "File::Find" => "0";
   requires "File::Spec" => "0";
   requires "File::Spec::Functions" => "0";

dist/sqitch.spec

@@ -1,5 +1,5 @@
 Name:           sqitch
-Version:        1.3.0
+Version:        1.3.1
 Release:        1%{?dist}
 Summary:        Sensible database change management
 License:        MIT
@@ -309,6 +309,9 @@ also be installed.
 # No additional files required.
 
 %changelog
+* Sat Oct 1 2022 David E. Wheeler <[email protected]> 1.3.1-1
+- Upgrade to v1.3.1.
+
 * Fri Aug 12 2022 David E. Wheeler <[email protected]> 1.3.0-1
 - Add Test::Exit build requirement.
 - Upgrade URI::db to v0.20.

lib/App/Sqitch/Engine/exasol.pm

@@ -78,6 +78,8 @@ has _exaplus => (
             }
         }
 
+        # Use _port instead of port so it's empty if no port is in the URI.
+        # https://github.com/sqitchers/sqitch/issues/675
         for my $spec (
             [ u => $self->username ],
             [ p => $self->password ],

lib/App/Sqitch/Engine/firebird.pm

@@ -241,6 +241,8 @@ sub connection_string {
         'Database name missing in URI {uri}',
         uri => $uri,
     );
+    # Use _port instead of port so it's empty if no port is in the URI.
+    # https://github.com/sqitchers/sqitch/issues/675
     my $host = $uri->host   or return $file;
     my $port = $uri->_port  or return "$host:$file";
     return "$host/$port:$file";

lib/App/Sqitch/Engine/mysql.pm

@@ -160,6 +160,8 @@ has _mysql => (
         ) unless $uri->dbname;
 
         my @ret  = ( $self->client );
+        # Use _port instead of port so it's empty if no port is in the URI.
+        # https://github.com/sqitchers/sqitch/issues/675
         for my $spec (
             [ user     => $self->username ],
             [ database => $uri->dbname    ],
@@ -311,24 +313,35 @@ sub begin_work {
     return $self;
 }
 
-# Override to try to acquire a lock on the string "sqitch working" without
-# waiting.
+# We include the database name in the lock name because that's probably the most
+# stringent lock the user expects. Locking the whole server with a static string
+# prevents parallel deploys to other databases. Yes, locking just the target
+# allows parallel deploys to conflict with one another if they make changes to
+# other databases, but is not a great practice and likely an anti-pattern. So
+# stick with the least surprising behavior.
+# https://github.com/sqitchers/sqitch/issues/670
+sub _lock_name {
+    'sqitch working on ' . shift->uri->dbname
+}
+
+# Override to try to acquire a lock on the string "sqitch working on $dbname"
+# without waiting.
 sub try_lock {
     my $self = shift;
     # Can't create a lock in the registry if it doesn't exist.
     $self->initialize unless $self->initialized;
     $self->dbh->selectcol_arrayref(
-        q{SELECT get_lock('sqitch working', 0)}
+        q{SELECT get_lock(?, ?)}, undef, $self->_lock_name, 0,
     )->[0]
 }
 
-# Override to try to acquire a lock on the string "sqitch working", waiting
-# for the lock until timeout.
+# Override to try to acquire a lock on the string "sqitch working on $dbname",
+# waiting for the lock until timeout.
 sub wait_lock {
     my $self = shift;
     $self->dbh->selectcol_arrayref(
-        q{SELECT get_lock('sqitch working', ?)},
-        undef, $self->lock_timeout
+        q{SELECT get_lock(?, ?)}, undef,
+        $self->_lock_name, $self->lock_timeout,
     )->[0]
 }
 

lib/App/Sqitch/Engine/oracle.pm

@@ -695,6 +695,8 @@ sub _script {
     my $self = shift;
     my $uri  = $self->uri;
     my $conn = '';
+    # Use _port instead of port so it's empty if no port is in the URI.
+    # https://github.com/sqitchers/sqitch/issues/675
     my ($user, $pass, $host, $port) = (
         $self->username, $self->password, $uri->host, $uri->_port
     );

lib/App/Sqitch/Engine/pg.pm

@@ -57,11 +57,13 @@ has _psql => (
 
         my %query_params = $uri->query_params;
         my @conninfo;
+        # Use _port instead of port so it's empty if no port is in the URI.
+        # https://github.com/sqitchers/sqitch/issues/675
         for my $spec (
             [ user   => $self->username ],
             [ dbname => $uri->dbname    ],
             [ host   => $uri->host      ],
-            [ port   => $uri->port      ],
+            [ port   => $uri->_port     ],
             map { [ $_ => $query_params{$_} ] }
                 sort keys %query_params,
         ) {

lib/App/Sqitch/Engine/snowflake.pm

@@ -98,6 +98,8 @@ has uri => (
 
         # Set defaults in the URI.
         $uri->host($self->_host($uri));
+        # Use _port instead of port so it's empty if no port is in the URI.
+        # https://github.com/sqitchers/sqitch/issues/675
         # XXX SNOWSQL_PORT deprecated; remove once Snowflake removes it.
         $uri->port($ENV{SNOWSQL_PORT}) if !$uri->_port && $ENV{SNOWSQL_PORT};
         $uri->dbname(

lib/App/Sqitch/Engine/vertica.pm

@@ -46,6 +46,8 @@ has _vsql => (
         my $self = shift;
         my $uri  = $self->uri;
         my @ret  = ( $self->client );
+        # Use _port instead of port so it's empty if no port is in the URI.
+        # https://github.com/sqitchers/sqitch/issues/675
         for my $spec (
             [ username => $self->username ],
             [ dbname   => $uri->dbname    ],

lib/App/Sqitch/Plan.pm

@@ -30,11 +30,13 @@ my $name_re = qr{
            [[:digit:]]+            #         digits
            (?:$|[[:blank:]])       #         eol or blank
        )                           #     ...
-       [^[:blank:]:@#]             #     match a valid character
+       [^[:blank:]:@#\\]           #     match a valid character
     )+                             # ... end non-capturing group
     (?<![$punct])\b                # last character isn't punctuation
 }x;
 
+my $dir_sep_re = qr{/};
+
 my %reserved = map { $_ => undef } qw(ROOT HEAD);
 
 sub name_regex { $name_re }
@@ -235,8 +237,8 @@ sub _parse {
             my $proj = $+{value};
             $raise_syntax_error->(__x(
                 qq{invalid project name "{project}": project names must not }
-                . 'begin with punctuation, contain "@", ":", "#", or blanks, or end in '
-                . 'punctuation or digits following punctuation',
+                . 'begin with punctuation, contain "@", ":", "#", "\\", or blanks, '
+                . 'or end in punctuation or digits following punctuation',
                 project => $proj,
             )) unless $proj =~ /\A$name_re\z/;
             $pragmas{project} = $proj;
@@ -316,7 +318,7 @@ sub _parse {
         # Raise errors for missing data.
         $raise_syntax_error->(__(
             qq{Invalid name; names must not begin with punctuation, }
-            . 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation',
+            . 'contain "@", ":", "#", "\\", or blanks, or end in punctuation or digits following punctuation',
         )) if !$params{name}
             || (!$params{yr} && $line =~ $ts_re);
 
@@ -352,6 +354,15 @@ sub _parse {
         );
 
         if ($type eq 'tag') {
+            # Faile if contains directory separators
+            if ($params{name} =~ qr/($dir_sep_re)/) {
+                $raise_syntax_error->(__x(
+                    'Tag "{tag}" contains illegal character {sep}',
+                    tag => $params{name},
+                    sep => $1,
+                ));
+            }
+
             # Fail if no changes.
             unless ($prev_change) {
                 $raise_syntax_error->(__x(
@@ -902,21 +913,20 @@ sub _is_valid {
         name => $name,
     ) if $name =~ /^[0-9a-f]{40}/;
 
-    unless ($name =~ /\A$name_re\z/) {
-        if ($type eq 'change') {
-            hurl plan => __x(
-                qq{"{name}" is invalid: changes must not begin with punctuation, }
-                . 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation',
-                name => $name,
-            );
-        } else {
-            hurl plan => __x(
-                qq{"{name}" is invalid: tags must not begin with punctuation, }
-                . 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation',
-                name => $name,
-            );
-        }
+    if ($type eq 'change' && $name !~ /\A$name_re\z/) {
+        hurl plan => __x(
+            qq{"{name}" is invalid: changes must not begin with punctuation, }
+            . 'contain "@", ":", "#", "\\", or blanks, or end in punctuation or digits following punctuation',
+            name => $name,
+        );
+    } elsif ($type eq 'tag' && ($name !~ /\A$name_re\z/ || $name =~ $dir_sep_re)) {
+        hurl plan => __x(
+            qq{"{name}" is invalid: tags must not begin with punctuation, }
+            . 'contain "@", ":", "#", "/", "\\", or blanks, or end in punctuation or digits following punctuation',
+            name => $name,
+        );
     }
+    return 1;
 }
 
 sub write_to {

lib/sqitchchanges.pod

@@ -16,8 +16,8 @@ L<C<sqitch log>|sqitch-log>, search the database for the change.
 =head2 Change Names
 
 A change name, such as that passed to L<C<sqitch add>|sqitch-add> and written
-to the plan file has a few limitations on the characters it may contain. The
-same limitations apply to tag names. The rules are:
+to the plan file, has a few limitations on the characters it may contain. The
+rules are:
 
 =over
 
@@ -43,7 +43,8 @@ Must not end in "~", "^", "/", "=", or "%" followed by digits.
 
 =item *
 
-All other characters may be any UTF-8 character other than ":", "@", and "#".
+All other characters may be any UTF-8 character other than ":", "@", "#",
+and "\".
 
 =back
 
@@ -102,6 +103,8 @@ Some examples of invalid names:
 
 =item C<foo:bar>
 
+=item C<foo\bar>
+
 =item C<+foo>
 
 =item C<-foo>
@@ -110,6 +113,19 @@ Some examples of invalid names:
 
 =back
 
+=head2 Tag Names
+
+A tag name, such as that passed to L<C<sqitch tag>|sqitch-tag> and written
+to the plan file, adhere by the same rules as L</Change Names> with one
+additional limitation: tags must not contain a slash character ("/").
+Example valid change name but invalid tag name:
+
+=over
+
+=item C<foo/bar>
+
+=back
+
 =head1 Specifying Changes
 
 A change parameter names a change object. It uses what is called an extended