App-Sqitch-0.9996/000755 000767 000024 00000000000 13133201371 014031 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/bin/000755 000767 000024 00000000000 13133201371 014601 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/Build.PL000644 000767 000024 00000006702 13133201371 015332 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v5.037. use strict; use warnings; use Module::Build 0.35; use lib qw{inc}; use Module::Build::Sqitch; my %module_build_args = ( "build_requires" => { "Module::Build" => "0.35" }, "configure_requires" => { "Module::Build" => "0.35" }, "dist_abstract" => "Sane database change management", "dist_author" => [ "David E. Wheeler " ], "dist_name" => "App-Sqitch", "dist_version" => "0.9996", "license" => "mit", "module_name" => "App::Sqitch", "recommends" => { "Class::XSAccessor" => "1.18", "Pod::Simple" => "1.41", "Type::Tiny::XS" => "0.010" }, "recursive_test_files" => 1, "requires" => { "Clone" => 0, "Config::GitLike" => "1.11", "DBI" => 0, "DateTime" => "1.04", "DateTime::TimeZone" => 0, "Devel::StackTrace" => "1.30", "Digest::SHA" => 0, "Encode" => 0, "Encode::Locale" => 0, "File::Basename" => 0, "File::Copy" => 0, "File::HomeDir" => 0, "File::Path" => 0, "File::Temp" => 0, "Getopt::Long" => 0, "Hash::Merge" => 0, "IO::Pager" => 0, "IPC::Run3" => 0, "IPC::System::Simple" => "1.17", "List::MoreUtils" => 0, "List::Util" => 0, "Locale::Messages" => 0, "Locale::TextDomain" => "1.20", "Moo" => "1.002000", "Moo::Role" => 0, "POSIX" => 0, "Path::Class" => "0.33", "PerlIO::utf8_strict" => 0, "Pod::Escapes" => "1.04", "Pod::Find" => 0, "Pod::Usage" => 0, "Scalar::Util" => 0, "StackTrace::Auto" => 0, "String::Formatter" => 0, "String::ShellQuote" => 0, "Sub::Exporter" => 0, "Sub::Exporter::Util" => 0, "Sys::Hostname" => 0, "Template::Tiny" => "0.11", "Term::ANSIColor" => "2.02", "Throwable" => "0.200009", "Time::HiRes" => 0, "Time::Local" => 0, "Try::Tiny" => 0, "Type::Library" => "0.040", "Type::Utils" => 0, "Types::Standard" => 0, "URI" => 0, "URI::db" => "0.15", "User::pwent" => 0, "constant" => 0, "if" => 0, "namespace::autoclean" => "0.16", "overload" => 0, "parent" => 0, "perl" => "5.010", "strict" => 0, "utf8" => 0, "warnings" => 0 }, "script_files" => [ "bin/sqitch" ], "test_requires" => { "Capture::Tiny" => "0.12", "Carp" => 0, "File::Find" => 0, "File::Spec" => 0, "File::Spec::Functions" => 0, "FindBin" => 0, "Module::Runtime" => 0, "Path::Class" => "0.33", "Test::Deep" => 0, "Test::Dir" => 0, "Test::Exception" => 0, "Test::File" => 0, "Test::File::Contents" => "0.20", "Test::MockModule" => "0.05", "Test::More" => "0.94", "Test::NoWarnings" => "0.083", "lib" => 0 } ); my %fallback_build_requires = ( "Capture::Tiny" => "0.12", "Carp" => 0, "File::Find" => 0, "File::Spec" => 0, "File::Spec::Functions" => 0, "FindBin" => 0, "Module::Build" => "0.35", "Module::Runtime" => 0, "Path::Class" => "0.33", "Test::Deep" => 0, "Test::Dir" => 0, "Test::Exception" => 0, "Test::File" => 0, "Test::File::Contents" => "0.20", "Test::MockModule" => "0.05", "Test::More" => "0.94", "Test::NoWarnings" => "0.083", "lib" => 0 ); unless ( eval { Module::Build->VERSION(0.4004) } ) { delete $module_build_args{test_requires}; $module_build_args{build_requires} = \%fallback_build_requires; } my $build = Module::Build::Sqitch->new(%module_build_args); $build->create_build_script; App-Sqitch-0.9996/Changes000644 000767 000024 00000254111 13133201371 015330 0ustar00davidstaff000000 000000 Revision history for Perl extension App::Sqitch 0.9996 2017-07-17T18:33:12Z - Fixed an error where Oracle sometimes truncated timestamp formats so that date parsing failed. Thanks to Johann Wilfling for the report and @nmaqsudov for the solution (#316). - Added pager configuration, prioritizing the new `core.pager` configuration variable over the `$PAGER` environment variable. The new `$SQITCH_PAGER` environment variable trumps all. Thanks to Yati Sagade for the pull request (#329). - Documented the `core.editor` configuration variable. - Updated PostgreSQL registry detection to avoid errors when not running Sqitch as a superuser and the registry schema already exists. Done by looking for the `changes` table in the `pg_tables` view instead of looking for the registry schema in the `pg_namespace` catalog table, and by using `CREATE SCHEMA IF NOT EXISTS` on PostgreSQL 9.3 and higher. Thanks to @djk447 for the pull request (#307). - Updated PostgreSQL registry detection to avoid errors when the `psql` client is newer than the server version. Sqitch now fetches the version from the server instead of parsing it from the client. - Specifying a change before a target name on the command-line no longer ignores the target (#281). - The `--db-*` options are now more consistently applied to a target, including when the target is specified as a URI (#293). - `HEAD` and `ROOT` are now properly recognized as aliases for `@HEAD` and `@ROOT`, when querying the database. This was supposedly done in v0.991, but due to a bug, it wasn't really. Sorry about that. - The `revert` and `verify` commands will now fail if a change is specified and matches multiple changes. This happens when referencing a reworked change only by its name. In this case, Sqitch will emit an error listing properly tag-qualified changes to use. Suggested by Jay Hannah (#312). - Sqitch no longer returns an error when a target name is passed to a command and the default target's plan file does not exist (#324). - Added missing options to the `rework` usage statement. Thanks to Jay Hannah for the PR (#342). - Passing an engine name or plan file as the `` parameter to the `log`, `status`, and `upgrade` commands now works correctly, matching what the documention has said for some time (#324). - Added the `--target` option to the `plan` and `show` commands. - Added the `` parameter to the `plan` command. - Sqitch now loads targets from all config files, not just the local file, when trying to determine if a `` parameter is a plan file name. - Improved the error message when a change is found more than once in a plan, typically a reworked changed referenced only by name. The error will no longer be "Key at multiple indexes", but "Change is ambiguous. Please specify a tag-qualified change:", followed by a list of tag-qualified variants of the change. - Fixed a bug where the verify command would return a database error when it finds no registory. Now it reports that the registry wasn't found in the database. 0.9995 2016-07-27T09:23:55Z - Taught the `add` command not to ignore the `--change` option. - The `add` command now emits a usage statement when no change name is passed to it. - The `add` command now helpfully suggests using the --change option when attempting to add a change with the same name as a target. Thanks to Ivan Nunes for the report! - The `tag` command now helpfully suggests using the --tag option when attempting to add a tag with the same name as a target. - Added `--global` as an alias for `--user` to the `config` command. This alias benefits the muscle memory of Git users. - Added a note for Git users to the `sqitch-revert` documentation, to head off potential confusion with `git revert`. Thanks to Eric Bréchemier for the "time travel" analogy and wording. - Fixed an "uninitialized value" error when creating a registry database on Windows. Thanks to Steven C. Buttgereit for the report (Issue #289). - Fixed editor selection to prioritize the `core.editor` configuration variable over the `$EDITOR` environment variable. The `$SQITCH_EDITOR` environment variable still trumps all. Thanks to Jim Nasby for the pull request (#296). - Added detection of the `$VISUAL` environment variable to Editor selection, prioritzed after the `core.editor` configuration variable and before the `$EDITOR` environment variable. Thanks to Jim Nasby for the pull request (#296). - Updated the DateTime code to set the locale via `set_locale()` instead of `set()`, as the latter may actually change the local time unintentionally, and has been deprecated since DateTime v1.04. Thanks to Dave Rolsky for the pull request (#304). 0.9994 2016-01-08T19:46:43Z - Reduced minimum required MySQL engine from 5.1.0 to 5.0.0. Thanks to @dgc-wh for testing it (Issue #251). - Fixed floating-point rounding issue with SQLite registry versions on Perls with 16-byte doubles. Thanks to H. Merijn Brand for the report and testing. - Fixed an error when adding an engine with the `engine` command. Thanks to Victor Mours for the report and fix! - Updated the Oracle engine to support Oracle Wallet connection strings, where no username or host is in the connection URI. Thanks to Timothy Procter for the patch! - Improved the installer's selection of the prefix in which to install `etc` files to better match the `--installdirs` option, which defaults to the "site" directories. Thanks to @carragom for the pull request (#265). - Added missing dash to `-engine` in sample calls to `sqitch init` in the tutorials. Thanks to Andrew Dunstan for the spot (Issue #268). - Fixed broken Vertica documentation links. - Attempting to revert a database with no associated registry no longer reports the registry as version 0, but correctly reports that no registry can be found. Thanks to Arnaldo Piccinelli for the spot (Issue #271). - Fixed the search for change IDs in engines to match the search for changes. Specifically, change ID seaerch now properly handles the offset characters `~` and `^`. This bug mainly affected the `verify` command, but it's good to address the inconsistency, done mainly by adding the `find_change_id` and `change_id_offset_from_id` methods to complement the `find_change` and `change_offset_from_id` methods. Thanks to Andrew Dunstan for the spot (Issue #272). - Fixed the `flips` table example in the MySQL tutorial. It was inappropriately copied from the PostgreSQL tutorial at some point. Thanks to Jeff Carpenter for the spot (Issue #254)! 0.9993 2015-08-17T17:55:26Z [Bug Fixes] - Eliminated test failures due to warnings from DateTime::Locale when `LC_TIME` is set to C.UTF-8. Thanks to Shantanu Bhadoria for the report and Dave Rolsky for the workaround. - Fixed an error checking the registry version when the local uses a comma for decimal values. Thanks to Steffen Müller for the report (Issue #234). - Worked around an error setting the MySQL storage engine using versions of DBI prior to 1.631. Thanks to melon-babak for the report! - Fixed an error from the Oracle engine when deploying more than 1000 changes. Thanks to Timothy Procter and Minh Hoang for the report and testing the fix. - Fixed a bunch of typos in error messages, comments, and documentation. Thanks to Dmitriy for the pull request! - Fixed test failures due to new warnings from File::Path on Perl 5.23.1. - On Firebird, Looking up a change and tag in the database (via the `--onto` option to `rebase` or the `--to` option to `revert`, among others) would sometimes return the incorrect change if the change has been reworked two or more times. Was fixed for the other engines in v0.9991. - Fixed the `--all` option used to apply a command to all known targets so that it loads only targets specified by the local configuration. Otherwise, user and system configuration can get in the way when they specify engines and targets not used by the current project. [Improvements] - Added support for the `--set` option when deploying to MySQL. Thanks to Chris Bandy for figuring out how to do it! - Added support for a "reworked directory". By default, reworked change scripts live in the deploy, revert, and verify directories along with all the other change scripts. But if that starts to get too messy, or you simply don't want to see them, add a `reworked_dir` setting to the core, engine, or target config and reworked scripts will be stored there, instead. Also supported are `reworked_deploy_dir`, `reworked_revert_dir`, and `reworked_verify_dir`. - Added the `--dir` option to the `init`, `engine`, and `target` commands. - Copied the core configuration options (`--engine`, `--target`, `--plan-file`, `--registry`, etc.) to the `init`, `engine`, and `target` commands. This means that they can be specified after the command, which is a bit more natural. It also means that the `--registry` and `--client` options of the `target` are no longer deprecated. - The `init` command on longer writes out commented values for the `deploy_dir`, `revert_dir`, or `verify_dir` settings. I think these settings are not commonly used, and it would start to get crowded if we also added their "reworked" variants, which will be used still less. - Added the `alter` action to the `engine` and `target` commands to set engine and target properties. - Added support for setting reworked directories to the `engine` and `target` commands. - Reformatted the output of the `engine` and `target` command `show` actions to include reworked directories, and to bit a bit less flat. - Attempting to add or alter an engine with a target URI that connects to a different engine now triggers an error. For example, you can't set the target for engine `pg` to `db:sqlite:`. - The `add` and `alter` actions of the `engine` and `target` commands now create script directories if they don't already exist. - The `add` action of the `engine` and `target` commands now creates a plan file if one does not exist in the specified location for the engine or target. - Added the `deploy_dir`, `revert_dir`, and `verify_dir` methods to App::Sqitch::Plan::Change. Each points to the proper directory for the target depending on whether or not the change has been reworked. - In the MySQL engine, the following URI query params will be converted to options passed to the command-line client, if they're present: * mysql_compression=1 => --compress * mysql_ssl=1 => --ssl * mysql_connect_timeout => --connect_timeout * mysql_init_command => --init-command * mysql_socket => --socket * mysql_ssl_client_key => --ssl-key * mysql_ssl_client_cert => --ssl-cert * mysql_ssl_ca_file => --ssl-ca * mysql_ssl_ca_path => --ssl-capath * mysql_ssl_cipher => --ssl-cipher [Documentation] - Added the "Overworked" section to sqitch-configuration guide with an example of how to move reworked change scripts into a `reworked_dir`. [Deprecations] - Deprecated the `set-*` actions in the `engine` and `target` commands in favor of the new `alter` action. - The core `--deployed-dir`, `--revert-dir`, and `--verify-dir` options are deprecated in favor of the `--dir` option on the `init`, `engine`, and `target` command. 0.9992 2015-05-20T23:51:41Z - On PostgreSQL, Sqitch now sets the `client_encoding` parameter to `UTF8` for its own connection to the database. This ensures that data sent to and from the databse should always be properly encoded and decoded. Users should still set the proper encodings for change scripts as appropriate. - Fixed test failures due to path differences on Windows. - DateTime::TimeZone is now explicitly required in an attempt to head off "Cannot determine local time zone" errors. - Corrected some typos and thinkos in `sqitchtutorial-oracle`, thanks to George Hartzell. - Improved the script to upgrade an Oracle registry to v1.0 to support versions prior to Oracle 12, thanks to Timothy Procter. - Added missing closing parenthesis to the "Nothing to deploy" message. Thanks to George Hartzell for the pull request (Issue #226). - Replaced the unique constraint on the `script_hash` column in the `changes` registry table with a unique constraint on `project` and `script_hash`. This is to allow a deploy script to be used in more than one project in a single database. This change increments the registry version to v1.1. Thanks to Timothy Procter for the report. - Updated the registry check constraints to have consistent names on the engines that support them. This will make it easier to modify the constraints in the future. - Fixed precision issues with the registry version on MySQL and Firebird. - Added comment to sqitch-passwords guide that MySQL::Config is required to read passwords from the MySQL configuration files. Thanks to Sterling Hanenkamp for the patch! 0.9991 2015-04-03T23:14:39Z [Improvements] - Reduced minimum required MySQL engine from 5.6.4 to 5.1.0. Versions prior to 5.6.4 lose the following features: * Versions earlier than 5.6.4 is fractional second precision on registry `DATETIME` columns. Since the ordering of those timestamps is so important to the functioning of Sqitch, it will sleep in 100 ms increments between logging changes to the registry until the time has ticked over to the next second. Naturally, reverts and deploys will be a little slower on versions of MySQL before 5.6.4, but accurate. * Versions earlier than 5.5.0 lose the `checkit()` functions, which would otherwise be used to emulate CHECK constraints in the registry, as well as in user-created verify scripts, as recommended in the MySQL tutorial, `sqitchtutorial-mysql`. - Added a script to update the `DATETIME` columns in a MySQL Sqitch registry that was upgraded to MySQL 5.6.4 or higher. It will be installed as `tools/upgrade-registry-to-mysql-5.6.4.sql` in the directory returned by `sqitch --etc`. - Added a script to add the `checkit()` function and registry triggers to emulate CHECK constraints to a MySQL Sqitch registry that was upgraded to MySQL 5.5.0 or higher. It will be installed as `tools/upgrade-registry-to-mysql-5.5.0.sql` in the directory returned by `sqitch --etc`. - The `init` command now throws an error when the plan file already exists and is invalid or defined for a different project. Thanks to Gabriel Potkány for the suggestion (Issue #214). - All commands that take target arguments can now specify them as engine names or plan file paths as well as target names and URIs. - Added the `--all` option and the `$command.all` configuration variable to the `add`, `rework`, `tag`, and `bundle` commands. This option tells the commands to do their thing for all plans known from the configuration, not just the default plan. - Pass engine, target, or plan file names to the `add`, `rework`, `tag`, and `bundle` commands` commands to specify specify one or more targets, engines, and plans to act on. - Added the `--change` option to the `add`, `rework`, and `tag` commands to distinguish the change to be added, reworked, or tagged from plan-specifying arguments, if necessary. - Added the `--tag` option to the `tag` command to distinguish the tag to be added from plan-specifying arguments, if necessary. - Changed the short variant of the `--conflicts` option to the `add` and `rework` commands from `-c` to `-x`. The `-c` option is now used as the short variant for `--change` (and `--conflicts` has almost certainly never been used, anyway). - Added the `engine` and `project` variables to the execution of script templates by the `add` command. The default templates now use it to make their first lines one of: * -- Deploy [% project %]:[% change %] to [% engine] * -- Revert [% project %]:[% change %] from [% engine] * -- Verify [% project %]:[% change %] on [% engine] [Bug Fixes] - DateTime::TimeZone::Local::Win32 is now required on Windows. - The MySQL engine no longer passes `--skip-pager` on Windows, since it is not supported there. Thanks to Gabriel Potkány for the report (Issue #213). - Fixed "no such table: changes" error when upgrading the SQLite registry. - Fixed upgrade failure on PostgreSQL 8.4. Thanks to Phillip Smith for the report! - Fixed an error when the `status` command `show_changes` and `show_tags` configuration variables were set. Thanks to Adrian Klaver for the report (Issue #219). - Fixed `log` and `plan` usage statements to properly spell `--abbrev`. Thanks to Adrian Klaver for the report (Issue #220). - Fixed the formatting of change notes so that a space precedes the `#` character whether the note was added by the `--note` option or via an editor. - Fixed a bug when parsing plan files with DOS/Windows line endings. Thanks to Timothy Procter for the report (Issue #212). - Looking up a change and tag in the database (via the `--onto` option to `rebase` or the `--to` option to `revert`, among others) would sometimes return the incorrect change if the change has been reworked two or more times. Thanks to BryLo for the report! [Documentation] - Updated docs to be consistent in referring to the location of the system configuration and template location as `$(prefix)/etc/sqitch`. Also added notes pointing to the `--etc-dir` to find out exactly what that resolves to. Suggested by Joseph Anthony Pasquale Holsten (Issue #167). [Deprecations] - Reverted deprecation of the database connection options. Target URIs are still generally preferred, but sometimes you want to use a target but just change the user name or database name. Retaining the options is the easiest way to do this. Plus, a fair number of people have scripts that use these options, and it seems petty to break them. Sorry for the double-take here! The list of un-deprecated options is: * `--db-client` * `--db-host` * `--db-port` * `--db-username` * `--db-password` * `--db-name` 0.999 2015-02-12T19:43:45Z - Improved MySQL missing table error detection by relying on error codes instead of matching a (possibly localized) error string. - Made the registry upgrade more transparent when deploying. Sqitch is now is a little more vigilent in checking for things being out-of-date and updating them. - Fixed an issue where the `status` command would return an error when run against a an older version of the registry. - Fixed a Postgres test failure when DBD::Pg is installed but psql is not in the path. - Now require Config::GitLike 1.15 to build on Windows in order to avoid test failures when Cwd::abs_path dies on non-existant paths. - Clarified the behavior of each `deploy` reversion mode with regard to deploy script vs. verify script failures, and with the expectation that deploy scripts are atomic. - Target passwords can now be set via a single environment variable, `$SQITCH_PASSWORD`. Its value will override URI-specified password. - Added the sqitch-passwords and sqitch-environment guides. 0.998 2015-01-15T22:17:44Z - Fixed a bug in `sqitch engine update-config` where it would add data to config files that did not previously have them, or report that data was present in nonexistent config files. - Added the `releases` table to the databases. This table will keep track of releases of the Sqitch registry schema. - The Oracle `registry` variable is now always `DEFINE`d when Oracle scripts run. - Added the `upgrade` command, which upgrades the schema for the Sqitch registry for a target database. - Added the `script_hash` column to the `changes` registry table. This column contains a SHA-1 hash of the deploy script for the change at the time it was deployed. For existing registries, the upgrade script sets its value to be the same as the change ID. This value is update the next time a project is deployed to the database. - The error message when `deploy` cannot find the currently-deployed change ID in the plan now includes more contextual information, including the change name, associated tags, and the plan file name. Suggested by Curtis Poe (Issue #205). - Comments on Firebird registry objects are now created with the `COMMENT` command, rather than INSERTs into catalog tables. - Added support for "merge" events, though none are logged, yet. 0.997 2014-11-04T22:52:23Z [New Features] - Added support for new target properties. In addition to the existing `uri`, `client`, and `registry` properties, targets may also configure these properties via the new `--set` option to and `set-*` actions on the `target` command: * `top_dir` * `plan_file` * `extension` * `deploy_dir` * `revert_dir` * `verify_dir` - Added support for new engine configuration variables. In addition to the existing `target`, `client`, and `registry` variables, engine configuration may also include these variables: * `top_dir` * `plan_file` * `extension` * `deploy_dir` * `revert_dir` * `verify_dir` - Rationalized the hierarchical configuration of deployment targets. The properties of any given target will now be determined by examining values in the following order: * Command-line options * Target configuration * Engine configuration * Core configuration * Reasonable engine-specific defaults - Added the `engine` command to simplify engine configuration. This complements the newly-improved `target` command. Run `sqitch engine update-config` to update deprecated engine configurations and start using it. - Added the sqitch-configuration guide to provide an overview of core, engine, and target configuration. Includes some use-case examples and best suggested practices. [Improvements] - Simplified the output of `sqitch help`, and added the more important options to it. - Added the `--guide` option to `sqitch help` to list Sqitch guides. - Renamed the `--db-client` option to `--client`. `--db-client` still works, but is deprecated. - Added the `--registry` core option for parity with `--client`, `--top-dir`, `--plan-file`, and the rest of the hierarchical configuration properties. - Updated the `init` documentation to better cover all the options processed. - Incremented the version plan file format version to v1.0.0. No changes; it has been stable for at least a year, so it's time. [Bug Fixes] - At runtime, the Vertica engine now properly requires DBD::ODBC instead of DBD::Pg. - The Vertica engine now supports Vertica 6, as documented. - Fixed a warning from Type::Utils, thanks to a report from Géraud CONTINSOUZAS. - The `status` command once again notices if the specified database is uninitialized and says as much, rather than dying with an SQL error. - The `--etc-path` option works again. [Deprecations] - Deprecated `core.$engine` configuration in favor of `engine.$engine`. A warning will be emitted if Sqitch sees the former. Run `sqitch engine update-config` to update your configurations. Existing `core.$engine` configurations will be left in place for compatibility with older versions of Sqitch, but the `sqitch engine` command will not modify them, so they can get out-of-sync. Run `sqitch config --remove-section core.$engine` to remove them. - Formally deprecated the database connection options in favor of target URIs. If any of these options is used, a warning will be issued. They will be dropped in v1.0: * `--db-host` * `--db-port` * `--db-username` * `--db-password` * `--db-name` - Formally deprecated the database connection configuration variables in favor of target URIs. If any of these variables is used, a warning will be issued. Run `sqitch engine update-config` to update your configurations. Existing `core.$engine` configurations will be left in place for compatibility with older versions of Sqitch, but the `sqitch engine` command will not modify them, so they can get out-of-sync. Run `sqitch config --remove-section core.$engine` to remove them. Sqitch will cease to support them in v1.0: * `core.$engine.host` * `core.$engine.port` * `core.$engine.username` * `core.$engine.password` * `core.$engine.db_name` - Deprecated the `--registry` and `--client` options of the `target` command. All target properties should now be set via the new `--set` option, such as `--set registry=reg`. - Formally deprecated the following options of the `add` command. They have been replaced with the `--with`, `--without`, and `--use` options since v0.991. Their use will emit a warning, and they will be removed in v1.0: * `--deploy-template` * `--revert-template` * `--verify-template` * `--deploy` * `--no-deploy` * `--revert` * `--no-revert` * `--verify` * `--no-verify` - Dropped support for the long-deprecated (and likely never used outside ancient tests long deleted) engine configuration variables `core.sqlite.sqitch_db` and `core.pg.sqitch_schema`. Both have been replaced with `engine.$engine.registry`, which applies to all engines. - Formally deprecated the `@FIRST` and `@LAST` symbolic tags. Their use will trigger a warning to use `@ROOT` and `@HEAD`, instead. They will be removed in v1.0. [Internals] - Moved target and engine configuration from App::Sqitch and App::Sqitch::Engine to a new class, App::Sqitch::Target. This class is solely responsible for finding the appropriate values for attributes on every run. The target knows what plan and engine to use, based on those properties. App::Sqitch is now responsible solely for encapsulating command-line options, configuration, and utilities. Classes are now responsible for instantiating both an App::Sqitch and App::Sqitch::Target options as appropriate. - Updated all classes to create both Sqitch and Target objects as appropriate. This change touched almost every class. - Replaced attributes in App::Sqitch that were previously set from command-line options or configuration with a single attribute, `options`, which is a hash only of the command-line options. Classes are now responsible for finding the proper values in config or options. Mostly this requirement is encapsulated by the new App::Sqitch::Target class. - Updated the command classes to use either a "default target" derived from command-line options, engine configuration, and core configuration, or a target looked up by name in the configuration maintained by the `target` command. 0.996 2014-09-05T21:11:00Z - Fixed one more test failure due to the introduction of "Negative repeat count does nothing" warning in Perl 5.21.1. - Fixed "Redundant argument in printf" warning on Perl 5.21.2. - Switched from Digest::SHA1, which is deprecated, to Digest::SHA for generating SHA-1 IDs. - Switched from Mouse and Moose to Moo. Sqitch no longer depends on any modules that use Moose, either. This results in an approximately 40% startup time speedup. - Loading of App::Sqitch::DateTime is now deferred until it's needed. This is because DateTime is rather expensive to load. Since a number of commands don't need it, it seems silly to load it in those cases. - Now recommend Type::Tiny::XS and Class::XSAccessor for improved performance. - The `check` command now properly fails on a plan parse error, instead of blindly continuing on. - Fixed a failing test on PostgreSQL due to localization issues. Thanks to Sven Schoberf for the report (Issue #171). - Added the `revert.prompt_accept`, `rebase.prompt_accept`, and `checkout.prompt_accept` boolean configuration variables. Set these variables to false to change the default answer to the revert prompt to "No". When rebasing or checking out, if the variables specific to those commands are not set, Sqitch will fall back on the value of `revert.prompt_accept`. Suggested by Graeme Lawton (Issue #164). - The MySQL engine now sets the `$MYSQL_PWD` environment variable if a password is provided in a target. This should simplify authentication when running MySQL change scripts through the `mysql` client client (Issue #150). - The MySQL engine now reads `client` and `mysql` groups in the MySQL configuration files for a password when connecting to the registry database, and when the target URI includes no password. The MySQL client already read those files, of course, but now the internal database connection does as well (Issue #150). - The Firebird engine now sets the `$ISC_PASSWORD` environment variable if a password is provided in a target. This should simplify authentication when running Firebird change scripts through the `isql` client client. Patch from Ștefan Suciu. - No longer passing URI query params as DBI params, because they are already included in the DSN provided by URI::db. - Added the Vertica engine. 0.995 2014-07-13T22:24:53Z - Fixed test failures due to the introduction of "Negative repeat count does nothing" warning in Perl 5.21.1. - Fixed more test failures when DBD::Firebird is installed but Firebird isql cannot be found. - Fixed registry file naming issues on Win32 for the SQLite engine, and as well as the tests that failed because of it. - Worked around Config::GitLike bug on Windows in the target test. - Changed the exit value for an attempt to deploy to an up-to-date database from 1 to 0. In other words, it no longer looks like an error (Issue #147). 0.994 2014-06-20T02:58:10Z - Fixed installation failure due to missing IO::File module on Windows. - Fixed file test failure for the Oracle engine on Windows. - Fixed bug where namespace-autoclean: 0.16 caused errors such as "Invalid object instance: 'yellow'". - Fixed Oracle SQL*Plus capture test failure on Windows. 0.993 2014-06-04T20:14:34Z - Fixed engine loading to prefer the engine implied by the target URI over the `core.engine` configuration variable. This means that you no longer have to pass `--engine` when using commands that accept a target option or argument, such as `deploy`. - Fixed test failure when DBD::Firebird is installed but Firebird isql cannot be found. - Fixed issue where the revert command fails to execute the proper revert script. This can occur when a change has been reworked in the plan, but the reworked version of the change has not been deployed to the database. Thanks to Timothy Procter for the report (Issue #166). - Fixed issue with aggregating text values with `COLLECT()` on Oracle. Thanks to Timothy Procter for the digging and invocation of an Oracle support request (Issue #91). - Fixed issue where SQL*Plus could not run rework scripts because of the `@` in the file name. It now uses a symlink (or copied file on Windows) to circumvent the problem. Thanks to Timothy Procter for the report (Issue #165). - Fix issue where, on first deploy, the MySQL engine would fail to notice that the server was not the right version of MySQL. Thanks to Luke Young for the report (Issue #158). - Made the `checkit()` MySQL function DETERMINISTIC, to improve compatability with MariaDB. Thanks to Jesse Luehrs for the report (Issue #158). - Fixed deployment to PostgreSQL 8.4 so that it no longer chokes on the `:tableopts`. Thanks to Justin Hawkins for the report! 0.992 2014-03-05T00:34:49Z - Fixed target test failures on Windows. - Added support for Postgres-XC to the PostgreSQL engine. Sqitch registry tables are distributed by replication to all data nodes. - Added support to MariaDB 5.3 and higher to the MySQL engine, thanks to Ed Silva. 0.991 2014-01-16T23:24:33Z - Greatly simplified determining the Firebird ISQL client. It no longer tries so hard to find a full path, but does seach through the path list for a likely candidate between fbsql, isql-fb, and isql (or equivalents ending in .exe on Windows). - Removed a bunch of inappropriately pasted stuff from the Firebird tutorial, and updated it a bit. - `HEAD` and `ROOT` are now recognized as aliases for `@HEAD` and `@ROOT`, when querying the database, too. That means that `revert --to HEAD` now works the same as `revert --to @HEAD`, as had been expected in v0.990. - Eliminated "use of uninitialized value" warnings when database connections fail. - Reduced the minimum required DBD::Firebird to v1.11. - Fixed the `--verbose` option to the `target` command. - Eliminated more user-configuration issues in tests, thanks to chromatic. - Fixed test failures when the `$PGPASSWORD` environment variable is set, thanks to Ioan Rogers's test smoker. 0.990 2014-01-04T01:14:24Z [New Features] - Added new command and feature: `target`. Use it to manage multiple database targets, each with an associated URI and, optionally, a registry name and command-line client. Inspired by Git remotes. - Added Firebird engine. Three cheers to Ștefan Suciu for this contribution! - Added support for the generation of arbitrary scripts from templates to the `add` command. Just add template files to subdirectories of the `templates` directory, and scripts will be created in a directory of the same name based on those templates. - Added `--open-editor` option (and aliases) to the `add` and `rework` commands. This option will open the newly-added change scripts in the preferred editor. Thanks to Thomas Sibley for the patch! [Improvements] - Improved database driver loading to ensure the proper version of the driver is required. - Non-fatal but possibly unexpected messages -- which correspond to exit value 1 -- now send their messages to STDOUT instead of STDERR, and respect the `--quiet` option. Thanks to @giorgio-v for the report! - Added or replaced the `--target` option to commands that connect to a database to specify the name of target managed by the new `target` command or a database URI. - `HEAD` and `ROOT` are now recognized as aliases for `@HEAD` and `@ROOT`, respectively, since they are disallowed as change names, anyway, and folks often use them out of habit from Git. [Internals] - Replaced the engine-specific connection attributes with three attributes use by every engine: * `target`: The name of a target managed by the new `target` command. Defaults to a value stored for the `core.$engine.target` configuration variable. If that variable does not exist, the target falls back on the stringification of `uri`. * `uri`: a database URI with the format `db:{engine}:{dbname}` or `db:{engine}://{user}:{password}@{host}:{port}/{dbname}`. If its value is not passed to the constructor, a `uri` value is looked up for the associated `target`. If `target` is not passed or configured, or if it has no URI associated with it, the `config.$engine.uri` configuration variable is used. If that value does not exist, the URI defaults to `db:$engine:`. In any of these cases, if any of the `--db-*` options are passed, they will be merged into the URI. * `registry`: the name to use for the Sqitch registry schema or database, where Sqitch's own data will be stored, as appropriate to each engine. If its value is not passed to the constructor, a `registry` value is looked up for the associated `target`. If `target` is not passed or configured, or if it has no registry associated with it, the `config.$engine.registry` configuration variable is used. If no value is found there, it defaults to an engine-specific value, usually "sqitch". [Bug Fixes] - Fixed a bug when installing under local::lib. Thanks to Thomas Sibley for the pull request! - Eliminated "Wide character in print" warnings when piping the `log` command. - Documented that reworked changes do not have their verify tests run by the `verify` command. They do run when using the `--verify` deploy option. - Removed the documentation for the `add.with_deploy`, `add.with_revert`, and `add.with_verify` configuration variables, which were never implemented. [Deprecations] - Deprecated engine-specific connection attributes and configuration variables. See the "Internals" section for their replacements. The deprecated options are: * `core.$engine.username` * `core.$engine.password` * `core.$engine.db_name` * `core.$engine.host` * `core.$engine.port` * `core.$engine.sqitch_schema` * `core.$engine.sqitch_db` - Deprecated all command-specific options with the string "target" in them, such as `--to-target`, `--upto-target`, etc. They have been replaced with options containing the string "change", instead, such as `--to-change` and `--upto-change`. Few people used these options, preferring their shorter aliases (`--to`, `--upto`, etc.). - Deprecated the `--deploy-template`, `--revert-template`, and `--verify-template` options to the `add` command. They are replaced with a single option, `--use` which takes a key/value pair for the script name and template path. This makes it useful for arbitrary script generation, as well. - Deprecated the `--deploy`, `--revert`, and `--verify` options to the `add` command, as well as their `--no-*` variants. They are replaced with two new options, `--with` and `--without`, to which a script name is passed. These are useful for arbitrary script generation, as well. - Deprecated the `add.deploy_template`, `add.revert_template`, and `add.verify_template` configuration settings. They have been replaced with a section, `add.templates`, which is more general, and supports arbitrary script generation, as well. [Incompatibilities] - Removed the undocumented `--test` option to the `add` command. - Changed the meaning of `--target` from specifying a change to specifying a deployment target. Use the new `--change` option to specify a change. 0.983 2013-11-21T21:50:12Z - Fixed "Use of uninitialized value" in the MySQL engine. Thanks to Jean-Michel REY for the report. - All tests now protect against failures due to the presence of the `$SQITCH_CONFIG` environment variable (issue #114). - The installer now respects the `distdir` option to `Build.PL` when searching for existing templates. Important for packaging. - Fixed the error "Table 'sqitch.changes' doesn't exist" when deploying to a MySQL database that exists but has not been initialized. Thanks to Jean-Michel REY for the report! - Refactored the handling of the C<--log-only> option so it sets an engine attribute, rather than passing the flag to a whole stack of method calls. - Fixed "Argument "en_us" isn't numeric" error on Windows. - Now using `LC_ALL` instead of `LC_MESSAGES` when setting the locale, as the latter is not present on Windows. - The sqitch-pg RPM now requires DBD::Pg 2.0.0 or higher. - Improved handling of invalid command names so that the error message is less ambiguous when triggered by a Perl parse error. - Added `-m` as an alias for `--note`, for you Git folks out there. - Added exception handling to the Postgres and Oracle engines to avoid unexpected errors when deploying to a database that has not been deployed to before. - Updated detection of an uninitialized database to double-check with the engine that it really thinks it's uninitialized, not just that the "changes" table is missing. This should catch the case where the database has its own "changes" table unrelated to Sqitch. 0.982 2013-09-11T18:26:07Z - Errors thrown by Template toolkit are no longer silently ignored. - Variables passed to change templates are now cloned before the execution of each template. This prevents one template from deleting variable values another template might also need. - Fixed "The getpwnam function is unimplemented" errors on Win32. - No longer runs revert scripts when deploying with `--log-only` and a verify script fails, as that could lead to data loss (yikes!). Thanks to BryLo for the report (issue #112). 0.981 2013-09-06T00:22:26Z - Now use Encode::Locale to try to decode the user's full name from the system encoding when fetched from the system on all OSes. Note that this is not necessary if the `user.name` config is explicitly set, as recommended. Issue #107. - Removed the special-case handling of the user's full name fetched from the system on OS X. - Added call to `sleep` to test in an attempt to fix SQLite failures. - The SQLite engine now requires that the SQLite client be 3.3.9 or later, for support of the `-bail` option. - Bug fix: The MySQL engine now properly uses the host, port, and password options when connecting to the database. Thanks to vreb87 for the report! 0.980 2013-08-28T21:40:00Z - Changed the default SQLite Sqitch database name from `$dbname-sqitch.$suffix` to `sqitch.$suffix`. The `$suffix` still comes from the destination database name. This breaks compatibility with previous releases. If you need the old name, set it with `sqitch config core.sqlite.sqitch_db $dbname`. - Fixed encoding of the user's full name when fetched from the system on OS X. Thanks to Tomohiro Hosaka for the pull request! - Fixed test failures when DBD::SQLite is installed but compiled with SQLite 3.7.10 or lower. - Fixed a bug where declaring a dependency on a reworked change would incorrectly result in the error "Key "foo" matches multiple changes". Thanks to BryLo for the report (issue #103). - Modified tests to allow them to run in parallel without stomping on each other. - Bundling of options, such as `-vvv`, now works properly (issue #108). - Added alias `--get-regexp` for `--get-regex` to the `config` command. This brings it in line with the documentation for the `config` command (Issue #110). - Fixed all of the `config` command actions that contain a dash so that they actually work. Thanks to Ștefan Suciu for the report (issue #110). - All leading and trailing white space is now trimmed from plan notes, rather than just vertical white space. Thanks to Ronan Dunklau for the report (issue #106). - The `status` command now notices if the specified database is uninitialized and says as much, rather than dying with an SQL error (issue #109). - When reading the user's username from the system Sqitch now uses Encode::Locale to try to decode the value from the system encoding. Issue #107. - Compatibility change: Changed the location and name of script template files. Previously they were called `deploy.tmpl`, `revert.tmpl`, and `verify.tmpl`, and they lived in the `templates` subdirectory of the system-wide and user-specific configuration directories. They now live in subdirectories of the `templates` directory named for each action (deploy, revert, and verify), and with file names matching engine names (`pg.tmpl`, `sqlite.tmpl`, `oracle.tmpl`, and `mysql.tmpl`). The installer will move old files from the system-wide config directory (`sqitch --etc-path`) to their new homes, named `pg.tmpl` and `sqlite.tmpl`. It assumes no customizations exist for Oracle. If that's not true in your case, simply copy the `pg.tmpl` files to `oracle.tmpl`. - Added the `--template-name` option to the `add` command. By default, it looks for templates named for the current engine. The option allows for the user of task-specific templates. For example, if you create templates named `createtable.tmpl` in the `deploy`, `revert`, and `verify` subdirectories of `~/.sqitch/templates`, You can specify `--template-name createtable` to use those templates when adding a change. - Added the `--exists` option to the `show` command. - Fixed the `--set` option to the `add` command so that duplicate keys have their values passed to the template as an array, as documented. - If Template::Toolkit is installed, the `add` command will use it for processing templates instead of Template::Tiny. This makes it easy to upgrade the templating environment just by installing a module. 0.973 2013-07-03T13:47:22Z - Now Require DBD::SQLite compiled with SQLite 3.7.11 or higher. It always has, but now it throws a meaningful exception if an older version is compiled into DBD::SQLite. Thanks to Damon Buckwalter for the report. - When a deploy fails because of missing dependencies, the list of missing dependencies no longer contains duplicates. Thanks to Damon Buckwalter for the report. 0.972 2013-05-31T23:26:52Z - Fixed test failures on Windows. - Fixed locale configuration on Windows so that `sqitch` will actually run, rather than exiting with an error about `LC_MESSAGES` not being set. - Fixed a test hang on Windows when DBD::Oracle is installed but the Oracle libraries (`OCI.dll`) are not or cannot be found. This was triggering a UI dialog that did not dismiss itself. Using Win32::API to work around this issue. Thanks to Jan Dubois for the fix. 0.971 2013-05-18T21:08:51Z - Removed most uses of the smartmatch operator, since as of Perl 5.17.11 it is marked as experimental, and silenced the warning where it is still used. - Added 0.1s sleep between logging changes back-to-back in the engine tests, mostly to try to get SQLite to generate different timestamps. Pretty sure the recent test failures have been due to the passage of less than a millisecond between the two inserts. - Added the `shell` and `quote_shell` methods to Sqitch.pm for shelling out a command. - Sqitch now shells out to an editor when opening a file for the user to edit. For example, if the `$EDITOR` environment variable is set to `"emacs -nw"`, it will now work. Thanks to Florian Ragwitz for the report (issue #80). - Removed the pod-checking tests from the distribution. 0.970 2013-05-09T00:21:06Z - Fixed the default ordering of changes displayed by the `plan` command. They are now ascending by default. - Switched to PerlIO::utf8_strict for fast character encoding and decoding. - The help emitted when an unknown option is passed to `sqitch` now consists of a usage statement and brief table of options, rather than the entire man page. - Added the project name in a header to the output of the `plan` command. - Added the Oracle engine. - Added `sqitchtutorial-oracle.pod`, a Oracle-specific variant of `sqitchtutorial.pod`. - Added missing version declaration to the App::Sqitch::Plan::* modules. - Devel::StackTrace 1.30 is now properly required (it was previously recommended). - The `--show-tags` and `--show-changes` options to the `status` command now show the changes when the project plan cannot be found (issue #90). 0.965 2013-04-23T16:25:59Z - Fixed failing test due to line-ending character variations on Windows. Many thanks to Jan Dubois for the testing help. - Replaced all uses of `$/` in output to `"\n"`. Thanks to Jan Dubois for pointing out the incorrect use of `$/`. - Fixed build error that prevented installation on Perl 5.10 when the parent module was not installed. 0.964 2013-04-15T18:47:30Z - Fixed test failures on Perl versions lower than 5.14 when DBD::SQLite or DBD::Pg is not installed. - Removed DBD::SQLite from the list of build dependencies. - Fixed test failures due to encoded (wide-character) warnings on triggered on systems with non-english locales. Thanks to Alexandr Ciornii for the smoke testing that revealed this issue. - Removed overriding of Throwable's `previous_exception` in App::Sqitch::X on Throwable 0.200007 and higher, where it is no longer needed. - Changed test comparing file contents that fails on Windows to do a looser comparison and hopefully fix the test failure. 0.963 2013-04-12T19:11:29Z - Fixed a test failure when Git is in the execution path and the test is not run from a Git checkout. - Added `plan` to `sqitchchanges`, the contents of which are shown when Sqitch is run with no command. - Removed the unique constraint on tag names in the database, as it prevented two projects from having the same tag name. Replaced it with a unique constraint on the project and tag names. Folks with production PostgreSQL installs should run these queries: ALTER TABLE sqitch.tags DROP CONSTRAINT tags_tag_key, ADD UNIQUE(project, tag); COMMENT ON COLUMN sqitch.tags.tag IS 'Project-unique tag name.'; - Fixed failing tests when DBD::SQLite is not installed. - Removed dependency on Git::Wrapper. The `checkout` command does things very simply, and we already have tools for running command-line applications. So we just take advantage of that. The code is no more complicated than it was before. - Added the `core.vcs.client` configuration setting. Defaults to `git` (or `git.exe` on Windows). 0.962 2013-04-10T17:10:05Z - Fixed failing test on Perl 5.12 and lower. - Fixed the French translation by re-encoding it in UTF-8 (Ronan Dunklau). - Fixed the loading of the editor with placeholder text to properly encode that text as UTF-8 (Ronan Dunklau). 0.961 2013-04-09T19:21:15Z - Fixed error when running on PostgreSQL 9.0. - Added support for PostgreSQL 8.4. - Fixed the SQLite tests to skip the live tests when `sqlite3` cannot be found. - Fixed the Postgres tests to skip the live tests if `psql` cannot be found or cannot connect to the database. - Fixed the `checkout` test to skip tests that depend on Git and Git is not found in the path. - Fixed test failures on Windows (hopefully). - Made the order of commented configuration variables in the project configuration file deterministic. It will now always be the same order as specified by the engine class. This fixes test failures on Perl 5.17. - Fixed encoding issue that caused test failures on Perl 5.17. - Requiring Devel::StackTrace 1.30, as earlier versions can intermittently suppress errors. - Added hack to `App::Sqitch::X::hurl()` to work around a bug in Throwable that prevents `previous_exception` from being set half the time on v5.17. 0.960 2013-04-05T23:04:35Z - Removed `-CAS` from the shebang line on Perl 5.10.0. This is to eliminate `Too late for "-CAS" option` errors. This means that UTF-8 semantics will be suboptimal on Perl 5.10.0. Consider upgrading to 5.12 or higher. - Added the `checkout` command. Pass it the name of a VCS branch, and it will compare the plans between that branch and the current branch, revert to the last common change, check out the branch, and then redeploy. This makes it easy to switch between working branches that have different sets of commits. Git-only for now. Idea and code by Ronan Dunklau. - The `rebase` command no longer fails if the database is already reverted, but just makes a note of it and goes on to the deploy. - Added the `plan` command. It's like `log`, but shows a list of changes in the plan, rather than events recorded in the database. - Added `search_changes()` to Plan. Used by the `plan` command. - Added the `--oneline` option to the `log` command. - Allow tagging of an arbitrary change, not just the last change in the plan, by passing a change specification (name, ID, or tag) as the second argument to the `tag` command. - Updated error messages to note that blank characters are not allowed in project, change, or tag names. - Factored most of the engine-specific code into App::Sqitch::Role::DBIEngine. Future DBI-based engines should be able to use this role to handle most of the work. - Factored the live engine tests int `t/lib/DBIEngineTest`. Future DBI-based engines can use this module to do all or most of the live testing. - Added the SQLite engine. The Sqitch metadata is stored in a separate file from a database, by default in the same directory as the database file. - Added `sqitchtutorial-sqlite.pod`, a SQLite-specific variant of `sqitchtutorial.pod`. 0.953 2013-02-21T23:37:57Z - Fixed test failure in `t/engine.t` triggered by a clock tick. - Changed the verify template to end with `ROLLBACK` rather than `COMMIT`. This it to encourage folks to make no lasting changes in verify tests. - Fixed exception triggered on an attempt to revert or rebase `--to` a change that does not exist in the database. - Added recommendation for Pod::Simple to the build process. - Added the `--etcdir` build option to specify the directory in which configuration and template files should be installed. Defaults to the `etc/sqitch` subdirectory of the `--prefix`, `--install_base`, or Perl's prefix. - Added the `--installed_etcdir` build option. This is used to set the location of the system etc directory. Defaults to the value of `--etcdir`. - When building with `--prefix` or `--install_base`, and without `--etcdir`, the configuration files and tmeplates are now installed into `etc/sqitch` in that directory, rather than just `etc`. This is to enable packaging systems to move the directory to the proper location. 0.952 2013-01-12T00:02:54Z - Switched from Moose to Mouse whever possible. Speeds load and runtime 20-30%. Thanks to Michael Schwern for the pull request! 0.951 2013-01-08T00:21:58Z - Fixed double "@" displayed for tags in the output of `revert`. - Fixed reversion of reworked changes to run the original revert script, rather than the reworked script. - Added `is_reworked` accessor to App::Sqitch::Plan::Change. - Changed the behavior determining the file name to use for reworked change scripts. It now looks for a deploy script using the name of any tag between the reworked instances of a change and selects the first one it finds that exists. This will allow Sqitch to find the proper script name even if new tags have been added to the plan (issue #70). 0.950 2013-01-03T23:09:42Z - Fixed the "Name" header in `sqitch-rebase` so that it will actually show up on the CPAN search sites. - Fixed test failure triggered by the passage of time in `t/engine.t`. - At the start of a `deploy`, if the most recently deployed change has any unlogged tags (that is, tags added since the last `deploy`), they will be logged before the `deploy` continues (issue #60). - Added the `--no-log` option to `deploy`, `revert`, and `rebase`. This causes the changes to be logged as deployed without actually running the deploy scripts. Useful for an existing database that is being converted to Sqitch, and you need to log changes as deployed because they have been deployed by other means in the past. - Now check that dependencies are required for all changes to be deployed or reverted before deploying or reverting anything, rather than checking dependencies for each change just before deploying or reverting it. This allows a or revert deploy to fail sooner, with no database changes, when dependencies are not met. - The `deploy` command now checks that no changes its about to deploy are already deployed. - Added `--mode` to the `rebase` command. - Added the `--verify` option to `deploy` and `rebase`. Specify this option to run the verify script, if it exists, for each change after it is deployed. If the verify script dies, the deploy will be considered a failure and the requisite reversion (as specified for `--mode`) will begin. - Added the `verify` command, which verifies that a database is valid relative to the plan and each deployed change's verification scripts. - Changed the format of the list of changes output by `deploy` and `revert` so that each now gets "ok" or "not ok" printed on success or failure. - Added short aliases for commonly-used core options: * -f for --plan-file * -v for --verbose * -h for --db-host * -p for --db-port 0.940 2012-12-04T05:49:45Z - Fixed tests that failed due to I18N issues, with thanks to Arnaud (Arhuman) ASSAD! - Localized messages are now properly encoded in UTF-8. Thanks to Ronan Dunklau for the report (issue #46) and to Guido Flohr for details on how to address the issue. - The variables defined for the `add`, `deploy`, and `revert` commands now have the case of there names preserved if Config::GitLike 1.10 or later is installed. Thanks to Ronan Dunklau for the report (issue #48) and to Alex Vandiver for the case-preserving update to Config::GitLike. - Attempting to run `sqitch` with no command now outputs the list of supported commands (`sqitchcommands`), rather than the list of core options. Thanks to BryLo for the suggestion. - Changed the plan parser so that it no longer changes the order of changes based on the dependency graph. Unfortunately, this meant that the order could change from one run to another, especially if new changes were added since the last deploy. The planner now throws an exception if the order in the plan is wrong, and suggests that the user move changes in the plan file to get it to work properly. - Fixed bug where the `core.plan_file` configuration variable was ignored. - Improved error handling when deploying and reverting a change. If the change successfully deployed but the logging of the deployment to the database failed, there was just a rollback message. Sqitch will now emit the underlying error *and* run the revert script for the just-deployed change. - Modified the text hashed for change and tag IDs. Both now include the note, if present, the ID of the preceding change, and the list of dependencies. The result is that, when a change is modified or moved in the plan, it gets a new ID ID. The upshot is that things *must* be in order for a deploy to succeed. Existing deployments will automatically have their IDs updated by the `deploy` command. - Changed the `revert` command so that it *only* fetches information about changes to be reverted from the database, rather than the plan. - Deprecated the `@LAST` and `@FIRST` symbolic tags. With `revert` now fetching change information from the database, there is no longer a need to specify that changes be found in the database. It's possible some other way to search database changes will be added in the future, but if so, it will be less limiting than `@LAST` and `@FIRST`, because it will likely allow searches by literal tags. - Added the `rebase` command. This command combines a `revert` and a `deploy` into a single command, which should allow for more natural deployment testing during development. `sqitch rebase @HEAD^` should become a common command for database developers. - Duplicate values passed via `--requires` and `--conflicts` in the `add` and `rework` actions are now ignored. - The `add` command now throws an exception if `--template-directory` is passed or specified in the configuration file, and the specified directory does not exist or is not a directory. Thanks to Ronan Dunklau for the report! (Issue #52). - The `revert` command now prompts for confirmation before reverting anything. The prompt can be skipped via the `-y` option or setting the `revert.no_prompt` configuration variable. Works for rebase, too, which reads `rebase.no_prompt` before `revert.no_prompt`.' (Issue #49.) - Added the `show` command, which show information about changes or tags, or the contents of change script files. (Issue #57.) - Renamed the `test` scripts and planned command to `verify`. 0.938 2012-10-12T19:16:57Z - Added a primary key to the PostgreSQL `events` table, which should make it easier to support replication. 0.937 2012-10-09T21:54:36Z - Fixed the `--to` option to `deploy` and `revert`, which was ignored starting in v0.936. 0.936 2012-10-09T19:11:5Z2 - Added `--set` option to the `deploy` and `revert` commands. Useful for setting database client variables for use in scripts. Used by the PostgreSQL engine. - Merged the contents of `dist/sqitch-pg.spec` into a subpackage in `sqitch.spec`. This allows both RPMs are created from a single build process. Simplifies things quite a bit and improves the flexibility for adding other engines in the future. - Reduced required Perl version from 5.10.1 to 5.10.0. - Fixed inconsistent handling of command options with dashes where some were ignored. - The bundle command now properly copies scripts for changes with slashes in their names -- that is, where the scripts are in subdirectories. 0.935 2012-10-02T19:21:05Z - Updated `dist/sqitch-pg.spec` to require `postgresql` rather than "postgresql91". The version doesn't matter so much. - All known Windows issues and failures fixed, with many thanks to Randy Stauner for repeatedly running tests and supplying patches: - Fixed "'2' is not recognized as an internal or external command, operable program or batch file" error on Windows. - Fixed multiple errors detecting Windows. The OS name is "MSWin32", not "Win32". The test failure thus addressed was the setting of the DateTime locale. - Fixed failing tests that were incorrectly comparing subprocess errors messages on Windows - Fixed bug in `bundle` where a file would be re-copied even if the source and destination had the same timestamps, as they seem to do during tests on Windows. Patch from Randy Stauner. - Fixed failing test that failed to include `.exe` in a file name on Windows. Patch from Randy Stauner. - Added French translation, with thanks to Arnaud (Arhuman) ASSAD! 0.934 2012-09-28T16:43:43Z - Fixed typo in error handling that prevented an I/O error message from being properly emitted. 0.933 2012-09-27T18:04:53Z - The `init` command no longer fails if `--top-dir` does not exist. It creates it. - Yet another attempt to fix "List form of pipe open not implemented" bug on Windows. 0.932 2012-09-26T21:32:48Z - One more attempt to fix "List form of pipe open not implemented" bug on Windows. 0.931 2012-09-25T19:09:14Z - Now properly require Text::LocaleDomain 1.20. - Stubbed out French and German localization files. Translators wanted! - Added LocaleTextDomain dzil support (no impact on distribution). - Fix "List form of pipe open not implemented" bug on Windows by using Win32::ShellQuote to quote commands. 0.93 2012-08-31T22:29:41Z - Added forward and reverse change references. Append ^ to a change reference to mean the change before, or ~ to mean the change following. Use ~~ and ^^ to select two changes forward and back, and ~n and ^n, where n is an integer, to select that number of changes forward or back. Idea stolen from Git, though the meanings of the characters are different. - Added the @FIRST and @LAST symbolic references to refer to the first and last changes deployed to the database, respectively. These vary from the existing @ROOT and @HEAD symbolic references, which refer to the first and last changes listed in the plan. - Updated the tutorial to use the new symbolic references and ^ and ~ qualifiers where appropriate. - The messages output by the `deploy` and `revert` commands now show the resolved name of the `--to` target, rather than the value passed to `--to`. This is most useful when using a symbolic reference, so you can see what you're actually deploying or reverting to. 0.922 2012-08-30T17:41:59Z - Loosened constraint to disallow only `/[~^/=%]/` before digits at the end of name. This allows, for example, a tag to be named "v1.2-1". - Added the `bundle` command to the documentation displayed by `sqitch help`. - Updated the mention of the `bundle` command in the main `sqitch` documentation. 0.921 2012-08-30T00:09:56Z - Made Win32::Locale required only on Windows. - Fixed some module minimum version requirements so that dependencies will be properly listed in `Build.PL`. 0.92 2012-08-28T23:14:37Z - Added the `bundle` command. - Attempts to deploy a project with a different name or URI than previously registered now throws an exception. - Added UNIQUE constraint to `projects.uri` in the PostgreSQL Sqitch schema. - Added ON UPDATE actions to foreign key constraints in the PostgreSQL Sqitch schema. 0.913 2012-08-28T17:31:29Z - Fixed oversight in test that still relied on `$ENV{USER}` instead of `Sqitch->sysuser`, 0.912 2012-08-27T21:23:19Z - Fall back on `Sqitch->sysuser` when looking for the PostgreSQL user, rather than just `$ENV{USER}`. The method does a lot more work to find the system user name. This will hopefully also fix test failures on systems where `$ENV{USER}` is not set. - Use Win32::Locale to set the locale on DateTime objects on Windows. 0.911 2012-08-23T19:19:17Z - Fixed more platform-specific test failures in `t/base.t`. - Increased liklihood of finding a user's full name on Windows. Thanks to H. Merijn Brand for testing. 0.91 2012-08-23T00:37:36Z - Moved `requires` and `conflicts` array columns from the `changes` table to an new table, `dependencies`, where there is just one per row. - Requirements are now checked before reverting a change. If the change is depended on by other changes, it will not be reverted (Issue #36). - Fixed bug where the `status` command would show changes and/or tags from other projects when `--show-tags` or `--show-changes` were used. - Fixed test failures on Windows. - Added more ways to look up the current username to minimize the chances that none is found. - Added Windows-specific way of finding the current user's full name, since the existing approach died on Windows. - Windows-specific modules are no longer required, but are recommended on Windows. They will be listed by `./Build` and added to the "recommends" section of the the generated `MYMETA.*` files on Windows. - Fixed a bug where dependencies on other projects would be rejected in calls to `add` and `rework`. 0.902 2012-08-20T21:14:08Z - Fixed another occasional test failure due to a clock tick in `t/pg.t.` - Fixed test failures in `t/status.t` on systems without DBD::Pg. 0.901 2012-08-20T19:31:03Z - Fix test failure in `t/status.t` caused by failing to ignore a pre-existing `~/.sqitch/sqitch.conf` configuration file. - Eliminated "Use of uninitialized value in length" warnings. 0.90 2012-08-18T00:05:41Z - Added `dist/sqitch.spec`. This file was created to generate an RPM for CentOS 6.1. - Added `dist/sqitch-pg.spec` to use for creating RPMs for Sqitch with PostgreSQL support. - Fixed an occasional test failure due to a clock tick in `t/pg.t.` - Switched to Dist::Zilla for creating the distribution. For end-users, this just means that `Build.PL` is now a generated file. - Required module versions are now declared in code. This is so that they are enforced at runtime, and also so that they will be picked up by Dist::Zilla for inclusion in the generated `Build.PL` and `META` files.x - Added support for declaring dependencies (required and conflicting changes) from other Sqitch projects. This allows one project to depend on changes from another. The syntax is `--requires $projname:$change`. This use of the colon required a few changes to the Plan syntax: + Pragmas may now appear only in the first "header" section of the plan, separated from the changes in the "body" of the plan by a blank line. + Required dependencies no longer begin with ":". Conflicts still must begin with "!". + Object names may no longer contain ":", as it is used for project specification. + Project-qualified dependencies are supported by the project name appearing before the change name, separated by a colon. - Added App::Sqitch::Plan::Depend, an object to parse, represent, and serialize dependencies. - The plan parser does not validate changes required from other projects, as it has no access to the plans from those projects. - The engine interface validates cross-project dependencies before deploying changes. - Project data is not included in the Sqitch metadata tables in the database. There is a table for all known projects, as well as foreign key references in the `changes`, `tags`, and `events` tables. - Project information is now displayed in the output of `sqitch status` and `sqitch log` (in some formats). - Added `--project` option to `sqitch status` to identify the project for which to display the status. Defaults to the current project, if there is one, or to the project in the database, if there is only one registered project. - Added `--project` option to `sqitch log` to allow searching for events from projects matching a regular expression. - Now require Config::GitLike 1.09 for its improved character encoding support. - Dependencies can now be declared as SHA1 hash IDs, including for IDs from other projects. - Fixed change and tag name validation to count "_" as a non-punctuation character, and therefore able to be used at the beginning or end of names. - Replaced the `appuser` change in `sqitchtutorial` with `appschema`. This simplifies things, since users are global objects in PostgreSQL, while schemas are not. As a result, a bunch of irrelevant code was removed from the tutorial. 0.82 2012-08-03T21:25:27Z - Now require Moose 2.0300, since MooseX::Role::Parameterized, which requires Role::HasMessage, requires it, anyway, - Fixed test failure in `t/pg.t` when running on Test::More 0.94. - Require POSIX in `t/datetime.t` to fix test failure with CentOS 6 Perl. Not sure why it did not fail anywhere else, but it's harmless enough to make sure it's loaded early. 0.81 2012-08-03T11:34:46Z - Removed wayward `/l` from a regular expression, which breaks Perls earlier than 5.14, and is not needed anyway. - Fixed error in `log` that caused invalid output on Perls earlier than 5.14. Seems that `return` is required for `when` statements meant to return a value, and postfix `when` is not supported in Perl 5.10. 0.80 2012-08-01T21:54:00Z - Added the `log` command to `sqitchcommands.pod`, which is shown as the output of `sqitch help`. - Added `user.name` and `user.email` configuration variables. - Now using `user.name` and `user.email`, rather than the system or database user name, to log the user committing changes to a database. - Database-specific options are now prefixed with `--db-`. - Added "raw" format to App::Sqitch::DateTime. It is ISO-8601 format in UTC. - Modified the "raw" log format to use the raw DateTime format. - Added timestamp and planner info to the plan. This is additional metadata included in every change and tag: The planner's name and email address and the current timestamp. This makes it easier to audit who added changes to a plan and when. - Added the `--note` option to the `add`, `rework`, and `tag` commands. - For consistency throughout, renamed all attributes and options from "message" and "comment" to "note", which is shorter and better reflects their purpose. - The planner's name and email address, as well as the plan time and note, are now stored in the database whenever changes or tags are committed and logged. - Renamed various database columns to be more consistent, with the terms "commit", "plan", and "note". - Added `requires` and `conflicts` columns to the events table, so that they can become available to the `log` command. - Various `log` format changes: * Renamed %n (newline) to %v (vertical space) * Renamed %c to %n (change name) * Replaced %a (committer name) with %c (committer info). It takes an optional argument: + "name" or "n" for committer name + "email" or "e" for committer email + "d" or "date" for commit date + "d:$format" or "date:$format" for formatted commit date * Added %p (planner info). It takes an optional argument just like "%c" does: + "name" or "n" for planner name + "email" or "e" for planner email + "d" or "date" for plan date + "d:$format" or "date:$format" for formatted plan date * Added special argument to "%C", `:event", which returns a color based on the value of the event type: + Green for "deploy" + Blue for "revert" + Red for "fail" * Added "%r" and "%R" for lists of required changes. * Added "%x" and "%X" for lists of conflicting changes. * Added "%a" to display an unlocalized attribute name and value. * Added "planner", "committer", "planned", and "email" arguments to %_. * Documented that the dates can take CLDR or strftime formats, too. * Added the %s, %b, and %B format for "subject", "body", and raw body akin to Git. The values are taken from the note value, if available. * Added committer email addresses to default formats. * Added plan data to default formats. * Added note data to default formats. * Added lists of required and conflicting changes to the "raw" and "full" formats. * Switched to event-driven colors for event types and change IDs in default formats. * Added color to the event type and change ID output in the "raw" format. - Added detailed descriptions of the default formats to `sqitch-log.pod`. - Updated the Change object to encode and decode vertical whitespace in a note, so that all data remains on a single line for each object in the plan file. - Now require a note when adding, reworking, or tagging a change. If `--note` is not specified, an editor will be launched and the user prompted to write a note. This is similar to how `git commit` behaves, and encourages documentation of changes. - Added required "project" and optional "uri" pragmas to the plan. - Added `--project` and `--uri` attributes to the `init` command. - Removed the `core.uri` configuration variable and corresponding core `--uri` option (since it has been replaced with the `init` command's `--uri` option. - Command-line arguments are now all assumed to be UTF-8, and are parsed as such. - Added workaround to force the configuration file to be written and read as UTF-8. Requires an unreleased version of Config::GitLike to actually work properly. - Text passed to a pager (as when running `sqitch log`) is now encoded in UTF-8. - Fixed `--quiet` option so that it properly trumps `--verbose`. 0.71 2012-07-12T15:30:27Z - Updated the example `sqitch log` output in `sqitchtutorial`. - Changed the terms "actor", "agent" to "committer" throughout the API and output. - Renamed the `events` table columns from `logged_at` and `logged_by` to `committed_at` and `committed_by`. 0.70 2012-07-12T13:24:13Z - Changed the `current_changes()` and `current_tags()` Engine methods so that they return iterator code references instead of lists. - Added the `search_events()` Engine method, to search the event log. - Added the `pager` attribute and `page()` methods to App::Sqitch. - Added support for `strftime:` and `cldr:` options to the `status` command's `--date-format` option. - Added the `log` command. - Added the `strftime:$string` and `cldr:$string` options to `--date-format` in the `status` and `log` commands. 0.60 2012-07-07T11:12:26Z - Removed some discussion of VCS integration, since it is not yet implemented, and it may be a while before it is. - Added `sqitchcommands`, documentation of the most common Sqitch commands, and fixed `--help` to show it. - Fixed `--man` to show the sqitch command documentation. - Fixed error handling for unknown commands, so that it displays a message saying the command is unknown, rather than a stack trace. - Adding a change after a tag now also inserts a blank line into the plan between the tag and the new change, for nicer plan file formatting. - Added the `status` command. - Added App::Sqitch::DateTime, a DateTime subclass with named formats. 0.51 2012-07-04T18:34:07Z - Added Role::HasMessage to the list or requirements in `Build.PL`. Was an oversight that it was omitted in v0.50. - Removed the `--dry-run` option. It was completely ignored. Maybe it will return someday. - Removed `fail()`, `bail()`, `unfound()`, and `help()`. It's better for commands not to exit, so have them throw exceptions in the appropriate places, instead. - Replaced all uses of Carp and non-exception handling uses of `die` with our own localized exceptions. - Localized all output and exception messages. 0.50 2012-07-03T19:55:20Z - Require a plan file. - Renamed "steps" to "changes". - New plan file spec. + Tags are just labels on a particular change, no longer a list of changes. + Dependencies now specified in the plan file, not in the deploy script. + Changes can be specified as deploys or reverts, though reverts are not currently supported. + Changes can be specified with an optional leading `+` for deploy or `-` for revert, which will eventually be important for conflict management. + Dependencies can be specified as other change names, tags, or a change as of a tag (e.g., `foo@beta`). + Pragmas can be specified with a leading `%`. Only `%syntax-version` is currently recognized; all others are ignored. - Renamed the `add-step` command to just `add`. - Added the `tag` command. - Added the `revert` command. - Added the `rework` command. - Added exception objects and started using them. - Added localization support and started using it. - Added IDs to changes and tags. These are SHA1s generated from the return value of the new `info` method, which describes the change or tag. - Updated the PostgreSQL engine to comply with the new Engine API. - Updated the PostgreSQL engine to use IDs for tracking changes and tags. - Eliminated the term "node" from the plan implementation and docs. - Updated the engine base class for the new plan API, and to just deploy changes one-at-a-time. - Added many new ways to look for changes in the plan, including: + `change_name` + `@tag_name` + `change_name@tag_name` + `change_id` + `tag_id` - The plan file can now be written out with nearly all white space and comments preserved. - Changed the `add` command to write out the plan file after a new change is added. - Change names can now be duplicated, as long as a tag name appears between them. - Renamed `target` to destination in Engine. - Started referring to the change to deploy or revert to in docs as the "target". - PostgreSQL errors will now be thrown as Sqitch exceptions, for proper handling during command execution. - Added required `core.uri` configuration setting. Used to keep change IDs unique across projects. - Added `--mode` option to `deploy`, to trigger reverts on failure to either: + Not at all: keep the latest successful change. + To the last deployed tag + To the point at which the current deploy started - Added the implicit tags `@ROOT` and `@HEAD` for looking up changes in the plan. - Renamed `sql_dir` to `top_dir` and made it default to the current directory. - Changed the location of the plan file to the top directory. This will make it easier to have plans and scripts for multiple database platforms in a single project. - Fixed a bug in the build process so that template files will be properly written to the `etc` directory. - Rewrote `sqitchtutorial` to reflect the new realities. - Updated `sqitch` documentation, and moved the plan file information to App::Sqitch::Plan. 0.31 2012-05-21T22:29:42Z - Fixed some typos and failing tests. 0.30 2012-05-18T15:43:12Z - The `init` command now properly writes out the `[core]` section header when there are only commented core settings. - The `--requires` and `--conflicts` options to `add` now work properly. - Fixed anticipated Win32 test failures in `t/init.t`.' - Fixed the `--plan-file`, `--top-dir`, and other directory options so that they no longer throw errors, but actually work. - Implemented the plan parser. It's designed to later be subclassed to support VCS integration. Includes dependency parsing and sorting. - Switched to IPC::System::Simple instead for system/capture code. - Implemented Engine interface for deploying and reverting tags. - Implemented PostgreSQL engine. It uses a lock to ensure that only one deployment can run at any time. - Added the `deploy` command. it is now possible to deploy to a PostgreSQL database. 0.20 2012-05-01T02:48:47Z - Added `--local` option to `sqitch config`. - Renamed `project_file()` to `--local_file()` in App::Sqitch::Config. - `sqitch init` now writes core and engine config settings with default values to the configuration file. This makes it easier for folks to get started editing it. - Implemented `add` command. Includes support for system-wide or use-specific templates using Template::Tiny. - Added `etc` directory with default templates. This is installed into `$Config{prefix}/etc/skitch`, unless built with `--prefix` or `--install_base`, in which case it will simply be installed into `etc` in that directory. - Added `--etc-path`, so that one can know where the system-wide configuration and templates are to be found. 0.11 2012-04-27T06:44:54Z - Implemented `init` command. - Started sketching out the engine interface, with preliminary PostgreSQL and SQLite implementations. - Require Perl v5.10.1 (did before, but in the wrong place, so it was ignored). - Fixed test failures on different verions of Moose. - Fixed test failure on Perl 5.12. 0.10 2012-04-25T20:46:59Z - Initial unstable release. - Implemented `help` command. - Implemented `config` command, very similar to `git-config`. App-Sqitch-0.9996/dist/000755 000767 000024 00000000000 13133201371 014774 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/etc/000755 000767 000024 00000000000 13133201371 014604 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/inc/000755 000767 000024 00000000000 13133201371 014602 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/lib/000755 000767 000024 00000000000 13133201371 014577 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/LICENSE000644 000767 000024 00000002212 13133201371 015033 0ustar00davidstaff000000 000000 This software is Copyright (c) 2017 by "iovation Inc.". This is free software, licensed under: The MIT (X11) License The MIT License Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. App-Sqitch-0.9996/MANIFEST000644 000767 000024 00000014225 13133201371 015166 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.037. Build.PL Changes LICENSE MANIFEST META.json META.yml README README.md bin/sqitch dist/sqitch.spec etc/templates/deploy/firebird.tmpl etc/templates/deploy/mysql.tmpl etc/templates/deploy/oracle.tmpl etc/templates/deploy/pg.tmpl etc/templates/deploy/sqlite.tmpl etc/templates/deploy/vertica.tmpl etc/templates/revert/firebird.tmpl etc/templates/revert/mysql.tmpl etc/templates/revert/oracle.tmpl etc/templates/revert/pg.tmpl etc/templates/revert/sqlite.tmpl etc/templates/revert/vertica.tmpl etc/templates/verify/firebird.tmpl etc/templates/verify/mysql.tmpl etc/templates/verify/oracle.tmpl etc/templates/verify/pg.tmpl etc/templates/verify/sqlite.tmpl etc/templates/verify/vertica.tmpl etc/tools/upgrade-registry-to-mysql-5.5.0.sql etc/tools/upgrade-registry-to-mysql-5.6.4.sql inc/Module/Build/Sqitch.pm lib/App/Sqitch.pm lib/App/Sqitch/Command.pm lib/App/Sqitch/Command/add.pm lib/App/Sqitch/Command/bundle.pm lib/App/Sqitch/Command/checkout.pm lib/App/Sqitch/Command/config.pm lib/App/Sqitch/Command/deploy.pm lib/App/Sqitch/Command/engine.pm lib/App/Sqitch/Command/help.pm lib/App/Sqitch/Command/init.pm lib/App/Sqitch/Command/log.pm lib/App/Sqitch/Command/plan.pm lib/App/Sqitch/Command/rebase.pm lib/App/Sqitch/Command/revert.pm lib/App/Sqitch/Command/rework.pm lib/App/Sqitch/Command/show.pm lib/App/Sqitch/Command/status.pm lib/App/Sqitch/Command/tag.pm lib/App/Sqitch/Command/target.pm lib/App/Sqitch/Command/upgrade.pm lib/App/Sqitch/Command/verify.pm lib/App/Sqitch/Config.pm lib/App/Sqitch/DateTime.pm lib/App/Sqitch/Engine.pm lib/App/Sqitch/Engine/Upgrade/firebird-1.0.sql lib/App/Sqitch/Engine/Upgrade/firebird-1.1.sql lib/App/Sqitch/Engine/Upgrade/mysql-1.0.sql lib/App/Sqitch/Engine/Upgrade/mysql-1.1.sql lib/App/Sqitch/Engine/Upgrade/oracle-1.0.sql lib/App/Sqitch/Engine/Upgrade/oracle-1.1.sql lib/App/Sqitch/Engine/Upgrade/pg-1.0.sql lib/App/Sqitch/Engine/Upgrade/pg-1.1.sql lib/App/Sqitch/Engine/Upgrade/sqlite-1.0.sql lib/App/Sqitch/Engine/Upgrade/sqlite-1.1.sql lib/App/Sqitch/Engine/Upgrade/vertica-1.0.sql lib/App/Sqitch/Engine/Upgrade/vertica-1.1.sql lib/App/Sqitch/Engine/firebird.pm lib/App/Sqitch/Engine/firebird.sql lib/App/Sqitch/Engine/mysql.pm lib/App/Sqitch/Engine/mysql.sql lib/App/Sqitch/Engine/oracle.pm lib/App/Sqitch/Engine/oracle.sql lib/App/Sqitch/Engine/pg.pm lib/App/Sqitch/Engine/pg.sql lib/App/Sqitch/Engine/sqlite.pm lib/App/Sqitch/Engine/sqlite.sql lib/App/Sqitch/Engine/vertica.pm lib/App/Sqitch/Engine/vertica.sql lib/App/Sqitch/ItemFormatter.pm lib/App/Sqitch/Plan.pm lib/App/Sqitch/Plan/Blank.pm lib/App/Sqitch/Plan/Change.pm lib/App/Sqitch/Plan/ChangeList.pm lib/App/Sqitch/Plan/Depend.pm lib/App/Sqitch/Plan/Line.pm lib/App/Sqitch/Plan/LineList.pm lib/App/Sqitch/Plan/Pragma.pm lib/App/Sqitch/Plan/Tag.pm lib/App/Sqitch/Role/DBIEngine.pm lib/App/Sqitch/Role/RevertDeployCommand.pm lib/App/Sqitch/Role/TargetConfigCommand.pm lib/App/Sqitch/Target.pm lib/App/Sqitch/Types.pm lib/App/Sqitch/X.pm lib/LocaleData/de/LC_MESSAGES/App-Sqitch.mo lib/LocaleData/fr/LC_MESSAGES/App-Sqitch.mo lib/sqitch-add-usage.pod lib/sqitch-add.pod lib/sqitch-bundle-usage.pod lib/sqitch-bundle.pod lib/sqitch-checkout-usage.pod lib/sqitch-checkout.pod lib/sqitch-config-usage.pod lib/sqitch-config.pod lib/sqitch-configuration.pod lib/sqitch-deploy-usage.pod lib/sqitch-deploy.pod lib/sqitch-engine-usage.pod lib/sqitch-engine.pod lib/sqitch-environment.pod lib/sqitch-help-usage.pod lib/sqitch-help.pod lib/sqitch-init-usage.pod lib/sqitch-init.pod lib/sqitch-log-usage.pod lib/sqitch-log.pod lib/sqitch-passwords.pod lib/sqitch-plan-usage.pod lib/sqitch-plan.pod lib/sqitch-rebase-usage.pod lib/sqitch-rebase.pod lib/sqitch-revert-usage.pod lib/sqitch-revert.pod lib/sqitch-rework-usage.pod lib/sqitch-rework.pod lib/sqitch-show-usage.pod lib/sqitch-show.pod lib/sqitch-status-usage.pod lib/sqitch-status.pod lib/sqitch-tag-usage.pod lib/sqitch-tag.pod lib/sqitch-target-usage.pod lib/sqitch-target.pod lib/sqitch-upgrade-usage.pod lib/sqitch-upgrade.pod lib/sqitch-verify-usage.pod lib/sqitch-verify.pod lib/sqitch.pod lib/sqitchchanges.pod lib/sqitchcommands.pod lib/sqitchguides.pod lib/sqitchtutorial-firebird.pod lib/sqitchtutorial-mysql.pod lib/sqitchtutorial-oracle.pod lib/sqitchtutorial-sqlite.pod lib/sqitchtutorial-vertica.pod lib/sqitchtutorial.pod lib/sqitchusage.pod t/add.t t/add_change.conf t/base.t t/blank.t t/bundle.t t/change.t t/changelist.t t/checkout.t t/command.t t/config.t t/configuration.t t/core.conf t/core_target.conf t/datetime.t t/depend.t t/deploy.t t/die.pl t/echo.pl t/editor.conf t/engine.conf t/engine.t t/engine/deploy/func/add_user.sql t/engine/deploy/users.sql t/engine/deploy/widgets.sql t/engine/revert/func/add_user.sql t/engine/revert/users.sql t/engine/revert/widgets.sql t/engine/reworked/deploy/users@alpha.sql t/engine/reworked/revert/users@alpha.sql t/engine/sqitch.plan t/engine_cmd.t t/firebird.t t/help.t t/init.t t/item_formatter.t t/lib/App/Sqitch/Command/bad.pm t/lib/App/Sqitch/Command/good.pm t/lib/App/Sqitch/Engine/bad.pm t/lib/App/Sqitch/Engine/good.pm t/lib/DBIEngineTest.pm t/lib/LC.pm t/lib/MockOutput.pm t/lib/upgradable_registries/firebird.sql t/lib/upgradable_registries/mysql.sql t/lib/upgradable_registries/oracle.sql t/lib/upgradable_registries/pg.sql t/lib/upgradable_registries/sqlite.sql t/lib/upgradable_registries/vertica.sql t/linelist.t t/local.conf t/log.t t/mooseless.t t/multiplan.conf t/mysql.t t/options.t t/oracle.t t/pg.t t/plan.t t/plan_command.t t/plans/bad-change.plan t/plans/changes-only.plan t/plans/dependencies.plan t/plans/deploy-and-revert.plan t/plans/dos.plan t/plans/dupe-change-diff-tag.plan t/plans/dupe-change.plan t/plans/dupe-tag.plan t/plans/multi.plan t/plans/pragmas.plan t/plans/project_deps.plan t/plans/reserved-tag.plan t/plans/widgets.plan t/pragma.t t/read.pl t/rebase.t t/revert.t t/rework.conf t/rework.t t/show.t t/sqitch t/sqitch.conf t/sql/deploy/roles.sql t/sql/deploy/users.sql t/sql/deploy/widgets.sql t/sql/sqitch.plan t/sql/verify/users.sql t/sqlite.t t/status.t t/tag.t t/tag_cmd.t t/target.conf t/target.t t/target_cmd.t t/templates.conf t/upgrade.t t/user.conf t/verify.t t/vertica.t t/x.t xt/release/pod-coverage.t xt/release/pod-spelling.t xt/release/pod.t App-Sqitch-0.9996/META.json000644 000767 000024 00000010323 13133201371 015451 0ustar00davidstaff000000 000000 { "abstract" : "Sane database change management", "author" : [ "David E. Wheeler " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.037, CPAN::Meta::Converter version 2.150001", "license" : [ "mit" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "App-Sqitch", "no_index" : { "directory" : [ "priv" ] }, "prereqs" : { "build" : { "requires" : { "Module::Build" : "0.35" } }, "configure" : { "requires" : { "Module::Build" : "0.35" } }, "develop" : { "recommends" : { "DBD::Firebird" : "1.11", "DBD::ODBC" : "1.43", "DBD::Pg" : "2.0", "DBD::SQLite" : "1.37", "DBD::mysql" : "4.018", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Spelling" : "0" }, "suggests" : { "DBD::Oracle" : "1.23" } }, "runtime" : { "recommends" : { "Class::XSAccessor" : "1.18", "Pod::Simple" : "1.41", "Type::Tiny::XS" : "0.010" }, "requires" : { "Clone" : "0", "Config::GitLike" : "1.11", "DBI" : "0", "DateTime" : "1.04", "DateTime::TimeZone" : "0", "Devel::StackTrace" : "1.30", "Digest::SHA" : "0", "Encode" : "0", "Encode::Locale" : "0", "File::Basename" : "0", "File::Copy" : "0", "File::HomeDir" : "0", "File::Path" : "0", "File::Temp" : "0", "Getopt::Long" : "0", "Hash::Merge" : "0", "IO::Pager" : "0", "IPC::Run3" : "0", "IPC::System::Simple" : "1.17", "List::MoreUtils" : "0", "List::Util" : "0", "Locale::Messages" : "0", "Locale::TextDomain" : "1.20", "Moo" : "1.002000", "Moo::Role" : "0", "POSIX" : "0", "Path::Class" : "0.33", "PerlIO::utf8_strict" : "0", "Pod::Escapes" : "1.04", "Pod::Find" : "0", "Pod::Usage" : "0", "Scalar::Util" : "0", "StackTrace::Auto" : "0", "String::Formatter" : "0", "String::ShellQuote" : "0", "Sub::Exporter" : "0", "Sub::Exporter::Util" : "0", "Sys::Hostname" : "0", "Template::Tiny" : "0.11", "Term::ANSIColor" : "2.02", "Throwable" : "0.200009", "Time::HiRes" : "0", "Time::Local" : "0", "Try::Tiny" : "0", "Type::Library" : "0.040", "Type::Utils" : "0", "Types::Standard" : "0", "URI" : "0", "URI::db" : "0.15", "User::pwent" : "0", "constant" : "0", "if" : "0", "namespace::autoclean" : "0.16", "overload" : "0", "parent" : "0", "perl" : "5.010", "strict" : "0", "utf8" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Capture::Tiny" : "0.12", "Carp" : "0", "File::Find" : "0", "File::Spec" : "0", "File::Spec::Functions" : "0", "FindBin" : "0", "Module::Runtime" : "0", "Path::Class" : "0.33", "Test::Deep" : "0", "Test::Dir" : "0", "Test::Exception" : "0", "Test::File" : "0", "Test::File::Contents" : "0.20", "Test::MockModule" : "0.05", "Test::More" : "0.94", "Test::NoWarnings" : "0.083", "lib" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://github.com/theory/sqitch/issues/" }, "homepage" : "http://sqitch.org/", "repository" : { "url" : "http://github.com/theory/sqitch/" } }, "version" : "0.9996" } App-Sqitch-0.9996/META.yml000644 000767 000024 00000004275 13133201371 015312 0ustar00davidstaff000000 000000 --- abstract: 'Sane database change management' author: - 'David E. Wheeler ' build_requires: Capture::Tiny: '0.12' Carp: '0' File::Find: '0' File::Spec: '0' File::Spec::Functions: '0' FindBin: '0' Module::Build: '0.35' Module::Runtime: '0' Path::Class: '0.33' Test::Deep: '0' Test::Dir: '0' Test::Exception: '0' Test::File: '0' Test::File::Contents: '0.20' Test::MockModule: '0.05' Test::More: '0.94' Test::NoWarnings: '0.083' lib: '0' configure_requires: Module::Build: '0.35' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.037, CPAN::Meta::Converter version 2.150001' license: mit meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: App-Sqitch no_index: directory: - priv recommends: Class::XSAccessor: '1.18' Pod::Simple: '1.41' Type::Tiny::XS: '0.010' requires: Clone: '0' Config::GitLike: '1.11' DBI: '0' DateTime: '1.04' DateTime::TimeZone: '0' Devel::StackTrace: '1.30' Digest::SHA: '0' Encode: '0' Encode::Locale: '0' File::Basename: '0' File::Copy: '0' File::HomeDir: '0' File::Path: '0' File::Temp: '0' Getopt::Long: '0' Hash::Merge: '0' IO::Pager: '0' IPC::Run3: '0' IPC::System::Simple: '1.17' List::MoreUtils: '0' List::Util: '0' Locale::Messages: '0' Locale::TextDomain: '1.20' Moo: '1.002000' Moo::Role: '0' POSIX: '0' Path::Class: '0.33' PerlIO::utf8_strict: '0' Pod::Escapes: '1.04' Pod::Find: '0' Pod::Usage: '0' Scalar::Util: '0' StackTrace::Auto: '0' String::Formatter: '0' String::ShellQuote: '0' Sub::Exporter: '0' Sub::Exporter::Util: '0' Sys::Hostname: '0' Template::Tiny: '0.11' Term::ANSIColor: '2.02' Throwable: '0.200009' Time::HiRes: '0' Time::Local: '0' Try::Tiny: '0' Type::Library: '0.040' Type::Utils: '0' Types::Standard: '0' URI: '0' URI::db: '0.15' User::pwent: '0' constant: '0' if: '0' namespace::autoclean: '0.16' overload: '0' parent: '0' perl: '5.010' strict: '0' utf8: '0' warnings: '0' resources: bugtracker: http://github.com/theory/sqitch/issues/ homepage: http://sqitch.org/ repository: http://github.com/theory/sqitch/ version: '0.9996' App-Sqitch-0.9996/README000644 000767 000024 00000000453 13133201371 014713 0ustar00davidstaff000000 000000 This archive contains the distribution App-Sqitch, version 0.9996: Sane database change management This software is Copyright (c) 2017 by "iovation Inc.". This is free software, licensed under: The MIT (X11) License This README file was generated by Dist::Zilla::Plugin::Readme v5.037. App-Sqitch-0.9996/README.md000644 000767 000024 00000012165 13133201371 015315 0ustar00davidstaff000000 000000 App/Sqitch version 0.9996 ========================= [![CPAN version](https://badge.fury.io/pl/App-Sqitch.svg)](http://badge.fury.io/pl/App-Sqitch) [![Build Status](https://travis-ci.org/theory/sqitch.svg)](https://travis-ci.org/theory/sqitch) [![Coverage Status](https://coveralls.io/repos/theory/sqitch/badge.svg)](https://coveralls.io/r/theory/sqitch) [Sqitch](http://sqitch.org/) is a database change management application. It currently supports PostgreSQL 8.4+, SQLite 3.7.11+, MySQL 5.0+, Oracle 10g+, Firebird 2.0+, and Vertica 6.0+. What makes it different from your typical [migration](http://guides.rubyonrails.org/migrations.html) approaches? A few things: * No opinions Sqitch is not integrated with any framework, ORM, or platform. Rather, it is a standalone change management system with no opinions about your database engine, application framework, or your development environment. * Native scripting Changes are implemented as scripts native to your selected database engine. Writing a [PostgreSQL](http://postgresql.org/) application? Write SQL scripts for [`psql`](http://www.postgresql.org/docs/current/static/app-psql.html). Writing an [Oracle](http://www.oracle.com/us/products/database/)-backed app? Write SQL scripts for [SQL\*Plus](http://www.orafaq.com/wiki/SQL*Plus). * Dependency resolution Database changes may declare dependencies on other changes -- even on changes from other Sqitch projects. This ensures proper order of execution, even when you've committed changes to your VCS out-of-order. * No numbering Change deployment is managed by maintaining a plan file. As such, there is no need to number your changes, although you can if you want. Sqitch doesn't much care how you name your changes. * Iterative Development Up until you tag and release your project, you can modify your change deployment scripts as often as you like. They're not locked in just because they've been committed to your VCS. This allows you to take an iterative approach to developing your database schema. Or, better, you can do test-driven database development. Want to learn more? The best place to start is in the tutorials: * [Introduction to Sqitch on PostgreSQL](lib/sqitchtutorial.pod) * [Introduction to Sqitch on SQLite](lib/sqitchtutorial-sqlite.pod) * [Introduction to Sqitch on Oracle](lib/sqitchtutorial-oracle.pod) * [Introduction to Sqitch on MySQL](lib/sqitchtutorial-mysql.pod) * [Introduction to Sqitch on Firebird](lib/sqitchtutorial-firebird.pod) * [Introduction to Sqitch on Vertica](lib/sqitchtutorial-vertica.pod) There have also been a number of presentations on Sqitch: * [PDX.pm Presentation](https://speakerdeck.com/theory/sane-database-change-management-with-sqitch): Slides from "Sane Database Management with Sqitch", presented to the Portland Perl Mongers in January, 2013. * [PDXPUG Presentation](https://vimeo.com/50104469): Movie of "Sane Database Management with Sqitch", presented to the Portland PostgreSQL Users Group in September, 2012. * [Agile Database Development](https://speakerdeck.com/theory/agile-database-development-2ed): Slides from a three-hour tutorial session on using [Git](http://git-scm.org), test-driven development with [pgTAP](http://pgtap.org), and change management with Sqitch, updated in January, 2014. Installation ------------ To install Sqitch from a distribution download, type the following: perl Build.PL ./Build installdeps ./Build ./Build test ./Build install To build from a Git clone, first install [Dist::Zilla](https://metacpan.org/module/Dist::Zilla), then use it to install Sqitch and its dependencies: cpan Dist::Zilla dzil install To run Sqitch directly from the Git clone execute `t/sqitch`. If you're doing development on Sqitch, you will need to install the authoring dependencies, as well: dzil listdeps | xargs cpan To install Sqitch on a specific platform, including Debian- and RedHat-derived Linux distributions and Windows, see the [Installation documentation](http://sqitch.org/#installation). Licence ------- Copyright © 2012-2015 iovation Inc. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. App-Sqitch-0.9996/t/000755 000767 000024 00000000000 13133201371 014274 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/xt/000755 000767 000024 00000000000 13133201371 014464 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/xt/release/000755 000767 000024 00000000000 13133201371 016104 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/xt/release/pod-coverage.t000644 000767 000024 00000000511 13133201371 020641 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; all_pod_coverage_ok({ also_private => [qw(BUILDARGS BUILD CAN_OUTPUT_COLOR OUTPUT_TO_PIPE)], coverage_class => 'Pod::Coverage::CountParents', }); App-Sqitch-0.9996/xt/release/pod-spelling.t000644 000767 000024 00000001627 13133201371 020674 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More; eval "use Test::Spelling"; plan skip_all => "Test::Spelling required for testing POD spelling" if $@; add_stopwords(); all_pod_files_spelling_ok(); __DATA__ iovation NONINFRINGEMENT RDBMS RDBMSes SQLite sqitch VCS sublicense subdirectories EBNF UTF ftw MySQL MySQL's ORM blog depesz Flipr GitHub PostgreSQL PostgreSQL's sqitchtutorial sqitchchanges VCSes Versioning namespace DDLs SHA untracked yay other's Hrm rebase rebased undeployed Oy API overridable command's unsets NL multivalue init relatedly postgres DateTime committer committers UTC timestamp CLDR lowercased unlocalized flipr change's queryable Relatedly Rebase SQLite's Yay hashtags sqlite Overridable formatter Ronan Dunklau Sqitch's Unsets PDX PDXPUG username Firebird firebird Firebird's Gentoo Suciu MariaDB XC pgTAP schemas Vertica vertica DBA VM ODBC DSN GSS GSSAPI TLS ident passwordless IDE App-Sqitch-0.9996/xt/release/pod.t000644 000767 000024 00000000241 13133201371 017050 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); App-Sqitch-0.9996/t/add.t000644 000767 000024 00000107307 13133201371 015221 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 232; #use Test::More 'no_plan'; use App::Sqitch; use App::Sqitch::Target; use Locale::TextDomain qw(App-Sqitch); use Path::Class; use Test::Exception; use Test::Dir; use File::Temp 'tempdir'; use Test::File qw(file_not_exists_ok file_exists_ok); use Test::File::Contents 0.05; use File::Path qw(make_path remove_tree); use Test::NoWarnings 0.083; use lib 't/lib'; use MockOutput; my $CLASS = 'App::Sqitch::Command::add'; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $config_mock = Test::MockModule->new('App::Sqitch::Config'); my $sysdir = dir 'nonexistent'; my $usrdir = dir 'nonexistent'; $config_mock->mock(system_dir => sub { $sysdir }); $config_mock->mock(user_dir => sub { $usrdir }); ok my $sqitch = App::Sqitch->new( options => { top_dir => dir('test-add')->stringify, engine => 'pg', } ), 'Load a sqitch sqitch object'; my $config = $sqitch->config; isa_ok my $add = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'add', config => $config, }), $CLASS, 'add command'; my $target = $add->default_target; sub dep($$) { my $dep = App::Sqitch::Plan::Depend->new( %{ App::Sqitch::Plan::Depend->parse( $_[1] ) }, plan => $add->default_target->plan, conflicts => $_[0], ); $dep->project; return $dep; } can_ok $CLASS, qw( options requires conflicts variables template_name template_directory with_scripts templates open_editor configure execute _config_templates all_templates _slurp _add ); is_deeply [$CLASS->options], [qw( change-name|change|c=s requires|r=s@ conflicts|x=s@ note|n|m=s@ all|a! template-name|template|t=s template-directory=s with=s@ without=s@ use=s% open-editor|edit|e! deploy-template=s revert-template=s verify-template=s deploy! revert! verify! )], 'Options should be set up'; sub contents_of ($) { my $file = shift; open my $fh, "<:utf8_strict", $file or die "cannot open $file: $!"; local $/; return <$fh>; } ############################################################################## # Test configure(). is_deeply $CLASS->configure($config, {}, $sqitch), { requires => [], conflicts => [], note => [], }, 'Should have default configuration with no config or opts'; is_deeply $CLASS->configure($config, { requires => [qw(foo bar)], conflicts => ['baz'], note => [qw(hellow there)], }), { requires => [qw(foo bar)], conflicts => ['baz'], note => [qw(hellow there)], }, 'Should have get requires and conflicts options'; is_deeply $CLASS->configure($config, { template_directory => 't' }), { requires => [], conflicts => [], note => [], template_directory => dir('t'), }, 'Should set up template directory option'; is_deeply $CLASS->configure($config, { change_name => 'blog' }), { requires => [], conflicts => [], note => [], change_name => 'blog', }, 'Should set up change name option'; throws_ok { $CLASS->configure($config, { template_directory => '__nonexistent__' }); } 'App::Sqitch::X', 'Should die if --template-directory does not exist'; is $@->ident, 'add', 'Missing directory ident should be "add"'; is $@->message, __x( 'Directory "{dir}" does not exist', dir => '__nonexistent__', ), 'Missing directory error message should be correct'; throws_ok { $CLASS->configure($config, { template_directory => 'README.md' }); } 'App::Sqitch::X', 'Should die if --template-directory does is not a dir'; is $@->ident, 'add', 'In alid directory ident should be "add"'; is $@->message, __x( '"{dir}" is not a directory', dir => 'README.md', ), 'Invalid directory error message should be correct'; is_deeply $CLASS->configure($config, { template_name => 'foo' }), { requires => [], conflicts => [], note => [], template_name => 'foo', }, 'Should set up template name option'; is_deeply $CLASS->configure($config, { all => 1, with_scripts => { deploy => 1, revert => 1, verify => 0 }, use => { deploy => 'etc/templates/deploy/pg.tmpl', revert => 'etc/templates/revert/pg.tmpl', verify => 'etc/templates/verify/pg.tmpl', whatev => 'etc/templates/verify/pg.tmpl', }, }), { all => 1, requires => [], conflicts => [], note => [], with_scripts => { deploy => 1, revert => 1, verify => 0 }, templates => { deploy => file('etc/templates/deploy/pg.tmpl'), revert => file('etc/templates/revert/pg.tmpl'), verify => file('etc/templates/verify/pg.tmpl'), whatev => file('etc/templates/verify/pg.tmpl'), } }, 'Should have get template options'; # Test variable configuration. CONFIG: { local $ENV{SQITCH_CONFIG} = File::Spec->catfile(qw(t add_change.conf)); my $config = App::Sqitch::Config->new; my $dir = dir 't'; is_deeply $CLASS->configure($config, {}), { template_directory => $dir, template_name => 'hi', requires => [], conflicts => [], note => [], }, 'Variables should by default not be loaded from config'; is_deeply $CLASS->configure($config, {set => { yo => 'dawg' }}), { template_directory => $dir, template_name => 'hi', requires => [], conflicts => [], note => [], variables => { foo => 'bar', baz => [qw(hi there you)], yo => 'dawg', }, }, '--set should be merged with config variables'; is_deeply $CLASS->configure($config, {set => { foo => 'ick' }}), { template_directory => $dir, template_name => 'hi', requires => [], conflicts => [], note => [], variables => { foo => 'ick', baz => [qw(hi there you)], }, }, '--set should be override config variables'; } ############################################################################## # Test attributes. is_deeply $add->requires, [], 'Requires should be an arrayref'; is_deeply $add->conflicts, [], 'Conflicts should be an arrayref'; is_deeply $add->note, [], 'Notes should be an arrayref'; is_deeply $add->variables, {}, 'Varibles should be a hashref'; is $add->template_directory, undef, 'Default dir should be undef'; is $add->template_name, undef, 'Default temlate_name should be undef'; is_deeply $add->with_scripts, {}, 'Default with_scripts should be empty'; is_deeply $add->templates, {}, 'Default templates should be empty'; ############################################################################## # Test _check_script. isa_ok my $check = $CLASS->can('_check_script'), 'CODE', '_check_script'; my $tmpl = 'etc/templates/verify/pg.tmpl'; is $check->($tmpl), file($tmpl), '_check_script should be okay with script'; throws_ok { $check->('nonexistent') } 'App::Sqitch::X', '_check_script should die on nonexistent file'; is $@->ident, 'add', 'Nonexistent file ident should be "add"'; is $@->message, __x( 'Template {template} does not exist', template => 'nonexistent', ), 'Nonexistent file error message should be correct'; throws_ok { $check->('lib') } 'App::Sqitch::X', '_check_script should die on directory'; is $@->ident, 'add', 'Directory error ident should be "add"'; is $@->message, __x( 'Template {template} is not a file', template => 'lib', ), 'Directory error message should be correct'; ############################################################################## # Test _config_templates. READCONFIG: { local $ENV{SQITCH_CONFIG} = file('t/templates.conf')->stringify; ok my $sqitch = App::Sqitch->new( options => { top_dir => dir('test-add')->stringify }, ), 'Load another sqitch sqitch object'; my $config = $sqitch->config; ok $add = $CLASS->new(sqitch => $sqitch), 'Create add with template config'; is_deeply $add->_config_templates($config), { deploy => file('etc/templates/deploy/pg.tmpl'), revert => file('etc/templates/revert/pg.tmpl'), test => file('etc/templates/verify/pg.tmpl'), verify => file('etc/templates/verify/pg.tmpl'), }, 'Should load the config templates'; } ############################################################################## # Test all_templates(). my $tmpldir = dir 'etc/templates'; # First, specify template directory. ok $add = $CLASS->new(sqitch => $sqitch, template_directory => $tmpldir), 'Add object with template directory'; is $add->template_name, undef, 'Template name should be undef'; my $tname = $add->template_name || $target->engine_key; is_deeply $add->all_templates($tname), { deploy => file('etc/templates/deploy/pg.tmpl'), revert => file('etc/templates/revert/pg.tmpl'), verify => file('etc/templates/verify/pg.tmpl'), }, 'Should find all templates in directory'; # Now let it find the templates in the user dir. $usrdir = dir 'etc'; ok $add = $CLASS->new(sqitch => $sqitch, template_name => 'sqlite'), 'Add object with template name'; is_deeply $add->all_templates($add->template_name), { deploy => file('etc/templates/deploy/sqlite.tmpl'), revert => file('etc/templates/revert/sqlite.tmpl'), verify => file('etc/templates/verify/sqlite.tmpl'), }, 'Should find all templates in user directory'; # And then the system dir. ($usrdir, $sysdir) = ($sysdir, $usrdir); ok $add = $CLASS->new(sqitch => $sqitch, template_name => 'mysql'), 'Add object with another template name'; is_deeply $add->all_templates($add->template_name), { deploy => file('etc/templates/deploy/mysql.tmpl'), revert => file('etc/templates/revert/mysql.tmpl'), verify => file('etc/templates/verify/mysql.tmpl'), }, 'Should find all templates in systsem directory'; # Now make sure it combines directories. my $tmp_dir = dir tempdir CLEANUP => 1; for my $script (qw(deploy whatev)) { my $subdir = $tmp_dir->subdir($script); $subdir->mkpath; $subdir->file('pg.tmpl')->touch; } ok $add = $CLASS->new(sqitch => $sqitch, template_directory => $tmp_dir), 'Add object with temporary template directory'; is_deeply $add->all_templates($tname), { deploy => $tmp_dir->file('deploy/pg.tmpl'), whatev => $tmp_dir->file('whatev/pg.tmpl'), revert => file('etc/templates/revert/pg.tmpl'), verify => file('etc/templates/verify/pg.tmpl'), }, 'Template dir files should override others'; # Add in configured files. ok $add = $CLASS->new( sqitch => $sqitch, template_directory => $tmp_dir, templates => { foo => file('foo'), verify => file('verify'), deploy => file('deploy'), }, ), 'Add object with configured templates'; is_deeply $add->all_templates($tname), { deploy => file('deploy'), verify => file('verify'), foo => file('foo'), whatev => $tmp_dir->file('whatev/pg.tmpl'), revert => file('etc/templates/revert/pg.tmpl'), }, 'Template dir files should override others'; # Should die when missing files. $sysdir = $usrdir; for my $script (qw(deploy revert verify)) { ok $add = $CLASS->new( sqitch => $sqitch, with_scripts => { deploy => 0, revert => 0, verify => 0, $script => 1 }, ), "Add object requiring $script template"; throws_ok { $add->all_templates($tname) } 'App::Sqitch::X', "Should get error for missing $script template"; is $@->ident, 'add', qq{Missing $script template ident should be "add"}; is $@->message, __x( 'Cannot find {script} template', script => $script, ), "Missing $script template message should be correct"; } ############################################################################## # Test _slurp(). $tmpl = file(qw(etc templates deploy pg.tmpl)); is $ { $add->_slurp($tmpl)}, contents_of $tmpl, '_slurp() should load a reference to file contents'; ############################################################################## # Test _add(). my $test_add = sub { my $engine = shift; make_path 'test-add'; my $fn = $target->plan_file; open my $fh, '>', $fn or die "Cannot open $fn: $!"; say $fh "%project=add\n\n"; close $fh or die "Error closing $fn: $!"; END { remove_tree 'test-add' }; my $out = file 'test-add', 'sqitch_change_test.sql'; file_not_exists_ok $out; ok my $add = $CLASS->new( sqitch => $sqitch, template_directory => $tmpldir, ), 'Create add command'; ok $add->_add('sqitch_change_test', $out, $tmpl, 'sqlite', 'add'), 'Write out a script'; file_exists_ok $out; file_contents_is $out, <get_info, [[__x 'Created {file}', file => $out ]], 'Info should show $out created'; unlink $out; # Try with requires and conflicts. ok $add = $CLASS->new( sqitch => $sqitch, requires => [qw(foo bar)], conflicts => ['baz'], template_directory => $tmpldir, ), 'Create add cmd with requires and conflicts'; $out = file 'test-add', 'another_change_test.sql'; ok $add->_add('another_change_test', $out, $tmpl, 'sqlite', 'add'), 'Write out a script with requires and conflicts'; is_deeply +MockOutput->get_info, [[__x 'Created {file}', file => $out ]], 'Info should show $out created'; file_contents_is $out, < sub { my ($self, $file) = @_; return if $file ne 'Template.pm'; my $i = 0; return sub { $_ = 'die "NO ONE HERE";'; return $i = !$i; }, 1; }; $test_add->('Template::Tiny'); # Test _add() with Template. shift @INC; delete $INC{'Template.pm'}; SKIP: { skip 'Template Toolkit not installed', 14 unless eval 'use Template; 1'; $test_add->('Template Toolkit'); # Template Toolkit should throw an error on template syntax errors. ok my $add = $CLASS->new(sqitch => $sqitch, template_directory => $tmpldir), 'Create add command'; my $mock_add = Test::MockModule->new($CLASS); $mock_add->mock(_slurp => sub { \'[% IF foo %]' }); my $out = file 'test-add', 'sqitch_change_test.sql'; throws_ok { $add->_add('sqitch_change_test', $out, $tmpl) } 'App::Sqitch::X', 'Should get an exception on TT syntax error'; is $@->ident, 'add', 'TT exception ident should be "add"'; is $@->message, __x( 'Error executing {template}: {error}', template => $tmpl, error => 'file error - parse error - input text line 1: unexpected end of input', ), 'TT exception message should include the original error message'; } ############################################################################## # Test execute. ok $add = $CLASS->new( sqitch => $sqitch, template_directory => $tmpldir, ), 'Create another add with template_directory'; # Override request_note(). my $change_mocker = Test::MockModule->new('App::Sqitch::Plan::Change'); my %request_params; $change_mocker->mock(request_note => sub { my $self = shift; %request_params = @_; return $self->note; }); my $deploy_file = file qw(test-add deploy widgets_table.sql); my $revert_file = file qw(test-add revert widgets_table.sql); my $verify_file = file qw(test-add verify widgets_table.sql); my $plan = $add->default_target->plan; is $plan->get('widgets_table'), undef, 'Should not have "widgets_table" in plan'; dir_not_exists_ok +File::Spec->catdir('test-add', $_) for qw(deploy revert verify); ok $add->execute('widgets_table'), 'Add change "widgets_table"'; isa_ok my $change = $plan->get('widgets_table'), 'App::Sqitch::Plan::Change', 'Added change'; is $change->name, 'widgets_table', 'Change name should be set'; is_deeply [$change->requires], [], 'It should have no requires'; is_deeply [$change->conflicts], [], 'It should have no conflicts'; is_deeply \%request_params, { for => __ 'add', scripts => [$change->deploy_file, $change->revert_file, $change->verify_file], }, 'It should have prompted for a note'; file_exists_ok $_ for ($deploy_file, $revert_file, $verify_file); file_contents_like $deploy_file, qr/^-- Deploy add:widgets_table/, 'Deploy script should look right'; file_contents_like $revert_file, qr/^-- Revert add:widgets_table/, 'Revert script should look right'; file_contents_like $verify_file, qr/^-- Verify add:widgets_table/, 'Verify script should look right'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $deploy_file], [__x 'Created {file}', file => $revert_file], [__x 'Created {file}', file => $verify_file], [__x 'Added "{change}" to {file}', change => 'widgets_table', file => $target->plan_file, ], ], 'Info should have reported file creation'; # Relod the plan file to make sure change is written to it. $plan->load; isa_ok $change = $plan->get('widgets_table'), 'App::Sqitch::Plan::Change', 'Added change in reloaded plan'; # Make sure conflicts are avoided and conflicts and requires are respected. ok $add = $CLASS->new( change_name => 'foo_table', sqitch => $sqitch, requires => ['widgets_table'], conflicts => [qw(dr_evil joker)], note => [qw(hello there)], with_scripts => { verify => 0 }, template_directory => $tmpldir, ), 'Create another add with template_directory and no verify script'; $deploy_file = file qw(test-add deploy foo_table.sql); $revert_file = file qw(test-add revert foo_table.sql); $verify_file = file qw(test-add ferify foo_table.sql); $deploy_file->touch; file_exists_ok $deploy_file; file_not_exists_ok $_ for ($revert_file, $verify_file); is $plan->get('foo_table'), undef, 'Should not have "foo_table" in plan'; ok $add->execute, 'Add change "foo_table"'; file_exists_ok $_ for ($deploy_file, $revert_file); file_not_exists_ok $verify_file; $plan = $add->default_target->plan; isa_ok $change = $plan->get('foo_table'), 'App::Sqitch::Plan::Change', '"foo_table" change'; is_deeply \%request_params, { for => __ 'add', scripts => [$change->deploy_file, $change->revert_file], }, 'It should have prompted for a note'; is $change->name, 'foo_table', 'Change name should be set to "foo_table"'; is_deeply [$change->requires], [dep 0, 'widgets_table'], 'It should have requires'; is_deeply [$change->conflicts], [map { dep 1, $_ } qw(dr_evil joker)], 'It should have conflicts'; is $change->note, "hello\n\nthere", 'It should have a comment'; is_deeply +MockOutput->get_info, [ [__x 'Skipped {file}: already exists', file => $deploy_file], [__x 'Created {file}', file => $revert_file], [__x 'Added "{change}" to {file}', change => 'foo_table [widgets_table !dr_evil !joker]', file => $target->plan_file, ], ], 'Info should report skipping file and include dependencies'; # Make sure we die on an unknown argument. throws_ok { $add->execute(qw(foo bar)) } 'App::Sqitch::X', 'Should get an error on unkonwn argument'; is $@->ident, 'add', 'Unkown argument error ident should be "add"'; is $@->message, __x( 'Unknown arguments: {arg}', arg => 'foo, bar', ), 'Unknown argument error message should be correct'; # Make sure we die if the passed name conflicts with a target. TARGET: { my $mock_add = Test::MockModule->new($CLASS); $mock_add->mock(parse_args => sub { return undef, [$target]; }); $mock_add->mock(name => 'blog'); my $mock_target = Test::MockModule->new('App::Sqitch::Target'); $mock_target->mock(name => 'blog'); throws_ok { $add->execute('blog') } 'App::Sqitch::X', 'Should get an error for conflict with target name'; is $@->ident, 'add', 'Conflicting target error ident should be "add"'; is $@->message, __x( 'Name "{name}" identifies a target; use "--change {name}" to use it for the change name', name => 'blog', ), 'Conflicting target error message should be correct'; } # Make sure we get a usage message when no name specified. USAGE: { my @args; my $mock_add = Test::MockModule->new($CLASS); $mock_add->mock(usage => sub { @args = @_; die 'USAGE' }); my $add = $CLASS->new(sqitch => $sqitch); throws_ok { $add->execute } qr/USAGE/, 'No name arg or option should yield usage'; is_deeply \@args, [$add], 'No args should be passed to usage'; } # Make sure --open-editor works MOCKSHELL: { my $sqitch_mocker = Test::MockModule->new('App::Sqitch'); my $shell_cmd; $sqitch_mocker->mock(shell => sub { $shell_cmd = $_[1] }); $sqitch_mocker->mock(quote_shell => sub { shift; join ' ' => @_ }); ok $add = $CLASS->new( sqitch => $sqitch, template_directory => $tmpldir, note => ['Testing --open-editor'], open_editor => 1, ), 'Create another add with open_editor'; my $deploy_file = file qw(test-add deploy open_editor.sql); my $revert_file = file qw(test-add revert open_editor.sql); my $verify_file = file qw(test-add verify open_editor.sql); my $plan = $add->default_target->plan; is $plan->get('open_editor'), undef, 'Should not have "open_editor" in plan'; ok $add->execute('open_editor'), 'Add change "open_editor"'; isa_ok my $change = $plan->get('open_editor'), 'App::Sqitch::Plan::Change', 'Added change'; is $change->name, 'open_editor', 'Change name should be set'; is $shell_cmd, join(' ', $sqitch->editor, $deploy_file, $revert_file, $verify_file), 'It should have prompted to edit sql files'; file_exists_ok $_ for ($deploy_file, $revert_file, $verify_file); file_contents_like +File::Spec->catfile(qw(test-add deploy open_editor.sql)), qr/^-- Deploy add:open_editor/, 'Deploy script should look right'; file_contents_like +File::Spec->catfile(qw(test-add revert open_editor.sql)), qr/^-- Revert add:open_editor/, 'Revert script should look right'; file_contents_like +File::Spec->catfile(qw(test-add verify open_editor.sql)), qr/^-- Verify add:open_editor/, 'Verify script should look right'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $deploy_file], [__x 'Created {file}', file => $revert_file], [__x 'Created {file}', file => $verify_file], [__x 'Added "{change}" to {file}', change => 'open_editor', file => $target->plan_file, ], ], 'Info should have reported file creation'; }; # Make sure an additional script and an exclusion work properly. EXTRAS: { ok my $add = $CLASS->new( sqitch => $sqitch, template_directory => $tmpldir, with_scripts => { verify => 0 }, templates => { whatev => file(qw(etc templates verify mysql.tmpl)) }, note => ['Testing custom scripts'], ), 'Create another add with custom script and no verify'; my $deploy_file = file qw(test-add deploy custom_script.sql); my $revert_file = file qw(test-add revert custom_script.sql); my $verify_file = file qw(test-add verify custom_script.sql); my $whatev_file = file qw(test-add whatev custom_script.sql); ok $add->execute('custom_script'), 'Add change "custom_script"'; my $plan = $add->default_target->plan; isa_ok my $change = $plan->get('custom_script'), 'App::Sqitch::Plan::Change', 'Added change'; is $change->name, 'custom_script', 'Change name should be set'; is_deeply [$change->requires], [], 'It should have no requires'; is_deeply [$change->conflicts], [], 'It should have no conflicts'; is_deeply \%request_params, { for => __ 'add', scripts => [ map { $change->script_file($_) } qw(deploy revert whatev)] }, 'It should have prompted for a note'; file_exists_ok $_ for ($deploy_file, $revert_file, $whatev_file); file_not_exists_ok $verify_file; file_contents_like $deploy_file, qr/^-- Deploy add:custom_script/, 'Deploy script should look right'; file_contents_like $revert_file, qr/^-- Revert add:custom_script/, 'Revert script should look right'; file_contents_like $whatev_file, qr/^-- Verify add:custom_script/, 'Whatev script should look right'; file_contents_unlike $whatev_file, qr/^BEGIN/, 'Whatev script should be based on the MySQL verify script'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $deploy_file], [__x 'Created {file}', file => $revert_file], [__x 'Created {file}', file => $whatev_file], [__x 'Added "{change}" to {file}', change => 'custom_script', file => $target->plan_file, ], ], 'Info should have reported file creation'; # Relod the plan file to make sure change is written to it. $plan->load; isa_ok $change = $plan->get('custom_script'), 'App::Sqitch::Plan::Change', 'Added change in reloaded plan'; } # Make sure a configuration with multiple plans works. MULTIPLAN: { make_path 'test-multiadd'; END { remove_tree 'test-multiadd' }; chdir 'test-multiadd'; my $conf = file 'multiadd.conf'; $conf->spew(join "\n", '[core]', 'engine = pg', '[engine "pg"]', 'top_dir = pg', '[engine "sqlite"]', 'top_dir = sqlite', '[engine "mysql"]', 'top_dir = mysql', ); # Create plan files and determine the scripts that to be created. my @scripts = map { my $dir = dir $_; $dir->mkpath; $dir->file('sqitch.plan')->spew("%project=add\n\n"); map { $dir->file($_, 'widgets.sql') } qw(deploy revert verify); } qw(pg sqlite mysql); # Load up the configuration for this project. local $ENV{SQITCH_CONFIG} = $conf; my $sqitch = App::Sqitch->new; ok my $add = $CLASS->new( sqitch => $sqitch, note => ['Testing multiple plans'], all => 1, template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create another add with custom multiplan config'; my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 3, 'Should have three targets'; # Make sure the target list matches our script list order (by engine). # pg always comes first, as primary engine, but the other two are random. push @targets, splice @targets, 1, 1 if $targets[1]->engine_key ne 'sqlite'; # Let's do this thing! ok $add->execute('widgets'), 'Add change "widgets" to all plans'; ok $_->plan->get('widgets'), 'Should have "widgets" in ' . $_->engine_key . ' plan' for @targets; file_exists_ok $_ for @scripts; # Make sure we see the proper output. my $info = MockOutput->get_info; my $ekey = $targets[1]->engine_key; if ($info->[4][0] !~ /$ekey/) { # Got the targets in a different order. So reorder results to match. push @{ $info } => splice @{ $info }, 4, 4; } is_deeply $info, [ (map { [__x 'Created {file}', file => $_] } @scripts[0..2]), [ __x 'Added "{change}" to {file}', change => 'widgets', file => $targets[0]->plan_file, ], (map { [__x 'Created {file}', file => $_] } @scripts[3..5]), [ __x 'Added "{change}" to {file}', change => 'widgets', file => $targets[1]->plan_file, ], (map { [__x 'Created {file}', file => $_] } @scripts[6..8]), [ __x 'Added "{change}" to {file}', change => 'widgets', file => $targets[2]->plan_file, ], ], 'Info should have reported all script creations and plan updates'; # Make sure we get an error using --all and a target arg. throws_ok { $add->execute('foo', 'pg' ) } 'App::Sqitch::X', 'Should get an error for --all and a target arg'; is $@->ident, 'add', 'Mixed arguments error ident should be "add"'; is $@->message, __( 'Cannot specify both --all and engine, target, or plan arugments' ), 'Mixed arguments error message should be correct'; # Now try adding a change to just one engine. Remove --all ok $add = $CLASS->new( sqitch => $sqitch, note => ['Testing multiple plans'], template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create yet another add with custom multiplan config'; ok $add->execute('choc', 'sqlite'), 'Add change "choc" to the sqlite plan'; my %targets = map { $_->engine_key => $_ } App::Sqitch::Target->all_targets(sqitch => $sqitch); is keys %targets, 3, 'Should still have three targets'; ok !$targets{pg}->plan->get('choc'), 'Should not have "choc" in the pg plan'; ok !$targets{mysql}->plan->get('choc'), 'Should not have "choc" in the mysql plan'; ok $targets{sqlite}->plan->get('choc'), 'Should have "choc" in the sqlite plan'; @scripts = map { my $dir = dir $_; $dir->mkpath; map { $dir->file($_, 'choc.sql') } qw(deploy revert verify); } qw(sqlite pg mysql); file_exists_ok $_ for @scripts[0..2]; file_not_exists_ok $_ for @scripts[3..8]; is_deeply +MockOutput->get_info, [ (map { [__x 'Created {file}', file => $_] } @scripts[0..2]), [ __x 'Added "{change}" to {file}', change => 'choc', file => $targets{sqlite}->plan_file, ], ], 'Info should have reported sqlite choc script creations and plan updates'; chdir File::Spec->updir; } # Make sure we update only one plan but write out multiple target files. MULTITARGET: { remove_tree 'test-multiadd'; make_path 'test-multiadd'; chdir 'test-multiadd'; my $conf = file 'multiadd.conf'; $conf->spew(join "\n", '[core]', 'engine = pg', 'plan_file = sqitch.plan', '[engine "pg"]', 'top_dir = pg', '[engine "sqlite"]', 'top_dir = sqlite', '[add]', 'all = true', ); file('sqitch.plan')->spew("%project=add\n\n"); # Create list of scripts to be created. my @scripts = map { my $dir = dir $_; $dir->mkpath; map { $dir->file($_, 'widgets.sql') } qw(deploy revert verify); } qw(pg sqlite); # Load up the configuration for this project. local $ENV{SQITCH_CONFIG} = $conf; my $sqitch = App::Sqitch->new; ok my $add = $CLASS->new( sqitch => $sqitch, note => ['Testing multiple targets'], template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create another add with single plan, multi-target config'; my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 2, 'Should have two targets'; is $targets[0]->plan_file, $targets[1]->plan_file, 'Targets should use the same plan file'; # Let's do this thing! ok $add->execute('widgets'), 'Add change "widgets" to all plans'; ok $targets[0]->plan->get('widgets'), 'Should have "widgets" in the plan'; file_exists_ok $_ for @scripts; is_deeply \%request_params, { for => __ 'add', scripts => \@scripts, }, 'Should have the proper files listed in the note promt'; is_deeply +MockOutput->get_info, [ (map { [__x 'Created {file}', file => $_] } @scripts), [ __x 'Added "{change}" to {file}', change => 'widgets', file => $targets[0]->plan_file, ], ], 'Info should have reported all script creations and one plan update'; chdir File::Spec->updir; } # Make sure we're okay with multiple plans sharing the same top dir. ONETOP: { remove_tree 'test-multiadd'; make_path 'test-multiadd'; chdir 'test-multiadd'; my $conf = file 'multiadd.conf'; $conf->spew(join "\n", '[core]', 'engine = pg', '[engine "pg"]', 'plan_file = pg.plan', '[engine "sqlite"]', 'plan_file = sqlite.plan', ); file("$_.plan")->spew("%project=add\n\n") for qw(pg sqlite); # Create list of scripts to be created. my @scripts = map { file $_, 'widgets.sql' } qw(deploy revert verify); # Load up the configuration for this project. local $ENV{SQITCH_CONFIG} = $conf; my $sqitch = App::Sqitch->new; ok my $add = $CLASS->new( sqitch => $sqitch, note => ['Testing two targets, one top_dir'], all => 1, template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create another add with two targets, one top dir'; my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 2, 'Should have two targets'; is $targets[0]->plan_file, file('pg.plan'), 'First target plan should be in pg.plan'; is $targets[1]->plan_file, file('sqlite.plan'), 'Second target plan should be in sqlite.plan'; # Let's do this thing! ok $add->execute('widgets'), 'Add change "widgets" to all plans'; ok $_->plan->get('widgets'), 'Should have "widgets" in ' . $_->engine_key . ' plan' for @targets; file_exists_ok $_ for @scripts; is_deeply \%request_params, { for => __ 'add', scripts => \@scripts, }, 'Should have the proper files listed in the note promt'; is_deeply my $info = MockOutput->get_info, [ (map { [__x 'Created {file}', file => $_] } @scripts), [ __x 'Added "{change}" to {file}', change => 'widgets', file => $targets[0]->plan_file, ], (map { [__x 'Skipped {file}: already exists', file => $_] } @scripts), [ __x 'Added "{change}" to {file}', change => 'widgets', file => $targets[1]->plan_file, ], ], 'Info should have script creations and skips'; chdir File::Spec->updir; } ############################################################################## # Test options parsing. can_ok $CLASS, 'options', '_parse_opts'; ok $add = $CLASS->new({ sqitch => $sqitch }), "Create a $CLASS object again"; is_deeply $add->_parse_opts, {}, 'Base _parse_opts should return an empty hash'; is_deeply $add->_parse_opts([1]), { with_scripts => { deploy => 1, verify => 1, revert => 1 }, }, '_parse_opts() hould use options spec'; my $args = [qw( --note foo --template bar whatever )]; is_deeply $add->_parse_opts($args), { note => ['foo'], template_name => 'bar', with_scripts => { deploy => 1, verify => 1, revert => 1 }, }, '_parse_opts() should parse options spec'; is_deeply $args, ['whatever'], 'Args array should be cleared of options'; # Make sure --set works. push @{ $args }, '--set' => 'schema=foo', '--set' => 'table=bar'; is_deeply $add->_parse_opts($args), { set => { schema => 'foo', table => 'bar' }, with_scripts => { deploy => 1, verify => 1, revert => 1 }, }, '_parse_opts() should parse --set options'; is_deeply $args, ['whatever'], 'Args array should be cleared of options'; # make sure --set works with repeating keys. push @{ $args }, '--set' => 'column=id', '--set' => 'column=name'; is_deeply $add->_parse_opts($args), { set => { column => [qw(id name)] }, with_scripts => { deploy => 1, verify => 1, revert => 1 }, }, '_parse_opts() should parse --set options with repeting key'; is_deeply $args, ['whatever'], 'Args array should be cleared of options'; # Make sure --with and --use work. push @{ $args }, qw(--with deploy --without verify --use), "foo=$tmpl"; is_deeply $add->_parse_opts($args), { with_scripts => { deploy => 1, verify => 0, revert => 1 }, use => { foo => $tmpl } }, '_parse_opts() should parse --with, --without, and --user'; is_deeply $args, ['whatever'], 'Args array should be cleared of options'; App-Sqitch-0.9996/t/add_change.conf000644 000767 000024 00000000167 13133201371 017204 0ustar00davidstaff000000 000000 [add] template_directory = t template_name = hi all = true [add "variables"] foo = bar baz = hi baz = there baz = you App-Sqitch-0.9996/t/base.t000644 000767 000024 00000047151 13133201371 015403 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use Test::More tests => 140; #use Test::More 'no_plan'; use Test::MockModule; use Path::Class; use Test::Exception; use Test::NoWarnings; use Capture::Tiny 0.12 qw(:all); use Locale::TextDomain qw(App-Sqitch); use App::Sqitch::X 'hurl'; my $CLASS; BEGIN { $CLASS = 'App::Sqitch'; use_ok $CLASS or die; } $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; can_ok $CLASS, qw( go new options user_name user_email verbosity prompt ask_y_n ); ############################################################################## # Defaults. isa_ok my $sqitch = $CLASS->new, $CLASS, 'A new object'; is $sqitch->verbosity, 1, 'verbosity should be 1'; ok $sqitch->user_name, 'Default user_name should be set from system'; is $sqitch->user_email, do { require Sys::Hostname; $sqitch->sysuser . '@' . Sys::Hostname::hostname(); }, 'Default user_email should be set from system'; ############################################################################## # Test go(). GO: { my $mock = Test::MockModule->new('App::Sqitch::Command::help'); my ($cmd, @params); my $ret = 1; $mock->mock(execute => sub { ($cmd, @params) = @_; $ret }); chdir 't'; local $ENV{SQITCH_CONFIG} = 'sqitch.conf'; local $ENV{SQITCH_USER_CONFIG} = 'user.conf'; local @ARGV = qw(--engine sqlite help config); is +App::Sqitch->go, 0, 'Should get 0 from go()'; isa_ok $cmd, 'App::Sqitch::Command::help', 'Command'; is_deeply \@params, ['config'], 'Extra args should be passed to execute'; isa_ok my $sqitch = $cmd->sqitch, 'App::Sqitch'; is $sqitch->options->{engine}, 'sqlite', 'Should have collected --engine'; ok my $config = $sqitch->config, 'Get the Sqitch config'; is $config->get(key => 'engine.pg.client'), '/usr/local/pgsql/bin/psql', 'Should have local config overriding user'; is $config->get(key => 'engine.pg.registry'), 'meta', 'Should fall back on user config'; is $sqitch->user_name, 'Michael Stonebraker', 'Should have read user name from configuration'; is $sqitch->user_email, 'michael@example.com', 'Should have read user email from configuration'; is_deeply $sqitch->options, { engine => 'sqlite' }, 'Should have options'; # Now make it die. sub puke { App::Sqitch::X->new(@_) } # Ensures we have trace frames. my $ex = puke(ident => 'ohai', message => 'OMGWTF!'); $mock->mock(execute => sub { die $ex }); my $sqitch_mock = Test::MockModule->new($CLASS); my @vented; $sqitch_mock->mock(vent => sub { push @vented => $_[1]; }); my $traced; $sqitch_mock->mock(trace => sub { $traced = $_[1]; }); is $sqitch->go, 2, 'Go should return 2 on Sqitch exception'; is_deeply \@vented, ['OMGWTF!'], 'The error should have been vented'; is $traced, $ex->stack_trace->as_string, 'The stack trace should have been sent to trace'; # Make it die with a developer exception. @vented = (); $traced = undef; $ex = puke( message => 'OUCH!', exitval => 4 ); is $sqitch->go, 4, 'Go should return exitval on another exception'; is_deeply \@vented, ['OUCH!', $ex->stack_trace->as_string], 'Both the message and the trace should have been vented'; is $traced, undef, 'Nothing should have been traced'; # Make it die without an exception object. $ex = 'LOLZ'; @vented = (); is $sqitch->go, 2, 'Go should return 2 on a third Sqitch exception'; is @vented, 1, 'Should have one thing vented'; like $vented[0], qr/^LOLZ\b/, 'And it should include our message'; } ############################################################################## # Test the editor. EDITOR: { local $ENV{SQITCH_EDITOR}; local $ENV{VISUAL}; local $ENV{EDITOR} = 'edd'; my $sqitch = App::Sqitch->new; is $sqitch->editor, 'edd', 'editor should use $EDITOR'; local $ENV{VISUAL} = 'gvim'; $sqitch = App::Sqitch->new; is $sqitch->editor, 'gvim', 'editor should prefer $VISUAL over $EDITOR'; local $ENV{SQITCH_CONFIG} = File::Spec->catfile(qw(t editor.conf)); my $config = App::Sqitch::Config->new; $sqitch = App::Sqitch->new; is $sqitch->editor, 'config_specified_editor', 'editor should prefer core.editor over $VISUAL'; local $ENV{SQITCH_EDITOR} = 'vimz'; $sqitch = App::Sqitch->new; is $sqitch->editor, 'vimz', 'editor should prefer $SQITCH_EDITOR over $VISUAL'; $sqitch = App::Sqitch->new({editor => 'emacz' }); is $sqitch->editor, 'emacz', 'editor should use use parameter regardless of environment'; delete $ENV{SQITCH_EDITOR}; delete $ENV{SQITCH_CONFIG}; delete $ENV{VISUAL}; delete $ENV{EDITOR}; local $^O = 'NotWin32'; $sqitch = App::Sqitch->new; is $sqitch->editor, 'vi', 'editor fall back on vi when not Windows'; $^O = 'MSWin32'; $sqitch = App::Sqitch->new; is $sqitch->editor, 'notepad.exe', 'editor fall back on notepad on Windows'; } ############################################################################## # Test the pager program config. We want to pick up from one of the following # places, earlier in the list more preferred. # - SQITCH_PAGER environment variable. # - core.pager configuration prop. # - PAGER environment variable. # PAGER_PROGRAM: { { local $ENV{SQITCH_PAGER}; local $ENV{PAGER} = "morez"; my $sqitch = App::Sqitch->new; is $sqitch->pager_program, "morez", "pager program should be picked up from PAGER when SQITCH_PAGER and core.pager are not set"; } { local $ENV{SQITCH_PAGER} = "less -myway"; local $ENV{PAGER} = "morezz"; my $sqitch = App::Sqitch->new; is $sqitch->pager_program, "less -myway", "SQITCH_PAGER should take precedence over PAGER"; } { local $ENV{SQITCH_PAGER}; local $ENV{PAGER} = "morezz"; local $ENV{SQITCH_CONFIG} = File::Spec->catfile(qw/t sqitch.conf/); my $sqitch = App::Sqitch->new; is $sqitch->pager_program, "less -r", "`core.pager' setting should take precedence over PAGER when SQITCH_PAGER is not set."; } { local $ENV{SQITCH_PAGER} = "less -rules"; local $ENV{PAGER} = "more -dontcare"; local $ENV{SQITCH_CONFIG} = File::Spec->catfile(qw/t sqitch.conf/); my $sqitch = App::Sqitch->new; is $sqitch->pager_program, "less -rules", "SQITCH_PAGER should take precedence over both PAGER and the `core.pager' setting."; } } ############################################################################## # Test message levels. Start with trace. $sqitch = $CLASS->new(verbosity => 3); is capture_stdout { $sqitch->trace('This ', "that\n", 'and the other') }, "trace: This that\ntrace: and the other\n", 'trace should work'; $sqitch = $CLASS->new(verbosity => 2); is capture_stdout { $sqitch->trace('This ', "that\n", 'and the other') }, '', 'Should get no trace output for verbosity 2'; # Trace literal $sqitch = $CLASS->new(verbosity => 3); is capture_stdout { $sqitch->trace_literal('This ', "that\n", 'and the other') }, "trace: This that\ntrace: and the other", 'trace_literal should work'; $sqitch = $CLASS->new(verbosity => 2); is capture_stdout { $sqitch->trace_literal('This ', "that\n", 'and the other') }, '', 'Should get no trace_literal output for verbosity 2'; # Debug. $sqitch = $CLASS->new(verbosity => 2); is capture_stdout { $sqitch->debug('This ', "that\n", 'and the other') }, "debug: This that\ndebug: and the other\n", 'debug should work'; $sqitch = $CLASS->new(verbosity => 1); is capture_stdout { $sqitch->debug('This ', "that\n", 'and the other') }, '', 'Should get no debug output for verbosity 1'; # Debug literal. $sqitch = $CLASS->new(verbosity => 2); is capture_stdout { $sqitch->debug_literal('This ', "that\n", 'and the other') }, "debug: This that\ndebug: and the other", 'debug_literal should work'; $sqitch = $CLASS->new(verbosity => 1); is capture_stdout { $sqitch->debug_literal('This ', "that\n", 'and the other') }, '', 'Should get no debug_literal output for verbosity 1'; # Info. $sqitch = $CLASS->new(verbosity => 1); is capture_stdout { $sqitch->info('This ', "that\n", 'and the other') }, "This that\nand the other\n", 'info should work'; $sqitch = $CLASS->new(verbosity => 0); is capture_stdout { $sqitch->info('This ', "that\n", 'and the other') }, '', 'Should get no info output for verbosity 0'; # Info literal. $sqitch = $CLASS->new(verbosity => 1); is capture_stdout { $sqitch->info_literal('This ', "that\n", 'and the other') }, "This that\nand the other", 'info_literal should work'; $sqitch = $CLASS->new(verbosity => 0); is capture_stdout { $sqitch->info_literal('This ', "that\n", 'and the other') }, '', 'Should get no info_literal output for verbosity 0'; # Comment. $sqitch = $CLASS->new(verbosity => 1); is capture_stdout { $sqitch->comment('This ', "that\n", 'and the other') }, "# This that\n# and the other\n", 'comment should work'; $sqitch = $CLASS->new(verbosity => 0); is capture_stdout { $sqitch->comment('This ', "that\n", 'and the other') }, "# This that\n# and the other\n", 'comment should work with verbosity 0'; # Comment literal. $sqitch = $CLASS->new(verbosity => 1); is capture_stdout { $sqitch->comment_literal('This ', "that\n", 'and the other') }, "# This that\n# and the other", 'comment_literal should work'; $sqitch = $CLASS->new(verbosity => 0); is capture_stdout { $sqitch->comment_literal('This ', "that\n", 'and the other') }, "# This that\n# and the other", 'comment_literal should work with verbosity 0'; # Emit. is capture_stdout { $sqitch->emit('This ', "that\n", 'and the other') }, "This that\nand the other\n", 'emit should work'; $sqitch = $CLASS->new(verbosity => 0); is capture_stdout { $sqitch->emit('This ', "that\n", 'and the other') }, "This that\nand the other\n", 'emit should work even with verbosity 0'; # Emit literal. is capture_stdout { $sqitch->emit_literal('This ', "that\n", 'and the other') }, "This that\nand the other", 'emit_literal should work'; $sqitch = $CLASS->new(verbosity => 0); is capture_stdout { $sqitch->emit_literal('This ', "that\n", 'and the other') }, "This that\nand the other", 'emit_literal should work even with verbosity 0'; # Warn. is capture_stderr { $sqitch->warn('This ', "that\n", 'and the other') }, "warning: This that\nwarning: and the other\n", 'warn should work'; # Warn_Literal. is capture_stderr { $sqitch->warn_literal('This ', "that\n", 'and the other') }, "warning: This that\nwarning: and the other", 'warn_literal should work'; # Vent. is capture_stderr { $sqitch->vent('This ', "that\n", 'and the other') }, "This that\nand the other\n", 'vent should work'; # Vent literal. is capture_stderr { $sqitch->vent_literal('This ', "that\n", 'and the other') }, "This that\nand the other", 'vent_literal should work'; ############################################################################## # Test run(). can_ok $CLASS, 'run'; my ($stdout, $stderr) = capture { ok $sqitch->run( $^X, 'echo.pl', qw(hi there) ), 'Should get success back from run echo'; }; is $stdout, "hi there\n", 'The echo script should have run'; is $stderr, '', 'Nothing should have gone to STDERR'; ($stdout, $stderr) = capture { throws_ok { $sqitch->run( $^X, 'die.pl', qw(hi there)) } qr/unexpectedly returned/, 'run die should, well, die'; }; is $stdout, "hi there\n", 'The die script should have its STDOUT ummolested'; like $stderr, qr/OMGWTF/, 'The die script should have its STDERR unmolested'; ############################################################################## # Test shell(). can_ok $CLASS, 'shell'; my $pl = $sqitch->quote_shell($^X); ($stdout, $stderr) = capture { ok $sqitch->shell( "$pl echo.pl hi there" ), 'Should get success back from shell echo'; }; is $stdout, "hi there\n", 'The echo script should have shell'; is $stderr, '', 'Nothing should have gone to STDERR'; ($stdout, $stderr) = capture { throws_ok { $sqitch->shell( "$pl die.pl hi there" ) } qr/unexpectedly returned/, 'shell die should, well, die'; }; is $stdout, "hi there\n", 'The die script should have its STDOUT ummolested'; like $stderr, qr/OMGWTF/, 'The die script should have its STDERR unmolested'; ############################################################################## # Test quote_shell(). my $quoter = do { if ($^O eq 'MSWin32') { require Win32::ShellQuote; \&Win32::ShellQuote::quote_native; } else { require String::ShellQuote; \&String::ShellQuote::shell_quote; } }; is $sqitch->quote_shell(qw(foo bar baz), 'hi there'), $quoter->(qw(foo bar baz), 'hi there'), 'quote_shell should work'; ############################################################################## # Test capture(). can_ok $CLASS, 'capture'; is $sqitch->capture($^X, 'echo.pl', qw(hi there)), "hi there\n", 'The echo script output should have been returned'; like capture_stderr { throws_ok { $sqitch->capture($^X, 'die.pl', qw(hi there)) } qr/unexpectedly returned/, 'Should get an error if the command errors out'; }, qr/OMGWTF/m, 'The die script STDERR should have passed through'; ############################################################################## # Test probe(). can_ok $CLASS, 'probe'; is $sqitch->probe($^X, 'echo.pl', qw(hi there), "\nyo"), "hi there ", 'Should have just chomped first line of output'; ############################################################################## # Test spool(). can_ok $CLASS, 'spool'; my $data = "hi\nthere\n"; open my $fh, '<', \$data; is capture_stdout { ok $sqitch->spool($fh, $^X, 'read.pl'), 'Spool to read.pl'; }, $data, 'Data should have been sent to STDOUT by read.pl'; seek $fh, 0, 0; open my $fh2, '<', \$CLASS; is capture_stdout { ok $sqitch->spool([$fh, $fh2], $^X, 'read.pl'), 'Spool to read.pl'; }, $data . $CLASS, 'All data should have been sent to STDOUT by read.pl'; like capture_stderr { local $ENV{LANGUAGE} = 'en'; throws_ok { $sqitch->spool($fh, $^X, 'die.pl') } 'App::Sqitch::X', 'Should get error when die.pl dies'; is $@->ident, 'io', 'Error ident should be "io"'; like $@->message, qr/\Q$^X\E unexpectedly returned exit value |\QError closing pipe to/, 'The error message should be one of the I/O messages'; }, qr/OMGWTF/, 'The die script STDERR should have passed through'; throws_ok { local $ENV{LANGUAGE} = 'en'; $sqitch->spool($fh, '--nosuchscript.ply--') } 'App::Sqitch::X', 'Should get an error for a bad command'; is $@->ident, 'io', 'Error ident should be "io"'; like $@->message, qr/\QCannot exec --nosuchscript.ply--:\E|\QError closing pipe to --nosuchscript.ply--:/, 'Error message should be about inability to exec'; ############################################################################## # Test prompt(). throws_ok { $sqitch->prompt } 'App::Sqitch::X', 'Should get error for no prompt message'; is $@->ident, 'DEV', 'No prompt ident should be "DEV"'; is $@->message, 'prompt() called without a prompt message', 'No prompt error message should be correct'; my $sqitch_mock = Test::MockModule->new($CLASS); my $input = 'hey'; $sqitch_mock->mock(_readline => sub { $input }); my $unattended = 0; $sqitch_mock->mock(_is_unattended => sub { $unattended }); is capture_stdout { is $sqitch->prompt('hi'), 'hey', 'Prompt should return input'; }, 'hi ', 'Prompt should prompt'; $input = 'how'; is capture_stdout { is $sqitch->prompt('hi', 'blah'), 'how', 'Prompt with default should return input'; }, 'hi [blah] ', 'Prompt should prompt with default'; $input = 'hi'; is capture_stdout { is $sqitch->prompt('hi', undef), 'hi', 'Prompt with undef default should return input'; }, 'hi [] ', 'Prompt should prompt with bracket for undef default'; $input = undef; is capture_stdout { is $sqitch->prompt('hi', 'yo'), 'yo', 'Prompt should return default for undef input'; }, 'hi [yo] ', 'Prompt should show default when undef input'; $input = ''; is capture_stdout { is $sqitch->prompt('hi', 'yo'), 'yo', 'Prompt should return input for empty input'; }, 'hi [yo] ', 'Prompt should show default when empty input'; $unattended = 1; throws_ok { is capture_stdout { $sqitch->prompt('yo') }, "yo \n", 'Unattended message should be emitted'; } 'App::Sqitch::X', 'Should get error when uattended and no default'; is $@->ident, 'io', 'Unattended error ident should be "io"'; is $@->message, __( 'Sqitch seems to be unattended and there is no default value for this question' ), 'Unattended error message should be correct'; is capture_stdout { is $sqitch->prompt('hi', 'yo'), 'yo', 'Prompt should return input'; }, "hi [yo] yo\n", 'Prompt should show default as selected when unattended'; ############################################################################## # Test ask_y_n(). throws_ok { $sqitch->ask_y_n } 'App::Sqitch::X', 'Should get error for no ask_y_n message'; is $@->ident, 'DEV', 'No ask_y_n ident should be "DEV"'; is $@->message, 'ask_y_n() called without a prompt message', 'No ask_y_n error message should be correct'; throws_ok { $sqitch->ask_y_n('hi', 'b') } 'App::Sqitch::X', 'Should get error for invalid ask_y_n default'; is $@->ident, 'DEV', 'Invalid ask_y_n default ident should be "DEV"'; is $@->message, 'Invalid default value: ask_y_n() default must be "y" or "n"', 'Invalid ask_y_n default error message should be correct'; $input = 'y'; $unattended = 0; is capture_stdout { ok $sqitch->ask_y_n('hi'), 'ask_y_n should return true for "y" input'; }, 'hi ', 'ask_y_n() should prompt'; $input = 'no'; is capture_stdout { ok !$sqitch->ask_y_n('howdy'), 'ask_y_n should return false for "no" input'; }, 'howdy ', 'ask_y_n() should prompt for no'; $input = 'Nein'; is capture_stdout { ok !$sqitch->ask_y_n('howdy'), 'ask_y_n should return false for "Nein"'; }, 'howdy ', 'ask_y_n() should prompt for no'; $input = 'Yep'; is capture_stdout { ok $sqitch->ask_y_n('howdy'), 'ask_y_n should return true for "Yep"'; }, 'howdy ', 'ask_y_n() should prompt for yes'; $input = ''; is capture_stdout { ok $sqitch->ask_y_n('whu?', 'y'), 'ask_y_n should return true default "y"'; }, 'whu? [y] ', 'ask_y_n() should prompt and show default "y"'; is capture_stdout { ok !$sqitch->ask_y_n('whu?', 'n'), 'ask_y_n should return false default "n"'; }, 'whu? [n] ', 'ask_y_n() should prompt and show default "n"'; my $please = __ 'Please answer "y" or "n".'; $input = 'ha!'; throws_ok { is capture_stdout { $sqitch->ask_y_n('hi') }, "hi \n$please\nhi \n$please\nhi \n", 'Should get prompts for repeated bad answers'; } 'App::Sqitch::X', 'Should get error for bad answers'; is $@->ident, 'io', 'Bad answers ident should be "IO"'; is $@->message, __ 'No valid answer after 3 attempts; aborting', 'Bad answers message should be correct'; ############################################################################## # Test _readline. $sqitch_mock->unmock('_readline'); $input = 'hep'; open my $stdin, '<', \$input; *STDIN = $stdin; is $sqitch->_readline, $input, '_readline should work'; $unattended = 1; is $sqitch->_readline, undef, '_readline should return undef when unattended'; $sqitch_mock->unmock_all; ############################################################################## # Make sure Test::LocaleDomain gives us decoded strings. for my $lang (qw(en fr)) { local $ENV{LANGUAGE} = $lang; my $text = __x 'On database {db}', db => 'foo'; ok utf8::valid($text), 'Localied string should be valid UTF-8'; ok utf8::is_utf8($text), 'Localied string should be decoded'; } App-Sqitch-0.9996/t/blank.t000644 000767 000024 00000010247 13133201371 015554 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 34; #use Test::More 'no_plan'; use Locale::TextDomain qw(App-Sqitch); use Test::NoWarnings; use Test::Exception; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; use Test::MockModule; use Test::File; use Test::File::Contents 0.20; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Plan::Blank'; require_ok $CLASS or die; } can_ok $CLASS, qw( name lspace rspace note plan request_note note_prompt ); my $sqitch = App::Sqitch->new(options => { engine => 'sqlite'}); my $target = App::Sqitch::Target->new(sqitch => $sqitch); my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target); isa_ok my $blank = $CLASS->new( name => 'foo', plan => $plan, ), $CLASS; isa_ok $blank, 'App::Sqitch::Plan::Line'; is $blank->format_name, '', 'Name should format as ""'; is $blank->as_string, '', 'should stringify to ""'; ok $blank = $CLASS->new( name => 'howdy', plan => $plan, lspace => ' ', rspace => "\t", note => 'blah blah blah', ), 'Create tag with more stuff'; is $blank->as_string, " \t# blah blah blah", 'It should stringify correctly'; ok $blank = $CLASS->new(plan => $plan, note => "foo\nbar\nbaz\\\n"), 'Create a blank with newlines and backslashes in the note'; is $blank->note, "foo\nbar\nbaz\\", 'The newlines and backslashe should not be escaped'; is $blank->format_note, '# foo\\nbar\\nbaz\\\\', 'The newlines and backslahs should be escaped by format_note'; ok $blank = $CLASS->new(plan => $plan, note => "foo\\nbar\\nbaz\\\\\\n"), 'Create a blank with escapes'; is $blank->note, "foo\nbar\nbaz\\\n", 'Note shoud be unescaped'; for my $spec ( ["\n\n\nfoo" => 'foo', 'Leading newlines' ], ["\r\r\rfoo" => 'foo', 'Leading line feeds' ], ["foo\n\n\n" => 'foo', 'Trailing newlines' ], ["foo\r\r\r" => 'foo', 'trailing line feeds' ], ["\r\n\r\n\r\nfoo\n\nbar\r" => "foo\n\nbar", 'Leading and trailing vertical space' ], ["\n\n\n foo \n" => 'foo', 'Leading and trailing newlines and spaces' ], ) { is $CLASS->new( plan => $plan, note => $spec->[0] )->note, $spec->[1], "Should trim $spec->[2] from note"; } ############################################################################## # Test note requirement. is $blank->note_prompt(for => 'add'), __x( "Write a {command} note.\nLines starting with '#' will be ignored.", command => 'add' ), 'Should have localized not prompt'; my $sqitch_mocker = Test::MockModule->new('App::Sqitch'); my $note = ''; my $for = 'add'; $sqitch_mocker->mock(shell => sub { my ( $self, $cmd ) = @_; my $editor = $sqitch->editor; ok $cmd =~ s/^\Q$editor\E //, 'Shell command should start with editor'; my $fn = $cmd; file_exists_ok $fn, 'Temp file should exist'; ( my $prompt = $CLASS->note_prompt(for => $for) ) =~ s/^/# /gms; file_contents_eq $fn, "\n$prompt\n", 'Temp file contents should include prompt', { encoding => ':raw:utf8_strict' }; if ($note) { open my $fh, '>:utf8_strict', $fn or die "Cannot open $fn: $!"; print $fh $note, $prompt, "\n"; close $fh or die "Error closing $fn: $!"; } }); # Do no actual shell quoting. $sqitch_mocker->mock(quote_shell => sub { shift; join ' ' => @_ }); throws_ok { $CLASS->new(plan => $plan )->request_note(for => $for) } 'App::Sqitch::X', 'Should get exception for no note text'; is $@->ident, 'plan', 'No note error ident should be "plan"'; is $@->message, __ 'Aborting due to empty note', 'No note error message should be correct'; is $@->exitval, 1, 'Exit val should be 1'; # Now write a note. $for = 'rework'; $note = "This is my awesome note.\n"; $blank = $CLASS->new(plan => $plan ); is $blank->request_note(for => $for), 'This is my awesome note.', 'Request note'; $note = ''; is $blank->note, 'This is my awesome note.', 'Should have the edited note'; is $blank->request_note(for => $for), 'This is my awesome note.', 'The request should not prompt again'; App-Sqitch-0.9996/t/bundle.t000644 000767 000024 00000046476 13133201371 015753 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 304; #use Test::More 'no_plan'; use App::Sqitch; use Path::Class; use Test::Exception; use Test::Dir; use Test::File qw(file_exists_ok file_not_exists_ok); use Test::File::Contents; use Locale::TextDomain qw(App-Sqitch); use File::Path qw(make_path remove_tree); use Test::NoWarnings; use lib 't/lib'; use MockOutput; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::Command::bundle'; ok my $sqitch = App::Sqitch->new, 'Load a sqitch object'; my $config = $sqitch->config; isa_ok my $bundle = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'bundle', config => $config, }), $CLASS, 'bundle command'; can_ok $CLASS, qw( configure execute from to dest_dir dest_top_dir dest_dirs_for bundle_config bundle_plan bundle_scripts _mkpath _copy_if_modified ); is_deeply [$CLASS->options], [qw( dest-dir|dir=s all|a! from=s to=s )], 'Should have dest_dir option'; is $bundle->dest_dir, dir('bundle'), 'Default dest_dir should be bundle/'; is $bundle->dest_top_dir($bundle->default_target), dir('bundle'), 'Should have dest top dir'; ############################################################################## # Test configure(). is_deeply $CLASS->configure($config, {}), {}, 'Default config should be empty'; is_deeply $CLASS->configure($config, {dest_dir => 'whu'}), { dest_dir => dir 'whu', }, '--dest_dir should be converted to a path object by configure()'; is_deeply $CLASS->configure($config, {from => 'HERE', to => 'THERE'}), { from => 'HERE', to => 'THERE', }, '--from and --to should be passed through configure'; chdir 't'; $ENV{SQITCH_CONFIG} = 'sqitch.conf'; END { remove_tree 'bundle' if -d 'bundle' } ok $sqitch = App::Sqitch->new( options => { top_dir => dir('sql')->stringify }, ), 'Load a sqitch object with top_dir'; $config = $sqitch->config; my $dir = dir qw(_build sql); is_deeply $CLASS->configure($config, {}), { dest_dir => $dir, }, 'bundle.dest_dir config should be converted to a path object by configure()'; ############################################################################## # Load a real project. isa_ok $bundle = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'bundle', config => $config, }), $CLASS, 'another bundle command'; is $bundle->dest_dir, $dir, qq{dest_dir should be "$dir"}; is $bundle->dest_top_dir($bundle->default_target), dir(qw(_build sql sql)), 'Dest top dir should be _build/sql/sql/'; my $target = $bundle->default_target; my $dir_for = $bundle->dest_dirs_for($target); for my $sub (qw(deploy revert verify)) { is $dir_for->{$sub}, $dir->subdir('sql', $sub), "Dest $sub dir should be _build/sql/sql/$sub"; } # Try engine project. ok $sqitch = App::Sqitch->new( options => { top_dir => dir('engine')->stringify, reworked_dir => dir(qw(engine reworked))->stringify, }, ), 'Load a sqitch object with engine top_dir'; isa_ok $bundle = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'bundle', config => $config, }), $CLASS, 'engine bundle command'; $target = $bundle->default_target; is $bundle->dest_dir, $dir, qq{dest_dir should again be "$dir"}; $dir_for = $bundle->dest_dirs_for($target); for my $sub (qw(deploy revert verify)) { is $dir_for->{$sub}, $dir->subdir('engine', $sub), "Dest $sub dir should be _build/sql/engine/$sub"; } ############################################################################## # Test _mkpath. my $path = dir 'delete.me'; dir_not_exists_ok $path, "Path $path should not exist"; END { remove_tree $path->stringify if -e $path } ok $bundle->_mkpath($path), "Create $path"; dir_exists_ok $path, "Path $path should now exist"; is_deeply +MockOutput->get_debug, [[' ', __x 'Created {file}', file => $path]], 'The mkdir info should have been output'; # Create it again. ok $bundle->_mkpath($path), "Create $path again"; dir_exists_ok $path, "Path $path should still exist"; is_deeply +MockOutput->get_debug, [], 'Nothing should have been emitted'; # Handle errors. FSERR: { # Make mkpath to insert an error. my $mock = Test::MockModule->new('File::Path'); $mock->mock( mkpath => sub { my ($file, $p) = @_; ${ $p->{error} } = [{ $file => 'Permission denied yo'}]; return; }); throws_ok { $bundle->_mkpath('foo') } 'App::Sqitch::X', 'Should fail on permission issue'; is $@->ident, 'bundle', 'Permission error should have ident "bundle"'; is $@->message, __x( 'Error creating {path}: {error}', path => 'foo', error => 'Permission denied yo', ), 'The permission error should be formatted properly'; } ############################################################################## # Test _copy(). my $file = file qw(sql deploy roles.sql); my $dest = file $path, qw(deploy roles.sql); file_not_exists_ok $dest, "File $dest should not exist"; ok $bundle->_copy_if_modified($file, $dest), "Copy $file to $dest"; file_exists_ok $dest, "File $dest should now exist"; file_contents_identical $dest, $file; is_deeply +MockOutput->get_debug, [ [' ', __x 'Created {file}', file => $dest->dir], [' ', __x( "Copying {source} -> {dest}", source => $file, dest => $dest )], ], 'The mkdir and copy info should have been output'; # Copy it again. ok $bundle->_copy_if_modified($file, $dest), "Copy $file to $dest again"; file_exists_ok $dest, "File $dest should still exist"; file_contents_identical $dest, $file; my $out = MockOutput->get_debug; is_deeply $out, [], 'Should have no debugging output' or diag explain $out; # Make it old and copy it again. utime 0, $file->stat->mtime - 1, $dest; ok $bundle->_copy_if_modified($file, $dest), "Copy $file to old $dest"; file_exists_ok $dest, "File $dest should still be there"; file_contents_identical $dest, $file; is_deeply +MockOutput->get_debug, [[' ', __x( "Copying {source} -> {dest}", source => $file, dest => $dest )]], 'Only copy message should again have been emitted'; # Copy a different file. my $file2 = file qw(sql deploy users.sql); $dest->remove; ok $bundle->_copy_if_modified($file2, $dest), "Copy $file2 to $dest"; file_exists_ok $dest, "File $dest should now exist"; file_contents_identical $dest, $file2; is_deeply +MockOutput->get_debug, [[' ', __x( "Copying {source} -> {dest}", source => $file2, dest => $dest )]], 'Again only Copy message should have been emitted'; # Try to copy a nonexistent file. my $nonfile = file 'nonexistent.txt'; throws_ok { $bundle->_copy_if_modified($nonfile, $dest) } 'App::Sqitch::X', 'Should get exception when source file does not exist'; is $@->ident, 'bundle', 'Nonexistent file error ident should be "bundle"'; is $@->message, __x( 'Cannot copy {file}: does not exist', file => $nonfile, ), 'Nonexistent file error message should be correct'; COPYDIE: { # Make copy die. $dest->remove; my $mocker = Test::MockModule->new('File::Copy'); $mocker->mock(copy => sub { return 0 }); throws_ok { $bundle->_copy_if_modified($file, $dest) } 'App::Sqitch::X', 'Should get exception when copy returns false'; is $@->ident, 'bundle', 'Copy fail ident should be "bundle"'; is $@->message, __x( 'Cannot copy "{source}" to "{dest}": {error}', source => $file, dest => $dest, error => $!, ), 'Copy fail error message should be correct'; } ############################################################################## # Test bundle_config(). END { my $to_remove = $dir->parent->stringify; remove_tree $to_remove if -e $to_remove; } $dest = file $dir, qw(sqitch.conf); file_not_exists_ok $dest; ok $bundle->bundle_config, 'Bundle the config file'; file_exists_ok $dest; file_contents_identical $dest, file('sqitch.conf'); is_deeply +MockOutput->get_info, [[__ 'Writing config']], 'Should have config notice'; ############################################################################## # Test bundle_plan(). $dest = file $bundle->dest_top_dir($bundle->default_target), qw(sqitch.plan); file_not_exists_ok $dest; ok $bundle->bundle_plan($bundle->default_target), 'Bundle the default target plan file'; file_exists_ok $dest; file_contents_identical $dest, file(qw(engine sqitch.plan)); is_deeply +MockOutput->get_info, [[__ 'Writing plan']], 'Should have plan notice'; # Make sure that --from works. isa_ok $bundle = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'bundle', config => $config, args => ['--from', 'widgets'], }), $CLASS, '--from bundle command'; is $bundle->from, 'widgets', 'From should be "widgets"'; ok $bundle->bundle_plan($bundle->default_target, 'widgets'), 'Bundle the default target plan file with from arg'; my $plan = $bundle->default_target->plan; is_deeply +MockOutput->get_info, [[__x( 'Writing plan from {from} to {to}', from => 'widgets', to => '@HEAD', )]], 'Statement of the bits written should have been emitted'; file_contents_is $dest, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . '%project=engine' . "\n" . "\n" . $plan->find('widgets')->as_string . "\n" . $plan->find('func/add_user')->as_string . "\n" . $plan->find('users@HEAD')->as_string . "\n", 'Plan should contain only changes from "widgets" on'; # Make sure that --to works. isa_ok $bundle = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'bundle', config => $config, args => ['--to', 'users'], }), $CLASS, '--to bundle command'; is $bundle->to, 'users', 'To should be "users"'; ok $bundle->bundle_plan($bundle->default_target, undef, 'users'), 'Bundle the default target plan file with to arg'; is_deeply +MockOutput->get_info, [[__x( 'Writing plan from {from} to {to}', from => '@ROOT', to => 'users', )]], 'Statement of the bits written should have been emitted'; file_contents_is $dest, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . '%project=engine' . "\n" . "\n" . $plan->find('users')->as_string . "\n" . join( "\n", map { $_->as_string } $plan->find('users')->tags ) . "\n", 'Plan should have written only "users" and its tags'; ############################################################################## # Test bundle_scripts(). my @scripts = ( $dir_for->{reworked_deploy}->file('users@alpha.sql'), $dir_for->{reworked_revert}->file('users@alpha.sql'), $dir_for->{deploy}->file('widgets.sql'), $dir_for->{revert}->file('widgets.sql'), $dir_for->{deploy}->file(qw(func add_user.sql)), $dir_for->{revert}->file(qw(func add_user.sql)), $dir_for->{deploy}->file('users.sql'), $dir_for->{revert}->file('users.sql'), ); file_not_exists_ok $_ for @scripts; ok $sqitch = App::Sqitch->new( options => { extension => 'sql', top_dir => dir('engine')->stringify, reworked_dir => dir(qw(engine reworked))->stringify, }, ), 'Load engine sqitch object'; isa_ok $bundle = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'bundle', config => $config, }), $CLASS, 'another bundle command'; ok $bundle->bundle_scripts($bundle->default_target), 'Bundle default target scripts'; file_exists_ok $_ for @scripts; is_deeply +MockOutput->get_info, [ [__ 'Writing scripts'], [' + ', 'users @alpha'], [' + ', 'widgets'], [' + ', 'func/add_user'], [' + ', 'users'], ], 'Should have change notices'; # Make sure that --from works. remove_tree $dir->parent->stringify; isa_ok $bundle = App::Sqitch::Command::bundle->new( sqitch => $sqitch, dest_dir => $bundle->dest_dir, from => 'widgets', ), $CLASS, 'bundle from "widgets"'; ok $bundle->bundle_scripts($bundle->default_target, 'widgets'), 'Bundle scripts'; file_not_exists_ok $_ for @scripts[0,1]; file_exists_ok $_ for @scripts[2,3]; is_deeply +MockOutput->get_info, [ [__ 'Writing scripts'], [' + ', 'widgets'], [' + ', 'func/add_user'], [' + ', 'users'], ], 'Should have changes only from "widets" onward in notices'; # Make sure that --to works. remove_tree $dir->parent->stringify; isa_ok $bundle = App::Sqitch::Command::bundle->new( sqitch => $sqitch, dest_dir => $bundle->dest_dir, to => 'users@alpha', ), $CLASS, 'bundle to "users"'; ok $bundle->bundle_scripts($bundle->default_target, undef, 'users@alpha'), 'Bundle scripts'; file_exists_ok $_ for @scripts[0,1]; file_not_exists_ok $_ for @scripts[2,3]; is_deeply +MockOutput->get_info, [ [__ 'Writing scripts'], [' + ', 'users @alpha'], ], 'Should have only "users" in change notices'; # Should throw exceptions on unknonw changes. for my $key (qw(from to)) { my $bundle = $CLASS->new( sqitch => $sqitch, $key => 'nonexistent' ); throws_ok { $bundle->bundle_scripts($bundle->default_target, 'nonexistent') } 'App::Sqitch::X', "Should die on nonexistent $key change"; is $@->ident, 'bundle', qq{Nonexistent $key change ident should be "bundle"}; is $@->message, __x( 'Cannot find change {change}', change => 'nonexistent', ), "Nonexistent $key message change should be correct"; } ############################################################################## # Test execute(). MockOutput->get_debug; remove_tree $dir->parent->stringify; @scripts = ( file($dir, 'sqitch.conf'), file($bundle->dest_top_dir($bundle->default_target), 'sqitch.plan'), @scripts, ); file_not_exists_ok $_ for @scripts; isa_ok $bundle = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'bundle', config => $config, }), $CLASS, 'another bundle command'; ok $bundle->execute, 'Execute!'; file_exists_ok $_ for @scripts; is_deeply +MockOutput->get_info, [ [__x 'Bundling into {dir}', dir => $bundle->dest_dir ], [__ 'Writing config'], [__ 'Writing plan'], [__ 'Writing scripts'], [' + ', 'users @alpha'], [' + ', 'widgets'], [' + ', 'func/add_user'], [' + ', 'users'], ], 'Should have all notices'; # Try a configuration with multiple plans. my $multidir = $dir->parent; END { remove_tree $multidir->stringify } remove_tree $multidir->stringify; my @sql = ( $multidir->file(qw(sql sqitch.plan)), $multidir->file(qw(sql deploy roles.sql)), $multidir->file(qw(sql deploy users.sql)), $multidir->file(qw(sql verify users.sql)), $multidir->file(qw(sql deploy widgets.sql)), ); my @engine = ( $multidir->file(qw(engine sqitch.plan)), $multidir->file(qw(engine reworked deploy users@alpha.sql)), $multidir->file(qw(engine reworked revert users@alpha.sql)), $multidir->file(qw(engine deploy widgets.sql)), $multidir->file(qw(engine revert widgets.sql)), $multidir->file(qw(engine deploy func add_user.sql)), $multidir->file(qw(engine revert func add_user.sql)), $multidir->file(qw(engine deploy users.sql)), $multidir->file(qw(engine revert users.sql)), ); my $conf_file = $multidir->file('multiplan.conf'),; file_not_exists_ok $_ for ($conf_file, @sql, @engine); local $ENV{SQITCH_CONFIG} = 'multiplan.conf'; $sqitch = App::Sqitch->new; isa_ok $bundle = $CLASS->new( sqitch => $sqitch, config => $sqitch->config, all => 1, dest_dir => dir '_build', ), $CLASS, 'all xmultiplan bundle command'; ok $bundle->execute, 'Execute multi-target bundle!'; file_exists_ok $_ for ($conf_file, @sql, @engine); # Make sure we get an error with both --all and a specified target. throws_ok { $bundle->execute('pg' ) } 'App::Sqitch::X', 'Should get an error for --all and a target arg'; is $@->ident, 'bundle', 'Mixed arguments error ident should be "bundle"'; is $@->message, __( 'Cannot specify both --all and engine, target, or plan arugments' ), 'Mixed arguments error message should be correct'; # Try without --all. isa_ok $bundle = $CLASS->new( sqitch => $sqitch, config => $sqitch->config, dest_dir => dir '_build', ), $CLASS, 'multiplan bundle command'; remove_tree $multidir->stringify; ok $bundle->execute, qq{Execute with no arg}; file_exists_ok $_ for ($conf_file, @engine); file_not_exists_ok $_ for @sql; # Make sure it works with bundle.all set, as well. my $cmock = Test::MockModule->new('App::Sqitch::Config'); my $get; $cmock->mock( get => sub { return 1 if $_[2] eq 'bundle.all'; return $get->(@_); }); $get = $cmock->original('get'); remove_tree $multidir->stringify; ok $bundle->execute, qq{Execute with bundle.all config}; file_exists_ok $_ for ($conf_file, @engine, @sql); $cmock->unmock_all; # Try limiting it in various ways. for my $spec ( [ target => 'pg', { include => \@engine, exclude => \@sql }, ], [ 'plan file' => file(qw(engine sqitch.plan))->stringify, { include => \@engine, exclude => \@sql }, ], [ target => 'mysql', { include => \@sql, exclude => \@engine }, ], [ 'plan file' => file(qw(sql sqitch.plan))->stringify, { include => \@sql, exclude => \@engine }, ], ) { my ($type, $arg, $files) = @{ $spec }; remove_tree $multidir->stringify; ok $bundle->execute($arg), qq{Execute with $type arg "$arg"}; file_exists_ok $_ for ($conf_file, @{ $files->{include} }); file_not_exists_ok $_ for @{ $files->{exclude} }; } # Make sure we handle --to and --from. isa_ok $bundle = $CLASS->new( sqitch => $sqitch, config => $sqitch->config, from => 'widgets', to => 'widgets', dest_dir => dir '_build', ), $CLASS, 'to/from bundle command'; remove_tree $multidir->stringify; ok $bundle->execute('pg'), 'Execute to/from bundle!'; file_exists_ok $_ for ($conf_file, @engine[0,3,4]); file_not_exists_ok $_ for (@engine[1,2,5..$#engine]); file_contents_is $engine[0], '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . '%project=engine' . "\n" . "\n" . $plan->find('widgets')->as_string . "\n", 'Plan should have written only "widgets"'; # Make sure we handle to and from args. isa_ok $bundle = $CLASS->new( sqitch => $sqitch, config => $sqitch->config, dest_dir => dir '_build', ), $CLASS, 'another bundle command'; remove_tree $multidir->stringify; ok $bundle->execute(qw(pg widgets @HEAD)), 'Execute bundle with to/from args!'; file_exists_ok $_ for ($conf_file, @engine[0,3..$#engine]); file_not_exists_ok $_ for (@engine[1,2]); file_contents_is $engine[0], '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . '%project=engine' . "\n" . "\n" . $plan->find('widgets')->as_string . "\n" . $plan->find('func/add_user')->as_string . "\n" . $plan->find('users@HEAD')->as_string . "\n", 'Plan should have written "widgets" and "func/add_user"'; # Should die on unknown argument. throws_ok { $bundle->execute('nonesuch') } 'App::Sqitch::X', 'Should get an exception for unknown argument'; is $@->ident, 'bundle', 'Unknown argument error ident shoud be "bundle"'; is $@->message, __x( 'Unknown argument "{arg}"', arg => 'nonesuch', ), 'Unknown argument error message should be correct'; # Should handle multiple arguments, too. throws_ok { $bundle->execute(qw(ba da dum)) } 'App::Sqitch::X', 'Should get an exception for unknown arguments'; is $@->ident, 'bundle', 'Unknown arguments error ident shoud be "bundle"'; is $@->message, __x( 'Unknown arguments: {arg}', arg => join ', ', qw(ba da dum) ), 'Unknown arguments error message should be correct'; App-Sqitch-0.9996/t/change.t000644 000767 000024 00000037617 13133201371 015724 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 97; #use Test::More 'no_plan'; use Test::NoWarnings; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; use App::Sqitch::Plan::Tag; use Encode qw(encode_utf8); use Locale::TextDomain qw(App-Sqitch); use Test::Exception; use Path::Class; use File::Path qw(make_path remove_tree); use Digest::SHA; use Test::MockModule; use URI; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Plan::Change'; require_ok $CLASS or die; } $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; can_ok $CLASS, qw( name info id old_info old_id lspace rspace note parent since_tag rework_tags add_rework_tags is_reworked tags add_tag plan deploy_dir deploy_file script_hash revert_dir revert_file revert_dir verify_file requires conflicts timestamp planner_name planner_email format_name format_dependencies format_name_with_tags format_tag_qualified_name format_name_with_dependencies format_op_name_dependencies format_planner note_prompt ); my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => dir('test-change')->stringify, }); my $target = App::Sqitch::Target->new( sqitch => $sqitch, reworked_dir => dir('test-change/reworked'), ); my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target); make_path 'test-change'; END { remove_tree 'test-change' }; my $fn = $target->plan_file; open my $fh, '>', $fn or die "Cannot open $fn: $!"; say $fh "%project=change\n\n"; close $fh or die "Error closing $fn: $!"; isa_ok my $change = $CLASS->new( name => 'foo', plan => $plan, ), $CLASS; isa_ok $change, 'App::Sqitch::Plan::Line'; ok $change->is_deploy, 'It should be a deploy change'; ok !$change->is_revert, 'It should not be a revert change'; is $change->action, 'deploy', 'And it should say so'; isa_ok $change->timestamp, 'App::Sqitch::DateTime', 'Timestamp'; my $tag = App::Sqitch::Plan::Tag->new( plan => $plan, name => 'alpha', change => $change, ); is_deeply [ $change->path_segments ], ['foo.sql'], 'path_segments should have the file name'; is $change->deploy_dir, $target->deploy_dir, 'The deploy dir should be correct'; is $change->deploy_file, $target->deploy_dir->file('foo.sql'), 'The deploy file should be correct'; is $change->revert_dir, $target->revert_dir, 'The revert dir should be correct'; is $change->revert_file, $target->revert_dir->file('foo.sql'), 'The revert file should be correct'; is $change->verify_dir, $target->verify_dir, 'The verify dir should be correct'; is $change->verify_file, $target->verify_dir->file('foo.sql'), 'The verify file should be correct'; ok !$change->is_reworked, 'The change should not be reworked'; is_deeply [ $change->path_segments ], ['foo.sql'], 'path_segments should not include suffix'; # Test script_hash. is $change->script_hash, undef, 'Nonexistent deploy script hash should be undef'; make_path $change->deploy_dir->stringify; $change->deploy_file->spew(iomode => '>:raw', encode_utf8 "Foo\nBar\nBøz\n亜唖娃阿" ); $change = $CLASS->new( name => 'foo', plan => $plan ); is $change->script_hash, 'd48866b846300912570f643c99b2ceec4ba29f5c', 'Deploy script hash should be correct'; is $change->format_tag_qualified_name, 'foo@HEAD', 'Tag-qualified name should be tagged with @HEAD'; # Identify it as reworked. ok $change->add_rework_tags($tag), 'Add a rework tag'; is_deeply [$change->rework_tags], [$tag], 'Reworked tag should be stored'; ok $change->is_reworked, 'The change should be reworked'; $change->deploy_dir->mkpath; $change->deploy_dir->file('foo@alpha.sql')->touch; is_deeply [ $change->path_segments ], ['foo@alpha.sql'], 'path_segments should now include suffix'; # Make sure all rework tags are searched. $change->clear_rework_tags; ok !$change->is_reworked, 'The change should not be reworked'; my $tag2 = App::Sqitch::Plan::Tag->new( plan => $plan, name => 'beta', change => $change, ); ok $change->add_rework_tags($tag2, $tag), 'Add two rework tags'; ok $change->is_reworked, 'The change should again be reworked'; is_deeply [ $change->path_segments ], ['foo@alpha.sql'], 'path_segments should now include the correct suffixc'; is $change->format_name, 'foo', 'Name should format as "foo"'; is $change->format_name_with_tags, 'foo', 'Name should format with tags as "foo"'; is $change->format_tag_qualified_name, 'foo@beta', 'Tag-qualified Name should format as "foo@beta"'; is $change->format_dependencies, '', 'Dependencies should format as ""'; is $change->format_name_with_dependencies, 'foo', 'Name should format with dependencies as "foo"'; is $change->format_op_name_dependencies, 'foo', 'Name should format op without dependencies as "foo"'; is $change->format_content, 'foo ' . $change->timestamp->as_string . ' ' . $change->format_planner, 'Change content should format correctly without dependencies'; is $change->planner_name, $sqitch->user_name, 'Planner name shoudld default to user name'; is $change->planner_email, $sqitch->user_email, 'Planner email shoudld default to user email'; is $change->format_planner, join( ' ', $sqitch->user_name, '<' . $sqitch->user_email . '>' ), 'Planner name and email should format properly'; my $ts = $change->timestamp->as_string; is $change->as_string, "foo $ts " . $change->format_planner, 'should stringify to "foo" + planner'; is $change->since_tag, undef, 'Since tag should be undef'; is $change->parent, undef, 'Parent should be undef'; is $change->old_info, join("\n", 'project change', 'change foo', 'planner ' . $change->format_planner, 'date ' . $change->timestamp->as_string, ), 'Old change info should be correct'; is $change->old_id, do { my $content = encode_utf8 $change->old_info; Digest::SHA->new(1)->add( 'change ' . length($content) . "\0" . $content )->hexdigest; },'Old change ID should be correct'; is $change->info, join("\n", 'project change', 'change foo', 'planner ' . $change->format_planner, 'date ' . $change->timestamp->as_string, ), 'Change info should be correct'; is $change->id, do { my $content = encode_utf8 $change->info; Digest::SHA->new(1)->add( 'change ' . length($content) . "\0" . $content )->hexdigest; },'Change ID should be correct'; my $date = App::Sqitch::DateTime->new( year => 2012, month => 7, day => 16, hour => 17, minute => 25, second => 7, time_zone => 'UTC', ); sub dep($) { App::Sqitch::Plan::Depend->new( %{ App::Sqitch::Plan::Depend->parse(shift) }, plan => $target->plan, project => 'change', ) } ok my $change2 = $CLASS->new( name => 'yo/howdy', plan => $plan, since_tag => $tag, parent => $change, lspace => ' ', operator => '-', ropspace => ' ', rspace => "\t", suffix => '@beta', note => 'blah blah blah ', pspace => ' ', requires => [map { dep $_ } qw(foo bar @baz)], conflicts => [dep '!dr_evil'], timestamp => $date, planner_name => 'Barack Obama', planner_email => 'potus@whitehouse.gov', ), 'Create change with more stuff'; my $ts2 = '2012-07-16T17:25:07Z'; is $change2->as_string, " - yo/howdy [foo bar \@baz !dr_evil] " . "$ts2 Barack Obama \t# blah blah blah", 'It should stringify correctly'; my $mock_plan = Test::MockModule->new(ref $plan); $mock_plan->mock(index_of => 0); my $uri = URI->new('https://github.com/theory/sqitch/'); $mock_plan->mock( uri => $uri ); ok !$change2->is_deploy, 'It should not be a deploy change'; ok $change2->is_revert, 'It should be a revert change'; is $change2->action, 'revert', 'It should say so'; is $change2->since_tag, $tag, 'It should have a since tag'; is $change2->parent, $change, 'It should have a parent'; is $change2->old_info, join("\n", 'project change', 'uri https://github.com/theory/sqitch/', 'change yo/howdy', 'planner Barack Obama ', 'date 2012-07-16T17:25:07Z' ), 'Old info should not since tag'; is $change2->info, join("\n", 'project change', 'uri https://github.com/theory/sqitch/', 'change yo/howdy', 'parent ' . $change->id, 'planner Barack Obama ', 'date 2012-07-16T17:25:07Z', 'requires', ' + foo', ' + bar', ' + @baz', 'conflicts', ' - dr_evil', '', 'blah blah blah' ), 'Info should include parent and dependencies'; # Check tags. is_deeply [$change2->tags], [], 'Should have no tags'; ok $change2->add_tag($tag), 'Add a tag'; is_deeply [$change2->tags], [$tag], 'Should have the tag'; is $change2->format_name_with_tags, 'yo/howdy @alpha', 'Should format name with tags'; is $change2->format_tag_qualified_name, 'yo/howdy@alpha', 'Should format tag-qualiified name'; # Add another tag. ok $change2->add_tag($tag2), 'Add another tag'; is_deeply [$change2->tags], [$tag, $tag2], 'Should have both tags'; is $change2->format_name_with_tags, 'yo/howdy @alpha @beta', 'Should format name with both tags'; is $change2->format_tag_qualified_name, 'yo/howdy@alpha', 'Should format tag-qualified name with first tag'; is $change2->format_planner, 'Barack Obama ', 'Planner name and email should format properly'; is $change2->format_dependencies, '[foo bar @baz !dr_evil]', 'Dependencies should format as "[foo bar @baz !dr_evil]"'; is $change2->format_name_with_dependencies, 'yo/howdy [foo bar @baz !dr_evil]', 'Name should format with dependencies as "yo/howdy [foo bar @baz !dr_evil]"'; is $change2->format_op_name_dependencies, '- yo/howdy [foo bar @baz !dr_evil]', 'Name should format op with dependencies as "yo/howdy [foo bar @baz !dr_evil]"'; is $change2->format_content, '- yo/howdy [foo bar @baz !dr_evil] ' . $change2->timestamp->as_string . ' ' . $change2->format_planner, 'Change content should format correctly with dependencies'; # Check file names. my @fn = ('yo', 'howdy@beta.sql'); $change2->add_rework_tags($tag2); is_deeply [ $change2->path_segments ], \@fn, 'path_segments should include directories'; is $change2->deploy_dir, $target->reworked_deploy_dir, 'Deploy dir should be in rworked dir'; is $change2->deploy_file, $target->reworked_deploy_dir->file(@fn), 'Deploy file should be in rworked dir and include suffix'; is $change2->revert_dir, $target->reworked_revert_dir, 'Revert dir should be in rworked dir'; is $change2->revert_file, $target->reworked_revert_dir->file(@fn), 'Revert file should be in rworked dir and include suffix'; is $change2->verify_dir, $target->reworked_verify_dir, 'Verify dir should be in rworked dir'; is $change2->verify_file, $target->reworked_verify_dir->file(@fn), 'Verify file should be in rworked dir and include suffix'; ############################################################################## # Test open_script. make_path dir(qw(test-change deploy))->stringify; file(qw(test-change deploy baz.sql))->touch; my $change2_file = file qw(test-change deploy bar.sql); $fh = $change2_file->open('>:utf8_strict') or die "Cannot open $change2_file: $!\n"; $fh->say('-- This is a comment'); $fh->say('# And so is this'); $fh->say('; and this, w€€!'); $fh->say('/* blah blah blah */'); $fh->close; ok $change2 = $CLASS->new( name => 'baz', plan => $plan ), 'Create change "baz"'; ok $change2 = $CLASS->new( name => 'bar', plan => $plan ), 'Create change "bar"'; ############################################################################## # Test file handles. ok $fh = $change2->deploy_handle, 'Get deploy handle'; is $fh->getline, "-- This is a comment\n", 'It should be the deploy file'; make_path dir(qw(test-change revert))->stringify; $fh = $change2->revert_file->open('>') or die "Cannot open " . $change2->revert_file . ": $!\n"; $fh->say('-- revert it, baby'); $fh->close; ok $fh = $change2->revert_handle, 'Get revert handle'; is $fh->getline, "-- revert it, baby\n", 'It should be the revert file'; make_path dir(qw(test-change verify))->stringify; $fh = $change2->verify_file->open('>') or die "Cannot open " . $change2->verify_file . ": $!\n"; $fh->say('-- verify it, baby'); $fh->close; ok $fh = $change2->verify_handle, 'Get verify handle'; is $fh->getline, "-- verify it, baby\n", 'It should be the verify file'; ############################################################################## # Test the requires/conflicts params. my $file = file qw(t plans multi.plan); my $sqitch2 = App::Sqitch->new(options => { engine => 'sqlite', top_dir => dir('test-change')->stringify, plan_file => $file->stringify, }); my $target2 = App::Sqitch::Target->new(sqitch => $sqitch2); my $plan2 = $target2->plan; ok $change2 = $CLASS->new( name => 'whatever', plan => $plan2, requires => [dep 'hey', dep 'you'], conflicts => [dep '!hey-there'], ), 'Create a change with explicit requires and conflicts'; is_deeply [$change2->requires], [dep 'hey', dep 'you'], 'requires should be set'; is_deeply [$change2->conflicts], [dep '!hey-there'], 'conflicts should be set'; is_deeply [$change2->dependencies], [dep 'hey', dep 'you', dep '!hey-there'], 'Dependencies should include requires and conflicts'; is_deeply [$change2->requires_changes], [$plan2->get('hey'), $plan2->get('you')], 'Should find changes for requires'; is_deeply [$change2->conflicts_changes], [$plan2->get('hey-there')], 'Should find changes for conflicts'; ############################################################################## # Test ID for a change with a UTF-8 name. ok $change2 = $CLASS->new( name => '阱阪阬', plan => $plan2, ), 'Create change with UTF-8 name'; is $change2->old_info, join("\n", 'project ' . 'multi', 'uri ' . $uri->canonical, 'change ' . '阱阪阬', 'planner ' . $change2->format_planner, 'date ' . $change2->timestamp->as_string, ), 'The name should be decoded text in old info'; is $change2->old_id, do { my $content = Encode::encode_utf8 $change2->old_info; Digest::SHA->new(1)->add( 'change ' . length($content) . "\0" . $content )->hexdigest; },'Old change ID should be hashed from encoded UTF-8'; is $change2->info, join("\n", 'project ' . 'multi', 'uri ' . $uri->canonical, 'change ' . '阱阪阬', 'planner ' . $change2->format_planner, 'date ' . $change2->timestamp->as_string, ), 'The name should be decoded text in info'; is $change2->id, do { my $content = Encode::encode_utf8 $change2->info; Digest::SHA->new(1)->add( 'change ' . length($content) . "\0" . $content )->hexdigest; },'Change ID should be hashed from encoded UTF-8'; ############################################################################## # Test note_prompt(). is $change->note_prompt( for => 'add', scripts => [$change->deploy_file, $change->revert_file, $change->verify_file], ), exp_prompt( for => 'add', scripts => [$change->deploy_file, $change->revert_file, $change->verify_file], name => $change->format_op_name_dependencies, ), 'note_prompt() should work'; is $change2->note_prompt( for => 'add', scripts => [$change2->deploy_file, $change2->revert_file, $change2->verify_file], ), exp_prompt( for => 'add', scripts => [$change2->deploy_file, $change2->revert_file, $change2->verify_file], name => $change2->format_op_name_dependencies, ), 'note_prompt() should work'; sub exp_prompt { my %p = @_; join( '', __x( "Please enter a note for your change. Lines starting with '#' will\n" . "be ignored, and an empty message aborts the {command}.", command => $p{for}, ), "\n", __x('Change to {command}:', command => $p{for}), "\n\n", ' ', $p{name}, join "\n ", '', @{ $p{scripts} }, "\n", ); } App-Sqitch-0.9996/t/changelist.t000644 000767 000024 00000043645 13133201371 016616 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 259; #use Test::More 'no_plan'; use Test::NoWarnings; use Test::Exception; use Path::Class; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; use Locale::TextDomain qw(App-Sqitch); use Test::MockModule; use lib 't/lib'; use MockOutput; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; BEGIN { require_ok 'App::Sqitch::Plan::ChangeList' or die } my $sqitch = App::Sqitch->new(options => { engine => 'sqlite', top_dir => dir(qw(t sql))->stringify, }); my $target = App::Sqitch::Target->new(sqitch => $sqitch); my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target); my $foo = App::Sqitch::Plan::Change->new(plan => $plan, name => 'foo'); my $bar = App::Sqitch::Plan::Change->new(plan => $plan, name => 'bar', parent => $foo); my $baz = App::Sqitch::Plan::Change->new(plan => $plan, name => 'baz', parent => $bar); my $yo1 = App::Sqitch::Plan::Change->new(plan => $plan, name => 'yo', parent => $baz); my $yo2 = App::Sqitch::Plan::Change->new(plan => $plan, name => 'yo', parent => $yo1, planner_name => 'Phil' ); my $alpha = App::Sqitch::Plan::Tag->new( plan => $plan, change => $yo1, name => 'alpha', ); $yo1->add_tag($alpha); my $changes = App::Sqitch::Plan::ChangeList->new( $foo, $bar, $yo1, $baz, $yo2, ); my ($earliest_id, $latest_id); my $engine_mocker = Test::MockModule->new('App::Sqitch::Engine::sqlite'); my $offset = 0; $engine_mocker->mock(earliest_change_id => sub { $offset = $_[1]; $changes->change_at( $changes->index_of($earliest_id) + $offset )->id; }); $engine_mocker->mock(latest_change_id => sub { $offset = $_[1]; $changes->change_at( $changes->index_of($latest_id) - $offset )->id; }); is $changes->count, 5, 'Count should be six'; is_deeply [$changes->changes], [$foo, $bar, $yo1, $baz, $yo2], 'Changes should be in order'; is_deeply [$changes->items], [$changes->changes], 'Items should be the same as changes'; is_deeply [$changes->tags], [$alpha], 'Tags should return the one tag'; is $changes->change_at(0), $foo, 'Should have foo at 0'; is $changes->change_at(1), $bar, 'Should have bar at 1'; is $changes->change_at(2), $yo1, 'Should have yo1 at 2'; is $changes->change_at(3), $baz, 'Should have baz at 4'; is $changes->change_at(4), $yo2, 'Should have yo2 at 5'; is $changes->index_of('non'), undef, 'Should not find "non"'; is $changes->index_of('@non'), undef, 'Should not find "@non"'; is $changes->index_of('foo'), 0, 'Should find foo at 0'; is $changes->index_of($foo->id), 0, 'Should find foo by ID at 0'; is $changes->index_of($foo->old_id), 0, 'Should find foo by old ID at 0'; is $changes->index_of('bar'), 1, 'Should find bar at 1'; is $changes->index_of('bar^'), 0, 'Should find bar^ at 0'; is $changes->index_of('bar~'), 2, 'Should find bar~ at 2'; is $changes->index_of('bar~~'), 3, 'Should find bar~~ at 3'; is $changes->index_of('bar~~~'), undef, 'Should not find bar~~~'; is $changes->index_of('bar~2'), 3, 'Should find bar~2 at 3'; is $changes->index_of('bar~3'), 4, 'Should find bar~3 at 4'; is $changes->index_of($bar->id), 1, 'Should find bar by ID at 1'; is $changes->index_of($bar->old_id), 1, 'Should find bar by old ID at 1'; is $changes->index_of('@alpha'), 2, 'Should find @alpha at 2'; is $changes->index_of('@alpha^'), 1, 'Should find @alpha^ at 1'; is $changes->index_of('@alpha^^'), 0, 'Should find @alpha^^ at 1'; is $changes->index_of('@alpha^^^'), undef, 'Should not find @alpha^^^'; is $changes->index_of($alpha->id), 2, 'Should find @alpha by ID at 2'; is $changes->index_of($alpha->old_id), 2, 'Should find @alpha by old ID at 2'; is $changes->index_of('baz'), 3, 'Should find baz at 3'; is $changes->index_of($baz->id), 3, 'Should find baz by ID at 3'; is $changes->index_of($baz->old_id), 3, 'Should find baz by old ID at 3'; is $changes->index_of('baz^^^'), undef, 'Should not find baz^^^'; is $changes->index_of('baz^3'), 0, 'Should not find baz^3 at 0'; is $changes->index_of('baz^4'), undef, 'Should not find baz^4'; is $changes->index_of($baz->id . '^'), 2, 'Should find baz by ID^ at 2'; is $changes->index_of($baz->old_id . '^'), 2, 'Should find baz by old ID^ at 2'; throws_ok { $changes->index_of('yo') } 'App::Sqitch::X', 'Should get multiple indexes error looking for index of "yo"'; is $@->ident, 'plan', 'Multiple indexes error ident should be "plan"'; is $@->message, __ 'Change lookup failed', 'Multiple indexes message should be correct'; is_deeply +MockOutput->get_vent, [ [__x( 'Change "{change}" is ambiguous. Please specify a tag-qualified change:', change => 'yo', )], [ ' * ', 'yo@HEAD' ], [ ' * ', 'yo@alpha' ], ], 'Should have output listing tag-qualified changes'; throws_ok { $changes->index_of('yo@howdy') } 'App::Sqitch::X', 'Should unknown tag error for invalid tag'; is $@->ident, 'plan', 'Unknown tag error ident should be "plan"'; is $@->message, __x( 'Unknown tag "{tag}"', tag => '@howdy', ), 'Unknown taf message should be correct'; is $changes->index_of('yo@alpha'), 2, 'Should get 2 for yo@alpha'; is $changes->index_of('yo@alpha^'), 1, 'Should get 1 for yo@alpha^'; is $changes->index_of('yo@HEAD'), 4, 'Should get 4 for yo@HEAD'; is $changes->index_of('yo@HEAD^'), 3, 'Should get 3 for yo@HEAD^'; is $changes->index_of('yo@HEAD~'), undef, 'Should get undef for yo@HEAD~'; is $changes->index_of('yo@HEAD~~'), undef, 'Should get undef for yo@HEAD~~'; is $changes->index_of('foo@alpha'), 0, 'Should get 0 for foo@alpha'; is $changes->index_of('foo@HEAD'), 0, 'Should get 0 for foo@HEAD'; is $changes->index_of('foo@ROOT'), 0, 'Should get 0 for foo@ROOT'; is $changes->index_of('baz@alpha'), undef, 'Should get undef for baz@alpha'; is $changes->index_of('baz@HEAD'), 3, 'Should get 3 for baz@HEAD'; is $changes->index_of('@HEAD'), 4, 'Should get 4 for @HEAD'; is $changes->index_of('@ROOT'), 0, 'Should get 0 for @ROOT'; is $changes->index_of('@HEAD^'), 3, 'Should get 3 for @HEAD^'; is $changes->index_of('@HEAD~'), undef, 'Should get undef for @HEAD~'; is $changes->index_of('@ROOT~'), 1, 'Should get 1 for @ROOT~'; is $changes->index_of('@ROOT^'), undef, 'Should get undef for @ROOT^'; is $changes->index_of('HEAD'), 4, 'Should get 4 for HEAD'; is $changes->index_of('ROOT'), 0, 'Should get 0 for ROOT'; is $changes->index_of('HEAD^'), 3, 'Should get 3 for HEAD^'; is $changes->index_of('HEAD~'), undef, 'Should get undef for HEAD~'; is $changes->index_of('ROOT~'), 1, 'Should get 1 for ROOT~'; is $changes->index_of('ROOT^'), undef, 'Should get undef for ROOT^'; is $changes->get('foo'), $foo, 'Should get foo for "foo"'; is $changes->get('foo~'), $bar, 'Should get bar for "foo~"'; is $changes->get($foo->id), $foo, 'Should get foo by ID'; is $changes->get($foo->old_id), $foo, 'Should get foo by old ID'; is $changes->get('bar'), $bar, 'Should get bar for "bar"'; is $changes->get('bar^'), $foo, 'Should get foo for "bar^"'; is $changes->get('bar~'), $yo1, 'Should get yo1 for "bar~"'; is $changes->get('bar~~'), $baz, 'Should get baz for "bar~~"'; is $changes->get('bar~3'), $yo2, 'Should get yo2 for "bar~3"'; is $changes->get($bar->id), $bar, 'Should get bar by ID'; is $changes->get($bar->old_id), $bar, 'Should get bar by old ID'; is $changes->get($alpha->id), $yo1, 'Should get "yo" by the @alpha tag ID'; is $changes->get($alpha->old_id), $yo1, 'Should get "yo" by the @alpha tag old ID'; is $changes->get('baz'), $baz, 'Should get baz for "baz"'; is $changes->get($baz->id), $baz, 'Should get baz by ID'; is $changes->get($baz->old_id), $baz, 'Should get baz by old ID'; is $changes->get('@HEAD^'), $baz, 'Should get baz for "@HEAD^"'; is $changes->get('@HEAD^^'), $yo1, 'Should get yo1 for "@HEAD^^"'; is $changes->get('@HEAD^3'), $bar, 'Should get bar for "@HEAD^3"'; is $changes->get('@ROOT'), $foo, 'Should get foo for "@ROOT"'; is $changes->get('HEAD^'), $baz, 'Should get baz for "HEAD^"'; is $changes->get('HEAD^^'), $yo1, 'Should get yo1 for "HEAD^^"'; is $changes->get('HEAD^3'), $bar, 'Should get bar for "HEAD^3"'; is $changes->get('ROOT'), $foo, 'Should get foo for "ROOT"'; is $changes->get('yo@alpha'), $yo1, 'Should get yo1 for yo@alpha'; is $changes->get('yo@HEAD'), $yo2, 'Should get yo2 for yo@HEAD'; is $changes->get('foo@alpha'), $foo, 'Should get foo for foo@alpha'; is $changes->get('foo@HEAD'), $foo, 'Should get foo for foo@HEAD'; is $changes->get('baz@alpha'), undef, 'Should get undef for baz@alpha'; is $changes->get('baz@HEAD'), $baz, 'Should get baz for baz@HEAD'; is $changes->get('yo@HEAD'), $yo2, 'Should get yo2 for "yo@HEAD"'; is $changes->get('foo@ROOT'), $foo, 'Should get foo for "foo@ROOT"'; is $changes->find('yo'), $yo1, 'Should find yo1 with "yo"'; is $changes->find('yo@alpha'), $yo1, 'Should find yo1 with "yo@alpha"'; is $changes->find('yo@HEAD'), $yo2, 'Should find yo2 with yo@HEAD'; is $changes->find('foo'), $foo, 'Should find foo for "foo"'; is $changes->find('foo@alpha'), $foo, 'Should find foo for "foo@alpha"'; is $changes->find('foo@HEAD'), $foo, 'Should find foo for "foo@HEAD"'; is $changes->find('yo^'), $bar, 'Should find bar with "yo^"'; is $changes->find('yo^^'), $foo, 'Should find foo with "yo^^"'; is $changes->find('yo^2'), $foo, 'Should find foo with "yo^2"'; is $changes->find('yo~'), $baz, 'Should find baz with "yo~"'; is $changes->find('yo~~'), $yo2, 'Should find yo2 with "yo~~"'; is $changes->find('yo~2'), $yo2, 'Should find yo2 with "yo~2"'; is $changes->find('yo@alpha^'), $bar, 'Should find bar with "yo@alpha^"'; is $changes->find('yo@alpha~'), $baz, 'Should find baz with "yo@alpha^"'; is $changes->find('yo@HEAD^'), $baz, 'Should find baz with yo@HEAD^'; is $changes->find('@HEAD^'), $baz, 'Should find baz with @HEAD^'; is $changes->find('@ROOT~'), $bar, 'Should find bar with @ROOT~^'; is $changes->find('HEAD^'), $baz, 'Should find baz with HEAD^'; is $changes->find('ROOT~'), $bar, 'Should find bar with ROOT~^'; ok $changes->contains('yo'), 'Should contain yo1 with "yo"'; ok $changes->contains('yo@alpha'), 'Should contain yo1 with "yo@alpha"'; ok $changes->contains('yo@HEAD'), 'Should contain yo2 with yo@HEAD'; ok $changes->contains('foo'), 'Should contain foo for "foo"'; ok $changes->contains('foo@alpha'), 'Should contain foo for "foo@alpha"'; ok $changes->contains('foo@HEAD'), 'Should contain foo for "foo@HEAD"'; ok $changes->contains('yo^'), 'Should contain bar with "yo^"'; ok $changes->contains('yo^^'), 'Should contain foo with "yo^^"'; ok $changes->contains('yo^2'), 'Should contain foo with "yo^2"'; ok $changes->contains('yo~'), 'Should contain baz with "yo~"'; ok $changes->contains('yo~~'), 'Should contain yo2 with "yo~~"'; ok $changes->contains('yo~2'), 'Should contain yo2 with "yo~2"'; ok $changes->contains('yo@alpha^'), 'Should contain bar with "yo@alpha^"'; ok $changes->contains('yo@alpha~'), 'Should contain baz with "yo@alpha^"'; ok $changes->contains('yo@HEAD^'), 'Should contain baz with yo@HEAD^'; ok $changes->contains('@HEAD^'), 'Should contain baz with @HEAD^'; ok $changes->contains('@ROOT~'), 'Should contain bar with @ROOT~^'; ok $changes->contains('HEAD^'), 'Should contain baz with HEAD^'; ok $changes->contains('ROOT~'), 'Should contain bar with ROOT~^'; throws_ok { $changes->get('yo') } 'App::Sqitch::X', 'Should get multiple indexes error looking for index of "yo"'; is $@->ident, 'plan', 'Multiple indexes error ident should be "plan"'; is $@->message, __ 'Change lookup failed', 'Multiple indexes message should be correct'; is_deeply +MockOutput->get_vent, [ [__x( 'Change "{change}" is ambiguous. Please specify a tag-qualified change:', change => 'yo', )], [ ' * ', 'yo@HEAD' ], [ ' * ', 'yo@alpha' ], ], 'Should have output listing tag-qualified changes'; throws_ok { $changes->get('yo@howdy') } 'App::Sqitch::X', 'Should unknown tag error for invalid tag'; is $@->ident, 'plan', 'Unknown tag error ident should be "plan"'; is $@->message, __x( 'Unknown tag "{tag}"', tag => '@howdy', ), 'Unknown taf message should be correct'; my $hi = App::Sqitch::Plan::Change->new(plan => $plan, name => 'hi'); ok $changes->append($hi), 'Push hi'; is $changes->count, 6, 'Count should now be six'; is_deeply [$changes->changes], [$foo, $bar, $yo1, $baz, $yo2, $hi], 'Changes should be in order with $hi at the end'; is $changes->index_of('hi'), 5, 'Should find "hi" at index 5'; is $changes->index_of($hi->id), 5, 'Should find "hi" by ID at index 5'; is $changes->index_of($hi->old_id), 5, 'Should find "hi" by old ID at index 5'; is $changes->index_of('@ROOT'), 0, 'Index of @ROOT should still be 0'; is $changes->index_of('@HEAD'), 5, 'Index of @HEAD should now be 5'; is $changes->index_of('ROOT'), 0, 'Index of ROOT should still be 0'; is $changes->index_of('HEAD'), 5, 'Index of HEAD should now be 5'; # Now try first_index_of(). is $changes->first_index_of('non'), undef, 'First index of "non" should be undef'; is $changes->first_index_of('foo'), 0, 'First index of "foo" should be 0'; is $changes->first_index_of('foo~'), 1, 'First index of "foo~" should be 1'; is $changes->first_index_of('foo~~'), 2, 'First index of "foo~~" should be 2'; is $changes->first_index_of('foo~3'), 3, 'First index of "foo~3" should be 3'; is $changes->first_index_of('foo~~~'), undef, 'Should not find first index of "foo~~~"'; is $changes->first_index_of('foo', '@ROOT'), undef, 'First index of "foo" since @ROOT should be undef'; is $changes->first_index_of('bar'), 1, 'First index of "bar" should be 1'; is $changes->first_index_of('yo'), 2, 'First index of "yo" should be 2'; is $changes->first_index_of('yo', '@ROOT'), 2, 'First index of "yo" since @ROOT should be 2'; is $changes->first_index_of('baz'), 3, 'First index of "baz" should be 3'; is $changes->first_index_of('baz^'), 2, 'First index of "baz^" should be 2'; is $changes->first_index_of('baz^^'), 1, 'First index of "baz^^" should be 1'; is $changes->first_index_of('baz^3'), 0, 'First index of "baz^3" should be 0'; is $changes->first_index_of('baz^^^'), undef, 'Should not find first index of "baz^^^"'; is $changes->first_index_of('yo', '@alpha'), 4, 'First index of "yo" since "@alpha" should be 4'; is $changes->first_index_of('yo', 'baz'), 4, 'First index of "yo" since "baz" should be 4'; is $changes->first_index_of('yo^', 'baz'), 3, 'First index of "yo^" since "baz" should be 4'; is $changes->first_index_of('yo~', 'baz'), 5, 'First index of "yo~" since "baz" should be 5'; throws_ok { $changes->first_index_of('baz', 'nonexistent') } 'App::Sqitch::X', 'Should get an exception for an unknown change passed to first_index_of()'; is $@->ident, 'plan', 'Unknown change error ident should be "plan"'; is $@->message, __x( 'Unknown change: "{change}"', change => 'nonexistent', ), 'Unknown change message should be correct'; # Try appending a couple more changes. my $so = App::Sqitch::Plan::Change->new(plan => $plan, name => 'so'); my $fu = App::Sqitch::Plan::Change->new(plan => $plan, name => 'fu'); ok $changes->append($so, $fu), 'Push so and fu'; is $changes->count, 8, 'Count should now be eight'; is $changes->index_of('@ROOT'), 0, 'Index of @ROOT should remain 0'; is $changes->index_of('@HEAD'), 7, 'Index of @HEAD should now be 7'; is $changes->index_of('ROOT'), 0, 'Index of ROOT should remain 0'; is $changes->index_of('HEAD'), 7, 'Index of HEAD should now be 7'; is_deeply [$changes->changes], [$foo, $bar, $yo1, $baz, $yo2, $hi, $so, $fu], 'Changes should be in order with $so and $fu at the end'; # Try indexing a tag. my $beta = App::Sqitch::Plan::Tag->new( plan => $plan, change => $yo2, name => 'beta', ); $yo2->add_tag($beta); ok $changes->index_tag(4, $beta), 'Index beta'; is $changes->index_of('@beta'), 4, 'Should find @beta at index 4'; is $changes->get('@beta'), $yo2, 'Should find yo2 via @beta'; is $changes->get($beta->id), $yo2, 'Should find yo2 via @beta ID'; is $changes->get($beta->old_id), $yo2, 'Should find yo2 via @beta old ID'; is_deeply [$changes->tags], [$alpha, $beta], 'Tags should return both tags'; ############################################################################## # Test last_tagged(), last_change(), index_of_last_tagged(). is $changes->index_of_last_tagged, 2, 'Should get 2 for last tagged index'; is $changes->last_tagged_change, $yo1, 'Should find "yo" as last tagged'; is $changes->count, 8, 'Should get 8 for count'; is $changes->last_change, $fu, 'Should find fu as last change'; for my $changes ( [0, $yo1], [1, $foo, $yo1], [3, $foo, $bar, $baz, $yo1], [4, $foo, $bar, $baz, $hi, $yo1], ) { my $index = shift @{ $changes }; my $n = App::Sqitch::Plan::ChangeList->new(@{ $changes }); is $n->index_of_last_tagged, $index, "Should find last tagged index at $index"; is $n->last_tagged_change, $changes->[$index], "Should find last tagged at $index"; is $n->count, ($index + 1), "Should get count " . ($index + 1); is $n->last_change, $changes->[$index], "Should find last change at $index"; } for my $changes ( [], [$foo, $baz], [$foo, $bar, $baz, $hi], ) { my $n = App::Sqitch::Plan::ChangeList->new(@{ $changes }); is $n->index_of_last_tagged, undef, 'Should not find tag index in ' . scalar @{$changes} . ' changes'; is $n->last_tagged_change, undef, 'Should not find tag in ' . scalar @{$changes} . ' changes'; if (!@{ $changes }) { is $n->last_change, undef, "Should find no change in empty plan"; } } # Try an empty change list. isa_ok $changes = App::Sqitch::Plan::ChangeList->new, 'App::Sqitch::Plan::ChangeList'; for my $ref (qw( foo bar HEAD @HEAD ROOT @ROOT alpha @alpha )) { is $changes->index_of($ref), undef, qq{Should not find index of "$ref" in empty list}; is $changes->first_index_of($ref), undef, qq{Should not find first index of "$ref" in empty list}; is $changes->get($ref), undef, qq{Should get undef for "$ref" in empty list}; ok !$changes->contains($ref), qq{Should not contain "$ref" in empty list}; is $changes->find($ref), undef, qq{Should find undef for "$ref" in empty list}; } App-Sqitch-0.9996/t/checkout.t000644 000767 000024 00000036262 13133201371 016277 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use utf8; use Path::Class qw(dir file); use Locale::TextDomain qw(App-Sqitch); use App::Sqitch::X qw(hurl); use Test::MockModule; use Test::Exception; use lib 't/lib'; use MockOutput; my $CLASS = 'App::Sqitch::Command::checkout'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; isa_ok $CLASS, 'App::Sqitch::Command'; can_ok $CLASS, qw( target options configure log_only execute deploy_variables revert_variables ); is_deeply [$CLASS->options], [qw( target|t=s mode=s verify! set|s=s% set-deploy|d=s% set-revert|r=s% log-only y )], 'Options should be correct'; ok my $sqitch = App::Sqitch->new( options => { plan_file => file(qw(t sql sqitch.plan))->stringify, top_dir => dir(qw(t sql))->stringify, engine => 'sqlite', }, ), 'Load a sqitch object'; my $config = $sqitch->config; # Test configure(). is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1, verify => 0, mode => 'all', }, 'Check default configuration'; is_deeply $CLASS->configure($config, { set => { foo => 'bar' }, }), { verify => 0, no_prompt => 0, prompt_accept => 1, mode => 'all', deploy_variables => { foo => 'bar' }, revert_variables => { foo => 'bar' }, }, 'Should have set option'; is_deeply $CLASS->configure($config, { y => 1, set_deploy => { foo => 'bar' }, log_only => 1, verify => 1, mode => 'tag', }), { mode => 'tag', no_prompt => 1, prompt_accept => 1, deploy_variables => { foo => 'bar' }, verify => 1, log_only => 1, }, 'Should have mode, deploy_variables, verify, no_prompt, and log_only'; is_deeply $CLASS->configure($config, { y => 0, set_revert => { foo => 'bar' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, revert_variables => { foo => 'bar' }, }, 'Should have set_revert option and no_prompt false'; is_deeply $CLASS->configure($config, { set => { foo => 'bar' }, set_deploy => { foo => 'dep', hi => 'you' }, set_revert => { foo => 'rev', hi => 'me' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'dep', hi => 'you' }, revert_variables => { foo => 'rev', hi => 'me' }, }, 'set_deploy and set_revert should overrid set'; is_deeply $CLASS->configure($config, { set => { foo => 'bar' }, set_deploy => { hi => 'you' }, set_revert => { hi => 'me' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'bar', hi => 'you' }, revert_variables => { foo => 'bar', hi => 'me' }, }, 'set_deploy and set_revert should merge with set'; is_deeply $CLASS->configure($config, { set => { foo => 'bar' }, set_deploy => { hi => 'you' }, set_revert => { my => 'yo' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'bar', hi => 'you' }, revert_variables => { foo => 'bar', hi => 'you', my => 'yo' }, }, 'set_revert should merge with set_deploy'; CONFIG: { my $mock_config = Test::MockModule->new(ref $config); my %config_vals; $mock_config->mock(get => sub { my ($self, %p) = @_; return $config_vals{ $p{key} }; }); $mock_config->mock(get_section => sub { my ($self, %p) = @_; return $config_vals{ $p{section} } || {}; }); %config_vals = ( 'deploy.variables' => { foo => 'bar', hi => 21 }, ); is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1, verify => 0, mode => 'all', }, 'Should have deploy configuration'; # Try merging. is_deeply $CLASS->configure($config, { set => { foo => 'yo', yo => 'stellar' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'yo', yo => 'stellar', hi => 21 }, revert_variables => { foo => 'yo', yo => 'stellar', hi => 21 }, }, 'Should have merged variables'; # Try merging with checkout.variables, too. $config_vals{'revert.variables'} = { hi => 42 }; is_deeply $CLASS->configure($config, { set => { yo => 'stellar' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'bar', yo => 'stellar', hi => 21 }, revert_variables => { foo => 'bar', yo => 'stellar', hi => 42 }, }, 'Should have merged --set, deploy, checkout'; isa_ok my $checkout = $CLASS->new(sqitch => $sqitch), $CLASS; is_deeply $checkout->deploy_variables, { foo => 'bar', hi => 21 }, 'Should pick up deploy variables from configuration'; is_deeply $checkout->revert_variables, { foo => 'bar', hi => 42 }, 'Should pick up revert variables from configuration'; # Make sure we can override mode, prompting, and verify. %config_vals = ( 'revert.no_prompt' => 1, 'revert.prompt_accept' => 0, 'deploy.verify' => 1, 'deploy.mode' => 'tag', ); is_deeply $CLASS->configure($config, {}), { no_prompt => 1, prompt_accept => 0, verify => 1, mode => 'tag', }, 'Should have no_prompt and prompt_accept from revert config'; # Checkout option takes precendence $config_vals{'checkout.no_prompt'} = 0; $config_vals{'checkout.prompt_accept'} = 1; $config_vals{'checkout.verify'} = 0; $config_vals{'checkout.mode'} = 'change'; is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1, verify => 0, mode => 'change', }, 'Should have false log_only, verify, true prompt_accept from checkout config'; delete $config_vals{'revert.no_prompt'}; delete $config_vals{'revert.prompt_accept'}; delete $config_vals{'checkout.verify'}; delete $config_vals{'checkout.mode'}; $config_vals{'checkout.no_prompt'} = 1; is_deeply $CLASS->configure($config, {}), { no_prompt => 1, prompt_accept => 1, verify => 1, mode => 'tag' }, 'Should have log_only, prompt_accept true from checkout and verify from deploy'; # But option should override. is_deeply $CLASS->configure($config, {y => 0, verify => 0, mode => 'all'}), { no_prompt => 0, verify => 0, mode => 'all', prompt_accept => 1 }, 'Should have log_only false and mode all again'; $config_vals{'checkout.no_prompt'} = 0; $config_vals{'checkout.prompt_accept'} = 1; is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1, verify => 1, mode => 'tag', }, 'Should have log_only false for false config'; is_deeply $CLASS->configure($config, {y => 1}), { no_prompt => 1, prompt_accept => 1, verify => 1, mode => 'tag', }, 'Should have no_prompt true with -y'; } # Mock the execution interface. my $mock_sqitch = Test::MockModule->new(ref $sqitch); my (@probe_args, $probed, $target, $orig_method); $mock_sqitch->mock(probe => sub { shift; @probe_args = @_; $probed }); my $mock_cmd = Test::MockModule->new($CLASS); $mock_cmd->mock(parse_args => sub { my @ret = shift->$orig_method(@_); $target = $ret[1][0]; @ret; }); $orig_method = $mock_cmd->original('parse_args'); my @run_args; $mock_sqitch->mock(run => sub { shift; @run_args = @_ }); # Try rebasing to the current branch. isa_ok my $checkout = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'checkout', config => $config, }), $CLASS, 'checkout command'; my $client = $checkout->client; $probed = 'fixdupes'; throws_ok { $checkout->execute($probed) } 'App::Sqitch::X', 'Should get an error current branch'; is $@->ident, 'checkout', 'Current branch error ident should be "checkout"'; is $@->message, __x('Already on branch {branch}', branch => $probed), 'Should get proper error for current branch error'; is_deeply \@probe_args, [$client, qw(rev-parse --abbrev-ref HEAD)], 'The proper args should have been passed to rev-parse'; @probe_args = (); # Try a plan with nothing in common with the current branch's plan. my (@capture_args, $captured); $mock_sqitch->mock(capture => sub { shift; @capture_args = @_; $captured }); $captured = q{%project=sql foo 2012-07-16T17:25:07Z Barack Obama bar 2012-07-16T17:25:07Z Barack Obama }; throws_ok { $checkout->execute('master') } 'App::Sqitch::X', 'Should get an error for plans without a common change'; is $@->ident, 'checkout', 'The no common change error ident should be "checkout"'; is $@->message, __x( 'Branch {branch} has no changes in common with current branch {current}', branch => 'master', current => $probed, ), 'The no common change error message should be correct'; # Mock the engine interface. my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite'); my (@dep_args, @dep_changes); $mock_engine->mock(deploy => sub { @dep_changes = map { $_->name } shift->plan->changes; @dep_args = @_; }); my (@rev_args, @rev_changes); $mock_engine->mock(revert => sub { @rev_changes = map { $_->name } shift->plan->changes; @rev_args = @_; }); my @vars; $mock_engine->mock(set_variables => sub { shift; push @vars => [@_] }); # Load up the plan file without decoding and change the plan. $captured = file(qw(t sql sqitch.plan))->slurp; { no utf8; $captured =~ s/widgets/thingíes/; } # Checkout with options. isa_ok $checkout = $CLASS->new( log_only => 1, verify => 1, sqitch => $sqitch, mode => 'tag', deploy_variables => { foo => 'bar', one => 1 }, revert_variables => { hey => 'there' }, ), $CLASS, 'Object with to and variables'; ok $checkout->execute('master'), 'Checkout master'; is_deeply \@probe_args, [$client, qw(rev-parse --abbrev-ref HEAD)], 'The proper args should again have been passed to rev-parse'; is_deeply \@capture_args, [$client, 'show', 'master:' . $checkout->default_target->plan_file ], 'Should have requested the plan file contents as of master'; is_deeply \@run_args, [$client, qw(checkout master)], 'Should have checked out other branch'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; is_deeply +MockOutput->get_info, [[__x( 'Last change before the branches diverged: {last_change}', last_change => 'users @alpha', )]], 'Should have emitted info identifying the last common change'; # Did it revert? is_deeply \@rev_args, [$checkout->default_target->plan->get('users')->id], '"users" ID and 1 should be passed to the engine revert'; is_deeply \@rev_changes, [qw(roles users widgets)], 'Should have had the current changes for revision'; # Did it deploy? is_deeply \@dep_args, [undef, 'tag'], 'undef, "tag", and 1 should be passed to the engine deploy'; is_deeply \@dep_changes, [qw(roles users thingíes)], 'Should have had the other branch changes (decoded) for deploy'; ok $target->engine->with_verify, 'Engine should verify'; ok $target->engine->log_only, 'The engine should be set to log_only'; is @vars, 2, 'Variables should have been passed to the engine twice'; is_deeply { @{ $vars[0] } }, { hey => 'there' }, 'The revert vars should have been passed first'; is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 }, 'The deploy vars should have been next'; # Try passing a target. ok $checkout->execute('master', 'db:sqlite:foo'), 'Checkout master with target'; is $target->name, 'db:sqlite:foo', 'Target should be passed to engine'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # If nothing is deployed, or we are already at the revert target, the revert # should be skipped. isa_ok $checkout = $CLASS->new( target => 'db:sqlite:hello', log_only => 0, verify => 0, sqitch => $sqitch, mode => 'tag', deploy_variables => { foo => 'bar', one => 1 }, revert_variables => { hey => 'there' }, ), $CLASS, 'Object with to and variables'; $mock_engine->mock(revert => sub { hurl { ident => 'revert', message => 'foo', exitval => 1 } }); @dep_args = @rev_args = @vars = (); ok $checkout->execute('master'), 'Checkout master again'; is $target->name, 'db:sqlite:hello', 'Target should be passed to engine'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Did it deploy? ok !$target->engine->log_only, 'The engine should not be set to log_only'; ok !$target->engine->with_verify, 'The engine should not be set with_verfy'; is_deeply \@dep_args, [undef, 'tag'], 'undef, "tag", and 1 should be passed to the engine deploy again'; is_deeply \@dep_changes, [qw(roles users thingíes)], 'Should have had the other branch changes (decoded) for deploy again'; is @vars, 2, 'Variables should again have been passed to the engine twice'; is_deeply { @{ $vars[0] } }, { hey => 'there' }, 'The revert vars should again have been passed first'; is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 }, 'The deploy vars should again have been next'; # Should get a warning for two targets. ok $checkout->execute('master', 'db:sqlite:'), 'Checkout master again with target'; is $target->name, 'db:sqlite:hello', 'Target should be passed to engine'; is_deeply +MockOutput->get_warn, [[__x( 'Too many targets specified; connecting to {target}', target => 'db:sqlite:hello', )]], 'Should have warning about two targets'; # Make sure we get an exception for unknown args. throws_ok { $checkout->execute(qw(master greg)) } 'App::Sqitch::X', 'Should get an exception for unknown arg'; is $@->ident, 'checkout', 'Unknow arg ident should be "checkout"'; is $@->message, __x( 'Unknown argument "{arg}"', arg => 'greg', ), 'Should get an exeption for two unknown arg'; throws_ok { $checkout->execute(qw(master greg widgets)) } 'App::Sqitch::X', 'Should get an exception for unknown args'; is $@->ident, 'checkout', 'Unknow args ident should be "checkout"'; is $@->message, __x( 'Unknown arguments: {arg}', arg => 'greg, widgets', ), 'Should get an exeption for two unknown args'; # Should die for fatal, unknown, or confirmation errors. for my $spec ( [ confirm => App::Sqitch::X->new(ident => 'revert:confirm', message => 'foo', exitval => 1) ], [ fatal => App::Sqitch::X->new(ident => 'revert', message => 'foo', exitval => 2) ], [ unknown => bless { } => __PACKAGE__ ], ) { $mock_engine->mock(revert => sub { die $spec->[1] }); throws_ok { $checkout->execute('master') } ref $spec->[1], "Should rethrow $spec->[0] exception"; } done_testing; App-Sqitch-0.9996/t/command.t000755 000767 000024 00000056745 13133201371 016123 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 166; #use Test::More 'no_plan'; use Test::NoWarnings; use List::Util qw(first); $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $catch_exit; BEGIN { $catch_exit = 0; # Stub out exit. *CORE::GLOBAL::exit = sub { die 'EXITED: ' . (@_ ? shift : 0) if $catch_exit; CORE::exit(@_); }; } use App::Sqitch; use App::Sqitch::Target; use Test::Exception; use Test::NoWarnings; use Test::MockModule; use Locale::TextDomain qw(App-Sqitch); use Capture::Tiny 0.12 ':all'; use Path::Class; use lib 't/lib'; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Command'; use_ok $CLASS or die; } can_ok $CLASS, qw( load new options configure command prompt ask_y_n parse_args default_target ); COMMAND: { # Stub out a couple of commands. package App::Sqitch::Command::whu; use Moo; extends 'App::Sqitch::Command'; has foo => (is => 'ro'); has feathers => (is => 'ro'); $INC{'App/Sqitch/Command/whu.pm'} = __FILE__; sub options { return qw( foo hi-there|h icky-foo! feathers=s ); } package App::Sqitch::Command::wah_hoo; use Moo; extends 'App::Sqitch::Command'; $INC{'App/Sqitch/Command/wah_hoo.pm'} = __FILE__; } ok my $sqitch = App::Sqitch->new, 'Load a sqitch sqitch object'; ############################################################################## # Test new(). throws_ok { $CLASS->new } qr/\QMissing required arguments: sqitch/, 'Should get an exception for missing sqitch param'; my $array = []; throws_ok { $CLASS->new({ sqitch => $array }) } qr/\QReference [] did not pass type constraint "Sqitch"/, 'Should get an exception for array sqitch param'; throws_ok { $CLASS->new({ sqitch => 'foo' }) } qr/\QValue "foo" did not pass type constraint "Sqitch"/, 'Should get an exception for string sqitch param'; isa_ok $CLASS->new({sqitch => $sqitch}), $CLASS; ############################################################################## # Test configure. my $config = App::Sqitch::Config->new; my $cmock = Test::MockModule->new('App::Sqitch::Config'); is_deeply $CLASS->configure($config, {}), {}, 'Should get empty hash for no config or options'; $cmock->mock(get_section => {foo => 'hi'}); is_deeply $CLASS->configure($config, {}), {foo => 'hi'}, 'Should get config with no options'; is_deeply $CLASS->configure($config, {foo => 'yo'}), {foo => 'yo'}, 'Options should override config'; is_deeply $CLASS->configure($config, {'foo_bar' => 'yo'}), {foo => 'hi', foo_bar => 'yo'}, 'Options keys should have dashes changed to underscores'; ############################################################################## # Test load(). $cmock->mock(get_section => {}); ok my $cmd = $CLASS->load({ command => 'whu', sqitch => $sqitch, config => $config, args => [] }), 'Load a "whu" command'; isa_ok $cmd, 'App::Sqitch::Command::whu'; is $cmd->sqitch, $sqitch, 'The sqitch attribute should be set'; $cmock->mock(get_section => {foo => 'hi'}); ok $cmd = $CLASS->load({ command => 'whu', sqitch => $sqitch, config => $config, args => [] }), 'Load a "whu" command with "foo" config'; is $cmd->foo, 'hi', 'The "foo" attribute should be set'; # Test handling of nonexistent commands. throws_ok { $CLASS->load({ command => 'nonexistent', sqitch => $sqitch }) } 'App::Sqitch::X', 'Should exit'; is $@->ident, 'command', 'Nonexistent command error ident should be "config"'; is $@->message, __x( '"{command}" is not a valid command', command => 'nonexistent', ), 'Should get proper mesage for nonexistent command'; is $@->exitval, 1, 'Nonexistent command should yield exitval of 1'; # Test command that evals to a syntax error. throws_ok { local $SIG{__WARN__} = sub { } if $] < 5.11; # Warns on 5.10. $CLASS->load({ command => 'foo.bar', sqitch => $sqitch }) } 'App::Sqitch::X', 'Should die on bad command'; is $@->ident, 'command', 'Bad command error ident should be "config"'; is $@->message, __x( '"{command}" is not a valid command', command => 'foo.bar', ), 'Should get proper mesage for bad command'; is $@->exitval, 1, 'Bad command should yield exitval of 1'; NOCOMMAND: { # Test handling of no command. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $CLASS->load({ command => '', sqitch => $sqitch }) } qr/USAGE/, 'No command should yield usage'; is_deeply \@args, [$CLASS], 'No args should be passed to usage'; } # Test handling a bad command implementation. throws_ok { $CLASS->load({ command => 'bad', sqitch => $sqitch }) } 'App::Sqitch::X', 'Should die on broken command module'; is $@->ident, 'command', 'Broken command error ident should be "config"'; is $@->message, __x( '"{command}" is not a valid command', command => 'bad', ), 'Should get proper mesage for broken command'; is $@->exitval, 1, 'Broken command should yield exitval of 1'; # Test options processing. $cmock->mock(get_section => {foo => 'hi', feathers => 'yes'}); ok $cmd = $CLASS->load({ command => 'whu', sqitch => $sqitch, config => $config, args => ['--feathers' => 'no'] }), 'Load a "whu" command with "--feathers" optin'; is $cmd->feathers, 'no', 'The "feathers" attribute should be set'; # Test command with a dash in its name. ok $cmd = $CLASS->load({ command => 'wah-hoo', sqitch => $sqitch, config => $config, }), 'Load a "wah-hoo" command'; isa_ok $cmd, "$CLASS\::wah_hoo", 'It'; is $cmd->command, 'wah-hoo', 'command() should return hyphenated name'; ############################################################################## # Test default_target. ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create a $CLASS object"; isa_ok my $target = $cmd->default_target, 'App::Sqitch::Target', 'default target'; is $target->name, 'db:', 'Default target name should be "db:"'; is $target->uri, URI->new('db:'), 'Default target URI should be "db:"'; # Make sure the core.engine config option gets used. my @get_ret; my @get_expect; $cmock->mock(get => sub { my $self = shift; my $exp = shift @get_expect; is_deeply \@_, [key => $exp], "Should try to fetch $exp"; return shift @get_ret; }); @get_ret = ('sqlite', undef, 'sqlite'); @get_expect = ('core.engine', 'core.target', 'core.engine', 'engine.sqlite.target', 'core.sqlite.target'); ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create a $CLASS object"; isa_ok $target = $cmd->default_target, 'App::Sqitch::Target', 'default target'; is $target->name, 'db:sqlite:', 'Default target name should be "db:sqlite:"'; is $target->uri, URI->new('db:sqlite:'), 'Default target URI should be "db:sqlite:"'; # Make sure --engine is higher precedence. $sqitch->options->{engine} = 'pg'; @get_expect = ('engine.pg.target', 'core.pg.target'); ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create a $CLASS object"; isa_ok $target = $cmd->default_target, 'App::Sqitch::Target', 'default target'; is $target->name, 'db:pg:', 'Default target name should be "db:pg:"'; is $target->uri, URI->new('db:pg:'), 'Default target URI should be "db:pg:"'; # We should get stuff from the engine section of the config. @get_expect = ('engine.pg.target'); @get_ret = ('db:pg:foo'); ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create a $CLASS object"; isa_ok $target = $cmd->default_target, 'App::Sqitch::Target', 'default target'; is $target->name, 'db:pg:foo', 'Default target name should be "db:pg:foo"'; is $target->uri, URI->new('db:pg:foo'), 'Default target URI should be "db:pg:foo"'; # Cleanup. delete $sqitch->options->{engine}; $cmock->unmock('get'); ############################################################################## # Test command and execute. can_ok $CLASS, 'execute'; ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create a $CLASS object"; is $CLASS->command, '', 'Base class command should be ""'; is $cmd->command, '', 'Base object command should be ""'; throws_ok { $cmd->execute } 'App::Sqitch::X', 'Should get an error calling execute on command base class'; is $@->ident, 'DEV', 'Execute exception ident should be "DEV"'; is $@->message, "The execute() method must be called from a subclass of $CLASS", 'The execute() error message should be correct'; ok $cmd = App::Sqitch::Command::whu->new({sqitch => $sqitch}), 'Create a subclass command object'; is $cmd->command, 'whu', 'Subclass oject command should be "whu"'; is +App::Sqitch::Command::whu->command, 'whu', 'Subclass class command should be "whu"'; throws_ok { $cmd->execute } 'App::Sqitch::X', 'Should get an error for un-overridden execute() method'; is $@->ident, 'DEV', 'Un-overidden execute() exception ident should be "DEV"'; is $@->message, "The execute() method has not been overridden in $CLASS\::whu", 'The unoverridden execute() error message should be correct'; ############################################################################## # Test options parsing. can_ok $CLASS, 'options', '_parse_opts'; ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create a $CLASS object again"; is_deeply $cmd->_parse_opts, {}, 'Base _parse_opts should return an empty hash'; ok $cmd = App::Sqitch::Command::whu->new({sqitch => $sqitch}), 'Create a subclass command object again'; is_deeply $cmd->_parse_opts, {}, 'Subclass should return an empty hash for no args'; is_deeply $cmd->_parse_opts([1]), {}, 'Subclass should use options spec'; my $args = [qw( --foo --h --no-icky-foo --feathers down whatever )]; is_deeply $cmd->_parse_opts($args), { 'foo' => 1, 'hi_there' => 1, 'icky_foo' => 0, 'feathers' => 'down', }, 'Subclass should parse options spec'; is_deeply $args, ['whatever'], 'Args array should be cleared of options'; PARSEOPTSERR: { # Make sure that invalid options trigger an error. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; }); my @warn; local $SIG{__WARN__} = sub { @warn = @_ }; $cmd->_parse_opts(['--dont-do-this']); is_deeply \@warn, ["Unknown option: dont-do-this\n"], 'Should get warning for unknown option'; is_deeply \@args, [$cmd], 'Should call _pod2usage on options parse failure'; # Try it with a command with no options. @args = @warn = (); isa_ok $cmd = App::Sqitch::Command->load({ command => 'good', sqitch => $sqitch, config => $config, }), 'App::Sqitch::Command::good', 'Good command object'; $cmd->_parse_opts(['--dont-do-this']); is_deeply \@warn, ["Unknown option: dont-do-this\n"], 'Should get warning for unknown option when there are no options'; is_deeply \@args, [$cmd], 'Should call _pod2usage on no options parse failure'; } ############################################################################## # Test argument parsing. ARGS: { local $ENV{SQITCH_CONFIG} = file qw(t local.conf); ok $sqitch = App::Sqitch->new(options => { engine => 'sqlite', plan_file => file(qw(t plans multi.plan))->stringify, top_dir => dir(qw(t sql))->stringify }), 'Load Sqitch with config and plan'; ok my $cmd = $CLASS->new({ sqitch => $sqitch }), 'Load cmd with config and plan'; my $parsem = sub { my @ret = $cmd->parse_args(@_); # Targets are always second to last. $ret[-2] = [ map { $_->name } @{ $ret[-2] } ]; return \@ret; }; my $msg = sub { __nx( 'Unknown argument "{arg}"', 'Unknown arguments: {arg}', scalar @_, arg => join ', ', @_ ) }; is_deeply $parsem->(), [['devdb'], []], 'Parsing no args should return default target'; throws_ok { $parsem->( args => ['foo'] ) } 'App::Sqitch::X', 'Single unknown arg raise an error'; is $@->ident, '', 'Unknown error ident should be ""'; is $@->message, $msg->('foo'), 'Unknown error message should be correct'; is_deeply $parsem->( args => ['hey'] ), [['devdb'], ['hey']], 'Single change should be recognized as change'; is_deeply $parsem->( args => ['devdb'] ), [['devdb'], []], 'Single target should be recognized as target'; is_deeply $parsem->(args => ['db:pg:']), [['db:pg:'], []], 'URI target should be recognized as target, too'; is_deeply $parsem->(args => ['devdb', 'hey']), [['devdb'], ['hey']], 'Target and change should be recognized'; is_deeply $parsem->(args => ['hey', 'devdb']), [['devdb'], ['hey']], 'Change and target should be recognized'; is_deeply $parsem->(args => ['mydb', 'hey']), [['mydb'], ['hey']], 'Alternate Target and change should be recognized'; is_deeply $parsem->(args => ['hey', 'mydb']), [['mydb'], ['hey']], 'Change and alternate target should be recognized'; is_deeply $parsem->(args => ['hey', 'devdb', 'foo'], names => [undef]), ['foo', ['devdb'], ['hey']], 'Change, target, and unknown name should be recognized'; is_deeply $parsem->(args => ['hey', 'devdb', 'foo', 'hey-there'], names => [0]), ['foo', ['devdb'], ['hey', 'hey-there']], 'Multiple changes, target, and unknown name should be recognized'; is_deeply $parsem->(args => ['yuck', 'hey', 'devdb', 'foo'], names => [0, 0]), ['yuck', 'foo', ['devdb'], ['hey']], 'Multiple names should be recognized'; throws_ok { $parsem->(args => ['yuck', 'hey', 'devdb'], names => ['hi']); } 'App::Sqitch::X', 'Should get an error with name and unknown'; is $@->ident, '', 'Unknown error ident should be ""'; is $@->message, $msg->('yuck'), 'Unknown error message should be correct'; throws_ok { $parsem->(args => ['yuck', 'hey', 'devdb', 'foo'], names => ['hi']); } 'App::Sqitch::X', 'Should get an error with name and two unknowns'; is $@->ident, '', 'Two unknowns error ident should be ""'; is $@->message, $msg->('yuck', 'foo'), 'Two unknowns error message should be correct'; # Make sure changes are found in previously-passed target. ok $sqitch = App::Sqitch->new(options => { engine => 'sqlite', top_dir => dir(qw(t sql))->stringify }), 'Load Sqitch with config'; ok $cmd = $CLASS->new({ sqitch => $sqitch }), 'Load cmd with config'; is_deeply $parsem->(args => ['mydb', 'add_user']), [['mydb'], ['add_user']], 'Change following target should be recognized from target plan'; # Now pass a target. is_deeply $parsem->(target => 'devdb'), [['devdb'], []], 'Passed target should always be returned'; is_deeply $parsem->(target => 'devdb', args => ['mydb']), [['devdb', 'mydb'], []], 'Passed and specified targets should always be returned'; throws_ok { $parsem->(target => 'devdb', args => ['hey']) } 'App::Sqitch::X', 'Change unknown to passed target should error'; is $@->ident, '', 'Change unknown error ident should be ""'; is $@->message, $msg->('hey'), 'Change unknown error message should be correct'; is_deeply $parsem->(args => ['widgets', '@beta']), [['devdb'], ['widgets', '@beta']], 'Should get known changes from default target (t/sql/sqitch.plan)'; throws_ok { $parsem->(args => ['widgets', 'mydb', 'foo', '@beta']); } 'App::Sqitch::X', 'Change seen after target should error if not in that target'; is $@->ident, '', 'Change after target error ident should be ""'; is $@->message, $msg->('foo', '@beta'), 'Change after target error message should be correct'; # Make sure a plan file name is recognized as pointing to a target. is_deeply $parsem->(args => [file(qw(t plans dependencies.plan))->stringify]), [['mydb'], []], 'Should resolve plan file to a target'; # Should work for default plan file, too. is_deeply $parsem->(args => [file(qw(t sql sqitch.plan))->stringify]), [['devdb'], []], 'SHould resolve default plan file to target'; # Should also recognize an engine argument. is_deeply $parsem->(args => ['pg']), [['mydb'], []], 'Should resolve engine "pg" file to its target'; is_deeply $parsem->(args => ['sqlite']), [['devdb'], []], 'Should resolve engine "sqlite" file to its target'; # Make sure we don't get an error when the default target has no plan file. my $mock_target = Test::MockModule->new('App::Sqitch::Target'); $mock_target->mock(plan_file => file 'no-such-file.txt'); is_deeply $parsem->( args => ['devdb'] ), [['devdb'], []], 'Should recognize target when default target has no plan file'; } ############################################################################## # Test _pod2usage(). POD2USAGE: { my $mock = Test::MockModule->new('Pod::Usage'); my %args; $mock->mock(pod2usage => sub { %args = @_} ); $cmd = $CLASS->new({ sqitch => $sqitch }); ok $cmd->_pod2usage, 'Call _pod2usage on base object'; is_deeply \%args, { '-verbose' => 99, '-sections' => '(?i:(Usage|Synopsis|Options))', '-exitval' => 2, '-input' => Pod::Find::pod_where({'-inc' => 1}, 'sqitch'), }, 'Default params should be passed to Pod::Usage'; $cmd = App::Sqitch::Command::whu->new({ sqitch => $sqitch }); ok $cmd->_pod2usage, 'Call _pod2usage on "whu" command object'; is_deeply \%args, { '-verbose' => 99, '-sections' => '(?i:(Usage|Synopsis|Options))', '-exitval' => 2, '-input' => Pod::Find::pod_where({'-inc' => 1}, 'sqitch'), }, 'Default params should be passed to Pod::Usage'; isa_ok $cmd = App::Sqitch::Command->load({ command => 'config', sqitch => $sqitch, config => $config, }), 'App::Sqitch::Command::config', 'Config command object'; ok $cmd->_pod2usage, 'Call _pod2usage on "config" command object'; is_deeply \%args, { '-verbose' => 99, '-sections' => '(?i:(Usage|Synopsis|Options))', '-exitval' => 2, '-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch-config'), }, 'Should find sqitch-config docs to pass to Pod::Usage'; isa_ok $cmd = App::Sqitch::Command->load({ command => 'good', sqitch => $sqitch, config => $config, }), 'App::Sqitch::Command::good', 'Good command object'; ok $cmd->_pod2usage, 'Call _pod2usage on "good" command object'; is_deeply \%args, { '-verbose' => 99, '-sections' => '(?i:(Usage|Synopsis|Options))', '-exitval' => 2, '-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch'), }, 'Should find App::Sqitch::Command::good docs to pass to Pod::Usage'; # Test usage(), too. can_ok $cmd, 'usage'; $cmd->usage('Hello ', 'gorgeous'); is_deeply \%args, { '-verbose' => 99, '-sections' => '(?i:(Usage|Synopsis|Options))', '-exitval' => 2, '-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch'), '-message' => 'Hello gorgeous', }, 'Should find App::Sqitch::Command::good docs to pass to Pod::Usage'; } ############################################################################## # Test verbosity. can_ok $CLASS, 'verbosity'; is $cmd->verbosity, $sqitch->verbosity, 'Verbosity should be from sqitch'; $sqitch->{verbosity} = 3; is $cmd->verbosity, $sqitch->verbosity, 'Verbosity should change with sqitch'; ############################################################################## # Test message levels. Start with trace. $sqitch->{verbosity} = 3; is capture_stdout { $cmd->trace('This ', "that\n", 'and the other') }, "trace: This that\ntrace: and the other\n", 'trace should work'; $sqitch->{verbosity} = 2; is capture_stdout { $cmd->trace('This ', "that\n", 'and the other') }, '', 'Should get no trace output for verbosity 2'; # Trace literal. $sqitch->{verbosity} = 3; is capture_stdout { $cmd->trace_literal('This ', "that\n", 'and the other') }, "trace: This that\ntrace: and the other", 'trace_literal should work'; $sqitch->{verbosity} = 2; is capture_stdout { $cmd->trace_literal('This ', "that\n", 'and the other') }, '', 'Should get no trace_literal output for verbosity 2'; # Debug. $sqitch->{verbosity} = 2; is capture_stdout { $cmd->debug('This ', "that\n", 'and the other') }, "debug: This that\ndebug: and the other\n", 'debug should work'; $sqitch->{verbosity} = 1; is capture_stdout { $cmd->debug('This ', "that\n", 'and the other') }, '', 'Should get no debug output for verbosity 1'; # Debug literal. $sqitch->{verbosity} = 2; is capture_stdout { $cmd->debug_literal('This ', "that\n", 'and the other') }, "debug: This that\ndebug: and the other", 'debug_literal should work'; $sqitch->{verbosity} = 1; is capture_stdout { $cmd->debug_literal('This ', "that\n", 'and the other') }, '', 'Should get no debug_literal output for verbosity 1'; # Info. $sqitch->{verbosity} = 1; is capture_stdout { $cmd->info('This ', "that\n", 'and the other') }, "This that\nand the other\n", 'info should work'; $sqitch->{verbosity} = 0; is capture_stdout { $cmd->info('This ', "that\n", 'and the other') }, '', 'Should get no info output for verbosity 0'; # Info literal. $sqitch->{verbosity} = 1; is capture_stdout { $cmd->info_literal('This ', "that\n", 'and the other') }, "This that\nand the other", 'info_literal should work'; $sqitch->{verbosity} = 0; is capture_stdout { $cmd->info_literal('This ', "that\n", 'and the other') }, '', 'Should get no info_literal output for verbosity 0'; # Comment. $sqitch->{verbosity} = 1; is capture_stdout { $cmd->comment('This ', "that\n", 'and the other') }, "# This that\n# and the other\n", 'comment should work'; $sqitch->{verbosity} = 0; is capture_stdout { $sqitch->comment('This ', "that\n", 'and the other') }, "# This that\n# and the other\n", 'comment should work with verbosity 0'; # Comment literal. $sqitch->{verbosity} = 1; is capture_stdout { $cmd->comment_literal('This ', "that\n", 'and the other') }, "# This that\n# and the other", 'comment_literal should work'; $sqitch->{verbosity} = 0; is capture_stdout { $sqitch->comment_literal('This ', "that\n", 'and the other') }, "# This that\n# and the other", 'comment_literal should work with verbosity 0'; # Emit. is capture_stdout { $cmd->emit('This ', "that\n", 'and the other') }, "This that\nand the other\n", 'emit should work'; $sqitch->{verbosity} = 0; is capture_stdout { $cmd->emit('This ', "that\n", 'and the other') }, "This that\nand the other\n", 'emit should work even with verbosity 0'; # Emit literal. is capture_stdout { $cmd->emit_literal('This ', "that\n", 'and the other') }, "This that\nand the other", 'emit_literal should work'; $sqitch->{verbosity} = 0; is capture_stdout { $cmd->emit_literal('This ', "that\n", 'and the other') }, "This that\nand the other", 'emit_literal should work even with verbosity 0'; # Warn. is capture_stderr { $cmd->warn('This ', "that\n", 'and the other') }, "warning: This that\nwarning: and the other\n", 'warn should work'; # Warn literal. is capture_stderr { $cmd->warn_literal('This ', "that\n", 'and the other') }, "warning: This that\nwarning: and the other", 'warn_literal should work'; # Usage. $catch_exit = 1; like capture_stderr { throws_ok { $cmd->usage('Invalid whozit') } qr/EXITED: 2/ }, qr/Invalid whozit/, 'usage should work'; like capture_stderr { throws_ok { $cmd->usage('Invalid whozit') } qr/EXITED: 2/ }, qr/\Qsqitch [] [] []/, 'usage should prefer sqitch-$command-usage'; App-Sqitch-0.9996/t/config.t000644 000767 000024 00000116116 13133201371 015734 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use Test::More tests => 344; #use Test::More 'no_plan'; use File::Spec; use Test::MockModule; use Test::Exception; use Test::NoWarnings; use Path::Class; use File::Path qw(remove_tree); use Locale::TextDomain qw(App-Sqitch); my $CLASS; BEGIN { $CLASS = 'App::Sqitch'; use_ok $CLASS or die; } # protect against user's environment variables delete @ENV{qw( SQITCH_CONFIG SQITCH_USER_CONFIG SQITCH_SYSTEM_CONFIG )}; ok my $sqitch = App::Sqitch->new, 'Load a sqitch object'; isa_ok my $cmd = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'config', config => $sqitch->config, }), 'App::Sqitch::Command::config', 'Config command'; isa_ok $cmd, 'App::Sqitch::Command', 'Config command'; can_ok $cmd, qw(file action context get get_all get_regex set add unset unset_all list edit); is_deeply [$cmd->options], [qw( file|config-file|f=s local user|global system int bool bool-or-int num get get-all get-regex|get-regexp add replace-all unset unset-all rename-section remove-section list|l edit|e )], 'Options should be configured'; ############################################################################## # Test configure errors. my $mock = Test::MockModule->new('App::Sqitch::Command::config'); my @usage; $mock->mock(usage => sub { shift; @usage = @_; die 'USAGE' }); # Test for multiple config file specifications. throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { user => 1, system => 1, }) } qr/USAGE/, 'Construct with user and system'; is_deeply \@usage, ['Only one config file at a time.'], 'Should get error for multiple config files'; throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { user => 1, local => 1, }) } qr/USAGE/, 'Construct with user and local'; is_deeply \@usage, ['Only one config file at a time.'], 'Should get error for multiple config files'; throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { file => 't/sqitch.ini', system => 1, })} qr/USAGE/, 'Construct with file and system'; is_deeply \@usage, ['Only one config file at a time.'], 'Should get another error for multiple config files'; throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { file => 't/sqitch.ini', user => 1, })} qr/USAGE/, 'Construct with file and user'; is_deeply \@usage, ['Only one config file at a time.'], 'Should get a third error for multiple config files'; throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { file => 't/sqitch.ini', user => 1, system => 1, })} qr/USAGE/, 'Construct with file, system, and user'; is_deeply \@usage, ['Only one config file at a time.'], 'Should get one last error for multiple config files'; # Test for multiple type specifications. throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { bool => 1, num => 1, }) } qr/USAGE/, 'Construct with bool and num'; is_deeply \@usage, ['Only one type at a time.'], 'Should get error for multiple types'; throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { sqitch => $sqitch, int => 1, num => 1, })} qr/USAGE/, 'Construct with int and num'; is_deeply \@usage, ['Only one type at a time.'], 'Should get another error for multiple types'; throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { int => 1, bool => 1, })} qr/USAGE/, 'Construct with int and bool'; is_deeply \@usage, ['Only one type at a time.'], 'Should get a third error for multiple types'; throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { int => 1, bool => 1, num => 1, })} qr/USAGE/, 'Construct with int, num, and bool'; is_deeply \@usage, ['Only one type at a time.'], 'Should get one last error for multiple types'; # Test for multiple action specifications. for my $spec ( [qw(get unset)], [qw(get unset edit)], [qw(get unset edit list)], [qw(unset edit)], [qw(unset edit list)], [qw(edit list)], [qw(edit add list)], [qw(edit add list get_all)], [qw(edit add list get_regex)], [qw(edit add list unset_all)], [qw(edit add list get_all unset_all)], [qw(edit list remove_section)], [qw(edit list remove_section rename_section)], ) { throws_ok { App::Sqitch::Command::config->configure( $sqitch->config, { map { $_ => 1 } @{ $spec } })} qr/USAGE/, 'Construct with ' . join ' & ' => @{ $spec }; is_deeply \@usage, ['Only one action at a time.'], 'Should get error for multiple actions'; } ############################################################################## # Test context. is $cmd->file, $sqitch->config->dir_file, 'Default context should be local context'; is $cmd->action, undef, 'Default action should be undef'; is $cmd->context, undef, 'Default context should be undef'; # Test local file name. is_deeply App::Sqitch::Command::config->configure( $sqitch->config, { local => 1, }), { context => 'local', }, 'Local context should be local'; # Test user file name. is_deeply App::Sqitch::Command::config->configure( $sqitch->config, { user => 1, }), { context => 'user', }, 'User context should be user'; # Test system file name. is_deeply App::Sqitch::Command::config->configure( $sqitch->config, { system => 1, }), { context => 'system', }, 'System context should be system'; ############################################################################## # Test execute(). my @fail; $mock->mock(fail => sub { shift; @fail = @_; die "FAIL @_" }); my @set; $mock->mock(set => sub { shift; @set = @_; return 1 }); my @get; $mock->mock(get => sub { shift; @get = @_; return 1 }); my @get_all; $mock->mock(get_all => sub { shift; @get_all = @_; return 1 }); ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'system', }), 'Create config set command'; ok $cmd->execute(qw(foo bar)), 'Execute the set command'; is_deeply \@set, [qw(foo bar)], 'The set method should have been called'; ok $cmd->execute(qw(foo)), 'Execute the get command'; is_deeply \@get, [qw(foo)], 'The get method should have been called'; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_all', }), 'Create config get_all command'; $cmd->execute('boy.howdy'); is_deeply \@get_all, ['boy.howdy'], 'An action with a dash should have triggered a method with an underscore'; $mock->unmock(qw(set get get_all)); ############################################################################## # Test get(). chdir 't'; $ENV{SQITCH_USER_CONFIG} = 'user.conf'; $sqitch->config->load; my @emit; $mock->mock(emit => sub { shift; push @emit => [@_] }); ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get', }), 'Create config get command'; ok $cmd->execute('core.engine'), 'Get core.engine'; is_deeply \@emit, [['pg']], 'Should have emitted the merged core.engine'; @emit = (); ok $cmd->execute('engine.pg.registry'), 'Get engine.pg.registry'; is_deeply \@emit, [['meta']], 'Should have emitted the merged engine.pg.registry'; @emit = (); ok $cmd->execute('engine.pg.client'), 'Get engine.pg.client'; is_deeply \@emit, [['/usr/local/pgsql/bin/psql']], 'Should have emitted the merged engine.pg.client'; @emit = (); # Make sure the key is required. throws_ok { $cmd->get } qr/USAGE/, 'Should get usage for missing get key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing get key should trigger a usage message'; throws_ok { $cmd->get('') } qr/USAGE/, 'Should get usage for invalid get key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the invalid get key should trigger a usage message'; # Make sure int data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get', type => 'int', }), 'Create config get int command'; ok $cmd->execute('revert.count'), 'Get revert.count as int'; is_deeply \@emit, [[2]], 'Should have emitted the revert count'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as int'; is_deeply \@emit, [[1]], 'Should have emitted the revert revision as an int'; @emit = (); throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X', 'Get bundle.tags_only as an int should fail'; is $@->ident, 'config', 'Int cast exception ident should be "config"'; # Make sure num data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get', type => 'num', }), 'Create config get num command'; ok $cmd->execute('revert.count'), 'Get revert.count as num'; is_deeply \@emit, [[2]], 'Should have emitted the revert count'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as num'; is_deeply \@emit, [[1.1]], 'Should have emitted the revert revision as an num'; @emit = (); throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X', 'Get bundle.tags_only as an num should fail'; is $@->ident, 'config', 'Num cast exception ident should be "config"'; # Make sure bool data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get', type => 'bool', }), 'Create config get bool command'; throws_ok { $cmd->execute('revert.count') } 'App::Sqitch::X', 'Should get failure for invalid bool int'; is $@->ident, 'config', 'Bool int cast exception ident should be "config"'; throws_ok { $cmd->execute('revert.revision') } 'App::Sqitch::X', 'Should get failure for invalid bool num'; is $@->ident, 'config', 'Bool num cast exception ident should be "config"'; ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool'; is_deeply \@emit, [['true']], 'Should have emitted bundle.tags_only as a bool'; @emit = (); # Make sure bool-or-int data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get', type => 'bool-or-int', }), 'Create config get bool-or-int command'; ok $cmd->execute('revert.count'), 'Get revert.count as bool-or-int'; is_deeply \@emit, [[2]], 'Should have emitted the revert count as an int'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as bool-or-int'; is_deeply \@emit, [[1]], 'Should have emitted the revert revision as an int'; @emit = (); ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool-or-int'; is_deeply \@emit, [['true']], 'Should have emitted bundle.tags_only as a bool'; @emit = (); chdir File::Spec->updir; CONTEXT: { local $ENV{SQITCH_SYSTEM_CONFIG} = file qw(t sqitch.conf); $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'system', action => 'get', }), 'Create system config get command'; ok $cmd->execute('core.engine'), 'Get system core.engine'; is_deeply \@emit, [['pg']], 'Should have emitted the system core.engine'; @emit = (); ok $cmd->execute('engine.pg.client'), 'Get system engine.pg.client'; is_deeply \@emit, [['/usr/local/pgsql/bin/psql']], 'Should have emitted the system engine.pg.client'; @emit = @fail = (); throws_ok { $cmd->execute('engine.pg.host') } 'App::Sqitch::X', 'Attempt to get engine.pg.host should fail'; is $@->ident, 'config', 'Error ident should be "config"'; is $@->message, '', 'Error Message should be empty'; is $@->exitval, 1, 'Error exitval should be 1'; is_deeply \@emit, [], 'Nothing should have been emitted'; local $ENV{SQITCH_USER_CONFIG} = file qw(t user.conf); $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'user', action => 'get', }), 'Create user config get command'; @emit = (); ok $cmd->execute('engine.pg.registry'), 'Get user engine.pg.registry'; is_deeply \@emit, [['meta']], 'Should have emitted the user engine.pg.registry'; @emit = (); ok $cmd->execute('engine.pg.client'), 'Get user engine.pg.client'; is_deeply \@emit, [['/opt/local/pgsql/bin/psql']], 'Should have emitted the user engine.pg.client'; @emit = (); local $ENV{SQITCH_CONFIG} = file qw(t local.conf); $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'local', action => 'get', }), 'Create local config get command'; @emit = (); ok $cmd->execute('engine.pg.target'), 'Get local engine.pg.target'; is_deeply \@emit, [['mydb']], 'Should have emitted the local engine.pg.target'; @emit = (); ok $cmd->execute('core.engine'), 'Get local core.engine'; is_deeply \@emit, [['pg']], 'Should have emitted the local core.engine'; @emit = (); } CONTEXT: { # What happens when there is no config file? local $ENV{SQITCH_SYSTEM_CONFIG} = 'NONEXISTENT'; $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'system', action => 'get', }), 'Create another system config get command'; ok !-f $cmd->file, 'There should be no system config file'; throws_ok { $cmd->execute('core.engine') } 'App::Sqitch::X', 'Should fail when no system config file'; is $@->ident, 'config', 'Error ident should be "config"'; is $@->message, '', 'Error Message should be empty'; is $@->exitval, 1, 'Error exitval should be 1'; local $ENV{SQITCH_USER_CONFIG} = 'NONEXISTENT'; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'user', action => 'get', }), 'Create another user config get command'; ok !-f $cmd->file, 'There should be no user config file'; throws_ok { $cmd->execute('core.engine') } 'App::Sqitch::X', 'Should fail when no user config file'; is $@->ident, 'config', 'Error ident should be "config"'; is $@->message, '', 'Error Message should be empty'; is $@->exitval, 1, 'Error exitval should be 1'; local $ENV{SQITCH_CONFIG} = 'NONEXISTENT'; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'local', action => 'get', }), 'Create another local config get command'; ok !-f $cmd->file, 'There should be no local config file'; throws_ok { $cmd->execute('core.engine') } 'App::Sqitch::X', 'Should fail when no local config file'; is $@->ident, 'config', 'Error ident should be "config"'; is $@->message, '', 'Error Message should be empty'; is $@->exitval, 1, 'Error exitval should be 1'; } ############################################################################## # Test list(). local $ENV{SQITCH_SYSTEM_CONFIG} = file qw(t sqitch.conf); local $ENV{SQITCH_USER_CONFIG} = file qw(t user.conf); local $ENV{SQITCH_CONFIG} = file qw(t local.conf); $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'list', }), 'Create config list command'; ok $cmd->execute, 'Execute the list action'; is_deeply \@emit, [[ 'bundle.dest_dir=_build/sql bundle.from=gamma bundle.tags_only=true core.engine=pg core.extension=ddl core.pager=less -r core.top_dir=migrations core.uri=https://github.com/theory/sqitch/ engine.firebird.client=/opt/firebird/bin/isql engine.firebird.registry=meta engine.mysql.client=/opt/local/mysql/bin/mysql engine.mysql.registry=meta engine.pg.client=/opt/local/pgsql/bin/psql engine.pg.registry=meta engine.pg.target=mydb engine.sqlite.client=/opt/local/bin/sqlite3 engine.sqlite.registry=meta engine.sqlite.target=devdb revert.count=2 revert.revision=1.1 revert.to=gamma target.devdb.uri=db:sqlite: target.mydb.plan_file=t/plans/dependencies.plan target.mydb.uri=db:pg:mydb user.email=michael@example.com user.name=Michael Stonebraker ' ]], 'Should have emitted the merged config'; @emit = (); CONTEXT: { local $ENV{SQITCH_SYSTEM_CONFIG} = file qw(t sqitch.conf); local $ENV{SQITCH_USER_CONFIG} = undef; local $ENV{SQITCH_CONFIG} = undef; $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'system', action => 'list', }), 'Create system config list command'; ok $cmd->execute, 'List the system config'; is_deeply \@emit, [[ 'bundle.dest_dir=_build/sql bundle.from=gamma bundle.tags_only=true core.engine=pg core.extension=ddl core.pager=less -r core.top_dir=migrations core.uri=https://github.com/theory/sqitch/ engine.pg.client=/usr/local/pgsql/bin/psql revert.count=2 revert.revision=1.1 revert.to=gamma ' ]], 'Should have emitted the system config list'; @emit = (); $ENV{SQITCH_USER_CONFIG} = file qw(t user.conf); $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'user', action => 'list', }), 'Create user config list command'; ok $cmd->execute, 'List the user config'; is_deeply \@emit, [[ 'engine.firebird.client=/opt/firebird/bin/isql engine.firebird.registry=meta engine.mysql.client=/opt/local/mysql/bin/mysql engine.mysql.registry=meta engine.pg.client=/opt/local/pgsql/bin/psql engine.pg.registry=meta engine.pg.target=db:pg://postgres@localhost/thingies engine.sqlite.client=/opt/local/bin/sqlite3 engine.sqlite.registry=meta engine.sqlite.target=db:sqlite:my.db user.email=michael@example.com user.name=Michael Stonebraker ' ]], 'Should only have emitted the user config list'; @emit = (); $ENV{SQITCH_CONFIG} = file qw(t local.conf); $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'local', action => 'list', }), 'Create local config list command'; ok $cmd->execute, 'List the local config'; is_deeply \@emit, [[ 'core.engine=pg engine.pg.target=mydb engine.sqlite.target=devdb target.devdb.uri=db:sqlite: target.mydb.plan_file=t/plans/dependencies.plan target.mydb.uri=db:pg:mydb ' ]], 'Should only have emitted the local config list'; @emit = (); } CONTEXT: { # What happens when there is no config file? local $ENV{SQITCH_SYSTEM_CONFIG} = 'NONEXISTENT'; local $ENV{SQITCH_USER_CONFIG} = undef; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'system', action => 'list', }), 'Create system config list command with no file'; ok $cmd->execute, 'List the system config'; is_deeply \@emit, [], 'Nothing should have been emitted'; $ENV{SQITCH_USER_CONFIG} = 'NONEXISTENT'; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, context => 'user', action => 'list', }), 'Create user config list command with no file'; ok $cmd->execute, 'List the user config'; is_deeply \@emit, [], 'Nothing should have been emitted'; } ############################################################################## # Test set(). my $file = 'testconfig.conf'; $mock->mock(file => $file); END { unlink $file } ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, }), 'Create system config set command'; ok $cmd->execute('core.foo' => 'bar'), 'Write core.foo'; is_deeply read_config($cmd->file), {'core.foo' => 'bar' }, 'The property should have been written'; # Write another property. ok $cmd->execute('core.engine' => 'funky'), 'Write core.engine'; is_deeply read_config($cmd->file), {'core.foo' => 'bar', 'core.engine' => 'funky' }, 'Both settings should be saved'; # Write a sub-propery. ok $cmd->execute('engine.pg.user' => 'theory'), 'Write engine.pg.user'; is_deeply read_config($cmd->file), { 'core.foo' => 'bar', 'core.engine' => 'funky', 'engine.pg.user' => 'theory', }, 'Both sections should be saved'; # Make sure the key is required. throws_ok { $cmd->set } qr/USAGE/, 'Should set usage for missing set key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing set key should trigger a usage message'; throws_ok { $cmd->set('') } qr/USAGE/, 'Should set usage for invalid set key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the invalid set key should trigger a usage message'; # Make sure the value is required. throws_ok { $cmd->set('foo.bar') } qr/USAGE/, 'Should set usage for missing set value'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing set value should trigger a usage message'; ############################################################################## # Test add(). ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'add', }), 'Create system config add command'; ok $cmd->execute('core.foo' => 'baz'), 'Add to core.foo'; is_deeply read_config($cmd->file), { 'core.foo' => ['bar', 'baz'], 'core.engine' => 'funky', 'engine.pg.user' => 'theory', }, 'The value should have been added to the property'; # Make sure the key is required. throws_ok { $cmd->add } qr/USAGE/, 'Should add usage for missing add key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing add key should trigger a usage message'; throws_ok { $cmd->add('') } qr/USAGE/, 'Should add usage for invalid add key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the invalid add key should trigger a usage message'; # Make sure the value is required. throws_ok { $cmd->add('foo.bar') } qr/USAGE/, 'Should add usage for missing add value'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing add value should trigger a usage message'; ############################################################################## # Test get with regex. delete $ENV{SQITCH_CONFIG}; $ENV{SQITCH_USER_CONFIG} = $file; $sqitch->config->load; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get', }), 'Create system config add command'; ok $cmd->execute('core.engine', 'funk'), 'Get core.engine with regex'; is_deeply \@emit, [['funky']], 'Should have emitted value'; @emit = (); ok $cmd->execute('core.foo', 'z$'), 'Get core.foo with regex'; is_deeply \@emit, [['baz']], 'Should have emitted value'; @emit = (); throws_ok { $cmd->execute('core.foo', 'x$') } 'App::Sqitch::X', 'Attempt to get core.foo with non-matching regex should fail'; is $@->ident, 'config', 'Error ident should be "config"'; is $@->message, '', 'Error Message should be empty'; is $@->exitval, 1, 'Error exitval should be 1'; is_deeply \@emit, [], 'Nothing should have been emitted'; ############################################################################## # Test get_all(). @emit = (); ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_all', }), 'Create system config get_all command'; ok $cmd->execute('core.engine'), 'Call get_all on core.engine'; is_deeply \@emit, [['funky']], 'The engine should have been emitted'; @emit = (); ok $cmd->execute('core.engine', 'funk'), 'Get all core.engine with regex'; is_deeply \@emit, [['funky']], 'Should have emitted value'; @emit = (); ok $cmd->execute('core.foo'), 'Call get_all on core.foo'; is_deeply \@emit, [["bar\nbaz"]], 'Both foos should have been emitted'; @emit = (); ok $cmd->execute('core.foo', '^ba'), 'Call get_all on core.foo with regex'; is_deeply \@emit, [["bar\nbaz"]], 'Both foos should have been emitted'; @emit = (); ok $cmd->execute('core.foo', 'z$'), 'Call get_all on core.foo with limiting regex'; is_deeply \@emit, [["baz"]], 'Only the one foo should have been emitted'; @emit = (); throws_ok { $cmd->execute('core.foo', 'x$') } 'App::Sqitch::X', 'Attempt to get_all core.foo with non-matching regex should fail'; is $@->ident, 'config', 'Error ident should be "config"'; is $@->message, '', 'Error Message should be empty'; is $@->exitval, 1, 'Error exitval should be 1'; is_deeply \@emit, [], 'Nothing should have been emitted'; # Make sure the key is required. throws_ok { $cmd->get_all } qr/USAGE/, 'Should get_all usage for missing get_all key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing get_all key should trigger a usage message'; throws_ok { $cmd->get_all('') } qr/USAGE/, 'Should get_all usage for invalid get_all key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the invalid get_all key should trigger a usage message'; # Make sure int data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_all', type => 'int', }), 'Create config get_all int command'; ok $cmd->execute('revert.count'), 'Get revert.count as int'; is_deeply \@emit, [[2]], 'Should have emitted the revert count'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as int'; is_deeply \@emit, [[1]], 'Should have emitted the revert revision as an int'; @emit = (); throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X', 'Get bundle.tags_only as an int should fail'; is $@->ident, 'config', 'Int cast exception ident should be "config"'; # Make sure num data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_all', type => 'num', }), 'Create config get_all num command'; ok $cmd->execute('revert.count'), 'Get revert.count as num'; is_deeply \@emit, [[2]], 'Should have emitted the revert count'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as num'; is_deeply \@emit, [[1.1]], 'Should have emitted the revert revision as an num'; @emit = (); throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X', 'Get bundle.tags_only as an num should fail'; is $@->ident, 'config', 'Num cast exception ident should be "config"'; # Make sure bool data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_all', type => 'bool', }), 'Create config get_all bool command'; throws_ok { $cmd->execute('revert.count') } 'App::Sqitch::X', 'Should get failure for invalid bool int'; is $@->ident, 'config', 'Bool int cast exception ident should be "config"'; throws_ok { $cmd->execute('revert.revision') } 'App::Sqitch::X', 'Should get failure for invalid bool num'; is $@->ident, 'config', 'Num int cast exception ident should be "config"'; ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool'; is_deeply \@emit, [[$Config::GitLike::VERSION > 1.08 ? 'true' : 1]], 'Should have emitted bundle.tags_only as a bool'; @emit = (); # Make sure bool-or-int data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_all', type => 'bool-or-int', }), 'Create config get_all bool-or-int command'; ok $cmd->execute('revert.count'), 'Get revert.count as bool-or-int'; is_deeply \@emit, [[2]], 'Should have emitted the revert count as an int'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as bool-or-int'; is_deeply \@emit, [[1]], 'Should have emitted the revert revision as an int'; @emit = (); ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool-or-int'; is_deeply \@emit, [[$Config::GitLike::VERSION > 1.08 ? 'true' : 1]], 'Should have emitted bundle.tags_only as a bool'; @emit = (); ############################################################################## # Test get_regex(). ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_regex', }), 'Create system config get_regex command'; ok $cmd->execute('core\\..+'), 'Call get_regex on core\\..+'; is_deeply \@emit, [[q{core.engine=funky core.extension=ddl core.foo=[bar, baz] core.pager=less -r core.top_dir=migrations core.uri=https://github.com/theory/sqitch/} ]], 'Should match all core options'; @emit = (); ok $cmd->execute('engine\\.pg\\..+'), 'Call get_regex on engine\\.pg\\..+'; is_deeply \@emit, [[q{engine.pg.client=/usr/local/pgsql/bin/psql engine.pg.user=theory} ]], 'Should match all engine.pg options'; @emit = (); ok $cmd->execute('engine\\.pg\\..+', 'theory$'), 'Call get_regex on engine\\.pg\\..+ and value regex'; is_deeply \@emit, [[q{engine.pg.user=theory} ]], 'Should match all engine.pg options that match'; @emit = (); throws_ok { $cmd->execute('engine\\.pg\\..+', 'x$') } 'App::Sqitch::X', 'Attempt to get_regex core.foo with non-matching regex should fail'; is $@->ident, 'config', 'Error ident should be "config"'; is $@->message, '', 'Error Message should be empty'; is $@->exitval, 1, 'Error exitval should be 1'; is_deeply \@emit, [], 'Nothing should have been emitted'; # Make sure the key is required. throws_ok { $cmd->get_regex } qr/USAGE/, 'Should get_regex usage for missing get_regex key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing get_regex key should trigger a usage message'; throws_ok { $cmd->get_regex('') } qr/USAGE/, 'Should get_regex usage for invalid get_regex key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the invalid get_regex key should trigger a usage message'; # Make sure int data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_regex', type => 'int', }), 'Create config get_regex int command'; ok $cmd->execute('revert.count'), 'Get revert.count as int'; is_deeply \@emit, [['revert.count=2']], 'Should have emitted the revert count'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as int'; is_deeply \@emit, [['revert.revision=1']], 'Should have emitted the revert revision as an int'; @emit = (); throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X', 'Get bundle.tags_only as an int should fail'; is $@->ident, 'config', 'Int cast exception ident should be "config"'; # Make sure num data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_regex', type => 'num', }), 'Create config get_regexp num command'; ok $cmd->execute('revert.count'), 'Get revert.count as num'; is_deeply \@emit, [['revert.count=2']], 'Should have emitted the revert count'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as num'; is_deeply \@emit, [['revert.revision=1.1']], 'Should have emitted the revert revision as an num'; @emit = (); throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X', 'Get bundle.tags_only as an num should fail'; is $@->ident, 'config', 'Num cast exception ident should be "config"'; # Make sure bool data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_regex', type => 'bool', }), 'Create config get_regex bool command'; throws_ok { $cmd->execute('revert.count') } 'App::Sqitch::X', 'Should get failure for invalid bool int'; is $@->ident, 'config', 'Bool int cast exception ident should be "config"'; throws_ok { $cmd->execute('revert.revision') } 'App::Sqitch::X', 'Should get failure for invalid bool num'; is $@->ident, 'config', 'Num int cast exception ident should be "config"'; ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool'; is_deeply \@emit, [['bundle.tags_only=' . ($Config::GitLike::VERSION > 1.08 ? 'true' : 1)]], 'Should have emitted bundle.tags_only as a bool'; @emit = (); # Make sure int data type works. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'get_regex', type => 'bool-or-int', }), 'Create config get_regex bool-or-int command'; ok $cmd->execute('revert.count'), 'Get revert.count as bool-or-int'; is_deeply \@emit, [['revert.count=2']], 'Should have emitted the revert count as an int'; @emit = (); ok $cmd->execute('revert.revision'), 'Get revert.revision as bool-or-int'; is_deeply \@emit, [['revert.revision=1']], 'Should have emitted the revert revision as an int'; @emit = (); ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool-or-int'; is_deeply \@emit, [['bundle.tags_only=' . ($Config::GitLike::VERSION > 1.08 ? 'true' : 1)]], 'Should have emitted bundle.tags_only as a bool'; @emit = (); ############################################################################## # Test unset(). ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'unset', }), 'Create system config unset command'; ok $cmd->execute('engine.pg.user'), 'Unset engine.pg.user'; is_deeply read_config($cmd->file), { 'core.foo' => ['bar', 'baz'], 'core.engine' => 'funky', }, 'engine.pg.user should be gone'; ok $cmd->execute('core.engine'), 'Unset core.engine'; is_deeply read_config($cmd->file), { 'core.foo' => ['bar', 'baz'], }, 'core.engine should have been removed'; throws_ok { $cmd->execute('core.foo') } 'App::Sqitch::X', 'Should get failure trying to delete multivalue key'; is $@->ident, 'config', 'Multiple value exception ident should be "config"'; is $@->message, __ 'Cannot unset key with multiple values', 'And it should have the proper error message'; ok $cmd->execute('core.foo', 'z$'), 'Unset core.foo with a regex'; is_deeply read_config($cmd->file), { 'core.foo' => 'bar', }, 'The core.foo "baz" value should have been removed'; # Make sure the key is required. throws_ok { $cmd->unset } qr/USAGE/, 'Should unset usage for missing unset key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing unset key should trigger a usage message'; throws_ok { $cmd->unset('') } qr/USAGE/, 'Should unset usage for invalid unset key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the invalid unset key should trigger a usage message'; ############################################################################## # Test unset_all(). ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'unset_all', }), 'Create system config unset_all command'; $cmd->add('core.foo', 'baz'); ok $cmd->execute('core.foo'), 'unset_all core.foo'; is_deeply read_config($cmd->file), {}, 'core.foo should have been removed'; # Test handling of multiple value. $cmd->add('core.foo', 'bar'); $cmd->add('core.foo', 'baz'); $cmd->add('core.foo', 'yo'); ok $cmd->execute('core.foo', '^ba'), 'unset_all core.foo with regex'; is_deeply read_config($cmd->file), { 'core.foo' => 'yo', }, 'core.foo should have one value left'; # Make sure the key is required. throws_ok { $cmd->unset_all } qr/USAGE/, 'Should unset_all usage for missing unset_all key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the missing unset_all key should trigger a usage message'; throws_ok { $cmd->unset_all('') } qr/USAGE/, 'Should unset_all usage for invalid unset_all key'; is_deeply \@usage, ['Wrong number of arguments.'], 'And the invalid unset_all key should trigger a usage message'; ############################################################################## # Test replace_all. ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'replace_all', }), 'Create system config replace_all command'; $cmd->add('core.bar', 'bar'); $cmd->add('core.bar', 'baz'); $cmd->add('core.bar', 'yo'); ok $cmd->execute('core.bar', 'hi'), 'Replace all core.bar'; is_deeply read_config($cmd->file), { 'core.bar' => 'hi', 'core.foo' => 'yo', }, 'core.bar should have all its values with one value'; $cmd->add('core.foo', 'bar'); $cmd->add('core.foo', 'baz'); ok $cmd->execute('core.foo', 'ba', '^ba'), 'Replace all core.bar matching /^ba/'; is_deeply read_config($cmd->file), { 'core.bar' => 'hi', 'core.foo' => ['yo', 'ba'], }, 'core.foo should have had the matching values replaced'; # Clean up. $cmd->unset_all('core.bar'); $cmd->unset('core.foo', 'ba'); ############################################################################## # Test rename_section(). ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'rename_section', }), 'Create system config rename_section command'; ok $cmd->execute('core', 'funk'), 'Rename "core" to "funk"'; is_deeply read_config($cmd->file), { 'funk.foo' => 'yo', }, 'core.foo should have become funk.foo'; throws_ok { $cmd->execute('foo') } qr/USAGE/, 'Should fail with no new name'; is_deeply \@usage, ['Wrong number of arguments.'], 'Message should be in the usage call'; throws_ok { $cmd->execute('', 'bar') } qr/USAGE/, 'Should fail with bad old name'; is_deeply \@usage, ['Wrong number of arguments.'], 'Message should be in the usage call'; throws_ok { $cmd->execute('baz', '') } qr/USAGE/, 'Should fail with bad new name'; is_deeply \@usage, ['Wrong number of arguments.'], 'Message should be in the usage call'; throws_ok { $cmd->execute('foo', 'bar') } 'App::Sqitch::X', 'Should fail with invalid section'; is $@->ident, 'config', 'Invalid section exception ident should be "config"'; is $@->message, __ 'No such section!', 'Invalid section exception message should be set'; ############################################################################## # Test remove_section(). ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'remove_section', }), 'Create system config remove_section command'; ok $cmd->execute('funk'), 'Remove "func" section'; is_deeply read_config($cmd->file), {}, 'The "funk" section should be gone'; throws_ok { $cmd->execute() } qr/USAGE/, 'Should fail with no name'; is_deeply \@usage, ['Wrong number of arguments.'], 'Message should be in the usage call'; throws_ok { $cmd->execute('bar') } 'App::Sqitch::X', 'Should fail with invalid name'; is $@->ident, 'config', 'Invalid key name exception ident should be "config"'; is $@->message, __ 'No such section!', 'And the invalid key message should be set'; ############################################################################## # Test errors with multiple values. throws_ok { $cmd->get('core.foo', '.') } 'App::Sqitch::X', 'Should fail fetching multi-value key'; is $@->ident, 'config', 'Multi-value key exception ident should be "config"'; is $@->message, __x( 'More then one value for the key "{key}"', key => 'core.foo', ), 'The multiple value error should be thrown'; $cmd->add('core.foo', 'hi'); $cmd->add('core.foo', 'bye'); throws_ok { $cmd->set('core.foo', 'hi') } 'App::Sqitch::X', 'Should fail setting multi-value key'; is $@->ident, 'config', 'Mult-valkue key exception ident should be "config"'; is $@->message, __('Cannot overwrite multiple values with a single value'), 'The multi-value key error should be thrown'; ############################################################################## # Test edit(). my $shell; my $ret = 1; $mock->mock(shell => sub { $shell = $_[1]; return $ret }); ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, action => 'edit', }), 'Create system config edit command'; ok $cmd->execute, 'Execute the edit comand'; is $shell, $sqitch->editor . ' ' . $sqitch->quote_shell($cmd->file), 'The editor should have been run'; ############################################################################## # Make sure we can write to a file in a directory. my $path = file qw(t config.tmp test.conf); $mock->mock(file => $path); END { remove_tree +File::Spec->catdir(qw(t config.tmp)) } ok $sqitch = App::Sqitch->new, 'Load a new sqitch object'; ok $cmd = App::Sqitch::Command::config->new({ sqitch => $sqitch, }), 'Create system config set command with subdirectory config file path'; ok $cmd->execute('my.foo', 'hi'), 'Set "my.foo" in subdirectory config file'; is_deeply read_config($cmd->file), {'my.foo' => 'hi' }, 'The file should have been written'; sub read_config { my $conf = App::Sqitch::Config->new; $conf->load_file(shift); $conf->data; } App-Sqitch-0.9996/t/configuration.t000644 000767 000024 00000004530 13133201371 017332 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use Test::More tests => 17; #use Test::More 'no_plan'; use File::Spec; use Test::MockModule; use Test::Exception; use Test::NoWarnings; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Config'; use_ok $CLASS or die; } # protect against user's environment variables delete @ENV{qw( SQITCH_CONFIG SQITCH_USER_CONFIG SQITCH_SYSTEM_CONFIG )}; isa_ok my $config = $CLASS->new, $CLASS, 'New config object'; is $config->confname, 'sqitch.conf', 'confname should be "sqitch.conf"'; SKIP: { skip 'System dir can be modified at build time', 1 if $INC{'App/Sqitch/Config.pm'} =~ /\bblib\b/; is $config->system_dir, File::Spec->catfile( $Config::Config{prefix}, 'etc', 'sqitch' ), 'Default system directory should be correct'; } is $config->user_dir, File::Spec->catfile( File::HomeDir->my_home, '.sqitch' ), 'Default user directory should be correct'; is $config->global_file, File::Spec->catfile( $config->system_dir, 'sqitch.conf' ), 'Default global file name should be correct'; my $file = File::Spec->catfile(qw(FOO BAR)); $ENV{SQITCH_SYSTEM_CONFIG} = $file; is $config->global_file, $file, 'Should preferably get SQITCH_SYSTEM_CONFIG file from global_file'; is $config->system_file, $config->global_file, 'system_file should alias global_file'; is $config->user_file, File::Spec->catfile( File::HomeDir->my_home, '.sqitch', 'sqitch.conf' ), 'Default user file name should be correct'; $ENV{SQITCH_USER_CONFIG} = $file, is $config->user_file, $file, 'Should preferably get SQITCH_USER_CONFIG file from user_file'; is $config->local_file, 'sqitch.conf', 'Local file should be correct'; is $config->dir_file, $config->local_file, 'dir_file should alias local_file'; SQITCH_CONFIG: { local $ENV{SQITCH_CONFIG} = 'sqitch.ini'; is $config->local_file, 'sqitch.ini', 'local_file should prefer $SQITCH_CONFIG'; is $config->dir_file, 'sqitch.ini', 'And so should dir_file'; } chdir 't'; is_deeply $config->get_section(section => 'core'), { engine => "pg", extension => "ddl", top_dir => "migrations", uri => 'https://github.com/theory/sqitch/', pager => "less -r", }, 'get_section("core") should work'; is_deeply $config->get_section(section => 'engine.pg'), { client => "/usr/local/pgsql/bin/psql", }, 'get_section("engine.pg") should work'; App-Sqitch-0.9996/t/core.conf000644 000767 000024 00000000027 13133201371 016072 0ustar00davidstaff000000 000000 [core] engine = pg App-Sqitch-0.9996/t/core_target.conf000644 000767 000024 00000000043 13133201371 017436 0ustar00davidstaff000000 000000 [core] target = db:pg:whatever App-Sqitch-0.9996/t/datetime.t000644 000767 000024 00000005534 13133201371 016264 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 33; #use Test::More 'no_plan'; use Locale::TextDomain qw(App-Sqitch); use Test::NoWarnings; use Test::Exception; use Encode; use lib 't/lib'; use LC; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::DateTime'; require_ok $CLASS; ok my $dt = $CLASS->now, 'Construct a datetime object'; is_deeply [$dt->as_string_formats], [qw( raw iso iso8601 rfc rfc2822 full long medium short )], 'as_string_formats should be correct'; my $rfc = do { my $clone = $dt->clone; $clone->set_time_zone('local'); $clone->set_locale('en_US'); ( my $rv = $clone->strftime('%a, %d %b %Y %H:%M:%S %z') ) =~ s/\+0000$/-0000/; $rv; }; my $iso = do { my $clone = $dt->clone; $clone->set_time_zone('local'); join ' ', $clone->ymd('-'), $clone->hms(':'), $clone->strftime('%z') }; my $ldt = do { my $clone = $dt->clone; $clone->set_time_zone('local'); $clone->set_locale($LC::TIME); $clone; }; my $raw = do { my $clone = $dt->clone; $clone->set_time_zone('UTC'); $clone->iso8601 . 'Z'; }; for my $spec ( [ full => $ldt->format_cldr( $ldt->locale->datetime_format_full )], [ long => $ldt->format_cldr( $ldt->locale->datetime_format_long )], [ medium => $ldt->format_cldr( $ldt->locale->datetime_format_medium )], [ short => $ldt->format_cldr( $ldt->locale->datetime_format_short )], [ raw => $raw ], [ '' => $raw ], [ iso => $iso ], [ iso8601 => $iso ], [ rfc => $rfc ], [ rfc2822 => $rfc ], [ q{cldr:HH'h' mm'm'} => $ldt->format_cldr( q{HH'h' mm'm'} ) ], [ 'strftime:%a at %H:%M:%S' => $ldt->strftime('%a at %H:%M:%S') ], ) { my $clone = $dt->clone; $clone->set_time_zone('UTC'); is $dt->as_string( format => $spec->[0] ), $spec->[1], sprintf 'Date format "%s" should yield "%s"', $spec->[0], encode_utf8 $spec->[1]; ok $dt->validate_as_string_format($spec->[0]), qq{Format "$spec->[0]" should be valid} if $spec->[0]; } throws_ok { $dt->validate_as_string_format('nonesuch') } 'App::Sqitch::X', 'Should get error for invalid date format'; is $@->ident, 'datetime', 'Invalid date format error ident should be "datetime"'; is $@->message, __x( 'Unknown date format "{format}"', format => 'nonesuch', ), 'Invalid date format error message should be correct'; throws_ok { $dt->as_string( format => 'nonesuch' ) } 'App::Sqitch::X', 'Should get error for invalid as_string format param'; is $@->ident, 'datetime', 'Invalid date format error ident should be "datetime"'; is $@->message, __x( 'Unknown date format "{format}"', format => 'nonesuch', ), 'Invalid date format error message should be correct'; App-Sqitch-0.9996/t/depend.t000644 000767 000024 00000020461 13133201371 015723 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 326; #use Test::More 'no_plan'; use Test::Exception; #use Test::NoWarnings; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; use Locale::TextDomain qw(App-Sqitch); $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Plan::Depend'; require_ok $CLASS or die; } ok my $sqitch = App::Sqitch->new(options => { engine => 'sqlite', top_dir => Path::Class::Dir->new(qw(t sql))->stringify, }), 'Load a sqitch sqitch object'; my $target = App::Sqitch::Target->new( sqitch => $sqitch ); my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, project => 'depend', target => $target); can_ok $CLASS, qw( conflicts project change tag id resolved_id key_name as_string as_plan_string ); my $id = '9ed961ad7902a67fe0804c8e49e8993719fd5065'; for my $spec( [ 'foo' => change => 'foo' ], [ 'bar' => change => 'bar' ], [ '@bar' => tag => 'bar' ], [ '!foo' => change => 'foo', conflicts => 1 ], [ '!@bar' => tag => 'bar', conflicts => 1 ], [ 'foo@bar' => change => 'foo', tag => 'bar' ], [ '!foo@bar' => change => 'foo', tag => 'bar', conflicts => 1 ], [ 'proj:foo' => change => 'foo', project => 'proj' ], [ '!proj:foo' => change => 'foo', project => 'proj', conflicts => 1 ], [ 'proj:@foo' => tag => 'foo', project => 'proj' ], [ '!proj:@foo' => tag => 'foo', project => 'proj', conflicts => 1 ], [ 'proj:foo@bar' => change => 'foo', tag => 'bar', project => 'proj' ], [ '!proj:foo@bar', change => 'foo', tag => 'bar', project => 'proj', conflicts => 1 ], [ $id => id => $id ], [ "!$id" => id => $id, conflicts => 1 ], [ "foo:$id" => id => $id, project => 'foo' ], [ "!foo:$id" => id => $id, project => 'foo', conflicts => 1 ], [ "$id\@what" => change => $id, tag => 'what' ], [ "!$id\@what" => change => $id, tag => 'what', conflicts => 1 ], [ "foo:$id\@what" => change => $id, tag => 'what', project => 'foo' ], ) { my $exp = shift @{$spec}; ok my $depend = $CLASS->new( plan => $plan, @{$spec}, ), qq{Construct "$exp"}; ( my $str = $exp ) =~ s/^!//; ( my $key = $str ) =~ s/^[^:]+://; my $proj = $1; is $depend->as_string, $str, qq{Constructed should stringify as "$str"}; is $depend->key_name, $key, qq{Constructed should have key name "$key"}; is $depend->as_plan_string, $exp, qq{Constructed should plan stringify as "$exp"}; ok $depend = $CLASS->new( plan => $plan, %{ $CLASS->parse($exp) }, ), qq{Parse "$exp"}; is $depend->as_plan_string, $exp, qq{Parsed should plan stringify as "$exp"}; if ($exp =~ /^!/) { # Conflicting. ok $depend->conflicts, qq{"$exp" should be conflicting}; ok !$depend->required, qq{"$exp" should not be required}; is $depend->type, 'conflict', qq{"$exp" type should be "conflict"}; } else { # Required. ok $depend->required, qq{"$exp" should be required}; ok !$depend->conflicts, qq{"$exp" should not be conflicting}; is $depend->type, 'require', qq{"$exp" type should be "require"}; } if ($str =~ /^([^:]+):/) { # Project specified in spec. my $prj = $1; ok $depend->got_project, qq{Should have got project from "$exp"}; is $depend->project, $prj, qq{Should have project "$prj" for "$exp"}; if ($prj eq $plan->project) { ok !$depend->is_external, qq{"$exp" should not be external}; ok $depend->is_internal, qq{"$exp" should be internal}; } else { ok $depend->is_external, qq{"$exp" should be external}; ok !$depend->is_internal, qq{"$exp" should not be internal}; } } else { ok !$depend->got_project, qq{Should not have got project from "$exp"}; if ($depend->change || $depend->tag) { # No ID, default to current project. my $prj = $plan->project; is $depend->project, $prj, qq{Should have project "$prj" for "$exp"}; ok !$depend->is_external, qq{"$exp" should not be external}; ok $depend->is_internal, qq{"$exp" should be internal}; } else { # ID specified, but no project, and ID not in plan, so unknown project. is $depend->project, undef, qq{Should have undef project for "$exp"}; ok $depend->is_external, qq{"$exp" should be external}; ok !$depend->is_internal, qq{"$exp" should not be internal}; } } if ($exp =~ /\Q$id\E(?![@])/) { ok $depend->got_id, qq{Should have got ID from "$exp"}; } else { ok !$depend->got_id, qq{Should not have got ID from "$exp"}; } } for my $bad ( 'foo bar', 'foo+@bar', 'foo:+bar', 'foo@bar+', 'proj:foo@bar+', ) { is $CLASS->parse($bad), undef, qq{Should fail to parse "$bad"}; } throws_ok { $CLASS->new( plan => $plan ) } 'App::Sqitch::X', 'Should get exception for no change or tag'; is $@->ident, 'DEV', 'No change or tag error ident should be "DEV"'; is $@->message, 'Depend object must have either "change", "tag", or "id" defined', 'No change or tag error message should be correct'; for my $params ( { change => 'foo' }, { tag => 'bar' }, { change => 'foo', tag => 'bar' }, ) { my $keys = join ' and ' => keys %{ $params }; throws_ok { $CLASS->new( plan => $plan, id => $id, %{ $params} ) } 'App::Sqitch::X', "Should get an error for ID + $keys"; is $@->ident, 'DEV', qq{ID + $keys error ident ident should be "DEV"}; is $@->message, 'Depend object cannot contain both an ID and a tag or change', qq{ID + $keys error message should be correct}; } ############################################################################## # Test ID. ok my $depend = $CLASS->new( plan => $plan, %{ $CLASS->parse('roles') }, ), 'Create "roles" dependency'; is $depend->id, $plan->find('roles')->id, 'Should find the "roles" ID in the plan'; ok !$depend->is_external, 'The "roles" change should not be external'; ok $depend->is_internal, 'The "roles" change should be internal'; ok $depend = $CLASS->new( plan => $plan, %{ $CLASS->parse('elsewhere:roles') }, ), 'Create "elsewhere:roles" dependency'; is $depend->id, undef, 'The "elsewhere:roles" id should be undef'; ok $depend->is_external, 'The "elsewhere:roles" change should be external'; ok !$depend->is_internal, 'The "elsewhere:roles" change should not be internal'; ok $depend = $CLASS->new( plan => $plan, id => $id, ), 'Create depend using external ID'; is $depend->id, $id, 'The external ID should be set'; ok $depend->is_external, 'The external ID should register as external'; ok !$depend->is_internal, 'The external ID should not register as internal'; $id = $plan->find('roles')->id; ok $depend = $CLASS->new( plan => $plan, id => $id, ), 'Create depend using "roles" ID'; is $depend->id, $id, 'The "roles" ID should be set'; ok !$depend->is_external, 'The "roles" ID should not register as external'; ok $depend->is_internal, 'The "roles" ID should register as internal'; ok $depend = $CLASS->new( plan => $plan, project => $plan->project, %{ $CLASS->parse('nonexistent') }, ), 'Create "nonexistent" dependency'; throws_ok { $depend->id } 'App::Sqitch::X', 'Should get error for nonexistent change'; is $@->ident, 'plan', 'Nonexistent change error ident should be "plan"'; is $@->message, __x( 'Unable to find change "{change}" in plan {file}', change => 'nonexistent', file => $target->plan_file, ), 'Nonexistent change error message should be correct'; ############################################################################## # Test resolved_id. ok $depend = $CLASS->new( plan => $plan, tag => 'foo' ), 'Create depend without ID'; is $depend->resolved_id, undef, 'Resolved ID should be undef'; ok $depend->resolved_id($id), 'Set resolved ID'; is $depend->resolved_id, $id, 'Resolved ID should be set'; ok !$depend->resolved_id(undef), 'Unset resolved ID'; is $depend->resolved_id, undef, 'Resolved ID should be undef again'; App-Sqitch-0.9996/t/deploy.t000644 000767 000024 00000020637 13133201371 015765 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use Path::Class qw(dir file); use Test::MockModule; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use lib 't/lib'; use MockOutput; my $CLASS = 'App::Sqitch::Command::deploy'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; isa_ok $CLASS, 'App::Sqitch::Command'; can_ok $CLASS, qw( target options configure new to_change mode log_only execute variables ); is_deeply [$CLASS->options], [qw( target|t=s to-change|to|change=s mode=s set|s=s% log-only verify! to-target=s )], 'Options should be correct'; my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', plan_file => file(qw(t sql sqitch.plan))->stringify, top_dir => dir(qw(t sql))->stringify, }, ); my $config = $sqitch->config; # Test configure(). is_deeply $CLASS->configure($config, {}), { mode => 'all', verify => 0, log_only => 0, }, 'Should have default configuration with no config or opts'; is_deeply $CLASS->configure($config, { mode => 'tag', verify => 1, log_only => 1, set => { foo => 'bar' }, }), { mode => 'tag', verify => 1, log_only => 1, variables => { foo => 'bar' }, }, 'Should have mode, verify, set, and log-only options'; CONFIG: { my $mock_config = Test::MockModule->new(ref $config); my %config_vals; $mock_config->mock(get => sub { my ($self, %p) = @_; return $config_vals{ $p{key} }; }); $mock_config->mock(get_section => sub { my ($self, %p) = @_; return $config_vals{ $p{section} }; }); %config_vals = ( 'deploy.mode' => 'change', 'deploy.verify' => 1, 'deploy.variables' => { foo => 'bar', hi => 21 }, ); is_deeply $CLASS->configure($config, {}), { mode => 'change', verify => 1, log_only => 0, }, 'Should have mode and verify configuration'; # Try merging. is_deeply $CLASS->configure($config, { to_change => 'whu', mode => 'tag', verify => 0, set => { foo => 'yo', yo => 'stellar' }, }), { to_change => 'whu', mode => 'tag', verify => 0, log_only => 0, variables => { foo => 'yo', yo => 'stellar', hi => 21 }, }, 'Should have merged variables'; isa_ok my $deploy = $CLASS->new(sqitch => $sqitch), $CLASS; is_deeply $deploy->variables, { foo => 'bar', hi => 21 }, 'Should pick up variables from configuration'; } ############################################################################## # Test accessors. isa_ok my $deploy = $CLASS->new( sqitch => $sqitch, target => 'foo', ), $CLASS, 'new deploy with target'; is $deploy->target, 'foo', 'Should have target "foo"'; isa_ok $deploy = $CLASS->new(sqitch => $sqitch), $CLASS; is $deploy->target, undef, 'Should have undef default target'; is $deploy->to_change, undef, 'to_change should be undef'; is $deploy->mode, 'all', 'mode should be "all"'; # Mock parse_args() so that we can grab the target it returns. my $mock_cmd = Test::MockModule->new($CLASS); my $parser; my $target; $mock_cmd->mock(parse_args => sub { my @ret = $parser->(@_); $target = $ret[0][0]; return @ret; }); $parser = $mock_cmd->original('parse_args'); # Mock the engine interface. my $mock_engine = Test::MockModule->new('App::Sqitch::Engine'); my @args; $mock_engine->mock(deploy => sub { shift; @args = @_ }); my @vars; $mock_engine->mock(set_variables => sub { shift; @vars = @_ }); ok $deploy->execute('@alpha'), 'Execute to "@alpha"'; is_deeply \@args, ['@alpha', 'all'], '"@alpha" "all", and 0 should be passed to the engine'; ok $target, 'Should have a target'; ok !$target->engine->log_only, 'The engine should not be set log_only'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; @args = (); ok $deploy->execute, 'Execute'; is_deeply \@args, [undef, 'all'], 'undef and "all" should be passed to the engine'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Try passing the change. ok $deploy->execute('widgets'), 'Execute with change'; is_deeply \@args, ['widgets', 'all'], '"widgets" and "all" should be passed to the engine'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Try passing the target. ok $deploy->execute('db:pg:foo'), 'Execute with target'; is_deeply \@args, [undef, 'all'], 'undef and "all" should be passed to the engine'; is $target->name, 'db:pg:foo', 'The target should be as specified'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Pass both! ok $deploy->execute('db:pg:blah', 'widgets'), 'Execute with change and target'; is_deeply \@args, ['widgets', 'all'], '"widgets" and "all" should be passed to the engine'; is $target->name, 'db:pg:blah', 'The target should be as specified'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Reverse them! ok $deploy->execute('db:pg:blah', 'widgets'), 'Execute with target and change'; is_deeply \@args, ['widgets', 'all'], '"widgets" and "all" should be passed to the engine'; is $target->name, 'db:pg:blah', 'The target should be as specified'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Now pass a bunch of options. isa_ok $deploy = $CLASS->new( sqitch => $sqitch, to_change => 'foo', target => 'db:pg:hi', mode => 'tag', log_only => 1, verify => 1, variables => { foo => 'bar', one => 1 }, ), $CLASS, 'Object with to, mode, log_only, and variables'; @args = (); ok $deploy->execute, 'Execute again'; ok $target->engine->with_verify, 'Engine should verify'; ok $target->engine->log_only, 'The engine should be set log_only'; is_deeply \@args, ['foo', 'tag'], '"foo", "tag", and 1 should be passed to the engine'; is_deeply {@vars}, { foo => 'bar', one => 1 }, 'Vars should have been passed through to the engine'; is $target->name, 'db:pg:hi', 'The target name should be from the target option'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Try passing the change. ok $deploy->execute('widgets'), 'Execute with change'; ok $target->engine->with_verify, 'Engine should verify'; ok $target->engine->log_only, 'The engine should be set log_only'; is_deeply \@args, ['foo', 'tag'], '"foo", "tag", and 1 should be passed to the engine'; is_deeply {@vars}, { foo => 'bar', one => 1 }, 'Vars should have been passed through to the engine'; is_deeply +MockOutput->get_warn, [[__x( 'Too many changes specified; deploying to "{change}"', change => 'foo', )]], 'Should have too many changes warning'; # Pass the target. ok $deploy->execute('db:pg:bye'), 'Execute with target again'; ok $target->engine->with_verify, 'Engine should verify'; ok $target->engine->log_only, 'The engine should be set log_only'; is_deeply \@args, ['foo', 'tag'], '"foo", "tag", and 1 should be passed to the engine'; is_deeply {@vars}, { foo => 'bar', one => 1 }, 'Vars should have been passed through to the engine'; is $target->name, 'db:pg:hi', 'The target should be from the target option'; is_deeply +MockOutput->get_warn, [[__x( 'Too many targets specified; connecting to {target}', target => 'db:pg:hi', )]], 'Should have warning about too many targets'; # Make sure the mode enum works. for my $mode (qw(all tag change)) { ok $CLASS->new( sqitch => $sqitch, mode => $mode ), qq{"$mode" should be a valid mode}; } for my $bad (qw(foo bad gar)) { throws_ok { $CLASS->new( sqitch => $sqitch, mode => $bad ) } qr/\QValue "$bad" did not pass type constraint "Enum[all,change,tag]/, qq{"$bad" should not be a valid mode}; } # Make sure we get an exception for unknown args. throws_ok { $deploy->execute(qw(greg)) } 'App::Sqitch::X', 'Should get an exception for unknown arg'; is $@->ident, 'deploy', 'Unknow arg ident should be "deploy"'; is $@->message, __x( 'Unknown argument "{arg}"', arg => 'greg', ), 'Should get an exeption for two unknown arg'; throws_ok { $deploy->execute(qw(greg jon)) } 'App::Sqitch::X', 'Should get an exception for unknown args'; is $@->ident, 'deploy', 'Unknow args ident should be "deploy"'; is $@->message, __x( 'Unknown arguments: {arg}', arg => 'greg, jon', ), 'Should get an exeption for two unknown args'; done_testing; App-Sqitch-0.9996/t/die.pl000644 000767 000024 00000000061 13133201371 015367 0ustar00davidstaff000000 000000 use v5.10; say "@ARGV" if @ARGV; die 'OMGWTF'; App-Sqitch-0.9996/t/echo.pl000644 000767 000024 00000000031 13133201371 015541 0ustar00davidstaff000000 000000 use 5.010; say "@ARGV"; App-Sqitch-0.9996/t/editor.conf000644 000767 000024 00000000074 13133201371 016432 0ustar00davidstaff000000 000000 [core] engine = pg editor = config_specified_editor App-Sqitch-0.9996/t/engine/000755 000767 000024 00000000000 13133201371 015541 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/engine.conf000644 000767 000024 00000000544 13133201371 016413 0ustar00davidstaff000000 000000 [core] engine = pg [engine "mysql"] target = db:mysql://root@/foo client = /usr/sbin/mysql [engine "pg"] target = db:pg:try registry = meta client = /usr/sbin/psql [engine "sqlite"] target = widgets client = /usr/sbin/sqlite3 [target "widgets"] uri = db:sqlite:widgets.db plan_file = foo.plan App-Sqitch-0.9996/t/engine.t000644 000767 000024 00000344410 13133201371 015734 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 645; #use Test::More 'no_plan'; use App::Sqitch; use App::Sqitch::Plan; use App::Sqitch::Target; use Path::Class; use Test::Exception; use Test::NoWarnings; use Test::MockModule; use Locale::TextDomain qw(App-Sqitch); use App::Sqitch::X qw(hurl); use App::Sqitch::DateTime; use List::Util qw(max); use lib 't/lib'; use MockOutput; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Engine'; use_ok $CLASS or die; delete $ENV{PGDATABASE}; delete $ENV{PGUSER}; delete $ENV{USER}; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; } can_ok $CLASS, qw(load new name no_prompt run_deploy run_revert run_verify uri); my ($is_deployed_tag, $is_deployed_change) = (0, 0); my @deployed_changes; my @deployed_change_ids; my @resolved; my @requiring; my @load_changes; my $offset_change; my $die = ''; my $record_work = 1; my $updated_idx; my ( $earliest_change_id, $latest_change_id, $initialized ); my $registry_version = $CLASS->registry_release; my $script_hash; ENGINE: { # Stub out an engine. package App::Sqitch::Engine::whu; use Moo; use App::Sqitch::X qw(hurl); extends 'App::Sqitch::Engine'; $INC{'App/Sqitch/Engine/whu.pm'} = __FILE__; my @SEEN; for my $meth (qw( run_file log_deploy_change log_revert_change log_fail_change )) { no strict 'refs'; *$meth = sub { hurl 'AAAH!' if $die eq $meth; push @SEEN => [ $meth => $_[1] ]; }; } sub is_deployed_tag { push @SEEN => [ is_deployed_tag => $_[1] ]; $is_deployed_tag } sub is_deployed_change { push @SEEN => [ is_deployed_change => $_[1] ]; $is_deployed_change } sub are_deployed_changes { shift; push @SEEN => [ are_deployed_changes => [@_] ]; @deployed_change_ids } sub change_id_for { shift; push @SEEN => [ change_id_for => {@_} ]; shift @resolved } sub change_offset_from_id { shift; push @SEEN => [ change_offset_from_id => [@_] ]; $offset_change } sub change_id_offset_from_id { shift; push @SEEN => [ change_id_offset_from_id => [@_] ]; $_[0] } sub changes_requiring_change { push @SEEN => [ changes_requiring_change => $_[1] ]; @{ shift @requiring } } sub earliest_change_id { push @SEEN => [ earliest_change_id => $_[1] ]; $earliest_change_id } sub latest_change_id { push @SEEN => [ latest_change_id => $_[1] ]; $latest_change_id } sub current_state { push @SEEN => [ current_state => $_[1] ]; $latest_change_id ? { change => 'what', change_id => $latest_change_id, script_hash => $script_hash } : undef } sub initialized { push @SEEN => 'initialized'; $initialized } sub initialize { push @SEEN => 'initialize' } sub register_project { push @SEEN => 'register_project' } sub deployed_changes { push @SEEN => [ deployed_changes => $_[1] ]; @deployed_changes } sub load_change { push @SEEN => [ load_change => $_[1] ]; @load_changes } sub deployed_changes_since { push @SEEN => [ deployed_changes_since => $_[1] ]; @deployed_changes } sub mock_check_deploy { shift; push @SEEN => [ check_deploy_dependencies => [@_] ] } sub mock_check_revert { shift; push @SEEN => [ check_revert_dependencies => [@_] ] } sub begin_work { push @SEEN => ['begin_work'] if $record_work } sub finish_work { push @SEEN => ['finish_work'] if $record_work } sub _update_ids { push @SEEN => ['_update_ids']; $updated_idx } sub log_new_tags { push @SEEN => [ log_new_tags => $_[1] ]; $_[0] } sub _update_script_hashes { push @SEEN => ['_update_script_hashes']; $_[0] } sub seen { [@SEEN] } after seen => sub { @SEEN = () }; sub name_for_change_id { return 'bugaboo' } sub registry_version { $registry_version } } ok my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => dir(qw(t sql))->stringify, plan_file => file(qw(t plans multi.plan))->stringify, } ), 'Load a sqitch sqitch object'; my $mock_engine = Test::MockModule->new($CLASS); ############################################################################## # Test new(). my $target = App::Sqitch::Target->new( sqitch => $sqitch ); throws_ok { $CLASS->new( sqitch => $sqitch ) } qr/\QMissing required arguments: target/, 'Should get an exception for missing sqitch param'; throws_ok { $CLASS->new( target => $target ) } qr/\QMissing required arguments: sqitch/, 'Should get an exception for missing sqitch param'; my $array = []; throws_ok { $CLASS->new({ sqitch => $array, target => $target }) } qr/\QReference [] did not pass type constraint "Sqitch"/, 'Should get an exception for array sqitch param'; throws_ok { $CLASS->new({ sqitch => $sqitch, target => $array }) } qr/\QReference [] did not pass type constraint "Target"/, 'Should get an exception for array target param'; throws_ok { $CLASS->new({ sqitch => 'foo', target => $target }) } qr/\QValue "foo" did not pass type constraint "Sqitch"/, 'Should get an exception for string sqitch param'; throws_ok { $CLASS->new({ sqitch => $sqitch, target => 'foo' }) } qr/\QValue "foo" did not pass type constraint "Target"/, 'Should get an exception for string target param'; isa_ok $CLASS->new({sqitch => $sqitch, target => $target}), $CLASS, 'Engine'; ############################################################################## # Test load(). $sqitch->options->{engine} = 'whu'; $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok my $engine = $CLASS->load({ sqitch => $sqitch, target => $target, }), 'Load an engine'; isa_ok $engine, 'App::Sqitch::Engine::whu'; is $engine->sqitch, $sqitch, 'The sqitch attribute should be set'; # Test handling of an invalid engine. my $unknown_target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI::db->new('db:nonexistent:') ); throws_ok { $CLASS->load({ sqitch => $sqitch, target => $unknown_target }) } 'App::Sqitch::X', 'Should die on unknown target'; is $@->message, 'Unable to load App::Sqitch::Engine::nonexistent', 'Should get load error message'; like $@->previous_exception, qr/\QCan't locate/, 'Should have relevant previoius exception'; NOENGINE: { # Test handling of no target. throws_ok { $CLASS->load({ sqitch => $sqitch }) } 'App::Sqitch::X', 'No target should die'; is $@->message, 'Missing "target" parameter to load()', 'It should be the expected message'; } # Test handling a bad engine implementation. use lib 't/lib'; my $bad_target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI::db->new('db:bad:') ); throws_ok { $CLASS->load({ sqitch => $sqitch, target => $bad_target }) } 'App::Sqitch::X', 'Should die on bad engine module'; is $@->message, 'Unable to load App::Sqitch::Engine::bad', 'Should get another load error message'; like $@->previous_exception, qr/^LOL BADZ/, 'Should have relevant previoius exception from the bad module'; ############################################################################## # Test name. can_ok $CLASS, 'name'; ok $engine = $CLASS->new({ sqitch => $sqitch, target => $target }), "Create a $CLASS object"; throws_ok { $engine->name } 'App::Sqitch::X', 'Should get error from base engine name'; is $@->ident, 'engine', 'Name error ident should be "engine"'; is $@->message, __('No engine specified; use --engine or set core.engine'), 'Name error message should be correct'; ok $engine = App::Sqitch::Engine::whu->new({sqitch => $sqitch, target => $target}), 'Create a subclass name object'; is $engine->name, 'whu', 'Subclass oject name should be "whu"'; is +App::Sqitch::Engine::whu->name, 'whu', 'Subclass class name should be "whu"'; ############################################################################## # Test config_vars. can_ok $CLASS, 'config_vars'; is_deeply [App::Sqitch::Engine->config_vars], [ target => 'any', registry => 'any', client => 'any', ], 'Should have database and client in engine base class'; ############################################################################## # Test variables. can_ok $CLASS, qw(variables set_variables clear_variables); is_deeply [$engine->variables], [], 'Should have no variables'; ok $engine->set_variables(foo => 'bar'), 'Add a variable'; is_deeply [$engine->variables], [foo => 'bar'], 'Should have the variable'; ok $engine->set_variables(foo => 'baz', whu => 'hi', yo => 'stellar'), 'Set more variables'; is_deeply {$engine->variables}, {foo => 'baz', whu => 'hi', yo => 'stellar'}, 'Should have all of the variables'; $engine->clear_variables; is_deeply [$engine->variables], [], 'Should again have no variables'; ############################################################################## # Test target. ok $engine = $CLASS->load({ sqitch => $sqitch, target => $target, }), 'Load engine'; is $engine->target, $target, 'Target should be as passed'; # Make sure password is removed from the target. ok $engine = $CLASS->load({ sqitch => $sqitch, target => $target, uri => URI->new('db:whu://foo:bar@localhost/blah'), }), 'Load engine with URI with password'; isa_ok $engine->target, 'App::Sqitch::Target', 'target attribute'; ############################################################################## # Test destination. ok $engine = $CLASS->load({ sqitch => $sqitch, target => $target, }), 'Load engine'; is $engine->destination, 'db:whu:', 'Destination should be URI string'; is $engine->registry_destination, $engine->destination, 'Rgistry destination should be the same as destination'; # Make sure password is removed from the destination. my $long_target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI->new('db:whu://foo:bar@localhost/blah'), ); ok $engine = $CLASS->load({ sqitch => $sqitch, target => $long_target, }), 'Load engine with URI with password'; like $engine->destination, qr{^db:whu://foo:?\@localhost/blah$}, 'Destination should not include password'; is $engine->registry_destination, $engine->destination, 'Meta destination should again be the same as destination'; ############################################################################## # Test _check_registry. can_ok $engine, '_check_registry'; ok $engine->_check_registry, 'Registry should be fine at current version'; # Make the registry non-existent. $registry_version = 0; $initialized = 0; throws_ok { $engine->_check_registry } 'App::Sqitch::X', 'Should get error for non-existent registry'; is $@->ident, 'engine', 'Non-existent registry error ident should be "engine"'; is $@->message, __x( 'No registry found in {destination}. Have you ever deployed?', destination => $engine->registry_destination, ), 'Non-existent registry error message should be correct'; $engine->seen; # Make sure it's checked on revert and verify. for my $meth (qw(revert verify)) { throws_ok { $engine->$meth } 'App::Sqitch::X', "Should get error from $meth"; is $@->ident, 'engine', qq{$meth registry error ident should be "engine"}; is $@->message, __x( 'No registry found in {destination}. Have you ever deployed?', destination => $engine->registry_destination, ), "$meth registry error message should be correct"; $engine->seen; } # Make the registry out-of-date. $registry_version = 0.1; throws_ok { $engine->_check_registry } 'App::Sqitch::X', 'Should get error for out-of-date registry'; is $@->ident, 'engine', 'Out-of-date registry error ident should be "engine"'; is $@->message, __x( 'Registry is at version {old} but latest is {new}. Please run the "upgrade" conmand', old => 0.1, new => $engine->registry_release, ), 'Out-of-date registry error message should be correct'; # Send the registry to the future. $registry_version = 999.99; throws_ok { $engine->_check_registry } 'App::Sqitch::X', 'Should get error for future registry'; is $@->ident, 'engine', 'Future registry error ident should be "engine"'; is $@->message, __x( 'Registry version is {old} but {new} is the latest known. Please upgrade Sqitch', old => 999.99, new => $engine->registry_release, ), 'Future registry error message should be correct'; # Restore the registry version. $registry_version = $CLASS->registry_release; ############################################################################## # Test abstract methods. ok $engine = $CLASS->new({ sqitch => $sqitch, target => $target, }), "Create a $CLASS object again"; for my $abs (qw( initialized initialize register_project run_file run_handle log_deploy_change log_fail_change log_revert_change log_new_tags is_deployed_tag is_deployed_change are_deployed_changes change_id_for changes_requiring_change earliest_change_id latest_change_id deployed_changes deployed_changes_since load_change name_for_change_id current_state current_changes current_tags search_events registered_projects change_offset_from_id change_id_offset_from_id )) { throws_ok { $engine->$abs } qr/\Q$CLASS has not implemented $abs()/, "Should get an unimplemented exception from $abs()" } ############################################################################## # Test _load_changes(). can_ok $engine, '_load_changes'; my $now = App::Sqitch::DateTime->now; my $plan = $target->plan; # Mock App::Sqitch::DateTime so that dbchange tags all have the same # timestamps. my $mock_dt = Test::MockModule->new('App::Sqitch::DateTime'); $mock_dt->mock(now => $now); for my $spec ( [ 'no change' => [] ], [ 'undef' => [undef] ], ['no tags' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, }, ]], ['multiple hashes with no tags' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, }, { id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0', name => 'booyah', project => 'engine', note => 'Whatever', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, }, ]], ['tags' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, tags => [qw(foo bar)], }, ]], ['tags with leading @' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, tags => [qw(@foo @bar)], }, ]], ['multiple hashes with tags' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, tags => [qw(foo bar)], }, { id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0', name => 'booyah', project => 'engine', note => 'Whatever', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, tags => [qw(@foo @bar)], }, ]], ['reworked change' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, tags => [qw(foo bar)], }, { id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, rtags => [qw(howdy)], }, ]], ['reworked change & multiple tags' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, tags => [qw(foo bar)], }, { id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0', name => 'booyah', project => 'engine', note => 'Whatever', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, tags => [qw(@settle)], }, { id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, rtags => [qw(booyah howdy)], }, ]], ['doubly reworked change' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, tags => [qw(foo bar)], }, { id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, rtags => [qw(howdy)], tags => [qw(why)], }, { id => 'f38ceb6efcf2a813104b7bb08cc90667033ddf6b', name => 'howdy', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, rtags => [qw(howdy)], }, ]], ) { my ($desc, $args) = @{ $spec }; my %seen; is_deeply [ $engine->_load_changes(@{ $args }) ], [ map { my $tags = $_->{tags} || []; my $rtags = $_->{rtags}; my $c = App::Sqitch::Plan::Change->new(%{ $_ }, plan => $plan ); $c->add_tag(App::Sqitch::Plan::Tag->new( name => $_, plan => $plan, change => $c, timestamp => $now, )) for map { s/^@//; $_ } @{ $tags }; if (my $dupe = $seen{ $_->{name} }) { $dupe->add_rework_tags( map { $seen{$_}->tags } @{ $rtags }); } $seen{ $_->{name} } = $c; $c; } grep { $_ } @{ $args }], "Should load changes with $desc"; } # Rework a change in the plan. my $you = $plan->get('you'); my $this_rocks = $plan->get('this/rocks'); my $hey_there = $plan->get('hey-there'); ok my $rev_change = $plan->rework( name => 'you' ), 'Rework change "you"'; ok $plan->tag( name => '@beta1' ), 'Tag @beta1'; # Load changes for my $spec ( [ 'Unplanned change' => [ { id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', name => 'you', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, }, { id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163', name => 'this/rocks', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, }, ]], [ 'reworked change without reworked version deployed' => [ { id => $you->id, name => $you->name, project => $you->project, note => $you->note, planner_name => $you->planner_name, planner_email => $you->planner_email, timestamp => $you->timestamp, ptags => [ $hey_there->tags, $you->tags ], }, { id => $this_rocks->id, name => 'this/rocks', project => 'engine', note => 'For realz', planner_name => 'Barack Obama', planner_email => 'bo@whitehouse.gov', timestamp => $now, }, ]], [ 'reworked change with reworked version deployed' => [ { id => $you->id, name => $you->name, project => $you->project, note => $you->note, planner_name => $you->planner_name, planner_email => $you->planner_email, timestamp => $you->timestamp, tags => [qw(@foo @bar)], ptags => [ $hey_there->tags, $you->tags ], }, { id => $rev_change->id, name => $rev_change->name, project => 'engine', note => $rev_change->note, planner_name => $rev_change->planner_name, planner_email => $rev_change->planner_email, timestamp => $rev_change->timestamp, }, ]], ) { my ($desc, $args) = @{ $spec }; my %seen; is_deeply [ $engine->_load_changes(@{ $args }) ], [ map { my $tags = $_->{tags} || []; my $rtags = $_->{rtags}; my $ptags = $_->{ptags}; my $c = App::Sqitch::Plan::Change->new(%{ $_ }, plan => $plan ); $c->add_tag(App::Sqitch::Plan::Tag->new( name => $_, plan => $plan, change => $c, timestamp => $now, )) for map { s/^@//; $_ } @{ $tags }; my %seen_tags; if (@{ $ptags || [] }) { $c->add_rework_tags( @{ $ptags }); } if (my $dupe = $seen{ $_->{name} }) { $dupe->add_rework_tags( map { $seen{$_}->tags } @{ $rtags }); } $seen{ $_->{name} } = $c; $c; } grep { $_ } @{ $args }], "Should load changes with $desc"; } ############################################################################## # Test deploy_change and revert_change. ok $engine = App::Sqitch::Engine::whu->new( sqitch => $sqitch, target => $target ), 'Create a subclass name object again'; can_ok $engine, 'deploy_change', 'revert_change'; my $change = App::Sqitch::Plan::Change->new( name => 'users', plan => $target->plan ); $engine->max_name_length(length $change->format_name_with_tags); ok $engine->deploy_change($change), 'Deploy a change'; is_deeply $engine->seen, [ ['begin_work'], [run_file => $change->deploy_file ], [log_deploy_change => $change ], ['finish_work'], ], 'deploy_change should have called the proper methods'; is_deeply +MockOutput->get_info_literal, [[ ' + users ..', '' , ' ' ]], 'Output should reflect the deployment'; is_deeply +MockOutput->get_info, [[__ 'ok' ]], 'Output should reflect success'; # Have it log only. $engine->log_only(1); ok $engine->deploy_change($change), 'Only log a change'; is_deeply $engine->seen, [ ['begin_work'], [log_deploy_change => $change ], ['finish_work'], ], 'log-only deploy_change should not have called run_file'; is_deeply +MockOutput->get_info_literal, [[ ' + users ..', '' , ' ' ]], 'Output should reflect the logging'; is_deeply +MockOutput->get_info, [[__ 'ok' ]], 'Output should reflect deploy success'; # Have it verify. ok $engine->with_verify(1), 'Enable verification'; $engine->log_only(0); ok $engine->deploy_change($change), 'Deploy a change to be verified'; is_deeply $engine->seen, [ ['begin_work'], [run_file => $change->deploy_file ], [run_file => $change->verify_file ], [log_deploy_change => $change ], ['finish_work'], ], 'deploy_change with verification should run the verify file'; is_deeply +MockOutput->get_info_literal, [[ ' + users ..', '' , ' ' ]], 'Output should reflect the logging'; is_deeply +MockOutput->get_info, [[__ 'ok' ]], 'Output should reflect deploy success'; # Have it verify *and* log-only. ok $engine->log_only(1), 'Enable log_only'; ok $engine->deploy_change($change), 'Verify and log a change'; is_deeply $engine->seen, [ ['begin_work'], [run_file => $change->verify_file ], [log_deploy_change => $change ], ['finish_work'], ], 'deploy_change with verification and log-only should not run deploy'; is_deeply +MockOutput->get_info_literal, [[ ' + users ..', '' , ' ' ]], 'Output should reflect the logging'; is_deeply +MockOutput->get_info, [[__ 'ok' ]], 'Output should reflect deploy success'; # Make it fail. $die = 'run_file'; $engine->log_only(0); throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X', 'Deploy change with error'; is $@->message, 'AAAH!', 'Error should be from run_file'; is_deeply $engine->seen, [ ['begin_work'], [log_fail_change => $change ], ['finish_work'], ], 'Should have logged change failure'; $die = ''; is_deeply +MockOutput->get_info_literal, [[ ' + users ..', '' , ' ' ]], 'Output should reflect the deployment, even with failure'; is_deeply +MockOutput->get_info, [[__ 'not ok' ]], 'Output should reflect deploy failure'; # Make the verify fail. $mock_engine->mock( verify_change => sub { hurl 'WTF!' }); throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X', 'Deploy change with failed verification'; is $@->message, __ 'Deploy failed', 'Error should be from deploy_change'; is_deeply $engine->seen, [ ['begin_work'], [run_file => $change->deploy_file ], ['begin_work'], [run_file => $change->revert_file ], [log_fail_change => $change ], ['finish_work'], ], 'Should have logged verify failure'; $die = ''; is_deeply +MockOutput->get_info_literal, [[ ' + users ..', '' , ' ' ]], 'Output should reflect the deployment, even with verify failure'; is_deeply +MockOutput->get_info, [[__ 'not ok' ]], 'Output should reflect deploy failure'; is_deeply +MockOutput->get_vent, [['WTF!']], 'Verify error should have been vented'; # Make the verify fail with log only. ok $engine->log_only(1), 'Enable log_only'; throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X', 'Deploy change with log-only and failed verification'; is $@->message, __ 'Deploy failed', 'Error should be from deploy_change'; is_deeply $engine->seen, [ ['begin_work'], ['begin_work'], [log_fail_change => $change ], ['finish_work'], ], 'Should have logged verify failure but not reverted'; $die = ''; is_deeply +MockOutput->get_info_literal, [[ ' + users ..', '' , ' ' ]], 'Output should reflect the deployment, even with verify failure'; is_deeply +MockOutput->get_info, [[__ 'not ok' ]], 'Output should reflect deploy failure'; is_deeply +MockOutput->get_vent, [['WTF!']], 'Verify error should have been vented'; # Try a change with no verify file. $engine->log_only(0); $mock_engine->unmock( 'verify_change' ); $change = App::Sqitch::Plan::Change->new( name => 'foo', plan => $target->plan ); ok $engine->deploy_change($change), 'Deploy a change with no verify script'; is_deeply $engine->seen, [ ['begin_work'], [run_file => $change->deploy_file ], [log_deploy_change => $change ], ['finish_work'], ], 'deploy_change with no verify file should not run it'; is_deeply +MockOutput->get_info_literal, [[ ' + foo ..', '..' , ' ' ]], 'Output should reflect the logging'; is_deeply +MockOutput->get_info, [[__ 'ok' ]], 'Output should reflect deploy success'; is_deeply +MockOutput->get_vent, [ [__x 'Verify script {file} does not exist', file => $change->verify_file], ], 'A warning about no verify file should have been emitted'; # Alright, disable verify now. $engine->with_verify(0); ok $engine->revert_change($change), 'Revert a change'; is_deeply $engine->seen, [ ['begin_work'], [run_file => $change->revert_file ], [log_revert_change => $change ], ['finish_work'], ], 'revert_change should have called the proper methods'; is_deeply +MockOutput->get_info_literal, [[ ' - foo ..', '..', ' ' ]], 'Output should reflect reversion'; is_deeply +MockOutput->get_info, [[__ 'ok']], 'Output should acknowldge revert success'; # Revert with log-only. ok $engine->log_only(1), 'Enable log_only'; ok $engine->revert_change($change), 'Revert a change with log-only'; is_deeply $engine->seen, [ ['begin_work'], [log_revert_change => $change ], ['finish_work'], ], 'Log-only revert_change should not have run the change script'; is_deeply +MockOutput->get_info_literal, [[ ' - foo ..', '..', ' ' ]], 'Output should reflect logged reversion'; is_deeply +MockOutput->get_info, [[__ 'ok']], 'Output should acknowldge revert success'; $record_work = 0; ############################################################################## # Test earliest_change() and latest_change(). chdir 't'; my $plan_file = file qw(sql sqitch.plan); my $sqitch_old = $sqitch; # Hang on to this because $change does not retain it. $sqitch = App::Sqitch->new( options => { engine => 'sqlite', plan_file => $plan_file->stringify, top_dir => 'sql', }, ); $target = App::Sqitch::Target->new( sqitch => $sqitch ); $change = App::Sqitch::Plan::Change->new( name => 'foo', plan => $target->plan ); ok $engine = App::Sqitch::Engine::whu->new( sqitch => $sqitch, target => $target ), 'Engine with sqitch with plan file'; $plan = $target->plan; my @changes = $plan->changes; $latest_change_id = $changes[0]->id; is $engine->latest_change, $changes[0], 'Should get proper change from latest_change()'; is_deeply $engine->seen, [[ latest_change_id => undef ]], 'Latest change ID should have been called with no arg'; $latest_change_id = $changes[2]->id; is $engine->latest_change(2), $changes[2], 'Should again get proper change from latest_change()'; is_deeply $engine->seen, [[ latest_change_id => 2 ]], 'Latest change ID should have been called with offset arg'; $latest_change_id = undef; $earliest_change_id = $changes[0]->id; is $engine->earliest_change, $changes[0], 'Should get proper change from earliest_change()'; is_deeply $engine->seen, [[ earliest_change_id => undef ]], 'Earliest change ID should have been called with no arg'; $earliest_change_id = $changes[2]->id; is $engine->earliest_change(4), $changes[2], 'Should again get proper change from earliest_change()'; is_deeply $engine->seen, [[ earliest_change_id => 4 ]], 'Earliest change ID should have been called with offset arg'; $earliest_change_id = undef; ############################################################################## # Test _sync_plan() can_ok $CLASS, '_sync_plan'; $engine->seen; is $plan->position, -1, 'Plan should start at position -1'; is $engine->start_at, undef, 'start_at should be undef'; ok $engine->_sync_plan, 'Sync the plan'; is $plan->position, -1, 'Plan should still be at position -1'; is $engine->start_at, undef, 'start_at should still be undef'; $plan->position(4); is_deeply $engine->seen, [['current_state', undef]], 'Should not have updated IDs or hashes'; ok $engine->_sync_plan, 'Sync the plan again'; is $plan->position, -1, 'Plan should again be at position -1'; is $engine->start_at, undef, 'start_at should again be undef'; is_deeply $engine->seen, [['current_state', undef]], 'Still should not have updated IDs or hashes'; # Have latest_item return a tag. $latest_change_id = $changes[1]->old_id; $updated_idx = 2; ok $engine->_sync_plan, 'Sync the plan to a tag'; is $plan->position, 2, 'Plan should now be at position 1'; is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta'; is_deeply $engine->seen, [ ['current_state', undef], ['_update_ids'], ['log_new_tags' => $plan->change_at(2)], ], 'Should have updated IDs'; # Have current_state return a script hash. $script_hash = '550aeeab2ae39cba45840888b12a70820a2d6f83'; ok $engine->_sync_plan, 'Sync the plan with a random script hash'; is $plan->position, 2, 'Plan should now be at position 1'; is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta'; is_deeply $engine->seen, [ ['current_state', undef], ['_update_ids'], ['log_new_tags' => $plan->change_at(2)], ], 'Should have updated IDs but not hashes'; # Have current_state return the last deployed ID as script_hash. $script_hash = $latest_change_id; ok $engine->_sync_plan, 'Sync the plan with a random script hash'; is $plan->position, 2, 'Plan should now be at position 1'; is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta'; is_deeply $engine->seen, [ ['current_state', undef], ['_update_ids'], ['_update_script_hashes'], ['log_new_tags' => $plan->change_at(2)], ], 'Should have updated IDs and hashes'; # Return no change ID, now. $script_hash = $latest_change_id = $changes[1]->id; ok $engine->_sync_plan, 'Sync the plan'; is $plan->position, 1, 'Plan should be at position 1'; is $engine->start_at, 'users@alpha', 'start_at should be users@alpha'; is_deeply $engine->seen, [ ['current_state', undef], ['_update_script_hashes'], ['log_new_tags' => $plan->change_at(1)], ], 'Should have updated hashes but not IDs'; ############################################################################## # Test deploy. can_ok $CLASS, 'deploy'; $script_hash = undef; $latest_change_id = undef; $plan->reset; $engine->seen; @changes = $plan->changes; # Mock the deploy methods to log which were called. my $deploy_meth; for my $meth (qw(_deploy_all _deploy_by_tag _deploy_by_change)) { my $orig = $CLASS->can($meth); $mock_engine->mock($meth => sub { $deploy_meth = $meth; $orig->(@_); }); } # Mock dependency checking to add its call to the seen stuff. $mock_engine->mock( check_deploy_dependencies => sub { shift->mock_check_deploy(@_); }); $mock_engine->mock( check_revert_dependencies => sub { shift->mock_check_revert(@_); }); ok $engine->deploy('@alpha'), 'Deploy to @alpha'; is $plan->position, 1, 'Plan should be at position 1'; is_deeply $engine->seen, [ [current_state => undef], 'initialized', 'initialize', 'register_project', [check_deploy_dependencies => [$plan, 1]], [run_file => $changes[0]->deploy_file], [log_deploy_change => $changes[0]], [run_file => $changes[1]->deploy_file], [log_deploy_change => $changes[1]], ], 'Should have deployed through @alpha'; is $deploy_meth, '_deploy_all', 'Should have called _deploy_all()'; is_deeply +MockOutput->get_info, [ [__x 'Adding registry tables to {destination}', destination => $engine->registry_destination, ], [__x 'Deploying changes through {change} to {destination}', destination => $engine->destination, change => $plan->get('@alpha')->format_name_with_tags, ], [__ 'ok'], [__ 'ok'], ], 'Should have seen the output of the deploy to @alpha'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '.......', ' '], [' + users @alpha ..', '', ' '], ], 'Both change names should be output'; # Try with log-only in all modes. for my $mode (qw(change tag all)) { ok $engine->log_only(1), 'Enable log_only'; ok $engine->deploy('@alpha', $mode, 1), 'Log-only deploy in $mode mode to @alpha'; is $plan->position, 1, 'Plan should be at position 1'; is_deeply $engine->seen, [ [current_state => undef], 'initialized', 'initialize', 'register_project', [check_deploy_dependencies => [$plan, 1]], [log_deploy_change => $changes[0]], [log_deploy_change => $changes[1]], ], 'Should have deployed through @alpha without running files'; my $meth = $mode eq 'all' ? 'all' : ('by_' . $mode); is $deploy_meth, "_deploy_$meth", "Should have called _deploy_$meth()"; is_deeply +MockOutput->get_info, [ [ __x 'Adding registry tables to {destination}', destination => $engine->registry_destination, ], [ __x 'Deploying changes through {change} to {destination}', destination => $engine->destination, change => $plan->get('@alpha')->format_name_with_tags, ], [__ 'ok'], [__ 'ok'], ], 'Should have seen the output of the deploy to @alpha'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '.......', ' '], [' + users @alpha ..', '', ' '], ], 'Both change names should be output'; } # Try with no need to initialize. $initialized = 1; $plan->reset; $engine->log_only(0); ok $engine->deploy('@alpha', 'tag'), 'Deploy to @alpha with tag mode'; is $plan->position, 1, 'Plan should again be at position 1'; is_deeply $engine->seen, [ [current_state => undef], 'initialized', 'register_project', [check_deploy_dependencies => [$plan, 1]], [run_file => $changes[0]->deploy_file], [log_deploy_change => $changes[0]], [run_file => $changes[1]->deploy_file], [log_deploy_change => $changes[1]], ], 'Should have deployed through @alpha without initialization'; is $deploy_meth, '_deploy_by_tag', 'Should have called _deploy_by_tag()'; is_deeply +MockOutput->get_info, [ [__x 'Deploying changes through {change} to {destination}', destination => $engine->registry_destination, change => $plan->get('@alpha')->format_name_with_tags, ], [__ 'ok'], [__ 'ok'], ], 'Should have seen the output of the deploy to @alpha'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '.......', ' '], [' + users @alpha ..', '', ' '], ], 'Both change names should be output'; # Try a bogus change. throws_ok { $engine->deploy('nonexistent') } 'App::Sqitch::X', 'Should get an error for an unknown change'; is $@->message, __x( 'Unknown change: "{change}"', change => 'nonexistent', ), 'The exception should report the unknown change'; is_deeply $engine->seen, [ [current_state => undef], ], 'Only latest_item() should have been called'; # Start with @alpha. $latest_change_id = ($changes[1]->tags)[0]->id; ok $engine->deploy('@alpha'), 'Deploy to alpha thrice'; is_deeply $engine->seen, [ [current_state => undef], ['log_new_tags' => $changes[1]], ], 'Only latest_item() should have been called'; is_deeply +MockOutput->get_info, [ [__x 'Nothing to deploy (already at "{change}")', change => '@alpha'], ], 'Should notify user that already at @alpha'; # Start with widgets. $latest_change_id = $changes[2]->id; throws_ok { $engine->deploy('@alpha') } 'App::Sqitch::X', 'Should fail changeing older change'; is $@->ident, 'deploy', 'Should be a "deploy" error'; is $@->message, __ 'Cannot deploy to an earlier change; use "revert" instead', 'It should suggest using "revert"'; is_deeply $engine->seen, [ [current_state => undef], ['log_new_tags' => $changes[2]], ], 'Should have called latest_item() and latest_tag()'; # Make sure we can deploy everything by change. $latest_change_id = undef; $plan->reset; $plan->add( name => 'lolz', note => 'ha ha' ); @changes = $plan->changes; ok $engine->deploy(undef, 'change'), 'Deploy everything by change'; is $plan->position, 3, 'Plan should be at position 3'; is_deeply $engine->seen, [ [current_state => undef], 'initialized', 'register_project', [check_deploy_dependencies => [$plan, 3]], [run_file => $changes[0]->deploy_file], [log_deploy_change => $changes[0]], [run_file => $changes[1]->deploy_file], [log_deploy_change => $changes[1]], [run_file => $changes[2]->deploy_file], [log_deploy_change => $changes[2]], [run_file => $changes[3]->deploy_file], [log_deploy_change => $changes[3]], ], 'Should have deployed everything'; is $deploy_meth, '_deploy_by_change', 'Should have called _deploy_by_change()'; is_deeply +MockOutput->get_info, [ [__x 'Deploying changes to {destination}', destination => $engine->destination ], [__ 'ok'], [__ 'ok'], [__ 'ok'], [__ 'ok'], ], 'Should have emitted deploy announcement and successes'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], [' + widgets @beta ..', '', ' '], [' + lolz ..', '.........', ' '], ], 'Should have seen the output of the deploy to the end'; # If we deploy again, it should be up-to-date. $latest_change_id = $changes[-1]->id; ok $engine->deploy, 'Should return success for deploy to up-to-date DB'; is_deeply +MockOutput->get_info, [ [__ 'Nothing to deploy (up-to-date)' ], ], 'Should have emitted deploy announcement and successes'; is_deeply $engine->seen, [ [current_state => undef], ], 'It should have just fetched the latest change ID'; $latest_change_id = undef; # Try invalid mode. throws_ok { $engine->deploy(undef, 'evil_mode') } 'App::Sqitch::X', 'Should fail on invalid mode'; is $@->ident, 'deploy', 'Should be a "deploy" error'; is $@->message, __x('Unknown deployment mode: "{mode}"', mode => 'evil_mode'), 'And the message should reflect the unknown mode'; is_deeply $engine->seen, [ [current_state => undef], 'initialized', 'register_project', [check_deploy_dependencies => [$plan, 3]], ], 'It should have check for initialization'; is_deeply +MockOutput->get_info, [ [__x 'Deploying changes to {destination}', destination => $engine->destination ], ], 'Should have announced destination'; # Try a plan with no changes. NOSTEPS: { my $plan_file = file qw(empty.plan); my $fh = $plan_file->open('>') or die "Cannot open $plan_file: $!"; say $fh '%project=empty'; $fh->close or die "Error closing $plan_file: $!"; END { $plan_file->remove } my $sqitch = App::Sqitch->new( _engine => 'sqlite', plan_file => $plan_file, options => { engine => 'sqlite', plan_file => $plan_file->stringify, } ); my $target = App::Sqitch::Target->new(sqitch => $sqitch ); ok my $engine = App::Sqitch::Engine::whu->new( sqitch => $sqitch, target => $target, ), 'Engine with sqitch with no file'; $engine->max_name_length(10); throws_ok { $engine->deploy } 'App::Sqitch::X', 'Should die with no changes'; is $@->message, __"Nothing to deploy (empty plan)", 'Should have the localized message'; is_deeply $engine->seen, [ [current_state => undef], ], 'It should have checked for the latest item'; } ############################################################################## # Test _deploy_by_change() $engine = App::Sqitch::Engine::whu->new(sqitch => $sqitch, target => $target); $plan->reset; $mock_engine->unmock('_deploy_by_change'); $engine->max_name_length( max map { length $_->format_name_with_tags } $plan->changes ); ok $engine->_deploy_by_change($plan, 1), 'Deploy changewise to index 1'; is_deeply $engine->seen, [ [run_file => $changes[0]->deploy_file], [log_deploy_change => $changes[0]], [run_file => $changes[1]->deploy_file], [log_deploy_change => $changes[1]], ], 'Should changewise deploy to index 2'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], ], 'Should have seen output of each change'; is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']], 'Output should reflect deploy successes'; ok $engine->_deploy_by_change($plan, 3), 'Deploy changewise to index 2'; is_deeply $engine->seen, [ [run_file => $changes[2]->deploy_file], [log_deploy_change => $changes[2]], [run_file => $changes[3]->deploy_file], [log_deploy_change => $changes[3]], ], 'Should changewise deploy to from index 2 to index 3'; is_deeply +MockOutput->get_info_literal, [ [' + widgets @beta ..', '', ' '], [' + lolz ..', '.........', ' '], ], 'Should have seen output of changes 2-3'; is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']], 'Output should reflect deploy successes'; # Make it die. $plan->reset; $die = 'run_file'; throws_ok { $engine->_deploy_by_change($plan, 2) } 'App::Sqitch::X', 'Die in _deploy_by_change'; is $@->message, 'AAAH!', 'It should have died in run_file'; is_deeply $engine->seen, [ [log_fail_change => $changes[0] ], ], 'It should have logged the failure'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], ], 'Should have seen output for first change'; is_deeply +MockOutput->get_info, [[__ 'not ok']], 'Output should reflect deploy failure'; $die = ''; ############################################################################## # Test _deploy_by_tag(). $plan->reset; $mock_engine->unmock('_deploy_by_tag'); ok $engine->_deploy_by_tag($plan, 1), 'Deploy tagwise to index 1'; is_deeply $engine->seen, [ [run_file => $changes[0]->deploy_file], [log_deploy_change => $changes[0]], [run_file => $changes[1]->deploy_file], [log_deploy_change => $changes[1]], ], 'Should tagwise deploy to index 1'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], ], 'Should have seen output of each change'; is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']], 'Output should reflect deploy successes'; ok $engine->_deploy_by_tag($plan, 3), 'Deploy tagwise to index 3'; is_deeply $engine->seen, [ [run_file => $changes[2]->deploy_file], [log_deploy_change => $changes[2]], [run_file => $changes[3]->deploy_file], [log_deploy_change => $changes[3]], ], 'Should tagwise deploy from index 2 to index 3'; is_deeply +MockOutput->get_info_literal, [ [' + widgets @beta ..', '', ' '], [' + lolz ..', '.........', ' '], ], 'Should have seen output of changes 3-3'; is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']], 'Output should reflect deploy successes'; # Add another couple of changes. $plan->add(name => 'tacos' ); $plan->add(name => 'curry' ); @changes = $plan->changes; # Make it die. $plan->position(1); my $mock_whu = Test::MockModule->new('App::Sqitch::Engine::whu'); $mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[-1] }); throws_ok { $engine->_deploy_by_tag($plan, $#changes) } 'App::Sqitch::X', 'Die in log_deploy_change'; is $@->message, __('Deploy failed'), 'Should get final deploy failure message'; is_deeply $engine->seen, [ [run_file => $changes[2]->deploy_file], [run_file => $changes[3]->deploy_file], [run_file => $changes[4]->deploy_file], [run_file => $changes[5]->deploy_file], [run_file => $changes[5]->revert_file], [log_fail_change => $changes[5] ], [run_file => $changes[4]->revert_file], [log_revert_change => $changes[4]], [run_file => $changes[3]->revert_file], [log_revert_change => $changes[3]], ], 'It should have reverted back to the last deployed tag'; is_deeply +MockOutput->get_info_literal, [ [' + widgets @beta ..', '', ' '], [' + lolz ..', '.........', ' '], [' + tacos ..', '........', ' '], [' + curry ..', '........', ' '], [' - tacos ..', '........', ' '], [' - lolz ..', '.........', ' '], ], 'Should have seen deploy and revert messages (excluding curry revert)'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'not ok' ], [__ 'ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes and failure'; is_deeply +MockOutput->get_vent, [ ['ROFL'], [__x 'Reverting to {change}', change => 'widgets @beta'] ], 'The original error should have been vented'; $mock_whu->unmock('log_deploy_change'); # Make it die with log-only. $plan->position(1); ok $engine->log_only(1), 'Enable log_only'; $mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[-1] }); throws_ok { $engine->_deploy_by_tag($plan, $#changes, 1) } 'App::Sqitch::X', 'Die in log_deploy_change log-only'; is $@->message, __('Deploy failed'), 'Should get final deploy failure message'; is_deeply $engine->seen, [ [log_fail_change => $changes[5] ], [log_revert_change => $changes[4]], [log_revert_change => $changes[3]], ], 'It should have run no deploy or revert scripts'; is_deeply +MockOutput->get_info_literal, [ [' + widgets @beta ..', '', ' '], [' + lolz ..', '.........', ' '], [' + tacos ..', '........', ' '], [' + curry ..', '........', ' '], [' - tacos ..', '........', ' '], [' - lolz ..', '.........', ' '], ], 'Should have seen deploy and revert messages (excluding curry revert)'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'not ok' ], [__ 'ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes and failure'; is_deeply +MockOutput->get_vent, [ ['ROFL'], [__x 'Reverting to {change}', change => 'widgets @beta'] ], 'The original error should have been vented'; $mock_whu->unmock('log_deploy_change'); # Now have it fail back to the beginning. $plan->reset; $engine->log_only(0); $mock_whu->mock(run_file => sub { die 'ROFL' if $_[1]->basename eq 'users.sql' }); throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X', 'Die in _deploy_by_tag again'; is $@->message, __('Deploy failed'), 'Should again get final deploy failure message'; is_deeply $engine->seen, [ [log_deploy_change => $changes[0]], [log_fail_change => $changes[1]], [log_revert_change => $changes[0]], ], 'Should have logged back to the beginning'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], [' - roles ..', '........', ' '], ], 'Should have seen deploy and revert messages'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'not ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes and failure'; my $vented = MockOutput->get_vent; is @{ $vented }, 2, 'Should have one vented message'; my $errmsg = shift @{ $vented->[0] }; like $errmsg, qr/^ROFL\b/, 'And it should be the underlying error'; is_deeply $vented, [ [], [__ 'Reverting all changes'], ], 'And it should had notified that all changes were reverted'; # Add a change and deploy to that, to make sure it rolls back any changes since # last tag. $plan->add(name => 'dr_evil' ); @changes = $plan->changes; $plan->reset; $mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'dr_evil.sql' }); throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X', 'Die in _deploy_by_tag yet again'; is $@->message, __('Deploy failed'), 'Should die "Deploy failed" again'; is_deeply $engine->seen, [ [log_deploy_change => $changes[0]], [log_deploy_change => $changes[1]], [log_deploy_change => $changes[2]], [log_deploy_change => $changes[3]], [log_deploy_change => $changes[4]], [log_deploy_change => $changes[5]], [log_fail_change => $changes[6]], [log_revert_change => $changes[5] ], [log_revert_change => $changes[4] ], [log_revert_change => $changes[3] ], ], 'Should have reverted back to last tag'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], [' + widgets @beta ..', '', ' '], [' + lolz ..', '.........', ' '], [' + tacos ..', '........', ' '], [' + curry ..', '........', ' '], [' + dr_evil ..', '......', ' '], [' - curry ..', '........', ' '], [' - tacos ..', '........', ' '], [' - lolz ..', '.........', ' '], ], 'Should have user change reversion messages'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'not ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes and failure'; is_deeply +MockOutput->get_vent, [ ['ROFL'], [__x 'Reverting to {change}', change => 'widgets @beta'] ], 'Should see underlying error and reversion message'; # Make it choke on change reversion. $mock_whu->unmock_all; $die = ''; $plan->reset; $mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1] eq $changes[1]->deploy_file; hurl 'BARF' if $_[1] eq $changes[0]->revert_file; }); $mock_whu->mock(start_at => 'whatever'); throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X', 'Die in _deploy_by_tag again'; is $@->message, __('Deploy failed'), 'Should once again get final deploy failure message'; is_deeply $engine->seen, [ [log_deploy_change => $changes[0] ], [log_fail_change => $changes[1] ], ], 'Should have tried to revert one change'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], [' - roles ..', '........', ' '], ], 'Should have seen revert message'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'not ok' ], [__ 'not ok' ], ], 'Output should reflect deploy successes and failure'; is_deeply +MockOutput->get_vent, [ ['ROFL'], [__x 'Reverting to {change}', change => 'whatever'], ['BARF'], [__ 'The schema will need to be manually repaired'] ], 'Should get reversion failure message'; $mock_whu->unmock_all; ############################################################################## # Test _deploy_all(). $plan->reset; $mock_engine->unmock('_deploy_all'); ok $engine->_deploy_all($plan, 1), 'Deploy all to index 1'; is_deeply $engine->seen, [ [run_file => $changes[0]->deploy_file], [log_deploy_change => $changes[0]], [run_file => $changes[1]->deploy_file], [log_deploy_change => $changes[1]], ], 'Should tagwise deploy to index 1'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], ], 'Should have seen output of each change'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes'; ok $engine->_deploy_all($plan, 2), 'Deploy tagwise to index 2'; is_deeply $engine->seen, [ [run_file => $changes[2]->deploy_file], [log_deploy_change => $changes[2]], ], 'Should tagwise deploy to from index 1 to index 2'; is_deeply +MockOutput->get_info_literal, [ [' + widgets @beta ..', '', ' '], ], 'Should have seen output of changes 3-4'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], ], 'Output should reflect deploy successe'; # Make it die. $plan->reset; $mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[2] }); throws_ok { $engine->_deploy_all($plan, 3) } 'App::Sqitch::X', 'Die in _deploy_all'; is $@->message, __('Deploy failed'), 'Should get final deploy failure message'; $mock_whu->unmock('log_deploy_change'); is_deeply $engine->seen, [ [run_file => $changes[0]->deploy_file], [run_file => $changes[1]->deploy_file], [run_file => $changes[2]->deploy_file], [run_file => $changes[2]->revert_file], [log_fail_change => $changes[2]], [run_file => $changes[1]->revert_file], [log_revert_change => $changes[1]], [run_file => $changes[0]->revert_file], [log_revert_change => $changes[0]], ], 'It should have logged up to the failure'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], [' + widgets @beta ..', '', ' '], [' - users @alpha ..', '.', ' '], [' - roles ..', '........', ' '], ], 'Should have seen deploy and revert messages excluding revert for failed logging'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'ok' ], [__ 'not ok' ], [__ 'ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes and failures'; is_deeply +MockOutput->get_vent, [ ['ROFL'], [__ 'Reverting all changes'], ], 'The original error should have been vented'; $die = ''; # Make it die with log-only. $plan->reset; ok $engine->log_only(1), 'Enable log_only'; $mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[2] }); throws_ok { $engine->_deploy_all($plan, 3, 1) } 'App::Sqitch::X', 'Die in log-only _deploy_all'; is $@->message, __('Deploy failed'), 'Should get final deploy failure message'; $mock_whu->unmock('log_deploy_change'); is_deeply $engine->seen, [ [log_fail_change => $changes[2]], [log_revert_change => $changes[1]], [log_revert_change => $changes[0]], ], 'It should have run no deploys or reverts'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], [' + widgets @beta ..', '', ' '], [' - users @alpha ..', '.', ' '], [' - roles ..', '........', ' '], ], 'Should have seen deploy and revert messages excluding revert for failed logging'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'ok' ], [__ 'not ok' ], [__ 'ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes and failures'; is_deeply +MockOutput->get_vent, [ ['ROFL'], [__ 'Reverting all changes'], ], 'The original error should have been vented'; $die = ''; # Now have it fail on a later change, should still go all the way back. $plan->reset; $engine->log_only(0); $mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'widgets.sql' }); throws_ok { $engine->_deploy_all($plan, $plan->count -1 ) } 'App::Sqitch::X', 'Die in _deploy_all again'; is $@->message, __('Deploy failed'), 'Should again get final deploy failure message'; is_deeply $engine->seen, [ [log_deploy_change => $changes[0]], [log_deploy_change => $changes[1]], [log_fail_change => $changes[2]], [log_revert_change => $changes[1]], [log_revert_change => $changes[0]], ], 'Should have reveted all changes and tags'; is_deeply +MockOutput->get_info_literal, [ [' + roles ..', '........', ' '], [' + users @alpha ..', '.', ' '], [' + widgets @beta ..', '', ' '], [' - users @alpha ..', '.', ' '], [' - roles ..', '........', ' '], ], 'Should see all changes revert'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'ok' ], [__ 'not ok' ], [__ 'ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes and failures'; is_deeply +MockOutput->get_vent, [ ['ROFL'], [__ 'Reverting all changes'], ], 'Should notifiy user of error and rollback'; # Die when starting from a later point. $plan->position(2); $engine->start_at('@alpha'); $mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'dr_evil.sql' }); throws_ok { $engine->_deploy_all($plan, $plan->count -1 ) } 'App::Sqitch::X', 'Die in _deploy_all on the last change'; is $@->message, __('Deploy failed'), 'Should once again get final deploy failure message'; is_deeply $engine->seen, [ [log_deploy_change => $changes[3]], [log_deploy_change => $changes[4]], [log_deploy_change => $changes[5]], [log_fail_change => $changes[6]], [log_revert_change => $changes[5]], [log_revert_change => $changes[4]], [log_revert_change => $changes[3]], ], 'Should have deployed to dr_evil and revered down to @alpha'; is_deeply +MockOutput->get_info_literal, [ [' + lolz ..', '.........', ' '], [' + tacos ..', '........', ' '], [' + curry ..', '........', ' '], [' + dr_evil ..', '......', ' '], [' - curry ..', '........', ' '], [' - tacos ..', '........', ' '], [' - lolz ..', '.........', ' '], ], 'Should see changes revert back to @alpha'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'not ok' ], [__ 'ok' ], [__ 'ok' ], [__ 'ok' ], ], 'Output should reflect deploy successes and failures'; is_deeply +MockOutput->get_vent, [ ['ROFL'], [__x 'Reverting to {change}', change => '@alpha'], ], 'Should notifiy user of error and rollback to @alpha'; $mock_whu->unmock_all; ############################################################################## # Test is_deployed(). my $tag = App::Sqitch::Plan::Tag->new( name => 'foo', change => $change, plan => $target->plan, ); $is_deployed_tag = $is_deployed_change = 1; ok $engine->is_deployed($tag), 'Test is_deployed(tag)'; is_deeply $engine->seen, [ [is_deployed_tag => $tag], ], 'It should have called is_deployed_tag()'; ok $engine->is_deployed($change), 'Test is_deployed(change)'; is_deeply $engine->seen, [ [is_deployed_change => $change], ], 'It should have called is_deployed_change()'; ############################################################################## # Test deploy_change. can_ok $engine, 'deploy_change'; ok $engine->deploy_change($change), 'Deploy a change'; is_deeply $engine->seen, [ [run_file => $change->deploy_file], [log_deploy_change => $change], ], 'It should have been deployed'; is_deeply +MockOutput->get_info_literal, [ [' + foo ..', '..........', ' '] ], 'Should have shown change name'; is_deeply +MockOutput->get_info, [ [__ 'ok' ], ], 'Output should reflect deploy success'; my $make_deps = sub { my $conflicts = shift; return map { my $dep = App::Sqitch::Plan::Depend->new( change => $_, plan => $plan, project => $plan->project, conflicts => $conflicts, ); $dep; } @_; }; DEPLOYDIE: { my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend'); $mock_depend->mock(id => sub { undef }); # Now make it die on the actual deploy. $die = 'log_deploy_change'; my @requires = $make_deps->( 0, qw(foo bar) ); my @conflicts = $make_deps->( 1, qw(dr_evil) ); my $change = App::Sqitch::Plan::Change->new( name => 'foo', plan => $target->plan, requires => \@requires, conflicts => \@conflicts, ); throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X', 'Shuld die on deploy failure'; is $@->message, __ 'Deploy failed', 'Should be told the deploy failed'; is_deeply $engine->seen, [ [run_file => $change->deploy_file], [run_file => $change->revert_file], [log_fail_change => $change], ], 'It should failed to have been deployed'; is_deeply +MockOutput->get_vent, [ ['AAAH!'], ], 'Should have vented the original error'; is_deeply +MockOutput->get_info_literal, [ [' + foo ..', '..........', ' '], ], 'Should have shown change name'; is_deeply +MockOutput->get_info, [ [__ 'not ok' ], ], 'Output should reflect deploy failure'; $die = ''; } ############################################################################## # Test revert_change(). can_ok $engine, 'revert_change'; ok $engine->revert_change($change), 'Revert the change'; is_deeply $engine->seen, [ [run_file => $change->revert_file], [log_revert_change => $change], ], 'It should have been reverted'; is_deeply +MockOutput->get_info_literal, [ [' - foo ..', '..........', ' '] ], 'Should have shown reverted change name'; is_deeply +MockOutput->get_info, [ [__ 'ok'], ], 'And the revert failure should be "ok"'; ############################################################################## # Test revert(). can_ok $engine, 'revert'; $engine->plan($plan); # Start with no deployed IDs. @deployed_changes = (); throws_ok { $engine->revert } 'App::Sqitch::X', 'Should get exception for no changes to revert'; is $@->ident, 'revert', 'Should be a revert exception'; is $@->message, __ 'Nothing to revert (nothing deployed)', 'Should have notified that there is nothing to revert'; is $@->exitval, 1, 'Exit val should be 1'; is_deeply $engine->seen, [ [deployed_changes => undef], ], 'It should only have called deployed_changes()'; is_deeply +MockOutput->get_info, [], 'Nothing should have been output'; # Try reverting to an unknown change. throws_ok { $engine->revert('nonexistent') } 'App::Sqitch::X', 'Revert should die on unknown change'; is $@->ident, 'revert', 'Should be another "revert" error'; is $@->message, __x( 'Unknown change: "{change}"', change => 'nonexistent', ), 'The message should mention it is an unknown change'; is_deeply $engine->seen, [['change_id_for', { change_id => undef, change => 'nonexistent', tag => undef, project => 'sql', }]], 'Should have called change_id_for() with change name'; is_deeply +MockOutput->get_info, [], 'Nothing should have been output'; # Try reverting to an unknown change ID. throws_ok { $engine->revert('8d77c5f588b60bc0f2efcda6369df5cb0177521d') } 'App::Sqitch::X', 'Revert should die on unknown change ID'; is $@->ident, 'revert', 'Should be another "revert" error'; is $@->message, __x( 'Unknown change: "{change}"', change => '8d77c5f588b60bc0f2efcda6369df5cb0177521d', ), 'The message should mention it is an unknown change'; is_deeply $engine->seen, [['change_id_for', { change_id => '8d77c5f588b60bc0f2efcda6369df5cb0177521d', change => undef, tag => undef, project => 'sql', }]], 'Should have called change_id_for() with change ID'; is_deeply +MockOutput->get_info, [], 'Nothing should have been output'; # Revert an undeployed change. throws_ok { $engine->revert('@alpha') } 'App::Sqitch::X', 'Revert should die on undeployed change'; is $@->ident, 'revert', 'Should be another "revert" error'; is $@->message, __x( 'Change not deployed: "{change}"', change => '@alpha', ), 'The message should mention that the change is not deployed'; is_deeply $engine->seen, [['change_id_for', { change => '', change_id => undef, tag => 'alpha', project => 'sql', }]], 'change_id_for'; is_deeply +MockOutput->get_info, [], 'Nothing should have been output'; # Revert to a point with no following changes. $offset_change = $changes[0]; push @resolved => $offset_change->id; throws_ok { $engine->revert($changes[0]->id) } 'App::Sqitch::X', 'Should get error reverting when no subsequent changes'; is $@->ident, 'revert', 'No subsequent change error ident should be "revert"'; is $@->exitval, 1, 'No subsequent change error exitval should be 1'; is $@->message, __x( 'No changes deployed since: "{change}"', change => $changes[0]->id, ), 'No subsequent change error message should be correct'; delete $changes[0]->{_rework_tags}; # For deep comparison. is_deeply $engine->seen, [ [change_id_for => { change_id => $changes[0]->id, change => undef, tag => undef, project => 'sql', }], [ change_offset_from_id => [$changes[0]->id, 0] ], [deployed_changes_since => $changes[0]], ], 'Should have called change_id_for and deployed_changes_since'; # Revert with nothing deployed. throws_ok { $engine->revert } 'App::Sqitch::X', 'Should get error for known but undeployed change'; is $@->ident, 'revert', 'No changes error should be "revert"'; is $@->exitval, 1, 'No changes exitval should be 1'; is $@->message, __ 'Nothing to revert (nothing deployed)', 'No changes message should be correct'; is_deeply $engine->seen, [ [deployed_changes => undef], ], 'Should have called deployed_changes'; # Now revert from a deployed change. my @dbchanges; @deployed_changes = map { my $plan_change = $_; my $params = { id => $plan_change->id, name => $plan_change->name, project => $plan_change->project, note => $plan_change->note, planner_name => $plan_change->planner_name, planner_email => $plan_change->planner_email, timestamp => $plan_change->timestamp, tags => [ map { $_->name } $plan_change->tags ], }; push @dbchanges => my $db_change = App::Sqitch::Plan::Change->new( plan => $plan, %{ $params }, ); $db_change->add_tag( App::Sqitch::Plan::Tag->new( name => $_->name, plan => $plan, change => $db_change ) ) for $plan_change->tags; $db_change->tags; # Autovivify _tags For changes with no tags. $params; } @changes[0..3]; MockOutput->ask_y_n_returns(1); ok $engine->revert, 'Revert all changes'; is_deeply $engine->seen, [ [deployed_changes => undef], [check_revert_dependencies => [reverse @dbchanges[0..3]] ], [run_file => $dbchanges[3]->revert_file ], [log_revert_change => $dbchanges[3] ], [run_file => $dbchanges[2]->revert_file ], [log_revert_change => $dbchanges[2] ], [run_file => $dbchanges[1]->revert_file ], [log_revert_change => $dbchanges[1] ], [run_file => $dbchanges[0]->revert_file ], [log_revert_change => $dbchanges[0] ], ], 'Should have reverted the changes in reverse order'; is_deeply +MockOutput->get_ask_y_n, [ [__x( 'Revert all changes from {destination}?', destination => $engine->destination, ), 'Yes'], ], 'Should have prompted to revert all changes'; is_deeply +MockOutput->get_info_literal, [ [' - lolz ..', '.........', ' '], [' - widgets @beta ..', '', ' '], [' - users @alpha ..', '.', ' '], [' - roles ..', '........', ' '], ], 'It should have said it was reverting all changes and listed them'; is_deeply +MockOutput->get_info, [ [__ 'ok'], [__ 'ok'], [__ 'ok'], [__ 'ok'], ], 'And the revert successes should be emitted'; # Try with log-only. ok $engine->log_only(1), 'Enable log_only'; ok $engine->revert(undef, 1), 'Revert all changes log-only'; delete @{ $_ }{qw(_path_segments _rework_tags)} for @dbchanges; # These need to be invisible. is_deeply $engine->seen, [ [deployed_changes => undef], [check_revert_dependencies => [reverse @dbchanges[0..3]] ], [log_revert_change => $dbchanges[3] ], [log_revert_change => $dbchanges[2] ], [log_revert_change => $dbchanges[1] ], [log_revert_change => $dbchanges[0] ], ], 'Log-only Should have reverted the changes in reverse order'; is_deeply +MockOutput->get_ask_y_n, [ [__x( 'Revert all changes from {destination}?', destination => $engine->destination, ), 'Yes'], ], 'Log-only should have prompted to revert all changes'; is_deeply +MockOutput->get_info_literal, [ [' - lolz ..', '.........', ' '], [' - widgets @beta ..', '', ' '], [' - users @alpha ..', '.', ' '], [' - roles ..', '........', ' '], ], 'It should have said it was reverting all changes and listed them'; is_deeply +MockOutput->get_info, [ [__ 'ok'], [__ 'ok'], [__ 'ok'], [__ 'ok'], ], 'And the revert successes should be emitted'; # Should exit if the revert is declined. MockOutput->ask_y_n_returns(0); throws_ok { $engine->revert } 'App::Sqitch::X', 'Should abort declined revert'; is $@->ident, 'revert', 'Declined revert ident should be "revert"'; is $@->exitval, 1, 'Should have exited with value 1'; is $@->message, __ 'Nothing reverted', 'Should have exited with proper message'; is_deeply $engine->seen, [ [deployed_changes => undef], ], 'Should have called deployed_changes only'; is_deeply +MockOutput->get_ask_y_n, [ [__x( 'Revert all changes from {destination}?', destination => $engine->destination, ), 'Yes'], ], 'Should have prompt to revert all changes'; is_deeply +MockOutput->get_info, [ ], 'It should have emitted nothing else'; # Revert all changes with no prompt. MockOutput->ask_y_n_returns(1); $engine->log_only(0); $engine->no_prompt(1); ok $engine->revert, 'Revert all changes with no prompt'; is_deeply $engine->seen, [ [deployed_changes => undef], [check_revert_dependencies => [reverse @dbchanges[0..3]] ], [run_file => $dbchanges[3]->revert_file ], [log_revert_change => $dbchanges[3] ], [run_file => $dbchanges[2]->revert_file ], [log_revert_change => $dbchanges[2] ], [run_file => $dbchanges[1]->revert_file ], [log_revert_change => $dbchanges[1] ], [run_file => $dbchanges[0]->revert_file ], [log_revert_change => $dbchanges[0] ], ], 'Should have reverted the changes in reverse order'; is_deeply +MockOutput->get_ask_y_n, [], 'Should have no prompt'; is_deeply +MockOutput->get_info_literal, [ [' - lolz ..', '.........', ' '], [' - widgets @beta ..', '', ' '], [' - users @alpha ..', '.', ' '], [' - roles ..', '........', ' '], ], 'It should have said it was reverting all changes and listed them'; is_deeply +MockOutput->get_info, [ [__x( 'Reverting all changes from {destination}', destination => $engine->destination, )], [__ 'ok'], [__ 'ok'], [__ 'ok'], [__ 'ok'], ], 'And the revert successes should be emitted'; # Now just revert to an earlier change. $engine->no_prompt(0); $offset_change = $dbchanges[1]; push @resolved => $offset_change->id; @deployed_changes = @deployed_changes[2..3]; ok $engine->revert('@alpha'), 'Revert to @alpha'; delete $dbchanges[1]->{_rework_tags}; # These need to be invisible. is_deeply $engine->seen, [ [change_id_for => { change_id => undef, change => '', tag => 'alpha', project => 'sql' }], [ change_offset_from_id => [$dbchanges[1]->id, 0] ], [deployed_changes_since => $dbchanges[1]], [check_revert_dependencies => [reverse @dbchanges[2..3]] ], [run_file => $dbchanges[3]->revert_file ], [log_revert_change => $dbchanges[3] ], [run_file => $dbchanges[2]->revert_file ], [log_revert_change => $dbchanges[2] ], ], 'Should have reverted only changes after @alpha'; is_deeply +MockOutput->get_ask_y_n, [ [__x( 'Revert changes to {change} from {destination}?', destination => $engine->destination, change => $dbchanges[1]->format_name_with_tags, ), 'Yes'], ], 'Should have prompt to revert to change'; is_deeply +MockOutput->get_info_literal, [ [' - lolz ..', '.........', ' '], [' - widgets @beta ..', '', ' '], ], 'Output should show what it reverts to'; is_deeply +MockOutput->get_info, [ [__ 'ok'], [__ 'ok'], ], 'And the revert successes should be emitted'; MockOutput->ask_y_n_returns(0); $offset_change = $dbchanges[1]; push @resolved => $offset_change->id; throws_ok { $engine->revert('@alpha') } 'App::Sqitch::X', 'Should abort declined revert to @alpha'; is $@->ident, 'revert:confirm', 'Declined revert ident should be "revert:confirm"'; is $@->exitval, 1, 'Should have exited with value 1'; is $@->message, __ 'Nothing reverted', 'Should have exited with proper message'; is_deeply $engine->seen, [ [change_id_for => { change_id => undef, change => '', tag => 'alpha', project => 'sql' }], [change_offset_from_id => [$dbchanges[1]->id, 0] ], [deployed_changes_since => $dbchanges[1]], ], 'Should have called revert methods'; is_deeply +MockOutput->get_ask_y_n, [ [__x( 'Revert changes to {change} from {destination}?', change => $dbchanges[1]->format_name_with_tags, destination => $engine->destination, ), 'Yes'], ], 'Should have prompt to revert to @alpha'; is_deeply +MockOutput->get_info, [ ], 'It should have emitted nothing else'; # Try to revert just the last change with no prompt MockOutput->ask_y_n_returns(1); $engine->no_prompt(1); my $rev_file = $dbchanges[-1]->revert_file; # Grab before deleting _rework_tags. my $rtags = delete $dbchanges[-1]->{_rework_tags}; # These need to be invisible. $offset_change = $dbchanges[-1]; push @resolved => $offset_change->id; @deployed_changes = $deployed_changes[-1]; ok $engine->revert('@HEAD^'), 'Revert to @HEAD^'; is_deeply $engine->seen, [ [change_id_for => { change_id => undef, change => '', tag => 'HEAD', project => 'sql' }], [change_offset_from_id => [$dbchanges[-1]->id, -1] ], [deployed_changes_since => $dbchanges[-1]], [check_revert_dependencies => [{ %{ $dbchanges[-1] }, _rework_tags => $rtags }] ], [run_file => $rev_file ], [log_revert_change => { %{ $dbchanges[-1] }, _rework_tags => $rtags } ], ], 'Should have reverted one changes for @HEAD^'; is_deeply +MockOutput->get_ask_y_n, [], 'Should have no prompt'; is_deeply +MockOutput->get_info_literal, [ [' - lolz ..', '', ' '], ], 'Output should show what it reverts to'; is_deeply +MockOutput->get_info, [ [__x( 'Reverting changes to {change} from {destination}', destination => $engine->destination, change => $dbchanges[-1]->format_name_with_tags, )], [__ 'ok'], ], 'And the header and "ok" should be emitted'; ############################################################################## # Test change_id_for_depend(). can_ok $CLASS, 'change_id_for_depend'; $offset_change = $dbchanges[1]; my ($dep) = $make_deps->( 1, 'foo' ); throws_ok { $engine->change_id_for_depend( $dep ) } 'App::Sqitch::X', 'Should get error from change_id_for_depend when change not in plan'; is $@->ident, 'plan', 'Should get ident "plan" from change_id_for_depend'; is $@->message, __x( 'Unable to find change "{change}" in plan {file}', change => $dep->key_name, file => $target->plan_file, ), 'Should have proper message from change_id_for_depend error'; PLANOK: { my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend'); $mock_depend->mock(id => sub { undef }); $mock_depend->mock(change => sub { undef }); throws_ok { $engine->change_id_for_depend( $dep ) } 'App::Sqitch::X', 'Should get error from change_id_for_depend when no ID'; is $@->ident, 'engine', 'Should get ident "engine" when no ID'; is $@->message, __x( 'Invalid dependency: {dependency}', dependency => $dep->as_string, ), 'Should have proper messag from change_id_for_depend error'; # Let it have the change. $mock_depend->unmock('change'); push @resolved => $changes[1]->id; is $engine->change_id_for_depend( $dep ), $changes[1]->id, 'Get a change id'; is_deeply $engine->seen, [ [change_id_for => { change_id => $dep->id, change => $dep->change, tag => $dep->tag, project => $dep->project, }], ], 'Should have passed dependency params to change_id_for()'; } ############################################################################## # Test find_change(). can_ok $CLASS, 'find_change'; push @resolved => $dbchanges[1]->id; is $engine->find_change( change_id => $resolved[0], change => 'hi', tag => 'yo', ), $dbchanges[1], 'find_change() should work'; is_deeply $engine->seen, [ [change_id_for => { change_id => $dbchanges[1]->id, change => 'hi', tag => 'yo', project => 'sql', }], [change_offset_from_id => [ $dbchanges[1]->id, undef ]], ], 'Its parameters should have been passed to change_id_for and change_offset_from_id'; # Pass a project and an ofset. push @resolved => $dbchanges[1]->id; is $engine->find_change( change => 'hi', offset => 1, project => 'fred', ), $dbchanges[1], 'find_change() should work'; is_deeply $engine->seen, [ [change_id_for => { change_id => undef, change => 'hi', tag => undef, project => 'fred', }], [change_offset_from_id => [ $dbchanges[1]->id, 1 ]], ], 'Project and offset should have been passed off'; ############################################################################## # Test find_change_id(). can_ok $CLASS, 'find_change_id'; push @resolved => $dbchanges[1]->id; is $engine->find_change_id( change_id => $resolved[0], change => 'hi', tag => 'yo', ), $dbchanges[1]->id, 'find_change_id() should work'; is_deeply $engine->seen, [ [change_id_for => { change_id => $dbchanges[1]->id, change => 'hi', tag => 'yo', project => 'sql', }], [change_id_offset_from_id => [ $dbchanges[1]->id, undef ]], ], 'Its parameters should have been passed to change_id_for and change_offset_from_id'; # Pass a project and an ofset. push @resolved => $dbchanges[1]->id; is $engine->find_change_id( change => 'hi', offset => 1, project => 'fred', ), $dbchanges[1]->id, 'find_change_id() should work'; is_deeply $engine->seen, [ [change_id_for => { change_id => undef, change => 'hi', tag => undef, project => 'fred', }], [change_id_offset_from_id => [ $dbchanges[1]->id, 1 ]], ], 'Project and offset should have been passed off'; ############################################################################## # Test verify_change(). can_ok $CLASS, 'verify_change'; $change = App::Sqitch::Plan::Change->new( name => 'users', plan => $target->plan ); ok $engine->verify_change($change), 'Verify a change'; is_deeply $engine->seen, [ [run_file => $change->verify_file ], ], 'The change file should have been run'; is_deeply +MockOutput->get_info, [], 'Should have no info output'; # Try a change with no verify script. $change = App::Sqitch::Plan::Change->new( name => 'roles', plan => $target->plan ); ok $engine->verify_change($change), 'Verify a change with no verify script.'; is_deeply $engine->seen, [], 'No abstract methods should be called'; is_deeply +MockOutput->get_info, [], 'Should have no info output'; is_deeply +MockOutput->get_vent, [ [__x 'Verify script {file} does not exist', file => $change->verify_file], ], 'A warning about no verify file should have been emitted'; ############################################################################## # Test check_deploy_dependenices(). $mock_engine->unmock('check_deploy_dependencies'); can_ok $engine, 'check_deploy_dependencies'; CHECK_DEPLOY_DEPEND: { # Make sure dependencies check out for all the existing changes. $plan->reset; ok $engine->check_deploy_dependencies($plan), 'All planned changes should be okay'; is_deeply $engine->seen, [ [ are_deployed_changes => [map { $plan->change_at($_) } 0..$plan->count - 1] ], ], 'Should have called are_deployed_changes'; # Make sure it works when depending on a previous change. my $change = $plan->change_at(3); push @{ $change->_requires } => $make_deps->( 0, 'users' ); ok $engine->check_deploy_dependencies($plan), 'Dependencies should check out even when within those to be deployed'; is_deeply [ map { $_->resolved_id } map { $_->requires } $plan->changes ], [ $plan->change_at(1)->id ], 'Resolved ID should be populated'; # Make sure it fails if there is a conflict within those to be deployed. push @{ $change->_conflicts } => $make_deps->( 1, 'widgets' ); throws_ok { $engine->check_deploy_dependencies($plan) } 'App::Sqitch::X', 'Conflict should throw exception'; is $@->ident, 'deploy', 'Should be a "deploy" error'; is $@->message, __nx( 'Conflicts with previously deployed change: {changes}', 'Conflicts with previously deployed changes: {changes}', scalar 1, changes => 'widgets', ), 'Should have localized message about the local conflict'; shift @{ $change->_conflicts }; # Now test looking stuff up in the database. my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend'); my @depend_ids; $mock_depend->mock(id => sub { shift @depend_ids }); my @conflicts = $make_deps->( 1, qw(foo bar) ); $change = App::Sqitch::Plan::Change->new( name => 'foo', plan => $target->plan, conflicts => \@conflicts, ); $plan->_changes->append($change); my $start_from = $plan->count - 1; $plan->position( $start_from - 1); push @resolved, '2342', '253245'; throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X', 'Conflict should throw exception'; is $@->ident, 'deploy', 'Should be a "deploy" error'; is $@->message, __nx( 'Conflicts with previously deployed change: {changes}', 'Conflicts with previously deployed changes: {changes}', scalar 2, changes => 'foo bar', ), 'Should have localized message about conflicts'; is_deeply $engine->seen, [ [ are_deployed_changes => [map { $plan->change_at($_) } 0..$start_from-1] ], [ change_id_for => { change_id => undef, change => 'foo', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'bar', tag => undef, project => 'sql', } ], ], 'Should have called change_id_for() twice'; is_deeply [ map { $_->resolved_id } @conflicts ], [undef, undef], 'Conflicting dependencies should have no resolved IDs'; # Fail with multiple conflicts. push @{ $plan->change_at(3)->_conflicts } => $make_deps->( 1, 'widgets' ); $plan->reset; push @depend_ids => $plan->change_at(2)->id; push @resolved, '2342', '253245', '2323434'; throws_ok { $engine->check_deploy_dependencies($plan) } 'App::Sqitch::X', 'Conflict should throw another exception'; is $@->ident, 'deploy', 'Should be a "deploy" error'; is $@->message, __nx( 'Conflicts with previously deployed change: {changes}', 'Conflicts with previously deployed changes: {changes}', scalar 3, changes => 'widgets foo bar', ), 'Should have localized message about all three conflicts'; is_deeply $engine->seen, [ [ change_id_for => { change_id => undef, change => 'users', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'foo', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'bar', tag => undef, project => 'sql', } ], ], 'Should have called change_id_for() twice'; is_deeply [ map { $_->resolved_id } @conflicts ], [undef, undef], 'Conflicting dependencies should have no resolved IDs'; ########################################################################## # Die on missing dependencies. my @requires = $make_deps->( 0, qw(foo bar) ); $change = App::Sqitch::Plan::Change->new( name => 'blah', plan => $target->plan, requires => \@requires, ); $plan->_changes->append($change); $start_from = $plan->count - 1; $plan->position( $start_from - 1); push @resolved, undef, undef; throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X', 'Missing dependencies should throw exception'; is $@->ident, 'deploy', 'Should be another "deploy" error'; is $@->message, __nx( 'Missing required change: {changes}', 'Missing required changes: {changes}', scalar 2, changes => 'foo bar', ), 'Should have localized message missing dependencies'; is_deeply $engine->seen, [ [ change_id_for => { change_id => undef, change => 'foo', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'bar', tag => undef, project => 'sql', } ], ], 'Should have called check_requires'; is_deeply [ map { $_->resolved_id } @requires ], [undef, undef], 'Missing requirements should not have resolved'; # Make sure we see both conflict and prereq failures. push @resolved, '2342', '253245', '2323434', undef, undef; $plan->reset; throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X', 'Missing dependencies should throw exception'; is $@->ident, 'deploy', 'Should be another "deploy" error'; is $@->message, join( "\n", __nx( 'Conflicts with previously deployed change: {changes}', 'Conflicts with previously deployed changes: {changes}', scalar 3, changes => 'widgets foo', ), __nx( 'Missing required change: {changes}', 'Missing required changes: {changes}', scalar 2, changes => 'foo bar', ), ), 'Should have localized conflicts and required error messages'; is_deeply $engine->seen, [ [ change_id_for => { change_id => undef, change => 'widgets', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'users', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'foo', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'bar', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'foo', tag => undef, project => 'sql', } ], [ change_id_for => { change_id => undef, change => 'bar', tag => undef, project => 'sql', } ], ], 'Should have called check_requires'; is_deeply [ map { $_->resolved_id } @requires ], [undef, undef], 'Missing requirements should not have resolved'; } # Test revert dependency-checking. $mock_engine->unmock('check_revert_dependencies'); can_ok $engine, 'check_revert_dependencies'; CHECK_REVERT_DEPEND: { my $change = App::Sqitch::Plan::Change->new( name => 'urfa', id => '24234234234e', plan => $plan, ); # Have revert change fail with requiring changes. my $req = { change_id => '23234234', change => 'blah', asof_tag => undef, project => $plan->project, }; @requiring = [$req]; throws_ok { $engine->check_revert_dependencies($change) } 'App::Sqitch::X', 'Should get error reverting change another depend on'; is $@->ident, 'revert', 'Dependent error ident should be "revert"'; is $@->message, __nx( 'Change "{change}" required by currently deployed change: {changes}', 'Change "{change}" required by currently deployed changes: {changes}', 1, change => 'urfa', changes => 'blah' ), 'Dependent error message should be correct'; is_deeply $engine->seen, [ [changes_requiring_change => $change ], ], 'It should have check for requiring changes'; # Add a second requiring change. my $req2 = { change_id => '99999', change => 'harhar', asof_tag => '@foo', project => 'elsewhere', }; @requiring = [$req, $req2]; throws_ok { $engine->check_revert_dependencies($change) } 'App::Sqitch::X', 'Should get error reverting change others depend on'; is $@->ident, 'revert', 'Dependent error ident should be "revert"'; is $@->message, __nx( 'Change "{change}" required by currently deployed change: {changes}', 'Change "{change}" required by currently deployed changes: {changes}', 2 , change => 'urfa', changes => 'blah elsewhere:harhar@foo' ), 'Dependent error message should be correct'; is_deeply $engine->seen, [ [changes_requiring_change => $change ], ], 'It should have check for requiring changes'; # Try it with two changes. my $req3 = { change_id => '94949494', change => 'frobisher', project => 'whu', }; @requiring = ([$req, $req2], [$req3]); my $change2 = App::Sqitch::Plan::Change->new( name => 'kazane', id => '8686868686', plan => $plan, ); throws_ok { $engine->check_revert_dependencies($change, $change2) } 'App::Sqitch::X', 'Should get error reverting change others depend on'; is $@->ident, 'revert', 'Dependent error ident should be "revert"'; is $@->message, join( "\n", __nx( 'Change "{change}" required by currently deployed change: {changes}', 'Change "{change}" required by currently deployed changes: {changes}', 2 , change => 'urfa', changes => 'blah elsewhere:harhar@foo' ), __nx( 'Change "{change}" required by currently deployed change: {changes}', 'Change "{change}" required by currently deployed changes: {changes}', 1, change => 'kazane', changes => 'whu:frobisher' ), ), 'Dependent error message should be correct'; is_deeply $engine->seen, [ [changes_requiring_change => $change ], [changes_requiring_change => $change2 ], ], 'It should have checked twice for requiring changes'; } ############################################################################## # Test _trim_to(). can_ok $engine, '_trim_to'; # Should get an error when a change is not in the plan. throws_ok { $engine->_trim_to( 'foo', 'nonexistent', [] ) } 'App::Sqitch::X', '_trim_to should complain about a nonexistent change key'; is $@->ident, 'foo', '_trim_to nonexistent key error ident should be "foo"'; is $@->message, __x( 'Cannot find "{change}" in the database or the plan', change => 'nonexistent', ), '_trim_to nonexistent key error message should be correct'; is_deeply $engine->seen, [ [ change_id_for => { change => 'nonexistent', change_id => undef, project => 'sql', tag => undef, } ] ], 'It should have passed the change name and ROOT tag to change_id_for'; # Should get an error when it's in the plan but not the database. throws_ok { $engine->_trim_to( 'yep', 'blah', [] ) } 'App::Sqitch::X', '_trim_to should complain about an undeployed change key'; is $@->ident, 'yep', '_trim_to undeployed change error ident should be "yep"'; is $@->message, __x( 'Change "{change}" has not been deployed', change => 'blah', ), '_trim_to undeployed change error message should be correct'; is_deeply $engine->seen, [ [ change_id_for => { change => 'blah', change_id => undef, project => 'sql', tag => undef, } ] ], 'It should have passed change "blah" change_id_for'; # Should get an error when it's deployed but not in the plan. @resolved = ('whatever'); throws_ok { $engine->_trim_to( 'oop', 'whatever', [] ) } 'App::Sqitch::X', '_trim_to should complain about an unplanned change key'; is $@->ident, 'oop', '_trim_to unplanned change error ident should be "oop"'; is $@->message, __x( 'Change "{change}" is deployed, but not planned', change => 'whatever', ), '_trim_to unplanned change error message should be correct'; is_deeply $engine->seen, [ [ change_id_for => { change => 'whatever', change_id => undef, project => 'sql', tag => undef, } ], [ change_id_offset_from_id => ['whatever', 0]], ], 'It should have passed "whatever" to change_id_offset_from_id'; # Let's mess with changes. Start by shifting nothing. my $to_trim = [@changes]; @resolved = ($changes[0]->id); my $key = $changes[0]->name; is $engine->_trim_to('foo', $key, $to_trim), 0, qq{_trim_to should find "$key" at index 0}; is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes ], 'Changes should be untrimmed'; is_deeply $engine->seen, [ [ change_id_for => { change => $key, change_id => undef, project => 'sql', tag => undef, } ], [ change_id_offset_from_id => [$changes[0]->id, 0]], ], 'It should have passed change 0 ID to change_id_offset_from_id'; # Try shifting to the third change. $to_trim = [@changes]; @resolved = ($changes[2]->id); $key = $changes[2]->name; is $engine->_trim_to('foo', $key, $to_trim), 2, qq{_trim_to should find "$key" at index 2}; is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ], 'First two changes should be shifted off'; is_deeply $engine->seen, [ [ change_id_for => { change => $key, change_id => undef, project => 'sql', tag => undef, } ], [ change_id_offset_from_id => [$changes[2]->id, 0]], ], 'It should have passed change 2 ID to change_id_offset_from_id'; # Try popping nothing. $to_trim = [@changes]; @resolved = ($changes[-1]->id); $key = $changes[-1]->name; is $engine->_trim_to('foo', $key, $to_trim, 1), $#changes, qq{_trim_to should find "$key" at last index}; is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes ], 'Changes should be untrimmed'; is_deeply $engine->seen, [ [ change_id_for => { change => $key, change_id => undef, project => 'sql', tag => undef, } ], [ change_id_offset_from_id => [$changes[-1]->id, 0]], ], 'It should have passed change -1 ID to change_id_offset_from_id'; # Try shifting to the third-to-last change. $to_trim = [@changes]; @resolved = ($changes[-3]->id); $key = $changes[-3]->name; is $engine->_trim_to('foo', $key, $to_trim, 1), 4, qq{_trim_to should find "$key" at index 4}; is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0..$#changes-2] ], 'Last two changes should be popped off'; is_deeply $engine->seen, [ [ change_id_for => { change => $key, change_id => undef, project => 'sql', tag => undef, } ], [ change_id_offset_from_id => [$changes[-3]->id, 0]], ], 'It should have passed change -3 ID to change_id_offset_from_id'; # ^ should be handled relative to deployed changes. $to_trim = [@changes]; @resolved = ($changes[-3]->id); $key = $changes[-4]->name; is $engine->_trim_to('foo', "$key^", $to_trim, 1), 4, qq{_trim_to should find "$key^" at index 4}; is_deeply $engine->seen, [ [ change_id_for => { change => $key, change_id => undef, project => 'sql', tag => undef, } ], [ change_id_offset_from_id => [$changes[-3]->id, -1]], ], 'Should pass change -3 ID and offset -1 to change_id_offset_from_id'; # ~ should be handled relative to deployed changes. $to_trim = [@changes]; @resolved = ($changes[-3]->id); $key = $changes[-2]->name; is $engine->_trim_to('foo', "$key~", $to_trim, 1), 4, qq{_trim_to should find "$key~" at index 4}; is_deeply $engine->seen, [ [ change_id_for => { change => $key, change_id => undef, project => 'sql', tag => undef, } ], [ change_id_offset_from_id => [$changes[-3]->id, 1]], ], 'Should pass change -3 ID and offset 1 to change_id_offset_from_id'; # @HEAD and HEAD should be handled relative to deployed changes, not the plan. $to_trim = [@changes]; @resolved = ($changes[2]->id); $key = '@HEAD'; is $engine->_trim_to('foo', $key, $to_trim), 2, qq{_trim_to should find "$key" at index 2}; is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ], 'First two changes should be shifted off'; is_deeply $engine->seen, [ [ change_id_for => { change => '', change_id => undef, project => 'sql', tag => 'HEAD', } ], [ change_id_offset_from_id => [$changes[2]->id, 0]], ], 'Should pass tag HEAD to change_id_for'; $to_trim = [@changes]; @resolved = ($changes[2]->id); $key = 'HEAD'; is $engine->_trim_to('foo', $key, $to_trim), 2, qq{_trim_to should find "$key" at index 2}; is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ], 'First two changes should be shifted off'; is_deeply $engine->seen, [ [ change_id_for => { change => undef, change_id => undef, project => 'sql', tag => 'HEAD', } ], [ change_id_offset_from_id => [$changes[2]->id, 0]], ], 'Should pass tag @HEAD to change_id_for'; # @ROOT and ROOT should be handled relative to deployed changes, not the plan. $to_trim = [@changes]; @resolved = ($changes[2]->id); $key = '@ROOT'; is $engine->_trim_to('foo', $key, $to_trim, 1), 2, qq{_trim_to should find "$key" at index 2}; is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0,1,2] ], 'All but First three changes should be popped off'; is_deeply $engine->seen, [ [ change_id_for => { change => '', change_id => undef, project => 'sql', tag => 'ROOT', } ], [ change_id_offset_from_id => [$changes[2]->id, 0]], ], 'Should pass tag ROOT to change_id_for'; $to_trim = [@changes]; @resolved = ($changes[2]->id); $key = 'ROOT'; is $engine->_trim_to('foo', $key, $to_trim, 1), 2, qq{_trim_to should find "$key" at index 2}; is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0,1,2] ], 'All but First three changes should be popped off'; is_deeply $engine->seen, [ [ change_id_for => { change => undef, change_id => undef, project => 'sql', tag => 'ROOT', } ], [ change_id_offset_from_id => [$changes[2]->id, 0]], ], 'Should pass tag @ROOT to change_id_for'; ############################################################################## # Test _verify_changes(). can_ok $engine, '_verify_changes'; $engine->seen; # Start with a single change with a valid verify script. is $engine->_verify_changes(1, 1, 0, $changes[1]), 0, 'Verify of a single change should return errcount 0'; is_deeply +MockOutput->get_emit_literal, [[ ' * users @alpha ..', '', ' ', ]], 'Declared output should list the change'; is_deeply +MockOutput->get_emit, [['ok']], 'Emitted Output should reflect the verification of the change'; is_deeply +MockOutput->get_comment, [], 'Should have no comments'; is_deeply $engine->seen, [ [run_file => $changes[1]->verify_file ], ], 'The verify script should have been run'; # Try a single change with no verify script. is $engine->_verify_changes(0, 0, 0, $changes[0]), 0, 'Verify of another single change should return errcount 0'; is_deeply +MockOutput->get_emit_literal, [[ ' * roles ..', '', ' ', ]], 'Declared output should list the change'; is_deeply +MockOutput->get_emit, [['ok']], 'Emitted Output should reflect the verification of the change'; is_deeply +MockOutput->get_comment, [], 'Should have no comments'; is_deeply +MockOutput->get_vent, [ [__x 'Verify script {file} does not exist', file => $changes[0]->verify_file], ], 'A warning about no verify file should have been emitted'; is_deeply $engine->seen, [ ], 'The verify script should not have been run'; # Try multiple changes. is $engine->_verify_changes(0, 1, 0, @changes[0,1]), 0, 'Verify of two changes should return errcount 0'; is_deeply +MockOutput->get_emit_literal, [ [' * roles ..', '.......', ' '], [' * users @alpha ..', '', ' '], ], 'Declared output should list both changes'; is_deeply +MockOutput->get_emit, [['ok'], ['ok']], 'Emitted Output should reflect the verification of the changes'; is_deeply +MockOutput->get_comment, [], 'Should have no comments'; is_deeply +MockOutput->get_vent, [ [__x 'Verify script {file} does not exist', file => $changes[0]->verify_file], ], 'A warning about no verify file should have been emitted'; is_deeply $engine->seen, [ [run_file => $changes[1]->verify_file ], ], 'Only one verify script should have been run'; # Try multiple changes and show undeployed changes. my @plan_changes = $plan->changes; is $engine->_verify_changes(0, 1, 1, @changes[0,1]), 0, 'Verify of two changes and show pending'; is_deeply +MockOutput->get_emit_literal, [ [' * roles ..', '.......', ' '], [' * users @alpha ..', '', ' '], ], 'Delcared output should list deployed changes'; is_deeply +MockOutput->get_emit, [ ['ok'], ['ok'], [__n 'Undeployed change:', 'Undeployed changes:', 2], map { [ ' * ', $_->format_name_with_tags] } @plan_changes[2..$#plan_changes] ], 'Emitted output should include list of pending changes'; is_deeply +MockOutput->get_comment, [], 'Should have no comments'; is_deeply +MockOutput->get_vent, [ [__x 'Verify script {file} does not exist', file => $changes[0]->verify_file], ], 'A warning about no verify file should have been emitted'; is_deeply $engine->seen, [ [run_file => $changes[1]->verify_file ], ], 'Only one verify script should have been run'; # Try a change that is not in the plan. $change = App::Sqitch::Plan::Change->new( name => 'nonexistent', plan => $plan ); is $engine->_verify_changes(1, 0, 0, $change), 1, 'Verify of a change not in the plan should return errcount 1'; is_deeply +MockOutput->get_emit_literal, [[ ' * nonexistent ..', '', ' ' ]], 'Declared Output should reflect the verification of the change'; is_deeply +MockOutput->get_emit, [['not ok']], 'Emitted Output should reflect the failure of the verify'; is_deeply +MockOutput->get_comment, [[__ 'Not present in the plan' ]], 'Should have a comment about the change missing from the plan'; is_deeply $engine->seen, [], 'No verify script should have been run'; # Try a change in the wrong place in the plan. my $mock_plan = Test::MockModule->new(ref $plan); $mock_plan->mock(index_of => 5); is $engine->_verify_changes(1, 0, 0, $changes[1]), 1, 'Verify of an out-of-order change should return errcount 1'; is_deeply +MockOutput->get_emit_literal, [ [' * users @alpha ..', '', ' '], ], 'Declared output should reflect the verification of the change'; is_deeply +MockOutput->get_emit, [['not ok']], 'Emitted Output should reflect the failure of the verify'; is_deeply +MockOutput->get_comment, [[__ 'Out of order' ]], 'Should have a comment about the out-of-order change'; is_deeply $engine->seen, [ [run_file => $changes[1]->verify_file ], ], 'The verify script should have been run'; # Make sure that multiple issues add up. $mock_engine->mock( verify_change => sub { hurl 'WTF!' }); is $engine->_verify_changes(1, 0, 0, $changes[1]), 2, 'Verify of a change with 2 issues should return 2'; is_deeply +MockOutput->get_emit_literal, [ [' * users @alpha ..', '', ' '], ], 'Declared output should reflect the verification of the change'; is_deeply +MockOutput->get_emit, [['not ok']], 'Emitted Output should reflect the failure of the verify'; is_deeply +MockOutput->get_comment, [ [__ 'Out of order' ], ['WTF!'], ], 'Should have comment about the out-of-order change and script failure'; is_deeply $engine->seen, [], 'No abstract methods should have been called'; # Make sure that multiple changes with multiple issues add up. $mock_engine->mock( verify_change => sub { hurl 'WTF!' }); is $engine->_verify_changes(0, -1, 0, @changes[0,1]), 4, 'Verify of 2 changes with 2 issues each should return 4'; is_deeply +MockOutput->get_emit_literal, [ [' * roles ..', '.......', ' '], [' * users @alpha ..', '', ' '], ], 'Declraed output should reflect the verification of both changes'; is_deeply +MockOutput->get_emit, [['not ok'], ['not ok']], 'Emitted Output should reflect the failure of both verifies'; is_deeply +MockOutput->get_comment, [ [__ 'Out of order' ], ['WTF!'], [__ 'Out of order' ], ['WTF!'], ], 'Should have comment about the out-of-order changes and script failures'; is_deeply $engine->seen, [], 'No abstract methods should have been called'; # Unmock before moving on. $mock_plan->unmock('index_of'); $mock_engine->unmock('verify_change'); # Now deal with changes in the plan but not in the list. is $engine->_verify_changes($#changes, $plan->count - 1, 0, $changes[-1]), 2, '_verify_changes with two undeployed changes should returne 2'; is_deeply +MockOutput->get_emit_literal, [ [' * dr_evil ..', '', ' '], [' * foo ..', '....', ' ' , 'not ok', ' '], [' * blah ..', '...', ' ' , 'not ok', ' '], ], 'Listed changes should be both deployed and undeployed'; is_deeply +MockOutput->get_emit, [['ok']], 'Emitted Output should reflect 1 pass'; is_deeply +MockOutput->get_comment, [ [__ 'Not deployed' ], [__ 'Not deployed' ], ], 'Should have comments for undeployed changes'; is_deeply $engine->seen, [], 'No abstract methods should have been called'; ############################################################################## # Test verify(). can_ok $engine, 'verify'; my @verify_changes; $mock_engine->mock( _load_changes => sub { @verify_changes }); # First, test with no changes. throws_ok { $engine->verify } 'App::Sqitch::X', 'Should get error for no deployed changes'; is $@->ident, 'verify', 'No deployed changes ident should be "verify"'; is $@->exitval, 1, 'No deployed changes exitval should be 1'; is $@->message, __ 'No changes deployed', 'No deployed changes message should be correct'; is_deeply +MockOutput->get_info, [ [__x 'Verifying {destination}', destination => $engine->destination], ], 'Notification of the verify should be emitted'; # Try no changes *and* nothing in the plan. my $count = 0; $mock_plan->mock(count => sub { $count }); throws_ok { $engine->verify } 'App::Sqitch::X', 'Should get error for no changes'; is $@->ident, 'verify', 'No changes ident should be "verify"'; is $@->exitval, 1, 'No changes exitval should be 1'; is $@->message, __ 'Nothing to verify (no planned or deployed changes)', 'No changes message should be correct'; is_deeply +MockOutput->get_info, [ [__x 'Verifying {destination}', destination => $engine->destination], ], 'Notification of the verify should be emitted'; # Now return some changes but have nothing in the plan. @verify_changes = @changes; throws_ok { $engine->verify } 'App::Sqitch::X', 'Should get error for no planned changes'; is $@->ident, 'verify', 'No planned changes ident should be "verify"'; is $@->exitval, 2, 'No planned changes exitval should be 2'; is $@->message, __ 'There are deployed changes, but none planned!', 'No planned changes message should be correct'; is_deeply +MockOutput->get_info, [ [__x 'Verifying {destination}', destination => $engine->destination], ], 'Notification of the verify should be emitted'; # Let's do one change and have it pass. $mock_plan->mock(index_of => 0); $count = 1; @verify_changes = ($changes[1]); undef $@; ok $engine->verify, 'Verify one change'; is_deeply +MockOutput->get_info, [ [__x 'Verifying {destination}', destination => $engine->destination], ], 'Notification of the verify should be emitted'; is_deeply +MockOutput->get_emit_literal, [ [' * ' . $changes[1]->format_name_with_tags . ' ..', '', ' ' ], ], 'The one change name should be declared'; is_deeply +MockOutput->get_emit, [ ['ok'], [__ 'Verify successful'], ], 'Success should be emitted'; is_deeply +MockOutput->get_comment, [], 'Should have no comments'; # Verify two changes. MockOutput->get_vent; $mock_plan->unmock('index_of'); @verify_changes = @changes[0,1]; ok $engine->verify, 'Verify two changes'; is_deeply +MockOutput->get_info, [ [__x 'Verifying {destination}', destination => $engine->destination], ], 'Notification of the verify should be emitted'; is_deeply +MockOutput->get_emit_literal, [ [' * roles ..', '.......', ' ' ], [' * users @alpha ..', '', ' ' ], ], 'The two change names should be declared'; is_deeply +MockOutput->get_emit, [ ['ok'], ['ok'], [__ 'Verify successful'], ], 'Both successes should be emitted'; is_deeply +MockOutput->get_comment, [], 'Should have no comments'; is_deeply +MockOutput->get_vent, [ [__x( 'Verify script {file} does not exist', file => $changes[0]->verify_file, )] ], 'Should have warning about missing verify script'; # Make sure a reworked change (that is, one with a suffix) is ignored. my $mock_change = Test::MockModule->new(ref $change); $mock_change->mock(is_reworked => 1); @verify_changes = @changes[0,1]; ok $engine->verify, 'Verify with a reworked change changes'; is_deeply +MockOutput->get_info, [ [__x 'Verifying {destination}', destination => $engine->destination], ], 'Notification of the verify should be emitted'; is_deeply +MockOutput->get_emit_literal, [ [' * roles ..', '.......', ' ' ], [' * users @alpha ..', '', ' ' ], ], 'The two change names should be emitted'; is_deeply +MockOutput->get_emit, [ ['ok'], ['ok'], [__ 'Verify successful'], ], 'Both successes should be emitted'; is_deeply +MockOutput->get_comment, [], 'Should have no comments'; is_deeply +MockOutput->get_vent, [], 'Should have no warnings'; $mock_change->unmock('is_reworked'); # Make sure we can trim. @verify_changes = @changes; @resolved = map { $_->id } @changes[1,2]; ok $engine->verify('users', 'widgets'), 'Verify two specific changes'; is_deeply +MockOutput->get_info, [ [__x 'Verifying {destination}', destination => $engine->destination], ], 'Notification of the verify should be emitted'; is_deeply +MockOutput->get_emit_literal, [ [' * users @alpha ..', '.', ' ' ], [' * widgets @beta ..', '', ' ' ], ], 'The two change names should be emitted'; is_deeply +MockOutput->get_emit, [ ['ok'], ['ok'], [__ 'Verify successful'], ], 'Both successes should be emitted'; is_deeply +MockOutput->get_comment, [], 'Should have no comments'; is_deeply +MockOutput->get_vent, [ [__x( 'Verify script {file} does not exist', file => $changes[2]->verify_file, )] ], 'Should have warning about missing verify script'; # Now fail! $mock_engine->mock( verify_change => sub { hurl 'WTF!' }); @verify_changes = @changes; @resolved = map { $_->id } @changes[1,2]; throws_ok { $engine->verify('users', 'widgets') } 'App::Sqitch::X', 'Should get failure for failing verify scripts'; is $@->ident, 'verify', 'Failed verify ident should be "verify"'; is $@->exitval, 2, 'Failed verify exitval should be 2'; is $@->message, __ 'Verify failed', 'Faield verify message should be correct'; is_deeply +MockOutput->get_info, [ [__x 'Verifying {destination}', destination => $engine->destination], ], 'Notification of the verify should be emitted'; my $msg = __ 'Verify Summary Report'; is_deeply +MockOutput->get_emit_literal, [ [' * users @alpha ..', '.', ' ' ], [' * widgets @beta ..', '', ' ' ], ], 'Both change names should be declared'; is_deeply +MockOutput->get_emit, [ ['not ok'], ['not ok'], [ "\n", $msg ], [ '-' x length $msg ], [__x 'Changes: {number}', number => 2 ], [__x 'Errors: {number}', number => 2 ], ], 'Output should include the failure report'; is_deeply +MockOutput->get_comment, [ ['WTF!'], ['WTF!'], ], 'Should have the errors in comments'; is_deeply +MockOutput->get_vent, [], 'Nothing should have been vented'; __END__ diag $_->format_name_with_tags for @changes; diag '======'; diag $_->format_name_with_tags for $plan->changes; App-Sqitch-0.9996/t/engine_cmd.t000644 000767 000024 00000056776 13133201371 016576 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 282; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::Exception; use Test::Dir; use Test::File qw(file_not_exists_ok file_exists_ok); use Test::NoWarnings; use File::Copy; use Path::Class; use File::Temp 'tempdir'; use lib 't/lib'; use MockOutput; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; # Circumvent Config::Gitlike bug on Windows. # https://rt.cpan.org/Ticket/Display.html?id=96670 $ENV{HOME} ||= '~'; my $CLASS = 'App::Sqitch::Command::engine'; ############################################################################## # Set up a test directory and config file. my $tmp_dir = tempdir CLEANUP => 1; File::Copy::copy file(qw(t engine.conf))->stringify, "$tmp_dir" or die "Cannot copy t/engine.conf to $tmp_dir: $!\n"; File::Copy::copy file(qw(t engine sqitch.plan))->stringify, "$tmp_dir" or die "Cannot copy t/engine/sqitch.plan to $tmp_dir: $!\n"; chdir $tmp_dir; $ENV{SQITCH_CONFIG} = 'engine.conf'; my $psql = 'psql' . ($^O eq 'MSWin32' ? '.exe' : ''); ############################################################################## # Load an engine command and test the basics. ok my $sqitch = App::Sqitch->new, 'Load a sqitch sqitch object'; my $config = $sqitch->config; isa_ok my $cmd = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'engine', config => $config, }), $CLASS, 'Engine command'; can_ok $cmd, qw( options configure execute list add set_target set_registry set_client remove rm show update_config ); is_deeply [$CLASS->options], [qw( verbose|v+ target=s plan-file=s registry=s client=s extension=s top-dir=s dir|d=s% )], 'Options should be correct'; # Check default property values. is_deeply $CLASS->configure({}, {}), { properties => {}}, 'Default config should contain empty properties'; # Make sure configure ignores config file. is_deeply $CLASS->configure({ foo => 'bar'}, { verbose => 1 }), { verbose => 1, properties => {} }, 'configure() should ignore config file'; ok my $conf = $CLASS->configure({}, { top_dir => 'top', plan_file => 'my.plan', registry => 'bats', client => 'cli', extension => 'ddl', target => 'db:pg:foo', dir => { deploy => 'dep', revert => 'rev', verify => 'ver', reworked => 'wrk', reworked_deploy => 'rdep', reworked_revert => 'rrev', reworked_verify => 'rver', }, }), 'Get full config'; is_deeply $conf->{properties}, { top_dir => 'top', plan_file => 'my.plan', registry => 'bats', client => 'cli', extension => 'ddl', target => 'db:pg:foo', deploy_dir => 'dep', revert_dir => 'rev', verify_dir => 'ver', reworked_dir => 'wrk', reworked_deploy_dir => 'rdep', reworked_revert_dir => 'rrev', reworked_verify_dir => 'rver', }, 'Should have properties'; isa_ok $conf->{properties}{$_}, 'Path::Class::File', "$_ file attribute" for qw( plan_file ); isa_ok $conf->{properties}{$_}, 'Path::Class::Dir', "$_ directory attribute" for ( 'top_dir', 'reworked_dir', map { ($_, "reworked_$_") } qw(deploy_dir revert_dir verify_dir) ); # Make sure invalid directories are ignored. throws_ok { $CLASS->new($CLASS->configure({}, { dir => { foo => 'bar' }, })) } 'App::Sqitch::X', 'Should fail on invalid directory name'; is $@->ident, 'engine', 'Invalid directory ident should be "engine"'; is $@->message, __x( 'Unknown directory name: {prop}', prop => 'foo', ), 'The invalid directory messsage should be correct'; throws_ok { $CLASS->new($CLASS->configure({}, { dir => { foo => 'bar', cavort => 'ha' }, })) } 'App::Sqitch::X', 'Should fail on invalid directory names'; is $@->ident, 'engine', 'Invalid directories ident should be "engine"'; is $@->message, __x( 'Unknown directory names: {props}', props => 'cavort, foo', ), 'The invalid properties messsage should be correct'; ############################################################################## # Test list(). ok $cmd->list, 'Run list()'; is_deeply +MockOutput->get_emit, [['mysql'], ['pg'], ['sqlite']], 'The list of engines should have been output'; # Make it verbose. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, verbose => 1 }), $CLASS, 'Verbose engine'; ok $cmd->list, 'Run verbose list()'; is_deeply +MockOutput->get_emit, [ ["mysql\tdb:mysql://root@/foo"], ["pg\tdb:pg:try"], ["sqlite\twidgets"] ], 'The list of engines and their targets should have been output'; ############################################################################## # Test add(). MISSINGARGS: { # Test handling of no name. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->add } qr/USAGE/, 'No name arg to add() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should die on existing key. throws_ok { $cmd->add('pg') } 'App::Sqitch::X', 'Should get error for existing engine'; is $@->ident, 'engine', 'Existing engine error ident should be "engine"'; is $@->message, __x( 'Engine "{engine}" already exists', engine => 'pg' ), 'Existing engine error message should be correct'; # Now add a new engine. dir_not_exists_ok $_ for qw(deploy revert verify); ok $cmd->add('vertica'), 'Add engine "vertica"'; dir_exists_ok $_ for qw(deploy revert verify); $config->load; is $config->get(key => 'engine.vertica.target'), 'db:vertica:', 'Engine "test" target should have been set'; for my $key (qw( client registry top_dir plan_file deploy_dir revert_dir verify_dir extension )) { is $config->get(key => "engine.test.$key"), undef, qq{Engine "test" should have no $key set}; } # Should die on target that doesn't match the engine. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { target => 'db:sqlite:' }, }), $CLASS, 'Engine with target property'; throws_ok { $cmd->add('firebird' ) } 'App::Sqitch::X', 'Should get error for engine/target mismatch'; is $@->ident, 'engine', 'Target mismatch ident should be "engine"'; is $@->message, __x( 'Cannot assign URI using engine "{new}" to engine "{old}"', new => 'sqlite', old => 'firebird', ), 'Target mismatch message should be correct'; # Try all the properties. my %props = ( target => 'db:firebird:foo', client => 'poo', registry => 'reg', top_dir => dir('top'), plan_file => file('my.plan'), deploy_dir => dir('dep'), revert_dir => dir('rev'), verify_dir => dir('ver'), reworked_dir => dir('r'), reworked_deploy_dir => dir('r/d'), extension => 'ddl', ); isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { %props }, }), $CLASS, 'Engine with all properties'; file_not_exists_ok 'my.plan'; dir_not_exists_ok dir $_ for qw(top/deploy top/revert top/verify r/d r/revert r/verify); ok $cmd->add('firebird'), 'Add engine "firebird"'; dir_exists_ok dir $_ for qw(top/deploy top/revert top/verify r/d r/revert r/verify); file_exists_ok 'my.plan'; $config->load; while (my ($k, $v) = each %props) { is $config->get(key => "engine.firebird.$k"), $v, qq{Engine "firebird" should have $k set}; } ############################################################################## # Test alter(). isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, }), $CLASS, 'Engine with no properties'; MISSINGARGS: { # Test handling of no name. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->alter } qr/USAGE/, 'No name arg to add() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } throws_ok { $cmd->alter('nonexistent' ) } 'App::Sqitch::X', 'Should get error from alter for nonexistent engine'; is $@->ident, 'engine', 'Nonexistent engine error ident should be "engine"'; is $@->message, __x( 'Unknown engine "{engine}"', engine => 'nonexistent' ), 'Nonexistent engine error message should be correct'; # Should die on missing key. throws_ok { $cmd->alter('oracle') } 'App::Sqitch::X', 'Should get error for missing engine'; is $@->ident, 'engine', 'Missing engine error ident should be "engine"'; is $@->message, __x( 'Missing Engine "{engine}"; use "{command}" to add it', engine => 'oracle', command => 'add oracle db:oracle:', ), 'Missing engine error message should be correct'; # Try all the properties. %props = ( target => 'db:firebird:bar', client => 'argh', registry => 'migrations', top_dir => dir('fb'), plan_file => file('fb.plan'), deploy_dir => dir('fb/dep'), revert_dir => dir('fb/rev'), verify_dir => dir('fb/ver'), reworked_dir => dir('fb/r'), reworked_deploy_dir => dir('fb/r/d'), extension => 'fbsql', ); isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { %props }, }), $CLASS, 'Engine with more properties'; ok $cmd->alter('firebird'), 'Alter engine "firebird"'; $config->load; while (my ($k, $v) = each %props) { is $config->get(key => "engine.firebird.$k"), $v, qq{Engine "firebird" should have $k set}; } # Try changing the top directory. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { top_dir => dir 'pg' }, }), $CLASS, 'Engine with new top_dir property'; dir_not_exists_ok dir $_ for qw(pg pg/deploy pg/revert pg/verify); ok $cmd->alter('pg'), 'Alter engine "pg"'; dir_exists_ok dir $_ for qw(pg pg/deploy pg/revert pg/verify); $config->load; is $config->get(key => 'engine.pg.top_dir'), 'pg', 'The pg top_dir should have been set'; # An attempt to alter a missing engine should show the target if in props. throws_ok { $cmd->alter('oracle') } 'App::Sqitch::X', 'Should again get error for missing engine'; is $@->ident, 'engine', 'Missing engine error ident should still be "engine"'; is $@->message, __x( 'Missing Engine "{engine}"; use "{command}" to add it', engine => 'oracle', command => 'add oracle db:oracle:', ), 'Missing engine error message should include target property'; # Should die on target mismatch engine. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { target => 'db:sqlite:' }, }), $CLASS, 'Engine with target property'; throws_ok { $cmd->alter('firebird' ) } 'App::Sqitch::X', 'Should get error for engine/target mismatch'; is $@->ident, 'engine', 'Target mismatch ident should be "engine"'; is $@->message, __x( 'Cannot assign URI using engine "{new}" to engine "{old}"', new => 'sqlite', old => 'firebird', ), 'Target mismatch message should be correct'; ############################################################################## # Test set_target(). MISSINGARGS: { # Test handling of no name. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->set_target } qr/USAGE/, 'No name arg to set_target() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; @args = (); throws_ok { $cmd->set_target('foo') } qr/USAGE/, 'No target arg to set_target() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should get an error if the engine does not exist. throws_ok { $cmd->set_target('nonexistent', 'db:pg:' ) } 'App::Sqitch::X', 'Should get error for nonexistent engine'; is $@->ident, 'engine', 'Nonexistent engine error ident should be "engine"'; is $@->message, __x( 'Unknown engine "{engine}"', engine => 'nonexistent' ), 'Nonexistent engine error message should be correct'; # Set one that exists. ok $cmd->set_target('pg', 'db:pg:newtarget'), 'Set new target'; $config->load; is $config->get(key => 'engine.pg.target'), 'db:pg:newtarget', 'Engine "pg" should have new target'; # Make sure the target is a database target. ok $cmd->set_target('pg', 'postgres:stuff'), 'Set new target'; $config->load; is $config->get(key => 'engine.pg.target'), 'db:postgres:stuff', 'Engine "pg" should have new DB target'; # Make sure we die for an unknown target. throws_ok { $cmd->set_target('pg', 'unknown') } 'App::Sqitch::X', 'Should get an error for an unknown target'; is $@->ident, 'engine', 'Nonexistent target error ident should be "engine"'; is $@->message, __x( 'Unknown target "{target}"', target => 'unknown' ), 'Nonexistent target error message should be correct'; ############################################################################## # Test other set_* methods for my $key (keys %props) { next if $key =~ /^reworked/; my $meth = "set_$key"; MISSINGARGS: { # Test handling of no name. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->$meth } qr/USAGE/, "No name arg to $meth() should yield usage"; is_deeply \@args, [$cmd], 'No args should be passed to usage'; @args = (); throws_ok { $cmd->$meth('foo') } qr/USAGE/, "No $key arg to $meth() should yield usage"; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should get an error if the engine does not exist. throws_ok { $cmd->$meth('nonexistent', 'widgets' ) } 'App::Sqitch::X', 'Should get error for nonexistent engine'; is $@->ident, 'engine', 'Nonexistent engine error ident should be "engine"'; is $@->message, __x( 'Unknown engine "{engine}"', engine => 'nonexistent' ), 'Nonexistent engine error message should be correct'; # Set one that exists. ok $cmd->$meth('pg', 'widgets'), 'Set new $key'; $config->load; is $config->get(key => "engine.pg.$key"), 'widgets', qq{Engine "pg" should have new $key}; } ############################################################################## # Test remove. MISSINGARGS: { # Test handling of no names. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->remove } qr/USAGE/, 'No name args to remove() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should get an error if the engine does not exist. throws_ok { $cmd->remove('nonexistent', 'existant' ) } 'App::Sqitch::X', 'Should get error for nonexistent engine'; is $@->ident, 'engine', 'Nonexistent engine error ident should be "engine"'; is $@->message, __x( 'Unknown engine "{engine}"', engine => 'nonexistent' ), 'Nonexistent engine error message should be correct'; # Remove one that exists. ok $cmd->remove('mysql'), 'Remove'; $config->load; is $config->get(key => "engine.mysql.target"), undef, qq{Engine "mysql" should now be gone}; ############################################################################## # Test show. ok $cmd->show, 'Run show()'; is_deeply +MockOutput->get_emit, [ ['firebird'], ['pg'], ['sqlite'], ['vertica'] ], 'Show with no names should emit the list of engines'; # Try one engine. ok $cmd->show('sqlite'), 'Show sqlite'; is_deeply +MockOutput->get_emit, [ ['* sqlite'], [' ', 'Target: ', 'widgets'], [' ', 'Registry: ', 'sqitch'], [' ', 'Client: ', '/usr/sbin/sqlite3'], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'foo.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ], 'The full "sqlite" engine should have been shown'; # Try multiples. ok $cmd->set_client(vertica => 'vsql.exe'), 'Set vertica client'; $config->load; ok $cmd->show(qw(sqlite vertica firebird)), 'Show three engines'; is_deeply +MockOutput->get_emit, [ ['* sqlite'], [' ', 'Target: ', 'widgets'], [' ', 'Registry: ', 'sqitch'], [' ', 'Client: ', '/usr/sbin/sqlite3'], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'foo.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ['* vertica'], [' ', 'Target: ', 'db:vertica:'], [' ', 'Registry: ', 'sqitch'], [' ', 'Client: ', 'vsql.exe'], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'sqitch.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ['* firebird'], [' ', 'Target: ', 'db:firebird:bar'], [' ', 'Registry: ', 'migrations'], [' ', 'Client: ', 'argh'], [' ', 'Top Directory: ', 'fb'], [' ', 'Plan File: ', 'fb.plan'], [' ', 'Extension: ', 'fbsql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', dir 'fb/dep'], [' ', ' Revert: ', dir 'fb/rev'], [' ', ' Verify: ', dir 'fb/ver'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', dir 'fb/r'], [' ', ' Deploy: ', dir 'fb/r/d'], [' ', ' Revert: ', dir 'fb/r/revert'], [' ', ' Verify: ', dir 'fb/r/verify'], ], 'All three engines should have been shown'; ############################################################################## # Test execute(). isa_ok $cmd = $CLASS->new({ sqitch => $sqitch }), $CLASS, 'Simple engine'; for my $spec ( [ undef, 'list' ], [ 'list' ], [ 'add' ], [ 'set-target' ], [ 'set-registry' ], [ 'set-client' ], [ 'remove' ], [ 'rm', 'remove' ], [ 'rename' ], [ 'show' ], ) { my ($arg, $meth) = @{ $spec }; $meth //= $arg; $meth =~ s/-/_/g; my $mocker = Test::MockModule->new($CLASS); my @args; $mocker->mock($meth => sub { @args = @_ }); ok $cmd->execute($spec->[0]), "Execute " . ($spec->[0] // 'undef'); is_deeply \@args, [$cmd], "$meth() should have been called"; # Make sure args are passed. ok $cmd->execute($spec->[0], qw(pg db:pg:)), "Execute " . ($spec->[0] // 'undef') . ' with args'; is_deeply \@args, [$cmd, qw(pg db:pg:)], "$meth() should have been passed args"; } # Make sure an invalid action dies with a usage statement. MISSINGARGS: { # Test handling of no names. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->execute('nonexistent') } qr/USAGE/, 'Should get an exception for a nonexistent action'; is_deeply \@args, [$cmd, __x( 'Unknown action "{action}"', action => 'nonexistent', )], 'Nonexistent action message should be passed to usage'; } ############################################################################## # Test update_config. $config->group_set($config->local_file, [ {key => 'core.mysql.target', value => 'widgets' }, {key => 'core.mysql.client', value => 'mysql.exe' }, {key => 'core.mysql.registry', value => 'spliff' }, {key => 'core.mysql.host', value => 'localhost' }, {key => 'core.mysql.port', value => 1234 }, {key => 'core.mysql.username', value => 'fred' }, {key => 'core.mysql.password', value => 'barb' }, {key => 'core.mysql.db_name', value => 'ouch' }, ]); $cmd->sqitch->config->load; my $core = $cmd->sqitch->config->get_section(section => 'core.mysql'); ok $cmd->update_config, 'Update the config'; $cmd->sqitch->config->load; is_deeply $cmd->sqitch->config->get_section(section => 'core.mysql'), $core, 'The core.mysql config should still be present'; is_deeply $cmd->sqitch->config->get_section(section => 'engine.mysql'), { target => 'widgets', client => 'mysql.exe', registry => 'spliff', }, 'MySQL config should have been rewritten without deprecated keys'; # Try with no target. $config->rename_section( from => 'engine.mysql', filename => $config->local_file, ); $config->group_set($config->local_file, [ {key => 'core.mysql.target', value => undef }, {key => 'core.mysql.client', value => 'mysql.exe' }, {key => 'core.mysql.registry', value => 'spliff' }, {key => 'core.mysql.host', value => 'localhost' }, {key => 'core.mysql.port', value => 1234 }, {key => 'core.mysql.username', value => 'fred' }, {key => 'core.mysql.password', value => 'barb' }, {key => 'core.mysql.db_name', value => 'ouch' }, ]); $cmd->sqitch->config->load; $core = $cmd->sqitch->config->get_section(section => 'core.mysql'); ok $cmd->update_config, 'Update the config again'; $cmd->sqitch->config->load; is_deeply $cmd->sqitch->config->get_section(section => 'core.mysql'), $core, 'The core.mysql config should again remain'; is_deeply $cmd->sqitch->config->get_section(section => 'engine.mysql'), { target => 'db:mysql://fred:barb@localhost:1234/ouch', client => 'mysql.exe', registry => 'spliff', }, 'MySQL config should have been rewritten with an integrated target'; # Try with no deprecated keys. $config->rename_section( from => 'engine.mysql', filename => $config->local_file, ); $config->group_set($config->local_file, [ {key => 'core.mysql.client', value => 'mysql.exe' }, {key => 'core.mysql.registry', value => 'spliff' }, {key => 'core.mysql.host', value => undef }, {key => 'core.mysql.port', value => undef }, {key => 'core.mysql.username', value => undef }, {key => 'core.mysql.password', value => undef }, {key => 'core.mysql.db_name', value => undef }, ]); $cmd->sqitch->config->load; $core = $cmd->sqitch->config->get_section(section => 'core.mysql'); ok $cmd->update_config, 'Update the config again'; $cmd->sqitch->config->load; is_deeply $cmd->sqitch->config->get_section(section => 'core.mysql'), $core, 'The core.mysql config should again remain'; is_deeply $cmd->sqitch->config->get_section(section => 'engine.mysql'), { target => 'db:mysql:', client => 'mysql.exe', registry => 'spliff', }, 'MySQL config should have been rewritten with a default target'; App-Sqitch-0.9996/t/firebird.t000644 000767 000024 00000032454 13133201371 016257 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w # # Made after sqlite.t and mysql.t # use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use App::Sqitch::Target; use Test::MockModule; use Path::Class; use Try::Tiny; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use File::Spec::Functions; use File::Temp 'tempdir'; use lib 't/lib'; use DBIEngineTest; my $CLASS; my $user; my $pass; my $tmpdir; my $have_fb_driver = 1; # assume DBD::Firebird is installed and so is Firebird my $live_testing = 0; # Is DBD::Firebird realy installed? try { require DBD::Firebird; } catch { $have_fb_driver = 0; }; BEGIN { $CLASS = 'App::Sqitch::Engine::firebird'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.sys'; $user = $ENV{ISC_USER} || $ENV{DBI_USER} || 'SYSDBA'; $pass = $ENV{ISC_PASSWORD} || $ENV{DBI_PASS} || 'masterkey'; $tmpdir = File::Spec->tmpdir(); delete $ENV{ISC_PASSWORD}; } is_deeply [$CLASS->config_vars], [ target => 'any', registry => 'any', client => 'any', ], 'config_vars should return three vars'; my $sqitch = App::Sqitch->new(options => { engine => 'firebird' }); my $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI->new('db:firebird:foo.fdb'), ); isa_ok my $fb = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS; my $have_fb_client; if ($have_fb_driver && (my $client = try { $fb->client })) { $have_fb_client = 1; like $client, qr/isql|fbsql|isql-fb/, 'client should default to isql | fbsql | isql-fb'; } is $fb->uri->dbname, file('foo.fdb'), 'dbname should be filled in'; is $fb->registry_uri->dbname, 'sqitch.fdb', 'registry dbname should be "sqitch.fdb"'; is $fb->registry_destination, $fb->registry_uri->as_string, 'registry_destination should be the same as registry URI'; my @std_opts = ( '-quiet', '-bail', '-sqldialect' => '3', '-pagelength' => '16384', '-charset' => 'UTF8', ); my $dbname = $fb->connection_string($fb->uri); is_deeply([$fb->isql], [$fb->client, @std_opts, $dbname], 'isql command should be std opts-only') if $have_fb_client; isa_ok $fb = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS; ok $fb->set_variables(foo => 'baz', whu => 'hi there', yo => 'stellar'), 'Set some variables'; is_deeply([$fb->isql], [$fb->client, @std_opts, $dbname], 'isql command should be std opts-only') if $have_fb_client; ############################################################################## # Make sure config settings override defaults. my %config = ( 'engine.firebird.client' => '/path/to/isql', 'engine.firebird.target' => 'db:firebird://freddy:s3cr3t@db.example.com:1234/widgets', 'engine.firebird.registry' => 'meta', ); my $mock_config = Test::MockModule->new('App::Sqitch::Config'); $mock_config->mock(get => sub { $config{ $_[2] } }); $sqitch = App::Sqitch->new(options => { engine => 'firebird' }); $target = App::Sqitch::Target->new(sqitch => $sqitch); ok $fb = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another firebird'; is $fb->client, '/path/to/isql', 'client should be as configured'; is $fb->uri, URI::db->new('db:firebird://freddy:s3cr3t@db.example.com:1234/widgets'), 'URI should be as configured'; like $fb->destination, qr{db:firebird://freddy:?\@db.example.com:1234/widgets}, 'destination should default to URI without password'; like $fb->registry_destination, qr{db:firebird://freddy:?\@db.example.com:1234/meta}, 'registry_destination should be URI with configured registry and no password'; is_deeply [$fb->isql], [( '/path/to/isql', '-user', 'freddy', '-password', 's3cr3t', ), @std_opts, 'db.example.com/1234:widgets'], 'firebird command should be configured'; ############################################################################## # Now make sure that Sqitch options override configurations. $sqitch = App::Sqitch->new(options => { engine => 'firebird', client => '/some/other/isql', registry => 'meta', }); $target = App::Sqitch::Target->new(sqitch => $sqitch); ok $fb = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a firebird with sqitch with options'; is $fb->client, '/some/other/isql', 'client should be as optioned'; is $fb->registry_uri, URI::db->new('db:firebird://freddy:s3cr3t@db.example.com:1234/meta'), 'Registry URI should include --registry value.'; is_deeply [$fb->isql], [( '/some/other/isql', '-user', 'freddy', '-password', 's3cr3t', ), @std_opts, 'db.example.com/1234:widgets'], 'isql command should be as optioned'; ############################################################################## # Test connection_string. can_ok $fb, 'connection_string'; for my $file (qw( foo.fdb /blah/hi.fdb C:/blah/hi.fdb )) { # DB name only. is $fb->connection_string( URI::db->new("db:firebird:$file") ), $file, "Connection for db:firebird:$file"; # DB name and host. is $fb->connection_string( URI::db->new("db:firebird:foo.com/$file") ), "foo.com/$file", "Connection for db:firebird:foo.com/$file"; # DB name, host, and port is $fb->connection_string( URI::db->new("db:firebird:foo.com:1234/$file") ), "foo.com:1234/$file", "Connection for db:firebird:foo.com/$file:1234"; } throws_ok { $fb->connection_string( URI::db->new('db:firebird:') ) } 'App::Sqitch::X', 'Should get an exception for no db name'; is $@->ident, 'firebird', 'No dbname exception ident should be "firebird"'; is $@->message, __x( 'Database name missing in URI {uri}', uri => 'db:firebird:', ), 'No dbname exception message should be correct'; ############################################################################## # Test _run(), _capture(), and _spool(). can_ok $fb, qw(_run _capture _spool); my $mock_sqitch = Test::MockModule->new('App::Sqitch'); my (@run, $exp_pass); $mock_sqitch->mock(run => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @run = @_; if (defined $exp_pass) { is $ENV{ISC_PASSWORD}, $exp_pass, qq{ISC_PASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{ISC_PASSWORD}, 'ISC_PASSWORD should not exist'; } }); my @capture; $mock_sqitch->mock(capture => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @capture = @_; if (defined $exp_pass) { is $ENV{ISC_PASSWORD}, $exp_pass, qq{ISC_PASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{ISC_PASSWORD}, 'ISC_PASSWORD should not exist'; } }); my @spool; $mock_sqitch->mock(spool => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @spool = @_; if (defined $exp_pass) { is $ENV{ISC_PASSWORD}, $exp_pass, qq{ISC_PASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{ISC_PASSWORD}, 'ISC_PASSWORD should not exist'; } }); $exp_pass = 's3cr3t'; $target->uri->password($exp_pass); ok $fb->_run(qw(foo bar baz)), 'Call _run'; is_deeply \@run, [$fb->isql, qw(foo bar baz)], 'Command should be passed to run()'; ok $fb->_spool('FH'), 'Call _spool'; is_deeply \@spool, ['FH', $fb->isql], 'Command should be passed to spool()'; ok $fb->_capture(qw(foo bar baz)), 'Call _capture'; is_deeply \@capture, [$fb->isql, qw(foo bar baz)], 'Command should be passed to capture()'; # Without password. $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok $fb = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a firebird with sqitch with no pw'; $exp_pass = undef; $target->uri->password($exp_pass); ok $fb->_run(qw(foo bar baz)), 'Call _run again'; is_deeply \@run, [$fb->isql, qw(foo bar baz)], 'Command should be passed to run() again'; ok $fb->_spool('FH'), 'Call _spool again'; is_deeply \@spool, ['FH', $fb->isql], 'Command should be passed to spool() again'; ok $fb->_capture(qw(foo bar baz)), 'Call _capture again'; is_deeply \@capture, [$fb->isql, qw(foo bar baz)], 'Command should be passed to capture() again'; ############################################################################## # Test file and handle running. ok $fb->run_file('foo/bar.sql'), 'Run foo/bar.sql'; is_deeply \@run, [$fb->isql, '-input', 'foo/bar.sql'], 'File should be passed to run()'; ok $fb->run_handle('FH'), 'Spool a "file handle"'; is_deeply \@spool, ['FH', $fb->isql], 'Handle should be passed to spool()'; # Verify should go to capture unless verosity is > 1. ok $fb->run_verify('foo/bar.sql'), 'Verify foo/bar.sql'; is_deeply \@capture, [$fb->isql, '-input', 'foo/bar.sql'], 'Verify file should be passed to capture()'; $mock_sqitch->mock(verbosity => 2); ok $fb->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again'; is_deeply \@run, [$fb->isql, '-input', 'foo/bar.sql'], 'Verify file should be passed to run() for high verbosity'; $mock_sqitch->unmock_all; $mock_config->unmock_all; ############################################################################## # Test DateTime formatting stuff. can_ok $CLASS, '_ts2char_format'; is sprintf($CLASS->_ts2char_format, 'foo'), q{'year:' || CAST(EXTRACT(YEAR FROM foo) AS SMALLINT) || ':month:' || CAST(EXTRACT(MONTH FROM foo) AS SMALLINT) || ':day:' || CAST(EXTRACT(DAY FROM foo) AS SMALLINT) || ':hour:' || CAST(EXTRACT(HOUR FROM foo) AS SMALLINT) || ':minute:' || CAST(EXTRACT(MINUTE FROM foo) AS SMALLINT) || ':second:' || FLOOR(CAST(EXTRACT(SECOND FROM foo) AS NUMERIC(9,4))) || ':time_zone:UTC'}, '_ts2char_format should work'; # WORKS! :) ok my $dtfunc = $CLASS->can('_dt'), "$CLASS->can('_dt')"; isa_ok my $dt = $dtfunc->( 'year:2012:month:07:day:05:hour:15:minute:07:second:01:time_zone:UTC' ), 'App::Sqitch::DateTime', 'Return value of _dt()'; is $dt->year, 2012, 'DateTime year should be set'; is $dt->month, 7, 'DateTime month should be set'; is $dt->day, 5, 'DateTime day should be set'; is $dt->hour, 15, 'DateTime hour should be set'; is $dt->minute, 7, 'DateTime minute should be set'; is $dt->second, 1, 'DateTime second should be set'; is $dt->time_zone->name, 'UTC', 'DateTime TZ should be set'; ############################################################################## # Can we do live tests? END { return unless $live_testing; return unless $have_fb_driver; foreach my $dbname (qw{__sqitchtest__ __sqitchtest __metasqitch}) { my $dbpath = catfile($tmpdir, $dbname); next unless -f $dbpath; my $dsn = qq{dbi:Firebird:dbname=$dbpath;host=localhost;port=3050}; $dsn .= q{;ib_dialect=3;ib_charset=UTF8}; my $dbh = DBI->connect( $dsn, $user, $pass, { FetchHashKeyName => 'NAME_lc', AutoCommit => 1, RaiseError => 0, PrintError => 0, } ) or die $DBI::errstr; $dbh->{Driver}->visit_child_handles( sub { my $h = shift; $h->disconnect if $h->{Type} eq 'db' && $h->{Active} && $h ne $dbh; } ); my $res = $dbh->selectall_arrayref( q{ SELECT MON$USER FROM MON$ATTACHMENTS } ); if (@{$res} > 1) { # Do we have more than 1 active connections? warn " Another active connection detected, can't DROP DATABASE!\n"; } else { $dbh->func('ib_drop_database') or warn "Error dropping test database '$dbname': $DBI::errstr"; } } } my $dbpath = catfile($tmpdir, '__sqitchtest__'); my $err = try { require DBD::Firebird; DBD::Firebird->create_database( { db_path => $dbpath, user => $user, password => $pass, character_set => 'UTF8', page_size => 16384, } ); undef; } catch { eval { $_->message } || $_; }; my $uri = URI::db->new("db:firebird://$user:$pass\@localhost/$dbpath"); DBIEngineTest->run( class => $CLASS, sqitch_params => [options => { _engine => 'firebird', top_dir => Path::Class::dir(qw(t engine))->stringify, plan_file => Path::Class::file(qw(t engine sqitch.plan))->stringify, }], target_params => [ uri => $uri, registry => catfile($tmpdir, '__metasqitch') ], alt_target_params => [ uri => $uri, registry => catfile($tmpdir, '__sqitchtest') ], skip_unless => sub { my $self = shift; die $err if $err; # Make sure we have the right isql and can connect to the # database. Adapted from the FirebirdMaker.pm module of # DBD::Firebird. my $cmd = $self->client; my $cmd_echo = qx(echo "quit;" | "$cmd" -z -quiet 2>&1 ); return 0 unless $cmd_echo =~ m{Firebird}ims; # Skip if no DBD::Firebird. return 0 unless $have_fb_driver; $live_testing = 1; }, engine_err_regex => qr/\QDynamic SQL Error\E/xms, init_error => __x( 'Sqitch database {database} already initialized', database => catfile($tmpdir, '__sqitchtest'), ), add_second_format => q{dateadd(1 second to %s)}, test_dbh => sub { my $dbh = shift; # Check the session configuration... # To try: http://www.firebirdsql.org/refdocs/langrefupd21-intfunc-get_context.html }, ); done_testing; App-Sqitch-0.9996/t/help.t000644 000767 000024 00000004213 13133201371 015411 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 15; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::Exception; use Config; use File::Spec; use Test::MockModule; use Test::NoWarnings; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::Command::help'; ok my $sqitch = App::Sqitch->new, 'Load a sqitch sqitch object'; my $config = App::Sqitch::Config->new; isa_ok my $help = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'help', config => $config, }), $CLASS, 'Load help command'; my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(_pod2usage => sub { @args = @_} ); ok $help->execute, 'Execute help'; is_deeply \@args, [ $help, '-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitchcommands'), '-verbose' => 2, '-exitval' => 0, ], 'Should show sqitch app docs'; ok $help->execute('config'), 'Execute "config" help'; is_deeply \@args, [ $help, '-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch-config'), '-verbose' => 2, '-exitval' => 0, ], 'Should show "config" command docs'; ok $help->execute('changes'), 'Execute "changes" help'; is_deeply \@args, [ $help, '-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitchchanges'), '-verbose' => 2, '-exitval' => 0, ], 'Should show "changes" command docs'; ok $help->execute('tutorial'), 'Execute "tutorial" help'; is_deeply \@args, [ $help, '-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitchtutorial'), '-verbose' => 2, '-exitval' => 0, ], 'Should show "tutorial" command docs'; my @fail; $mock->mock(fail => sub { @fail = @_ }); throws_ok { $help->execute('nonexistent') } 'App::Sqitch::X', 'Should get an exception for "nonexistent" help'; is $@->ident, 'help', 'Exception ident should be "help"'; is $@->message, __x( 'No manual entry for {command}', command => 'sqitch-nonexistent', ), 'Should get failure message for nonexistent command'; is $@->exitval, 1, 'Exception exit val should be 1'; App-Sqitch-0.9996/t/init.t000644 000767 000024 00000056005 13133201371 015432 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 187; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Path::Class; use Test::Dir; use Test::File qw(file_not_exists_ok file_exists_ok); use Test::Exception; use Test::File::Contents; use Test::NoWarnings; use File::Path qw(remove_tree make_path); use URI; use lib 't/lib'; use MockOutput; my $exe_ext = $^O eq 'MSWin32' ? '.exe' : ''; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Command::init'; use_ok $CLASS or die; } isa_ok $CLASS, 'App::Sqitch::Command', $CLASS; chdir 't'; sub read_config($) { my $conf = App::Sqitch::Config->new; $conf->load_file(shift); $conf->data; } $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; ############################################################################## # Test options and configuration. my $sqitch = App::Sqitch->new( options => { top_dir => dir('init.mkdir') }, ); isa_ok my $init = $CLASS->new( sqitch => $sqitch, properties => { reworked_dir => dir('init.mkdir/reworked') }, ), $CLASS, 'New init object'; can_ok $init, qw( uri properties options configure ); is_deeply [$init->options], [qw( uri=s engine=s target=s plan-file=s registry=s client=s extension=s top-dir=s dir|d=s% )], 'Options should be correct'; is_deeply $CLASS->configure({}, {}), { properties => {}}, 'Default config should contain empty properties'; is_deeply $CLASS->configure({}, { uri => 'http://example.com' }), { uri => URI->new('http://example.com'), properties => {}, }, 'Should accept a URI in options'; ok my $config = $CLASS->configure({}, { uri => 'http://example.com', engine => 'pg', top_dir => 'top', plan_file => 'my.plan', registry => 'bats', client => 'cli', extension => 'ddl', target => 'db:pg:foo', dir => { deploy => 'dep', revert => 'rev', verify => 'ver', reworked => 'wrk', reworked_deploy => 'rdep', reworked_revert => 'rrev', reworked_verify => 'rver', }, }), 'Get full config'; isa_ok $config->{uri}, 'URI', 'uri propertiy'; is_deeply $config->{properties}, { engine => 'pg', top_dir => 'top', plan_file => 'my.plan', registry => 'bats', client => 'cli', extension => 'ddl', target => 'db:pg:foo', deploy_dir => 'dep', revert_dir => 'rev', verify_dir => 'ver', reworked_dir => 'wrk', reworked_deploy_dir => 'rdep', reworked_revert_dir => 'rrev', reworked_verify_dir => 'rver', }, 'Should have properties'; isa_ok $config->{properties}{$_}, 'Path::Class::File', "$_ file attribute" for qw( plan_file ); isa_ok $config->{properties}{$_}, 'Path::Class::Dir', "$_ directory attribute" for ( 'top_dir', 'reworked_dir', map { ($_, "reworked_$_") } qw(deploy_dir revert_dir verify_dir) ); # Make sure invalid directories are ignored. throws_ok { $CLASS->new($CLASS->configure({}, { dir => { foo => 'bar' }, })) } 'App::Sqitch::X', 'Should fail on invalid directory name'; is $@->ident, 'init', 'Invalid directory ident should be "init"'; is $@->message, __x( 'Unknown directory name: {prop}', prop => 'foo', ), 'The invalid directory messsage should be correct'; throws_ok { $CLASS->new($CLASS->configure({}, { dir => { foo => 'bar', cavort => 'ha' }, })) } 'App::Sqitch::X', 'Should fail on invalid directory names'; is $@->ident, 'init', 'Invalid directories ident should be "init"'; is $@->message, __x( 'Unknown directory names: {props}', props => 'cavort, foo', ), 'The invalid properties messsage should be correct'; isa_ok my $target = $init->default_target, 'App::Sqitch::Target', 'default target'; ############################################################################## # Test make_directories_for. can_ok $init, 'make_directories_for'; dir_not_exists_ok $target->top_dir; dir_not_exists_ok $_ for $init->directories_for($target); my $top_dir_string = $target->top_dir->stringify; END { remove_tree $top_dir_string if -e $top_dir_string } ok $init->make_directories_for($target), 'Make the directories'; dir_exists_ok $_ for $init->directories_for($target); my $sep = dir('')->stringify; my $dirs = $init->properties; is_deeply +MockOutput->get_info, [ [__x "Created {file}", file => $target->deploy_dir . $sep], [__x "Created {file}", file => $target->revert_dir . $sep], [__x "Created {file}", file => $target->verify_dir . $sep], [__x "Created {file}", file => $dirs->{reworked_dir}->subdir('deploy') . $sep], [__x "Created {file}", file => $dirs->{reworked_dir}->subdir('revert') . $sep], [__x "Created {file}", file => $dirs->{reworked_dir}->subdir('verify') . $sep], ], 'Each should have been sent to info'; # Do it again. ok $init->make_directories_for($target), 'Make the directories again'; is_deeply +MockOutput->get_info, [], 'Nothing should have been sent to info'; # Delete one of them. remove_tree $target->revert_dir->stringify; ok $init->make_directories_for($target), 'Make the directories once more'; dir_exists_ok $target->revert_dir, 'revert dir exists again'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $target->revert_dir . $sep], ], 'Should have noted creation of revert dir'; remove_tree $top_dir_string; # Handle errors. FSERR: { # Make mkpath to insert an error. my $mock = Test::MockModule->new('File::Path'); $mock->mock( mkpath => sub { my ($file, $p) = @_; ${ $p->{error} } = [{ $file => 'Permission denied yo'}]; return; }); throws_ok { $init->make_directories_for($target) } 'App::Sqitch::X', 'Should fail on permission issue'; is $@->ident, 'init', 'Permission error should have ident "init"'; is $@->message, __x( 'Error creating {path}: {error}', path => $target->deploy_dir, error => 'Permission denied yo', ), 'The permission error should be formatted properly'; } ############################################################################## # Test write_config(). can_ok $init, 'write_config'; my $write_dir = 'init.write'; make_path $write_dir; END { remove_tree $write_dir } chdir $write_dir; END { chdir File::Spec->updir } my $conf_file = $sqitch->config->local_file; my $uri = URI->new('https://github.com/theory/sqitch/'); $sqitch = App::Sqitch->new; ok $init = $CLASS->new( sqitch => $sqitch, ), 'Another init object'; file_not_exists_ok $conf_file; $target = $init->default_target; # Write empty config. ok $init->write_config, 'Write the config'; file_exists_ok $conf_file; is_deeply read_config $conf_file, { }, 'The configuration file should have no variables'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info'; my $top_dir = File::Spec->curdir; my $deploy_dir = File::Spec->catdir(qw(deploy)); my $revert_dir = File::Spec->catdir(qw(revert)); my $verify_dir = File::Spec->catdir(qw(verify)); my $plan_file = $target->top_dir->file('sqitch.plan')->cleanup->stringify; file_contents_like $conf_file, qr{\Q[core] # engine = # plan_file = $plan_file # top_dir = $top_dir }m, 'All in core section should be commented-out'; unlink $conf_file; # Set two options. $sqitch = App::Sqitch->new; ok $init = $CLASS->new( sqitch => $sqitch, properties => { extension => 'foo' } ), 'Another init object'; $target = $init->default_target; ok $init->write_config, 'Write the config'; file_exists_ok $conf_file; is_deeply read_config $conf_file, { 'core.extension' => 'foo', }, 'The configuration should have been written with the one setting'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info'; file_contents_like $conf_file, qr{ # engine = # plan_file = $plan_file # top_dir = $top_dir }m, 'Other settings should be commented-out'; # Go again. ok $init->write_config, 'Write the config again'; is_deeply read_config $conf_file, { 'core.extension' => 'foo', }, 'The configuration should be unchanged'; is_deeply +MockOutput->get_info, [ ], 'Nothing should have been sent to info'; USERCONF: { # Delete the file and write with a user config loaded. unlink $conf_file; local $ENV{SQITCH_USER_CONFIG} = file +File::Spec->updir, 'user.conf'; my $sqitch = App::Sqitch->new; ok my $init = $CLASS->new( sqitch => $sqitch, properties => { extension => 'foo' }), 'Make an init object with user config'; file_not_exists_ok $conf_file; ok $init->write_config, 'Write the config with a user conf'; file_exists_ok $conf_file; is_deeply read_config $conf_file, { 'core.extension' => 'foo', }, 'The configuration should just have core.top_dir'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info again'; file_contents_like $conf_file, qr{\Q # engine = # plan_file = $plan_file # top_dir = $top_dir }m, 'Other settings should be commented-out'; } SYSTEMCONF: { # Delete the file and write with a system config loaded. unlink $conf_file; local $ENV{SQITCH_SYSTEM_CONFIG} = file +File::Spec->updir, 'sqitch.conf'; my $sqitch = App::Sqitch->new; ok my $init = $CLASS->new( sqitch => $sqitch, properties => { extension => 'foo' } ), 'Make an init object with system config'; ok $target = $init->default_target, 'Get target'; file_not_exists_ok $conf_file; ok $init->write_config, 'Write the config with a system conf'; file_exists_ok $conf_file; is_deeply read_config $conf_file, { 'core.extension' => 'foo', 'core.engine' => 'pg', }, 'The configuration should have local and system config' or diag $conf_file->slurp; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info again'; my $plan_file = $target->top_dir->file('sqitch.plan')->stringify; file_contents_like $conf_file, qr{\Q # plan_file = $plan_file # top_dir = migrations }m, 'Other settings should be commented-out'; } ############################################################################## # Now get it to write a bunch of other stuff. unlink $conf_file; $sqitch = App::Sqitch->new; ok $init = $CLASS->new( sqitch => $sqitch, properties => { engine => 'sqlite', top_dir => dir('top'), plan_file => file('my.plan'), registry => 'bats', client => 'cli', target => 'db:sqlite:foo', extension => 'ddl', deploy_dir => dir('dep'), revert_dir => dir('rev'), verify_dir => dir('tst'), reworked_deploy_dir => dir('rdep'), reworked_revert_dir => dir('rrev'), reworked_verify_dir => dir('rtst'), } ), 'Create new init with sqitch non-default attributes'; ok $init->write_config, 'Write the config with core attrs'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info once more'; is_deeply read_config $conf_file, { 'core.top_dir' => 'top', 'core.plan_file' => 'my.plan', 'core.deploy_dir' => 'dep', 'core.revert_dir' => 'rev', 'core.verify_dir' => 'tst', 'core.reworked_deploy_dir' => 'rdep', 'core.reworked_revert_dir' => 'rrev', 'core.reworked_verify_dir' => 'rtst', 'core.extension' => 'ddl', 'core.engine' => 'sqlite', 'engine.sqlite.registry' => 'bats', 'engine.sqlite.client' => 'cli', 'engine.sqlite.target' => 'db:sqlite:foo', }, 'The configuration should have been written with core and engine values'; ############################################################################## # Now get it to write core.sqlite stuff with main options. unlink $conf_file; $sqitch = App::Sqitch->new( options => { engine => 'sqlite', client => '/to/sqlite3', registry => 'foo', target => 'bar', }, ); ok $init = $CLASS->new( sqitch => $sqitch ), 'Create new init with sqitch with non-default engine attributes'; ok $init->write_config, 'Write the config with engine attrs'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info yet again'; is_deeply read_config $conf_file, { 'core.engine' => 'sqlite', 'engine.sqlite.client' => '/to/sqlite3', 'engine.sqlite.registry' => 'foo', 'engine.sqlite.target' => 'bar', 'target.bar.uri' => 'db:sqlite:', }, 'Config should have been written with sqlite and target values'; # Try it with no options. unlink $conf_file; $sqitch = App::Sqitch->new(options => { engine => 'sqlite' }); ok $init = $CLASS->new( sqitch => $sqitch ), 'Create new init with sqitch with default engine attributes'; ok $init->write_config, 'Write the config with engine attrs'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info again again'; is_deeply read_config $conf_file, { 'core.engine' => 'sqlite', }, 'The configuration should have been written with only the engine var'; file_contents_like $conf_file, qr{^\Q# [engine "sqlite"] # target = db:sqlite: # registry = sqitch # client = sqlite3$exe_ext }m, 'Engine section should be present but commented-out'; # Now build it with other config. USERCONF: { # Delete the file and write with a user config loaded. unlink $conf_file; local $ENV{SQITCH_USER_CONFIG} = file +File::Spec->updir, 'user.conf'; my $sqitch = App::Sqitch->new(options => { engine => 'sqlite' }); ok my $init = $CLASS->new( sqitch => $sqitch ), 'Make an init with sqlite and user config'; file_not_exists_ok $conf_file; ok $init->write_config, 'Write the config with sqlite config'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info once more'; is_deeply read_config $conf_file, { 'core.engine' => 'sqlite', }, 'New config should have been written with sqlite values'; file_contents_like $conf_file, qr{^\t\Q# client = /opt/local/bin/sqlite3\E\n}m, 'Configured client should be included in a comment'; file_contents_like $conf_file, qr/^\t# target = db:sqlite:my\.db\n/m, 'Configured target should be included in a comment'; file_contents_like $conf_file, qr/^\t# registry = meta\n/m, 'Configured registry should be included in a comment'; } ############################################################################## # Now get it to write engine.pg stuff. unlink $conf_file; $sqitch = App::Sqitch->new( options => { engine => 'pg', client => '/to/psql', }, ); ok $init = $CLASS->new( sqitch => $sqitch ), 'Create new init with sqitch with more non-default engine attributes'; ok $init->write_config, 'Write the config with more engine attrs'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info one more time'; is_deeply read_config $conf_file, { 'core.engine' => 'pg', 'engine.pg.client' => '/to/psql', }, 'The configuration should have been written with client values' or diag $conf_file->slurp; file_contents_like $conf_file, qr/^\t# registry = sqitch\n/m, 'registry should be included in a comment'; # Try it with no config or options. unlink $conf_file; $sqitch = App::Sqitch->new(options => { engine => 'pg' }); ok $init = $CLASS->new( sqitch => $sqitch ), 'Create new init with sqitch with default engine attributes'; ok $init->write_config, 'Write the config with engine attrs'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The creation should be sent to info again again again'; is_deeply read_config $conf_file, { 'core.engine' => 'pg', }, 'The configuration should have been written with only the engine var' or diag $conf_file->slurp; file_contents_like $conf_file, qr{^\Q# [engine "pg"] # target = db:pg: # registry = sqitch # client = psql$exe_ext }m, 'Engine section should be present but commented-out' or diag $conf_file->slurp; USERCONF: { # Delete the file and write with a user config loaded. unlink $conf_file; local $ENV{SQITCH_USER_CONFIG} = file +File::Spec->updir, 'user.conf'; my $sqitch = App::Sqitch->new(options => { engine => 'pg' }); ok my $init = $CLASS->new( sqitch => $sqitch ), 'Make an init with pg and user config'; file_not_exists_ok $conf_file; ok $init->write_config, 'Write the config with pg config'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file] ], 'The pg config creation should be sent to info'; is_deeply read_config $conf_file, { 'core.engine' => 'pg', }, 'The configuration should have been written with pg options' or diag $conf_file->slurp; file_contents_like $conf_file, qr/^\t# registry = meta\n/m, 'Configured registry should be in a comment'; file_contents_like $conf_file, qr{^\t# target = db:pg://postgres\@localhost/thingies\n}m, 'Configured target should be in a comment'; } ############################################################################## # Test write_plan(). can_ok $init, 'write_plan'; $target = $init->default_target; $plan_file = $target->plan_file; file_not_exists_ok $plan_file, 'Plan file should not yet exist'; ok $init->write_plan( project => 'nada' ), 'Write the plan file'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $plan_file] ], 'The plan creation should be sent to info'; file_exists_ok $plan_file, 'Plan file should now exist'; file_contents_is $plan_file, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION() . "\n" . '%project=nada' . "\n\n", 'The contents should be correct'; # Make sure we don't overwrite the file when initializing again. ok $init->write_plan( project => 'nada' ), 'Write the plan file again'; file_exists_ok $plan_file, 'Plan file should still exist'; file_contents_is $plan_file, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION() . "\n" . '%project=nada' . "\n\n", 'The contents should be identical'; # Make sure we get an error trying to initalize a different plan. throws_ok { $init->write_plan( project => 'oopsie' ) } 'App::Sqitch::X', 'Should get an error initialing a different project'; is $@->ident, 'init', 'Initialization error ident should be "init"'; is $@->message, __x( 'Cannot initialize because project "{project}" already initialized in {file}', project => 'nada', file => $plan_file, ), 'Initialzation error message should be correct'; # Write a different file. my $fh = $plan_file->open('>:utf8_strict') or die "Cannot open $plan_file: $!\n"; $fh->say('# testing 1, 2, 3'); $fh->close; # Try writing again. throws_ok { $init->write_plan( project => 'foofoo' ) } 'App::Sqitch::X', 'Should get an error initialzing a non-plan file'; is $@->ident, 'init', 'Non-plan file error ident should be "init"'; is $@->message, __x( 'Cannot initialize because {file} already exists and is not a valid plan file', file => $plan_file, ), 'Non-plan file error message should be correct'; file_contents_like $plan_file, qr/testing 1, 2, 3/, 'The file should not be overwritten'; # Make sure a URI gets written, if present. $plan_file->remove; $sqitch = App::Sqitch->new(options => { top_dir => dir('plan.dir') }); END { remove_tree dir('plan.dir')->stringify }; ok $init = $CLASS->new( sqitch => $sqitch, uri => $uri, ), 'Create new init with sqitch with project and URI'; $target = $init->default_target; $plan_file = $target->plan_file; ok $init->write_plan( project => 'howdy', uri => $init->uri ), 'Write the plan file again'; is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $plan_file->dir . $sep], [__x 'Created {file}', file => $plan_file] ], 'The plan creation should be sent to info againq'; file_exists_ok $plan_file, 'Plan file should again exist'; file_contents_is $plan_file, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION() . "\n" . '%project=howdy' . "\n" . '%uri=' . $uri->canonical . "\n\n", 'The plan should include the project and uri pragmas'; ############################################################################## # Test _validate_project(). can_ok $init, '_validate_project'; NOPROJ: { # Test handling of no command. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $CLASS->_validate_project } qr/USAGE/, 'No project should yield usage'; is_deeply \@args, [$CLASS], 'No args should be passed to usage'; } # Test invalid project names. my @bad_names = ( '^foo', # No leading punctuation 'foo^', # No trailing punctuation 'foo^6', # No trailing punctuation+digit 'foo^666', # No trailing punctuation+digits '%hi', # No leading punctuation 'hi!', # No trailing punctuation 'foo@bar', # No @ allowed at all 'foo:bar', # No : allowed at all '+foo', # No leading + '-foo', # No leading - '@foo', # No leading @ ); for my $bad (@bad_names) { throws_ok { $init->_validate_project($bad) } 'App::Sqitch::X', qq{Should get error for invalid project name "$bad"}; is $@->ident, 'init', qq{Bad project "$bad" ident should be "init"}; is $@->message, __x( qq{invalid project name "{project}": project names must not } . 'begin with punctuation, contain "@", ":", "#", or blanks, or end in ' . 'punctuation or digits following punctuation', project => $bad ), qq{Bad project "$bad" error message should be correct}; } ############################################################################## # Bring it all together, yo. $conf_file->remove; $plan_file->remove; ok $init->execute('foofoo'), 'Execute!'; # Should have directories. for my $attr (map { "$_\_dir"} qw(top deploy revert verify)) { dir_exists_ok $target->$attr; } # Should have config and plan. file_exists_ok $conf_file; file_exists_ok $plan_file; # Should have the output. my @dir_messages = map { [__x 'Created {file}', file => $target->$_ . $sep] } map { "$_\_dir" } qw(deploy revert verify); is_deeply +MockOutput->get_info, [ [__x 'Created {file}', file => $conf_file], [__x 'Created {file}', file => $plan_file], @dir_messages, ], 'Should have status messages'; file_contents_is $plan_file, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION() . "\n" . '%project=foofoo' . "\n" . '%uri=' . $uri->canonical . "\n\n", 'The plan should have the --project name'; App-Sqitch-0.9996/t/item_formatter.t000644 000767 000024 00000030303 13133201371 017501 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 158; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::NoWarnings; use Test::Exception; use Test::MockModule; use Path::Class; use Term::ANSIColor qw(color); use App::Sqitch::DateTime; use Encode; use lib 't/lib'; use MockOutput; use LC; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::ItemFormatter'; require_ok $CLASS; can_ok $CLASS => qw( new abbrev date_format color formatter format ); isa_ok my $formatter = $CLASS->new, $CLASS, 'Instantiated object'; ok !$formatter->abbrev, 'Should not be abbreviated by default'; is $formatter->date_format, 'iso', 'Default date format should be "iso"'; ############################################################################### # Test all formatting characters. my $cdt = App::Sqitch::DateTime->now; my $pdt = $cdt->clone->subtract(days => 1); my $local_cdt = $cdt->clone; $local_cdt->set_time_zone('local'); my $local_pdt = $pdt->clone; $local_pdt->set_time_zone('local'); my $craw = $cdt->as_string( format => 'raw' ); my $event = { event => 'deploy', project => 'logit', change_id => '000011112222333444', change => 'lolz', tags => [ '@beta', '@gamma' ], committer_name => 'larry', committer_email => 'larry@example.com', committed_at => $cdt, planner_name => 'damian', planner_email => 'damian@example.com', planned_at => $pdt, note => "For the LOLZ.\n\nYou know, funny stuff and cute kittens, right?", requires => [qw(foo bar)], conflicts => [] }; $_->set_locale($LC::TIME) for ($local_cdt, $local_pdt); for my $spec ( ['%e', { event => 'deploy' }, 'deploy' ], ['%e', { event => 'revert' }, 'revert' ], ['%e', { event => 'fail' }, 'fail' ], ['%L', { event => 'deploy' }, __ 'Deploy' ], ['%L', { event => 'revert' }, __ 'Revert' ], ['%L', { event => 'fail' }, __ 'Fail' ], ['%l', { event => 'deploy' }, __ 'deploy' ], ['%l', { event => 'revert' }, __ 'revert' ], ['%l', { event => 'fail' }, __ 'fail' ], ['%{event}_', {}, __ 'Event: ' ], ['%{change}_', {}, __ 'Change: ' ], ['%{committer}_', {}, __ 'Committer:' ], ['%{planner}_', {}, __ 'Planner: ' ], ['%{by}_', {}, __ 'By: ' ], ['%{date}_', {}, __ 'Date: ' ], ['%{committed}_', {}, __ 'Committed:' ], ['%{planned}_', {}, __ 'Planned: ' ], ['%{name}_', {}, __ 'Name: ' ], ['%{email}_', {}, __ 'Email: ' ], ['%{requires}_', {}, __ 'Requires: ' ], ['%{conflicts}_', {}, __ 'Conflicts:' ], ['%H', { change_id => '123456789' }, '123456789' ], ['%h', { change_id => '123456789' }, '123456789' ], ['%{5}h', { change_id => '123456789' }, '12345' ], ['%{7}h', { change_id => '123456789' }, '1234567' ], ['%n', { change => 'foo' }, 'foo'], ['%n', { change => 'bar' }, 'bar'], ['%o', { project => 'foo' }, 'foo'], ['%o', { project => 'bar' }, 'bar'], ['%c', { committer_name => 'larry', committer_email => 'larry@example.com' }, 'larry '], ['%{n}c', { committer_name => 'damian' }, 'damian'], ['%{name}c', { committer_name => 'chip' }, 'chip'], ['%{e}c', { committer_email => 'larry@example.com' }, 'larry@example.com'], ['%{email}c', { committer_email => 'damian@example.com' }, 'damian@example.com'], ['%{date}c', { committed_at => $cdt }, $cdt->as_string( format => 'iso' ) ], ['%{date:rfc}c', { committed_at => $cdt }, $cdt->as_string( format => 'rfc' ) ], ['%{d:long}c', { committed_at => $cdt }, $cdt->as_string( format => 'long' ) ], ["%{d:cldr:HH'h' mm'm'}c", { committed_at => $cdt }, $local_cdt->format_cldr( q{HH'h' mm'm'} ) ], ["%{d:strftime:%a at %H:%M:%S}c", { committed_at => $cdt }, $local_cdt->strftime('%a at %H:%M:%S') ], ['%p', { planner_name => 'larry', planner_email => 'larry@example.com' }, 'larry '], ['%{n}p', { planner_name => 'damian' }, 'damian'], ['%{name}p', { planner_name => 'chip' }, 'chip'], ['%{e}p', { planner_email => 'larry@example.com' }, 'larry@example.com'], ['%{email}p', { planner_email => 'damian@example.com' }, 'damian@example.com'], ['%{date}p', { planned_at => $pdt }, $pdt->as_string( format => 'iso' ) ], ['%{date:rfc}p', { planned_at => $pdt }, $pdt->as_string( format => 'rfc' ) ], ['%{d:long}p', { planned_at => $pdt }, $pdt->as_string( format => 'long' ) ], ["%{d:cldr:HH'h' mm'm'}p", { planned_at => $pdt }, $local_pdt->format_cldr( q{HH'h' mm'm'} ) ], ["%{d:strftime:%a at %H:%M:%S}p", { planned_at => $pdt }, $local_pdt->strftime('%a at %H:%M:%S') ], ['%t', { tags => [] }, '' ], ['%t', { tags => ['@foo'] }, ' @foo' ], ['%t', { tags => ['@foo', '@bar'] }, ' @foo, @bar' ], ['%{|}t', { tags => [] }, '' ], ['%{|}t', { tags => ['@foo'] }, ' @foo' ], ['%{|}t', { tags => ['@foo', '@bar'] }, ' @foo|@bar' ], ['%T', { tags => [] }, '' ], ['%T', { tags => ['@foo'] }, ' (@foo)' ], ['%T', { tags => ['@foo', '@bar'] }, ' (@foo, @bar)' ], ['%{|}T', { tags => [] }, '' ], ['%{|}T', { tags => ['@foo'] }, ' (@foo)' ], ['%{|}T', { tags => ['@foo', '@bar'] }, ' (@foo|@bar)' ], ['%r', { requires => [] }, '' ], ['%r', { requires => ['foo'] }, ' foo' ], ['%r', { requires => ['foo', 'bar'] }, ' foo, bar' ], ['%{|}r', { requires => [] }, '' ], ['%{|}r', { requires => ['foo'] }, ' foo' ], ['%{|}r', { requires => ['foo', 'bar'] }, ' foo|bar' ], ['%R', { requires => [] }, '' ], ['%R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ], ['%R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo, bar\n" ], ['%{|}R', { requires => [] }, '' ], ['%{|}R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ], ['%{|}R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo|bar\n" ], ['%x', { conflicts => [] }, '' ], ['%x', { conflicts => ['foo'] }, ' foo' ], ['%x', { conflicts => ['foo', 'bax'] }, ' foo, bax' ], ['%{|}x', { conflicts => [] }, '' ], ['%{|}x', { conflicts => ['foo'] }, ' foo' ], ['%{|}x', { conflicts => ['foo', 'bax'] }, ' foo|bax' ], ['%X', { conflicts => [] }, '' ], ['%X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ], ['%X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo, bar\n" ], ['%{|}X', { conflicts => [] }, '' ], ['%{|}X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ], ['%{|}X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo|bar\n" ], ['%{yellow}C', {}, '' ], ['%{:event}C', { event => 'deploy' }, '' ], ['%v', {}, "\n" ], ['%%', {}, '%' ], ['%s', { note => 'hi there' }, 'hi there' ], ['%s', { note => "hi there\nyo" }, 'hi there' ], ['%s', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, 'subject line' ], ['%{ }s', { note => 'hi there' }, ' hi there' ], ['%{xx}s', { note => 'hi there' }, 'xxhi there' ], ['%b', { note => 'hi there' }, '' ], ['%b', { note => "hi there\nyo" }, 'yo' ], ['%b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "first graph\n\nsecond graph\n\n" ], ['%{ }b', { note => 'hi there' }, '' ], ['%{xxx }b', { note => "hi there\nyo" }, "xxx yo" ], ['%{x}b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xfirst graph\nx\nxsecond graph\nx\n" ], ['%{ }b', { note => "hi there\r\nyo" }, " yo" ], ['%B', { note => 'hi there' }, 'hi there' ], ['%B', { note => "hi there\nyo" }, "hi there\nyo" ], ['%B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "subject line\n\nfirst graph\n\nsecond graph\n\n" ], ['%{ }B', { note => 'hi there' }, ' hi there' ], ['%{xxx }B', { note => "hi there\nyo" }, "xxx hi there\nxxx yo" ], ['%{x}B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xsubject line\nx\nxfirst graph\nx\nxsecond graph\nx\n" ], ['%{ }B', { note => "hi there\r\nyo" }, " hi there\r\n yo" ], ['%{change}a', $event, "change $event->{change}\n" ], ['%{change_id}a', $event, "change_id $event->{change_id}\n" ], ['%{event}a', $event, "event $event->{event}\n" ], ['%{tags}a', $event, 'tags ' . join(', ', @{ $event->{tags} }) . "\n" ], ['%{requires}a', $event, 'requires ' . join(', ', @{ $event->{requires} }) . "\n" ], ['%{conflicts}a', $event, '' ], ['%{committer_name}a', $event, "committer_name $event->{committer_name}\n" ], ['%{committed_at}a', $event, "committed_at $craw\n" ], ) { (my $desc = encode_utf8 $spec->[2]) =~ s/\n/[newline]/g; local $ENV{ANSI_COLORS_DISABLED} = 1; is $formatter->format( $spec->[0], $spec->[1] ), $spec->[2], qq{Format "$spec->[0]" should output "$desc"}; } throws_ok { $formatter->format( '%_', {} ) } 'App::Sqitch::X', 'Should get exception for format "%_"'; is $@->ident, 'format', '%_ error ident should be "format"'; is $@->message, __ 'No label passed to the _ format', '%_ error message should be correct'; throws_ok { $formatter->format( '%{foo}_', {} ) } 'App::Sqitch::X', 'Should get exception for unknown label in format "%_"'; is $@->ident, 'format', 'Invalid %_ label error ident should be "format"'; is $@->message, __x( 'Unknown label "{label}" passed to the _ format', label => 'foo' ), 'Invalid %_ label error message should be correct'; ok $formatter = $CLASS->new( abbrev => 4 ), 'Instantiate with abbrev => 4'; is $formatter->format( '%h', { change_id => '123456789' } ), '1234', '%h should respect abbrev'; is $formatter->format( '%H', { change_id => '123456789' } ), '123456789', '%H should not respect abbrev'; ok $formatter = $CLASS->new( date_format => 'rfc' ), 'Instantiate with date_format => "rfc"'; is $formatter->format( '%{date}c', { committed_at => $cdt } ), $cdt->as_string( format => 'rfc' ), '%{date}c should respect the date_format attribute'; is $formatter->format( '%{d:iso}c', { committed_at => $cdt } ), $cdt->as_string( format => 'iso' ), '%{iso}c should override the date_format attribute'; throws_ok { $formatter->format( '%{foo}a', {}) } 'App::Sqitch::X', 'Should get exception for unknown attribute passed to %a'; is $@->ident, 'format', '%a error ident should be "log"'; is $@->message, __x( '{attr} is not a valid change attribute', attr => 'foo' ), '%a error message should be correct'; # Test colors. delete $ENV{ANSI_COLORS_DISABLED}; ok $formatter = $CLASS->new( color => 'always' ), 'Construct with color "always"'; for my $color (qw(yellow red blue cyan magenta)) { is $formatter->format( "%{$color}C", {} ), color($color), qq{Format "%{$color}C" should output } . color($color) . $color . color('reset'); } for my $spec ( [ ':event', { event => 'deploy' }, 'green', 'deploy' ], [ ':event', { event => 'revert' }, 'blue', 'revert' ], [ ':event', { event => 'fail' }, 'red', 'fail' ], ) { is $formatter->format( "%{$spec->[0]}C", $spec->[1] ), color($spec->[2]), qq{Format "%{$spec->[0]}C" on "$spec->[3]" should output } . color($spec->[2]) . $spec->[2] . color('reset'); } throws_ok { $formatter->format( '%{BLUELOLZ}C', {} ) } 'App::Sqitch::X', 'Should get an error for an invalid color'; is $@->ident, 'format', 'Invalid color error ident should be "log"'; is $@->message, __x( '{color} is not a valid ANSI color', color => 'BLUELOLZ' ), 'Invalid color error message should be correct'; # Make sure color "never" works. ok $formatter = $CLASS->new( color => 'never' ), 'Construct with color "never"'; for my $color (qw(yellow red blue cyan magenta)) { is $formatter->format( "%{$color}C", {} ), '', qq{Format "%{$color}C" should not output a color}; } # Make sure an unknown format character throws a proper exception. throws_ok { $formatter->format('%Z', {}) } 'App::Sqitch::X', 'Should get an exception for a bad format code'; is $@->ident, 'format', 'bad format code format error ident should be "log"'; is $@->message, __x( 'Unknown format code "{code}"', code => 'Z', ), 'bad format code format error message should be correct'; App-Sqitch-0.9996/t/lib/000755 000767 000024 00000000000 13133201371 015042 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/linelist.t000644 000767 000024 00000005752 13133201371 016315 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 28; #use Test::More 'no_plan'; use Test::NoWarnings; use Test::Exception; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; BEGIN { require_ok 'App::Sqitch::Plan::LineList' or die } my $sqitch = App::Sqitch->new(options => { engine => 'sqlite' }); my $target = App::Sqitch::Target->new(sqitch => $sqitch); my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target); my $foo = App::Sqitch::Plan::Change->new(plan => $plan, name => 'foo'); my $bar = App::Sqitch::Plan::Change->new(plan => $plan, name => 'bar'); my $baz = App::Sqitch::Plan::Change->new(plan => $plan, name => 'baz'); my $yo1 = App::Sqitch::Plan::Change->new(plan => $plan, name => 'yo'); my $yo2 = App::Sqitch::Plan::Change->new(plan => $plan, name => 'yo'); my $blank = App::Sqitch::Plan::Blank->new(plan => $plan); my $alpha = App::Sqitch::Plan::Tag->new( plan => $plan, change => $yo1, name => 'alpha', ); my $lines = App::Sqitch::Plan::LineList->new( $foo, $bar, $yo1, $alpha, $blank, $baz, $yo2, ); is $lines->count, 7, 'Count should be six'; is_deeply [$lines->items], [$foo, $bar, $yo1, $alpha, $blank, $baz, $yo2], 'Lines should be in order'; is $lines->item_at(0), $foo, 'Should have foo at 0'; is $lines->item_at(1), $bar, 'Should have bar at 1'; is $lines->item_at(2), $yo1, 'Should have yo1 at 2'; is $lines->item_at(3), $alpha, 'Should have @alpha at 3'; is $lines->item_at(4), $blank, 'Should have blank at 4'; is $lines->item_at(5), $baz, 'Should have baz at 5'; is $lines->item_at(6), $yo2, 'Should have yo2 at 6'; is $lines->index_of('non'), undef, 'Should not find "non"'; is $lines->index_of($foo), 0, 'Should find foo at 0'; is $lines->index_of($bar), 1, 'Should find bar at 1'; is $lines->index_of($yo1), 2, 'Should find yo1 at 2'; is $lines->index_of($alpha), 3, 'Should find @alpha at 3'; is $lines->index_of($blank), 4, 'Should find blank at 4'; is $lines->index_of($baz), 5, 'Should find baz at 5'; is $lines->index_of($yo2), 6, 'Should find yo2 at 6'; my $hi = App::Sqitch::Plan::Change->new(plan => $plan, name => 'hi'); ok $lines->append($hi), 'Append hi'; is $lines->count, 8, 'Count should now be eight'; is_deeply [$lines->items], [$foo, $bar, $yo1, $alpha, $blank, $baz, $yo2, $hi], 'Lines should be in order with $hi at the end'; # Try inserting. my $oy = App::Sqitch::Plan::Change->new(plan => $plan, name => 'oy'); ok $lines->insert_at($oy, 3), 'Insert a change at index 3'; is $lines->count, 9, 'Count should now be nine'; is_deeply [$lines->items], [$foo, $bar, $yo1, $oy, $alpha, $blank, $baz, $yo2, $hi], 'Lines should be in order with $oy at index 3'; is $lines->index_of($oy), 3, 'Should find oy at 3'; is $lines->index_of($alpha), 4, 'Should find @alpha at 4'; is $lines->index_of($hi), 8, 'Should find hi at 8'; App-Sqitch-0.9996/t/local.conf000644 000767 000024 00000000340 13133201371 016232 0ustar00davidstaff000000 000000 [core] engine = pg [engine "pg"] target = mydb [engine "sqlite"] target = devdb [target "devdb"] uri = db:sqlite: [target "mydb"] uri = db:pg:mydb plan_file = t/plans/dependencies.plan App-Sqitch-0.9996/t/log.t000644 000767 000024 00000072310 13133201371 015245 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 252; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::NoWarnings; use Test::Exception; use Test::MockModule; use Path::Class; use Term::ANSIColor qw(color); use Encode; use lib 't/lib'; use MockOutput; use LC; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::Command::log'; require_ok $CLASS; ok my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => Path::Class::Dir->new('test-log')->stringify, plan_file => Path::Class::File->new('t/sql/sqitch.plan')->stringify, }, ), 'Load a sqitch sqitch object'; my $config = $sqitch->config; isa_ok my $log = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'log', config => $config, }), $CLASS, 'log command'; can_ok $log, qw( target change_pattern project_pattern committer_pattern max_count skip reverse format options execute configure ); is_deeply [$CLASS->options], [qw( event=s@ target|t=s change-pattern|change=s project-pattern|project=s committer-pattern|committer=s format|f=s date-format|date=s max-count|n=i skip=i reverse! color=s no-color abbrev=i oneline )], 'Options should be correct'; ############################################################################## # Test database. is $log->target, undef, 'Default target should be undef'; isa_ok $log = $CLASS->new( sqitch => $sqitch, target => 'foo', ), $CLASS, 'new status with target'; is $log->target, 'foo', 'Should have target "foo"'; ############################################################################## # Test configure(). my $cmock = Test::MockModule->new('App::Sqitch::Config'); # Test date_format validation. my $configured = $CLASS->configure($config, {}); isa_ok delete $configured->{formatter}, 'App::Sqitch::ItemFormatter', 'Formatter'; is_deeply $configured, {}, 'Should get empty hash for no config or options'; $cmock->mock( get => 'nonesuch' ); throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X', 'Should get error for invalid date format in config'; is $@->ident, 'datetime', 'Invalid date format error ident should be "datetime"'; is $@->message, __x( 'Unknown date format "{format}"', format => 'nonesuch', ), 'Invalid date format error message should be correct'; $cmock->unmock_all; throws_ok { $CLASS->configure($config, { date_format => 'non'}), {} } 'App::Sqitch::X', 'Should get error for invalid date format in optsions'; is $@->ident, 'datetime', 'Invalid date format error ident should be "log"'; is $@->message, __x( 'Unknown date format "{format}"', format => 'non', ), 'Invalid date format error message should be correct'; # Test format validation. $cmock->mock( get => sub { my ($self, %p) = @_; return 'nonesuch' if $p{key} eq 'log.format'; return undef; }); throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X', 'Should get error for invalid format in config'; is $@->ident, 'log', 'Invalid format error ident should be "log"'; is $@->message, __x( 'Unknown log format "{format}"', format => 'nonesuch', ), 'Invalid format error message should be correct'; $cmock->unmock_all; throws_ok { $CLASS->configure($config, { format => 'non'}), {} } 'App::Sqitch::X', 'Should get error for invalid format in optsions'; is $@->ident, 'log', 'Invalid format error ident should be "log"'; is $@->message, __x( 'Unknown log format "{format}"', format => 'non', ), 'Invalid format error message should be correct'; # Test color configuration. $configured = $CLASS->configure( $config, { no_color => 1 } ); is $configured->{formatter}->color, 'never', 'Configuration should respect --no-color, setting "never"'; # Test oneline configuration. $configured = $CLASS->configure( $config, { oneline => 1 }); is $configured->{format}, '%{:event}C%h %l%{reset}C %o:%n %s', '--oneline should set format'; is $configured->{formatter}{abbrev}, 6, '--oneline should set abbrev to 6'; $configured = $CLASS->configure( $config, { oneline => 1, format => 'format:foo', abbrev => 5 }); is $configured->{format}, 'foo', '--oneline should not override --format'; is $configured->{formatter}{abbrev}, 5, '--oneline should not overrride --abbrev'; my $config_color = 'auto'; $cmock->mock( get => sub { my ($self, %p) = @_; return $config_color if $p{key} eq 'log.color'; return undef; }); my $log_config = {}; $cmock->mock( get_section => sub { $log_config } ); $configured = $CLASS->configure( $config, { no_color => 1 } ); is $configured->{formatter}->color, 'never', 'Configuration should respect --no-color even when configure is set'; NEVER: { $config_color = 'never'; $log_config = { color => $config_color }; my $configured = $CLASS->configure( $config, $log_config ); is $configured->{formatter}->color, 'never', 'Configuration should respect color option'; # Try it with config. $log_config = { color => $config_color }; $configured = $CLASS->configure( $config, {} ); is $configured->{formatter}->color, 'never', 'Configuration should respect color config'; } ALWAYS: { $config_color = 'always'; $log_config = { color => $config_color }; my $configured = $CLASS->configure( $config, $log_config ); is_deeply $configured->{formatter}->color, 'always', 'Configuration should respect color option'; # Try it with config. $log_config = { color => $config_color }; $configured = $CLASS->configure( $config, {} ); is_deeply $configured->{formatter}->color, 'always', 'Configuration should respect color config'; } AUTO: { $config_color = 'auto'; $log_config = { color => $config_color }; for my $enabled (0, 1) { my $configured = $CLASS->configure( $config, $log_config ); is_deeply $configured->{formatter}->color, 'auto', 'Configuration should respect color option'; # Try it with config. $log_config = { color => $config_color }; $configured = $CLASS->configure( $config, {} ); is_deeply $configured->{formatter}->color, 'auto', 'Configuration should respect color config'; } } $cmock->unmock_all; ############################################################################### # Test named formats. my $cdt = App::Sqitch::DateTime->now; my $pdt = $cdt->clone->subtract(days => 1); my $event = { event => 'deploy', project => 'logit', change_id => '000011112222333444', change => 'lolz', tags => [ '@beta', '@gamma' ], committer_name => 'larry', committer_email => 'larry@example.com', committed_at => $cdt, planner_name => 'damian', planner_email => 'damian@example.com', planned_at => $pdt, note => "For the LOLZ.\n\nYou know, funny stuff and cute kittens, right?", requires => [qw(foo bar)], conflicts => [] }; my $ciso = $cdt->as_string( format => 'iso' ); my $craw = $cdt->as_string( format => 'raw' ); my $piso = $pdt->as_string( format => 'iso' ); my $praw = $pdt->as_string( format => 'raw' ); for my $spec ( [ raw => "deploy 000011112222333444 (\@beta, \@gamma)\n" . "name lolz\n" . "project logit\n" . "requires foo, bar\n" . "planner damian \n" . "planned $praw\n" . "committer larry \n" . "committed $craw\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ full => __('Deploy') . " 000011112222333444 (\@beta, \@gamma)\n" . __('Name: ') . " lolz\n" . __('Project: ') . " logit\n" . __('Requires: ') . " foo, bar\n" . __('Planner: ') . " damian \n" . __('Planned: ') . " __PDATE__\n" . __('Committer:') . " larry \n" . __('Committed:') . " __CDATE__\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ long => __('Deploy') . " 000011112222333444 (\@beta, \@gamma)\n" . __('Name: ') . " lolz\n" . __('Project: ') . " logit\n" . __('Planner: ') . " damian \n" . __('Committer:') . " larry \n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ medium => __('Deploy') . " 000011112222333444\n" . __('Name: ') . " lolz\n" . __('Committer:') . " larry \n" . __('Date: ') . " __CDATE__\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ short => __('Deploy') . " 000011112222333444\n" . __('Name: ') . " lolz\n" . __('Committer:') . " larry \n\n" . " For the LOLZ.\n", ], [ oneline => '000011112222333444 ' . __('deploy') . ' logit:lolz For the LOLZ.' ], ) { local $ENV{ANSI_COLORS_DISABLED} = 1; my $configured = $CLASS->configure( $config, { format => $spec->[0] } ); my $format = $configured->{format}; ok my $log = $CLASS->new( sqitch => $sqitch, %{ $configured } ), qq{Instantiate with format "$spec->[0]"}; (my $exp = $spec->[1]) =~ s/__CDATE__/$ciso/; $exp =~ s/__PDATE__/$piso/; is $log->formatter->format( $log->format, $event ), $exp, qq{Format "$spec->[0]" should output correctly}; if ($spec->[1] =~ /__CDATE__/) { # Test different date formats. for my $date_format (qw(rfc long medium)) { ok my $log = $CLASS->new( sqitch => $sqitch, format => $format, formatter => App::Sqitch::ItemFormatter->new(date_format => $date_format), ), qq{Instantiate with format "$spec->[0]" and date format "$date_format"}; my $date = $cdt->as_string( format => $date_format ); (my $exp = $spec->[1]) =~ s/__CDATE__/$date/; $date = $pdt->as_string( format => $date_format ); $exp =~ s/__PDATE__/$date/; is $log->formatter->format( $log->format, $event ), $exp, qq{Format "$spec->[0]" and date format "$date_format" should output correctly}; } } if ($spec->[1] =~ s/\s+[(]?[@]beta,\s+[@]gamma[)]?//) { # Test without tags. local $event->{tags} = []; (my $exp = $spec->[1]) =~ s/__CDATE__/$ciso/; $exp =~ s/__PDATE__/$piso/; is $log->formatter->format( $log->format, $event ), $exp, qq{Format "$spec->[0]" should output correctly without tags}; } } ############################################################################### # Test all formatting characters. my $local_cdt = $cdt->clone; $local_cdt->set_time_zone('local'); $local_cdt->set_locale($LC::TIME); my $local_pdt = $pdt->clone; $local_pdt->set_time_zone('local'); $local_pdt->set_locale($LC::TIME); my $formatter = $log->formatter; for my $spec ( ['%e', { event => 'deploy' }, 'deploy' ], ['%e', { event => 'revert' }, 'revert' ], ['%e', { event => 'fail' }, 'fail' ], ['%L', { event => 'deploy' }, __ 'Deploy' ], ['%L', { event => 'revert' }, __ 'Revert' ], ['%L', { event => 'fail' }, __ 'Fail' ], ['%l', { event => 'deploy' }, __ 'deploy' ], ['%l', { event => 'revert' }, __ 'revert' ], ['%l', { event => 'fail' }, __ 'fail' ], ['%{event}_', {}, __ 'Event: ' ], ['%{change}_', {}, __ 'Change: ' ], ['%{committer}_', {}, __ 'Committer:' ], ['%{planner}_', {}, __ 'Planner: ' ], ['%{by}_', {}, __ 'By: ' ], ['%{date}_', {}, __ 'Date: ' ], ['%{committed}_', {}, __ 'Committed:' ], ['%{planned}_', {}, __ 'Planned: ' ], ['%{name}_', {}, __ 'Name: ' ], ['%{email}_', {}, __ 'Email: ' ], ['%{requires}_', {}, __ 'Requires: ' ], ['%{conflicts}_', {}, __ 'Conflicts:' ], ['%H', { change_id => '123456789' }, '123456789' ], ['%h', { change_id => '123456789' }, '123456789' ], ['%{5}h', { change_id => '123456789' }, '12345' ], ['%{7}h', { change_id => '123456789' }, '1234567' ], ['%n', { change => 'foo' }, 'foo'], ['%n', { change => 'bar' }, 'bar'], ['%o', { project => 'foo' }, 'foo'], ['%o', { project => 'bar' }, 'bar'], ['%c', { committer_name => 'larry', committer_email => 'larry@example.com' }, 'larry '], ['%{n}c', { committer_name => 'damian' }, 'damian'], ['%{name}c', { committer_name => 'chip' }, 'chip'], ['%{e}c', { committer_email => 'larry@example.com' }, 'larry@example.com'], ['%{email}c', { committer_email => 'damian@example.com' }, 'damian@example.com'], ['%{date}c', { committed_at => $cdt }, $cdt->as_string( format => 'iso' ) ], ['%{date:rfc}c', { committed_at => $cdt }, $cdt->as_string( format => 'rfc' ) ], ['%{d:long}c', { committed_at => $cdt }, $cdt->as_string( format => 'long' ) ], ["%{d:cldr:HH'h' mm'm'}c", { committed_at => $cdt }, $local_cdt->format_cldr( q{HH'h' mm'm'} ) ], ["%{d:strftime:%a at %H:%M:%S}c", { committed_at => $cdt }, $local_cdt->strftime('%a at %H:%M:%S') ], ['%p', { planner_name => 'larry', planner_email => 'larry@example.com' }, 'larry '], ['%{n}p', { planner_name => 'damian' }, 'damian'], ['%{name}p', { planner_name => 'chip' }, 'chip'], ['%{e}p', { planner_email => 'larry@example.com' }, 'larry@example.com'], ['%{email}p', { planner_email => 'damian@example.com' }, 'damian@example.com'], ['%{date}p', { planned_at => $pdt }, $pdt->as_string( format => 'iso' ) ], ['%{date:rfc}p', { planned_at => $pdt }, $pdt->as_string( format => 'rfc' ) ], ['%{d:long}p', { planned_at => $pdt }, $pdt->as_string( format => 'long' ) ], ["%{d:cldr:HH'h' mm'm'}p", { planned_at => $pdt }, $local_pdt->format_cldr( q{HH'h' mm'm'} ) ], ["%{d:strftime:%a at %H:%M:%S}p", { planned_at => $pdt }, $local_pdt->strftime('%a at %H:%M:%S') ], ['%t', { tags => [] }, '' ], ['%t', { tags => ['@foo'] }, ' @foo' ], ['%t', { tags => ['@foo', '@bar'] }, ' @foo, @bar' ], ['%{|}t', { tags => [] }, '' ], ['%{|}t', { tags => ['@foo'] }, ' @foo' ], ['%{|}t', { tags => ['@foo', '@bar'] }, ' @foo|@bar' ], ['%T', { tags => [] }, '' ], ['%T', { tags => ['@foo'] }, ' (@foo)' ], ['%T', { tags => ['@foo', '@bar'] }, ' (@foo, @bar)' ], ['%{|}T', { tags => [] }, '' ], ['%{|}T', { tags => ['@foo'] }, ' (@foo)' ], ['%{|}T', { tags => ['@foo', '@bar'] }, ' (@foo|@bar)' ], ['%r', { requires => [] }, '' ], ['%r', { requires => ['foo'] }, ' foo' ], ['%r', { requires => ['foo', 'bar'] }, ' foo, bar' ], ['%{|}r', { requires => [] }, '' ], ['%{|}r', { requires => ['foo'] }, ' foo' ], ['%{|}r', { requires => ['foo', 'bar'] }, ' foo|bar' ], ['%R', { requires => [] }, '' ], ['%R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ], ['%R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo, bar\n" ], ['%{|}R', { requires => [] }, '' ], ['%{|}R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ], ['%{|}R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo|bar\n" ], ['%x', { conflicts => [] }, '' ], ['%x', { conflicts => ['foo'] }, ' foo' ], ['%x', { conflicts => ['foo', 'bax'] }, ' foo, bax' ], ['%{|}x', { conflicts => [] }, '' ], ['%{|}x', { conflicts => ['foo'] }, ' foo' ], ['%{|}x', { conflicts => ['foo', 'bax'] }, ' foo|bax' ], ['%X', { conflicts => [] }, '' ], ['%X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ], ['%X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo, bar\n" ], ['%{|}X', { conflicts => [] }, '' ], ['%{|}X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ], ['%{|}X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo|bar\n" ], ['%{yellow}C', {}, '' ], ['%{:event}C', { event => 'deploy' }, '' ], ['%v', {}, "\n" ], ['%%', {}, '%' ], ['%s', { note => 'hi there' }, 'hi there' ], ['%s', { note => "hi there\nyo" }, 'hi there' ], ['%s', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, 'subject line' ], ['%{ }s', { note => 'hi there' }, ' hi there' ], ['%{xx}s', { note => 'hi there' }, 'xxhi there' ], ['%b', { note => 'hi there' }, '' ], ['%b', { note => "hi there\nyo" }, 'yo' ], ['%b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "first graph\n\nsecond graph\n\n" ], ['%{ }b', { note => 'hi there' }, '' ], ['%{xxx }b', { note => "hi there\nyo" }, "xxx yo" ], ['%{x}b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xfirst graph\nx\nxsecond graph\nx\n" ], ['%{ }b', { note => "hi there\r\nyo" }, " yo" ], ['%B', { note => 'hi there' }, 'hi there' ], ['%B', { note => "hi there\nyo" }, "hi there\nyo" ], ['%B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "subject line\n\nfirst graph\n\nsecond graph\n\n" ], ['%{ }B', { note => 'hi there' }, ' hi there' ], ['%{xxx }B', { note => "hi there\nyo" }, "xxx hi there\nxxx yo" ], ['%{x}B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xsubject line\nx\nxfirst graph\nx\nxsecond graph\nx\n" ], ['%{ }B', { note => "hi there\r\nyo" }, " hi there\r\n yo" ], ['%{change}a', $event, "change $event->{change}\n" ], ['%{change_id}a', $event, "change_id $event->{change_id}\n" ], ['%{event}a', $event, "event $event->{event}\n" ], ['%{tags}a', $event, 'tags ' . join(', ', @{ $event->{tags} }) . "\n" ], ['%{requires}a', $event, 'requires ' . join(', ', @{ $event->{requires} }) . "\n" ], ['%{conflicts}a', $event, '' ], ['%{committer_name}a', $event, "committer_name $event->{committer_name}\n" ], ['%{committed_at}a', $event, "committed_at $craw\n" ], ) { local $ENV{ANSI_COLORS_DISABLED} = 1; (my $desc = encode_utf8 $spec->[2]) =~ s/\n/[newline]/g; is $formatter->format( $spec->[0], $spec->[1] ), $spec->[2], qq{Format "$spec->[0]" should output "$desc"}; } throws_ok { $formatter->format( '%_', {} ) } 'App::Sqitch::X', 'Should get exception for format "%_"'; is $@->ident, 'format', '%_ error ident should be "format"'; is $@->message, __ 'No label passed to the _ format', '%_ error message should be correct'; throws_ok { $formatter->format( '%{foo}_', {} ) } 'App::Sqitch::X', 'Should get exception for unknown label in format "%_"'; is $@->ident, 'format', 'Invalid %_ label error ident should be "format"'; is $@->message, __x( 'Unknown label "{label}" passed to the _ format', label => 'foo' ), 'Invalid %_ label error message should be correct'; ok $log = $CLASS->new( sqitch => $sqitch, formatter => App::Sqitch::ItemFormatter->new(abbrev => 4) ), 'Instantiate with abbrev => 4'; is $log->formatter->format( '%h', { change_id => '123456789' } ), '1234', '%h should respect abbrev'; is $log->formatter->format( '%H', { change_id => '123456789' } ), '123456789', '%H should not respect abbrev'; ok $log = $CLASS->new( sqitch => $sqitch, formatter => App::Sqitch::ItemFormatter->new(date_format => 'rfc') ), 'Instantiate with date_format => "rfc"'; is $log->formatter->format( '%{date}c', { committed_at => $cdt } ), $cdt->as_string( format => 'rfc' ), '%{date}c should respect the date_format attribute'; is $log->formatter->format( '%{d:iso}c', { committed_at => $cdt } ), $cdt->as_string( format => 'iso' ), '%{iso}c should override the date_format attribute'; throws_ok { $formatter->format( '%{foo}a', {}) } 'App::Sqitch::X', 'Should get exception for unknown attribute passed to %a'; is $@->ident, 'format', '%a error ident should be "format"'; is $@->message, __x( '{attr} is not a valid change attribute', attr => 'foo' ), '%a error message should be correct'; delete $ENV{ANSI_COLORS_DISABLED}; for my $color (qw(yellow red blue cyan magenta)) { is $formatter->format( "%{$color}C", {} ), color($color), qq{Format "%{$color}C" should output } . color($color) . $color . color('reset'); } for my $spec ( [ ':event', { event => 'deploy' }, 'green', 'deploy' ], [ ':event', { event => 'revert' }, 'blue', 'revert' ], [ ':event', { event => 'fail' }, 'red', 'fail' ], ) { is $formatter->format( "%{$spec->[0]}C", $spec->[1] ), color($spec->[2]), qq{Format "%{$spec->[0]}C" on "$spec->[3]" should output } . color($spec->[2]) . $spec->[2] . color('reset'); } # Make sure other colors work. my $yellow = color('yellow') . '%s' . color('reset'); my $green = color('green') . '%s' . color('reset'); $event->{conflicts} = [qw(dr_evil)]; for my $spec ( [ full => sprintf($green, __ ('Deploy') . ' 000011112222333444') . " (\@beta, \@gamma)\n" . __ ('Name: ') . " lolz\n" . __ ('Project: ') . " logit\n" . __ ('Requires: ') . " foo, bar\n" . __ ('Conflicts:') . " dr_evil\n" . __ ('Planner: ') . " damian \n" . __ ('Planned: ') . " __PDATE__\n" . __ ('Committer:') . " larry \n" . __ ('Committed:') . " __CDATE__\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ long => sprintf($green, __ ('Deploy') . ' 000011112222333444') . " (\@beta, \@gamma)\n" . __ ('Name: ') . " lolz\n" . __ ('Project: ') . " logit\n" . __ ('Planner: ') . " damian \n" . __ ('Committer:') . " larry \n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ medium => sprintf($green, __ ('Deploy') . ' 000011112222333444') . "\n" . __ ('Name: ') . " lolz\n" . __ ('Committer:') . " larry \n" . __ ('Date: ') . " __CDATE__\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ short => sprintf($green, __ ('Deploy') . ' 000011112222333444') . "\n" . __ ('Name: ') . " lolz\n" . __ ('Committer:') . " larry \n\n" . " For the LOLZ.\n", ], [ oneline => sprintf "$green %s %s", '000011112222333444' . ' ' . __('deploy'), 'logit:lolz', 'For the LOLZ.', ], ) { my $format = $CLASS->configure( $config, { format => $spec->[0] } )->{format}; ok my $log = $CLASS->new( sqitch => $sqitch, format => $format ), qq{Instantiate with format "$spec->[0]" again}; (my $exp = $spec->[1]) =~ s/__CDATE__/$ciso/; $exp =~ s/__PDATE__/$piso/; is $log->formatter->format( $log->format, $event ), $exp, qq{Format "$spec->[0]" should output correctly with color}; } throws_ok { $formatter->format( '%{BLUELOLZ}C', {} ) } 'App::Sqitch::X', 'Should get an error for an invalid color'; is $@->ident, 'format', 'Invalid color error ident should be "format"'; is $@->message, __x( '{color} is not a valid ANSI color', color => 'BLUELOLZ' ), 'Invalid color error message should be correct'; ############################################################################## # Test execute(). my $emock = Test::MockModule->new('App::Sqitch::Engine::sqlite'); $emock->mock(destination => 'flipr'); my $mock_target = Test::MockModule->new('App::Sqitch::Target'); my ($target_name_arg, $orig_meth); $target_name_arg = '_blah'; $mock_target->mock(new => sub { my $self = shift; my %p = @_; $target_name_arg = $p{name}; $self->$orig_meth(@_); }); $orig_meth = $mock_target->original('new'); # First test for uninitialized DB. my $init = 0; $emock->mock(initialized => sub { $init }); throws_ok { $log->execute } 'App::Sqitch::X', 'Should get exception for unititialied db'; is $@->ident, 'log', 'Uninit db error ident should be "log"'; is $@->exitval, 1, 'Uninit db exit val should be 1'; is $@->message, __x( 'Database {db} has not been initialized for Sqitch', db => 'db:sqlite:', ), 'Uninit db error message should be correct'; is $target_name_arg, undef, 'Should have passed undef to Target'; # Next, test for no events. $init = 1; $target_name_arg = '_blah'; my @events; my $iter = sub { shift @events }; my $search_args; $emock->mock(search_events => sub { shift; $search_args = [@_]; return $iter; }); $log = $CLASS->new(sqitch => $sqitch); throws_ok { $log->execute } 'App::Sqitch::X', 'Should get error for empty event table'; is $@->ident, 'log', 'no events error ident should be "log"'; is $@->exitval, 1, 'no events exit val should be 1'; is $@->message, __x( 'No events logged for {db}', db => 'flipr', ), 'no events error message should be correct'; is_deeply $search_args, [limit => 1], 'Search should have been limited to one row'; is $target_name_arg, undef, 'Should have passed undef to Target again'; # Okay, let's add some events. push @events => {}, $event; $target_name_arg = '_blah'; $log = $CLASS->new(sqitch => $sqitch); ok $log->execute, 'Execute log'; is $target_name_arg, undef, 'Should have passed undef to Target once more'; is_deeply $search_args, [ event => undef, change => undef, project => undef, committer => undef, limit => undef, offset => undef, direction => 'DESC' ], 'The proper args should have been passed to search_events'; is_deeply +MockOutput->get_page, [ [__x 'On database {db}', db => 'flipr'], [ $log->formatter->format( $log->format, $event ) ], ], 'The change should have been paged'; # Make sure a passed target is processed. push @events => {}, $event; $target_name_arg = '_blah'; ok $log->execute('db:sqlite:whatever.db'), 'Execute with target arg'; is $target_name_arg, 'db:sqlite:whatever.db', 'Target name should have been passed to Target'; is_deeply $search_args, [ event => undef, change => undef, project => undef, committer => undef, limit => undef, offset => undef, direction => 'DESC' ], 'The proper args should have been passed to search_events'; is_deeply +MockOutput->get_page, [ [__x 'On database {db}', db => 'flipr'], [ $log->formatter->format( $log->format, $event ) ], ], 'The change should have been paged'; # Make sure we can pass a plan file. push @events => {}, $event; $target_name_arg = '_blah'; ok $log->execute('t/sql/sqitch.plan'), 'Execute with plan arg'; is $target_name_arg, 'db:sqlite:', 'Default engine target should have been passed to Target'; is_deeply $search_args, [ event => undef, change => undef, project => undef, committer => undef, limit => undef, offset => undef, direction => 'DESC' ], 'The proper args should have been passed to search_events'; is_deeply +MockOutput->get_page, [ [__x 'On database {db}', db => 'flipr'], [ $log->formatter->format( $log->format, $event ) ], ], 'The change should have been paged'; # Set attributes and add more events. my $event2 = { event => 'revert', change_id => '84584584359345', change => 'barf', tags => [], committer_name => 'theory', committer_email => 'theory@example.com', committed_at => $cdt, note => 'Oh man this was a bad idea', }; push @events => {}, $event, $event2; isa_ok $log = $CLASS->new( sqitch => $sqitch, target => 'db:sqlite:foo.db', event => [qw(revert fail)], change_pattern => '.+', project_pattern => '.+', committer_pattern => '.+', max_count => 10, skip => 5, reverse => 1, ), $CLASS, 'log with attributes'; $target_name_arg = '_blah'; ok $log->execute, 'Execute log with attributes'; is $target_name_arg, $log->target, 'Should have passed target name to Target'; is_deeply $search_args, [ event => [qw(revert fail)], change => '.+', project => '.+', committer => '.+', limit => 10, offset => 5, direction => 'ASC' ], 'All params should have been passed to search_events'; is_deeply +MockOutput->get_page, [ [__x 'On database {db}', db => 'flipr'], [ $log->formatter->format( $log->format, $event ) ], [ $log->formatter->format( $log->format, $event2 ) ], ], 'Both changes should have been paged'; # Make sure we get a warning when both the option and the arg are specified. push @events => {}, $event; ok $log->execute('pg'), 'Execute log with attributes'; is $target_name_arg, 'db:pg:', 'Should have passed enginetarget to Target'; is_deeply +MockOutput->get_warn, [[__x( 'Too many targets specified; connecting to {target}', target => $log->target, )]], 'Should have got warning for two targets'; # Make sure we catch bad format codes. isa_ok $log = $CLASS->new( sqitch => $sqitch, format => '%Z', ), $CLASS, 'log with bad format'; push @events, {}, $event; $target_name_arg = '_blah'; throws_ok { $log->execute } 'App::Sqitch::X', 'Should get an exception for a bad format code'; is $@->ident, 'format', 'bad format code format error ident should be "format"'; is $@->message, __x( 'Unknown format code "{code}"', code => 'Z', ), 'bad format code format error message should be correct'; is $target_name_arg, $log->target, 'Should have passed target name to Target'; App-Sqitch-0.9996/t/mooseless.t000644 000767 000024 00000001022 13133201371 016465 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More; use File::Find qw(find); use Module::Runtime qw(use_module); my $test = sub { return unless $_ =~ /\.pm$/; my $module = $File::Find::name; $module =~ s!^(blib[/\\])?lib[/\\]!!; $module =~ s![/\\]!::!g; $module =~ s/\.pm$//; eval { use_module $module; }; if ($@) { diag "Couldn't load $module: $@"; undef $@; return; } ok ! $INC{'Moose.pm'}, "No moose in $module"; }; find($test, 'lib'); done_testing(); App-Sqitch-0.9996/t/multiplan.conf000644 000767 000024 00000000323 13133201371 017146 0ustar00davidstaff000000 000000 [core] engine = pg [engine "pg"] top_dir = engine reworked_dir = engine/reworked [engine "sqlite"] top_dir = engine reworked_dir = engine/reworked [engine "mysql"] top_dir = sql App-Sqitch-0.9996/t/mysql.t000755 000767 000024 00000037002 13133201371 015633 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use App::Sqitch::Target; use Test::MockModule; use Path::Class; use Try::Tiny; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use File::Temp 'tempdir'; use lib 't/lib'; use DBIEngineTest; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Engine::mysql'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.sys';} delete $ENV{MYSQL_PWD}; is_deeply [$CLASS->config_vars], [ target => 'any', registry => 'any', client => 'any', ], 'config_vars should return three vars'; my $sqitch = App::Sqitch->new( options => { engine => 'mysql'} ); my $target = App::Sqitch::Target->new(sqitch => $sqitch); isa_ok my $mysql = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS; my $client = 'mysql' . ($^O eq 'MSWin32' ? '.exe' : ''); my $uri = URI::db->new('db:mysql:'); is $mysql->client, $client, 'client should default to mysql'; is $mysql->registry, 'sqitch', 'registry default should be "sqitch"'; my $sqitch_uri = $uri->clone; $sqitch_uri->dbname('sqitch'); is $mysql->registry_uri, $sqitch_uri, 'registry_uri should be correct'; is $mysql->uri, $uri, qq{uri should be "$uri"}; is $mysql->registry_destination, 'db:mysql:sqitch', 'registry_destination should be the same as registry_uri'; my @std_opts = ( ($^O eq 'MSWin32' ? () : '--skip-pager' ), '--silent', '--skip-column-names', '--skip-line-numbers', ); my $mock_sqitch = Test::MockModule->new('App::Sqitch'); my $warning; $mock_sqitch->mock(warn => sub { shift; $warning = [@_] }); is_deeply [$mysql->mysql], [$client, @std_opts], 'mysql command should be std opts-only'; is_deeply $warning, [__x 'Database name missing in URI "{uri}"', uri => $mysql->uri ], 'Should have emitted a warning for no database name'; $mock_sqitch->unmock_all; $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI::db->new('db:mysql:foo'), ); isa_ok $mysql = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; ############################################################################## # Make sure config settings override defaults. my %config = ( 'engine.mysql.client' => '/path/to/mysql', 'engine.mysql.target' => 'db:mysql://foo.com/widgets', 'engine.mysql.registry' => 'meta', ); my $mock_config = Test::MockModule->new('App::Sqitch::Config'); $mock_config->mock(get => sub { $config{ $_[2] } }); my $mysql_version = 'mysql Ver 15.1 Distrib 10.0.15-MariaDB'; $mock_sqitch->mock(probe => sub { $mysql_version }); $target = App::Sqitch::Target->new(sqitch => $sqitch); ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another mysql'; is $mysql->client, '/path/to/mysql', 'client should be as configured'; is $mysql->uri->as_string, 'db:mysql://foo.com/widgets', 'URI should be as configured'; is $mysql->target->name, $mysql->uri->as_string, 'target name should be the URI'; is $mysql->destination, $mysql->uri->as_string, 'destination should be the URI'; is $mysql->registry, 'meta', 'registry should be as configured'; is $mysql->registry_uri->as_string, 'db:mysql://foo.com/meta', 'Sqitch DB URI should be the same as uri but with DB name "meta"'; is $mysql->registry_destination, $mysql->registry_uri->as_string, 'registry_destination should be the sqitch DB URL'; is_deeply [$mysql->mysql], [qw( /path/to/mysql --database widgets --host foo.com ), @std_opts], 'mysql command should be configured'; ############################################################################## # Make sure URI params get passed through to the client. $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI->new('db:mysql://foo.com/widgets?' . join( '&', 'mysql_compression=1', 'mysql_ssl=1', 'mysql_connect_timeout=20', 'mysql_init_command=BEGIN', 'mysql_socket=/dev/null', 'mysql_ssl_client_key=/foo/key', 'mysql_ssl_client_cert=/foo/cert', 'mysql_ssl_ca_file=/foo/cafile', 'mysql_ssl_ca_path=/foo/capath', 'mysql_ssl_cipher=blowfeld', 'mysql_client_found_rows=20', 'mysql_foo=bar', ), )); ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a mysql with query params'; is_deeply [$mysql->mysql], [qw( /path/to/mysql --database widgets --host foo.com ), @std_opts, qw( --compress --ssl --connect_timeout 20 --init-command BEGIN --socket /dev/null --ssl-key /foo/key --ssl-cert /foo/cert --ssl-ca /foo/cafile --ssl-capath /foo/capath --ssl-cipher blowfeld )], 'mysql command should be configured with query vals'; $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI->new('db:mysql://foo.com/widgets?' . join( '&', 'mysql_compression=0', 'mysql_ssl=0', 'mysql_connect_timeout=20', 'mysql_client_found_rows=20', 'mysql_foo=bar', ), )); ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a mysql with disabled query params'; is_deeply [$mysql->mysql], [qw( /path/to/mysql --database widgets --host foo.com ), @std_opts, qw( --connect_timeout 20 )], 'mysql command should not have disabled param options'; ############################################################################## # Now make sure that Sqitch options override configurations. $sqitch = App::Sqitch->new( options => { engine => 'mysql', client => '/some/other/mysql', }, ); $target = App::Sqitch::Target->new(sqitch => $sqitch); ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a mysql with sqitch with options'; is $mysql->client, '/some/other/mysql', 'client should be as optioned'; is $mysql->registry, 'meta', 'registry should be as configured'; is $mysql->registry_uri->as_string, 'db:mysql://foo.com/meta', 'Sqitch DB URI should be the same as uri but with DB name "meta"'; is $mysql->registry_destination, 'db:mysql://foo.com/meta', 'registry_destination should be the sqitch DB URL sans password'; is $mysql->registry, 'meta', 'registry should still be as configured'; is_deeply [$mysql->mysql], [qw( /some/other/mysql --database widgets --host foo.com ), @std_opts], 'mysql command should be as optioned'; ############################################################################## # Test _run(), _capture(), and _spool(). can_ok $mysql, qw(_run _capture _spool); my (@run, $exp_pass); $mock_sqitch->mock(run => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @run = @_; if (defined $exp_pass) { is $ENV{MYSQL_PWD}, $exp_pass, qq{MYSQL_PWD should be "$exp_pass"}; } else { ok !exists $ENV{MYSQL_PWD}, 'MYSQL_PWD should not exist'; } }); my @capture; $mock_sqitch->mock(capture => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @capture = @_; if (defined $exp_pass) { is $ENV{MYSQL_PWD}, $exp_pass, qq{MYSQL_PWD should be "$exp_pass"}; } else { ok !exists $ENV{MYSQL_PWD}, 'MYSQL_PWD should not exist'; } }); my @spool; $mock_sqitch->mock(spool => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @spool = @_; if (defined $exp_pass) { is $ENV{MYSQL_PWD}, $exp_pass, qq{MYSQL_PWD should be "$exp_pass"}; } else { ok !exists $ENV{MYSQL_PWD}, 'MYSQL_PWD should not exist'; } }); $target = App::Sqitch::Target->new(sqitch => $sqitch); ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a mysql with sqitch with options'; $exp_pass = 's3cr3t'; $target->uri->password($exp_pass); ok $mysql->_run(qw(foo bar baz)), 'Call _run'; is_deeply \@run, [$mysql->mysql, qw(foo bar baz)], 'Command should be passed to run()'; ok $mysql->_spool('FH'), 'Call _spool'; is_deeply \@spool, [['FH'], $mysql->mysql], 'Command should be passed to spool()'; $mysql->set_variables(foo => 'bar', '"that"' => "'this'"); ok $mysql->_spool('FH'), 'Call _spool with variables'; ok my $fh = shift @{ $spool[0] }, 'Get variables file handle'; is_deeply \@spool, [['FH'], $mysql->mysql], 'Command should be passed to spool() after variables handle'; is join("\n", <$fh>), qq{SET \@"""that""" = '''this''', \@"foo" = 'bar';\n}, 'Variables should have been escaped and set'; $mysql->clear_variables; ok $mysql->_capture(qw(foo bar baz)), 'Call _capture'; is_deeply \@capture, [$mysql->mysql, qw(foo bar baz)], 'Command should be passed to capture()'; # Without password. $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a mysql with sqitch with no pw'; $exp_pass = undef; $target->uri->password($exp_pass); ok $mysql->_run(qw(foo bar baz)), 'Call _run again'; is_deeply \@run, [$mysql->mysql, qw(foo bar baz)], 'Command should be passed to run() again'; ok $mysql->_spool('FH'), 'Call _spool again'; is_deeply \@spool, [['FH'], $mysql->mysql], 'Command should be passed to spool() again'; ok $mysql->_capture(qw(foo bar baz)), 'Call _capture again'; is_deeply \@capture, [$mysql->mysql, qw(foo bar baz)], 'Command should be passed to capture() again'; ############################################################################## # Test file and handle running. ok $mysql->run_file('foo/bar.sql'), 'Run foo/bar.sql'; is_deeply \@run, [$mysql->mysql, '--execute', 'source foo/bar.sql'], 'File should be passed to run()'; @run = (); ok $mysql->run_handle('FH'), 'Spool a "file handle"'; is_deeply \@spool, [['FH'], $mysql->mysql], 'Handle should be passed to spool()'; @spool = (); # Verify should go to capture unless verosity is > 1. ok $mysql->run_verify('foo/bar.sql'), 'Verify foo/bar.sql'; is_deeply \@capture, [$mysql->mysql, '--execute', 'source foo/bar.sql'], 'Verify file should be passed to capture()'; @capture = (); $mock_sqitch->mock(verbosity => 2); ok $mysql->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again'; is_deeply \@run, [$mysql->mysql, '--execute', 'source foo/bar.sql'], 'Verifile file should be passed to run() for high verbosity'; @run = (); # Try with variables. $mysql->set_variables(foo => 'bar', '"that"' => "'this'"); my $set = qq{SET \@"""that""" = '''this''', \@"foo" = 'bar';\n}; ok $mysql->run_file('foo/bar.sql'), 'Run foo/bar.sql with vars'; is_deeply \@run, [$mysql->mysql, '--execute', "${set}source foo/bar.sql"], 'Variabls and file should be passed to run()'; @run = (); ok $mysql->run_handle('FH'), 'Spool a "file handle"'; ok $fh = shift @{ $spool[0] }, 'Get variables file handle'; is_deeply \@spool, [['FH'], $mysql->mysql], 'File handle should be passed to spool() after variables handle'; is join("\n", <$fh>), $set, 'Variables should have been escaped and set'; @spool = (); ok $mysql->run_verify('foo/bar.sql'), 'Verbosely verify foo/bar.sql with vars'; is_deeply \@run, [$mysql->mysql, '--execute', "${set}source foo/bar.sql"], 'Variables and verify file should be passed to run()'; @run = (); # Reset verbosity to send verify to spool. $mock_sqitch->unmock('verbosity'); ok $mysql->run_verify('foo/bar.sql'), 'Verify foo/bar.sql with vars'; is_deeply \@capture, [$mysql->mysql, '--execute', "${set}source foo/bar.sql"], 'Verify file should be passed to capture()'; @capture = (); $mysql->clear_variables; $mock_sqitch->unmock_all; $mock_config->unmock_all; ############################################################################## # Test DateTime formatting stuff. can_ok $CLASS, '_ts2char_format'; is sprintf($CLASS->_ts2char_format, 'foo'), q{date_format(foo, 'year:%Y:month:%m:day:%d:hour:%H:minute:%i:second:%S:time_zone:UTC')}, '_ts2char_format should work'; ok my $dtfunc = $CLASS->can('_dt'), "$CLASS->can('_dt')"; isa_ok my $dt = $dtfunc->( 'year:2012:month:07:day:05:hour:15:minute:07:second:01:time_zone:UTC' ), 'App::Sqitch::DateTime', 'Return value of _dt()'; is $dt->year, 2012, 'DateTime year should be set'; is $dt->month, 7, 'DateTime month should be set'; is $dt->day, 5, 'DateTime day should be set'; is $dt->hour, 15, 'DateTime hour should be set'; is $dt->minute, 7, 'DateTime minute should be set'; is $dt->second, 1, 'DateTime second should be set'; is $dt->time_zone->name, 'UTC', 'DateTime TZ should be set'; ############################################################################## # Can we do live tests? my $dbh; END { return unless $dbh; $dbh->{Driver}->visit_child_handles(sub { my $h = shift; $h->disconnect if $h->{Type} eq 'db' && $h->{Active} && $h ne $dbh; }); return unless $dbh->{Active}; $dbh->do("DROP DATABASE IF EXISTS $_") for qw( __sqitchtest__ __metasqitch __sqitchtest ); } my $err = try { $mysql->use_driver; $dbh = DBI->connect('dbi:mysql:database=information_schema', 'root', '', { PrintError => 0, RaiseError => 1, AutoCommit => 1, }); # Make sure we have a version we can use. if ($dbh->{mysql_serverinfo} =~ /mariadb/i) { die "MariaDB >= 50300 required; this is $dbh->{mysql_serverversion}\n" unless $dbh->{mysql_serverversion} >= 50300; } else { die "MySQL >= 50000 required; this is $dbh->{mysql_serverversion}\n" unless $dbh->{mysql_serverversion} >= 50000; } $dbh->do('CREATE DATABASE __sqitchtest__'); undef; } catch { eval { $_->message } || $_; }; DBIEngineTest->run( class => $CLASS, sqitch_params => [options => { engine => 'mysql', top_dir => Path::Class::dir(qw(t engine))->stringify, plan_file => Path::Class::file(qw(t engine sqitch.plan))->stringify, }], target_params => [ registry => '__metasqitch', uri => URI::db->new('db:mysql://root@/__sqitchtest__'), ], alt_target_params => [ registry => '__sqitchtest', uri => URI::db->new('db:mysql://root@/__sqitchtest__'), ], skip_unless => sub { my $self = shift; die $err if $err; # Make sure we have psql and can connect to the database. $self->sqitch->probe( $self->client, '--version' ); $self->_capture('--execute' => 'SELECT version()'); }, engine_err_regex => qr/^You have an error /, init_error => __x( 'Sqitch database {database} already initialized', database => '__sqitchtest', ), add_second_format => q{date_add(%s, interval 1 second)}, test_dbh => sub { my $dbh = shift; # Check the session configuration. for my $spec ( [character_set_client => 'utf8'], [character_set_server => 'utf8'], ($dbh->{mysql_serverversion} < 50500 ? () : ([default_storage_engine => 'InnoDB'])), [time_zone => '+00:00'], [group_concat_max_len => 32768], ) { is $dbh->selectcol_arrayref('SELECT @@SESSION.' . $spec->[0])->[0], $spec->[1], "Setting $spec->[0] should be set to $spec->[1]"; } # Special-case sql_mode. my $sql_mode = $dbh->selectcol_arrayref('SELECT @@SESSION.sql_mode')->[0]; for my $mode (qw( ansi strict_trans_tables no_auto_value_on_zero no_zero_date no_zero_in_date only_full_group_by error_for_division_by_zero )) { like $sql_mode, qr/\b\Q$mode\E\b/i, "sql_mode should include $mode"; } }, ); done_testing; App-Sqitch-0.9996/t/options.t000644 000767 000024 00000011374 13133201371 016162 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 26; #use Test::More 'no_plan'; use Test::MockModule; use Capture::Tiny 0.12 ':all'; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS; BEGIN { $CLASS = 'App::Sqitch'; use_ok $CLASS or die; } ############################################################################## # Test _split_args. can_ok $CLASS, '_split_args'; is_deeply [ $CLASS->_split_args('help') ], [[], 'help', []], 'Split on command-only'; is_deeply [ $CLASS->_split_args('--help', 'help') ], [ ['--help'], 'help', [], ], 'Split on core option plus command'; is_deeply [ $CLASS->_split_args('--help', 'help', '--foo') ], [ ['--help'], 'help', ['--foo'], ], 'Split on core option plus command plus command option'; is_deeply [ $CLASS->_split_args('--plan-file', 'foo', 'help', '--foo') ], [ ['--plan-file', 'foo'], 'help', ['--foo'], ], 'Option with arg should work'; is_deeply [$CLASS->_split_args(qw( --plan-file foo help --foo ))], [ ['--plan-file', 'foo'], 'help', ['--foo'], ], 'Option with arg should work'; is_deeply [ $CLASS->_split_args('--help') ], [['--help'], undef, []], 'Should handle no command'; is_deeply [ $CLASS->_split_args('-vvv', 'deploy') ], [['-vvv'], 'deploy', []], 'Spliting args when using bundling should work'; # Make sure an invalid option is caught. INVALID: { my $mocker = Test::MockModule->new($CLASS); $mocker->mock(_pod2usage => sub { pass '_pod2usage should be called' }); is capture_stderr { $CLASS->_split_args('--foo', 'foo', 'help', '--bar') }, "Unknown option: foo\n", 'Should exit for invalid option'; } ############################################################################## # Test _parse_core_opts can_ok $CLASS, '_parse_core_opts'; is_deeply $CLASS->_parse_core_opts([]), {}, 'Should have default config for no options'; # Make sure we can get help. HELP: { my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(_pod2usage => sub { @args = @_} ); ok $CLASS->_parse_core_opts(['--help']), 'Ask for help'; is_deeply \@args, [ $CLASS, 'sqitchcommands', '-exitval', 0, '-verbose', 2 ], 'Should have been helped'; ok $CLASS->_parse_core_opts(['--man']), 'Ask for man'; is_deeply \@args, [ $CLASS, 'sqitch', '-exitval', 0, '-verbose', 2 ], 'Should have been manned'; } # Silence warnings. my $mock = Test::MockModule->new($CLASS); $mock->mock(warn => undef); ############################################################################## # Try lots of options. my $opts = $CLASS->_parse_core_opts([ '--plan-file' => 'plan.txt', '--engine' => 'pg', '--registry' => 'reg', '--client' => 'psql', '--db-name' => 'try', '--db-user' => 'bob', '--db-host' => 'local', '--db-port' => 2020, '--top-dir' => 'ddl', '--deploy-dir' => 'dep', '--revert-dir' => 'rev', '--verify-dir' => 'tst', '--extension' => 'ext', '--verbose', '--verbose', ]); is_deeply $opts, { plan_file => 'plan.txt', engine => 'pg', registry => 'reg', client => 'psql', db_name => 'try', db_username => 'bob', db_host => 'local', db_port => 2020, top_dir => 'ddl', deploy_dir => 'dep', revert_dir => 'rev', verify_dir => 'tst', extension => 'ext', verbosity => 2, }, 'Should parse lots of options'; for my $dir (qw( top_dir deploy_dir revert_dir verify_dir )) { isa_ok $opts->{$dir}, 'Path::Class::Dir', $dir; } # Make sure --quiet trumps --verbose. is_deeply $CLASS->_parse_core_opts([ '--verbose', '--verbose', '--quiet' ]), { verbosity => 0 }, '--quiet should trump verbosity.'; ############################################################################## # Try short options. is_deeply $CLASS->_parse_core_opts([ '-d' => 'mydb', '-u' => 'fred', '-h' => 'db1', '-p' => 5431, '-f' => 'foo.plan', '-vvv', ]), { db_name => 'mydb', db_username => 'fred', db_host => 'db1', db_port => 5431, verbosity => 3, plan_file => 'foo.plan', }, 'Short options should work'; USAGE: { my $mock = Test::MockModule->new('Pod::Usage'); my %args; $mock->mock(pod2usage => sub { %args = @_} ); ok $CLASS->_pod2usage('sqitch-add', foo => 'bar'), 'Run _pod2usage'; is_deeply \%args, { '-sections' => '(?i:(Usage|Synopsis|Options))', '-verbose' => 2, '-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch-add'), '-exitval' => 2, 'foo' => 'bar', }, 'Proper args should have been passed to Pod::Usage'; } App-Sqitch-0.9996/t/oracle.t000644 000767 000024 00000044745 13133201371 015744 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w # Environment variables required to test: # # * ORAUSER # * ORAPASS # * TWO_TASK # # Tests can be run against the Developer Days VM with a bit of configuration. # Download the VM from: # # http://www.oracle.com/technetwork/database/enterprise-edition/databaseappdev-vm-161299.html # # Once the VM is imported into VirtualBox and started, login with the username # "oracle" and the password "oracle". Then, in VirtualBox, go to Settings -> # Network, select the NAT adapter, and add two port forwarding rules # (http://barrymcgillin.blogspot.com/2011/12/using-oracle-developer-days-virtualbox.html): # # Host Port | Guest Port # -----------+------------ # 1521 | 1521 # 2222 | 22 # # Then restart the VM. You should then be able to connect from your host with: # # sqlplus sys/oracle@localhost/ORCL as sysdba # # If this fails with either of these errors: # # ORA-01017: invalid username/password; logon denied # ORA-21561: OID generation failed # # Make sure that your computer's hostname is on the localhost line of # /etc/hosts (http://sourceforge.net/p/tora/discussion/52737/thread/f68b89ad/): # # > hostname # stickywicket # > grep 127 /etc/hosts # 127.0.0.1 localhost stickywicket # # Once connected, execute this SQL to create the user and give it access: # # CREATE USER sqitchtest IDENTIFIED BY oracle; # GRANT ALL PRIVILEGES TO sqitchtest; # # Now the tests can be run with: # # ORAUSER=sqitchtest ORAPASS=oracle TWO_TASK=localhost/ORCL prove -lv t/oracle.t use strict; use warnings; use 5.010; use Test::More 0.94; use Test::MockModule; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use Capture::Tiny 0.12 qw(:all); use Try::Tiny; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; use lib 't/lib'; use DBIEngineTest; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Engine::oracle'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.sys'; delete $ENV{ORACLE_HOME}; } is_deeply [$CLASS->config_vars], [ target => 'any', registry => 'any', client => 'any', ], 'config_vars should return three vars'; my $sqitch = App::Sqitch->new(options => { engine => 'oracle' }); my $target = App::Sqitch::Target->new(sqitch => $sqitch); isa_ok my $ora = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS; my $client = 'sqlplus' . ($^O eq 'MSWin32' ? '.exe' : ''); is $ora->client, $client, 'client should default to sqlplus'; ORACLE_HOME: { local $ENV{ORACLE_HOME} = '/foo/bar'; my $target = App::Sqitch::Target->new(sqitch => $sqitch); isa_ok my $ora = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS; is $ora->client, Path::Class::file('/foo/bar', $client)->stringify, 'client should use $ORACLE_HOME'; } is $ora->registry, '', 'registry default should be empty'; is $ora->uri, 'db:oracle:', 'Default URI should be "db:oracle"'; my $dest_uri = $ora->uri->clone; $dest_uri->dbname( $ENV{TWO_TASK} || ($^O eq 'MSWin32' ? $ENV{LOCAL} : undef) || $ENV{ORACLE_SID} || $sqitch->sysuser ); is $ora->target->name, $ora->uri, 'Target name should be the uri stringified'; is $ora->destination, $dest_uri->as_string, 'Destination should fall back on environment variables'; is $ora->registry_destination, $ora->destination, 'Registry target should be the same as target'; my @std_opts = qw(-S -L /nolog); is_deeply [$ora->sqlplus], [$client, @std_opts], 'sqlplus command should connect to /nolog'; is $ora->_script, join( "\n" => ( 'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF', 'WHENEVER OSERROR EXIT 9;', 'WHENEVER SQLERROR EXIT SQL.SQLCODE;', 'connect ', $ora->_registry_variable, ) ), '_script should work'; # Set up a target URI. $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI::db->new('db:oracle://fred:derf@/blah') ); isa_ok $ora = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; is $ora->_script, join( "\n" => ( 'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF', 'WHENEVER OSERROR EXIT 9;', 'WHENEVER SQLERROR EXIT SQL.SQLCODE;', 'connect fred/"derf"@"blah"', $ora->_registry_variable, ) ), '_script should assemble connection string'; # Add a host name. $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI::db->new('db:oracle://fred:derf@there/blah') ); isa_ok $ora = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; is $ora->_script('@foo'), join( "\n" => ( 'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF', 'WHENEVER OSERROR EXIT 9;', 'WHENEVER SQLERROR EXIT SQL.SQLCODE;', 'connect fred/"derf"@//there/"blah"', $ora->_registry_variable, '@foo', ) ), '_script should assemble connection string with host'; # Add a port and varibles. $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI::db->new( 'db:oracle://fred:derf%20%22derf%22@there:1345/blah%20%22blah%22' ), ); isa_ok $ora = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; ok $ora->set_variables(foo => 'baz', whu => 'hi there', yo => q{"stellar"}), 'Set some variables'; is $ora->_script, join( "\n" => ( 'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF', 'WHENEVER OSERROR EXIT 9;', 'WHENEVER SQLERROR EXIT SQL.SQLCODE;', 'DEFINE foo="baz"', 'DEFINE whu="hi there"', 'DEFINE yo="""stellar"""', 'connect fred/"derf ""derf"""@//there:1345/"blah ""blah"""', $ora->_registry_variable, ) ), '_script should assemble connection string with host, port, and vars'; # Try a URI with nothing but the database name. $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI::db->new('db:oracle:secure_user_tns.tpg'), ); is $target->uri->dbi_dsn, 'dbi:Oracle:secure_user_tns.tpg', 'Database-only URI should produce proper DSN'; isa_ok $ora = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; is $ora->_script('@foo'), join( "\n" => ( 'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF', 'WHENEVER OSERROR EXIT 9;', 'WHENEVER SQLERROR EXIT SQL.SQLCODE;', 'connect /@"secure_user_tns.tpg"', $ora->_registry_variable, '@foo', ) ), '_script should assemble connection string with just dbname'; # Try a URI with double slash, but otherwise just the db name. $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI::db->new('db:oracle://:@/wallet_tns_name'), ); is $target->uri->dbi_dsn, 'dbi:Oracle:wallet_tns_name', 'Database and double-slash URI should produce proper DSN'; isa_ok $ora = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; is $ora->_script('@foo'), join( "\n" => ( 'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF', 'WHENEVER OSERROR EXIT 9;', 'WHENEVER SQLERROR EXIT SQL.SQLCODE;', 'connect /@"wallet_tns_name"', $ora->_registry_variable, '@foo', ) ), '_script should assemble connection string with double-slash and dbname'; ############################################################################## # Test other configs for the destination. $target = App::Sqitch::Target->new(sqitch => $sqitch); ENV: { # Make sure we override system-set vars. local $ENV{TWO_TASK}; local $ENV{ORACLE_SID}; for my $env (qw(TWO_TASK ORACLE_SID)) { my $ora = $CLASS->new(sqitch => $sqitch, target => $target); local $ENV{$env} = '$ENV=whatever'; is $ora->target->name, "db:oracle:", "Target name should not read \$$env"; is $ora->destination, "db:oracle:\$ENV=whatever", "Destination should read \$$env"; is $ora->registry_destination, $ora->destination, 'Registry destination should be the same as destination'; } my $mocker = Test::MockModule->new('App::Sqitch'); $mocker->mock(sysuser => 'sysuser=whatever'); my $ora = $CLASS->new(sqitch => $sqitch, target => $target); is $ora->target->name, 'db:oracle:', 'Target name should not fall back on sysuser'; is $ora->destination, 'db:oracle:sysuser=whatever', 'Destination should fall back on sysuser'; is $ora->registry_destination, $ora->destination, 'Registry destination should be the same as destination'; $ENV{TWO_TASK} = 'mydb'; $ora = $CLASS->new(sqitch => $sqitch, username => 'hi', target => $target); is $ora->target->name, 'db:oracle:', 'Target should be the default'; is $ora->destination, 'db:oracle:mydb', 'Destination should prefer $TWO_TASK to username'; is $ora->registry_destination, $ora->destination, 'Registry destination should be the same as destination'; } ############################################################################## # Make sure config settings override defaults. my %config = ( 'engine.oracle.client' => '/path/to/sqlplus', 'engine.oracle.target' => 'db:oracle://bob:hi@db.net:12/howdy', 'engine.oracle.registry' => 'meta', ); my $mock_config = Test::MockModule->new('App::Sqitch::Config'); $mock_config->mock(get => sub { $config{ $_[2] } }); $target = App::Sqitch::Target->new(sqitch => $sqitch); ok $ora = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another ora'; is $ora->client, '/path/to/sqlplus', 'client should be as configured'; is $ora->uri->as_string, 'db:oracle://bob:hi@db.net:12/howdy', 'DB URI should be as configured'; like $ora->target->name, qr{^db:oracle://bob:?\@db\.net:12/howdy$}, 'Target name should be the passwordless URI stringified'; like $ora->destination, qr{^db:oracle://bob:?\@db\.net:12/howdy$}, 'Destination should be the URI without the password'; is $ora->registry_destination, $ora->destination, 'registry_destination should replace be the same URI'; is $ora->registry, 'meta', 'registry should be as configured'; is_deeply [$ora->sqlplus], ['/path/to/sqlplus', @std_opts], 'sqlplus command should be configured'; %config = ( 'engine.oracle.client' => '/path/to/sqlplus', 'engine.oracle.registry' => 'meta', ); $target = App::Sqitch::Target->new(sqitch => $sqitch); ok $ora = $CLASS->new(sqitch => $sqitch, target => $target), 'Create yet another ora'; is $ora->client, '/path/to/sqlplus', 'client should be as configured'; is $ora->registry, 'meta', 'registry should be as configured'; is_deeply [$ora->sqlplus], ['/path/to/sqlplus', @std_opts], 'sqlplus command should be configured'; ############################################################################## # Now make sure that Sqitch options override configurations. $sqitch = App::Sqitch->new( options => { engine => 'oracle', client => '/some/other/sqlplus', }, ); $target = App::Sqitch::Target->new(sqitch => $sqitch); ok $ora = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a ora with sqitch with options'; is $ora->client, '/some/other/sqlplus', 'client should be as optioned'; is $ora->registry, 'meta', 'registry should still be as configured'; is_deeply [$ora->sqlplus], ['/some/other/sqlplus', @std_opts], 'sqlplus command should be as optioned'; ############################################################################## # Test _run() and _capture(). can_ok $ora, qw(_run _capture); my $mock_sqitch = Test::MockModule->new('App::Sqitch'); my (@capture, @spool); $mock_sqitch->mock(spool => sub { shift; @spool = @_ }); my $mock_run3 = Test::MockModule->new('IPC::Run3'); $mock_run3->mock(run3 => sub { @capture = @_ }); ok $ora->_run(qw(foo bar baz)), 'Call _run'; my $fh = shift @spool; is_deeply \@spool, [$ora->sqlplus], 'SQLPlus command should be passed to spool()'; is join('', <$fh> ), $ora->_script(qw(foo bar baz)), 'The script should be spooled'; ok $ora->_capture(qw(foo bar baz)), 'Call _capture'; is_deeply \@capture, [ [$ora->sqlplus], \$ora->_script(qw(foo bar baz)), [], { return_if_system_error => 1 }, ], 'Command and script should be passed to run3()'; # Let's make sure that IPC::Run3 actually works as expected. $mock_run3->unmock_all; my $echo = Path::Class::file(qw(t echo.pl)); my $mock_ora = Test::MockModule->new($CLASS); $mock_ora->mock(sqlplus => sub { $^X, $echo, qw(hi there) }); is join (', ' => $ora->_capture(qw(foo bar baz))), "hi there\n", '_capture should actually capture'; # Make it die. my $die = Path::Class::file(qw(t die.pl)); $mock_ora->mock(sqlplus => sub { $^X, $die, qw(hi there) }); like capture_stderr { throws_ok { $ora->_capture('whatever'), } 'App::Sqitch::X', '_capture should die when sqlplus dies'; }, qr/^OMGWTF/, 'STDERR should be emitted by _capture'; ############################################################################## # Test _file_for_script(). can_ok $ora, '_file_for_script'; is $ora->_file_for_script(Path::Class::file 'foo'), 'foo', 'File without special characters should be used directly'; is $ora->_file_for_script(Path::Class::file '"foo"'), '""foo""', 'Double quotes should be SQL-escaped'; # Get the temp dir used by the engine. ok my $tmpdir = $ora->tmpdir, 'Get temp dir'; isa_ok $tmpdir, 'Path::Class::Dir', 'Temp dir'; # Make sure a file with @ is aliased. my $file = $tmpdir->file('foo@bar.sql'); $file->touch; # File must exist, because on Windows it gets copied. is $ora->_file_for_script($file), $tmpdir->file('foo_bar.sql'), 'File with special char should be aliased'; # Make sure double-quotes are escaped. WIN32: { $file = $tmpdir->file('"foo$bar".sql'); my $mock_file = Test::MockModule->new(ref $file); # Windows doesn't like the quotation marks, so prevent it from writing. $mock_file->mock(copy_to => 1) if $^O eq 'MSWin32'; is $ora->_file_for_script($file), $tmpdir->file('""foo_bar"".sql'), 'File with special char and quotes should be aliased'; } ############################################################################## # Test file and handle running. my @run; $mock_ora->mock(_run => sub {shift; @run = @_ }); ok $ora->run_file('foo/bar.sql'), 'Run foo/bar.sql'; is_deeply \@run, ['@"foo/bar.sql"'], 'File should be passed to run()'; ok $ora->run_file('foo/"bar".sql'), 'Run foo/"bar".sql'; is_deeply \@run, ['@"foo/""bar"".sql"'], 'Double quotes in file passed to run() should be escaped'; ok $ora->run_handle('FH'), 'Spool a "file handle"'; my $handles = shift @spool; is_deeply \@spool, [$ora->sqlplus], 'sqlplus command should be passed to spool()'; isa_ok $handles, 'ARRAY', 'Array ove handles should be passed to spool'; $fh = $handles->[0]; is join('', <$fh>), $ora->_script, 'First file handle should be script'; is $handles->[1], 'FH', 'Second should be the passed handle'; # Verify should go to capture unless verosity is > 1. $mock_ora->mock(_capture => sub {shift; @capture = @_ }); ok $ora->run_verify('foo/bar.sql'), 'Verify foo/bar.sql'; is_deeply \@capture, ['@"foo/bar.sql"'], 'Verify file should be passed to capture()'; $mock_sqitch->mock(verbosity => 2); ok $ora->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again'; is_deeply \@run, ['@"foo/bar.sql"'], 'Verifile file should be passed to run() for high verbosity'; $mock_sqitch->unmock_all; $mock_config->unmock_all; $mock_ora->unmock_all; ############################################################################## # Test DateTime formatting stuff. ok my $ts2char = $CLASS->can('_ts2char'), "$CLASS->can('_ts2char')"; is $ts2char->('foo'), q{to_char(foo AT TIME ZONE 'UTC', 'YYYY:MM:DD:HH24:MI:SS')}, '_ts2char should work'; ok my $dtfunc = $CLASS->can('_dt'), "$CLASS->can('_dt')"; isa_ok my $dt = $dtfunc->( 'year:2012:month:07:day:05:hour:15:minute:07:second:01:time_zone:UTC' ), 'App::Sqitch::DateTime', 'Return value of _dt()'; is $dt->year, 2012, 'DateTime year should be set'; is $dt->month, 7, 'DateTime month should be set'; is $dt->day, 5, 'DateTime day should be set'; is $dt->hour, 15, 'DateTime hour should be set'; is $dt->minute, 7, 'DateTime minute should be set'; is $dt->second, 1, 'DateTime second should be set'; is $dt->time_zone->name, 'UTC', 'DateTime TZ should be set'; ############################################################################## # Can we do live tests? if ($^O eq 'MSWin32' && eval { require Win32::API}) { # Call kernel32.SetErrorMode(SEM_FAILCRITICALERRORS): # "The system does not display the critical-error-handler message box. # Instead, the system sends the error to the calling process." and # "A child process inherits the error mode of its parent process." my $SetErrorMode = Win32::API->new('kernel32', 'SetErrorMode', 'I', 'I'); my $SEM_FAILCRITICALERRORS = 0x0001; $SetErrorMode->Call($SEM_FAILCRITICALERRORS); } my $dbh; END { return unless $dbh; $dbh->{Driver}->visit_child_handles(sub { my $h = shift; $h->disconnect if $h->{Type} eq 'db' && $h->{Active} && $h ne $dbh; }); $dbh->{RaiseError} = 0; $dbh->{PrintError} = 1; $dbh->do($_) for ( 'DROP TABLE events', 'DROP TABLE dependencies', 'DROP TABLE tags', 'DROP TABLE changes', 'DROP TABLE projects', 'DROP TABLE releases', 'DROP TYPE sqitch_array', 'DROP TABLE oe.events', 'DROP TABLE oe.dependencies', 'DROP TABLE oe.tags', 'DROP TABLE oe.changes', 'DROP TABLE oe.projects', 'DROP TABLE oe.releases', 'DROP TYPE oe.sqitch_array', ); } my $user = $ENV{ORAUSER} || 'scott'; my $pass = $ENV{ORAPASS} || 'tiger'; my $err = try { $ora->use_driver; my $dsn = 'dbi:Oracle:'; $dbh = DBI->connect($dsn, $user, $pass, { PrintError => 0, RaiseError => 1, AutoCommit => 1, }); undef; } catch { eval { $_->message } || $_; }; my $uri = URI->new('db:oracle:'); $uri->user($user); $uri->password($pass); # $uri->dbname( $ENV{TWO_TASK} || $ENV{LOCAL} || $ENV{ORACLE_SID} ); DBIEngineTest->run( class => $CLASS, sqitch_params => [options => { engine => 'oracle', top_dir => Path::Class::dir(qw(t engine)), plan_file => Path::Class::file(qw(t engine sqitch.plan)), }], target_params => [ uri => $uri ], alt_target_params => [ uri => $uri, registry => 'oe' ], skip_unless => sub { my $self = shift; die $err if $err; # Make sure we have sqlplus and can connect to the database. $self->sqitch->probe( $self->client, '-v' ); $self->_capture('SELECT 1 FROM dual;'); }, engine_err_regex => qr/^ORA-00925: /, init_error => __ 'Sqitch already initialized', add_second_format => q{%s + interval '1' second}, ); done_testing; App-Sqitch-0.9996/t/pg.t000644 000767 000024 00000026304 13133201371 015074 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More 0.94; use Test::MockModule; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use Capture::Tiny 0.12 qw(:all); use Try::Tiny; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; use lib 't/lib'; use DBIEngineTest; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Engine::pg'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.sys'; delete $ENV{PGPASSWORD}; } is_deeply [$CLASS->config_vars], [ target => 'any', registry => 'any', client => 'any', ], 'config_vars should return three vars'; my $uri = URI::db->new('db:pg:'); my $sqitch = App::Sqitch->new(options => { engine => 'pg' }); my $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => $uri, ); isa_ok my $pg = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS; my $client = 'psql' . ($^O eq 'MSWin32' ? '.exe' : ''); is $pg->client, $client, 'client should default to psql'; is $pg->registry, 'sqitch', 'registry default should be "sqitch"'; is $pg->uri, $uri, 'DB URI should be "db:pg:"'; my $dest_uri = $uri->clone; $dest_uri->dbname($ENV{PGDATABASE} || $ENV{PGUSER} || $sqitch->sysuser); is $pg->destination, $dest_uri->as_string, 'Destination should fall back on environment variables'; is $pg->registry_destination, $pg->destination, 'Registry destination should be the same as destination'; my @std_opts = ( '--quiet', '--no-psqlrc', '--no-align', '--tuples-only', '--set' => 'ON_ERROR_STOP=1', '--set' => 'registry=sqitch', ); is_deeply [$pg->psql], [$client, @std_opts], 'psql command should be std opts-only'; isa_ok $pg = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS; ok $pg->set_variables(foo => 'baz', whu => 'hi there', yo => 'stellar'), 'Set some variables'; is_deeply [$pg->psql], [ $client, '--set' => 'foo=baz', '--set' => 'whu=hi there', '--set' => 'yo=stellar', @std_opts, ], 'Variables should be passed to psql via --set'; ############################################################################## # Test other configs for the target. ENV: { # Make sure we override system-set vars. local $ENV{PGDATABASE}; local $ENV{PGUSER}; for my $env (qw(PGDATABASE PGUSER)) { my $pg = $CLASS->new(sqitch => $sqitch, target => $target); local $ENV{$env} = "\$ENV=whatever"; is $pg->target->uri, "db:pg:", "Target should not read \$$env"; is $pg->registry_destination, $pg->destination, 'Meta target should be the same as destination'; } my $mocker = Test::MockModule->new('App::Sqitch'); $mocker->mock(sysuser => 'sysuser=whatever'); my $pg = $CLASS->new(sqitch => $sqitch, target => $target); is $pg->target->uri, 'db:pg:', 'Target should not fall back on sysuser'; is $pg->registry_destination, $pg->destination, 'Meta target should be the same as destination'; $ENV{PGDATABASE} = 'mydb'; $pg = $CLASS->new(sqitch => $sqitch, username => 'hi', target => $target); is $pg->target->uri, 'db:pg:', 'Target should be the default'; is $pg->registry_destination, $pg->destination, 'Meta target should be the same as destination'; } ############################################################################## # Make sure config settings override defaults. my %config = ( 'engine.pg.client' => '/path/to/psql', 'engine.pg.target' => 'db:pg://localhost/try', 'engine.pg.registry' => 'meta', ); $std_opts[-1] = 'registry=meta'; my $mock_config = Test::MockModule->new('App::Sqitch::Config'); $mock_config->mock(get => sub { $config{ $_[2] } }); $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok $pg = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another pg'; is $pg->client, '/path/to/psql', 'client should be as configured'; is $pg->uri->as_string, 'db:pg://localhost/try', 'uri should be as configured'; is $pg->registry, 'meta', 'registry should be as configured'; is_deeply [$pg->psql], [qw( /path/to/psql --dbname try --host localhost ), @std_opts], 'psql command should be configured from URI config'; ############################################################################## # Now make sure that (deprecated?) Sqitch options override configurations. $sqitch = App::Sqitch->new( options => { engine => 'pg', client => '/some/other/psql', } ); $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok $pg = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a pg with sqitch with options'; is $pg->client, '/some/other/psql', 'client should be as optioned'; is $pg->registry_destination, $pg->destination, 'registry_destination should be the same as destination'; is $pg->registry, 'meta', 'registry should still be as configured'; is_deeply [$pg->psql], [qw( /some/other/psql --dbname try --host localhost ), @std_opts], 'psql command should be as optioned'; ############################################################################## # Test _run(), _capture(), and _spool(). can_ok $pg, qw(_run _capture _spool); my $mock_sqitch = Test::MockModule->new('App::Sqitch'); my (@run, $exp_pass); $mock_sqitch->mock(run => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @run = @_; if (defined $exp_pass) { is $ENV{PGPASSWORD}, $exp_pass, qq{PGPASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{PGPASSWORD}, 'PGPASSWORD should not exist'; } }); my @capture; $mock_sqitch->mock(capture => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @capture = @_; if (defined $exp_pass) { is $ENV{PGPASSWORD}, $exp_pass, qq{PGPASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{PGPASSWORD}, 'PGPASSWORD should not exist'; } }); my @spool; $mock_sqitch->mock(spool => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @spool = @_; if (defined $exp_pass) { is $ENV{PGPASSWORD}, $exp_pass, qq{PGPASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{PGPASSWORD}, 'PGPASSWORD should not exist'; } }); $target->uri->password('s3cr3t'); $exp_pass = 's3cr3t'; ok $pg->_run(qw(foo bar baz)), 'Call _run'; is_deeply \@run, [$pg->psql, qw(foo bar baz)], 'Command should be passed to run()'; ok $pg->_spool('FH'), 'Call _spool'; is_deeply \@spool, ['FH', $pg->psql], 'Command should be passed to spool()'; ok $pg->_capture(qw(foo bar baz)), 'Call _capture'; is_deeply \@capture, [$pg->psql, qw(foo bar baz)], 'Command should be passed to capture()'; # Without password. $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok $pg = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a pg with sqitch with no pw'; $exp_pass = undef; ok $pg->_run(qw(foo bar baz)), 'Call _run again'; is_deeply \@run, [$pg->psql, qw(foo bar baz)], 'Command should be passed to run() again'; ok $pg->_spool('FH'), 'Call _spool again'; is_deeply \@spool, ['FH', $pg->psql], 'Command should be passed to spool() again'; ok $pg->_capture(qw(foo bar baz)), 'Call _capture again'; is_deeply \@capture, [$pg->psql, qw(foo bar baz)], 'Command should be passed to capture() again'; ############################################################################## # Test file and handle running. ok $pg->run_file('foo/bar.sql'), 'Run foo/bar.sql'; is_deeply \@run, [$pg->psql, '--file', 'foo/bar.sql'], 'File should be passed to run()'; ok $pg->run_handle('FH'), 'Spool a "file handle"'; is_deeply \@spool, ['FH', $pg->psql], 'Handle should be passed to spool()'; # Verify should go to capture unless verosity is > 1. ok $pg->run_verify('foo/bar.sql'), 'Verify foo/bar.sql'; is_deeply \@capture, [$pg->psql, '--file', 'foo/bar.sql'], 'Verify file should be passed to capture()'; $mock_sqitch->mock(verbosity => 2); ok $pg->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again'; is_deeply \@run, [$pg->psql, '--file', 'foo/bar.sql'], 'Verifile file should be passed to run() for high verbosity'; $mock_sqitch->unmock_all; $mock_config->unmock_all; ############################################################################## # Test DateTime formatting stuff. ok my $ts2char = $CLASS->can('_ts2char'), "$CLASS->can('_ts2char')"; is $ts2char->('foo'), q{to_char(foo AT TIME ZONE 'UTC', '"year":YYYY:"month":MM:"day":DD:"hour":HH24:"minute":MI:"second":SS:"time_zone":"UTC"')}, '_ts2char should work'; ok my $dtfunc = $CLASS->can('_dt'), "$CLASS->can('_dt')"; isa_ok my $dt = $dtfunc->( 'year:2012:month:07:day:05:hour:15:minute:07:second:01:time_zone:UTC' ), 'App::Sqitch::DateTime', 'Return value of _dt()'; is $dt->year, 2012, 'DateTime year should be set'; is $dt->month, 7, 'DateTime month should be set'; is $dt->day, 5, 'DateTime day should be set'; is $dt->hour, 15, 'DateTime hour should be set'; is $dt->minute, 7, 'DateTime minute should be set'; is $dt->second, 1, 'DateTime second should be set'; is $dt->time_zone->name, 'UTC', 'DateTime TZ should be set'; ############################################################################## # Can we do live tests? $sqitch = App::Sqitch->new( options => { engine => 'pg' } ); $target = App::Sqitch::Target->new( sqitch => $sqitch ); $pg = $CLASS->new(sqitch => $sqitch, target => $target); my $dbh; END { return unless $dbh; $dbh->{Driver}->visit_child_handles(sub { my $h = shift; $h->disconnect if $h->{Type} eq 'db' && $h->{Active} && $h ne $dbh; }); $dbh->do('DROP DATABASE __sqitchtest__') if $dbh->{Active}; } my $err = try { $pg->_capture('--version'); $pg->use_driver; $dbh = DBI->connect('dbi:Pg:dbname=template1', 'postgres', '', { PrintError => 0, RaiseError => 1, AutoCommit => 1, }); $dbh->do($_) for ( 'CREATE DATABASE __sqitchtest__', q{ALTER DATABASE __sqitchtest__ SET lc_messages = 'C'}, ); undef; } catch { eval { $_->message } || $_; }; DBIEngineTest->run( class => $CLASS, sqitch_params => [options => { engine => 'pg', top_dir => Path::Class::dir(qw(t engine))->stringify, plan_file => Path::Class::file(qw(t engine sqitch.plan))->stringify, }], target_params => [ uri => URI::db->new('db:pg://postgres@/__sqitchtest__'), ], alt_target_params => [ registry => '__sqitchtest', uri => URI::db->new('db:pg://postgres@/__sqitchtest__'), ], skip_unless => sub { my $self = shift; die $err if $err; # Make sure we have psql and can connect to the database. $self->sqitch->probe( $self->client, '--version' ); $self->_capture('--command' => 'SELECT version()'); }, engine_err_regex => qr/^ERROR: /, init_error => __x( 'Sqitch schema "{schema}" already exists', schema => '__sqitchtest', ), test_dbh => sub { my $dbh = shift; # Make sure the sqitch schema is the first in the search path. is $dbh->selectcol_arrayref('SELECT current_schema')->[0], '__sqitchtest', 'The Sqitch schema should be the current schema'; }, ); done_testing; App-Sqitch-0.9996/t/plan.t000644 000767 000024 00000234706 13133201371 015427 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More; use App::Sqitch; use App::Sqitch::Target; use Locale::TextDomain qw(App-Sqitch); use Path::Class; use Test::Exception; use Test::File; use Test::Deep; use Test::File::Contents; use Encode; #use Test::NoWarnings; use File::Path qw(make_path remove_tree); use App::Sqitch::DateTime; use lib 't/lib'; use MockOutput; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Plan'; use_ok $CLASS or die; } $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; can_ok $CLASS, qw( sqitch target file changes position load syntax_version project uri _parse check_changes open_script ); my $sqitch = App::Sqitch->new( options => { engine => 'sqlite' }); my $target = App::Sqitch::Target->new( sqitch => $sqitch ); isa_ok my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS; is $plan->file, $target->plan_file, 'File should be coopied from Target'; # Set up some some utility functions for creating changes. sub blank { App::Sqitch::Plan::Blank->new( plan => $plan, lspace => $_[0] // '', note => $_[1] // '', ); } my $prev_tag; my $prev_change; my %seen; sub clear { undef $prev_tag; undef $prev_change; %seen = (); return (); } my $ts = App::Sqitch::DateTime->new( year => 2012, month => 7, day => 16, hour => 17, minute => 25, second => 7, time_zone => 'UTC', ); sub ts($) { my $str = shift || return $ts; my @parts = split /[-:T]/ => $str; return App::Sqitch::DateTime->new( year => $parts[0], month => $parts[1], day => $parts[2], hour => $parts[3], minute => $parts[4], second => $parts[5], time_zone => 'UTC', ); } my $vivify = 0; my $project; sub dep($) { App::Sqitch::Plan::Depend->new( plan => $plan, (defined $project ? (project => $project) : ()), %{ App::Sqitch::Plan::Depend->parse(shift) }, ) } sub change($) { my $p = shift; if ( my $op = delete $p->{op} ) { @{ $p }{ qw(lopspace operator ropspace) } = split /([+-])/, $op; $p->{$_} //= '' for qw(lopspace ropspace); } $p->{requires} = [ map { dep $_ } @{ $p->{requires} } ] if $p->{requires}; $p->{conflicts} = [ map { dep "!$_" } @{ $p->{conflicts} }] if $p->{conflicts}; $prev_change = App::Sqitch::Plan::Change->new( plan => $plan, timestamp => ts delete $p->{ts}, planner_name => 'Barack Obama', planner_email => 'potus@whitehouse.gov', ( $prev_tag ? ( since_tag => $prev_tag ) : () ), ( $prev_change ? ( parent => $prev_change ) : () ), %{ $p }, ); if (my $duped = $seen{ $p->{name} }) { $duped->add_rework_tags(map { $seen{$_}-> tags } @{ $p->{rtag} }); } $seen{ $p->{name} } = $prev_change; if ($vivify) { $prev_change->id; $prev_change->old_id; $prev_change->tags; } return $prev_change; } sub tag($) { my $p = shift; my $ret = delete $p->{ret}; $prev_tag = App::Sqitch::Plan::Tag->new( plan => $plan, change => $prev_change, timestamp => ts delete $p->{ts}, planner_name => 'Barack Obama', planner_email => 'potus@whitehouse.gov', %{ $p }, ); $prev_change->add_tag($prev_tag); $prev_tag->id, $prev_tag->old_id if $vivify; return $ret ? $prev_tag : (); } sub prag { App::Sqitch::Plan::Pragma->new( plan => $plan, lspace => $_[0] // '', hspace => $_[1] // '', name => $_[2], (defined $_[3] ? (lopspace => $_[3]) : ()), (defined $_[4] ? (operator => $_[4]) : ()), (defined $_[5] ? (ropspace => $_[5]) : ()), (defined $_[6] ? (value => $_[6]) : ()), rspace => $_[7] // '', note => $_[8] // '', ); } my $mocker = Test::MockModule->new($CLASS); # Do no sorting for now. my $sorted = 0; sub sorted () { my $ret = $sorted; $sorted = 0; return $ret; } $mocker->mock(check_changes => sub { $sorted++; shift, shift, shift; @_ }); sub version () { prag( '', '', 'syntax-version', '', '=', '', App::Sqitch::Plan::SYNTAX_VERSION ); } ############################################################################## # Test parsing. my $file = file qw(t plans widgets.plan); my $fh = $file->open('<:utf8_strict'); ok my $parsed = $plan->_parse($file, $fh), 'Should parse simple "widgets.plan"'; is sorted, 1, 'Should have sorted changes'; isa_ok $parsed->{changes}, 'ARRAY', 'changes'; isa_ok $parsed->{lines}, 'ARRAY', 'lines'; cmp_deeply $parsed->{changes}, [ clear, change { name => 'hey', ts => '2012-07-16T14:01:20' }, change { name => 'you', ts => '2012-07-16T14:01:35' }, tag { name => 'foo', note => 'look, a tag!', ts => '2012-07-16T14:02:05', rspace => ' ' }, , ], 'All "widgets.plan" changes should be parsed'; cmp_deeply $parsed->{lines}, [ clear, version, prag( '', '', 'project', '', '=', '', 'widgets'), blank('', 'This is a note'), blank(), blank(' ', 'And there was a blank line.'), blank(), change { name => 'hey', ts => '2012-07-16T14:01:20' }, change { name => 'you', ts => '2012-07-16T14:01:35' }, tag { ret => 1, name => 'foo', note => 'look, a tag!', ts => '2012-07-16T14:02:05', rspace => ' ' }, ], 'All "widgets.plan" lines should be parsed'; # Plan with multiple tags. $file = file qw(t plans multi.plan); $fh = $file->open('<:utf8_strict'); ok $parsed = $plan->_parse($file, $fh), 'Should parse multi-tagged "multi.plan"'; is sorted, 2, 'Should have sorted changes twice'; cmp_deeply delete $parsed->{pragmas}, { syntax_version => App::Sqitch::Plan::SYNTAX_VERSION, project => 'multi', }, 'Should have captured the multi pragmas'; cmp_deeply $parsed, { changes => [ clear, change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' }, change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' }, tag { name => 'foo', note => 'look, a tag!', ts => '2012-07-16T17:24:07', rspace => ' ', planner_name => 'julie', planner_email => 'j@ul.ie', }, change { name => 'this/rocks', pspace => ' ' }, change { name => 'hey-there', note => 'trailing note!', rspace => ' ' }, tag { name =>, 'bar' }, tag { name => 'baz' }, ], lines => [ clear, version, prag( '', '', 'project', '', '=', '', 'multi'), blank('', 'This is a note'), blank(), blank('', 'And there was a blank line.'), blank(), change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' }, change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' }, tag { ret => 1, name => 'foo', note => 'look, a tag!', ts => '2012-07-16T17:24:07', rspace => ' ', planner_name => 'julie', planner_email => 'j@ul.ie', }, blank(' '), change { name => 'this/rocks', pspace => ' ' }, change { name => 'hey-there', note => 'trailing note!', rspace => ' ' }, tag { name =>, 'bar', ret => 1 }, tag { name => 'baz', ret => 1 }, ], }, 'Should have "multi.plan" lines and changes'; # Try a plan with changes appearing without a tag. $file = file qw(t plans changes-only.plan); $fh = $file->open('<:utf8_strict'); ok $parsed = $plan->_parse($file, $fh), 'Should read plan with no tags'; is sorted, 1, 'Should have sorted changes'; cmp_deeply delete $parsed->{pragmas}, { syntax_version => App::Sqitch::Plan::SYNTAX_VERSION, project => 'changes_only', }, 'Should have captured the changes-only pragmas'; cmp_deeply $parsed, { lines => [ clear, version, prag( '', '', 'project', '', '=', '', 'changes_only'), blank('', 'This is a note'), blank(), blank('', 'And there was a blank line.'), blank(), change { name => 'hey' }, change { name => 'you' }, change { name => 'whatwhatwhat' }, ], changes => [ clear, change { name => 'hey' }, change { name => 'you' }, change { name => 'whatwhatwhat' }, ], }, 'Should have lines and changes for tagless plan'; # Try plans with DOS line endings. $file = file qw(t plans dos.plan); $fh = $file->open('<:utf8_strict'); ok $parsed = $plan->_parse($file, $fh), 'Should read plan with DOS line endings'; is sorted, 1, 'Should have sorted changes'; cmp_deeply delete $parsed->{pragmas}, { syntax_version => App::Sqitch::Plan::SYNTAX_VERSION, project => 'dos', }, 'Should have captured the dos pragmas'; # Try a plan with a bad change name. $file = file qw(t plans bad-change.plan); $fh = $file->open('<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on plan with bad change name'; is $@->ident, 'parse', 'Bad change name error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 5, error => __( qq{Invalid name; names must not begin with punctuation, } . 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation', ), ), 'And the bad change name error message should be correct'; is sorted, 0, 'Should not have sorted changes'; my @bad_names = ( '^foo', # No leading punctuation 'foo^', # No trailing punctuation 'foo^6', # No trailing punctuation+digit 'foo^666', # No trailing punctuation+digits '%hi', # No leading punctuation 'hi!', # No trailing punctuation 'foo@bar', # No @ allowed at all 'foo:bar', # No : allowed at all '+foo', # No leading + '-foo', # No leading - '@foo', # No leading @ ); # Try other invalid change and tag name issues. my $prags = '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n%project=test\n\n"; for my $name (@bad_names) { for my $line ("+$name", "\@$name") { next if $line eq '%hi'; # This would be a pragma. my $buf = $prags . $line; my $what = $line =~ /^[@]/ ? 'tag' : 'change'; my $fh = IO::File->new(\$buf, '<:utf8_strict'); throws_ok { $plan->_parse('baditem', $fh) } 'App::Sqitch::X', qq{Should die on plan with bad name "$line"}; is $@->ident, 'parse', 'Exception ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => 'baditem', lineno => 4, error => __( qq{Invalid name; names must not begin with punctuation, } . 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation', ) ), qq{And "$line" should trigger the appropriate message}; is sorted, 0, 'Should not have sorted changes'; } } # Try some valid change and tag names. my $tsnp = '2012-07-16T17:25:07Z Barack Obama '; my $foo_proj = App::Sqitch::Plan::Pragma->new( plan => $plan, name => 'project', value => 'foo', operator => '=', ); for my $name ( 'foo', # alpha '12', # digits 't', # char '6', # digit '阱阪阬', # multibyte 'foo/bar', # middle punct 'beta1', # ending digit 'foo_', # ending underscore '_foo', # leading underscore 'v1.0-1b', # punctuation followed by digit in middle 'v1.2-1', # version number with dash 'v1.2+1', # version number with plus 'v1.2_1', # version number with underscore ) { # Test a change name. my $lines = encode_utf8 "\%project=foo\n\n$name $tsnp"; my $fh = IO::File->new(\$lines, '<:utf8_strict'); ok my $parsed = $plan->_parse('ooditem', $fh), encode_utf8(qq{Should parse "$name"}); cmp_deeply delete $parsed->{pragmas}, { syntax_version => App::Sqitch::Plan::SYNTAX_VERSION, project => 'foo', }, encode_utf8("Should have captured the $name pragmas"); cmp_deeply $parsed, { changes => [ clear, change { name => $name } ], lines => [ clear, version, $foo_proj, blank, change { name => $name } ], }, encode_utf8(qq{Should have pragmas in plan with change "$name"}); # Test a tag name. my $tag = '@' . $name; $lines = encode_utf8 "\%project=foo\n\nfoo $tsnp\n$tag $tsnp"; $fh = IO::File->new(\$lines, '<:utf8_strict'); ok $parsed = $plan->_parse('gooditem', $fh), encode_utf8(qq{Should parse "$tag"}); cmp_deeply delete $parsed->{pragmas}, { syntax_version => App::Sqitch::Plan::SYNTAX_VERSION, project => 'foo', }, encode_utf8(qq{Should have pragmas in plan with tag "$name"}); cmp_deeply $parsed, { changes => [ clear, change { name => 'foo' }, tag { name => $name } ], lines => [ clear, version, $foo_proj, blank, change { name => 'foo' }, tag { name => $name, ret => 1 } ], }, encode_utf8(qq{Should have line and change for "$tag"}); } is sorted, 26, 'Should have sorted changes 18 times'; # Try a plan with reserved tag name @HEAD. $file = file qw(t plans reserved-tag.plan); $fh = $file->open('<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on plan with reserved tag "@HEAD"'; is $@->ident, 'parse', '@HEAD exception should have ident "plan"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 7, error => __x( '"{name}" is a reserved name', name => '@HEAD', ), ), 'And the @HEAD error message should be correct'; is sorted, 1, 'Should have sorted changes once'; # Try planning with other reserved names. for my $reserved (qw(ROOT FIRST LAST)) { my $root = $prags . '@' . $reserved . " $tsnp"; $file = file qw(t plans), "$reserved.plan"; $fh = IO::File->new(\$root, '<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', qq{Should die on plan with reserved tag "\@$reserved"}; is $@->ident, 'parse', qq{\@$reserved exception should have ident "plan"}; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 4, error => __x( '"{name}" is a reserved name', name => '@' . $reserved, ), ), qq{And the \@$reserved error message should be correct}; is sorted, 0, "Should have sorted \@$reserved changes nonce"; } # Try a plan with a change name that looks like a sha1 hash. my $sha1 = '6c2f28d125aff1deea615f8de774599acf39a7a1'; $file = file qw(t plans sha1.plan); $fh = IO::File->new(\"$prags$sha1 $tsnp", '<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on plan with SHA1 change name'; is $@->ident, 'parse', 'The SHA1 error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 4, error => __x( '"{name}" is invalid because it could be confused with a SHA1 ID', name => $sha1, ), ), 'And the SHA1 error message should be correct'; is sorted, 0, 'Should have sorted changes nonce'; # Try a plan with a tag but no change. $file = file qw(t plans tag-no-change.plan); $fh = IO::File->new(\"$prags\@foo $tsnp\nbar $tsnp", '<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on plan with tag but no preceding change'; is $@->ident, 'parse', 'The missing change error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 4, error => __x( 'Tag "{tag}" declared without a preceding change', tag => 'foo', ), ), 'And the missing change error message should be correct'; is sorted, 0, 'Should have sorted changes nonce'; # Try a plan with a duplicate tag name. $file = file qw(t plans dupe-tag.plan); $fh = $file->open('<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on plan with dupe tag'; is $@->ident, 'parse', 'The dupe tag error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 12, error => __x( 'Tag "{tag}" duplicates earlier declaration on line {line}', tag => 'bar', line => 7, ), ), 'And the missing change error message should be correct'; is sorted, 2, 'Should have sorted changes twice'; # Try a plan with a duplicate change within a tag section. $file = file qw(t plans dupe-change.plan); $fh = $file->open('<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on plan with dupe change'; is $@->ident, 'parse', 'The dupe change error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 9, error => __x( 'Change "{change}" duplicates earlier declaration on line {line}', change => 'greets', line => 7, ), ), 'And the dupe change error message should be correct'; is sorted, 1, 'Should have sorted changes once'; # Try a plan with an invalid requirement. $fh = IO::File->new(\"\%project=foo\n\nfoo [^bar] $tsnp", '<:utf8_strict'); throws_ok { $plan->_parse('badreq', $fh ) } 'App::Sqitch::X', 'Should die on invalid dependency'; is $@->ident, 'parse', 'The invalid dependency error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => 'badreq', lineno => 3, error => __x( '"{dep}" is not a valid dependency specification', dep => '^bar', ), ), 'And the invalid dependency error message should be correct'; is sorted, 0, 'Should have sorted changes nonce'; # Try a plan without a timestamp. $file = file qw(t plans no-timestamp.plan); $fh = IO::File->new(\"${prags}foo hi ", '<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on change with no timestamp'; is $@->ident, 'parse', 'The missing timestamp error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 4, error => __ 'Missing timestamp', ), 'And the missing timestamp error message should be correct'; is sorted, 0, 'Should have sorted changes nonce'; # Try a plan without a planner. $file = file qw(t plans no-planner.plan); $fh = IO::File->new(\"${prags}foo 2012-07-16T23:12:34Z", '<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on change with no planner'; is $@->ident, 'parse', 'The missing parsener error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 4, error => __ 'Missing planner name and email', ), 'And the missing planner error message should be correct'; is sorted, 0, 'Should have sorted changes nonce'; # Try a plan with neither timestamp nor planner. $file = file qw(t plans no-timestamp-or-planner.plan); $fh = IO::File->new(\"%project=foo\n\nfoo", '<:utf8_strict'); throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should die on change with no timestamp or planner'; is $@->ident, 'parse', 'The missing timestamp or parsener error ident should be "parse"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 3, error => __ 'Missing timestamp and planner name and email', ), 'And the missing timestamp or planner error message should be correct'; is sorted, 0, 'Should have sorted changes nonce'; # Try a plan with pragmas. $file = file qw(t plans pragmas.plan); $fh = $file->open('<:utf8_strict'); ok $parsed = $plan->_parse($file, $fh), 'Should parse plan with pragmas"'; is sorted, 1, 'Should have sorted changes once'; cmp_deeply delete $parsed->{pragmas}, { syntax_version => App::Sqitch::Plan::SYNTAX_VERSION, foo => 'bar', project => 'pragmata', uri => 'https://github.com/theory/sqitch/', strict => 1, }, 'Should have captured all of the pragmas'; cmp_deeply $parsed, { changes => [ clear, change { name => 'hey' }, change { name => 'you' }, ], lines => [ clear, prag( '', ' ', 'syntax-version', '', '=', '', App::Sqitch::Plan::SYNTAX_VERSION), prag( ' ', '', 'foo', ' ', '=', ' ', 'bar', ' ', 'lolz'), prag( '', ' ', 'project', '', '=', '', 'pragmata'), prag( '', ' ', 'uri', '', '=', '', 'https://github.com/theory/sqitch/'), prag( '', ' ', 'strict'), blank(), change { name => 'hey' }, change { name => 'you' }, blank(), ], }, 'Should have "multi.plan" lines and changes'; # Try a plan with deploy/revert operators. $file = file qw(t plans deploy-and-revert.plan); $fh = $file->open('<:utf8_strict'); ok $parsed = $plan->_parse($file, $fh), 'Should parse plan with deploy and revert operators'; is sorted, 2, 'Should have sorted changes twice'; cmp_deeply delete $parsed->{pragmas}, { syntax_version => App::Sqitch::Plan::SYNTAX_VERSION, project => 'deploy_and_revert', }, 'Should have captured the deploy-and-revert pragmas'; cmp_deeply $parsed, { changes => [ clear, change { name => 'hey', op => '+' }, change { name => 'you', op => '+' }, change { name => 'dr_evil', op => '+ ', lspace => ' ' }, tag { name => 'foo' }, change { name => 'this/rocks', op => '+', pspace => ' ' }, change { name => 'hey-there', lspace => ' ' }, change { name => 'dr_evil', note => 'revert!', op => '-', rspace => ' ', pspace => ' ', rtag => [qw(dr_evil)], }, tag { name => 'bar', lspace => ' ' }, ], lines => [ clear, version, prag( '', '', 'project', '', '=', '', 'deploy_and_revert'), blank, change { name => 'hey', op => '+' }, change { name => 'you', op => '+' }, change { name => 'dr_evil', op => '+ ', lspace => ' ' }, tag { name => 'foo', ret => 1 }, blank( ' '), change { name => 'this/rocks', op => '+', pspace => ' ' }, change { name => 'hey-there', lspace => ' ' }, change { name => 'dr_evil', note => 'revert!', op => '-', rspace => ' ', pspace => ' ', rtag => [qw(dr_evil)], }, tag { name => 'bar', lspace => ' ', ret => 1 }, ], }, 'Should have "deploy-and-revert.plan" lines and changes'; # Try a non-existent plan file with load(). $file = file qw(t hi nonexistent.plan); $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file); throws_ok { App::Sqitch::Plan->new(sqitch => $sqitch, target => $target)->load } 'App::Sqitch::X', 'Should get exception for nonexistent plan file'; is $@->ident, 'plan', 'Nonexistent plan file ident should be "plan"'; is $@->message, __x( 'Plan file {file} does not exist', file => $file, ), 'Nonexistent plan file message should be correct'; # Try a plan with dependencies. $file = file qw(t plans dependencies.plan); $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file); isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS, 'Plan with sqitch with plan file with dependencies'; is $plan->file, $target->plan_file, 'File should be coopied from Sqitch'; ok $parsed = $plan->load, 'Load plan with dependencies file'; is_deeply $parsed->{changes}, [ clear, change { name => 'roles', op => '+' }, change { name => 'users', op => '+', pspace => ' ', requires => ['roles'] }, change { name => 'add_user', op => '+', pspace => ' ', requires => [qw(users roles)] }, change { name => 'dr_evil', op => '+' }, tag { name => 'alpha' }, change { name => 'users', op => '+', pspace => ' ', requires => ['users@alpha'], rtag => [qw(dr_evil add_user users)], }, change { name => 'dr_evil', op => '-', rtag => [qw(dr_evil)] }, change { name => 'del_user', op => '+', pspace => ' ', requires => ['users'], conflicts => ['dr_evil'] }, ], 'The changes should include the dependencies'; is sorted, 2, 'Should have sorted changes twice'; # Try a plan with cross-project dependencies. $file = file qw(t plans project_deps.plan); $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file); isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS, 'Plan with sqitch with plan file with project deps'; is $plan->file, $target->plan_file, 'File should be coopied from Sqitch'; ok $parsed = $plan->load, 'Load plan with project deps file'; is_deeply $parsed->{changes}, [ clear, change { name => 'roles', op => '+' }, change { name => 'users', op => '+', pspace => ' ', requires => ['roles'] }, change { name => 'add_user', op => '+', pspace => ' ', requires => [qw(users roles log:logger)] }, change { name => 'dr_evil', op => '+' }, tag { name => 'alpha' }, change { name => 'users', op => '+', pspace => ' ', requires => ['users@alpha'], rtag => [qw(dr_evil add_user users)], }, change { name => 'dr_evil', op => '-', rtag => [qw(dr_evil)] }, change { name => 'del_user', op => '+', pspace => ' ', requires => ['users', 'log:logger@beta1'], conflicts => ['dr_evil'] }, ], 'The changes should include the cross-project deps'; is sorted, 2, 'Should have sorted changes twice'; # Should fail with dependencies on tags. $file = file qw(t plans tag_dependencies.plan); $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file); $fh = IO::File->new(\"%project=tagdep\n\nfoo $tsnp\n\@bar [:foo] $tsnp", '<:utf8_strict'); isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS, 'Plan with sqitch with plan with tag dependencies'; is $plan->file, $target->plan_file, 'File should be coopied from Sqitch'; throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X', 'Should get an exception for tag with dependencies'; is $@->ident, 'parse', 'The tag dependencies error ident should be "plan"'; is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => $file, lineno => 4, error => __ 'Tags may not specify dependencies', ), 'And the tag dependencies error message should be correct'; # Make sure that lines() loads the plan. $file = file qw(t plans multi.plan); $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file); isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS, 'Plan with sqitch with plan file'; is $plan->file, $target->plan_file, 'File should be coopied from Sqitch'; cmp_deeply [$plan->lines], [ clear, version, prag( '', '', 'project', '', '=', '', 'multi'), blank('', 'This is a note'), blank(), blank('', 'And there was a blank line.'), blank(), change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' }, change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' }, tag { ret => 1, name => 'foo', note => 'look, a tag!', ts => '2012-07-16T17:24:07', rspace => ' ', planner_name => 'julie', planner_email => 'j@ul.ie', }, blank(' '), change { name => 'this/rocks', pspace => ' ' }, change { name => 'hey-there', note => 'trailing note!', rspace => ' ' }, tag { name =>, 'bar', ret => 1 }, tag { name => 'baz', ret => 1 }, ], 'Lines should be parsed from file'; $vivify = 1; cmp_deeply [$plan->changes], [ clear, change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' }, change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' }, tag { name => 'foo', note => 'look, a tag!', ts => '2012-07-16T17:24:07', rspace => ' ', planner_name => 'julie', planner_email => 'j@ul.ie', }, change { name => 'this/rocks', pspace => ' ' }, change { name => 'hey-there', note => 'trailing note!', rspace => ' ' }, tag { name =>, 'bar' }, tag { name => 'baz' }, ], 'Changes should be parsed from file'; clear; change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' }; change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' }; my $foo_tag = tag { ret => 1, name => 'foo', note => 'look, a tag!', ts => '2012-07-16T17:24:07', rspace => ' ', planner_name => 'julie', planner_email => 'j@ul.ie', }; change { name => 'this/rocks', pspace => ' ' }; change { name => 'hey-there', rspace => ' ', note => 'trailing note!' }; cmp_deeply [$plan->tags], [ $foo_tag, tag { name =>, 'bar', ret => 1 }, tag { name => 'baz', ret => 1 }, ], 'Should get all tags from tags()'; is sorted, 2, 'Should have sorted changes twice'; ok $parsed = $plan->load, 'Load should parse plan from file'; cmp_deeply delete $parsed->{pragmas}, { syntax_version => App::Sqitch::Plan::SYNTAX_VERSION, project => 'multi', }, 'Should have captured the multi pragmas'; $vivify = 0; cmp_deeply $parsed, { lines => [ clear, version, prag( '', '', 'project', '', '=', '', 'multi'), blank('', 'This is a note'), blank(), blank('', 'And there was a blank line.'), blank(), change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' }, change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' }, tag { ret => 1, name => 'foo', note => 'look, a tag!', ts => '2012-07-16T17:24:07', rspace => ' ', planner_name => 'julie', planner_email => 'j@ul.ie', }, blank(' '), change { name => 'this/rocks', pspace => ' ' }, change { name => 'hey-there', note => 'trailing note!', rspace => ' ' }, tag { name =>, 'bar', ret => 1 }, tag { name => 'baz', ret => 1 }, ], changes => [ clear, change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' }, change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' }, tag { name => 'foo', note => 'look, a tag!', ts => '2012-07-16T17:24:07', rspace => ' ', planner_name => 'julie', planner_email => 'j@ul.ie', }, change { name => 'this/rocks', pspace => ' ' }, change { name => 'hey-there', note => 'trailing note!', rspace => ' ' }, tag { name =>, 'bar' }, tag { name => 'baz' }, ], }, 'And the parsed file should have lines and changes'; is sorted, 2, 'Should have sorted changes twice'; ############################################################################## # Test the interator interface. can_ok $plan, qw( index_of contains get seek reset next current peek do ); is $plan->position, -1, 'Position should start at -1'; is $plan->current, undef, 'Current should be undef'; ok my $change = $plan->next, 'Get next change'; isa_ok $change, 'App::Sqitch::Plan::Change', 'First change'; is $change->name, 'hey', 'It should be the first change'; is $plan->position, 0, 'Position should be at 0'; is $plan->count, 4, 'Count should be 4'; is $plan->current, $change, 'Current should be current'; is $plan->change_at(0), $change, 'Should get first change from change_at(0)'; ok my $next = $plan->peek, 'Peek to next change'; isa_ok $next, 'App::Sqitch::Plan::Change', 'Peeked change'; is $next->name, 'you', 'Peeked change should be second change'; is $plan->last->format_name, 'hey-there', 'last() should return last change'; is $plan->current, $change, 'Current should still be current'; is $plan->peek, $next, 'Peek should still be next'; is $plan->next, $next, 'Next should be the second change'; is $plan->position, 1, 'Position should be at 1'; is $plan->change_at(1), $next, 'Should get second change from change_at(1)'; ok my $third = $plan->peek, 'Peek should return an object'; isa_ok $third, 'App::Sqitch::Plan::Change', 'Third change'; is $third->name, 'this/rocks', 'It should be the foo tag'; is $plan->current, $next, 'Current should be the second change'; is $plan->next, $third, 'Should get third change next'; is $plan->position, 2, 'Position should be at 2'; is $plan->current, $third, 'Current should be third change'; is $plan->change_at(2), $third, 'Should get third change from change_at(1)'; ok my $fourth = $plan->next, 'Get fourth change'; isa_ok $fourth, 'App::Sqitch::Plan::Change', 'Fourth change'; is $fourth->name, 'hey-there', 'Fourth change should be "hey-there"'; is $plan->position, 3, 'Position should be at 3'; is $plan->peek, undef, 'Peek should return undef'; is $plan->next, undef, 'Next should return undef'; is $plan->position, 4, 'Position should be at 7'; is $plan->next, undef, 'Next should still return undef'; is $plan->position, 4, 'Position should still be at 7'; ok $plan->reset, 'Reset the plan'; is $plan->position, -1, 'Position should be back at -1'; is $plan->current, undef, 'Current should still be undef'; is $plan->next, $change, 'Next should return the first change again'; is $plan->position, 0, 'Position should be at 0 again'; is $plan->current, $change, 'Current should be first change'; is $plan->index_of($change->name), 0, "Index of change should be 0"; ok $plan->contains($change->name), 'Plan should contain change'; is $plan->get($change->name), $change, 'Should be able to get change 0 by name'; is $plan->find($change->name), $change, 'Should be able to find change 0 by name'; is $plan->get($change->id), $change, 'Should be able to get change 0 by ID'; is $plan->find($change->id), $change, 'Should be able to find change 0 by ID'; is $plan->index_of('@bar'), 3, 'Index of @bar should be 3'; ok $plan->contains('@bar'), 'Plan should contain @bar'; is $plan->get('@bar'), $fourth, 'Should be able to get hey-there via @bar'; is $plan->get($fourth->id), $fourth, 'Should be able to get hey-there via @bar ID'; is $plan->find('@bar'), $fourth, 'Should be able to find hey-there via @bar'; is $plan->find($fourth->id), $fourth, 'Should be able to find hey-there via @bar ID'; ok $plan->seek('@bar'), 'Seek to the "@bar" change'; is $plan->position, 3, 'Position should be at 3 again'; is $plan->current, $fourth, 'Current should be fourth again'; is $plan->index_of('you'), 1, 'Index of you should be 1'; ok $plan->contains('you'), 'Plan should contain "you"'; is $plan->get('you'), $next, 'Should be able to get change 1 by name'; is $plan->find('you'), $next, 'Should be able to find change 1 by name'; ok $plan->seek('you'), 'Seek to the "you" change'; is $plan->position, 1, 'Position should be at 1 again'; is $plan->current, $next, 'Current should be second again'; is $plan->index_of('baz'), undef, 'Index of baz should be undef'; ok !$plan->contains('baz'), 'Plan should not contain "baz"'; is $plan->index_of('@baz'), 3, 'Index of @baz should be 3'; ok $plan->contains('@baz'), 'Plan should contain @baz'; ok $plan->seek('@baz'), 'Seek to the "baz" change'; is $plan->position, 3, 'Position should be at 3 again'; is $plan->current, $fourth, 'Current should be fourth again'; is $plan->change_at(0), $change, 'Should still get first change from change_at(0)'; is $plan->change_at(1), $next, 'Should still get second change from change_at(1)'; is $plan->change_at(2), $third, 'Should still get third change from change_at(1)'; # Make sure seek() chokes on a bad change name. throws_ok { $plan->seek('nonesuch') } 'App::Sqitch::X', 'Should die seeking invalid change'; is $@->ident, 'plan', 'Invalid seek change error ident should be "plan"'; is $@->message, __x( 'Cannot find change "{change}" in plan', change => 'nonesuch', ), 'And the failure message should be correct'; # Get all! my @changes = ($change, $next, $third, $fourth); cmp_deeply [$plan->changes], \@changes, 'All should return all changes'; ok $plan->reset, 'Reset the plan again'; $plan->do(sub { is shift, $changes[0], 'Change ' . $changes[0]->name . ' should be passed to do sub'; is $_, $changes[0], 'Change ' . $changes[0]->name . ' should be the topic in do sub'; shift @changes; }); # There should be no more to iterate over. $plan->do(sub { fail 'Should not get anything passed to do()' }); ############################################################################## # Let's try searching changes. isa_ok my $iter = $plan->search_changes, 'CODE', 'search_changes() should return a code ref'; my $get_all_names = sub { my $iter = shift; my @res; while (my $change = $iter->()) { push @res => $change->name; } return \@res; }; is_deeply $get_all_names->($iter), [qw(hey you this/rocks hey-there)], 'All the changes should be returned in the proper order'; # Try reverse order. is_deeply $get_all_names->( $plan->search_changes( direction => 'DESC' ) ), [qw(hey-there this/rocks you hey)], 'Direction "DESC" should work'; # Try invalid directions. throws_ok { $plan->search_changes( direction => 'foo' ) } 'App::Sqitch::X', 'Should get error for invalid direction'; is $@->ident, 'DEV', 'Invalid direction error ident should be "DEV"'; is $@->message, 'Search direction must be either "ASC" or "DESC"', 'Invalid direction error message should be correct'; # Try ascending lowercased. is_deeply $get_all_names->( $plan->search_changes( direction => 'asc' ) ), [qw(hey you this/rocks hey-there)], 'Direction "asc" should work'; # Try change name. is_deeply $get_all_names->( $plan->search_changes( name => 'you')), [qw(you)], 'Search by change name should work'; is_deeply $get_all_names->( $plan->search_changes( name => 'hey')), [qw(hey hey-there)], 'Search by change name should work as a regex'; is_deeply $get_all_names->( $plan->search_changes( name => '[-/]')), [qw(this/rocks hey-there)], 'Search by change name should with a character class'; # Try planner name. is_deeply $get_all_names->( $plan->search_changes( planner => 'Barack' ) ), [qw(this/rocks hey-there)], 'Search by planner should work'; is_deeply $get_all_names->( $plan->search_changes( planner => 'a..a' ) ), [qw(you)], 'Search by planner should work as a regex'; # Search by operation. is_deeply $get_all_names->( $plan->search_changes( operation => 'deploy' ) ), [qw(hey you this/rocks hey-there)], 'Search by operation "deploy" should work'; is_deeply $get_all_names->( $plan->search_changes( operation => 'revert' ) ), [], 'Search by operation "rever" should return nothing'; # Fake out an operation. my $mock_change = Test::MockModule->new('App::Sqitch::Plan::Change'); $mock_change->mock( operator => sub { return shift->name =~ /hey/ ? '-' : '+' }); is_deeply $get_all_names->( $plan->search_changes( operation => 'DEPLOY' ) ), [qw(you this/rocks)], 'Search by operation "DEPLOY" should now return two changes'; is_deeply $get_all_names->( $plan->search_changes( operation => 'REVERT' ) ), [qw(hey hey-there)], 'Search by operation "REVERT" should return the other two'; $mock_change->unmock_all; # Make sure we test only for legal operations. throws_ok { $plan->search_changes( operation => 'foo' ) } 'App::Sqitch::X', 'Should get an error for unknown operation'; is $@->ident, 'DEV', 'Unknown operation error ident should be "DEV"'; is $@->message, 'Unknown change operation "foo"', 'Unknown operation error message should be correct'; # Test offset and limit. is_deeply $get_all_names->( $plan->search_changes( offset => 2 ) ), [qw(this/rocks hey-there)], 'Search with offset 2 should work'; is_deeply $get_all_names->( $plan->search_changes( offset => 2, limit => 1 ) ), [qw(this/rocks)], 'Search with offset 2, limit 1 should work'; is_deeply $get_all_names->( $plan->search_changes( offset => 3, direction => 'desc' ) ), [qw(hey)], 'Search with offset 3 and dierction "desc" should work'; is_deeply $get_all_names->( $plan->search_changes( offset => 2, limit => 1, direction => 'desc' ) ), [qw(you)], 'Search with offset 2, limit 1, dierction "desc" should work'; ############################################################################## # Test writing the plan. can_ok $plan, 'write_to'; my $to = file 'plan.out'; END { unlink $to } file_not_exists_ok $to; ok $plan->write_to($to), 'Write out the file'; file_exists_ok $to; my $v = App::Sqitch->VERSION; file_contents_is $to, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . $file->slurp(iomode => '<:utf8_strict'), 'The contents should look right'; # Make sure it will start from a certain point. ok $plan->write_to($to, 'this/rocks'), 'Write out the file from "this/rocks"'; file_contents_is $to, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . '%project=multi' . "\n" . '# This is a note' . "\n" . "\n" . $plan->find('this/rocks')->as_string . "\n" . $plan->find('hey-there')->as_string . "\n" . join( "\n", map { $_->as_string } $plan->find('hey-there')->tags ) . "\n", 'Plan should have been written from "this/rocks" through tags at end'; # Make sure it ends at a certain point. ok $plan->write_to($to, undef, 'you'), 'Write the file up to "you"'; file_contents_is $to, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . '%project=multi' . "\n" . '# This is a note' . "\n" . "\n" . '# And there was a blank line.' . "\n" . "\n" . $plan->find('hey')->as_string . "\n" . $plan->find('you')->as_string . "\n" . join( "\n", map { $_->as_string } $plan->find('you')->tags ) . "\n", 'Plan should have been written through "you" and its tags'; # Try both. ok $plan->write_to($to, '@foo', 'this/rocks'), 'Write from "@foo" to "this/rocks"'; file_contents_is $to, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . '%project=multi' . "\n" . '# This is a note' . "\n" . "\n" . $plan->find('you')->as_string . "\n" . join( "\n", map { $_->as_string } $plan->find('you')->tags ) . "\n" . ' ' . "\n" . $plan->find('this/rocks')->as_string . "\n", 'Plan should have been written from "@foo" to "this/rocks"'; # End with a tag. ok $plan->write_to($to, 'hey', '@foo'), 'Write from "hey" to "@foo"'; file_contents_is $to, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . '%project=multi' . "\n" . '# This is a note' . "\n" . "\n" . $plan->find('hey')->as_string . "\n" . $plan->find('you')->as_string . "\n" . join( "\n", map { $_->as_string } $plan->find('you')->tags ) . "\n", 'Plan should have been written from "hey" through "@foo"'; ############################################################################## # Test _is_valid. can_ok $plan, '_is_valid'; for my $name (@bad_names) { throws_ok { $plan->_is_valid( tag => $name) } 'App::Sqitch::X', qq{Should find "$name" invalid}; is $@->ident, 'plan', qq{Invalid name "$name" error ident should be "plan"}; is $@->message, __x( qq{"{name}" is invalid: tags must not begin with punctuation, } . 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation', name => $name, ), qq{And the "$name" error message should be correct}; } # Try some valid names. for my $name ( 'foo', # alpha '12', # digits 't', # char '6', # digit '阱阪阬', # multibyte 'foo/bar', # middle punct 'beta1', # ending digit 'v1.2-1', # version number with dash 'v1.2+1', # version number with plus 'v1.2_1', # version number with underscore ) { local $ENV{FOO} = 1; my $disp = Encode::encode_utf8($name); ok $plan->_is_valid(change => $name), qq{Name "$disp" should be valid}; } ############################################################################## # Try adding a tag. ok my $tag = $plan->tag( name => 'w00t' ), 'Add tag "w00t"'; is $plan->count, 4, 'Should have 4 changes'; ok $plan->contains('@w00t'), 'Should find "@w00t" in plan'; is $plan->index_of('@w00t'), 3, 'Should find "@w00t" at index 3'; is $plan->last->name, 'hey-there', 'Last change should be "hey-there"'; is_deeply [map { $_->name } $plan->last->tags], [qw(bar baz w00t)], 'The w00t tag should be on the last change'; isa_ok $tag, 'App::Sqitch::Plan::Tag'; is $tag->name, 'w00t', 'The returned tag should be @w00t'; is $tag->change, $plan->last, 'The @w00t change should be the last change'; ok $plan->write_to($to), 'Write out the file again'; file_contents_is $to, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . $file->slurp(iomode => '<:utf8_strict') . $tag->as_string . "\n", { encoding => 'UTF-8' }, 'The contents should include the "w00t" tag'; # Try passing the tag name with a leading @. ok my $tag2 = $plan->tag( name => '@alpha' ), 'Add tag "@alpha"'; ok $plan->contains('@alpha'), 'Should find "@alpha" in plan'; is $plan->index_of('@alpha'), 3, 'Should find "@alpha" at index 3'; is $tag2->name, 'alpha', 'The returned tag should be @alpha'; is $tag2->change, $plan->last, 'The @alpha change should be the last change'; # Try specifying the change to tag. ok my $tag3 = $plan->tag(name => 'blarney', change => 'you'), 'Tag change "you"'; is $plan->count, 4, 'Should still have 4 changes'; ok $plan->contains('@blarney'), 'Should find "@blarney" in plan'; is $plan->index_of('@blarney'), 1, 'Should find "@blarney" at index 1'; is_deeply [map { $_->name } $plan->change_at(1)->tags], [qw(foo blarney)], 'The blarney tag should be on the second change'; isa_ok $tag3, 'App::Sqitch::Plan::Tag'; is $tag3->name, 'blarney', 'The returned tag should be @blarney'; is $tag3->change, $plan->change_at(1), 'The @blarney change should be the second change'; # Should choke on a duplicate tag. throws_ok { $plan->tag( name => 'w00t' ) } 'App::Sqitch::X', 'Should get error trying to add duplicate tag'; is $@->ident, 'plan', 'Duplicate tag error ident should be "plan"'; is $@->message, __x( 'Tag "{tag}" already exists', tag => '@w00t', ), 'And the error message should report it as a dupe'; # Should choke on an invalid tag names. for my $name (@bad_names, 'foo#bar') { next if $name =~ /^@/; throws_ok { $plan->tag( name => $name ) } 'App::Sqitch::X', qq{Should get error for invalid tag "$name"}; is $@->ident, 'plan', qq{Invalid name "$name" error ident should be "plan"}; is $@->message, __x( qq{"{name}" is invalid: tags must not begin with punctuation, } . 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation', name => $name, ), qq{And the "$name" error message should be correct}; } # Validate reserved names. for my $reserved (qw(HEAD ROOT FIRST LAST)) { throws_ok { $plan->tag( name => $reserved ) } 'App::Sqitch::X', qq{Should get error for reserved tag "$reserved"}; is $@->ident, 'plan', qq{Reserved tag "$reserved" error ident should be "plan"}; is $@->message, __x( '"{name}" is a reserved name', name => $reserved, ), qq{And the reserved tag "$reserved" message should be correct}; } throws_ok { $plan->tag( name => $sha1 ) } 'App::Sqitch::X', 'Should get error for a SHA1 tag'; is $@->ident, 'plan', 'SHA1 tag error ident should be "plan"'; is $@->message, __x( '"{name}" is invalid because it could be confused with a SHA1 ID', name => $sha1,, ), 'And the reserved name error should be output'; ############################################################################## # Try adding a change. ok my $new_change = $plan->add(name => 'booyah', note => 'Hi there'), 'Add change "booyah"'; is $plan->count, 5, 'Should have 5 changes'; ok $plan->contains('booyah'), 'Should find "booyah" in plan'; is $plan->index_of('booyah'), 4, 'Should find "booyah" at index 4'; is $plan->last->name, 'booyah', 'Last change should be "booyah"'; isa_ok $new_change, 'App::Sqitch::Plan::Change'; is $new_change->as_string, join (' ', 'booyah', $new_change->timestamp->as_string, $new_change->format_planner, $new_change->format_note, ), 'Should have plain stringification of "booya"'; my $contents = $file->slurp(iomode => '<:utf8_strict'); $contents =~ s{(\s+this/rocks)}{"\n" . $tag3->as_string . $1}ems; ok $plan->write_to($to), 'Write out the file again'; file_contents_is $to, '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n" . $contents . $tag->as_string . "\n" . $tag2->as_string . "\n\n" . $new_change->as_string . "\n", { encoding => 'UTF-8' }, 'The contents should include the "booyah" change'; # Make sure dependencies are verified. ok $new_change = $plan->add(name => 'blow', requires => ['booyah']), 'Add change "blow"'; is $plan->count, 6, 'Should have 6 changes'; ok $plan->contains('blow'), 'Should find "blow" in plan'; is $plan->index_of('blow'), 5, 'Should find "blow" at index 5'; is $plan->last->name, 'blow', 'Last change should be "blow"'; is $new_change->as_string, 'blow [booyah] ' . $new_change->timestamp->as_string . ' ' . $new_change->format_planner, 'Should have nice stringification of "blow [booyah]"'; is [$plan->lines]->[-1], $new_change, 'The new change should have been appended to the lines, too'; # Make sure dependencies are unique. ok $new_change = $plan->add(name => 'jive', requires => [qw(blow blow)]), 'Add change "jive" with dupe dependency'; is $plan->count, 7, 'Should have 7 changes'; ok $plan->contains('jive'), 'Should find "jive" in plan'; is $plan->index_of('jive'), 6, 'Should find "jive" at index 6'; is $plan->last->name, 'jive', 'jive change should be "jive"'; is_deeply [ map { $_->change } $new_change->requires ], ['blow'], 'Should have dependency "blow"'; is $new_change->as_string, 'jive [blow] ' . $new_change->timestamp->as_string . ' ' . $new_change->format_planner, 'Should have nice stringification of "jive [blow]"'; is [$plan->lines]->[-1], $new_change, 'The new change should have been appended to the lines, too'; # Make sure externals and conflicts are unique. ok $new_change = $plan->add( name => 'moo', requires => [qw(ext:foo ext:foo)], conflicts => [qw(blow blow ext:whu ext:whu)], ), 'Add change "moo" with dupe dependencies'; is $plan->count, 8, 'Should have 8 changes'; ok $plan->contains('moo'), 'Should find "moo" in plan'; is $plan->index_of('moo'), 7, 'Should find "moo" at index 7'; is $plan->last->name, 'moo', 'moo change should be "moo"'; is_deeply [ map { $_->as_string } $new_change->requires ], ['ext:foo'], 'Should require "ext:whu"'; is_deeply [ map { $_->as_string } $new_change->conflicts ], [qw(blow ext:whu)], 'Should conflict with "blow" and "ext:whu"'; is $new_change->as_string, 'moo [ext:foo !blow !ext:whu] ' . $new_change->timestamp->as_string . ' ' . $new_change->format_planner, 'Should have nice stringification of "moo [ext:foo !blow !ext:whu]"'; is [$plan->lines]->[-1], $new_change, 'The new change should have been appended to the lines, too'; # Should choke on a duplicate change. throws_ok { $plan->add(name => 'blow') } 'App::Sqitch::X', 'Should get error trying to add duplicate change'; is $@->ident, 'plan', 'Duplicate change error ident should be "plan"'; is $@->message, __x( qq{Change "{change}" already exists in plan {file}.\nUse "sqitch rework" to copy and rework it}, change => 'blow', file => $plan->file, ), 'And the error message should suggest "rework"'; # Should choke on an invalid change names. for my $name (@bad_names) { throws_ok { $plan->add( name => $name ) } 'App::Sqitch::X', qq{Should get error for invalid change "$name"}; is $@->ident, 'plan', qq{Invalid name "$name" error ident should be "plan"}; is $@->message, __x( qq{"{name}" is invalid: changes must not begin with punctuation, } . 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation', name => $name, ), qq{And the "$name" error message should be correct}; } # Try a reserved name. for my $reserved (qw(HEAD ROOT FIRST LAST)) { throws_ok { $plan->add( name => $reserved ) } 'App::Sqitch::X', qq{Should get error for reserved name "$reserved"}; is $@->ident, 'plan', qq{Reserved name "$reserved" error ident should be "plan"}; is $@->message, __x( '"{name}" is a reserved name', name => $reserved, ), qq{And the reserved name "$reserved" message should be correct}; } # Try an unknown dependency. throws_ok { $plan->add( name => 'whu', requires => ['nonesuch' ] ) } 'App::Sqitch::X', 'Should get failure for failed dependency'; is $@->ident, 'plan', 'Dependency error ident should be "plan"'; is $@->message, __x( 'Cannot add change "{change}": requires unknown change "{req}"', change => 'whu', req => 'nonesuch', ), 'The dependency error should be correct'; # Try invalid dependencies. throws_ok { $plan->add( name => 'whu', requires => ['^bogus' ] ) } 'App::Sqitch::X', 'Should get failure for invalid dependency'; is $@->ident, 'plan', 'Invalid dependency error ident should be "plan"'; is $@->message, __x( '"{dep}" is not a valid dependency specification', dep => '^bogus', ), 'The invalid dependency error should be correct'; throws_ok { $plan->add( name => 'whu', conflicts => ['^bogus' ] ) } 'App::Sqitch::X', 'Should get failure for invalid conflict'; is $@->ident, 'plan', 'Invalid conflict error ident should be "plan"'; is $@->message, __x( '"{dep}" is not a valid dependency specification', dep => '^bogus', ), 'The invalid conflict error should be correct'; # Should choke on an unknown tag, too. throws_ok { $plan->add(name => 'whu', requires => ['@nonesuch' ] ) } 'App::Sqitch::X', 'Should get failure for failed tag dependency'; is $@->ident, 'plan', 'Tag dependency error ident should be "plan"'; is $@->message, __x( 'Cannot add change "{change}": requires unknown change "{req}"', change => 'whu', req => '@nonesuch', ), 'The tag dependency error should be correct'; # Should choke on a change that looks like a SHA1. throws_ok { $plan->add(name => $sha1) } 'App::Sqitch::X', 'Should get error for a SHA1 change'; is $@->ident, 'plan', 'SHA1 tag error ident should be "plan"'; is $@->message, __x( '"{name}" is invalid because it could be confused with a SHA1 ID', name => $sha1,, ), 'And the reserved name error should be output'; ############################################################################## # Try reworking a change. can_ok $plan, 'rework'; ok my $rev_change = $plan->rework( name => 'you' ), 'Rework change "you"'; isa_ok $rev_change, 'App::Sqitch::Plan::Change'; is $rev_change->name, 'you', 'Reworked change should be "you"'; ok my $orig = $plan->change_at($plan->first_index_of('you')), 'Get original "you" change'; is $orig->name, 'you', 'It should also be named "you"'; is_deeply [ map { $_->format_name } $orig->rework_tags ], [qw(@bar)], 'And it should have the one rework tag'; is $orig->deploy_file, $target->deploy_dir->file('you@bar.sql'), 'The original file should now be named you@bar.sql'; is $rev_change->as_string, 'you [you@bar] ' . $rev_change->timestamp->as_string . ' ' . $rev_change->format_planner, 'It should require the previous "you" change'; is [$plan->lines]->[-1], $rev_change, 'The new "you" should have been appended to the lines, too'; # Make sure it was appended to the plan. ok $plan->contains('you@HEAD'), 'Should find "you@HEAD" in plan'; is $plan->index_of('you@HEAD'), 8, 'It should be at position 8'; is $plan->count, 9, 'The plan count should be 9'; # Tag and add again, to be sure we can do it multiple times. ok $plan->tag( name => '@beta1' ), 'Tag @beta1'; ok my $rev_change2 = $plan->rework( name => 'you' ), 'Rework change "you" again'; isa_ok $rev_change2, 'App::Sqitch::Plan::Change'; is $rev_change2->name, 'you', 'New reworked change should be "you"'; ok $orig = $plan->change_at($plan->first_index_of('you')), 'Get original "you" change again'; is $orig->name, 'you', 'It should still be named "you"'; is_deeply [ map { $_->format_name } $orig->rework_tags ], [qw(@bar)], 'And it should have the one rework tag'; ok $rev_change = $plan->get('you@beta1'), 'Get you@beta1'; is $rev_change->name, 'you', 'The second "you" should be named that'; is_deeply [ map { $_->format_name } $rev_change->rework_tags ], [qw(@beta1)], 'And the second change should have the rework_tag "@beta1"'; is_deeply [ $rev_change2->rework_tags ], [], 'But the new reworked change should have no rework tags'; is $rev_change2->as_string, 'you [you@beta1] ' . $rev_change2->timestamp->as_string . ' ' . $rev_change2->format_planner, 'It should require the previous "you" change'; is [$plan->lines]->[-1], $rev_change2, 'The new reworking should have been appended to the lines'; # Make sure it was appended to the plan. ok $plan->contains('you@HEAD'), 'Should find "you@HEAD" in plan'; is $plan->index_of('you@HEAD'), 9, 'It should be at position 9'; is $plan->count, 10, 'The plan count should be 10'; # Try a nonexistent change name. throws_ok { $plan->rework( name => 'nonexistent' ) } 'App::Sqitch::X', 'rework should die on nonexistent change'; is $@->ident, 'plan', 'Nonexistent change error ident should be "plan"'; is $@->message, __x( qq{Change "{change}" does not exist in {file}.\nUse "sqitch add {change}" to add it to the plan}, change => 'nonexistent', file => $plan->file, ), 'And the error should suggest "sqitch add"'; # Try reworking without an intervening tag. throws_ok { $plan->rework( name => 'you' ) } 'App::Sqitch::X', 'rework_stpe should die on lack of intervening tag'; is $@->ident, 'plan', 'Missing tag error ident should be "plan"'; is $@->message, __x( qq{Cannot rework "{change}" without an intervening tag.\nUse "sqitch tag" to create a tag and try again}, change => 'you', ), 'And the error should suggest "sqitch tag"'; # Make sure it checks dependencies. throws_ok { $plan->rework( name => 'booyah', requires => ['nonesuch' ] ) } 'App::Sqitch::X', 'rework should die on failed dependency'; is $@->ident, 'plan', 'Rework dependency error ident should be "plan"'; is $@->message, __x( 'Cannot rework change "{change}": requires unknown change "{req}"', change => 'booyah', req => 'nonesuch', ), 'The rework dependency error should be correct'; # Try invalid dependencies. throws_ok { $plan->rework( name => 'booyah', requires => ['^bogus' ] ) } 'App::Sqitch::X', 'Should get failure for invalid dependency'; is $@->ident, 'plan', 'Invalid dependency error ident should be "plan"'; is $@->message, __x( '"{dep}" is not a valid dependency specification', dep => '^bogus', ), 'The invalid dependency error should be correct'; throws_ok { $plan->rework( name => 'booyah', conflicts => ['^bogus' ] ) } 'App::Sqitch::X', 'Should get failure for invalid conflict'; is $@->ident, 'plan', 'Invalid conflict error ident should be "plan"'; is $@->message, __x( '"{dep}" is not a valid dependency specification', dep => '^bogus', ), 'The invalid conflict error should be correct'; ############################################################################## # Try a plan with a duplicate change in different tag sections. $file = file qw(t plans dupe-change-diff-tag.plan); $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file); isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS, 'Plan shoud work plan with dupe change across tags'; is $plan->file, $target->plan_file, 'File should be coopied from Sqitch'; is $plan->project, 'dupe_change_diff_tag', 'Project name should be set'; cmp_deeply [ $plan->lines ], [ clear, version, prag( '', '', 'project', '', '=', '', 'dupe_change_diff_tag'), blank, change { name => 'whatever' }, tag { name => 'foo', ret => 1 }, blank(), change { name => 'hi' }, tag { name => 'bar', ret => 1 }, blank(), change { name => 'greets' }, change { name => 'whatever', rtag => [qw(hi whatever)] }, ], 'Lines with dupe change should be read from file'; $vivify = 1; cmp_deeply [ $plan->changes ], [ clear, change { name => 'whatever' }, tag { name => 'foo' }, change { name => 'hi' }, tag { name => 'bar' }, change { name => 'greets' }, change { name => 'whatever', rtag => [qw(hi whatever)] }, ], 'Noes with dupe change should be read from file'; is sorted, 3, 'Should have sorted changes three times'; # Try to find whatever. ok $plan->contains('whatever'), 'Should find "whatever" in plan'; throws_ok { $plan->index_of('whatever') } 'App::Sqitch::X', 'Should get an error trying to find dupe key.'; is $@->ident, 'plan', 'Dupe key error ident should be "plan"'; is $@->message, __ 'Change lookup failed', 'Dupe key error message should be correct'; is_deeply +MockOutput->get_vent, [ [__x( 'Change "{change}" is ambiguous. Please specify a tag-qualified change:', change => 'whatever', )], [ ' * ', 'whatever@HEAD' ], [ ' * ', 'whatever@foo' ], ], 'Should have output listing tag-qualified changes'; is $plan->index_of('whatever@HEAD'), 3, 'Should get 3 for whatever@HEAD'; is $plan->index_of('whatever@bar'), 0, 'Should get 0 for whatever@bar'; # Make sure seek works, too. throws_ok { $plan->seek('whatever') } 'App::Sqitch::X', 'Should get an error seeking dupe key.'; is $@->ident, 'plan', 'Dupe key error ident should be "plan"'; is $@->message, __ 'Change lookup failed', 'Dupe key error message should be correct'; is_deeply +MockOutput->get_vent, [ [__x( 'Change "{change}" is ambiguous. Please specify a tag-qualified change:', change => 'whatever', )], [ ' * ', 'whatever@HEAD' ], [ ' * ', 'whatever@foo' ], ], 'Should have output listing tag-qualified changes'; is $plan->index_of('whatever@HEAD'), 3, 'Should find whatever@HEAD at index 3'; is $plan->index_of('whatever@bar'), 0, 'Should find whatever@HEAD at index 0'; is $plan->first_index_of('whatever'), 0, 'Should find first instance of whatever at index 0'; is $plan->first_index_of('whatever', '@bar'), 3, 'Should find first instance of whatever after @bar at index 5'; ok $plan->seek('whatever@HEAD'), 'Seek whatever@HEAD'; is $plan->position, 3, 'Position should be 3'; ok $plan->seek('whatever@bar'), 'Seek whatever@bar'; is $plan->position, 0, 'Position should be 0'; is $plan->last_tagged_change->name, 'hi', 'Last tagged change should be "hi"'; ############################################################################## # Test open_script. make_path dir(qw(sql deploy stuff))->stringify; END { remove_tree 'sql' }; can_ok $CLASS, 'open_script'; my $change_file = file qw(sql deploy bar.sql); $fh = $change_file->open('>') or die "Cannot open $change_file: $!\n"; $fh->say('-- This is a comment'); $fh->close; ok $fh = $plan->open_script($change_file), 'Open bar.sql'; is $fh->getline, "-- This is a comment\n", 'It should be the right file'; $fh->close; file(qw(sql deploy baz.sql))->touch; ok $fh = $plan->open_script(file qw(sql deploy baz.sql)), 'Open baz.sql'; is $fh->getline, undef, 'It should be empty'; # Make sure it dies on an invalid file. throws_ok { $plan->open_script(file 'nonexistent' ) } 'App::Sqitch::X', 'open_script() should die on nonexistent file'; is $@->ident, 'io', 'Nonexistent file error ident should be "io"'; is $@->message, __x( 'Cannot open {file}: {error}', file => 'nonexistent', error => $! || 'No such file or directory', ), 'Nonexistent file error message should be correct'; ############################################################################## # Test check_changes() $mocker->unmock('check_changes'); can_ok $CLASS, 'check_changes'; my @deps; my $i = 0; my $j = 0; $mock_change->mock(requires => sub { my $reqs = caller eq 'App::Sqitch::Plan' ? $deps[$i++] : $deps[$j++]; @{ $reqs->{requires} }; }); sub changes { clear; $i = $j = 0; map { change { name => $_ }; } @_; } # Start with no dependencies. $project = 'foo'; my %ddep = ( requires => [], conflicts => [] ); @deps = ({%ddep}, {%ddep}, {%ddep}); cmp_deeply [map { $_->name } $plan->check_changes({}, changes qw(this that other))], [qw(this that other)], 'Should get original order when no dependencies'; @deps = ({%ddep}, {%ddep}, {%ddep}); cmp_deeply [map { $_->name } $plan->check_changes('foo', changes qw(this that other))], [qw(this that other)], 'Should get original order when no prepreqs'; # Have that require this. @deps = ({%ddep}, {%ddep, requires => [dep 'this']}, {%ddep}); cmp_deeply [map { $_->name }$plan->check_changes('foo', changes qw(this that other))], [qw(this that other)], 'Should get original order when that requires this'; # Have other require that. @deps = ({%ddep}, {%ddep, requires => [dep 'this']}, {%ddep, requires => [dep 'that']}); cmp_deeply [map { $_->name } $plan->check_changes('foo', changes qw(this that other))], [qw(this that other)], 'Should get original order when other requires that'; my $deperr = sub { join "\n ", __n( 'Dependency error detected:', 'Dependency errors detected:', @_ ), @_ }; # Have this require other. @deps = ({%ddep, requires => [dep 'other']}, {%ddep}, {%ddep}); throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X', 'Should get error for out-of-order dependency'; is $@->ident, 'parse', 'Unordered dependency error ident should be "parse"'; is $@->message, $deperr->(__nx( 'Change "{change}" planned {num} change before required change "{required}"', 'Change "{change}" planned {num} changes before required change "{required}"', 2, change => 'this', required => 'other', num => 2, ) . "\n " . __xn( 'HINT: move "{change}" down {num} line in {plan}', 'HINT: move "{change}" down {num} lines in {plan}', 2, change => 'this', num => 2, plan => $plan->file, )), 'And the unordered dependency error message should be correct'; # Have this require other and that. @deps = ({%ddep, requires => [dep 'other', dep 'that']}, {%ddep}, {%ddep}); throws_ok { $plan->check_changes('foo', changes qw(this that other)); } 'App::Sqitch::X', 'Should get error for multiple dependency errors'; is $@->ident, 'parse', 'Multiple dependency error ident should be "parse"'; is $@->message, $deperr->( __nx( 'Change "{change}" planned {num} change before required change "{required}"', 'Change "{change}" planned {num} changes before required change "{required}"', 2, change => 'this', required => 'other', num => 2, ), __nx( 'Change "{change}" planned {num} change before required change "{required}"', 'Change "{change}" planned {num} changes before required change "{required}"', 1, change => 'this', required => 'that', num => 1, ) . "\n " . __xn( 'HINT: move "{change}" down {num} line in {plan}', 'HINT: move "{change}" down {num} lines in {plan}', 2, change => 'this', num => 2, plan => $plan->file, ), ), 'And the multiple dependency error message should be correct'; # Have that require a tag. @deps = ({%ddep}, {%ddep, requires => [dep '@howdy']}, {%ddep}); cmp_deeply [$plan->check_changes('foo', {'@howdy' => 2 }, changes qw(this that other))], [changes qw(this that other)], 'Should get original order when requiring a tag'; # Requires a step as of a tag. @deps = ({%ddep}, {%ddep, requires => [dep 'foo@howdy']}, {%ddep}); cmp_deeply [$plan->check_changes('foo', {'foo' => 1, '@howdy' => 2 }, changes qw(this that other))], [changes qw(this that other)], 'Should get original order when requiring a step as-of a tag'; # Should die if the step comes *after* the specified tag. @deps = ({%ddep}, {%ddep, requires => [dep 'foo@howdy']}, {%ddep}); throws_ok { $plan->check_changes('foo', {'foo' => 3, '@howdy' => 2 }, changes qw(this that other)) } 'App::Sqitch::X', 'Should get failure for a step after a tag'; is $@->ident, 'parse', 'Step after tag error ident should be "parse"'; is $@->message, $deperr->(__x( 'Unknown change "{required}" required by change "{change}"', required => 'foo@howdy', change => 'that', )), 'And we the unknown change as-of a tag message should be correct'; # Add a cycle. @deps = ({%ddep, requires => [dep 'that']}, {%ddep, requires => [dep 'this']}, {%ddep}); throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X', 'Should get failure for a cycle'; is $@->ident, 'parse', 'Cycle error ident should be "parse"'; is $@->message, $deperr->( __nx( 'Change "{change}" planned {num} change before required change "{required}"', 'Change "{change}" planned {num} changes before required change "{required}"', 1, change => 'this', required => 'that', num => 1, ) . "\n " . __xn( 'HINT: move "{change}" down {num} line in {plan}', 'HINT: move "{change}" down {num} lines in {plan}', 1, change => 'this', num => 1, plan => $plan->file, ), ), 'The cycle error message should be correct'; # Add an extended cycle. @deps = ( {%ddep, requires => [dep 'that']}, {%ddep, requires => [dep 'other']}, {%ddep, requires => [dep 'this']} ); throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X', 'Should get failure for a two-hop cycle'; is $@->ident, 'parse', 'Two-hope cycle error ident should be "parse"'; is $@->message, $deperr->( __nx( 'Change "{change}" planned {num} change before required change "{required}"', 'Change "{change}" planned {num} changes before required change "{required}"', 1, change => 'this', required => 'that', num => 1, ) . "\n " . __xn( 'HINT: move "{change}" down {num} line in {plan}', 'HINT: move "{change}" down {num} lines in {plan}', 1, change => 'this', num => 1, plan => $plan->file, ), __nx( 'Change "{change}" planned {num} change before required change "{required}"', 'Change "{change}" planned {num} changes before required change "{required}"', 1, change => 'that', required => 'other', num => 1, ) . "\n " . __xn( 'HINT: move "{change}" down {num} line in {plan}', 'HINT: move "{change}" down {num} lines in {plan}', 1, change => 'that', num => 1, plan => $plan->file, ), ), 'The two-hop cycle error message should be correct'; # Okay, now deal with depedencies from earlier change sections. @deps = ({%ddep, requires => [dep 'foo']}, {%ddep}, {%ddep}); cmp_deeply [$plan->check_changes('foo', { foo => 1}, changes qw(this that other))], [changes qw(this that other)], 'Should get original order with earlier dependency'; # Mix it up. @deps = ({%ddep, requires => [dep 'other', dep 'that']}, {%ddep, requires => [dep 'sqitch']}, {%ddep}); throws_ok { $plan->check_changes('foo', {sqitch => 1 }, changes qw(this that other)) } 'App::Sqitch::X', 'Should get error with misordered and seen dependencies'; is $@->ident, 'parse', 'Misorderd and seen error ident should be "parse"'; is $@->message, $deperr->( __nx( 'Change "{change}" planned {num} change before required change "{required}"', 'Change "{change}" planned {num} changes before required change "{required}"', 2, change => 'this', required => 'other', num => 2, ), __nx( 'Change "{change}" planned {num} change before required change "{required}"', 'Change "{change}" planned {num} changes before required change "{required}"', 1, change => 'this', required => 'that', num => 1, ) . "\n " . __xn( 'HINT: move "{change}" down {num} line in {plan}', 'HINT: move "{change}" down {num} lines in {plan}', 2, change => 'this', num => 2, plan => $plan->file, ), ), 'And the misordered and seen error message should be correct'; # Make sure it fails on unknown previous dependencies. @deps = ({%ddep, requires => [dep 'foo']}, {%ddep}, {%ddep}); throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X', 'Should die on unknown dependency'; is $@->ident, 'parse', 'Unknown dependency error ident should be "parse"'; is $@->message, $deperr->(__x( 'Unknown change "{required}" required by change "{change}"', required => 'foo', change => 'this', )), 'And the error should point to the offending change'; # Okay, now deal with depedencies from earlier change sections. @deps = ({%ddep, requires => [dep '@foo']}, {%ddep}, {%ddep}); throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X', 'Should die on unknown tag dependency'; is $@->ident, 'parse', 'Unknown tag dependency error ident should be "parse"'; is $@->message, $deperr->(__x( 'Unknown change "{required}" required by change "{change}"', required => '@foo', change => 'this', )), 'And the error should point to the offending change'; # Allow dependencies from different projects. @deps = ({%ddep}, {%ddep, requires => [dep 'bar:bob']}, {%ddep}); cmp_deeply [$plan->check_changes('foo', changes qw(this that other))], [changes qw(this that other)], 'Should get original order with external dependency'; $project = undef; # Make sure that a change does not require itself @deps = ({%ddep, requires => [dep 'this']}, {%ddep}, {%ddep}); throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X', 'Should die on self dependency'; is $@->ident, 'parse', 'Self dependency error ident should be "parse"'; is $@->message, $deperr->(__x( 'Change "{change}" cannot require itself', change => 'this', )), 'And the self dependency error should be correct'; # Make sure sort ordering respects the original ordering. @deps = ( {%ddep}, {%ddep}, {%ddep, requires => [dep 'that']}, {%ddep, requires => [dep 'that', dep 'this']}, ); cmp_deeply [$plan->check_changes('foo', changes qw(this that other thing))], [changes qw(this that other thing)], 'Should get original order with cascading dependencies'; $project = undef; @deps = ( {%ddep}, {%ddep}, {%ddep, requires => [dep 'that']}, {%ddep, requires => [dep 'that', dep 'this', dep 'other']}, {%ddep, requires => [dep 'that', dep 'this']}, ); cmp_deeply [$plan->check_changes('foo', changes qw(this that other thing yowza))], [changes qw(this that other thing yowza)], 'Should get original order with multiple cascading dependencies'; $project = undef; ############################################################################## # Test dependency testing. can_ok $plan, '_check_dependencies'; $mock_change->unmock('requires'); for my $req (qw(hi greets whatever @foo whatever@foo ext:larry ext:greets)) { $change = App::Sqitch::Plan::Change->new( plan => $plan, name => 'lazy', requires => [dep $req], ); my $req_proj = $req =~ /:/ ? do { (my $p = $req) =~ s/:.+//; $p; } : $plan->project; my ($dep) = $change->requires; is $dep->project, $req_proj, qq{Depend "$req" should be in project "$req_proj"}; ok $plan->_check_dependencies($change, 'add'), qq{Dependency on "$req" should succeed}; } for my $req (qw(wanker @blah greets@foo)) { $change = App::Sqitch::Plan::Change->new( plan => $plan, name => 'lazy', requires => [dep $req], ); throws_ok { $plan->_check_dependencies($change, 'bark') } 'App::Sqitch::X', qq{Should get error trying to depend on "$req"}; is $@->ident, 'plan', qq{Dependency "req" error ident should be "plan"}; is $@->message, __x( 'Cannot rework change "{change}": requires unknown change "{req}"', change => 'lazy', req => $req, ), qq{And should get unknown dependency message for "$req"}; } ############################################################################## # Test pragma accessors. is $plan->uri, undef, 'Should have undef URI when no pragma'; $file = file qw(t plans pragmas.plan); $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file); isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS, 'Plan with sqitch with plan file with dependencies'; is $plan->file, $target->plan_file, 'File should be coopied from Sqitch'; is $plan->syntax_version, App::Sqitch::Plan::SYNTAX_VERSION, 'syntax_version should be set'; is $plan->project, 'pragmata', 'Project should be set'; is $plan->uri, URI->new('https://github.com/theory/sqitch/'), 'Should have URI from pragma'; isa_ok $plan->uri, 'URI', 'It'; # Make sure we get an error if there is no project pragma. $fh = IO::File->new(\"%strict\n\nfoo $tsnp", '<:utf8_strict'); throws_ok { $plan->_parse('noproject', $fh) } 'App::Sqitch::X', 'Should die on plan with no project pragma'; is $@->ident, 'parse', 'Missing prorject error ident should be "parse"'; is $@->message, __x('Missing %project pragma in {file}', file => 'noproject'), 'The missing project error message should be correct'; # Make sure we get an error for an invalid project name. for my $bad (@bad_names) { my $fh = IO::File->new(\"%project=$bad\n\nfoo $tsnp", '<:utf8_strict'); throws_ok { $plan->_parse(badproj => $fh) } 'App::Sqitch::X', qq{Should die on invalid project name "$bad"}; is $@->ident, 'parse', qq{Ident for bad proj "$bad" should be "parse"}; my $error = __x( 'invalid project name "{project}": project names must not ' . 'begin with punctuation, contain "@", ":", "#", or blanks, or end in ' . 'punctuation or digits following punctuation', project => $bad); is $@->message, __x( 'Syntax error in {file} at line {lineno}: {error}', file => 'badproj', lineno => 1, error => $error ), qq{Error message for bad project "$bad" should be correct}; } done_testing; App-Sqitch-0.9996/t/plan_command.t000644 000767 000024 00000064434 13133201371 017124 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 227; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::NoWarnings; use Test::Exception; use Test::MockModule; use Path::Class; use Term::ANSIColor qw(color); use Encode; use lib 't/lib'; use MockOutput; use LC; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::Command::plan'; require_ok $CLASS; ok my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => Path::Class::Dir->new('test-plan_command')->stringify, plan_file => file(qw(t sql sqitch.plan))->stringify, }, ), 'Load a sqitch sqitch object'; my $config = $sqitch->config; isa_ok my $cmd = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'plan', config => $config, }), $CLASS, 'plan command'; can_ok $cmd, qw( target change_pattern planner_pattern max_count skip reverse format options execute configure ); is_deeply [$CLASS->options], [qw( event=s target|t=s change-pattern|change=s planner-pattern|planner=s format|f=s date-format|date=s max-count|n=i skip=i reverse! color=s no-color abbrev=i oneline )], 'Options should be correct'; ############################################################################## # Test configure(). my $cmock = Test::MockModule->new('App::Sqitch::Config'); # Test date_format validation. my $configured = $CLASS->configure($config, {}); isa_ok delete $configured->{formatter}, 'App::Sqitch::ItemFormatter', 'Formatter'; is_deeply $configured, {}, 'Should get empty hash for no config or options'; $cmock->mock( get => 'nonesuch' ); throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X', 'Should get error for invalid date format in config'; is $@->ident, 'datetime', 'Invalid date format error ident should be "datetime"'; is $@->message, __x( 'Unknown date format "{format}"', format => 'nonesuch', ), 'Invalid date format error message should be correct'; $cmock->unmock_all; throws_ok { $CLASS->configure($config, { date_format => 'non'}), {} } 'App::Sqitch::X', 'Should get error for invalid date format in optsions'; is $@->ident, 'datetime', 'Invalid date format error ident should be "plan"'; is $@->message, __x( 'Unknown date format "{format}"', format => 'non', ), 'Invalid date format error message should be correct'; # Test format validation. $cmock->mock( get => sub { my ($self, %p) = @_; return 'nonesuch' if $p{key} eq 'plan.format'; return undef; }); throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X', 'Should get error for invalid format in config'; is $@->ident, 'plan', 'Invalid format error ident should be "plan"'; is $@->message, __x( 'Unknown plan format "{format}"', format => 'nonesuch', ), 'Invalid format error message should be correct'; $cmock->unmock_all; throws_ok { $CLASS->configure($config, { format => 'non'}), {} } 'App::Sqitch::X', 'Should get error for invalid format in optsions'; is $@->ident, 'plan', 'Invalid format error ident should be "plan"'; is $@->message, __x( 'Unknown plan format "{format}"', format => 'non', ), 'Invalid format error message should be correct'; # Test color configuration. $configured = $CLASS->configure( $config, { no_color => 1 } ); is $configured->{formatter}->color, 'never', 'Configuration should respect --no-color, setting "never"'; # Test oneline configuration. $configured = $CLASS->configure( $config, { oneline => 1 }); is $configured->{format}, '%{:event}C%h %l%{reset}C %n%{cyan}C%t%{reset}C', '--oneline should set format'; is $configured->{formatter}{abbrev}, 6, '--oneline should set abbrev to 6'; $configured = $CLASS->configure( $config, { oneline => 1, format => 'format:foo', abbrev => 5 }); is $configured->{format}, 'foo', '--oneline should not override --format'; is $configured->{formatter}{abbrev}, 5, '--oneline should not overrride --abbrev'; my $config_color = 'auto'; $cmock->mock( get => sub { my ($self, %p) = @_; return $config_color if $p{key} eq 'plan.color'; return undef; }); my $cmd_config = {}; $cmock->mock( get_section => sub { $cmd_config } ); $configured = $CLASS->configure( $config, { no_color => 1 } ); is $configured->{formatter}->color, 'never', 'Configuration should respect --no-color even when configure is set'; NEVER: { $config_color = 'never'; $cmd_config = { color => $config_color }; my $configured = $CLASS->configure( $config, $cmd_config ); is $configured->{formatter}->color, 'never', 'Configuration should respect color option'; # Try it with config. $cmd_config = { color => $config_color }; $configured = $CLASS->configure( $config, {} ); is $configured->{formatter}->color, 'never', 'Configuration should respect color config'; } ALWAYS: { $config_color = 'always'; $cmd_config = { color => $config_color }; my $configured = $CLASS->configure( $config, $cmd_config ); is_deeply $configured->{formatter}->color, 'always', 'Configuration should respect color option'; # Try it with config. $cmd_config = { color => $config_color }; $configured = $CLASS->configure( $config, {} ); is_deeply $configured->{formatter}->color, 'always', 'Configuration should respect color config'; } AUTO: { $config_color = 'auto'; $cmd_config = { color => $config_color }; for my $enabled (0, 1) { my $configured = $CLASS->configure( $config, $cmd_config ); is_deeply $configured->{formatter}->color, 'auto', 'Configuration should respect color option'; # Try it with config. $cmd_config = { color => $config_color }; $configured = $CLASS->configure( $config, {} ); is_deeply $configured->{formatter}->color, 'auto', 'Configuration should respect color config'; } } $cmock->unmock_all; ############################################################################### # Test named formats. my $cdt = App::Sqitch::DateTime->now; my $pdt = $cdt->clone->subtract(days => 1); my $change = { event => 'deploy', project => 'planit', change_id => '000011112222333444', change => 'lolz', tags => [ '@beta', '@gamma' ], planner_name => 'damian', planner_email => 'damian@example.com', planned_at => $pdt, note => "For the LOLZ.\n\nYou know, funny stuff and cute kittens, right?", requires => [qw(foo bar)], conflicts => [] }; my $piso = $pdt->as_string( format => 'iso' ); my $praw = $pdt->as_string( format => 'raw' ); for my $spec ( [ raw => "deploy 000011112222333444 (\@beta, \@gamma)\n" . "name lolz\n" . "project planit\n" . "requires foo, bar\n" . "planner damian \n" . "planned $praw\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ full => __('Deploy') . " 000011112222333444 (\@beta, \@gamma)\n" . __('Name: ') . " lolz\n" . __('Project: ') . " planit\n" . __('Requires: ') . " foo, bar\n" . __('Planner: ') . " damian \n" . __('Planned: ') . " __PDATE__\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ long => __('Deploy') . " 000011112222333444 (\@beta, \@gamma)\n" . __('Name: ') . " lolz\n" . __('Project: ') . " planit\n" . __('Planner: ') . " damian \n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ medium => __('Deploy') . " 000011112222333444\n" . __('Name: ') . " lolz\n" . __('Planner: ') . " damian \n" . __('Date: ') . " __PDATE__\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ short => __('Deploy') . " 000011112222333444\n" . __('Name: ') . " lolz\n" . __('Planner: ') . " damian \n\n" . " For the LOLZ.\n", ], [ oneline => '000011112222333444 ' . __('deploy') . ' lolz @beta, @gamma' ], ) { local $ENV{ANSI_COLORS_DISABLED} = 1; my $configured = $CLASS->configure( $config, { format => $spec->[0] } ); my $format = $configured->{format}; ok my $cmd = $CLASS->new( sqitch => $sqitch, %{ $configured } ), qq{Instantiate with format "$spec->[0]"}; (my $exp = $spec->[1]) =~ s/__PDATE__/$piso/; is $cmd->formatter->format( $cmd->format, $change ), $exp, qq{Format "$spec->[0]" should output correctly}; if ($spec->[1] =~ /__PDATE__/) { # Test different date formats. for my $date_format (qw(rfc long medium)) { ok my $cmd = $CLASS->new( sqitch => $sqitch, format => $format, formatter => App::Sqitch::ItemFormatter->new(date_format => $date_format), ), qq{Instantiate with format "$spec->[0]" and date format "$date_format"}; my $date = $pdt->as_string( format => $date_format ); (my $exp = $spec->[1]) =~ s/__PDATE__/$date/; is $cmd->formatter->format( $cmd->format, $change ), $exp, qq{Format "$spec->[0]" and date format "$date_format" should output correctly}; } } if ($spec->[1] =~ s/\s+[(]?[@]beta,\s+[@]gamma[)]?//) { # Test without tags. local $change->{tags} = []; (my $exp = $spec->[1]) =~ s/__PDATE__/$piso/; is $cmd->formatter->format( $cmd->format, $change ), $exp, qq{Format "$spec->[0]" should output correctly without tags}; } } ############################################################################### # Test all formatting characters. my $local_pdt = $pdt->clone; $local_pdt->set_time_zone('local'); $local_pdt->set_locale($LC::TIME); my $formatter = $cmd->formatter; for my $spec ( ['%e', { event => 'deploy' }, 'deploy' ], ['%e', { event => 'revert' }, 'revert' ], ['%e', { event => 'fail' }, 'fail' ], ['%L', { event => 'deploy' }, __ 'Deploy' ], ['%L', { event => 'revert' }, __ 'Revert' ], ['%L', { event => 'fail' }, __ 'Fail' ], ['%l', { event => 'deploy' }, __ 'deploy' ], ['%l', { event => 'revert' }, __ 'revert' ], ['%l', { event => 'fail' }, __ 'fail' ], ['%{event}_', {}, __ 'Event: ' ], ['%{change}_', {}, __ 'Change: ' ], ['%{planner}_', {}, __ 'Planner: ' ], ['%{by}_', {}, __ 'By: ' ], ['%{date}_', {}, __ 'Date: ' ], ['%{planned}_', {}, __ 'Planned: ' ], ['%{name}_', {}, __ 'Name: ' ], ['%{email}_', {}, __ 'Email: ' ], ['%{requires}_', {}, __ 'Requires: ' ], ['%{conflicts}_', {}, __ 'Conflicts:' ], ['%H', { change_id => '123456789' }, '123456789' ], ['%h', { change_id => '123456789' }, '123456789' ], ['%{5}h', { change_id => '123456789' }, '12345' ], ['%{7}h', { change_id => '123456789' }, '1234567' ], ['%n', { change => 'foo' }, 'foo'], ['%n', { change => 'bar' }, 'bar'], ['%o', { project => 'foo' }, 'foo'], ['%o', { project => 'bar' }, 'bar'], ['%p', { planner_name => 'larry', planner_email => 'larry@example.com' }, 'larry '], ['%{n}p', { planner_name => 'damian' }, 'damian'], ['%{name}p', { planner_name => 'chip' }, 'chip'], ['%{e}p', { planner_email => 'larry@example.com' }, 'larry@example.com'], ['%{email}p', { planner_email => 'damian@example.com' }, 'damian@example.com'], ['%{date}p', { planned_at => $pdt }, $pdt->as_string( format => 'iso' ) ], ['%{date:rfc}p', { planned_at => $pdt }, $pdt->as_string( format => 'rfc' ) ], ['%{d:long}p', { planned_at => $pdt }, $pdt->as_string( format => 'long' ) ], ["%{d:cldr:HH'h' mm'm'}p", { planned_at => $pdt }, $local_pdt->format_cldr( q{HH'h' mm'm'} ) ], ["%{d:strftime:%a at %H:%M:%S}p", { planned_at => $pdt }, $local_pdt->strftime('%a at %H:%M:%S') ], ['%t', { tags => [] }, '' ], ['%t', { tags => ['@foo'] }, ' @foo' ], ['%t', { tags => ['@foo', '@bar'] }, ' @foo, @bar' ], ['%{|}t', { tags => [] }, '' ], ['%{|}t', { tags => ['@foo'] }, ' @foo' ], ['%{|}t', { tags => ['@foo', '@bar'] }, ' @foo|@bar' ], ['%T', { tags => [] }, '' ], ['%T', { tags => ['@foo'] }, ' (@foo)' ], ['%T', { tags => ['@foo', '@bar'] }, ' (@foo, @bar)' ], ['%{|}T', { tags => [] }, '' ], ['%{|}T', { tags => ['@foo'] }, ' (@foo)' ], ['%{|}T', { tags => ['@foo', '@bar'] }, ' (@foo|@bar)' ], ['%r', { requires => [] }, '' ], ['%r', { requires => ['foo'] }, ' foo' ], ['%r', { requires => ['foo', 'bar'] }, ' foo, bar' ], ['%{|}r', { requires => [] }, '' ], ['%{|}r', { requires => ['foo'] }, ' foo' ], ['%{|}r', { requires => ['foo', 'bar'] }, ' foo|bar' ], ['%R', { requires => [] }, '' ], ['%R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ], ['%R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo, bar\n" ], ['%{|}R', { requires => [] }, '' ], ['%{|}R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ], ['%{|}R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo|bar\n" ], ['%x', { conflicts => [] }, '' ], ['%x', { conflicts => ['foo'] }, ' foo' ], ['%x', { conflicts => ['foo', 'bax'] }, ' foo, bax' ], ['%{|}x', { conflicts => [] }, '' ], ['%{|}x', { conflicts => ['foo'] }, ' foo' ], ['%{|}x', { conflicts => ['foo', 'bax'] }, ' foo|bax' ], ['%X', { conflicts => [] }, '' ], ['%X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ], ['%X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo, bar\n" ], ['%{|}X', { conflicts => [] }, '' ], ['%{|}X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ], ['%{|}X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo|bar\n" ], ['%{yellow}C', {}, '' ], ['%{:event}C', { event => 'deploy' }, '' ], ['%v', {}, "\n" ], ['%%', {}, '%' ], ['%s', { note => 'hi there' }, 'hi there' ], ['%s', { note => "hi there\nyo" }, 'hi there' ], ['%s', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, 'subject line' ], ['%{ }s', { note => 'hi there' }, ' hi there' ], ['%{xx}s', { note => 'hi there' }, 'xxhi there' ], ['%b', { note => 'hi there' }, '' ], ['%b', { note => "hi there\nyo" }, 'yo' ], ['%b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "first graph\n\nsecond graph\n\n" ], ['%{ }b', { note => 'hi there' }, '' ], ['%{xxx }b', { note => "hi there\nyo" }, "xxx yo" ], ['%{x}b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xfirst graph\nx\nxsecond graph\nx\n" ], ['%{ }b', { note => "hi there\r\nyo" }, " yo" ], ['%B', { note => 'hi there' }, 'hi there' ], ['%B', { note => "hi there\nyo" }, "hi there\nyo" ], ['%B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "subject line\n\nfirst graph\n\nsecond graph\n\n" ], ['%{ }B', { note => 'hi there' }, ' hi there' ], ['%{xxx }B', { note => "hi there\nyo" }, "xxx hi there\nxxx yo" ], ['%{x}B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xsubject line\nx\nxfirst graph\nx\nxsecond graph\nx\n" ], ['%{ }B', { note => "hi there\r\nyo" }, " hi there\r\n yo" ], ['%{change}a', $change, "change $change->{change}\n" ], ['%{change_id}a', $change, "change_id $change->{change_id}\n" ], ['%{event}a', $change, "event $change->{event}\n" ], ['%{tags}a', $change, 'tags ' . join(', ', @{ $change->{tags} }) . "\n" ], ['%{requires}a', $change, 'requires ' . join(', ', @{ $change->{requires} }) . "\n" ], ['%{conflicts}a', $change, '' ], ) { local $ENV{ANSI_COLORS_DISABLED} = 1; (my $desc = encode_utf8 $spec->[2]) =~ s/\n/[newline]/g; is $formatter->format( $spec->[0], $spec->[1] ), $spec->[2], qq{Format "$spec->[0]" should output "$desc"}; } throws_ok { $formatter->format( '%_', {} ) } 'App::Sqitch::X', 'Should get exception for format "%_"'; is $@->ident, 'format', '%_ error ident should be "format"'; is $@->message, __ 'No label passed to the _ format', '%_ error message should be correct'; throws_ok { $formatter->format( '%{foo}_', {} ) } 'App::Sqitch::X', 'Should get exception for unknown label in format "%_"'; is $@->ident, 'format', 'Invalid %_ label error ident should be "format"'; is $@->message, __x( 'Unknown label "{label}" passed to the _ format', label => 'foo' ), 'Invalid %_ label error message should be correct'; ok $cmd = $CLASS->new( sqitch => $sqitch, formatter => App::Sqitch::ItemFormatter->new(abbrev => 4) ), 'Instantiate with abbrev => 4'; is $cmd->formatter->format( '%h', { change_id => '123456789' } ), '1234', '%h should respect abbrev'; is $cmd->formatter->format( '%H', { change_id => '123456789' } ), '123456789', '%H should not respect abbrev'; ok $cmd = $CLASS->new( sqitch => $sqitch, formatter => App::Sqitch::ItemFormatter->new(date_format => 'rfc') ), 'Instantiate with date_format => "rfc"'; is $cmd->formatter->format( '%{date}p', { planned_at => $cdt } ), $cdt->as_string( format => 'rfc' ), '%{date}p should respect the date_format attribute'; is $cmd->formatter->format( '%{d:iso}p', { planned_at => $cdt } ), $cdt->as_string( format => 'iso' ), '%{iso}p should override the date_format attribute'; throws_ok { $formatter->format( '%{foo}a', {}) } 'App::Sqitch::X', 'Should get exception for unknown attribute passed to %a'; is $@->ident, 'format', '%a error ident should be "format"'; is $@->message, __x( '{attr} is not a valid change attribute', attr => 'foo' ), '%a error message should be correct'; delete $ENV{ANSI_COLORS_DISABLED}; for my $color (qw(yellow red blue cyan magenta)) { is $formatter->format( "%{$color}C", {} ), color($color), qq{Format "%{$color}C" should output } . color($color) . $color . color('reset'); } for my $spec ( [ ':event', { event => 'deploy' }, 'green', 'deploy' ], [ ':event', { event => 'revert' }, 'blue', 'revert' ], [ ':event', { event => 'fail' }, 'red', 'fail' ], ) { is $formatter->format( "%{$spec->[0]}C", $spec->[1] ), color($spec->[2]), qq{Format "%{$spec->[0]}C" on "$spec->[3]" should output } . color($spec->[2]) . $spec->[2] . color('reset'); } # Make sure other colors work. my $yellow = color('yellow') . '%s' . color('reset'); my $green = color('green') . '%s' . color('reset'); my $cyan = color('cyan') . ' %s' . color('reset'); $change->{conflicts} = [qw(dr_evil)]; for my $spec ( [ full => sprintf($green, __ ('Deploy') . ' 000011112222333444') . " (\@beta, \@gamma)\n" . __ ('Name: ') . " lolz\n" . __ ('Project: ') . " planit\n" . __ ('Requires: ') . " foo, bar\n" . __ ('Conflicts:') . " dr_evil\n" . __ ('Planner: ') . " damian \n" . __ ('Planned: ') . " __PDATE__\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ long => sprintf($green, __ ('Deploy') . ' 000011112222333444') . " (\@beta, \@gamma)\n" . __ ('Name: ') . " lolz\n" . __ ('Project: ') . " planit\n" . __ ('Planner: ') . " damian \n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ medium => sprintf($green, __ ('Deploy') . ' 000011112222333444') . "\n" . __ ('Name: ') . " lolz\n" . __ ('Planner: ') . " damian \n" . __ ('Date: ') . " __PDATE__\n\n" . " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n" ], [ short => sprintf($green, __ ('Deploy') . ' 000011112222333444') . "\n" . __ ('Name: ') . " lolz\n" . __ ('Planner: ') . " damian \n\n" . " For the LOLZ.\n", ], [ oneline => sprintf "$green %s$cyan", '000011112222333444' . ' ' . __('deploy'), 'lolz', '@beta, @gamma', ], ) { my $format = $CLASS->configure( $config, { format => $spec->[0] } )->{format}; ok my $cmd = $CLASS->new( sqitch => $sqitch, format => $format ), qq{Instantiate with format "$spec->[0]" again}; (my $exp = $spec->[1]) =~ s/__PDATE__/$piso/; is $cmd->formatter->format( $cmd->format, $change ), $exp, qq{Format "$spec->[0]" should output correctly with color}; } throws_ok { $formatter->format( '%{BLUELOLZ}C', {} ) } 'App::Sqitch::X', 'Should get an error for an invalid color'; is $@->ident, 'format', 'Invalid color error ident should be "format"'; is $@->message, __x( '{color} is not a valid ANSI color', color => 'BLUELOLZ' ), 'Invalid color error message should be correct'; ############################################################################## # Test execute(). my $pmock = Test::MockModule->new('App::Sqitch::Plan'); # First, test for no changes. $pmock->mock(count => 0); my $plan = $cmd->default_target->plan; throws_ok { $cmd->execute } 'App::Sqitch::X', 'Should get error for no changes'; is $@->ident, 'plan', 'no changes error ident should be "plan"'; is $@->exitval, 1, 'no changes exit val should be 1'; is $@->message, __x( 'No changes in {file}', file => $plan->file, ), 'no changes error message should be correct'; $pmock->unmock('count'); # Okay, let's see some changes. my @changes; my $iter = sub { shift @changes }; my $search_args; $pmock->mock(search_changes => sub { shift; $search_args = [@_]; return $iter; }); $change = $plan->change_at(0); push @changes => $change; ok $cmd->execute, 'Execute plan'; is_deeply $search_args, [ operation => undef, name => undef, planner => undef, limit => undef, offset => undef, direction => 'ASC' ], 'The proper args should have been passed to search_events'; my $fmt_params = { event => $change->is_deploy ? 'deploy' : 'revert', project => $change->project, change_id => $change->id, change => $change->name, note => $change->note, tags => [ map { $_->format_name } $change->tags ], requires => [ map { $_->as_string } $change->requires ], conflicts => [ map { $_->as_string } $change->conflicts ], planned_at => $change->timestamp, planner_name => $change->planner_name, planner_email => $change->planner_email, }; is_deeply +MockOutput->get_page, [ ['# ', __x 'Project: {project}', project => $plan->project ], ['# ', __x 'File: {file}', file => $plan->file ], [''], [ $cmd->formatter->format( $cmd->format, $fmt_params ) ], ], 'The event should have been paged'; # Set attributes and add more events. my $change2 = $plan->change_at(1); push @changes => $change, $change2; isa_ok $cmd = $CLASS->new( sqitch => $sqitch, event => 'deploy', change_pattern => '.+', project_pattern => '.+', planner_pattern => '.+', max_count => 10, skip => 5, reverse => 1, ), $CLASS, 'plan with attributes'; ok $cmd->execute, 'Execute plan with attributes'; is_deeply $search_args, [ operation => 'deploy', name => '.+', planner => '.+', limit => 10, offset => 5, direction => 'DESC' ], 'All params should have been passed to search_events'; my $fmt_params2 = { event => $change2->is_deploy ? 'deploy' : 'revert', project => $change2->project, change_id => $change2->id, change => $change2->name, note => $change2->note, tags => [ map { $_->format_name } $change2->tags ], requires => [ map { $_->as_string } $change2->requires ], conflicts => [ map { $_->as_string } $change2->conflicts ], planned_at => $change2->timestamp, planner_name => $change2->planner_name, planner_email => $change2->planner_email, }; is_deeply +MockOutput->get_page, [ ['# ', __x 'Project: {project}', project => $plan->project ], ['# ', __x 'File: {file}', file => $plan->file ], [''], [ $cmd->formatter->format( $cmd->format, $fmt_params ) ], [ $cmd->formatter->format( $cmd->format, $fmt_params2 ) ], ], 'Both events should have been paged'; # Make sure we catch bad format codes. isa_ok $cmd = $CLASS->new( sqitch => $sqitch, format => '%Z', ), $CLASS, 'plan with bad format'; push @changes, $change; throws_ok { $cmd->execute } 'App::Sqitch::X', 'Should get an exception for a bad format code'; is $@->ident, 'format', 'bad format code format error ident should be "format"'; is $@->message, __x( 'Unknown format code "{code}"', code => 'Z', ), 'bad format code format error message should be correct'; # Gotta make sure params are parsed. my $mock_cmd = Test::MockModule->new($CLASS); my (@params, $orig_parse); $mock_cmd->mock(parse_args => sub { my $self = shift; @params = @_; $self->$orig_parse(@_); }); $orig_parse = $mock_cmd->original('parse_args'); # Try specifying an unkonwn target. ok $cmd = $CLASS->new( sqitch => $sqitch, target => 'foo'), 'Create plan command with unknown target option'; throws_ok { $cmd->execute } 'App::Sqitch::X', 'Should get error for unknown target'; is $@->ident, 'target', 'Unknown target error ident should be "plan"'; is $@->exitval, 2, 'Unknown target changes exit val should be 2'; is $@->message, __x('Cannot find target "{target}"', target => 'foo'), 'Unknown target error message should be correct'; is_deeply \@params, [ target => 'foo', args => [] ], 'Should have passed target for parsing'; # Try passing an engine target. ok $cmd = $CLASS->new( sqitch => $sqitch), 'Create plan command with target option'; ok $cmd->execute('sqlite'), 'Execute with engine arg'; is_deeply \@params, [ target => undef, args => [qw(sqlite)] ], 'Should have passed engine for parsing'; # Try both --target and arg.. ok $cmd = $CLASS->new( sqitch => $sqitch, target => 'db:pg:'), 'Create plan command with target option'; ok $cmd->execute('sqlite'), 'Execute with multiple targets'; is_deeply +MockOutput->get_warn, [[__x( 'Too many targets specified; using {target}', target => 'db:pg:', )]], 'Should have got warning for two targets'; App-Sqitch-0.9996/t/plans/000755 000767 000024 00000000000 13133201371 015411 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/pragma.t000644 000767 000024 00000002670 13133201371 015735 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 10; #use Test::More 'no_plan'; use Test::NoWarnings; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Plan::Pragma'; require_ok $CLASS or die; } can_ok $CLASS, qw( name lspace rspace hspace ropspace lopspace note plan value ); my $sqitch = App::Sqitch->new(options => { engine => 'sqlite' }); my $target = App::Sqitch::Target->new(sqitch => $sqitch); my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target); isa_ok my $dir = $CLASS->new( name => 'foo', plan => $plan, ), $CLASS; isa_ok $dir, 'App::Sqitch::Plan::Line'; is $dir->format_name, '%foo', 'Name should format as "%foo"'; is $dir->format_value, '', 'Value should format as ""'; is $dir->as_string, '%foo', 'should stringify to "%foo"'; ok $dir = $CLASS->new( name => 'howdy', value => 'woody', plan => $plan, lspace => ' ', hspace => ' ', rspace => "\t", lopspace => ' ', operator => '=', ropspace => ' ', note => 'blah blah blah', ), 'Create pragma with more stuff'; is $dir->as_string, " % howdy = woody\t# blah blah blah", 'It should stringify correctly'; App-Sqitch-0.9996/t/read.pl000644 000767 000024 00000000041 13133201371 015537 0ustar00davidstaff000000 000000 use 5.010; print while ; App-Sqitch-0.9996/t/rebase.t000644 000767 000024 00000037413 13133201371 015732 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use Path::Class qw(dir file); use App::Sqitch::X qw(hurl); use Locale::TextDomain qw(App-Sqitch); use Test::MockModule; use Test::Exception; use lib 't/lib'; use MockOutput; my $CLASS = 'App::Sqitch::Command::rebase'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; isa_ok $CLASS, 'App::Sqitch::Command'; can_ok $CLASS, qw( target options configure new onto_change upto_change log_only execute deploy_variables revert_variables ); is_deeply [$CLASS->options], [qw( onto-change|onto=s upto-change|upto=s onto-target=s upto-target=s target|t=s mode=s verify! set|s=s% set-deploy|d=s% set-revert|r=s% log-only y )], 'Options should be correct'; my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', plan_file => file(qw(t sql sqitch.plan))->stringify, top_dir => dir(qw(t sql))->stringify, } ); my $config = $sqitch->config; # Test configure(). is_deeply $CLASS->configure($config, {}), { no_prompt => 0, verify => 0, mode => 'all', prompt_accept => 1 }, 'Should have empty default configuration with no config or opts'; is_deeply $CLASS->configure($config, { set => { foo => 'bar' }, }), { no_prompt => 0, prompt_accept => 1, verify => 0, mode => 'all', deploy_variables => { foo => 'bar' }, revert_variables => { foo => 'bar' }, }, 'Should have set option'; is_deeply $CLASS->configure($config, { y => 1, set_deploy => { foo => 'bar' }, log_only => 1, verify => 1, mode => 'tag', }), { mode => 'tag', no_prompt => 1, prompt_accept => 1, deploy_variables => { foo => 'bar' }, verify => 1, log_only => 1, }, 'Should have mode, deploy_variables, verify, no_prompt, and log_only'; is_deeply $CLASS->configure($config, { y => 0, set_revert => { foo => 'bar' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, revert_variables => { foo => 'bar' }, }, 'Should have set_revert option and no_prompt false'; is_deeply $CLASS->configure($config, { set => { foo => 'bar' }, set_deploy => { foo => 'dep', hi => 'you' }, set_revert => { foo => 'rev', hi => 'me' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'dep', hi => 'you' }, revert_variables => { foo => 'rev', hi => 'me' }, }, 'set_deploy and set_revert should overrid set'; is_deeply $CLASS->configure($config, { set => { foo => 'bar' }, set_deploy => { hi => 'you' }, set_revert => { hi => 'me' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'bar', hi => 'you' }, revert_variables => { foo => 'bar', hi => 'me' }, }, 'set_deploy and set_revert should merge with set'; is_deeply $CLASS->configure($config, { set => { foo => 'bar' }, set_deploy => { hi => 'you' }, set_revert => { my => 'yo' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'bar', hi => 'you' }, revert_variables => { foo => 'bar', hi => 'you', my => 'yo' }, }, 'set_revert should merge with set_deploy'; CONFIG: { my $mock_config = Test::MockModule->new(ref $config); my %config_vals; $mock_config->mock(get => sub { my ($self, %p) = @_; return $config_vals{ $p{key} }; }); $mock_config->mock(get_section => sub { my ($self, %p) = @_; return $config_vals{ $p{section} } || {}; }); %config_vals = ( 'deploy.variables' => { foo => 'bar', hi => 21 }, ); is_deeply $CLASS->configure($config, {}), {no_prompt => 0, verify => 0, mode => 'all', prompt_accept => 1}, 'Should have deploy configuration'; # Try merging. is_deeply $CLASS->configure($config, { onto_target => 'whu', set => { foo => 'yo', yo => 'stellar' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'yo', yo => 'stellar', hi => 21 }, revert_variables => { foo => 'yo', yo => 'stellar', hi => 21 }, onto_change => 'whu', }, 'Should have merged variables'; is_deeply +MockOutput->get_warn, [[__x( 'Option --{old} has been deprecated; use --{new} instead', old => 'onto-target', new => 'onto-change', )]], 'Should get warning for deprecated --onto-target'; # Try merging with rebase.variables, too. $config_vals{'revert.variables'} = { hi => 42 }; is_deeply $CLASS->configure($config, { set => { yo => 'stellar' }, }), { mode => 'all', no_prompt => 0, prompt_accept => 1, verify => 0, deploy_variables => { foo => 'bar', yo => 'stellar', hi => 21 }, revert_variables => { foo => 'bar', yo => 'stellar', hi => 42 }, }, 'Should have merged --set, deploy, rebase'; isa_ok my $rebase = $CLASS->new(sqitch => $sqitch), $CLASS; is_deeply $rebase->deploy_variables, { foo => 'bar', hi => 21 }, 'Should pick up deploy variables from configuration'; is_deeply $rebase->revert_variables, { foo => 'bar', hi => 42 }, 'Should pick up revert variables from configuration'; # Make sure we can override mode, prompting, and verify. %config_vals = ( 'revert.no_prompt' => 1, 'revert.prompt_accept' => 0, 'deploy.verify' => 1, 'deploy.mode' => 'tag', ); is_deeply $CLASS->configure($config, {}), { no_prompt => 1, prompt_accept => 0, verify => 1, mode => 'tag', }, 'Should have no_prompt true'; # Rebase option takes precendence $config_vals{'rebase.no_prompt'} = 0; $config_vals{'rebase.prompt_accept'} = 1; $config_vals{'rebase.verify'} = 0; $config_vals{'rebase.mode'} = 'change'; is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1, verify => 0, mode => 'change', }, 'Should have false no_prompt, verify, and true prompt_accept from rebase config'; delete $config_vals{'revert.no_prompt'}; delete $config_vals{'revert.prompt_accept'}; delete $config_vals{'rebase.verify'}; delete $config_vals{'rebase.mode'}; $config_vals{'rebase.no_prompt'} = 1; $config_vals{'rebase.prompt_accept'} = 0; is_deeply $CLASS->configure($config, {}), { no_prompt => 1, prompt_accept => 0, verify => 1, mode => 'tag', }, 'Should have true no_prompt, verify, and false prompt_accept from rebase from deploy'; # But option should override. is_deeply $CLASS->configure($config, {y => 0, verify => 0, mode => 'all'}), { no_prompt => 0, verify => 0, mode => 'all', prompt_accept => 0 }, 'Should have no_prompt, prompt_accept false and mode all again'; $config_vals{'revert.no_prompt'} = 0; $config_vals{'revert.prompt_accept'} = 1; delete $config_vals{'rebase.no_prompt'}; delete $config_vals{'rebase.prompt_accept'}; is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1, verify => 1, mode => 'tag', }, 'Should have no_prompt false and prompt_accept true for revert config'; is_deeply $CLASS->configure($config, {y => 1}), { no_prompt => 1, prompt_accept => 1, verify => 1, mode => 'tag', }, 'Should have no_prompt true with -y'; } ############################################################################## # Test accessors. isa_ok my $rebase = $CLASS->new( sqitch => $sqitch, target => 'foo', ), $CLASS, 'new status with target'; is $rebase->target, 'foo', 'Should have target "foo"'; isa_ok $rebase = $CLASS->new(sqitch => $sqitch), $CLASS; is $rebase->target, undef, 'Should have undef target'; is $rebase->onto_change, undef, 'onto_change should be undef'; is $rebase->upto_change, undef, 'upto_change should be undef'; # Mock the engine interface. my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite'); my @dep_args; $mock_engine->mock(deploy => sub { shift; @dep_args = @_ }); my @rev_args; $mock_engine->mock(revert => sub { shift; @rev_args = @_ }); my @vars; $mock_engine->mock(set_variables => sub { shift; push @vars => [@_] }); my $mock_cmd = Test::MockModule->new($CLASS); my ($target, $orig_method); $mock_cmd->mock(parse_args => sub { my @ret = shift->$orig_method(@_); $target = $ret[0][0]; @ret; }); $orig_method = $mock_cmd->original('parse_args'); ok $rebase->execute('@alpha'), 'Execute to "@alpha"'; is_deeply \@dep_args, [undef, 'all'], 'undef, and "all" should be passed to the engine deploy'; is_deeply \@rev_args, ['@alpha'], '"@alpha" should be passed to the engine revert'; ok !$target->engine->no_prompt, 'Engine should prompt'; ok !$target->engine->log_only, 'Engine should no be log only'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Pass a target. ok $rebase->execute('db:sqlite:yow'), 'Execute with target'; is_deeply \@dep_args, [undef, 'all'], 'undef, and "all" should be passed to the engine deploy'; is_deeply \@rev_args, [undef], 'undef should be passed to the engine revert'; ok !$target->engine->no_prompt, 'Engine should prompt'; ok !$target->engine->log_only, 'Engine should no be log only'; is $target->name, 'db:sqlite:yow', 'The target name should be as passed'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Pass both. ok $rebase->execute('db:sqlite:yow', 'widgets'), 'Execute with onto and target'; is_deeply \@dep_args, [undef, 'all'], 'undef, and "all" should be passed to the engine deploy'; is_deeply \@rev_args, ['widgets'], '"widgets" should be passed to the engine revert'; ok !$target->engine->no_prompt, 'Engine should prompt'; ok !$target->engine->log_only, 'Engine should no be log only'; is $target->name, 'db:sqlite:yow', 'The target name should be as passed'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Pass all three! ok $rebase->execute('db:sqlite:yow', 'roles', 'widgets'), 'Execute with three args'; is_deeply \@dep_args, ['widgets', 'all'], '"widgets", and "all" should be passed to the engine deploy'; is_deeply \@rev_args, ['roles'], '"roles" should be passed to the engine revert'; ok !$target->engine->no_prompt, 'Engine should prompt'; ok !$target->engine->log_only, 'Engine should no be log only'; is $target->name, 'db:sqlite:yow', 'The target name should be as passed'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Pass no args. @dep_args = @rev_args = (); ok $rebase->execute, 'Execute'; is_deeply \@dep_args, [undef, 'all'], 'undef and "all" should be passed to the engine deploy'; is_deeply \@rev_args, [undef], 'undef and = should be passed to the engine revert'; is_deeply \@vars, [], 'No vars should have been passed through to the engine'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Mix it up with options. isa_ok $rebase = $CLASS->new( target => 'db:sqlite:lolwut', no_prompt => 1, log_only => 1, verify => 1, sqitch => $sqitch, mode => 'tag', onto_change => 'foo', upto_change => 'bar', deploy_variables => { foo => 'bar', one => 1 }, revert_variables => { hey => 'there' }, ), $CLASS, 'Object with to and variables'; @dep_args = @rev_args = (); ok $rebase->execute, 'Execute again'; is $target->name, 'db:sqlite:lolwut', 'Target name should be from option'; ok $target->engine->no_prompt, 'Engine should be no_prompt'; ok $target->engine->log_only, 'Engine should be log_only'; ok $target->engine->with_verify, 'Engine should verify'; is_deeply \@dep_args, ['bar', 'tag'], '"bar", "tag", and 1 should be passed to the engine deploy'; is_deeply \@rev_args, ['foo'], '"foo" and 1 should be passed to the engine revert'; is @vars, 2, 'Variables should have been passed to the engine twice'; is_deeply { @{ $vars[0] } }, { hey => 'there' }, 'The revert vars should have been passed first'; is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 }, 'The deploy vars should have been next'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Make sure we get warnings for too many things. @dep_args = @rev_args, @vars = (); ok $rebase->execute('db:sqlite:yow', 'roles', 'widgets'), 'Execute with three args'; is $target->name, 'db:sqlite:lolwut', 'Target name should be from option'; ok $target->engine->no_prompt, 'Engine should be no_prompt'; ok $target->engine->log_only, 'Engine should be log_only'; ok $target->engine->with_verify, 'Engine should verify'; is_deeply \@dep_args, ['bar', 'tag'], '"bar", "tag", and 1 should be passed to the engine deploy'; is_deeply \@rev_args, ['foo'], '"foo" and 1 should be passed to the engine revert'; is @vars, 2, 'Variables should have been passed to the engine twice'; is_deeply { @{ $vars[0] } }, { hey => 'there' }, 'The revert vars should have been passed first'; is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 }, 'The deploy vars should have been next'; is_deeply +MockOutput->get_warn, [[__x( 'Too many targets specified; connecting to {target}', target => 'db:sqlite:lolwut', )], [__x( 'Too many changes specified; rebasing onto "{onto}" up to "{upto}"', onto => 'foo', upto => 'bar', )]], 'Should have two warnings'; # Make sure we get an exception for unknown args. throws_ok { $rebase->execute(qw(greg)) } 'App::Sqitch::X', 'Should get an exception for unknown arg'; is $@->ident, 'rebase', 'Unknow arg ident should be "rebase"'; is $@->message, __x( 'Unknown argument "{arg}"', arg => 'greg', ), 'Should get an exeption for two unknown arg'; throws_ok { $rebase->execute(qw(greg jon)) } 'App::Sqitch::X', 'Should get an exception for unknown args'; is $@->ident, 'rebase', 'Unknow args ident should be "rebase"'; is $@->message, __x( 'Unknown arguments: {arg}', arg => 'greg, jon', ), 'Should get an exeption for two unknown args'; # If nothing is deployed, or we are already at the revert target, the revert # should be skipped. @dep_args = @rev_args = @vars = (); $mock_engine->mock(revert => sub { hurl { ident => 'revert', message => 'foo', exitval => 1 } }); ok $rebase->execute, 'Execute once more'; is_deeply \@dep_args, ['bar', 'tag'], '"bar", "tag", and 1 should be passed to the engine deploy'; is @vars, 2, 'Variables should have been passed to the engine twice'; is_deeply { @{ $vars[0] } }, { hey => 'there' }, 'The revert vars should have been passed first'; is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 }, 'The deploy vars should have been next'; is_deeply +MockOutput->get_info, [['foo']], 'Should have emitted info for non-fatal revert exception'; # Should die for fatal, unknown, or confirmation errors. for my $spec ( [ confirm => App::Sqitch::X->new(ident => 'revert:confirm', message => 'foo', exitval => 1) ], [ fatal => App::Sqitch::X->new(ident => 'revert', message => 'foo', exitval => 2) ], [ unknown => bless { } => __PACKAGE__ ], ) { $mock_engine->mock(revert => sub { die $spec->[1] }); throws_ok { $rebase->execute } ref $spec->[1], "Should rethrow $spec->[0] exception"; } done_testing; App-Sqitch-0.9996/t/revert.t000644 000767 000024 00000021130 13133201371 015765 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use Path::Class qw(dir file); use Test::MockModule; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use lib 't/lib'; use MockOutput; my $CLASS = 'App::Sqitch::Command::revert'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; isa_ok $CLASS, 'App::Sqitch::Command'; can_ok $CLASS, qw( target options configure new to_change log_only execute variables ); is_deeply [$CLASS->options], [qw( target|t=s to-change|to|change=s to-target=s set|s=s% log-only y )], 'Options should be correct'; my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', plan_file => file(qw(t sql sqitch.plan))->stringify, top_dir => dir(qw(t sql))->stringify, }, ); my $config = $sqitch->config; # Test configure(). is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1 }, 'Should have empty default configuration with no config or opts'; is_deeply $CLASS->configure($config, { y => 1, set => { foo => 'bar' }, }), { no_prompt => 1, prompt_accept => 1, variables => { foo => 'bar' }, }, 'Should have set option'; CONFIG: { my $mock_config = Test::MockModule->new(ref $config); my %config_vals; $mock_config->mock(get => sub { my ($self, %p) = @_; return $config_vals{ $p{key} }; }); $mock_config->mock(get_section => sub { my ($self, %p) = @_; return $config_vals{ $p{section} } || {}; }); %config_vals = ( 'deploy.variables' => { foo => 'bar', hi => 21 }, ); is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1 }, 'Should have no_prompt false, prompt_accept true'; # Try merging. is_deeply $CLASS->configure($config, { to_change => 'whu', log_only => 1, set => { foo => 'yo', yo => 'stellar' }, }), { no_prompt => 0, prompt_accept => 1, variables => { foo => 'yo', yo => 'stellar', hi => 21 }, to_change => 'whu', log_only => 1, }, 'Should have merged variables'; # Try merging with revert.variables, too. $config_vals{'revert.variables'} = { hi => 42 }; is_deeply $CLASS->configure($config, { set => { yo => 'stellar' }, }), { no_prompt => 0, prompt_accept => 1, variables => { foo => 'bar', yo => 'stellar', hi => 42 }, }, 'Should have merged --set, deploy, revert'; isa_ok my $revert = $CLASS->new(sqitch => $sqitch), $CLASS; is_deeply $revert->variables, { foo => 'bar', hi => 42 }, 'Should pick up variables from configuration'; # Make sure we can override prompting. %config_vals = ('revert.no_prompt' => 1, 'revert.prompt_accept' => 0); is_deeply $CLASS->configure($config, {}), { no_prompt => 1, prompt_accept => 0 }, 'Should have no_prompt true, prompt_accept false'; # But option should override. is_deeply $CLASS->configure($config, {y => 0}), { no_prompt => 0, prompt_accept => 0 }, 'Should have no_prompt false again'; %config_vals = ('revert.no_prompt' => 0, 'revert.prompt_accept' => 1); is_deeply $CLASS->configure($config, {}), { no_prompt => 0, prompt_accept => 1 }, 'Should have no_prompt false for false config'; is_deeply $CLASS->configure($config, {y => 1}), { no_prompt => 1, prompt_accept => 1 }, 'Should have no_prompt true with -y'; } ############################################################################## # Test accessors. isa_ok my $revert = $CLASS->new( sqitch => $sqitch, target => 'foo', no_prompt => 1, ), $CLASS, 'new revert with target'; is $revert->target, 'foo', 'Should have target "foo"'; is $revert->to_change, undef, 'to_change should be undef'; isa_ok $revert = $CLASS->new(sqitch => $sqitch, no_prompt => 1), $CLASS; is $revert->target, undef, 'Should have undef default target'; is $revert->to_change, undef, 'to_change should be undef'; # Mock the engine interface. my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite'); my @args; $mock_engine->mock(revert => sub { shift; @args = @_ }); my @vars; $mock_engine->mock(set_variables => sub { shift; @vars = @_ }); my $mock_cmd = Test::MockModule->new($CLASS); my ($target, $orig_method); $mock_cmd->mock(parse_args => sub { my @ret = shift->$orig_method(@_); $target = $ret[0][0]; @ret; }); $orig_method = $mock_cmd->original('parse_args'); # Pass the change. ok $revert->execute('@alpha'), 'Execute to "@alpha"'; ok $target->engine->no_prompt, 'Engine should be no_prompt'; ok !$target->engine->log_only, 'Engine should not be log_only'; is_deeply \@args, ['@alpha'], '"@alpha" should be passed to the engine'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Pass nothing. @args = (); ok $revert->execute, 'Execute'; is_deeply \@args, [undef], 'undef should be passed to the engine'; is_deeply {@vars}, { }, 'No vars should have been passed through to the engine'; is_deeply +MockOutput->get_warn, [], 'Should still have no warnings'; # Pass the target. ok $revert->execute('db:sqlite:hi'), 'Execute to target'; ok $target->engine->no_prompt, 'Engine should be no_prompt'; ok !$target->engine->log_only, 'Engine should not be log_only'; is_deeply \@args, [undef], 'undef" should be passed to the engine'; is $target->name, 'db:sqlite:hi', 'Target name should be as passed'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Pass them both! ok $revert->execute('db:sqlite:lol', 'widgets'), 'Execute with change and target'; ok $target->engine->no_prompt, 'Engine should be no_prompt'; ok !$target->engine->log_only, 'Engine should not be log_only'; is_deeply \@args, ['widgets'], '"widgets" should be passed to the engine'; is $target->name, 'db:sqlite:lol', 'Target name should be as passed'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # And reverse them. ok $revert->execute('db:sqlite:lol', 'widgets'), 'Execute with target and change'; ok $target->engine->no_prompt, 'Engine should be no_prompt'; ok !$target->engine->log_only, 'Engine should not be log_only'; is_deeply \@args, ['widgets'], '"widgets" should be passed to the engine'; is $target->name, 'db:sqlite:lol', 'Target name should be as passed'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Now specify options. isa_ok $revert = $CLASS->new( sqitch => $sqitch, target => 'db:sqlite:welp', to_change => 'foo', log_only => 1, variables => { foo => 'bar', one => 1 }, ), $CLASS, 'Object with to and variables'; @args = (); ok $revert->execute, 'Execute again'; ok !$target->engine->no_prompt, 'Engine should not be no_prompt'; ok $target->engine->log_only, 'Engine should be log_only'; is_deeply \@args, ['foo'], '"foo" and 1 should be passed to the engine'; is_deeply {@vars}, { foo => 'bar', one => 1 }, 'Vars should have been passed through to the engine'; is $target->name, 'db:sqlite:welp', 'Target name should be from option'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Try also passing the target and change. ok $revert->execute('db:sqlite:lol', '@alpha'), 'Execute with options and args'; ok !$target->engine->no_prompt, 'Engine should not be no_prompt'; ok $target->engine->log_only, 'Engine should be log_only'; is_deeply \@args, ['foo'], '"foo" and 1 should be passed to the engine'; is_deeply {@vars}, { foo => 'bar', one => 1 }, 'Vars should have been passed through to the engine'; is $target->name, 'db:sqlite:welp', 'Target name should be from option'; is_deeply +MockOutput->get_warn, [[__x( 'Too many targets specified; connecting to {target}', target => 'db:sqlite:welp', )], [__x( 'Too many changes specified; reverting to "{change}"', change => 'foo', )]], 'Should have two warnings'; # Make sure we get an exception for unknown args. throws_ok { $revert->execute(qw(greg)) } 'App::Sqitch::X', 'Should get an exception for unknown arg'; is $@->ident, 'revert', 'Unknow arg ident should be "revert"'; is $@->message, __x( 'Unknown argument "{arg}"', arg => 'greg', ), 'Should get an exeption for two unknown arg'; throws_ok { $revert->execute(qw(greg jon)) } 'App::Sqitch::X', 'Should get an exception for unknown args'; is $@->ident, 'revert', 'Unknow args ident should be "revert"'; is $@->message, __x( 'Unknown arguments: {arg}', arg => 'greg, jon', ), 'Should get an exeption for two unknown args'; done_testing; App-Sqitch-0.9996/t/rework.conf000644 000767 000024 00000000040 13133201371 016446 0ustar00davidstaff000000 000000 [rework] open_editor = true App-Sqitch-0.9996/t/rework.t000644 000767 000024 00000100752 13133201371 015777 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 231; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::Exception; use App::Sqitch::Command::add; use Path::Class; use Test::File qw(file_not_exists_ok file_exists_ok); use Test::File::Contents qw(file_contents_identical file_contents_is files_eq); use File::Path qw(make_path remove_tree); use Test::NoWarnings; use lib 't/lib'; use MockOutput; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::Command::rework'; my $test_dir = dir 'test-rework'; ok my $sqitch = App::Sqitch->new( options => { engine => 'pg', top_dir => $test_dir->stringify, }, ), 'Load a sqitch sqitch object'; my $config = $sqitch->config; isa_ok my $rework = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'rework', config => $config, }), $CLASS, 'rework command'; my $target = $rework->default_target; sub dep($) { my $dep = App::Sqitch::Plan::Depend->new( conflicts => 0, %{ App::Sqitch::Plan::Depend->parse(shift) }, plan => $rework->default_target->plan, ); $dep->project; return $dep; } can_ok $CLASS, qw( change_name requires conflicts note execute ); is_deeply [$CLASS->options], [qw( change-name|change|c=s requires|r=s@ conflicts|x=s@ all|a! note|n|m=s@ open-editor|edit|e! )], 'Options should be set up'; ############################################################################## # Test configure(). is_deeply $CLASS->configure($config, {}), {}, 'Should have default configuration with no config or opts'; is_deeply $CLASS->configure($config, { requires => [qw(foo bar)], conflicts => ['baz'], note => [qw(hi there)], }), { requires => [qw(foo bar)], conflicts => ['baz'], note => [qw(hi there)], }, 'Should have get requires, conflicts, and note options'; # open_editor handling CONFIG: { local $ENV{SQITCH_CONFIG} = File::Spec->catfile(qw(t rework.conf)); my $config = App::Sqitch::Config->new; is_deeply $CLASS->configure($config, {}), {}, 'Grabs nothing from config'; ok my $sqitch = App::Sqitch->new, 'Load default Sqitch project'; isa_ok my $rework = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'rework', config => $config, }), $CLASS, 'rework command'; ok $rework->open_editor, 'Coerces rework.open_editor from config string boolean'; } ############################################################################## # Test attributes. is_deeply $rework->requires, [], 'Requires should be an arrayref'; is_deeply $rework->conflicts, [], 'Conflicts should be an arrayref'; is_deeply $rework->note, [], 'Note should be an arrayref'; ############################################################################## # Test execute(). make_path $test_dir->stringify; END { remove_tree $test_dir->stringify if -e $test_dir->stringify }; my $plan_file = $target->plan_file; my $fh = $plan_file->open('>') or die "Cannot open $plan_file: $!"; say $fh "%project=empty\n\n"; $fh->close or die "Error closing $plan_file: $!"; my $plan = $target->plan; throws_ok { $rework->execute('foo') } 'App::Sqitch::X', 'Should get an example for nonexistent change'; is $@->ident, 'plan', 'Nonexistent change error ident should be "plan"'; is $@->message, __x( qq{Change "{change}" does not exist in {file}.\n} . 'Use "sqitch add {change}" to add it to the plan', change => 'foo', file => $plan->file, ), 'Fail message should say the step does not exist'; # Use the add command to create a step. my $deploy_file = file qw(test-rework deploy foo.sql); my $revert_file = file qw(test-rework revert foo.sql); my $verify_file = file qw(test-rework verify foo.sql); my $change_mocker = Test::MockModule->new('App::Sqitch::Plan::Change'); my %request_params; $change_mocker->mock(request_note => sub { my $self = shift; %request_params = @_; return $self->note; }); # Use the same plan. my $mock_plan = Test::MockModule->new(ref $target); $mock_plan->mock(plan => $plan); ok my $add = App::Sqitch::Command::add->new( sqitch => $sqitch, change_name => 'foo',, template_directory => Path::Class::dir(qw(etc templates)) ), 'Create another add with template_directory'; file_not_exists_ok($_) for ($deploy_file, $revert_file, $verify_file); ok $add->execute, 'Execute with the --change option'; file_exists_ok($_) for ($deploy_file, $revert_file, $verify_file); ok my $foo = $plan->get('foo'), 'Get the "foo" change'; throws_ok { $rework->execute('foo') } 'App::Sqitch::X', 'Should get an example for duplicate change'; is $@->ident, 'plan', 'Duplicate change error ident should be "plan"'; is $@->message, __x( qq{Cannot rework "{change}" without an intervening tag.\n} . 'Use "sqitch tag" to create a tag and try again', change => 'foo', ), 'Fail message should say a tag is needed'; # Tag it, and *then* it should work. ok $plan->tag( name => '@alpha' ), 'Tag it'; my $deploy_file2 = file qw(test-rework deploy foo@alpha.sql); my $revert_file2 = file qw(test-rework revert foo@alpha.sql); my $verify_file2 = file qw(test-rework verify foo@alpha.sql); MockOutput->get_info; file_not_exists_ok($_) for ($deploy_file2, $revert_file2, $verify_file2); ok $rework->execute('foo'), 'Rework "foo"'; # The files should have been copied. file_exists_ok($_) for ($deploy_file, $revert_file, $verify_file); file_exists_ok($_) for ($deploy_file2, $revert_file2, $verify_file2); file_contents_identical($deploy_file2, $deploy_file); file_contents_identical($verify_file2, $verify_file); file_contents_identical($revert_file, $deploy_file); file_contents_is($revert_file2, <<'EOF', 'New revert should revert'); -- Revert empty:foo from pg BEGIN; -- XXX Add DDLs here. COMMIT; EOF # The note should have been required. is_deeply \%request_params, { for => __ 'rework', scripts => [$deploy_file, $revert_file, $verify_file], }, 'It should have prompted for a note'; # The plan file should have been updated. ok $plan->load, 'Reload the plan file'; ok my @steps = $plan->changes, 'Get the steps'; is @steps, 2, 'Should have two steps'; is $steps[0]->name, 'foo', 'First step should be "foo"'; is $steps[1]->name, 'foo', 'Second step should also be "foo"'; is_deeply [$steps[1]->requires], [dep 'foo@alpha'], 'Reworked step should require the previous step'; is_deeply +MockOutput->get_info, [ [__x( 'Added "{change}" to {file}.', change => 'foo [foo@alpha]', file => $target->plan_file, )], [__n( 'Modify this file as appropriate:', 'Modify these files as appropriate:', 3, )], [" * $deploy_file"], [" * $revert_file"], [" * $verify_file"], ], 'And the info message should suggest editing the old files'; is_deeply +MockOutput->get_debug, [ [__x( 'Copied {src} to {dest}', dest => $deploy_file2, src => $deploy_file, )], [__x( 'Copied {src} to {dest}', dest => $revert_file2, src => $revert_file, )], [__x( 'Copied {src} to {dest}', dest => $verify_file2, src => $verify_file, )], [__x( 'Copied {src} to {dest}', dest => $revert_file, src => $deploy_file, )], ], 'Debug should show file copying'; ############################################################################## # Let's do that again. This time with more dependencies and fewer files. $deploy_file = file qw(test-rework deploy bar.sql); $revert_file = file qw(test-rework revert bar.sql); $verify_file = file qw(test-rework verify bar.sql); ok $add = App::Sqitch::Command::add->new( sqitch => $sqitch, template_directory => Path::Class::dir(qw(etc templates)), with_scripts => { revert => 0, verify => 0 }, ), 'Create another add with template_directory'; file_not_exists_ok($_) for ($deploy_file, $revert_file, $verify_file); $add->execute('bar'); file_exists_ok($deploy_file); file_not_exists_ok($_) for ($revert_file, $verify_file); ok $plan->tag( name => '@beta' ), 'Tag it with @beta'; my $deploy_file3 = file qw(test-rework deploy bar@beta.sql); my $revert_file3 = file qw(test-rework revert bar@beta.sql); my $verify_file3 = file qw(test-rework verify bar@beta.sql); MockOutput->get_info; isa_ok $rework = App::Sqitch::Command::rework->new( sqitch => $sqitch, command => 'rework', config => $config, requires => ['foo'], note => [qw(hi there)], conflicts => ['dr_evil'], ), $CLASS, 'rework command with requirements and conflicts'; # Check the files. file_not_exists_ok($_) for ($deploy_file3, $revert_file3, $verify_file3); ok $rework->execute('bar'), 'Rework "bar"'; file_exists_ok($deploy_file); file_not_exists_ok($_) for ($revert_file, $verify_file); file_exists_ok($deploy_file3); file_not_exists_ok($_) for ($revert_file3, $verify_file3); # The note should have been required. is_deeply \%request_params, { for => __ 'rework', scripts => [$deploy_file], }, 'It should have prompted for a note'; # The plan file should have been updated. ok $plan->load, 'Reload the plan file again'; ok @steps = $plan->changes, 'Get the steps'; is @steps, 4, 'Should have four steps'; is $steps[0]->name, 'foo', 'First step should be "foo"'; is $steps[1]->name, 'foo', 'Second step should also be "foo"'; is $steps[2]->name, 'bar', 'First step should be "bar"'; is $steps[3]->name, 'bar', 'Second step should also be "bar"'; is_deeply [$steps[3]->requires], [dep 'bar@beta', dep 'foo'], 'Requires should have been passed to reworked change'; is_deeply [$steps[3]->conflicts], [dep '!dr_evil'], 'Conflicts should have been passed to reworked change'; is $steps[3]->note, "hi\n\nthere", 'Note should have been passed as comment'; is_deeply +MockOutput->get_info, [ [__x( 'Added "{change}" to {file}.', change => 'bar [bar@beta foo !dr_evil]', file => $target->plan_file, )], [__n( 'Modify this file as appropriate:', 'Modify these files as appropriate:', 1, )], [" * $deploy_file"], ], 'And the info message should show only the one file to modify'; is_deeply +MockOutput->get_debug, [ [__x( 'Copied {src} to {dest}', dest => $deploy_file3, src => $deploy_file, )], [__x( 'Skipped {dest}: {src} does not exist', dest => $revert_file3, src => $revert_file, )], [__x( 'Skipped {dest}: {src} does not exist', dest => $verify_file3, src => $verify_file, )], [__x( 'Skipped {dest}: {src} does not exist', dest => $revert_file, src => $revert_file3, # No previous revert, no need for new revert. )], ], 'Should have debug oputput for missing files'; # Make sure --open-editor works MOCKSHELL: { my $sqitch_mocker = Test::MockModule->new('App::Sqitch'); my $shell_cmd; $sqitch_mocker->mock(shell => sub { $shell_cmd = $_[1] }); $sqitch_mocker->mock(quote_shell => sub { shift; join ' ' => @_ }); ok $rework = $CLASS->new( sqitch => $sqitch, template_directory => Path::Class::dir(qw(etc templates)), note => ['Testing --open-editor'], open_editor => 1, ), 'Create another add with open_editor'; ok $plan->tag( name => '@gamma' ), 'Tag it'; my $rework_file = file qw(test-rework deploy bar.sql); my $deploy_file = file qw(test-rework deploy bar@gamma.sql); my $revert_file = file qw(test-rework revert bar@gamma.sql); my $verify_file = file qw(test-rework verify bar@gamma.sql); MockOutput->get_info; file_not_exists_ok($_) for ($deploy_file, $revert_file, $verify_file); ok $rework->execute('bar'), 'Rework "bar"'; # The files should have been copied. file_exists_ok($_) for ($rework_file, $deploy_file); file_not_exists_ok($_) for ($revert_file, $verify_file); is $shell_cmd, join(' ', $sqitch->editor, $rework_file), 'It should have prompted to edit sql files'; is_deeply +MockOutput->get_info, [ [__x( 'Added "{change}" to {file}.', change => 'bar [bar@gamma]', file => $target->plan_file, )], [__n( 'Modify this file as appropriate:', 'Modify these files as appropriate:', 1, )], [" * $rework_file"], ], 'And the info message should suggest editing the old files'; MockOutput->get_debug; # empty debug. }; # Make sure a configuration with multiple plans works. $mock_plan->unmock('plan'); MULTIPLAN: { my $dstring = $test_dir->stringify; remove_tree $dstring; make_path $dstring; END { remove_tree $dstring if -e $dstring }; chdir $dstring; my $conf = file 'multirework.conf'; $conf->spew(join "\n", '[core]', 'engine = pg', '[engine "pg"]', 'top_dir = pg', '[engine "sqlite"]', 'top_dir = sqlite', '[engine "mysql"]', 'top_dir = mysql', ); # Create plan files and determine the scripts that to be created. my %scripts = map { my $dir = dir $_; $dir->mkpath; $dir->file('sqitch.plan')->spew(join "\n", '%project=rework', '', 'widgets 2012-07-16T17:25:07Z anna ', 'gadgets 2012-07-16T18:25:07Z anna ', '@foo 2012-07-16T17:24:07Z julie ', '', ); # Make the script files. my (@change, @reworked); for my $type (qw(deploy revert verify)) { my $subdir = $dir->subdir($type); $subdir->mkpath; my $script = $subdir->file('widgets.sql'); $script->spew("-- $subdir widgets"); push @change => $script; push @reworked => $subdir->file('widgets@foo.sql'); } # Return the scripts. $_ => { change => \@change, reworked => \@reworked }; } qw(pg sqlite mysql); # Load up the configuration for this project. local $ENV{SQITCH_CONFIG} = $conf; my $sqitch = App::Sqitch->new; ok my $rework = $CLASS->new( sqitch => $sqitch, note => ['Testing multiple plans'], all => 1, template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create another rework with custom multiplan config'; my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 3, 'Should have three targets'; # Make sure the target list matches our script list order (by engine). # pg always comes first, as primary engine, but the other two are random. push @targets, splice @targets, 1, 1 if $targets[1]->engine_key ne 'sqlite'; # Let's do this thing! ok $rework->execute('widgets'), 'Rework change "widgets" in all plans'; for my $target(@targets) { my $ekey = $target->engine_key; ok my $head = $target->plan->get('widgets@HEAD'), "Get widgets\@HEAD from the $ekey plan"; ok my $foo = $target->plan->get('widgets@foo'), "Get widgets\@foo from the $ekey plan"; cmp_ok $head->id, 'ne', $foo->id, "The two $ekey widgets should be different changes"; } # All the files should exist, now. while (my ($k, $v) = each %scripts) { file_exists_ok $_ for map { @{ $v->{$_} } } qw(change reworked); # Deploy and verify files should be the same. files_eq $v->{change}[0], $v->{reworked}[0]; files_eq $v->{change}[2], $v->{reworked}[2]; # New revert should be the same as old deploy. files_eq $v->{change}[1], $v->{reworked}[0]; } # Make sure we see the proper output. my $info = MockOutput->get_info; my $note = $request_params{scripts}; my $ekey = $targets[1]->engine_key; if ($info->[1][0] !~ /$ekey/) { # Got the targets in a different order. So reorder results to match. ($info->[1], $info->[2]) = ($info->[2], $info->[1]); push @{ $info } => splice @{ $info }, 7, 3; push @{ $note } => splice @{ $note }, 3, 3; } is_deeply $note, [map { @{ $scripts{$_}{change} }} qw(pg sqlite mysql)], 'Should have listed the files in the note prompt'; is_deeply $info, [ [__x( 'Added "{change}" to {file}.', change => 'widgets [widgets@foo]', file => $targets[0]->plan_file, )], [__x( 'Added "{change}" to {file}.', change => 'widgets [widgets@foo]', file => $targets[1]->plan_file, )], [__x( 'Added "{change}" to {file}.', change => 'widgets [widgets@foo]', file => $targets[2]->plan_file, )], [__n( 'Modify this file as appropriate:', 'Modify these files as appropriate:', 3, )], map { map { [" * $_" ] } @{ $scripts{$_}{change} } } qw(pg sqlite mysql) ], 'And the info message should show the two files to modify'; my $debug = +MockOutput->get_debug; if ($debug->[4][0] !~ /$ekey/) { # Got the targets in a different order. So reorder results to match. push @{ $debug } => splice @{ $debug }, 4, 4; } is_deeply $debug, [ map { my ($c, $r) = @{ $scripts{$_} }{qw(change reworked)}; ( map { [__x( 'Copied {src} to {dest}', src => $c->[$_], dest => $r->[$_], )] } (0..2) ), [__x( 'Copied {src} to {dest}', src => $c->[0], dest => $c->[1], )] } qw(pg sqlite mysql) ], 'Should have debug oputput for all copied files'; # # Make sure we get an error using --all and a target arg. throws_ok { $rework->execute('foo', 'pg' ) } 'App::Sqitch::X', 'Should get an error for --all and a target arg'; is $@->ident, 'rework', 'Mixed arguments error ident should be "rework"'; is $@->message, __( 'Cannot specify both --all and engine, target, or plan arugments' ), 'Mixed arguments error message should be correct'; # # Now try reworking a change to just one engine. Remove --all %scripts = map { my $dir = dir $_; $dir->mkpath; # Make the script files. my (@change, @reworked); for my $type (qw(deploy revert verify)) { my $subdir = $dir->subdir($type); $subdir->mkpath; my $script = $subdir->file('gadgets.sql'); $script->spew("-- $subdir gadgets"); push @change => $script; # Only SQLite is reworked. push @reworked => $subdir->file('gadgets@foo.sql') if $_ eq 'sqlite'; } # Return the scripts. $_ => { change => \@change, reworked => \@reworked }; } qw(pg sqlite mysql); ok $rework = $CLASS->new( sqitch => $sqitch, note => ['Testing multiple plans'], template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create yet another rework with custom multiplan config'; ok $rework->execute('gadgets', 'sqlite'), 'Rework change "gadgets" in the sqlite plan'; my %targets = map { $_->engine_key => $_ } App::Sqitch::Target->all_targets(sqitch => $sqitch); is keys %targets, 3, 'Should still have three targets'; my $name = 'gadgets@foo'; for my $ekey(qw(pg mysql)) { my $target = $targets{$ekey}; ok my $head = $target->plan->get('gadgets@HEAD'), "Get gadgets\@HEAD from the $ekey plan"; ok my $foo = $target->plan->get('gadgets@foo'), "Get gadgets\@foo from the $ekey plan"; cmp_ok $head->id, 'eq', $foo->id, "The two $ekey gadgets should be the same change"; } do { my $ekey = 'sqlite'; my $target = $targets{$ekey}; ok my $head = $target->plan->get('gadgets@HEAD'), "Get gadgets\@HEAD from the $ekey plan"; ok my $foo = $target->plan->get('gadgets@foo'), "Get gadgets\@foo from the $ekey plan"; cmp_ok $head->id, 'ne', $foo->id, "The two $ekey gadgets should be different changes"; }; # All the files should exist, now. while (my ($k, $v) = each %scripts) { file_exists_ok $_ for map { @{ $v->{$_} } } qw(change reworked); next if $k ne 'sqlite'; # Deploy and verify files should be the same. files_eq $v->{change}[0], $v->{reworked}[0]; files_eq $v->{change}[2], $v->{reworked}[2]; # New revert should be the same as old deploy. files_eq $v->{change}[1], $v->{reworked}[0]; } is_deeply \%request_params, { for => __ 'rework', scripts => $scripts{sqlite}{change}, }, 'Should have listed SQLite scripts in the note prompt'; # Clear the output. MockOutput->get_info; MockOutput->get_debug; chdir File::Spec->updir; } # Make sure we update only one plan but write out multiple target files. MULTITARGET: { my $dstring = $test_dir->stringify; remove_tree $dstring; make_path $dstring; END { remove_tree $dstring if -e $dstring }; chdir $dstring; my $conf = file 'multiadd.conf'; $conf->spew(join "\n", '[core]', 'engine = pg', 'plan_file = sqitch.plan', '[engine "pg"]', 'top_dir = pg', '[engine "sqlite"]', 'top_dir = sqlite', '[add]', 'all = true', ); file('sqitch.plan')->spew(join "\n", '%project=rework', '', 'widgets 2012-07-16T17:25:07Z anna ', 'gadgets 2012-07-16T18:25:07Z anna ', '@foo 2012-07-16T17:24:07Z julie ', '', ); # Create the scripts. my %scripts = map { my $dir = dir $_; my (@change, @reworked); for my $type (qw(deploy revert verify)) { my $subdir = $dir->subdir($type); $subdir->mkpath; my $script = $subdir->file('widgets.sql'); $script->spew("-- $subdir widgets"); push @change => $script; push @reworked => $subdir->file('widgets@foo.sql'); } # Return the scripts. $_ => { change => \@change, reworked => \@reworked }; } qw(pg sqlite); # Load up the configuration for this project. local $ENV{SQITCH_CONFIG} = $conf; my $sqitch = App::Sqitch->new; ok my $rework = $CLASS->new( sqitch => $sqitch, note => ['Testing multiple plans'], all => 1, template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create another rework with custom multiplan config'; my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 2, 'Should have two targets'; is $targets[0]->plan_file, $targets[1]->plan_file, 'Targets should use the same plan file'; my $target = $targets[0]; # Let's do this thing! ok $rework->execute('widgets'), 'Rework change "widgets" in all plans'; ok my $head = $target->plan->get('widgets@HEAD'), "Get widgets\@HEAD from the plan"; ok my $foo = $target->plan->get('widgets@foo'), "Get widgets\@foo from the plan"; cmp_ok $head->id, 'ne', $foo->id, "The two widgets should be different changes"; # All the files should exist, now. while (my ($k, $v) = each %scripts) { file_exists_ok $_ for map { @{ $v->{$_} } } qw(change reworked); # Deploy and verify files should be the same. files_eq $v->{change}[0], $v->{reworked}[0]; files_eq $v->{change}[2], $v->{reworked}[2]; # New revert should be the same as old deploy. files_eq $v->{change}[1], $v->{reworked}[0]; } is_deeply \%request_params, { for => __ 'rework', scripts => [ map {@{ $scripts{$_}{change} }} qw(pg sqlite)], }, 'Should have listed all the files to edit in the note prompt'; # And the output should be correct. is_deeply +MockOutput->get_info, [ [__x( 'Added "{change}" to {file}.', change => 'widgets [widgets@foo]', file => $target->plan_file, )], [__n( 'Modify this file as appropriate:', 'Modify these files as appropriate:', 3, )], map { map { [" * $_" ] } @{ $scripts{$_}{change} } } qw(pg sqlite) ], 'And the info message should show the two files to modify'; # As should the debug output is_deeply +MockOutput->get_debug, [ map { my ($c, $r) = @{ $scripts{$_} }{qw(change reworked)}; ( map { [__x( 'Copied {src} to {dest}', src => $c->[$_], dest => $r->[$_], )] } (0..2) ), [__x( 'Copied {src} to {dest}', src => $c->[0], dest => $c->[1], )] } qw(pg sqlite) ], 'Should have debug oputput for all copied files'; chdir File::Spec->updir; } # Try two plans with different tags. MULTITAG: { my $dstring = $test_dir->stringify; remove_tree $dstring; make_path $dstring; END { remove_tree $dstring if -e $dstring }; chdir $test_dir->stringify; my $conf = file 'multirework.conf'; $conf->spew(join "\n", '[core]', 'engine = pg', '[engine "pg"]', 'top_dir = pg', '[engine "sqlite"]', 'top_dir = sqlite', ); # Create plan files and determine the scripts that to be created. my %scripts = map { my $dir = dir $_; $dir->mkpath; my $tag = $_ eq 'pg' ? 'foo' : 'bar'; $dir->file('sqitch.plan')->spew(join "\n", '%project=rework', '', 'widgets 2012-07-16T17:25:07Z anna ', "\@$tag 2012-07-16T17:24:07Z julie ", '', ); # Make the script files. my (@change, @reworked); for my $type (qw(deploy revert verify)) { my $subdir = $dir->subdir($type); $subdir->mkpath; my $script = $subdir->file('widgets.sql'); $script->spew("-- $subdir widgets"); push @change => $script; push @reworked => $subdir->file("widgets\@$tag.sql"); } # Return the scripts. $_ => { change => \@change, reworked => \@reworked }; } qw(pg sqlite); # Load up the configuration for this project. local $ENV{SQITCH_CONFIG} = $conf; my $sqitch = App::Sqitch->new; ok my $rework = $CLASS->new( sqitch => $sqitch, note => ['Testing multiple plans'], all => 1, template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create another rework with custom multiplan config'; my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 2, 'Should have two targets'; # Let's do this thing! ok $rework->execute('widgets'), 'Rework change "widgets" in all plans'; for my $target(@targets) { my $ekey = $target->engine_key; my $tag = $ekey eq 'pg' ? 'foo' : 'bar'; ok my $head = $target->plan->get('widgets@HEAD'), "Get widgets\@HEAD from the $ekey plan"; ok my $prev = $target->plan->get("widgets\@$tag"), "Get widgets\@$tag from the $ekey plan"; cmp_ok $head->id, 'ne', $prev->id, "The two $ekey widgets should be different changes"; } is_deeply \%request_params, { for => __ 'rework', scripts => [ map {@{ $scripts{$_}{change} }} qw(pg sqlite)], }, 'Should have listed all the files to edit in the note prompt'; # And the output should be correct. is_deeply +MockOutput->get_info, [ [__x( 'Added "{change}" to {file}.', change => 'widgets [widgets@foo]', file => $targets[0]->plan_file, )], [__x( 'Added "{change}" to {file}.', change => 'widgets [widgets@bar]', file => $targets[1]->plan_file, )], [__n( 'Modify this file as appropriate:', 'Modify these files as appropriate:', 2, )], map { map { [" * $_" ] } @{ $scripts{$_}{change} } } qw(pg sqlite) ], 'And the info message should show the two files to modify'; # As should the debug output is_deeply +MockOutput->get_debug, [ map { my ($c, $r) = @{ $scripts{$_} }{qw(change reworked)}; ( map { [__x( 'Copied {src} to {dest}', src => $c->[$_], dest => $r->[$_], )] } (0..2) ), [__x( 'Copied {src} to {dest}', src => $c->[0], dest => $c->[1], )] } qw(pg sqlite) ], 'Should have debug oputput for all copied files'; chdir File::Spec->updir; } # Make sure we're okay with multiple plans sharing the same top dir. ONETOP: { remove_tree $test_dir->stringify; make_path $test_dir->stringify; END { remove_tree $test_dir->stringify }; chdir $test_dir->stringify; my $conf = file 'multirework.conf'; $conf->spew(join "\n", '[core]', 'engine = pg', '[engine "pg"]', 'plan_file = pg.plan', '[engine "sqlite"]', 'plan_file = sqlite.plan', ); # Write the two plan files. file("$_.plan")->spew(join "\n", '%project=rework', '', 'widgets 2012-07-16T17:25:07Z anna ', '@foo 2012-07-16T17:24:07Z julie ', '', ) for qw(pg sqlite); # One set of scripts for both. my (@change, @reworked); for my $type (qw(deploy revert verify)) { my $dir = dir $type; $dir->mkpath; my $script = $dir->file('widgets.sql'); $script->spew("-- $dir widgets"); push @change => $script; push @reworked => $dir->file('widgets@foo.sql'); } # Load up the configuration for this project. local $ENV{SQITCH_CONFIG} = $conf; my $sqitch = App::Sqitch->new; ok my $rework = $CLASS->new( sqitch => $sqitch, note => ['Testing multiple plans'], all => 1, template_directory => dir->parent->subdir(qw(etc templates)) ), 'Create another rework with custom multiplan config'; my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 2, 'Should have two targets'; ok $rework->execute('widgets'), 'Rework change "widgets" in all plans'; for my $target(@targets) { my $ekey = $target->engine_key; ok my $head = $target->plan->get('widgets@HEAD'), "Get widgets\@HEAD from the $ekey plan"; ok my $foo = $target->plan->get('widgets@foo'), "Get widgets\@foo from the $ekey plan"; cmp_ok $head->id, 'ne', $foo->id, "The two $ekey widgets should be different changes"; } # Make sure the files were written properly. file_exists_ok $_ for (@change, @reworked); # Deploy and verify files should be the same. files_eq $change[0], $reworked[0]; files_eq $change[2], $reworked[2]; # New revert should be the same as old deploy. files_eq $change[1], $reworked[0]; is_deeply \%request_params, { for => __ 'rework', scripts => \@change, }, 'Should have listed the files to edit in the note prompt'; # And the output should be correct. is_deeply +MockOutput->get_info, [ [__x( 'Added "{change}" to {file}.', change => 'widgets [widgets@foo]', file => $targets[0]->plan_file, )], [__x( 'Added "{change}" to {file}.', change => 'widgets [widgets@foo]', file => $targets[1]->plan_file, )], [__n( 'Modify this file as appropriate:', 'Modify these files as appropriate:', 2, )], map { [" * $_" ] } @change, ], 'And the info message should show the two files to modify'; # As should the debug output is_deeply +MockOutput->get_debug, [ ( map { [__x( 'Copied {src} to {dest}', src => $change[$_], dest => $reworked[$_], )] } (0..2) ), [__x( 'Copied {src} to {dest}', src => $change[0], dest => $change[1], )], ], 'Should have debug oputput for all copied files'; chdir File::Spec->updir; } App-Sqitch-0.9996/t/show.t000644 000767 000024 00000016177 13133201371 015455 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use Path::Class; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use Test::MockModule; use lib 't/lib'; use MockOutput; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::Command::show'; require_ok $CLASS or die; isa_ok $CLASS, 'App::Sqitch::Command'; can_ok $CLASS, qw(execute exists_only target); is_deeply [$CLASS->options], [qw( target|t=s exists|e! )], 'Options should be correct'; my $sqitch = App::Sqitch->new( options => { plan_file => file(qw(t engine sqitch.plan))->stringify, top_dir => dir(qw(t engine))->stringify, reworked_dir => dir(qw(t engine reworked))->stringify, engine => 'pg', }, ); isa_ok my $show = $CLASS->new(sqitch => $sqitch), $CLASS; ok !$show->exists_only, 'exists_only should be false by default'; ok my $eshow = $CLASS->new(sqitch => $sqitch, exists_only => 1), 'Construct with exists_only'; ok $eshow->exists_only, 'exists_only should be set'; ############################################################################## # Test configure(). my $config = $sqitch->config; is_deeply $CLASS->configure($config, {}), {}, 'Should get empty hash for no config or options'; is_deeply $CLASS->configure($config, {exists => 1}), { exists_only => 1 }, 'Should get exists_only => 1 for exist in options'; ############################################################################## # Start with the change. ok my $change = $show->default_target->plan->get('widgets'), 'Get a change'; ok $show->execute( change => $change->id ), 'Find change by id'; is_deeply +MockOutput->get_emit, [[ $change->info ]], 'The change info should have been emitted'; # Try by name. ok $show->execute( change => $change->name ), 'Find change by name'; is_deeply +MockOutput->get_emit, [[ $change->info ]], 'The change info should have been emitted again'; # What happens for something unknown? throws_ok { $show->execute( change => 'nonexistent' ) } 'App::Sqitch::X', 'Should get an error for an unknown change'; is $@->ident, 'show', 'Unknown change error ident should be "show"'; is $@->message, __x('Unknown change "{change}"', change => 'nonexistent'), 'Should get proper error for unknown change'; # What about with exists_only? ok !$eshow->execute( change => 'nonexistent' ), 'Should return false for uknown change and exists_only'; is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted'; # Let's find a change by tag. my $tag = ($show->default_target->plan->tags)[0]; $change = $tag->change; ok $show->execute( change => $tag->id ), 'Find change by tag id'; is_deeply +MockOutput->get_emit, [[ $change->info ]], 'The change info should have been emitted'; # And the tag name. ok $show->execute( change => $tag->format_name ), 'Find change by tag'; is_deeply +MockOutput->get_emit, [[ $change->info ]], 'The change info should have been emitted'; # Make sure it works with exists_only. ok $eshow->execute( change => $change->id ), 'Run exists with ID'; is_deeply +MockOutput->get_emit, [], 'There should be no output'; # Great, let's look a the tag itself. ok $show->execute( tag => $tag->id ), 'Find tag by id'; is_deeply +MockOutput->get_emit, [[ $tag->info ]], 'The tag info should have been emitted'; # Should work with exists_only, too. ok $eshow->execute( tag => $tag->id ), 'Find tag by id with exists_only'; is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted'; ok $show->execute( tag => $tag->name ), 'Find tag by name'; is_deeply +MockOutput->get_emit, [[ $tag->info ]], 'The tag info should have been emitted'; ok $show->execute( tag => $tag->format_name ), 'Find tag by formatted name'; is_deeply +MockOutput->get_emit, [[ $tag->info ]], 'The tag info should have been emitted'; # Try an invalid tag. throws_ok { $show->execute( tag => 'nope') } 'App::Sqitch::X', 'Should get error for non-existent tag'; is $@->ident, 'show', 'Unknown tag error ident should be "show"'; is $@->message, __x('Unknown tag "{tag}"', tag => 'nope' ), 'Should get proper error for unknown tag'; # Try invalid tag with exists_only. ok !$eshow->execute( tag => 'nope'), 'Should return false for non-existent tag and exists_only'; is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted'; # Also an invalid sha1. throws_ok { $show->execute( tag => '7ecba288708307ef714362c121691de02ffb364d') } 'App::Sqitch::X', 'Should get error for non-existent tag ID'; is $@->ident, 'show', 'Unknown tag ID error ident should be "show"'; is $@->message, __x('Unknown tag "{tag}"', tag => '7ecba288708307ef714362c121691de02ffb364d' ), 'Should get proper error for unknown tag ID'; # Now let's look at files. ok $show->execute(deploy => $change->id), 'Show a deploy file'; is_deeply +MockOutput->get_emit, [[ $change->deploy_file->slurp(iomode => '<:raw') ]], 'The deploy file should have been emitted'; # With exists_only. ok $eshow->execute(deploy => $change->id), 'Show a deploy file with exists_only'; is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted'; ok $show->execute(revert => $change->id), 'Show a revert file'; is_deeply +MockOutput->get_emit, [[ $change->revert_file->slurp(iomode => '<:raw') ]], 'The revert file should have been emitted'; # Nonexistent verify file. throws_ok { $show->execute( verify => $change->id ) } 'App::Sqitch::X', 'Should get error for nonexistent varify file'; is $@->ident, 'show', 'Nonexistent file error ident should be "show"'; is $@->message, __x('File "{path}" does not exist', path => $change->verify_file ), 'Should get proper error for nonexistent file'; # Nonexistent with exists_only. ok !$eshow->execute( verify => $change->id ), 'Should return false for nonexistent file'; is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted'; # Now an unknown type. throws_ok { $show->execute(foo => 'bar') } 'App::Sqitch::X', 'Should get error for uknown type'; is $@->ident, 'show', 'Unknown type error ident should be "show"'; is $@->message, __x( 'Unknown object type "{type}', type => 'foo', ), 'Should get proper error for unknown type'; # Try specifying a non-default target. $sqitch = App::Sqitch->new; $sqitch->config->load_file(file 't', 'local.conf'); my $file = file qw(t plans dependencies.plan); my $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file); ok $change = $target->plan->get('add_user'), 'Get a change'; # Set it up. isa_ok $show = $CLASS->new(sqitch => $sqitch, target => 'mydb'), $CLASS; is $show->target, 'mydb', 'Target should be set'; ok $show->execute( change => $change->id ), 'Find change by id'; is_deeply +MockOutput->get_emit, [[ $change->info ]], 'The change info should have been emitted'; # Now try invalid args. my $mock = Test::MockModule->new($CLASS); my @usage; $mock->mock(usage => sub { shift; @usage = @_; die 'USAGE' }); throws_ok { $show->execute } qr/USAGE/, 'Should get usage for missing params'; is_deeply \@usage, [], 'Nothing should have been passed to usage'; done_testing; App-Sqitch-0.9996/t/sqitch000755 000767 000024 00000000503 13133201371 015513 0ustar00davidstaff000000 000000 #!/usr/bin/env perl -CAS use POSIX qw(setlocale); BEGIN { if ($^O eq 'MSWin32') { require Win32::Locale; setlocale POSIX::LC_ALL, Win32::Locale::get_locale(); } else { setlocale POSIX::LC_ALL, ''; } } use FindBin; use lib "$FindBin::Bin/../lib"; use App::Sqitch; exit App::Sqitch->go; App-Sqitch-0.9996/t/sqitch.conf000644 000767 000024 00000000543 13133201371 016440 0ustar00davidstaff000000 000000 [core] uri = https://github.com/theory/sqitch/ engine = pg top_dir = migrations extension = ddl pager = less -r [engine "pg"] client = /usr/local/pgsql/bin/psql [revert] to = gamma count = 2 revision = 1.1 [bundle] from = gamma tags_only = true dest_dir = _build/sql App-Sqitch-0.9996/t/sql/000755 000767 000024 00000000000 13133201371 015073 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/sqlite.t000644 000767 000024 00000034660 13133201371 015773 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use App::Sqitch::Target; use Test::MockModule; use Path::Class; use Try::Tiny; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use File::Temp 'tempdir'; use lib 't/lib'; use DBIEngineTest; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Engine::sqlite'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.sys'; } is_deeply [$CLASS->config_vars], [ target => 'any', registry => 'any', client => 'any', ], 'config_vars should return three vars'; my $sqitch = App::Sqitch->new; my $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI->new('db:sqlite:foo.db'), ); isa_ok my $sqlite = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS; is $sqlite->client, 'sqlite3' . ($^O eq 'MSWin32' ? '.exe' : ''), 'client should default to sqlite3'; is $sqlite->uri->dbname, file('foo.db'), 'dbname should be filled in'; is $sqlite->target, $target, 'Target attribute should be specified target'; is $sqlite->destination, $sqlite->uri->as_string, 'Destination should be uri stringified'; is $sqlite->registry_destination, $sqlite->registry_uri->as_string, 'Meta target should be registry_uri stringified'; # Pretend for now that we always have a valid SQLite. my $mock_sqitch = Test::MockModule->new(ref $sqitch); my $sqlite_version = '3.7.12 2012-04-03 19:43:07 86b8481be7e76cccc92d14ce762d21bfb69504af'; $mock_sqitch->mock(probe => sub { $sqlite_version }); my @std_opts = ( '-noheader', '-bail', '-batch', '-csv', ); is_deeply [$sqlite->sqlite3], [$sqlite->client, @std_opts, $sqlite->uri->dbname], 'sqlite3 command should have the proper opts'; ############################################################################## # Make sure we get an error for no database name. my $tmp_dir = Path::Class::dir( tempdir CLEANUP => 1 ); my $have_sqlite = try { $sqlite->use_driver }; $sqitch = App::Sqitch->new( _engine => 'sqlite', options => {engine => 'sqlite'} ); if ($have_sqlite) { # We have DBD::SQLite. # Find out if it's built with SQLite >= 3.7.11. my $dbh = DBI->connect('DBI:SQLite:'); my @v = split /[.]/ => $dbh->{sqlite_version}; $have_sqlite = $v[0] > 3 || ($v[0] == 3 && ($v[1] > 7 || ($v[1] == 7 && $v[2] >= 11))); unless ($have_sqlite) { # We have DBD::SQLite, but it is too old. Make sure we complain about that. isa_ok $sqlite = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; throws_ok { $sqlite->dbh } 'App::Sqitch::X', 'Should get an error for old SQLite'; is $@->ident, 'sqlite', 'Unsupported SQLite error ident should be "sqlite"'; is $@->message, __x( 'Sqitch requires SQLite 3.7.11 or later; DBD::SQLite was built with {version}', version => $dbh->{sqlite_version} ), 'Unsupported SQLite error message should be correct'; } } else { # No DBD::SQLite at all. throws_ok { $sqlite->dbh } 'App::Sqitch::X', 'Should get an error without DBD::SQLite'; is $@->ident, 'sqlite', 'No DBD::SQLite error ident should be "sqlite"'; is $@->message, __x( '{driver} required to manage {engine}', driver => $sqlite->driver, engine => $sqlite->name, ), 'No DBD::SQLite error message should be correct'; } ############################################################################## # Make sure config settings override defaults. my %config = ( 'engine.sqlite.client' => '/path/to/sqlite3', 'engine.sqlite.target' => 'test', 'engine.sqlite.registry' => 'meta', 'target.test.uri' => 'db:sqlite:/path/to/sqlite.db', ); my $mock_config = Test::MockModule->new('App::Sqitch::Config'); $mock_config->mock(get => sub { $config{ $_[2] } }); $target = ref($target)->new( sqitch => $sqitch ); ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another sqlite'; is $sqlite->client, '/path/to/sqlite3', 'client should fall back on config'; is $sqlite->uri->as_string, 'db:sqlite:/path/to/sqlite.db', 'dbname should fall back on config'; is $sqlite->target, $target, 'Target should be as specified'; is $sqlite->destination, 'test', 'Destination should be configured target name'; is $sqlite->registry_uri->as_string, 'db:sqlite:/path/to/meta.db', 'registry_uri should fall back on config'; is $sqlite->registry_destination, $sqlite->registry_uri->as_string, 'Meta target should be configured registry_uri stringified'; # Try a registry with an extension and a dbname without. %config = ( 'engine.sqlite.registry' => 'meta.db', 'engine.sqlite.target' => 'test', 'target.test.uri' => 'db:sqlite:/path/to/sqitch', ); $target = ref($target)->new( sqitch => $sqitch ); ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another sqlite'; is $sqlite->uri->as_string, 'db:sqlite:/path/to/sqitch', 'dbname should fall back on config with no extension'; is $sqlite->target, $target, 'Target should be as specified'; is $sqlite->destination, 'test', 'Destination should be configured target name'; is $sqlite->registry_uri->as_string, 'db:sqlite:/path/to/meta.db', 'registry_uri should fall back on config wth extension'; is $sqlite->registry_destination, $sqlite->registry_uri->as_string, 'Meta target should be configured registry_uri stringified'; # Also try a registry with no extension and a dbname with. %config = ( 'engine.sqlite.registry' => 'registry', 'engine.sqlite.target' => 'noext', 'target.noext.uri' => 'db:sqlite:/path/to/sqitch.db', ); $target = ref($target)->new( sqitch => $sqitch ); ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another sqlite'; is $sqlite->uri->as_string, 'db:sqlite:/path/to/sqitch.db', 'dbname should fall back on config with no extension'; is $sqlite->target, $target, 'Target should be as specified'; is $sqlite->destination, 'noext', 'Destination should be configured target name'; is $sqlite->registry_uri->as_string, 'db:sqlite:/path/to/registry.db', 'registry_uri should fall back on config wth extension'; is $sqlite->registry_destination, $sqlite->registry_uri->as_string, 'Meta target should be configured registry_uri stringified'; # Try a registry with an absolute path. %config = ( 'engine.sqlite.registry' => '/some/other/path.db', 'engine.sqlite.target' => 'abs', 'target.abs.uri' => 'db:sqlite:/path/to/sqitch.db', ); $target = ref($target)->new( sqitch => $sqitch ); ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another sqlite'; is $sqlite->uri->as_string, 'db:sqlite:/path/to/sqitch.db', 'dbname should fall back on config with no extension'; is $sqlite->target, $target, 'Target should be as specified'; is $sqlite->destination, 'abs', 'Destination should be configured target name'; is $sqlite->registry_uri->as_string, 'db:sqlite:/some/other/path.db', 'registry_uri should fall back on config wth extension'; is $sqlite->registry_destination, $sqlite->registry_uri->as_string, 'Meta target should be configured registry_uri stringified'; ############################################################################## # Now make sure that Sqitch options override configurations. $sqitch = App::Sqitch->new( options => { engine => 'sqlite', client => 'foo/bar', registry => 'reg', }); $target = ref($target)->new( sqitch => $sqitch ); ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target), 'Create sqlite with sqitch with --client and --target'; is $sqlite->client, 'foo/bar', 'The client should be grabbed from --client'; is $sqlite->registry, 'reg', 'The registry should be grabbed from --registry'; is_deeply [$sqlite->sqlite3], [$sqlite->client, @std_opts, $sqlite->uri->dbname], 'sqlite3 command should have option values'; $mock_config->unmock_all; ############################################################################## # Test _read(). my $db_name = $tmp_dir->file('sqitch.db'); $sqitch = App::Sqitch->new(_engine => 'sqlite'); $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => URI->new("db:sqlite:$db_name") ); ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target ), 'Instantiate with a temporary database file'; can_ok $sqlite, qw(_read); my $quote = $^O eq 'MSWin32' ? sub { $sqitch->quote_shell(shift) } : sub { shift }; SKIP: { skip 'DBD::SQLite not available', 3 unless $have_sqlite; is $sqlite->_read('foo'), $quote->(q{.read 'foo'}), '_read() should work'; is $sqlite->_read('foo bar'), $quote->(q{.read 'foo bar'}), '_read() should SQL-quote the file name'; is $sqlite->_read('foo \'bar\''), $quote->(q{.read 'foo ''bar'''}), '_read() should SQL-quote quotes, too'; } ############################################################################## # Test _run(), _capture(), and _spool(). can_ok $sqlite, qw(_run _capture _spool); my (@run, @capture, @spool); $mock_sqitch->mock(run => sub { shift; @run = @_ }); $mock_sqitch->mock(capture => sub { shift; @capture = @_ }); $mock_sqitch->mock(spool => sub { shift; @spool = @_ }); ok $sqlite->_run(qw(foo bar baz)), 'Call _run'; is_deeply \@run, [$sqlite->sqlite3, qw(foo bar baz)], 'Command should be passed to run()'; ok $sqlite->_spool('FH'), 'Call _spool'; is_deeply \@spool, ['FH', $sqlite->sqlite3], 'Command should be passed to spool()'; ok $sqlite->_capture(qw(foo bar baz)), 'Call _capture'; is_deeply \@capture, [$sqlite->sqlite3, qw(foo bar baz)], 'Command should be passed to capture()'; # Test file and handle running. SKIP: { skip 'DBD::SQLite not available', 2 unless $have_sqlite; ok $sqlite->run_file('foo/bar.sql'), 'Run foo/bar.sql'; is_deeply \@run, [$sqlite->sqlite3, $quote->(".read 'foo/bar.sql'")], 'File should be passed to run()'; } ok $sqlite->run_handle('FH'), 'Spool a "file handle"'; is_deeply \@spool, ['FH', $sqlite->sqlite3], 'Handle should be passed to spool()'; SKIP: { skip 'DBD::SQLite not available', 2 unless $have_sqlite; # Verify should go to capture unless verosity is > 1. ok $sqlite->run_verify('foo/bar.sql'), 'Verify foo/bar.sql'; is_deeply \@capture, [$sqlite->sqlite3, $quote->(".read 'foo/bar.sql'")], 'Verify file should be passed to capture()'; $mock_sqitch->mock(verbosity => 2); ok $sqlite->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again'; is_deeply \@run, [$sqlite->sqlite3, $quote->(".read 'foo/bar.sql'")], 'Verifile file should be passed to run() for high verbosity'; } ############################################################################## # Test DateTime formatting stuff. can_ok $CLASS, '_ts2char_format'; is sprintf($CLASS->_ts2char_format, 'foo'), q{strftime('year:%Y:month:%m:day:%d:hour:%H:minute:%M:second:%S:time_zone:UTC', foo)}, '_ts2char should work'; ok my $dtfunc = $CLASS->can('_dt'), "$CLASS->can('_dt')"; isa_ok my $dt = $dtfunc->( 'year:2012:month:07:day:05:hour:15:minute:07:second:01:time_zone:UTC' ), 'App::Sqitch::DateTime', 'Return value of _dt()'; is $dt->year, 2012, 'DateTime year should be set'; is $dt->month, 7, 'DateTime month should be set'; is $dt->day, 5, 'DateTime day should be set'; is $dt->hour, 15, 'DateTime hour should be set'; is $dt->minute, 7, 'DateTime minute should be set'; is $dt->second, 1, 'DateTime second should be set'; is $dt->time_zone->name, 'UTC', 'DateTime TZ should be set'; ############################################################################## # Test checking the SQLite version. for my $v (qw( 3.3.9 3.3.10 3.3.200 3.4.0 3.4.8 3.7.11 3.8.12 3.10.0 4.1.30 )) { $sqlite_version = "$v 2012-04-03 19:43:07 86b8481be7e76cccc92d14ce762d21bfb69504af"; ok my $sqlite = $CLASS->new( sqitch => $sqitch, target => $target, ), "Create command for v$v"; ok $sqlite->sqlite3, "Should be okay with sqlite v$v"; } for my $v (qw( 3.3.8 3.3.0 3.2.8 3.0.1 3.0.0 2.8.1 2.20.0 1.0.0 )) { $sqlite_version = "$v 2012-04-03 19:43:07 86b8481be7e76cccc92d14ce762d21bfb69504af"; ok my $sqlite = $CLASS->new( sqitch => $sqitch, target => $target, ), "Create command for v$v"; throws_ok { $sqlite->sqlite3 } 'App::Sqitch::X', "Should not be okay with v$v"; is $@->ident, 'sqlite', qq{Should get ident "sqlite" for v$v}; is $@->message, __x( 'Sqitch requires SQLite 3.3.9 or later; {client} is {version}', client => $sqlite->client, version => $v ), "Should get proper error message for v$v"; } $mock_sqitch->unmock_all; ############################################################################## my $alt_db = $db_name->dir->file('sqitchtest.db'); # Can we do live tests? END { my %drivers = DBI->installed_drivers; for my $driver (values %drivers) { $driver->visit_child_handles(sub { my $h = shift; $h->disconnect if $h->{Type} eq 'db' && $h->{Active}; }); } } DBIEngineTest->run( class => $CLASS, sqitch_params => [options => { top_dir => Path::Class::dir(qw(t engine))->stringify, plan_file => Path::Class::file(qw(t engine sqitch.plan))->stringify, engine => 'sqlite', }], target_params => [ uri => URI->new("db:sqlite:$db_name") ], alt_target_params => [ registry => 'sqitchtest', uri => URI->new("db:sqlite:$db_name"), ], skip_unless => sub { my $self = shift; # Should have the database handle and client. $self->dbh && $self->sqlite3; # Make sure we have a supported version. my $version = $self->dbh->{sqlite_version}; my @v = split /[.]/ => $version; die "SQLite >= 3.7.11 required; DBD::SQLite built with $version\n" unless $v[0] > 3 || ($v[0] == 3 && ($v[1] > 7 || ($v[1] == 7 && $v[2] >= 11))); }, engine_err_regex => qr/^near "blah": syntax error/, init_error => __x( 'Sqitch database {database} already initialized', database => $alt_db, ), test_dbh => sub { my $dbh = shift; # Make sure foreign key constraints are enforced. ok $dbh->selectcol_arrayref('PRAGMA foreign_keys')->[0], 'The foreign_keys pragma should be enabled'; }, add_second_format => q{strftime('%%Y-%%m-%%d %%H:%%M:%%f', strftime('%%J', %s) + (1/86400.0))}, ); done_testing; App-Sqitch-0.9996/t/status.t000644 000767 000024 00000052407 13133201371 016014 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 120; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::NoWarnings; use Test::Exception; use Test::MockModule; use Path::Class; use lib 't/lib'; use MockOutput; my $CLASS = 'App::Sqitch::Command::status'; require_ok $CLASS; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; ok my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => Path::Class::Dir->new('test-status'), }, ), 'Load a sqitch object'; my $config = $sqitch->config; isa_ok my $status = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'status', config => $config, }), $CLASS, 'status command'; can_ok $status, qw( project show_changes show_tags date_format options execute configure emit_state emit_changes emit_tags emit_status ); is_deeply [ $CLASS->options ], [qw( project=s target|t=s show-tags show-changes date-format|date=s )], 'Options should be correct'; my $engine_mocker = Test::MockModule->new('App::Sqitch::Engine::sqlite'); my @projs; $engine_mocker->mock( registered_projects => sub { @projs }); my $initialized; $engine_mocker->mock( initialized => sub { diag "Gonna return $initialized" if $ENV{RELEASE_TESTING}; $initialized; } ); my $mock_target = Test::MockModule->new('App::Sqitch::Target'); my ($target, $orig_new); $mock_target->mock(new => sub { $target = shift->$orig_new(@_); }); $orig_new = $mock_target->original('new'); # Start with uninitialized database. $initialized = 0; ############################################################################## # Test project. $status->target($status->default_target); throws_ok { $status->project } 'App::Sqitch::X', 'Should have error for uninitialized database'; is $@->ident, 'status', 'Uninitialized database error ident should be "status"'; is $@->message, __( 'Database not initialized for Sqitch' ), 'Uninitialized database error message should be correct'; # Specify a project. isa_ok $status = $CLASS->new( sqitch => $sqitch, project => 'foo', ), $CLASS, 'new status command'; is $status->project, 'foo', 'Should have project "foo"'; # Look up the project in the database. ok $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => Path::Class::Dir->new('test-status')->stringify, }, ), 'Load a sqitch object with SQLite'; ok $status = $CLASS->new(sqitch => $sqitch), 'Create another status command'; $status->target($status->default_target); throws_ok { $status->project } 'App::Sqitch::X', 'Should get an error for uninitialized db'; is $@->ident, 'status', 'Uninitialized db error ident should be "status"'; is $@->message, __ 'Database not initialized for Sqitch', 'Uninitialized db error message should be correct'; # Try no registered projects. $initialized = 1; throws_ok { $status->project } 'App::Sqitch::X', 'Should get an error for no registered projects'; is $@->ident, 'status', 'No projects error ident should be "status"'; is $@->message, __ 'No projects registered', 'No projects error message should be correct'; # Try too many registered projects. @projs = qw(foo bar); throws_ok { $status->project } 'App::Sqitch::X', 'Should get an error for too many projects'; is $@->ident, 'status', 'Too many projects error ident should be "status"'; is $@->message, __x( 'Use --project to select which project to query: {projects}', projects => join __ ', ', @projs, ), 'Too many projects error message should be correct'; # Go for one project. @projs = ('status'); is $status->project, 'status', 'Should find single project'; $engine_mocker->unmock_all; # Fall back on plan project name. ok $sqitch = App::Sqitch->new( options => { top_dir => Path::Class::Dir->new(qw(t sql))->stringify }, ), 'Load another sqitch object'; isa_ok $status = $CLASS->new( sqitch => $sqitch ), $CLASS, 'another status command'; $status->target($status->default_target); is $status->project, $target->plan->project, 'Should have plan project'; ############################################################################## # Test database. is $status->target_name, undef, 'Default target should be undef'; isa_ok $status = $CLASS->new( sqitch => $sqitch, target_name => 'foo', ), $CLASS, 'new status with target'; is $status->target_name, 'foo', 'Should have target "foo"'; ############################################################################## # Test configure(). my $cmock = Test::MockModule->new('App::Sqitch::Config'); is_deeply $CLASS->configure($config, {}), {}, 'Should get empty hash for no config or options'; my @vals = ('nonesuch'); $cmock->mock( get => sub { shift @vals } ); throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X', 'Should get error for invalid date format in config'; is $@->ident, 'datetime', 'Invalid date format error ident should be "datetime"'; is $@->message, __x( 'Unknown date format "{format}"', format => 'nonesuch', ), 'Invalid date format error message should be correct'; @vals = (undef, 1, 0); is_deeply $CLASS->configure($config, {}), { show_changes => 1, show_tags => 0, }, 'Should get bool values set from config'; $cmock->unmock_all; throws_ok { $CLASS->configure($config, { date_format => 'non'}), {} } 'App::Sqitch::X', 'Should get error for invalid date format in optsions'; is $@->ident, 'datetime', 'Invalid date format error ident should be "status"'; is $@->message, __x( 'Unknown date format "{format}"', format => 'non', ), 'Invalid date format error message should be correct'; ############################################################################## # Test emit_state(). my $dt = App::Sqitch::DateTime->new( year => 2012, month => 7, day => 7, hour => 16, minute => 12, second => 47, time_zone => 'America/Denver', ); my $state = { project => 'mystatus', change_id => 'someid', change => 'widgets_table', committer_name => 'fred', committer_email => 'fred@example.com', committed_at => $dt->clone, tags => [], planner_name => 'barney', planner_email => 'barney@example.com', planned_at => $dt->clone->subtract(days => 2), }; $dt->set_time_zone('local'); my $ts = $dt->as_string( format => $status->date_format ); ok $status->emit_state($state), 'Emit the state'; is_deeply +MockOutput->get_comment, [ [__x 'Project: {project}', project => 'mystatus'], [__x 'Change: {change_id}', change_id => 'someid'], [__x 'Name: {change}', change => 'widgets_table'], [__x 'Deployed: {date}', date => $ts], [__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com' ], ], 'The state should have been emitted'; # Try with a tag. $state-> {tags} = ['@alpha']; ok $status->emit_state($state), 'Emit the state with a tag'; is_deeply +MockOutput->get_comment, [ [__x 'Project: {project}', project => 'mystatus'], [__x 'Change: {change_id}', change_id => 'someid'], [__x 'Name: {change}', change => 'widgets_table'], [__nx 'Tag: {tags}', 'Tags: {tags}', 1, tags => '@alpha'], [__x 'Deployed: {date}', date => $ts], [__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com' ], ], 'The state should have been emitted with a tag'; # Try with mulitple tags. $state-> {tags} = ['@alpha', '@beta', '@gamma']; ok $status->emit_state($state), 'Emit the state with multiple tags'; is_deeply +MockOutput->get_comment, [ [__x 'Project: {project}', project => 'mystatus'], [__x 'Change: {change_id}', change_id => 'someid'], [__x 'Name: {change}', change => 'widgets_table'], [__nx 'Tag: {tags}', 'Tags: {tags}', 3, tags => join(__ ', ', qw(@alpha @beta @gamma))], [__x 'Deployed: {date}', date => $ts], [__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com' ], ], 'The state should have been emitted with multiple tags'; ############################################################################## # Test emit_changes(). my @current_changes; my $project; $engine_mocker->mock(current_changes => sub { $project = $_[1]; sub { shift @current_changes }; }); @current_changes = ({ change_id => 'someid', change => 'foo', committer_name => 'anna', committer_email => 'anna@example.com', committed_at => $dt, planner_name => 'anna', planner_email => 'anna@example.com', planned_at => $dt->clone->subtract( hours => 4 ), }); $sqitch = App::Sqitch->new(options => { engine => 'sqlite' }); ok $status = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'status', config => $config, }), 'Create status command with an engine'; ok $status->emit_changes, 'Try to emit changes'; is_deeply +MockOutput->get_comment, [], 'Should have emitted no changes'; ok $status = App::Sqitch::Command::status->new( sqitch => $sqitch, show_changes => 1, project => 'foo', ), 'Create change-showing status command'; $status->target($status->default_target); ok $status->emit_changes, 'Emit changes again'; is $project, 'foo', 'Project "foo" should have been passed to current_changes'; is_deeply +MockOutput->get_comment, [ [''], [__n 'Change:', 'Changes:', 1], [" foo - $ts - anna "], ], 'Should have emitted one change'; # Add a couple more changes. @current_changes = ( { change_id => 'someid', change => 'foo', committer_name => 'anna', committer_email => 'anna@example.com', committed_at => $dt, planner_name => 'anna', planner_email => 'anna@example.com', planned_at => $dt->clone->subtract( hours => 4 ), }, { change_id => 'anid', change => 'blech', committer_name => 'david', committer_email => 'david@example.com', committed_at => $dt, planner_name => 'david', planner_email => 'david@example.com', planned_at => $dt->clone->subtract( hours => 4 ), }, { change_id => 'anotherid', change => 'long_name', committer_name => 'julie', committer_email => 'julie@example.com', committed_at => $dt, planner_name => 'julie', planner_email => 'julie@example.com', planned_at => $dt->clone->subtract( hours => 4 ), }, ); ok $status->emit_changes, 'Emit changes thrice'; is $project, 'foo', 'Project "foo" again should have been passed to current_changes'; is_deeply +MockOutput->get_comment, [ [''], [__n 'Change:', 'Changes:', 3], [" foo - $ts - anna "], [" blech - $ts - david "], [" long_name - $ts - julie "], ], 'Should have emitted three changes'; ############################################################################## # Test emit_tags(). my @current_tags; $engine_mocker->mock(current_tags => sub { $project = $_[1]; sub { shift @current_tags }; }); ok $status->emit_tags, 'Try to emit tags'; is_deeply +MockOutput->get_comment, [], 'No tags should have been emitted'; ok $status = App::Sqitch::Command::status->new( sqitch => $sqitch, show_tags => 1, project => 'bar', ), 'Create tag-showing status command'; $status->target($status->default_target); # Try with no tags. ok $status->emit_tags, 'Try to emit tags again'; is $project, 'bar', 'Project "bar" should be passed to current_tags()'; is_deeply +MockOutput->get_comment, [ [''], [__ 'Tags: None.'], ], 'Should have emitted a header for no tags'; @current_tags = ({ tag_id => 'tagid', tag => '@alpha', committer_name => 'duncan', committer_email => 'duncan@example.com', committed_at => $dt, planner_name => 'duncan', planner_email => 'duncan@example.com', planned_at => $dt->clone->subtract( hours => 4 ), }); ok $status->emit_tags, 'Emit tags'; is $project, 'bar', 'Project "bar" should again be passed to current_tags()'; is_deeply +MockOutput->get_comment, [ [''], [__n 'Tag:', 'Tags:', 1], [" \@alpha - $ts - duncan "], ], 'Should have emitted one tag'; # Add a couple more tags. @current_tags = ( { tag_id => 'tagid', tag => '@alpha', committer_name => 'duncan', committer_email => 'duncan@example.com', committed_at => $dt, planner_name => 'duncan', planner_email => 'duncan@example.com', planned_at => $dt->clone->subtract( hours => 4 ), }, { tag_id => 'myid', tag => '@beta', committer_name => 'nick', committer_email => 'nick@example.com', committed_at => $dt, planner_name => 'nick', planner_email => 'nick@example.com', planned_at => $dt->clone->subtract( hours => 4 ), }, { tag_id => 'yourid', tag => '@gamma', committer_name => 'jacqueline', committer_email => 'jacqueline@example.com', committed_at => $dt, planner_name => 'jacqueline', planner_email => 'jacqueline@example.com', planned_at => $dt->clone->subtract( hours => 4 ), }, ); ok $status->emit_tags, 'Emit tags again'; is $project, 'bar', 'Project "bar" should once more be passed to current_tags()'; is_deeply +MockOutput->get_comment, [ [''], [__n 'Tag:', 'Tags:', 3], [" \@alpha - $ts - duncan "], [" \@beta - $ts - nick "], [" \@gamma - $ts - jacqueline "], ], 'Should have emitted all three tags'; ############################################################################## # Test emit_status(). my $file = file qw(t plans multi.plan); $sqitch = App::Sqitch->new(options => { plan_file => $file->stringify, engine => 'sqlite', }); ok $status = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'status', config => $config,}), 'Create status command with actual plan command'; $status->target($target = $status->default_target); my @changes = $target->plan->changes; # Start with an up-to-date state. $state->{change_id} = $changes[-1]->id; ok $status->emit_status($state), 'Emit status'; is_deeply +MockOutput->get_comment, [['']], 'Should have a blank comment line'; is_deeply +MockOutput->get_emit, [ [__ 'Nothing to deploy (up-to-date)'], ], 'Should emit up-to-date output'; # Start with second-to-last change. $state->{change_id} = $changes[2]->id; ok $status->emit_status($state), 'Emit status again'; is_deeply +MockOutput->get_comment, [['']], 'Should have a blank comment line'; is_deeply +MockOutput->get_emit, [ [__n 'Undeployed change:', 'Undeployed changes:', 1], [' * ', $changes[3]->format_name_with_tags], ], 'Should emit list of undeployed changes'; # Start with second step. $state->{change_id} = $changes[1]->id; ok $status->emit_status($state), 'Emit status thrice'; is_deeply +MockOutput->get_comment, [['']], 'Should have a blank comment line'; is_deeply +MockOutput->get_emit, [ [__n 'Undeployed change:', 'Undeployed changes:', 2], map { [' * ', $_->format_name_with_tags] } @changes[2..$#changes], ], 'Should emit list of undeployed changes'; # Now go for an ID that cannot be found. $state->{change_id} = 'nonesuchid'; throws_ok { $status->emit_status($state) } 'App::Sqitch::X', 'Die on invalid ID'; is $@->ident, 'status', 'Invalid ID error ident should be "status"'; is $@->message, __ 'Make sure you are connected to the proper database for this project.', 'The invalid ID error message should be correct'; is_deeply +MockOutput->get_comment, [['']], 'Should have a blank comment line'; is_deeply +MockOutput->get_vent, [ [__x 'Cannot find this change in {file}', file => $file], ], 'Should have a message about inability to find the change'; ############################################################################## # Test execute(). my ($target_name_arg, $orig_meth); $target_name_arg = '_blah'; $mock_target->mock(new => sub { my $self = shift; my %p = @_; $target_name_arg = $p{name}; $self->$orig_meth(@_); }); $orig_meth = $mock_target->original('new'); ok $status = App::Sqitch::Command::status->new( sqitch => $sqitch, config => $config, ), 'Recreate status command'; my $check_output = sub { local $Test::Builder::Level = $Test::Builder::Level + 1; is_deeply +MockOutput->get_comment, [ [__x 'On database {db}', db => $target->engine->destination ], [__x 'Project: {project}', project => 'mystatus'], [__x 'Change: {change_id}', change_id => $state->{change_id}], [__x 'Name: {change}', change => 'widgets_table'], [__nx 'Tag: {tags}', 'Tags: {tags}', 3, tags => join(__ ', ', qw(@alpha @beta @gamma))], [__x 'Deployed: {date}', date => $ts], [__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com'], [''], ], 'The state should have been emitted'; is_deeply +MockOutput->get_emit, [ [__n 'Undeployed change:', 'Undeployed changes:', 2], map { [' * ', $_->format_name_with_tags] } @changes[2..$#changes], ], 'Should emit list of undeployed changes'; }; $state->{change_id} = $changes[1]->id; $engine_mocker->mock( current_state => $state ); ok $status->execute, 'Execute'; $check_output->(); is $target_name_arg, undef, 'No target name should have been passed to Target'; # Test with a database argument. ok $status->execute('db:sqlite:'), 'Execute with target arg'; $check_output->(); is $target_name_arg, 'db:sqlite:', 'Name "db:sqlite:" should have been passed to Target'; # Pass the database in an option. ok $status = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'status', config => $config, args => ['--target', 'db:sqlite:'], }), 'Create status command with a target option'; ok $status->execute, 'Execute with target attribute'; $check_output->(); is $target_name_arg, 'db:sqlite:', 'Name "db:sqlite:" should have been passed to Target'; # Test with two targets. ok $status->execute('db:pg:'), 'Execute with target attribute and arg'; $check_output->(); is $target_name_arg, 'db:pg:', 'Name "db:sqlite:" should have been passed to Target'; is_deeply +MockOutput->get_warn, [[__x( 'Too many targets specified; connecting to {option}', option => $status->target_name, )]], 'Should have got warning for two targets'; # Test with a plan file param and no option. ok $status = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'status', config => $config, }), 'Create status command with no target option'; ok $status->execute($file), 'Execute with plan file'; $check_output->(); is $target_name_arg, 'db:sqlite:', 'Name "db:sqlite:" should have been passed to Target'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; # Test with unknown plan. for my $spec ( [ 'specified', App::Sqitch->new( options => { engine => 'sqlite' }) ], [ 'external', $sqitch ], ) { my ( $desc, $sqitch ) = @{ $spec }; ok $status = $CLASS->new( sqitch => $sqitch, project => 'foo', ), "Create status command with $desc project"; ok $status->execute, "Execute for $desc project"; is_deeply +MockOutput->get_comment, [ [__x 'On database {db}', db => $target->engine->destination ], [__x 'Project: {project}', project => 'mystatus'], [__x 'Change: {change_id}', change_id => $state->{change_id}], [__x 'Name: {change}', change => 'widgets_table'], [__nx 'Tag: {tags}', 'Tags: {tags}', 3, tags => join(__ ', ', qw(@alpha @beta @gamma))], [__x 'Deployed: {date}', date => $ts], [__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com'], [''], ], "The $desc project state should have been emitted"; is_deeply +MockOutput->get_emit, [ [__x 'Status unknown. Use --plan-file to assess "{project}" status', project => 'foo'], ], "Should emit unknown status message for $desc project"; } # Test with no changes. $engine_mocker->mock( current_state => undef ); throws_ok { $status->execute } 'App::Sqitch::X', 'Die on no state'; is $@->ident, 'status', 'No state error ident should be "status"'; is $@->message, __ 'No changes deployed', 'No state error message should be correct'; is_deeply +MockOutput->get_comment, [ [__x 'On database {db}', db => $target->engine->destination ], ], 'The "On database" comment should have been emitted'; # Test with no initilization. $initialized = 0; $engine_mocker->mock( initialized => sub { $initialized } ); $engine_mocker->mock( current_state => sub { die 'No Sqitch tables' } ); throws_ok { $status->execute } 'App::Sqitch::X', 'Should get an error for uninitialized db'; is $@->ident, 'status', 'Uninitialized db error ident should be "status"'; is $@->message, __x( 'Database {db} has not been initialized for Sqitch', db => $status->engine->destination, ), 'Uninitialized db error message should be correct'; App-Sqitch-0.9996/t/tag.t000644 000767 000024 00000013277 13133201371 015246 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use utf8; use Test::More tests => 27; #use Test::More 'no_plan'; use Test::NoWarnings; use Path::Class; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; use Test::MockModule; use Digest::SHA; use URI; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Plan::Tag'; require_ok $CLASS or die; delete $ENV{PGDATABASE}; delete $ENV{PGUSER}; delete $ENV{USER}; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; } can_ok $CLASS, qw( name info id old_info old_id lspace rspace note plan timestamp planner_name planner_email format_planner ); my $sqitch = App::Sqitch->new(options => { engine => 'sqlite', top_dir => dir(qw(t sql))->stringify, }); my $target = App::Sqitch::Target->new(sqitch => $sqitch); my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target); my $change = App::Sqitch::Plan::Change->new( plan => $plan, name => 'roles' ); isa_ok my $tag = $CLASS->new( name => 'foo', plan => $plan, change => $change, ), $CLASS; isa_ok $tag, 'App::Sqitch::Plan::Line'; my $mock_plan = Test::MockModule->new('App::Sqitch::Plan'); $mock_plan->mock(index_of => 0); # no other changes is $tag->format_name, '@foo', 'Name should format as "@foo"'; isa_ok $tag->timestamp, 'App::Sqitch::DateTime', 'Timestamp'; is $tag->planner_name, $sqitch->user_name, 'Planner name shoudld default to user name'; is $tag->planner_email, $sqitch->user_email, 'Planner email shoudld default to user email'; is $tag->format_planner, join( ' ', $sqitch->user_name, '<' . $sqitch->user_email . '>' ), 'Planner name and email should format properly'; my $ts = $tag->timestamp->as_string; is $tag->as_string, "\@foo $ts ". $tag->format_planner, 'Should as_string to "@foo" + timstamp + planner'; my $uri = URI->new('https://github.com/theory/sqitch/'); $mock_plan->mock( uri => $uri ); is $tag->info, join("\n", 'project sql', 'uri https://github.com/theory/sqitch/', 'tag @foo', 'change ' . $change->id, 'planner ' . $tag->format_planner, 'date ' . $ts, ), 'Tag info should incldue the URI'; is $tag->old_info, join("\n", 'project sql', 'uri https://github.com/theory/sqitch/', 'tag @foo', 'change ' . $change->old_id, 'planner ' . $tag->format_planner, 'date ' . $ts, ), 'Old tag info should incldue the URI'; my $date = App::Sqitch::DateTime->new( year => 2012, month => 7, day => 16, hour => 17, minute => 25, second => 7, time_zone => 'UTC', ); ok $tag = $CLASS->new( name => 'howdy', plan => $plan, change => $change, lspace => ' ', rspace => "\t", note => 'blah blah blah', timestamp => $date, planner_name => 'Barack Obama', planner_email => 'potus@whitehouse.gov', ), 'Create tag with more stuff'; my $ts2 = '2012-07-16T17:25:07Z'; is $tag->as_string, " \@howdy $ts2 Barack Obama \t# blah blah blah", 'It should as_string correctly'; $mock_plan->mock(index_of => 1); $mock_plan->mock(change_at => $change); is $tag->change, $change, 'Change should be correct'; is $tag->format_planner, 'Barack Obama ', 'Planner name and email should format properly'; # Make sure it gets the change even if there is a tag in between. my @prevs = ($tag, $change); $mock_plan->mock(index_of => 8); $mock_plan->mock(change_at => sub { shift @prevs }); is $tag->change, $change, 'Change should be for previous change'; is $tag->info, join("\n", 'project sql', 'uri https://github.com/theory/sqitch/', 'tag @howdy', 'change ' . $change->id, 'planner Barack Obama ', 'date 2012-07-16T17:25:07Z', '', 'blah blah blah', ), 'Tag info should include the change'; is $tag->id, do { my $content = $tag->info; Digest::SHA->new(1)->add( 'tag ' . length($content) . "\0" . $content )->hexdigest; },'Tag ID should be correct'; is $tag->old_info, join("\n", 'project sql', 'uri https://github.com/theory/sqitch/', 'tag @howdy', 'change ' . $change->old_id, 'planner Barack Obama ', 'date 2012-07-16T17:25:07Z' ), 'Old tag info should include the change'; is $tag->old_id, do { my $content = $tag->old_info; Digest::SHA->new(1)->add( 'tag ' . length($content) . "\0" . $content )->hexdigest; },'Old tag ID should be correct'; ############################################################################## # Test ID for a tag with a UTF-8 name. ok $tag = $CLASS->new( name => '阱阪阬', plan => $plan, change => $change, ), 'Create tag with UTF-8 name'; is $tag->info, join("\n", 'project sql', 'uri https://github.com/theory/sqitch/', 'tag ' . '@阱阪阬', 'change ' . $change->old_id, 'planner ' . $tag->format_planner, 'date ' . $tag->timestamp->as_string, ), 'The name should be decoded text in info'; is $tag->id, do { my $content = Encode::encode_utf8 $tag->info; Digest::SHA->new(1)->add( 'tag ' . length($content) . "\0" . $content )->hexdigest; },'Tag ID should be hahsed from encoded UTF-8'; is $tag->old_info, join("\n", 'project sql', 'uri https://github.com/theory/sqitch/', 'tag ' . '@阱阪阬', 'change ' . $change->old_id, 'planner ' . $tag->format_planner, 'date ' . $tag->timestamp->as_string, ), 'Old name should be decoded text in info'; is $tag->old_id, do { my $content = Encode::encode_utf8 $tag->old_info; Digest::SHA->new(1)->add( 'tag ' . length($content) . "\0" . $content )->hexdigest; },'Old tag ID should be hahsed from encoded UTF-8'; App-Sqitch-0.9996/t/tag_cmd.t000644 000767 000024 00000027264 13133201371 016072 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 81; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::Exception; use Test::NoWarnings; use Path::Class qw(file dir); use File::Path qw(make_path remove_tree); use lib 't/lib'; use MockOutput; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS = 'App::Sqitch::Command::tag'; my $dir = dir 'test-tag_cmd'; ok my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => $dir->stringify, }, ), 'Load a sqitch sqitch object'; my $config = $sqitch->config; isa_ok my $tag = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'tag', config => $config, }), $CLASS, 'tag command'; ok !$tag->all, 'The all attribute should be false by default'; can_ok $CLASS, qw( options configure note execute ); is_deeply [$CLASS->options], [qw( tag-name|tag|t=s change-name|change|c=s all|a! note|n|m=s@ )], 'Should have note option'; ############################################################################## # Test configure(). my $cmock = Test::MockModule->new('App::Sqitch::Config'); my (@vals, @params); $cmock->mock( get => sub { shift; push @params, \@_; shift @vals } ); is_deeply $CLASS->configure($config, {}), {}, 'Should get empty hash for no config or options'; is_deeply \@params, [], 'Should not have fetched boolean tag.all config'; @params = (); is_deeply $CLASS->configure( $config, { tag_name => 'foo', change_name => 'bar', all => 1} ), { tag_name => 'foo', change_name => 'bar', all => 1 }, 'Should get populated hash for no all options'; is_deeply \@params, [], 'Should not have fetched boolean tag.all config'; @params = (); $cmock->unmock_all; ############################################################################## # Test tagging a single plan. make_path $dir->stringify; END { remove_tree $dir->stringify }; my $plan_file = $tag->default_target->plan_file; $plan_file->spew("%project=empty\n\n"); # Override request_note(). my $tag_mocker = Test::MockModule->new('App::Sqitch::Plan::Tag'); my %request_params; $tag_mocker->mock(request_note => sub { my $self = shift; %request_params = @_; $self->note; }); my $plan = $tag->default_target->plan; ok $plan->add( name => 'foo' ), 'Add change "foo"'; ok $tag->execute('alpha'), 'Tag @alpha'; is $plan->get('@alpha')->name, 'foo', 'Should have tagged "foo"'; ok $plan->load, 'Reload plan'; is $plan->get('@alpha')->name, 'foo', 'New tag should have been written'; is [$plan->tags]->[-1]->note, '', 'New tag should have empty note'; is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note'; is_deeply +MockOutput->get_info, [ [__x 'Tagged "{change}" with {tag} in {file}', change => 'foo', tag => '@alpha', file => $plan->file, ] ], 'The info message should be correct'; # With no arg, should get a list of tags. ok $tag->execute, 'Execute with no arg'; is_deeply +MockOutput->get_info, [ ['@alpha'], ], 'The one tag should have been listed'; is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note'; # Add a tag. ok $plan->tag( name => '@beta' ), 'Add tag @beta'; ok $tag->execute, 'Execute with no arg again'; is_deeply +MockOutput->get_info, [ ['@alpha'], ['@beta'], ], 'Both tags should have been listed'; is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note'; # Set a note and a name. isa_ok $tag = App::Sqitch::Command::tag->new({ sqitch => $sqitch, note => [qw(hello there)], tag_name => 'gamma', }), $CLASS, 'tag command with note'; $plan = $tag->default_target->plan; ok $tag->execute, 'Tag @gamma'; is $plan->get('@gamma')->name, 'foo', 'Gamma tag should be on change "foo"'; is [$plan->tags]->[-1]->note, "hello\n\nthere", 'Gamma tag should have note'; ok $plan->load, 'Reload plan'; is $plan->get('@gamma')->name, 'foo', 'Gamma tag should have been written'; is [$plan->tags]->[-1]->note, "hello\n\nthere", 'Written tag should have note'; is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note'; is_deeply +MockOutput->get_info, [ [__x 'Tagged "{change}" with {tag} in {file}', change => 'foo', tag => '@gamma', file => $plan->file, ] ], 'The gamma note should be correct'; # Tag a specific change. isa_ok $tag = App::Sqitch::Command::tag->new({ sqitch => $sqitch, note => ['here we go'], }), $CLASS, 'tag command with note'; $plan = $tag->default_target->plan; ok $plan->add( name => 'bar' ), 'Add change "bar"'; ok $plan->add( name => 'baz' ), 'Add change "baz"'; ok $tag->execute('delta', 'bar'), 'Tag change "bar" with @delta'; is $plan->get('@delta')->name, 'bar', 'Should have tagged "bar"'; ok $plan->load, 'Reload plan'; is $plan->get('@delta')->name, 'bar', 'New tag should have been written'; is [$plan->tags]->[-1]->note, 'here we go', 'New tag should have the proper note'; is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note'; is_deeply +MockOutput->get_info, [ [__x 'Tagged "{change}" with {tag} in {file}', change => 'bar', tag => '@delta', file => $plan->file, ] ], 'The info message should be correct'; # Use --change to tage a specific change. isa_ok $tag = App::Sqitch::Command::tag->new({ sqitch => $sqitch, change_name => 'bar', note => ['here we go'], }), $CLASS, 'tag command with change name'; $plan = $tag->default_target->plan; ok $tag->execute('zeta'), 'Tag change "bar" with @zeta'; is $plan->get('@zeta')->name, 'bar', 'Should have tagged "bar" with @zeta'; ok $plan->load, 'Reload plan'; is $plan->get('@zeta')->name, 'bar', 'Tag @zeta should have been written'; is [$plan->tags]->[-1]->note, 'here we go', 'Tag @zeta should have the proper note'; is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note'; is_deeply +MockOutput->get_info, [ [__x 'Tagged "{change}" with {tag} in {file}', change => 'bar', tag => '@zeta', file => $plan->file, ] ], 'The zeta info message should be correct'; ############################################################################## # Let's deal with multiple engines. my $conf = $dir->file('sqitch.conf'); $conf->spew(join "\n", '[core]', 'engine = pg', '[engine "pg"]', 'top_dir = pg', '[engine "sqlite"]', 'top_dir = sqlite', '[engine "mysql"]', 'top_dir = mysql', ); local $ENV{SQITCH_CONFIG} = $conf->stringify; ok $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => $dir->stringify, }, ), 'Load another sqitch sqitch object'; isa_ok $tag = App::Sqitch::Command::tag->new({ sqitch => $sqitch, all => 1, note => ['here we go again'], }), $CLASS, 'another tag command'; $plan = $tag->default_target->plan; ok $tag->execute('whacko'), 'Tag with @whacko'; is $plan->get('@whacko')->name, 'baz', 'Should have tagged "baz" with @whacko'; is_deeply +MockOutput->get_info, [ [__x 'Tagged "{change}" with {tag} in {file}', change => 'baz', tag => '@whacko', file => $plan->file, ] ], 'The whacko info message should be correct'; # With --all and args, should get an error. throws_ok { $tag->execute('fred', 'pg') } 'App::Sqitch::X', 'Should get an error for --all and a target arg'; is $@->ident, 'tag', 'Mixed arguments error ident should be "tag"'; is $@->message, __( 'Cannot specify both --all and engine, target, or plan arugments' ), 'Mixed arguments error message should be correct'; # Great. Now try two plans! (my $pg = $dir->file('pg.plan')->stringify) =~ s{\\}{\\\\}g; (my $sqlite = $dir->file('sqlite.plan')->stringify) =~ s{\\}{\\\\}g; $conf->spew(join "\n", '[core]', 'engine = pg', "top_dir = $dir", '[engine "pg"]', "plan_file = $pg", '[engine "sqlite"]', "plan_file = $sqlite", ); $dir->file("$_.plan")->spew( "%project=tag\n\n${_}_change 2012-07-16T17:25:07Z Hi \n" ) for qw(pg sqlite); ok $sqitch = App::Sqitch->new, 'Load another sqitch sqitch object'; # Mock getting tag.all. my $get; $cmock->mock( get => sub { return 1 if $_[2] eq 'tag.all'; return $get->(@_); }); $get = $cmock->original('get'); isa_ok $tag = App::Sqitch::Command::tag->new({ sqitch => $sqitch, note => ['here we go again'], }), $CLASS, 'yet another tag command'; ok $tag->execute('dubdub'), 'Tag with @dubdub'; my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 2, 'Should have two targets'; is $targets[0]->plan->get('@dubdub')->name, 'pg_change', 'Should have tagged pg plan change "pg_change" with @dubdub'; is $targets[1]->plan->get('@dubdub')->name, 'sqlite_change', 'Should have tagged sqlite plan change "sqlite_change" with @dubdub'; is_deeply +MockOutput->get_info, [ [__x 'Tagged "{change}" with {tag} in {file}', change => 'pg_change', tag => '@dubdub', file => $targets[0]->plan_file, ], [__x 'Tagged "{change}" with {tag} in {file}', change => 'sqlite_change', tag => '@dubdub', file => $targets[1]->plan_file, ], ], 'The dubdub info message should show both plans tagged'; # With tag.all and an argument, we should just get the argument. ok $tag->execute('shoot', 'sqlite'), 'Tag sqlite plan with @shoot'; @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 2, 'Should still have two targets'; ok !$targets[0]->plan->get('@shoot'), 'Should not have tagged pg plan change "sqlite_change" with @shoot'; is $targets[1]->plan->get('@shoot')->name, 'sqlite_change', 'Should have tagged sqlite plan change "sqlite_change" with @shoot'; is_deeply +MockOutput->get_info, [ [__x 'Tagged "{change}" with {tag} in {file}', change => 'sqlite_change', tag => '@shoot', file => $targets[1]->plan_file, ], ], 'The shoot info message should the sqlite plan getting tagged'; $cmock->unmock_all; # Without --all or tag.all, we should just get the default target. isa_ok $tag = App::Sqitch::Command::tag->new({ sqitch => $sqitch, note => ['here we go again'], }), $CLASS, 'yet another tag command'; ok $tag->execute('huwah'), 'Tag with @huwah'; @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch); is @targets, 2, 'Should still have two targets'; is $targets[0]->plan->get('@huwah')->name, 'pg_change', 'Should have tagged pg plan change "pg_change" with @huwah'; ok !$targets[1]->plan->get('@huwah'), 'Should not have tagged sqlite plan change "sqlite_change" with @huwah'; is_deeply +MockOutput->get_info, [ [__x 'Tagged "{change}" with {tag} in {file}', change => 'pg_change', tag => '@huwah', file => $targets[0]->plan_file, ], ], 'The huwah info message should the pg plan getting tagged'; # Make sure we die if the passed name conflicts with a target. TARGET: { my $mock_add = Test::MockModule->new($CLASS); $mock_add->mock(parse_args => sub { return undef, undef, [$tag->default_target]; }); $mock_add->mock(name => 'blog'); my $mock_target = Test::MockModule->new('App::Sqitch::Target'); $mock_target->mock(name => 'blog'); throws_ok { $tag->execute('blog') } 'App::Sqitch::X', 'Should get an error for conflict with target name'; is $@->ident, 'tag', 'Conflicting target error ident should be "tag"'; is $@->message, __x( 'Name "{name}" identifies a target; use "--tag {name}" to use it for the tag name', name => 'blog', ), 'Conflicting target error message should be correct'; } App-Sqitch-0.9996/t/target.conf000644 000767 000024 00000000352 13133201371 016431 0ustar00davidstaff000000 000000 [core] engine = pg [target "dev"] uri = db:pg:widgets [target "qa"] uri = db:pg://qa.example.com/qa_widgets registry = meta client = /usr/sbin/psql [target "prod"] uri = db:pg://prod.example.us/pr_widgets App-Sqitch-0.9996/t/target.t000644 000767 000024 00000075150 13133201371 015757 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More; use App::Sqitch; use Path::Class qw(dir file); use Test::Exception; use Test::MockModule; use Locale::TextDomain qw(App-Sqitch); use lib 't/lib'; use MockOutput; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::Target'; use_ok $CLASS or die; } ############################################################################## # Load a target and test the basics. ok my $sqitch = App::Sqitch->new(options => { engine => 'sqlite'}), 'Load a sqitch sqitch object'; isa_ok my $target = $CLASS->new(sqitch => $sqitch), $CLASS; can_ok $target, qw( new name target uri sqitch engine registry client plan_file plan top_dir deploy_dir revert_dir verify_dir reworked_dir reworked_deploy_dir reworked_revert_dir reworked_verify_dir extension ); # Look at default values. is $target->name, 'db:sqlite:', 'Name should be "db:sqlite:"'; is $target->target, $target->name, 'Target should be alias for name'; is $target->uri, URI::db->new('db:sqlite:'), 'URI should be "db:sqlite:"'; is $target->sqitch, $sqitch, 'Sqitch should be as passed'; is $target->engine_key, 'sqlite', 'Engine key should be "sqlite"'; isa_ok $target->engine, 'App::Sqitch::Engine::sqlite', 'Engine'; is $target->registry, $target->engine->default_registry, 'Should have default registry'; my $client = $target->engine->default_client; $client .= '.exe' if $^O eq 'MSWin32' && $client !~ /[.](?:exe|bat)$/; is $target->client, $client, 'Should have default client'; is $target->top_dir, dir, 'Should have default top_dir'; is $target->deploy_dir, $target->top_dir->subdir('deploy'), 'Should have default deploy_dir'; is $target->revert_dir, $target->top_dir->subdir('revert'), 'Should have default revert_dir'; is $target->verify_dir, $target->top_dir->subdir('verify'), 'Should have default verify_dir'; is $target->reworked_dir, $target->top_dir, 'Should have default reworked_dir'; is $target->reworked_deploy_dir, $target->reworked_dir->subdir('deploy'), 'Should have default reworked_deploy_dir'; is $target->reworked_revert_dir, $target->reworked_dir->subdir('revert'), 'Should have default reworked_revert_dir'; is $target->reworked_verify_dir, $target->reworked_dir->subdir('verify'), 'Should have default reworked_verify_dir'; is $target->extension, 'sql', 'Should have default extension'; is $target->plan_file, $target->top_dir->file('sqitch.plan')->cleanup, 'Should have default plan file'; isa_ok $target->plan, 'App::Sqitch::Plan', 'Should get plan'; is $target->plan->file, $target->plan_file, 'Plan file should be copied from Target'; my $uri = $target->uri; is $target->dsn, $uri->dbi_dsn, 'DSN should be from URI'; is $target->username, $uri->user, 'Username should be from URI'; is $target->password, $uri->password, 'Password should be from URI'; do { isa_ok my $target = $CLASS->new(sqitch => $sqitch), $CLASS; local $ENV{SQITCH_PASSWORD} = 'S3cre7s'; is $target->password, $ENV{SQITCH_PASSWORD}, 'Password should be from environment variable'; }; ############################################################################## # Let's look at how the object is created based on the params to new(). # First try no params. throws_ok { $CLASS->new } qr/^Missing required arguments:/, 'Should get error for missing params'; # Pass both name and URI. $uri = URI::db->new('db:pg://hi:there@localhost/blah'), isa_ok $target = $CLASS->new( sqitch => $sqitch, name => 'foo', uri => $uri, ), $CLASS, 'Target with name and URI'; is $target->name, 'foo', 'Name should be "foo"'; is $target->target, $target->name, 'Target should be alias for name'; is $target->uri, $uri, 'URI should be set as passed'; is $target->sqitch, $sqitch, 'Sqitch should be as passed'; is $target->engine_key, 'pg', 'Engine key should be "pg"'; isa_ok $target->engine, 'App::Sqitch::Engine::pg', 'Engine'; is $target->dsn, $uri->dbi_dsn, 'DSN should be from URI'; is $target->username, 'hi', 'Username should be from URI'; do { local $ENV{SQITCH_PASSWORD} = 'lolz'; is $target->password, 'lolz', 'Password should be from environment'; }; # Pass a URI but no name. isa_ok $target = $CLASS->new( sqitch => $sqitch, uri => $uri, ), $CLASS, 'Target with URI'; like $target->name, qr{db:pg://hi:?\@localhost/blah}, 'Name should be URI without password'; is $target->target, $target->name, 'Target should be alias for name'; is $target->engine_key, 'pg', 'Engine key should be "pg"'; isa_ok $target->engine, 'App::Sqitch::Engine::pg', 'Engine'; is $target->dsn, $uri->dbi_dsn, 'DSN should be from URI'; is $target->username, $uri->user, 'Username should be from URI'; is $target->password, $uri->password, 'Password should be from URI'; # Set up a config. CONSTRUCTOR: { my $mock = Test::MockModule->new('App::Sqitch::Config'); my @get_params; my @get_ret; $mock->mock(get => sub { shift; push @get_params => \@_; shift @get_ret; }); # Pass neither, but rely on the engine in the Sqitch object. isa_ok my $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Default target'; is $target->name, 'db:sqlite:', 'Name should be "db:sqlite:"'; is $target->uri, URI::db->new('db:sqlite:'), 'URI should be "db:sqlite:"'; is_deeply \@get_params, [[key => 'engine.sqlite.target'],[key => 'core.sqlite.target']], 'Should have tried to get engine target'; # Try with no engine option. @get_params = (); delete $sqitch->options->{engine}; push @get_ret => undef, 'mysql'; isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Default target'; is $target->name, 'db:mysql:', 'Name should be "db:mysql:"'; is $target->uri, URI::db->new('db:mysql:'), 'URI should be "db:mysql"'; is_deeply \@get_params, [ [key => 'core.target'], [key => 'core.engine'], [key => 'engine.mysql.target'], [key => 'core.mysql.target'], ], 'Should have tried to get core.target, core.engine and then the target'; # Try with no engine option but a name that looks like a URI. @get_params = (); delete $sqitch->options->{engine}; isa_ok $target = $CLASS->new( sqitch => $sqitch, name => 'db:pg:', ), $CLASS, 'Target with URI in name'; is $target->name, 'db:pg:', 'Name should be "db:pg:"'; is $target->uri, URI::db->new('db:pg:'), 'URI should be "db:pg"'; is_deeply \@get_params, [], 'Should have fetched no config'; # Try it with a name with no engine. throws_ok { $CLASS->new(sqitch => $sqitch, name => 'db:') } 'App::Sqitch::X', 'Should have error for no engine in URI'; is $@->ident, 'target', 'Should have target ident'; is $@->message, __x( 'No engine specified by URI {uri}; URI must start with "db:$engine:"', uri => 'db:', ), 'Should have message about no engine-less URI'; # Try it with no configured core engine or target. throws_ok { $CLASS->new(sqitch => $sqitch) } 'App::Sqitch::X', 'Should have error for no engine or target'; is $@->ident, 'target', 'Should have target ident'; is $@->message, __( 'No engine specified; use --engine or set core.engine' ), 'Should have message about no specified engine'; # Try with engine-less URI. @get_params = (); isa_ok $target = $CLASS->new( sqitch => $sqitch, uri => URI::db->new('db:'), ), $CLASS, 'Engineless target'; is $target->name, 'db:', 'Name should be "db:"'; is $target->uri, URI::db->new('db:'), 'URI should be "db:"'; is_deeply \@get_params, [], 'Should not have tried to get engine target'; is $target->sqitch, $sqitch, 'Sqitch should be as passed'; is $target->engine_key, undef, 'Engine key should be undef'; throws_ok { $target->engine } 'App::Sqitch::X', 'Should get exception for no engine'; is $@->ident, 'engine', 'Should have engine ident'; is $@->message, __( 'No engine specified; use --engine or set core.engine' ), 'Should have message about no engine'; is $target->top_dir, dir, 'Should have default top_dir'; is $target->deploy_dir, $target->top_dir->subdir('deploy'), 'Should have default deploy_dir'; is $target->revert_dir, $target->top_dir->subdir('revert'), 'Should have default revert_dir'; is $target->verify_dir, $target->top_dir->subdir('verify'), 'Should have default verify_dir'; is $target->reworked_dir, $target->top_dir, 'Should have default reworked_dir'; is $target->reworked_deploy_dir, $target->reworked_dir->subdir('deploy'), 'Should have default reworked_deploy_dir'; is $target->reworked_revert_dir, $target->reworked_dir->subdir('revert'), 'Should have default reworked_revert_dir'; is $target->reworked_verify_dir, $target->reworked_dir->subdir('verify'), 'Should have default reworked_verify_dir'; is $target->extension, 'sql', 'Should have default extension'; is $target->plan_file, $target->top_dir->file('sqitch.plan')->cleanup, 'Should have default plan file'; isa_ok $target->plan, 'App::Sqitch::Plan', 'Should get plan'; is $target->plan->file, $target->plan_file, 'Plan file should be copied from Target'; is $target->dsn, '', 'DSN should be empty'; is $target->username, undef, 'Username should be undef'; is $target->password, undef, 'Password should be undef'; # Try passing a proper URI via the name. @get_params = (); isa_ok $target = $CLASS->new(sqitch => $sqitch, name => 'db:pg://a:b@foo/scat'), $CLASS, 'Engine URI target'; like $target->name, qr{db:pg://a:?\@foo/scat}, 'Name should be "db:pg://a@foo/scat"'; is $target->uri, URI::db->new('db:pg://a:b@foo/scat'), 'URI should be "db:pg://a:b@foo/scat"'; is_deeply \@get_params, [], 'Nothing should have been fetched from config'; # Pass nothing, but let a URI be in core.target. @get_params = (); push @get_ret => 'db:pg://s:b@ack/shi'; isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Engine URI core.target'; like $target->name, qr{db:pg://s:?\@ack/shi}, 'Name should be "db:pg://s@ack/shi"'; is $target->uri, URI::db->new('db:pg://s:b@ack/shi'), 'URI should be "db:pg://s:b@ack/shi"'; is_deeply \@get_params, [[key => 'core.target']], 'Should have fetched core.target from config'; # Pass nothing, but let a target name be in core.target. @get_params = (); push @get_ret => 'shout', 'db:pg:w:e@we/bar'; isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Engine name core.target'; is $target->name, 'shout', 'Name should be "shout"'; is $target->uri, URI::db->new('db:pg:w:e@we/bar'), 'URI should be "db:pg:w:e@we/bar"'; is_deeply \@get_params, [ [key => 'core.target'], [key => 'target.shout.uri'] ], 'Should have fetched target.shout.uri from config'; # Mock get_section. my @sect_params; my @sect_ret = ({}); $mock->mock(get_section => sub { shift; push @sect_params => \@_; shift @sect_ret; }); # Try it with a name. $sqitch->options->{engine} = 'sqlite'; @get_params = (); throws_ok { $CLASS->new(sqitch => $sqitch, name => 'foo') } 'App::Sqitch::X', 'Should have exception for unknown named target'; is $@->ident, 'target', 'Unknown target error ident should be "target"'; is $@->message, __x( 'Cannot find target "{target}"', target => 'foo', ), 'Unknown target error message should be correct'; is_deeply \@get_params, [[key => 'target.foo.uri']], 'Should have requested target URI from config'; is_deeply \@sect_params, [[section => 'target.foo']], 'Should have requested target.foo section'; # Let the name section exist, but without a URI. @get_params = @sect_params = (); @sect_ret = ({ foo => 1}); throws_ok { $CLASS->new(sqitch => $sqitch, name => 'foo') } 'App::Sqitch::X', 'Should have exception for URL-less named target'; is $@->ident, 'target', 'URL-less target error ident should be "target"'; is $@->message, __x( 'No URI associated with target "{target}"', target => 'foo', ), 'URL-less target error message should be correct'; is_deeply \@get_params, [[key => 'target.foo.uri']], 'Should have requested target URI from config'; is_deeply \@sect_params, [[section => 'target.foo']], 'Should have requested target.foo section'; # Now give it a URI. @get_params = @sect_params = (); @get_ret = ('db:pg:foo'); isa_ok $target = $CLASS->new(sqitch => $sqitch, name => 'foo'), $CLASS, 'Named target'; is $target->name, 'foo', 'Name should be "foo"'; is $target->uri, URI::db->new('db:pg:foo'), 'URI should be "db:pg:foo"'; is_deeply \@get_params, [[key => 'target.foo.uri']], 'Should have requested target URI from config'; is_deeply \@sect_params, [], 'Should not have requested deprecated pg section'; # Let the name be looked up by the engine. @get_params = @sect_params = (); @get_ret = ('foo', 'db:sqlite:foo'); isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Engine named target'; is $target->name, 'foo', 'Name should be "foo"'; is $target->uri, URI::db->new('db:sqlite:foo'), 'URI should be "db:sqlite:foo"'; is_deeply \@get_params, [[key => 'engine.sqlite.target'], [key => 'target.foo.uri']], 'Should have requested engine target and target URI from config'; is_deeply \@sect_params, [[section => 'core.sqlite']], 'Should have requested sqlite section'; # Make sure db options and deprecated config variables work. local $App::Sqitch::Target::WARNED = 0; @sect_ret = ({ host => 'hi.com', port => 5432, username => 'bob', password => 'ouch', db_name => 'sharks', }); $sqitch->options->{engine} = 'pg'; @get_params = @sect_params = (); $uri = URI::db->new('db:pg://bob:ouch@hi.com:5432/sharks'); isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Pg target'; is_deeply \@sect_params, [ [section => 'core.pg' ], [section => 'engine.pg' ]], 'Should have requested core and engine pg sections'; like $target->name, qr{db:pg://bob:?\@hi.com:5432/sharks}, 'Name should be passwordless stringified URI'; is $target->uri, $uri, 'URI should be tweaked by config* options'; is_deeply +MockOutput->get_warn, [[__x( "The core.{engine} config has been deprecated in favor of engine.{engine}.\nRun '{sqitch} engine update-config' to update your configurations.", engine => 'pg', sqitch => $0, )]], 'Should have warned on deprecated config options'; # Make sure --db-* options work. $App::Sqitch::Target::WARNED = 0; @sect_ret = ({ host => 'hi.com', port => 5432, username => 'bob', password => 'ouch', db_name => 'sharks', }); @get_params = @sect_params = (); $uri = URI::db->new('db:pg://fred:ouch@foo.com:12245/widget'); $sqitch->options->{db_host} = 'foo.com'; $sqitch->options->{db_port} = 12245; $sqitch->options->{db_username} = 'fred'; $sqitch->options->{db_name} = 'widget'; isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Postgres target'; is_deeply \@sect_params, [ [section => 'core.pg' ], [section => 'engine.pg' ] ], 'Should have requested sqlite core and engine sections'; like $target->name, qr{db:pg://fred:?\@foo.com:12245/widget}, 'Name should be passwordless stringified URI'; is $target->uri, $uri, 'URI should be tweaked by --db-* options'; is_deeply +MockOutput->get_warn, [ [__x( "The core.{engine} config has been deprecated in favor of engine.{engine}.\nRun '{sqitch} engine update-config' to update your configurations.", engine => 'pg', sqitch => $0, )], ], 'Should have warned on deprecated config'; # Options should work, but not config, when URI read from target config. $App::Sqitch::Target::WARNED = 0; @sect_ret = ({ host => 'hi.com', }); $uri = URI::db->new('db:pg://foo.com/widget'); @get_ret = ('db:pg:'); @get_params = @sect_params = (); delete $sqitch->{options}->{$_} for qw(engine db_port db_username); $sqitch->options->{db_host} = 'foo.com'; $sqitch->options->{db_name} = 'widget'; isa_ok $target = $CLASS->new(sqitch => $sqitch, name => 'foo'), $CLASS, 'Foo target'; is_deeply \@get_params, [ [key => 'target.foo.uri' ]], 'Should have requested target URI'; is_deeply \@sect_params, [], 'Should have fetched no section'; is $target->name, 'foo', 'Name should be as passed'; is $target->uri, $uri, 'URI should be tweaked by --db-* options'; is_deeply +MockOutput->get_warn, [], 'Should have emitted no warnigns'; # Options should work, but not config, when URI passsed. $App::Sqitch::Target::WARNED = 0; @sect_ret = ({ host => 'hi.com', }); $uri = URI::db->new('db:pg://foo.com/widget'); @get_ret = ('db:pg:'); @get_params = @sect_params = (); delete $sqitch->{options}->{$_} for qw(engine db_port db_username); $sqitch->options->{db_host} = 'foo.com'; $sqitch->options->{db_name} = 'widget'; isa_ok $target = $CLASS->new(sqitch => $sqitch, name => 'db:pg:widget'), $CLASS, 'URI target'; is_deeply \@get_params, [], 'Should have requested no config'; is_deeply \@sect_params, [], 'Should have fetched no section'; is $target->name, $uri, 'Name should tweaked by --db-* options'; is $target->uri, $uri, 'URI should be tweaked by --db-* options'; is_deeply +MockOutput->get_warn, [], 'Should have emitted no warnigns'; } CONFIG: { # Look at how attributes are populated from options, config. my $opts = { engine => 'pg' }; my $sqitch = App::Sqitch->new(options => $opts); # Mock config. my $mock = Test::MockModule->new('App::Sqitch::Config'); my %config; $mock->mock(get => sub { $config{$_[2]} }); # Start with core config. %config = ( 'core.registry' => 'myreg', 'core.client' => 'pgsql', 'core.plan_file' => 'my.plan', 'core.top_dir' => 'top', 'core.deploy_dir' => 'dep', 'core.revert_dir' => 'rev', 'core.verify_dir' => 'ver', 'core.reworked_dir' => 'wrk', 'core.reworked_deploy_dir' => 'rdep', 'core.reworked_revert_dir' => 'rrev', 'core.reworked_verify_dir' => 'rver', 'core.extension' => 'ddl', ); my $target = $CLASS->new( sqitch => $sqitch, name => 'foo', uri => URI::db->new('db:pg:foo'), ); is $target->registry, 'myreg', 'Registry should be "myreg"'; is $target->client, 'pgsql', 'Client should be "pgsql"'; is $target->plan_file, 'my.plan', 'Plan file should be "my.plan"'; isa_ok $target->plan_file, 'Path::Class::File', 'Plan file'; isa_ok my $plan = $target->plan, 'App::Sqitch::Plan', 'Plan'; is $plan->file, $target->plan_file, 'Plan should use target plan file'; is $target->top_dir, 'top', 'Top dir should be "top"'; isa_ok $target->top_dir, 'Path::Class::Dir', 'Top dir'; is $target->deploy_dir, 'dep', 'Deploy dir should be "dep"'; isa_ok $target->deploy_dir, 'Path::Class::Dir', 'Deploy dir'; is $target->revert_dir, 'rev', 'Revert dir should be "rev"'; isa_ok $target->revert_dir, 'Path::Class::Dir', 'Revert dir'; is $target->verify_dir, 'ver', 'Verify dir should be "ver"'; isa_ok $target->verify_dir, 'Path::Class::Dir', 'Verify dir'; is $target->reworked_dir, 'wrk', 'Reworked dir should be "wrk"'; isa_ok $target->reworked_dir, 'Path::Class::Dir', 'Reworked dir'; is $target->reworked_deploy_dir, 'rdep', 'Reworked deploy dir should be "rdep"'; isa_ok $target->reworked_deploy_dir, 'Path::Class::Dir', 'Reworked deploy dir'; is $target->reworked_revert_dir, 'rrev', 'Reworked revert dir should be "rrev"'; isa_ok $target->reworked_revert_dir, 'Path::Class::Dir', 'Reworked revert dir'; is $target->reworked_verify_dir, 'rver', 'Reworked verify dir should be "rver"'; isa_ok $target->reworked_verify_dir, 'Path::Class::Dir', 'Reworked verify dir'; is $target->extension, 'ddl', 'Extension should be "ddl"'; # Add engine config. $config{'engine.pg.registry'} = 'yoreg'; $config{'engine.pg.client'} = 'mycli'; $config{'engine.pg.plan_file'} = 'pg.plan'; $config{'engine.pg.top_dir'} = 'pg'; $config{'engine.pg.deploy_dir'} = 'pgdep'; $config{'engine.pg.revert_dir'} = 'pgrev'; $config{'engine.pg.verify_dir'} = 'pgver'; $config{'engine.pg.reworked_dir'} = 'pg/r'; $config{'engine.pg.reworked_deploy_dir'} = 'pgrdep'; $config{'engine.pg.reworked_revert_dir'} = 'pgrrev'; $config{'engine.pg.reworked_verify_dir'} = 'pgrver'; $config{'engine.pg.extension'} = 'pgddl'; $target = $CLASS->new( sqitch => $sqitch, name => 'foo', uri => URI::db->new('db:pg:foo'), ); is $target->registry, 'yoreg', 'Registry should be "yoreg"'; is $target->client, 'mycli', 'Client should be "mycli"'; is $target->plan_file, 'pg.plan', 'Plan file should be "pg.plan"'; isa_ok $target->plan_file, 'Path::Class::File', 'Plan file'; isa_ok $plan = $target->plan, 'App::Sqitch::Plan', 'Plan'; is $plan->file, $target->plan_file, 'Plan should use target plan file'; is $target->top_dir, 'pg', 'Top dir should be "pg"'; isa_ok $target->top_dir, 'Path::Class::Dir', 'Top dir'; is $target->deploy_dir, 'pgdep', 'Deploy dir should be "pgdep"'; isa_ok $target->deploy_dir, 'Path::Class::Dir', 'Deploy dir'; is $target->revert_dir, 'pgrev', 'Revert dir should be "pgrev"'; isa_ok $target->revert_dir, 'Path::Class::Dir', 'Revert dir'; is $target->verify_dir, 'pgver', 'Verify dir should be "pgver"'; isa_ok $target->verify_dir, 'Path::Class::Dir', 'Verify dir'; is $target->reworked_dir, dir('pg/r'), 'Reworked dir should be "pg/r"'; isa_ok $target->reworked_dir, 'Path::Class::Dir', 'Reworked dir'; is $target->reworked_deploy_dir, 'pgrdep', 'Reworked deploy dir should be "pgrdep"'; isa_ok $target->reworked_deploy_dir, 'Path::Class::Dir', 'Reworked deploy dir'; is $target->reworked_revert_dir, 'pgrrev', 'Reworked revert dir should be "pgrrev"'; isa_ok $target->reworked_revert_dir, 'Path::Class::Dir', 'Reworked revert dir'; is $target->reworked_verify_dir, 'pgrver', 'Reworked verify dir should be "pgrver"'; isa_ok $target->reworked_verify_dir, 'Path::Class::Dir', 'Reworked verify dir'; is $target->extension, 'pgddl', 'Extension should be "pgddl"'; # Add target config. $config{'target.foo.registry'} = 'fooreg'; $config{'target.foo.client'} = 'foocli'; $config{'target.foo.plan_file'} = 'foo.plan'; $config{'target.foo.top_dir'} = 'foo'; $config{'target.foo.deploy_dir'} = 'foodep'; $config{'target.foo.revert_dir'} = 'foorev'; $config{'target.foo.verify_dir'} = 'foover'; $config{'target.foo.reworked_dir'} = 'foo/r'; $config{'target.foo.reworked_deploy_dir'} = 'foodepr'; $config{'target.foo.reworked_revert_dir'} = 'foorevr'; $config{'target.foo.reworked_verify_dir'} = 'fooverr'; $config{'target.foo.extension'} = 'fooddl'; $target = $CLASS->new( sqitch => $sqitch, name => 'foo', uri => URI::db->new('db:pg:foo'), ); is $target->registry, 'fooreg', 'Registry should be "fooreg"'; is $target->client, 'foocli', 'Client should be "foocli"'; is $target->plan_file, 'foo.plan', 'Plan file should be "foo.plan"'; isa_ok $target->plan_file, 'Path::Class::File', 'Plan file'; isa_ok $plan = $target->plan, 'App::Sqitch::Plan', 'Plan'; is $plan->file, $target->plan_file, 'Plan should use target plan file'; is $target->top_dir, 'foo', 'Top dir should be "foo"'; isa_ok $target->top_dir, 'Path::Class::Dir', 'Top dir'; is $target->deploy_dir, 'foodep', 'Deploy dir should be "foodep"'; isa_ok $target->deploy_dir, 'Path::Class::Dir', 'Deploy dir'; is $target->revert_dir, 'foorev', 'Revert dir should be "foorev"'; isa_ok $target->revert_dir, 'Path::Class::Dir', 'Revert dir'; is $target->verify_dir, 'foover', 'Verify dir should be "foover"'; isa_ok $target->verify_dir, 'Path::Class::Dir', 'Verify dir'; is $target->reworked_dir, dir('foo/r'), 'Reworked dir should be "foo/r"'; isa_ok $target->reworked_dir, 'Path::Class::Dir', 'Reworked dir'; is $target->reworked_deploy_dir, 'foodepr', 'Reworked deploy dir should be "foodepr"'; isa_ok $target->reworked_deploy_dir, 'Path::Class::Dir', 'Reworked deploy dir'; is $target->reworked_revert_dir, 'foorevr', 'Reworked revert dir should be "foorevr"'; isa_ok $target->reworked_revert_dir, 'Path::Class::Dir', 'Reworked revert dir'; is $target->reworked_verify_dir, 'fooverr', 'Reworked verify dir should be "fooverr"'; isa_ok $target->reworked_verify_dir, 'Path::Class::Dir', 'Reworked verify dir'; is $target->extension, 'fooddl', 'Extension should be "fooddl"'; # Add command-line options. $opts->{registry} = 'optreg'; $opts->{client} = 'optcli'; $opts->{plan_file} = 'opt.plan'; $opts->{top_dir} = 'top.dir'; $opts->{deploy_dir} = 'dep.dir'; $opts->{revert_dir} = 'rev.dir'; $opts->{verify_dir} = 'ver.dir'; $opts->{reworked_dir} = 'wrk.dir'; $opts->{reworked_deploy_dir} = 'rdep.dir'; $opts->{reworked_revert_dir} = 'rrev.dir'; $opts->{reworked_verify_dir} = 'rver.dir'; $opts->{extension} = 'opt'; $target = $CLASS->new( sqitch => $sqitch, name => 'foo', uri => URI::db->new('db:pg:foo'), ); is $target->registry, 'optreg', 'Registry should be "optreg"'; is $target->client, 'optcli', 'Client should be "optcli"'; is $target->plan_file, 'opt.plan', 'Plan file should be "opt.plan"'; isa_ok $target->plan_file, 'Path::Class::File', 'Plan file'; isa_ok $plan = $target->plan, 'App::Sqitch::Plan', 'Plan'; is $plan->file, $target->plan_file, 'Plan should use target plan file'; is $target->top_dir, 'top.dir', 'Top dir should be "top.dir"'; isa_ok $target->top_dir, 'Path::Class::Dir', 'Top dir'; is $target->deploy_dir, 'dep.dir', 'Deploy dir should be "dep.dir"'; isa_ok $target->deploy_dir, 'Path::Class::Dir', 'Deploy dir'; is $target->revert_dir, 'rev.dir', 'Revert dir should be "rev.dir"'; isa_ok $target->revert_dir, 'Path::Class::Dir', 'Revert dir'; is $target->verify_dir, 'ver.dir', 'Verify dir should be "ver.dir"'; isa_ok $target->verify_dir, 'Path::Class::Dir', 'Verify dir'; is $target->reworked_dir, 'wrk.dir', 'Reworked dir should be "wrk.dir"'; isa_ok $target->reworked_dir, 'Path::Class::Dir', 'Reworked dir'; is $target->reworked_deploy_dir, 'rdep.dir', 'Reworked deploy dir should be "rdep.dir"'; isa_ok $target->reworked_deploy_dir, 'Path::Class::Dir', 'Reworked deploy dir'; is $target->reworked_revert_dir, 'rrev.dir', 'Reworked revert dir should be "rrev.dir"'; isa_ok $target->reworked_revert_dir, 'Path::Class::Dir', 'Reworked revert dir'; is $target->reworked_verify_dir, 'rver.dir', 'Reworked verify dir should be "rver.dir"'; isa_ok $target->reworked_verify_dir, 'Path::Class::Dir', 'Reworked verify dir'; is $target->extension, 'opt', 'Extension should be "opt"'; } sub _load($) { my $config = App::Sqitch::Config->new; $config->load_file(file 't', "$_[0].conf"); return $config; } ALL: { # Let's test loading all targets. Start with only core. local $ENV{SQITCH_CONFIG} = file qw(t core.conf); my $sqitch = App::Sqitch->new; ok my @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all targets'; is @targets, 1, 'Should have one target'; is $targets[0]->name, 'db:pg:', 'It should be the generic core enginetarget'; # Now load one with a core target defined. $ENV{SQITCH_CONFIG} = file qw(t core_target.conf); $sqitch = App::Sqitch->new; ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all targets with core target config'; is @targets, 1, 'Should again have one target'; is $targets[0]->name, 'db:pg:whatever', 'It should be the named target'; # Try it with both engine and target defined. $sqitch->config->load_file(file 't', 'core.conf'); ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all targets with core engine and target config'; is @targets, 1, 'Should still have one target'; is $targets[0]->name, 'db:pg:whatever', 'It should again be the named target'; # Great, now let's load one with some engines in it. $ENV{SQITCH_CONFIG} = file qw(t user.conf); $sqitch = App::Sqitch->new; ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all user conf targets'; is @targets, 4, 'Should have four user targets'; is_deeply [ sort map { $_->name } @targets ], [ 'db:firebird:', 'db:mysql:', 'db:pg://postgres@localhost/thingies', 'db:sqlite:my.db', ], 'Should have all the engine targets'; # Load one with targets. $ENV{SQITCH_CONFIG} = file qw(t target.conf); $sqitch = App::Sqitch->new; ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all target conf targets'; is @targets, 4, 'Should have three targets'; is $targets[0]->name, 'db:pg:', 'Core engine should be default target'; is_deeply [ sort map { $_->name } @targets ], [qw(db:pg: dev prod qa)], 'Should have the core target plus the named targets'; # Load one with engins and targets. $ENV{SQITCH_CONFIG} = file qw(t local.conf); $sqitch = App::Sqitch->new; ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all local conf targets'; is @targets, 2, 'Should have two local targets'; is $targets[0]->name, 'mydb', 'Core engine should be lead to default target'; is_deeply [ sort map { $_->name } @targets ], [qw(devdb mydb)], 'Should have the core target plus the named targets'; # Mix up a core engine, engines, and targets. $ENV{SQITCH_CONFIG} = file qw(t engine.conf); $sqitch = App::Sqitch->new; ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all engine conf targets'; is @targets, 3, 'Should have three engine conf targets'; is_deeply [ sort map { $_->name } @targets ], [qw(db:mysql://root@/foo db:pg:try widgets)], 'Should have the engine and target targets'; } done_testing; App-Sqitch-0.9996/t/target_cmd.t000644 000767 000024 00000064313 13133201371 016601 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 330; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::Exception; use Test::Dir; use Test::File qw(file_not_exists_ok file_exists_ok); use Test::NoWarnings; use File::Copy; use Path::Class; use File::Temp 'tempdir'; use lib 't/lib'; use MockOutput; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; # Circumvent Config::Gitlike bug on Windows. # https://rt.cpan.org/Ticket/Display.html?id=96670 $ENV{HOME} ||= '~'; my $CLASS = 'App::Sqitch::Command::target'; ############################################################################## # Set up a test directory and config file. my $tmp_dir = tempdir CLEANUP => 1; File::Copy::copy file(qw(t target.conf))->stringify, "$tmp_dir" or die "Cannot copy t/target.conf to $tmp_dir: $!\n"; File::Copy::copy file(qw(t engine sqitch.plan))->stringify, "$tmp_dir" or die "Cannot copy t/engine/sqitch.plan to $tmp_dir: $!\n"; chdir $tmp_dir; $ENV{SQITCH_CONFIG} = 'target.conf'; my $psql = 'psql' . ($^O eq 'MSWin32' ? '.exe' : ''); ############################################################################## # Load a target command and test the basics. ok my $sqitch = App::Sqitch->new, 'Load a sqitch sqitch object'; my $config = $sqitch->config; isa_ok my $cmd = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'target', config => $config, }), $CLASS, 'Target command'; can_ok $cmd, qw( options configure execute list add set_uri set_registry set_client remove rename rm show ); is_deeply [$CLASS->options], [qw( verbose|v+ uri=s plan-file=s registry=s client=s extension=s top-dir=s dir|d=s% )], 'Options should be correct'; # Check default property values. is $cmd->verbose, 0, 'Default verbosity should be 0'; is_deeply $cmd->properties, {}, 'Default properties should be empty'; # Make sure configure ignores config file. is_deeply $CLASS->configure({ foo => 'bar'}, { verbose => 2 }), { verbose => 2, properties => {} }, 'configure() should ignore config file'; ok my $conf = $CLASS->configure({}, { top_dir => 'top', plan_file => 'my.plan', registry => 'bats', client => 'cli', extension => 'ddl', uri => 'db:pg:foo', dir => { deploy => 'dep', revert => 'rev', verify => 'ver', reworked => 'wrk', reworked_deploy => 'rdep', reworked_revert => 'rrev', reworked_verify => 'rver', }, }), 'Get full config'; is_deeply $conf->{properties}, { top_dir => 'top', plan_file => 'my.plan', registry => 'bats', client => 'cli', extension => 'ddl', uri => URI->new('db:pg:foo'), deploy_dir => 'dep', revert_dir => 'rev', verify_dir => 'ver', reworked_dir => 'wrk', reworked_deploy_dir => 'rdep', reworked_revert_dir => 'rrev', reworked_verify_dir => 'rver', }, 'Should have properties'; isa_ok $conf->{properties}{$_}, 'Path::Class::File', "$_ file attribute" for qw( plan_file ); isa_ok $conf->{properties}{$_}, 'Path::Class::Dir', "$_ directory attribute" for ( 'top_dir', 'reworked_dir', map { ($_, "reworked_$_") } qw(deploy_dir revert_dir verify_dir) ); # Make sure invalid directories are ignored. throws_ok { $CLASS->new($CLASS->configure({}, { dir => { foo => 'bar' }, })) } 'App::Sqitch::X', 'Should fail on invalid directory name'; is $@->ident, 'target', 'Invalid directory ident should be "target"'; is $@->message, __x( 'Unknown directory name: {prop}', prop => 'foo', ), 'The invalid directory messsage should be correct'; throws_ok { $CLASS->new($CLASS->configure({}, { dir => { foo => 'bar', cavort => 'ha' }, })) } 'App::Sqitch::X', 'Should fail on invalid directory names'; is $@->ident, 'target', 'Invalid directories ident should be "target"'; is $@->message, __x( 'Unknown directory names: {props}', props => 'cavort, foo', ), 'The invalid properties messsage should be correct'; ############################################################################## # Test list(). ok $cmd->list, 'Run list()'; is_deeply +MockOutput->get_emit, [['dev'], ['prod'], ['qa']], 'The list of targets should have been output'; # Make it verbose. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, verbose => 1 }), $CLASS, 'Verbose target'; ok $cmd->list, 'Run verbose list()'; is_deeply +MockOutput->get_emit, [ ["dev\tdb:pg:widgets"], ["prod\tdb:pg://prod.example.us/pr_widgets"], ["qa\tdb:pg://qa.example.com/qa_widgets"] ], 'The list of targets and their URIs should have been output'; ############################################################################## # Test add(). MISSINGARGS: { # Test handling of no name. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->add } qr/USAGE/, 'No name arg to add() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; @args = (); throws_ok { $cmd->add('foo') } qr/USAGE/, 'No URI arg to add() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should die on existing key. throws_ok { $cmd->add('dev', 'db:pg:') } 'App::Sqitch::X', 'Should get error for existing target'; is $@->ident, 'target', 'Existing target error ident should be "target"'; is $@->message, __x( 'Target "{target}" already exists', target => 'dev' ), 'Existing target error message should be correct'; # Now add a new target. dir_not_exists_ok $_ for qw(deploy revert verify); ok $cmd->add('test', 'db:pg:test'), 'Add target "test"'; dir_exists_ok $_ for qw(deploy revert verify); $config->load; is $config->get(key => 'target.test.uri'), 'db:pg:test', 'Target "test" URI should have been set'; for my $key (qw( client registry top_dir plan_file deploy_dir revert_dir verify_dir extension )) { is $config->get(key => "target.test.$key"), undef, qq{Target "test" should have no $key set}; } # Try adding a target with a registry. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { registry => 'meta' }, }), $CLASS, 'Target with registry'; ok $cmd->add('withreg', 'db:pg:withreg'), 'Add target "withreg"'; $config->load; is $config->get(key => 'target.withreg.uri'), 'db:pg:withreg', 'Target "withreg" URI should have been set'; is $config->get(key => 'target.withreg.registry'), 'meta', 'Target "withreg" registry should have been set'; for my $key (qw( client top_dir plan_file deploy_dir revert_dir verify_dir extension) ) { is $config->get(key => "target.withreg.$key"), undef, qq{Target "test" should have no $key set}; } # Try a client. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { client => 'hi.exe' }, }), $CLASS, 'Target with client'; ok $cmd->add('withcli', 'db:pg:withcli'), 'Add target "withcli"'; $config->load; is $config->get(key => 'target.withcli.uri'), 'db:pg:withcli', 'Target "withcli" URI should have been set'; is $config->get(key => 'target.withcli.client'), 'hi.exe', 'Target "withcli" should have client set'; for my $key (qw( registry top_dir plan_file deploy_dir revert_dir verify_dir extension) ) { is $config->get(key => "target.withcli.$key"), undef, qq{Target "withcli" should have no $key set}; } # Try both. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { client => 'ack', registry => 'foo' }, }), $CLASS, 'Target with client and registry'; ok $cmd->add('withboth', 'db:pg:withboth'), 'Add target "withboth"'; $config->load; is $config->get(key => 'target.withboth.uri'), 'db:pg:withboth', 'Target "withboth" URI should have been set'; is $config->get(key => 'target.withboth.registry'), 'foo', 'Target "withboth" registry should have been set'; is $config->get(key => 'target.withboth.client'), 'ack', 'Target "withboth" should have client set'; for my $key (qw( top_dir plan_file deploy_dir revert_dir verify_dir extension) ) { is $config->get(key => "target.withboth.$key"), undef, qq{Target "withboth" should have no $key set}; } # Try all the properties. my %props = ( client => 'poo', registry => 'reg', top_dir => dir('top'), plan_file => file('my.plan'), deploy_dir => dir('dep'), revert_dir => dir('rev'), verify_dir => dir('ver'), reworked_dir => dir('r'), reworked_deploy_dir => dir('r/d'), extension => 'ddl', ); isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { %props }, }), $CLASS, 'Target with all properties'; file_not_exists_ok 'my.plan'; dir_not_exists_ok dir $_ for qw(top/deploy top/revert top/verify r/d r/revert r/verify); ok $cmd->add('withall', 'db:pg:withall'), 'Add target "withall"'; dir_exists_ok dir $_ for qw(top/deploy top/revert top/verify r/d r/revert r/verify); file_exists_ok 'my.plan'; $config->load; is $config->get(key => "target.withall.uri"), 'db:pg:withall', qq{Target "withall" should have uri set}; while (my ($k, $v) = each %props) { is $config->get(key => "target.withall.$k"), $v, qq{Target "withall" should have $k set}; } ############################################################################## # Test alter(). isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, }), $CLASS, 'Target with no properties'; MISSINGARGS: { # Test handling of no name. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->alter } qr/USAGE/, 'No name arg to alter() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should die on missing key. throws_ok { $cmd->alter('nonesuch') } 'App::Sqitch::X', 'Should get error for missing target'; is $@->ident, 'target', 'Missing target error ident should be "target"'; is $@->message, __x( 'Missing Target "{target}"; use "{command}" to add it', target => 'nonesuch', command => 'add nonesuch $uri', ), 'Missing target error message should be correct'; # Should include the URI, if present, in the error message. $cmd->properties->{uri} = URI::db->new('db:pg:'); throws_ok { $cmd->alter('nonesuch') } 'App::Sqitch::X', 'Should get error for missing target with URI'; is $@->ident, 'target', 'Missing target with URI error ident should be "target"'; is $@->message, __x( 'Missing Target "{target}"; use "{command}" to add it', target => 'nonesuch', command => 'add nonesuch db:pg:', ), 'Missing target error message should include URI'; # Try all the properties. %props = ( uri => URI->new('db:firebird:bar'), client => 'argh', registry => 'migrations', top_dir => dir('fb'), plan_file => file('fb.plan'), deploy_dir => dir('fb/dep'), revert_dir => dir('fb/rev'), verify_dir => dir('fb/ver'), reworked_dir => dir('fb/r'), reworked_deploy_dir => dir('fb/r/d'), extension => 'fbsql', ); isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { %props }, }), $CLASS, 'Target with more properties'; ok $cmd->alter('withall'), 'Alter target "withall"'; $config->load; while (my ($k, $v) = each %props) { is $config->get(key => "target.withall.$k"), $v, qq{Target "withall" should have $k set}; } # Try changing the top directory. isa_ok $cmd = $CLASS->new({ sqitch => $sqitch, properties => { top_dir => dir 'big' }, }), $CLASS, 'Target with new top_dir property'; dir_not_exists_ok dir $_ for qw(big big/deploy big/revert big/verify); ok $cmd->alter('withall'), 'Alter target "withall"'; dir_exists_ok dir $_ for qw(big big/deploy big/revert big/verify); $config->load; is $config->get(key => 'target.withall.top_dir'), 'big', 'The withall top_dir should have been set'; ############################################################################## # Test set_uri(). MISSINGARGS: { # Test handling of no name. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->set_uri } qr/USAGE/, 'No name arg to set_uri() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; @args = (); throws_ok { $cmd->set_uri('foo') } qr/USAGE/, 'No URI arg to set_uri() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should get an error if the target does not exist. throws_ok { $cmd->set_uri('nonexistent', 'db:pg:' ) } 'App::Sqitch::X', 'Should get error for nonexistent target'; is $@->ident, 'target', 'Nonexistent target error ident should be "target"'; is $@->message, __x( 'Unknown target "{target}"', target => 'nonexistent' ), 'Nonexistent target error message should be correct'; # Set one that exists. ok $cmd->set_uri('withboth', 'db:pg:newuri'), 'Set new URI'; $config->load; is $config->get(key => 'target.withboth.uri'), 'db:pg:newuri', 'Target "withboth" should have new URI'; # Make sure the URI is a database URI. ok $cmd->set_uri('withboth', 'postgres:stuff'), 'Set new URI'; $config->load; is $config->get(key => 'target.withboth.uri'), 'db:postgres:stuff', 'Target "withboth" should have new DB URI'; ############################################################################## # Test other set_* methods for my $key (keys %props) { next if $key =~ /^reworked/; my $meth = "set_$key"; MISSINGARGS: { # Test handling of no name. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->$meth } qr/USAGE/, "No name arg to $meth() should yield usage"; is_deeply \@args, [$cmd], 'No args should be passed to usage'; @args = (); throws_ok { $cmd->$meth('foo') } qr/USAGE/, "No $key arg to $meth() should yield usage"; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should get an error if the target does not exist. throws_ok { $cmd->$meth('nonexistent', 'shake' ) } 'App::Sqitch::X', 'Should get error for nonexistent target'; is $@->ident, 'target', 'Nonexistent target error ident should be "target"'; is $@->message, __x( 'Unknown target "{target}"', target => 'nonexistent' ), 'Nonexistent target error message should be correct'; # Set one that exists. ok $cmd->$meth('withboth', 'rock'), 'Set new $key'; $config->load; my $exp = $key eq 'uri' ? 'db:rock' : 'rock'; is $config->get(key => "target.withboth.$key"), $exp, qq{Target "withboth" should have new $key}; } ############################################################################## # Test rename. MISSINGARGS: { # Test handling of no names. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->rename } qr/USAGE/, 'No name args to rename() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; @args = (); throws_ok { $cmd->rename('foo') } qr/USAGE/, 'No second arg to rename() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should get an error if the target does not exist. throws_ok { $cmd->rename('nonexistent', 'existant' ) } 'App::Sqitch::X', 'Should get error for nonexistent target'; is $@->ident, 'target', 'Nonexistent target error ident should be "target"'; is $@->message, __x( 'Unknown target "{target}"', target => 'nonexistent' ), 'Nonexistent target error message should be correct'; # Rename one that exists. ok $cmd->rename('withboth', 'àlafois'), 'Rename'; $config->load; ok $config->get(key => "target.àlafois.uri"), qq{Target "àlafois" should now be present}; is $config->get(key => "target.withboth.uri"), undef, qq{Target "withboth" should no longer be present}; # Make sure we die on dependencies. $config->group_set( $config->local_file, [ {key => 'core.target', value => 'prod'}, {key => 'engine.firebird.target', value => 'prod'}, ]); $cmd->sqitch->config->load; # Should get an error for a target with dependencies. throws_ok { $cmd->rename('prod', 'fodder' ) } 'App::Sqitch::X', 'Should get error renaming a target with dependencies'; is $@->ident, 'target', 'Dependency target error ident should be "target"'; is $@->message, __x( q{Cannot rename target "{target}" because it's referenced by: {engines}}, target => 'prod', engines => 'core.target, engine.firebird.target', ), 'Dependency target error message should be correct'; ############################################################################## # Test remove. MISSINGARGS: { # Test handling of no names. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->remove } qr/USAGE/, 'No name args to remove() should yield usage'; is_deeply \@args, [$cmd], 'No args should be passed to usage'; } # Should get an error if the target does not exist. throws_ok { $cmd->remove('nonexistent', 'existant' ) } 'App::Sqitch::X', 'Should get error for nonexistent target'; is $@->ident, 'target', 'Nonexistent target error ident should be "target"'; is $@->message, __x( 'Unknown target "{target}"', target => 'nonexistent' ), 'Nonexistent target error message should be correct'; # Remove one that exists. ok $cmd->remove('àlafois'), 'Remove'; $config->load; is $config->get(key => "target.àlafois.uri"), undef, qq{Target "àlafois" should now be gone}; throws_ok { $cmd->remove('prod' ) } 'App::Sqitch::X', 'Should get error removing a target with dependencies'; is $@->ident, 'target', 'Dependency target error ident should be "target"'; is $@->message, __x( q{Cannot rename target "{target}" because it's referenced by: {engines}}, target => 'prod', engines => 'core.target, engine.firebird.target', ), 'Dependency target error message should be correct'; ############################################################################## # Test show. ok $cmd->show, 'Run show()'; is_deeply +MockOutput->get_emit, [ ['dev'], ['prod'], ['qa'], ['test'], ['withall'], ['withcli'], ['withreg'] ], 'Show with no names should emit the list of targets'; # Try one target. ok $cmd->show('dev'), 'Show dev'; is_deeply +MockOutput->get_emit, [ ['* dev'], [' ', 'URI: ', 'db:pg:widgets'], [' ', 'Registry: ', 'sqitch'], [' ', 'Client: ', $psql], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'sqitch.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ], 'The "dev" target should have been shown'; # Try a target with a non-default client. ok $cmd->show('withcli'), 'Show withcli'; is_deeply +MockOutput->get_emit, [ ['* withcli'], [' ', 'URI: ', 'db:pg:withcli'], [' ', 'Registry: ', 'sqitch'], [' ', 'Client: ', 'hi.exe'], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'sqitch.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ], 'The "with_cli" target should have been shown'; # Try a target with a non-default registry. ok $cmd->show('withreg'), 'Show withreg'; is_deeply +MockOutput->get_emit, [ ['* withreg'], [' ', 'URI: ', 'db:pg:withreg'], [' ', 'Registry: ', 'meta'], [' ', 'Client: ', $psql], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'sqitch.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ], 'The "with_reg" target should have been shown'; # Try multiples. ok $cmd->show(qw(dev qa withreg)), 'Show three targets'; is_deeply +MockOutput->get_emit, [ ['* dev'], [' ', 'URI: ', 'db:pg:widgets'], [' ', 'Registry: ', 'sqitch'], [' ', 'Client: ', $psql], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'sqitch.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ['* qa'], [' ', 'URI: ', 'db:pg://qa.example.com/qa_widgets'], [' ', 'Registry: ', 'meta'], [' ', 'Client: ', '/usr/sbin/psql'], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'sqitch.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ['* withreg'], [' ', 'URI: ', 'db:pg:withreg'], [' ', 'Registry: ', 'meta'], [' ', 'Client: ', $psql], [' ', 'Top Directory: ', '.'], [' ', 'Plan File: ', 'sqitch.plan'], [' ', 'Extension: ', 'sql'], [' ', 'Script Directories:'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], [' ', 'Reworked Script Directories:'], [' ', ' Reworked: ', '.'], [' ', ' Deploy: ', 'deploy'], [' ', ' Revert: ', 'revert'], [' ', ' Verify: ', 'verify'], ], 'All three targets should have been shown'; ############################################################################## # Test execute(). isa_ok $cmd = $CLASS->new({ sqitch => $sqitch }), $CLASS, 'Simple target'; for my $spec ( [ undef, 'list' ], [ 'list' ], [ 'add' ], [ 'set-uri' ], [ 'set-url', 'set_uri' ], [ 'set-registry' ], [ 'set-client' ], [ 'remove' ], [ 'rm', 'remove' ], [ 'rename' ], [ 'show' ], ) { my ($arg, $meth) = @{ $spec }; $meth //= $arg; $meth =~ s/-/_/g; my $mocker = Test::MockModule->new($CLASS); my @args; $mocker->mock($meth => sub { @args = @_ }); ok $cmd->execute($spec->[0]), "Execute " . ($spec->[0] // 'undef'); is_deeply \@args, [$cmd], "$meth() should have been called"; # Make sure args are passed. ok $cmd->execute($spec->[0], qw(foo bar)), "Execute " . ($spec->[0] // 'undef') . ' with args'; is_deeply \@args, [$cmd, qw(foo bar)], "$meth() should have been passed args"; } # Make sure an invalid action dies with a usage statement. MISSINGARGS: { # Test handling of no names. my $mock = Test::MockModule->new($CLASS); my @args; $mock->mock(usage => sub { @args = @_; die 'USAGE' }); throws_ok { $cmd->execute('nonexistent') } qr/USAGE/, 'Should get an exception for a nonexistent action'; is_deeply \@args, [$cmd, __x( 'Unknown action "{action}"', action => 'nonexistent', )], 'Nonexistent action message should be passed to usage'; } ############################################################################## # Test URI validation. for my $val ( 'rock', 'http://www.google.com/', ) { my $uri = URI->new($val); throws_ok { $CLASS->new({ sqitch => $sqitch, properties => { uri => $uri } }) } 'App::Sqitch::X', "Invalid URI $val should throw an error"; is $@->ident, 'target', qq{Invalid URI $val error ident should be "target"}; is $@->message, __x( 'URI "{uri}" is not a database URI', uri => $uri, ), qq{Invalid URI $val error message should be correct}; } my $uri = URI->new('db:'); throws_ok { $CLASS->new({ sqitch => $sqitch, properties => { uri => $uri } }) } 'App::Sqitch::X', 'Engineless URI should throw an error'; is $@->ident, 'target', 'Engineless URI error ident should be "target"'; is $@->message, __x( 'No database engine in URI "{uri}"', uri => $uri, ), 'Engineless URI error message should be correct'; $uri = URI->new('db:nonesuch:foo'); throws_ok { $CLASS->new({ sqitch => $sqitch, properties => { uri => $uri } }) } 'App::Sqitch::X', 'Unknown engine URI should throw an error'; is $@->ident, 'target', 'Unknown engine URI error ident should be "target"'; is $@->message, __x( 'Unknown engine "{engine}" in URI "{uri}"', uri => $uri, engine => 'nonesuch', ), 'Unknown engine URI error message should be correct'; App-Sqitch-0.9996/t/templates.conf000644 000767 000024 00000000437 13133201371 017145 0ustar00davidstaff000000 000000 [core] engine = pg [add] deploy_template = etc/templates/deploy/pg.tmpl revert_template = etc/templates/revert/pg.tmpl verify_template = etc/templates/revert/pg.tmpl [add "templates"] test = etc/templates/verify/pg.tmpl verify = etc/templates/verify/pg.tmpl App-Sqitch-0.9996/t/upgrade.t000644 000767 000024 00000006765 13133201371 016126 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use utf8; use Test::More tests => 22; #use Test::More 'no_plan'; use App::Sqitch; use Locale::TextDomain qw(App-Sqitch); use Test::NoWarnings; use Test::Exception; use Test::MockModule; use Path::Class; use lib 't/lib'; use MockOutput; my $CLASS = 'App::Sqitch::Command::upgrade'; require_ok $CLASS; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; ok my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', top_dir => Path::Class::Dir->new('test-upgrade'), }, ), 'Load a sqitch object'; my $config = $sqitch->config; isa_ok my $upgrade = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'upgrade', config => $config, }), $CLASS, 'upgrade command'; can_ok $upgrade, qw( target options execute configure ); is_deeply [ $CLASS->options ], [qw( target|t=s )], 'Options should be correct'; # Start with the engine up-to-date. my $engine_mocker = Test::MockModule->new('App::Sqitch::Engine::sqlite'); my $registry_version = App::Sqitch::Engine->registry_release; my $upgrade_called = 0; $engine_mocker->mock(registry_version => sub { $registry_version }); $engine_mocker->mock(upgrade_registry => sub { $upgrade_called = 1 }); ok $upgrade->execute, 'Execute upgrade'; ok !$upgrade_called, 'Upgrade should not have been called'; is_deeply +MockOutput->get_info, [[__x( 'Registry {registry} is up-to-date at version {version}', registry => 'db:sqlite:', version => App::Sqitch::Engine->registry_release, )]], 'Should get output for up-to-date registry'; # Pass in a different target. ok $upgrade->execute('db:sqlite:foo.db'), 'Execute upgrade with target'; ok !$upgrade_called, 'Upgrade should again not have been called'; is_deeply +MockOutput->get_info, [[__x( 'Registry {registry} is up-to-date at version {version}', registry => 'db:sqlite:sqitch.db', version => App::Sqitch::Engine->registry_release, )]], 'Should get output for up-to-date registry with target'; # Pass in an engine. ok $upgrade->execute('sqlite'), 'Execute upgrade with engine'; ok !$upgrade_called, 'Upgrade should again not have been called'; is_deeply +MockOutput->get_info, [[__x( 'Registry {registry} is up-to-date at version {version}', registry => 'db:sqlite:', version => App::Sqitch::Engine->registry_release, )]], 'Should get output for up-to-date registry with target'; # Specify a target as an option. isa_ok $upgrade = App::Sqitch::Command->load({ sqitch => $sqitch, command => 'upgrade', config => $config, args => [qw(--target db:sqlite:my.sqlite)], }), $CLASS, 'upgrade command with target'; ok $upgrade->execute, 'Execute upgrade with target option'; ok !$upgrade_called, 'Upgrade should still not have been called'; is_deeply +MockOutput->get_info, [[__x( 'Registry {registry} is up-to-date at version {version}', registry => 'db:sqlite:sqitch.sqlite', version => App::Sqitch::Engine->registry_release, )]], 'Should get output for up-to-date registry with target option'; # Now make it upgrade. $registry_version = 0.1; ok $upgrade->execute, 'Execute upgrade with out-of-date registry'; ok $upgrade_called, 'Upgrade should now have been called'; is_deeply +MockOutput->get_info, [[__x( 'Upgrading registry {registry} to version {version}', registry => 'db:sqlite:sqitch.sqlite', version => App::Sqitch::Engine->registry_release, )]], 'Should get output for the upgrade'; App-Sqitch-0.9996/t/user.conf000644 000767 000024 00000000743 13133201371 016125 0ustar00davidstaff000000 000000 [user] name = Michael Stonebraker email = michael@example.com [engine "pg"] client = /opt/local/pgsql/bin/psql target = db:pg://postgres@localhost/thingies registry = meta [engine "mysql"] client = /opt/local/mysql/bin/mysql registry = meta [engine "sqlite"] client = /opt/local/bin/sqlite3 registry = meta target = db:sqlite:my.db [engine "firebird"] client = /opt/firebird/bin/isql registry = meta App-Sqitch-0.9996/t/verify.t000644 000767 000024 00000016341 13133201371 015772 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use warnings; use 5.010; use Test::More; use App::Sqitch; use Path::Class qw(dir file); use Test::MockModule; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use lib 't/lib'; use MockOutput; my $CLASS = 'App::Sqitch::Command::verify'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; isa_ok $CLASS, 'App::Sqitch::Command'; can_ok $CLASS, qw( target options configure new from_change to_change variables ); is_deeply [$CLASS->options], [qw( target|t=s from-change|from=s to-change|to=s from-target=s to-target=s set|s=s% )], 'Options should be correct'; my $sqitch = App::Sqitch->new( options => { engine => 'sqlite', plan_file => file(qw(t sql sqitch.plan))->stringify, top_dir => dir(qw(t sql))->stringify, }, ); my $config = $sqitch->config; # Test configure(). is_deeply $CLASS->configure($config, {}), { }, 'Should have default configuration with no config or opts'; is_deeply $CLASS->configure($config, { from_change => 'foo', to_change => 'bar', set => { foo => 'bar' }, }), { from_change => 'foo', to_change => 'bar', variables => { foo => 'bar' }, }, 'Should have changes and variables from options'; CONFIG: { my $mock_config = Test::MockModule->new(ref $config); my %config_vals; $mock_config->mock(get => sub { my ($self, %p) = @_; return $config_vals{ $p{key} }; }); $mock_config->mock(get_section => sub { my ($self, %p) = @_; return $config_vals{ $p{section} }; }); %config_vals = ( 'verify.variables' => { foo => 'bar', hi => 21 }, ); is_deeply $CLASS->configure($config, {}), {}, 'Should have no config if no options'; # Try merging. is_deeply $CLASS->configure($config, { to_change => 'whu', set => { foo => 'yo', yo => 'stellar' }, }), { to_change => 'whu', variables => { foo => 'yo', yo => 'stellar', hi => 21 }, }, 'Should have merged variables'; isa_ok my $verify = $CLASS->new(sqitch => $sqitch), $CLASS; is_deeply $verify->variables, { foo => 'bar', hi => 21 }, 'Should pick up variables from configuration'; } ############################################################################## # Test accessors. isa_ok my $verify = $CLASS->new( sqitch => $sqitch, target => 'foo', ), $CLASS, 'new status with target'; is $verify->target, 'foo', 'Should have target "foo"'; isa_ok $verify = $CLASS->new(sqitch => $sqitch), $CLASS; is $verify->target, undef, 'Default target should be undef'; is $verify->from_change, undef, 'from_change should be undef'; is $verify->to_change, undef, 'to_change should be undef'; # Mock the engine interface. my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite'); my @args; $mock_engine->mock(verify => sub { shift; @args = @_ }); my @vars; $mock_engine->mock(set_variables => sub { shift; @vars = @_ }); ok $verify->execute, 'Execute with nothing.'; is_deeply \@args, [undef, undef], 'Two undefs should be passed to the engine'; is_deeply +MockOutput->get_warn, [], 'Should have no warnings'; ok $verify->execute('@alpha'), 'Execute from "@alpha"'; is_deeply \@args, ['@alpha', undef], '"@alpha" and undef should be passed to the engine'; is_deeply +MockOutput->get_warn, [], 'Should again have no warnings'; ok $verify->execute('@alpha', '@beta'), 'Execute from "@alpha" to "@beta"'; is_deeply \@args, ['@alpha', '@beta'], '"@alpha" and "@beat" should be passed to the engine'; is_deeply +MockOutput->get_warn, [], 'Should still have no warnings'; isa_ok $verify = $CLASS->new( sqitch => $sqitch, from_change => 'foo', to_change => 'bar', variables => { foo => 'bar', one => 1 }, ), $CLASS, 'Object with from, to, and variables'; ok $verify->execute, 'Execute again'; is_deeply \@args, ['foo', 'bar'], '"foo" and "bar" should be passed to the engine'; is_deeply {@vars}, { foo => 'bar', one => 1 }, 'Vars should have been passed through to the engine'; is_deeply +MockOutput->get_warn, [], 'Still should have no warnings'; # Pass and specify changes. ok $verify->execute('roles', 'widgets'), 'Execute with command-line args'; is_deeply \@args, ['foo', 'bar'], '"foo" and "bar" should be passed to the engine'; is_deeply {@vars}, { foo => 'bar', one => 1 }, 'Vars should have been passed through to the engine'; is_deeply +MockOutput->get_warn, [[__x( 'Too many changes specified; verifying from "{from}" to "{to}"', from => 'foo', to => 'bar', )]], 'Should have warning about which roles are used'; # Pass a target. my $target = 'db:pg:'; my $mock_cmd = Test::MockModule->new(ref $verify); my ($target_name_arg, $orig_meth); $mock_cmd->mock(parse_args => sub { my $self = shift; my %p = @_; my @ret = $self->$orig_meth(@_); $target_name_arg = $ret[0][0]->name; $ret[0][0] = $self->default_target; return @ret; }); $orig_meth = $mock_cmd->original('parse_args'); ok $verify->execute($target), 'Execute with target arg'; is $target_name_arg, $target, 'The target should have been passed to the engine'; is_deeply \@args, ['foo', 'bar'], '"foo" and "bar" should be passed to the engine'; is_deeply {@vars}, { foo => 'bar', one => 1 }, 'Vars should have been passed through to the engine'; is_deeply +MockOutput->get_warn, [], 'Should once again have no warnings'; # Pass a --target option. isa_ok $verify = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS, 'Object with target'; $target_name_arg = undef; @vars = (); ok $verify->execute, 'Execute with no args'; is $target_name_arg, $target, 'The target option should have been passed to the engine'; is_deeply \@args, [undef, undef], 'Undefs should be passed to the engine'; is_deeply {@vars}, {}, 'No vars should have been passed through to the engine'; is_deeply +MockOutput->get_warn, [], 'Should once again have no warnings'; # Pass a target, get a warning. ok $verify->execute('db:sqlite:', 'roles', 'widgets'), 'Execute with two targegs and two changes'; is $target_name_arg, $target, 'The target option should have been passed to the engine'; is_deeply \@args, ['roles', 'widgets'], 'The two changes should be passed to the engine'; is_deeply {@vars}, {}, 'No vars should have been passed through to the engine'; is_deeply +MockOutput->get_warn, [[__x( 'Too many targets specified; connecting to {target}', target => $verify->default_target->name, )]], 'Should have warning about too many targets'; # Make sure we get an exception for unknown args. throws_ok { $verify->execute(qw(greg)) } 'App::Sqitch::X', 'Should get an exception for unknown arg'; is $@->ident, 'verify', 'Unknow arg ident should be "verify"'; is $@->message, __x( 'Unknown argument "{arg}"', arg => 'greg', ), 'Should get an exeption for two unknown arg'; throws_ok { $verify->execute(qw(greg jon)) } 'App::Sqitch::X', 'Should get an exception for unknown args'; is $@->ident, 'verify', 'Unknow args ident should be "verify"'; is $@->message, __x( 'Unknown arguments: {arg}', arg => 'greg, jon', ), 'Should get an exeption for two unknown args'; done_testing; App-Sqitch-0.9996/t/vertica.t000644 000767 000024 00000026564 13133201371 016133 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w # To test against a live Vertica database, you must set the VSQL_URI environment variable. # this is a stanard URI::db URI, and should look something like this: # # export VSQL_URI=db:vertica://dbadmin:password@localhost:5433/dbadmin?Driver=Vertica # # Note that it must include the `?Driver=$driver` bit so that DBD::ODBC loads # the proper driver. use strict; use warnings; use 5.010; use Test::More 0.94; use Test::MockModule; use Test::Exception; use Locale::TextDomain qw(App-Sqitch); use Capture::Tiny 0.12 qw(:all); use Try::Tiny; use App::Sqitch; use App::Sqitch::Target; use App::Sqitch::Plan; use lib 't/lib'; use DBIEngineTest; my $CLASS; delete $ENV{"VSQL_$_"} for qw(USER PASSWORD DATABASE HOST PORT); BEGIN { $CLASS = 'App::Sqitch::Engine::vertica'; require_ok $CLASS or die; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.sys'; } is_deeply [$CLASS->config_vars], [ target => 'any', registry => 'any', client => 'any', ], 'config_vars should return three vars'; my $uri = URI::db->new('db:vertica:'); my $sqitch = App::Sqitch->new(options => { engine => 'vertica' }); my $target = App::Sqitch::Target->new( sqitch => $sqitch, uri => $uri, ); isa_ok my $vta = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; my $client = 'vsql' . ($^O eq 'MSWin32' ? '.exe' : ''); is $vta->client, $client, 'client should default to vsql'; is $vta->registry, 'sqitch', 'registry default should be "sqitch"'; is $vta->uri, $uri, 'DB URI should be "db:vertica:"'; my $dest_uri = $uri->clone; $dest_uri->dbname($ENV{VERTICADATABASE} || $ENV{VERTICAUSER} || $sqitch->sysuser); is $vta->destination, $dest_uri->as_string, 'Destination should fall back on environment variables'; is $vta->registry_destination, $vta->destination, 'Registry destination should be the same as destination'; my @std_opts = ( '--quiet', '--no-vsqlrc', '--no-align', '--tuples-only', '--set' => 'ON_ERROR_STOP=1', '--set' => 'registry=sqitch', ); is_deeply [$vta->vsql], [$client, @std_opts], 'vsql command should be std opts-only'; isa_ok $vta = $CLASS->new( sqitch => $sqitch, target => $target, ), $CLASS; ok $vta->set_variables(foo => 'baz', whu => 'hi there', yo => 'stellar'), 'Set some variables'; is_deeply [$vta->vsql], [ $client, '--set' => 'foo=baz', '--set' => 'whu=hi there', '--set' => 'yo=stellar', @std_opts, ], 'Variables should be passed to vsql via --set'; ############################################################################## # Test other configs for the target. ENV: { # Make sure we override system-set vars. local $ENV{VERTICADATABASE}; local $ENV{VERTICAUSER}; for my $env (qw(VERTICADATABASE VERTICAUSER)) { my $vta = $CLASS->new(sqitch => $sqitch, target => $target); local $ENV{$env} = "\$ENV=whatever"; is $vta->target->name, "db:vertica:", "Target name should not read \$$env"; is $vta->registry_destination, $vta->destination, 'Meta target should be the same as destination'; } my $mocker = Test::MockModule->new('App::Sqitch'); $mocker->mock(sysuser => 'sysuser=whatever'); my $vta = $CLASS->new(sqitch => $sqitch, target => $target); is $vta->target->name, 'db:vertica:', 'Target name should not fall back on sysuser'; is $vta->registry_destination, $vta->destination, 'Meta target should be the same as destination'; $ENV{VERTICADATABASE} = 'mydb'; $vta = $CLASS->new(sqitch => $sqitch, username => 'hi', target => $target); is $vta->target->name, 'db:vertica:', 'Target name should be the default'; is $vta->registry_destination, $vta->destination, 'Meta target should be the same as destination'; } ############################################################################## # Make sure config settings override defaults. my %config = ( 'engine.vertica.client' => '/path/to/vsql', 'engine.vertica.target' => 'db:vertica://localhost/try', 'engine.vertica.registry' => 'meta', ); $std_opts[-1] = 'registry=meta'; my $mock_config = Test::MockModule->new('App::Sqitch::Config'); $mock_config->mock(get => sub { $config{ $_[2] } }); $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok $vta = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another vertica'; is $vta->client, '/path/to/vsql', 'client should be as configured'; is $vta->uri->as_string, 'db:vertica://localhost/try', 'uri should be as configured'; is $vta->registry, 'meta', 'registry should be as configured'; is_deeply [$vta->vsql], [qw( /path/to/vsql --dbname try --host localhost ), @std_opts], 'vsql command should be configured from URI config'; ############################################################################## # Now make sure that (deprecated?) Sqitch options override configurations. $sqitch = App::Sqitch->new( options => { engine => 'vertica', client => '/some/other/vsql', }, ); $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok $vta = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a vertica with sqitch with options'; is $vta->client, '/some/other/vsql', 'client should be as optioned'; is_deeply [$vta->vsql], [qw( /some/other/vsql --dbname try --host localhost ), @std_opts], 'vsql command should be as optioned'; ############################################################################## # Test _run(), _capture(), and _spool(). can_ok $vta, qw(_run _capture _spool); my $mock_sqitch = Test::MockModule->new('App::Sqitch'); my (@run, $exp_pass); $mock_sqitch->mock(run => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @run = @_; if (defined $exp_pass) { is $ENV{VSQL_PASSWORD}, $exp_pass, qq{VSQL_PASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{VSQL_PASSWORD}, 'VSQL_PASSWORD should not exist'; } }); my @capture; $mock_sqitch->mock(capture => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @capture = @_; if (defined $exp_pass) { is $ENV{VSQL_PASSWORD}, $exp_pass, qq{VSQL_PASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{VSQL_PASSWORD}, 'VSQL_PASSWORD should not exist'; } }); my @spool; $mock_sqitch->mock(spool => sub { local $Test::Builder::Level = $Test::Builder::Level + 2; shift; @spool = @_; if (defined $exp_pass) { is $ENV{VSQL_PASSWORD}, $exp_pass, qq{VSQL_PASSWORD should be "$exp_pass"}; } else { ok !exists $ENV{VSQL_PASSWORD}, 'VSQL_PASSWORD should not exist'; } }); $exp_pass = 's3cr3t'; $target->uri->password($exp_pass); ok $vta->_run(qw(foo bar baz)), 'Call _run'; is_deeply \@run, [$vta->vsql, qw(foo bar baz)], 'Command should be passed to run()'; ok $vta->_spool('FH'), 'Call _spool'; is_deeply \@spool, ['FH', $vta->vsql], 'Command should be passed to spool()'; ok $vta->_capture(qw(foo bar baz)), 'Call _capture'; is_deeply \@capture, [$vta->vsql, qw(foo bar baz)], 'Command should be passed to capture()'; # Without password. $target = App::Sqitch::Target->new( sqitch => $sqitch ); ok $vta = $CLASS->new(sqitch => $sqitch, target => $target), 'Create a vertica with sqitch with no pw'; $exp_pass = undef; ok $vta->_run(qw(foo bar baz)), 'Call _run again'; is_deeply \@run, [$vta->vsql, qw(foo bar baz)], 'Command should be passed to run() again'; ok $vta->_spool('FH'), 'Call _spool again'; is_deeply \@spool, ['FH', $vta->vsql], 'Command should be passed to spool() again'; ok $vta->_capture(qw(foo bar baz)), 'Call _capture again'; is_deeply \@capture, [$vta->vsql, qw(foo bar baz)], 'Command should be passed to capture() again'; ############################################################################## # Test file and handle running. ok $vta->run_file('foo/bar.sql'), 'Run foo/bar.sql'; is_deeply \@run, [$vta->vsql, '--file', 'foo/bar.sql'], 'File should be passed to run()'; ok $vta->run_handle('FH'), 'Spool a "file handle"'; is_deeply \@spool, ['FH', $vta->vsql], 'Handle should be passed to spool()'; # Verify should go to capture unless verosity is > 1. ok $vta->run_verify('foo/bar.sql'), 'Verify foo/bar.sql'; is_deeply \@capture, [$vta->vsql, '--file', 'foo/bar.sql'], 'Verify file should be passed to capture()'; $mock_sqitch->mock(verbosity => 2); ok $vta->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again'; is_deeply \@run, [$vta->vsql, '--file', 'foo/bar.sql'], 'Verifile file should be passed to run() for high verbosity'; $mock_sqitch->unmock_all; $mock_config->unmock_all; ############################################################################## # Test DateTime formatting stuff. ok my $ts2char = $CLASS->can('_ts2char'), "$CLASS->can('_ts2char')"; is $ts2char->('foo'), q{to_char(foo AT TIME ZONE 'UTC', '"year":YYYY:"month":MM:"day":DD:"hour":HH24:"minute":MI:"second":SS:"time_zone":"UTC"')}, '_ts2char should work'; ok my $dtfunc = $CLASS->can('_dt'), "$CLASS->can('_dt')"; isa_ok my $dt = $dtfunc->( 'year:2012:month:07:day:05:hour:15:minute:07:second:01:time_zone:UTC' ), 'App::Sqitch::DateTime', 'Return value of _dt()'; is $dt->year, 2012, 'DateTime year should be set'; is $dt->month, 7, 'DateTime month should be set'; is $dt->day, 5, 'DateTime day should be set'; is $dt->hour, 15, 'DateTime hour should be set'; is $dt->minute, 7, 'DateTime minute should be set'; is $dt->second, 1, 'DateTime second should be set'; is $dt->time_zone->name, 'UTC', 'DateTime TZ should be set'; ############################################################################## # Can we do live tests? my $dbh; END { return unless $dbh; $dbh->{Driver}->visit_child_handles(sub { my $h = shift; $h->disconnect if $h->{Type} eq 'db' && $h->{Active} && $h ne $dbh; }); $dbh->{RaiseError} = 0; $dbh->{PrintError} = 1; $dbh->do($_) for ( 'DROP SCHEMA sqitch CASCADE', 'DROP SCHEMA __sqitchtest CASCADE', ); } $uri = URI->new($ENV{VSQL_URI} || 'db:dbadmin:password@localhost/dbadmin'); my $err = try { $vta->use_driver; $dbh = DBI->connect($uri->dbi_dsn, $uri->user, $uri->password, { PrintError => 0, RaiseError => 1, AutoCommit => 1, }); undef; } catch { eval { $_->message } || $_; }; DBIEngineTest->run( class => $CLASS, sqitch_params => [options => { engine => 'vertica', top_dir => Path::Class::dir(qw(t engine)), plan_file => Path::Class::file(qw(t engine sqitch.plan)), }], target_params => [ uri => $uri ], alt_target_params => [ uri => $uri, registry => '__sqitchtest' ], skip_unless => sub { my $self = shift; die $err if $err; # Make sure we have vsql and can connect to the database. $self->sqitch->probe( $self->client, '--version' ); $self->_capture('--command' => 'SELECT version()'); }, engine_err_regex => qr/\bERROR \d+:/, init_error => __x( 'Sqitch schema "{schema}" already exists', schema => '__sqitchtest', ), test_dbh => sub { my $dbh = shift; # Make sure the sqitch schema is the first in the search path. is $dbh->selectcol_arrayref('SELECT current_schema')->[0], '__sqitchtest', 'The Sqitch schema should be the current schema'; }, ); done_testing; App-Sqitch-0.9996/t/x.t000644 000767 000024 00000004606 13133201371 014736 0ustar00davidstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More; use Test::Exception; use Try::Tiny; use Path::Class; $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; $ENV{SQITCH_USER_CONFIG} = 'nonexistent.user'; $ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys'; my $CLASS; BEGIN { $CLASS = 'App::Sqitch::X'; require_ok $CLASS or die; $CLASS->import(':all'); } isa_ok my $x = $CLASS->new(ident => 'test', message => 'Die'), $CLASS, 'X object'; for my $role(qw( Throwable StackTrace::Auto )) { ok $x->does($role), "X object does $role"; } # Make sure default ident works. ok $x = $CLASS->new(message => 'whatever'), 'Create X without ident'; is $x->ident, 'DEV', 'Default ident should be "DEV"'; throws_ok { hurl basic => 'OMFG!' } $CLASS; isa_ok $x = $@, $CLASS, 'Thrown object'; is $x->ident, 'basic', 'Ident should be "basic"'; is $x->message, 'OMFG!', 'The message should have been passed'; ok $x->stack_trace->frames, 'It should have a stack trace'; is $x->exitval, 2, 'Exit val should be 2'; is +($x->stack_trace->frames)[0]->filename, file(qw(t x.t)), 'The trace should start in this file'; # NB: Don't use `local $@`, as it does not work on Perls < 5.14. throws_ok { $@ = 'Yo dawg'; hurl 'OMFG!' } $CLASS; isa_ok $x = $@, $CLASS, 'Thrown object'; is $x->ident, 'DEV', 'Ident should be "DEV"'; is $x->message, 'OMFG!', 'The message should have been passed'; is $x->exitval, 2, 'Exit val should again be 2'; is $x->previous_exception, 'Yo dawg', 'Previous exception should have been passed'; throws_ok { hurl {ident => 'blah', message => 'OMFG!', exitval => 1} } $CLASS; isa_ok $x = $@, $CLASS, 'Thrown object'; is $x->message, 'OMFG!', 'The params should have been passed'; is $x->exitval, 1, 'Exit val should be 1'; is $x->as_string, join("\n", grep { defined } $x->message, $x->previous_exception, $x->stack_trace ), 'Stringification should work'; is $x->as_string, "$x", 'Stringification should work'; # Do some actual exception handling. try { hurl io => 'Cannot open file'; } catch { return fail "Not a Sqitch::X: $_" unless eval { $_->isa('App::Sqitch::X') }; is $_->ident, 'io', 'Should be an "io" exception'; }; # Make sure we can goto hurl. try { @_ = (io => 'Cannot open file'); goto &hurl; } catch { return fail "Not a Sqitch::X: $_" unless eval { $_->isa('App::Sqitch::X') }; is $_->ident, 'io', 'Should catch error called via &goto'; }; done_testing; App-Sqitch-0.9996/t/sql/deploy/000755 000767 000024 00000000000 13133201371 016367 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/sql/sqitch.plan000644 000767 000024 00000000515 13133201371 017243 0ustar00davidstaff000000 000000 %project=sql roles 2012-07-16T17:25:07Z Barack Obama users 2012-07-16T17:25:07Z Barack Obama @alpha 2012-07-16T17:25:07Z Barack Obama widgets 2012-07-16T17:25:07Z Barack Obama @beta 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/sql/verify/000755 000767 000024 00000000000 13133201371 016377 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/sql/verify/users.sql000644 000767 000024 00000000062 13133201371 020257 0ustar00davidstaff000000 000000 SELECT nick, name FROM __myapp.users WHERE FALSE; App-Sqitch-0.9996/t/sql/deploy/roles.sql000644 000767 000024 00000000020 13133201371 020224 0ustar00davidstaff000000 000000 -- Create roles.App-Sqitch-0.9996/t/sql/deploy/users.sql000644 000767 000024 00000000044 13133201371 020247 0ustar00davidstaff000000 000000 -- Create users. -- requires: roles App-Sqitch-0.9996/t/sql/deploy/widgets.sql000644 000767 000024 00000000046 13133201371 020556 0ustar00davidstaff000000 000000 -- Create widgets. -- requires: users App-Sqitch-0.9996/t/plans/bad-change.plan000644 000767 000024 00000000261 13133201371 020235 0ustar00davidstaff000000 000000 %project=bad_change # This is a note # And there was a blank line. what what what 2012-07-16T17:25:07Z Barack Obama # OHNOEZ, No white space allowed! App-Sqitch-0.9996/t/plans/changes-only.plan000644 000767 000024 00000000407 13133201371 020655 0ustar00davidstaff000000 000000 %project=changes_only # This is a note # And there was a blank line. hey 2012-07-16T17:25:07Z Barack Obama you 2012-07-16T17:25:07Z Barack Obama whatwhatwhat 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/dependencies.plan000644 000767 000024 00000001134 13133201371 020712 0ustar00davidstaff000000 000000 %project=dependencies +roles 2012-07-16T17:25:07Z Barack Obama +users [roles] 2012-07-16T17:25:07Z Barack Obama +add_user [users roles] 2012-07-16T17:25:07Z Barack Obama +dr_evil 2012-07-16T17:25:07Z Barack Obama @alpha 2012-07-16T17:25:07Z Barack Obama +users [users@alpha] 2012-07-16T17:25:07Z Barack Obama -dr_evil 2012-07-16T17:25:07Z Barack Obama +del_user [!dr_evil users] 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/deploy-and-revert.plan000644 000767 000024 00000001066 13133201371 021631 0ustar00davidstaff000000 000000 %project=deploy_and_revert +hey 2012-07-16T17:25:07Z Barack Obama +you 2012-07-16T17:25:07Z Barack Obama + dr_evil 2012-07-16T17:25:07Z Barack Obama @foo 2012-07-16T17:25:07Z Barack Obama +this/rocks 2012-07-16T17:25:07Z Barack Obama hey-there 2012-07-16T17:25:07Z Barack Obama -dr_evil 2012-07-16T17:25:07Z Barack Obama # revert! @bar 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/dos.plan000644 000767 000024 00000000406 13133201371 017052 0ustar00davidstaff000000 000000 %project=dos # This is a note # And there was a blank line. hey 2012-07-16T17:25:07Z Barack Obama you 2012-07-16T17:25:07Z Barack Obama whatwhatwhat 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/dupe-change-diff-tag.plan000644 000767 000024 00000000635 13133201371 022130 0ustar00davidstaff000000 000000 %project=dupe_change_diff_tag whatever 2012-07-16T17:25:07Z Barack Obama @foo 2012-07-16T17:25:07Z Barack Obama hi 2012-07-16T17:25:07Z Barack Obama @bar 2012-07-16T17:25:07Z Barack Obama greets 2012-07-16T17:25:07Z Barack Obama whatever 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/dupe-change.plan000644 000767 000024 00000000722 13133201371 020446 0ustar00davidstaff000000 000000 %project=dupe_change whatever 2012-07-16T17:25:07Z Barack Obama @foo 2012-07-16T17:25:07Z Barack Obama hi 2012-07-16T17:25:07Z Barack Obama greets 2012-07-16T17:25:07Z Barack Obama tallyho 2012-07-16T17:25:07Z Barack Obama greets 2012-07-16T17:25:07Z Barack Obama @bar 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/dupe-tag.plan000644 000767 000024 00000001115 13133201371 017771 0ustar00davidstaff000000 000000 %project=dupe_tag whatever 2012-07-16T17:25:07Z Barack Obama @foo 2012-07-16T17:25:07Z Barack Obama hi 2012-07-16T17:25:07Z Barack Obama @bar 2012-07-16T17:25:07Z Barack Obama @stink 2012-07-16T17:25:07Z Barack Obama @blah 2012-07-16T17:25:07Z Barack Obama @bar 2012-07-16T17:25:07Z Barack Obama @w00t 2012-07-16T17:25:07Z Barack Obama OHNOEZ 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/multi.plan000644 000767 000024 00000000744 13133201371 017424 0ustar00davidstaff000000 000000 %project=multi # This is a note # And there was a blank line. hey 2012-07-16T17:25:07Z theory you 2012-07-16T17:25:07Z anna @foo 2012-07-16T17:24:07Z julie # look, a tag! this/rocks 2012-07-16T17:25:07Z Barack Obama hey-there 2012-07-16T17:25:07Z Barack Obama # trailing note! @bar 2012-07-16T17:25:07Z Barack Obama @baz 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/pragmas.plan000644 000767 000024 00000000356 13133201371 017723 0ustar00davidstaff000000 000000 % syntax-version=1.0.0 %foo = bar # lolz % project=pragmata % uri=https://github.com/theory/sqitch/ % strict hey 2012-07-16T17:25:07Z Barack Obama you 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/project_deps.plan000644 000767 000024 00000001167 13133201371 020753 0ustar00davidstaff000000 000000 %project=dependencies +roles 2012-07-16T17:25:07Z Barack Obama +users [roles] 2012-07-16T17:25:07Z Barack Obama +add_user [users roles log:logger] 2012-07-16T17:25:07Z Barack Obama +dr_evil 2012-07-16T17:25:07Z Barack Obama @alpha 2012-07-16T17:25:07Z Barack Obama +users [users@alpha] 2012-07-16T17:25:07Z Barack Obama -dr_evil 2012-07-16T17:25:07Z Barack Obama +del_user [!dr_evil users log:logger@beta1] 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/reserved-tag.plan000644 000767 000024 00000000625 13133201371 020660 0ustar00davidstaff000000 000000 %project=reserved_tag hey 2012-07-16T17:25:07Z Barack Obama @foo 2012-07-16T17:25:07Z Barack Obama @bar 2012-07-16T17:25:07Z Barack Obama @HEAD 2012-07-16T17:25:07Z Barack Obama @whatever 2012-07-16T17:25:07Z Barack Obama ruh-roh 2012-07-16T17:25:07Z Barack Obama App-Sqitch-0.9996/t/plans/widgets.plan000644 000767 000024 00000000412 13133201371 017730 0ustar00davidstaff000000 000000 %project=widgets # This is a note # And there was a blank line. hey 2012-07-16T14:01:20Z Barack Obama you 2012-07-16T14:01:35Z Barack Obama @foo 2012-07-16T14:02:05Z Barack Obama # look, a tag! App-Sqitch-0.9996/t/lib/App/000755 000767 000024 00000000000 13133201371 015562 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/lib/DBIEngineTest.pm000644 000767 000024 00000241076 13133201371 017776 0ustar00davidstaff000000 000000 package DBIEngineTest; use 5.010; use strict; use warnings; use utf8; use Try::Tiny; use Test::More; use Test::Exception; use Time::HiRes qw(sleep); use Path::Class 0.33 qw(file dir); use Digest::SHA qw(sha1_hex); use Locale::TextDomain qw(App-Sqitch); use File::Temp 'tempdir'; # Just die on warnings. use Carp; BEGIN { $SIG{__WARN__} = \&Carp::confess } sub run { my ( $self, %p ) = @_; my $class = $p{class}; my @sqitch_params = @{ $p{sqitch_params} || [] }; my $user1_name = 'Marge Simpson'; my $user1_email = 'marge@example.com'; my $mock_sqitch = Test::MockModule->new('App::Sqitch'); # Mock script hashes using lines from the README. my $mock_change = Test::MockModule->new('App::Sqitch::Plan::Change'); my @lines = grep { $_ } file('README.md')->slurp( chomp => 1, iomode => '<:encoding(UTF-8)' ); # Each change should retain its own hash. my $orig_deploy_hash; $mock_change->mock(_deploy_hash => sub { my $self = shift; $self->$orig_deploy_hash || sha1_hex shift @lines; }); $orig_deploy_hash = $mock_change->original('_deploy_hash'); can_ok $class, qw( initialized initialize run_file run_handle log_deploy_change log_fail_change log_revert_change earliest_change_id latest_change_id is_deployed_tag is_deployed_change change_id_for change_id_for_depend name_for_change_id change_offset_from_id change_id_offset_from_id load_change ); subtest 'live database' => sub { my $sqitch = App::Sqitch->new( @sqitch_params, user_name => $user1_name, user_email => $user1_email, ); my $target = App::Sqitch::Target->new( sqitch => $sqitch, @{ $p{target_params} || [] }, ); my $engine = $class->new( sqitch => $sqitch, target => $target, @{ $p{engine_params} || [] }, ); if (my $code = $p{skip_unless}) { try { $code->( $engine ) || die 'NO'; } catch { plan skip_all => sprintf( 'Unable to live-test %s engine: %s', $class->name, eval { $_->message } || $_ ); }; } ok $engine, 'Engine instantiated'; ok !$engine->initialized, 'Database should not yet be initialized'; OLDREG: { my $mock_file = Test::MockModule->new('Path::Class::File'); my $dir = file(__FILE__)->dir->subdir('upgradable_registries'); $mock_file->mock( dir => sub { $dir } ); ok $engine->initialize, 'Initialize the database'; }; ok $engine->initialized, 'Database should now be initialized'; ok !$engine->needs_upgrade, 'Registry should not need upgrading'; my $get_releases = sub { my $releases = $engine->dbh->selectall_arrayref(q{ SELECT version, installer_name, installer_email FROM releases ORDER BY version }); $_->[0] = sprintf '%.1f', $_->[0] for @{ $releases }; return $releases; }; is_deeply $get_releases->(), [ [$engine->registry_release + 0, $sqitch->user_name, $sqitch->user_email] ], 'The release should be registered'; # Let's make sure upgrades work. $engine->dbh->do('DROP TABLE releases'); ok $engine->needs_upgrade, 'Registry should need upgrading'; MOCKINFO: { my $sqitch_mocker = Test::MockModule->new(ref $sqitch); my @args; $sqitch_mocker->mock(info => sub { shift; push @args => @_ }); ok $engine->upgrade_registry, 'Upgrade the registry'; is_deeply \@args, [' * ' . __x( 'From {old} to {new}', old => 0, new => '1.0', ), ' * ' . __x( 'From {old} to {new}', old => '1.0', new => '1.1', )], 'Should have info output for upgrade'; } ok !$engine->needs_upgrade, 'Registry should no longer need upgrading'; is_deeply $get_releases->(), [ [ '1.0', $sqitch->user_name, $sqitch->user_email ], [ '1.1', $sqitch->user_name, $sqitch->user_email ], ], 'The release should be registered again'; # Try it with a different Sqitch DB. $target = App::Sqitch::Target->new( sqitch => $sqitch, @{ $p{alt_target_params} || [] }, ); ok $engine = $class->new( sqitch => $sqitch, target => $target, @{ $p{alt_engine_params} || [] }, ), 'Create engine with alternate params'; is $engine->earliest_change_id, undef, 'No init, earliest change'; is $engine->latest_change_id, undef, 'No init, no latest change'; ok !$engine->initialized, 'Database should no longer seem initialized'; ok $engine->initialize, 'Initialize the database again'; ok $engine->initialized, 'Database should be initialized again'; ok !$engine->needs_upgrade, 'Registry should not need upgrading'; is $engine->earliest_change_id, undef, 'Still no earlist change'; is $engine->latest_change_id, undef, 'Still no latest changes'; # Make sure a second attempt to initialize dies. throws_ok { $engine->initialize } 'App::Sqitch::X', 'Should die on existing schema'; is $@->ident, 'engine', 'Mode should be "engine"'; is $@->message, $p{init_error}, 'And it should show the proper schema in the error message'; throws_ok { $engine->dbh->do('INSERT blah INTO __bar_____') } 'App::Sqitch::X', 'Database error should be converted to Sqitch exception'; is $@->ident, $DBI::state, 'Ident should be SQL error state'; like $@->message, $p{engine_err_regex}, 'The message should be from the engine'; like $@->previous_exception, qr/DBD::[^:]+::db do failed: /, 'The DBI error should be in preview_exception'; is $engine->current_state, undef, 'Current state should be undef'; is_deeply all( $engine->current_changes ), [], 'Should have no current changes'; is_deeply all( $engine->current_tags ), [], 'Should have no current tags'; is_deeply all( $engine->search_events ), [], 'Should have no events'; ########################################################################## # Test the database connection, if appropriate. if (my $code = $p{test_dbh}) { $code->($engine->dbh); } ########################################################################## # Test register_project(). can_ok $engine, 'register_project'; can_ok $engine, 'registered_projects'; is_deeply [ $engine->registered_projects ], [], 'Should have no registered projects'; ok $engine->register_project, 'Register the project'; is_deeply [ $engine->registered_projects ], ['engine'], 'Should have one registered project, "engine"'; is_deeply $engine->dbh->selectall_arrayref( 'SELECT project, uri, creator_name, creator_email FROM projects' ), [['engine', undef, $sqitch->user_name, $sqitch->user_email]], 'The project should be registered'; # Try to register it again. ok $engine->register_project, 'Register the project again'; is_deeply [ $engine->registered_projects ], ['engine'], 'Should still have one registered project, "engine"'; is_deeply $engine->dbh->selectall_arrayref( 'SELECT project, uri, creator_name, creator_email FROM projects' ), [['engine', undef, $sqitch->user_name, $sqitch->user_email]], 'The project should still be registered only once'; # Register a different project name. MOCKPROJECT: { my $plan_mocker = Test::MockModule->new(ref $target->plan ); $plan_mocker->mock(project => 'groovy'); $plan_mocker->mock(uri => 'http://example.com/'); ok $engine->register_project, 'Register a second project'; } is_deeply [ $engine->registered_projects ], ['engine', 'groovy'], 'Should have both registered projects'; is_deeply $engine->dbh->selectall_arrayref( 'SELECT project, uri, creator_name, creator_email FROM projects ORDER BY created_at' ), [ ['engine', undef, $sqitch->user_name, $sqitch->user_email], ['groovy', 'http://example.com/', $sqitch->user_name, $sqitch->user_email], ], 'Both projects should now be registered'; # Try to register with a different URI. MOCKURI: { my $plan_mocker = Test::MockModule->new(ref $target->plan ); my $plan_proj = 'engine'; my $plan_uri = 'http://example.net/'; $plan_mocker->mock(project => sub { $plan_proj }); $plan_mocker->mock(uri => sub { $plan_uri }); throws_ok { $engine->register_project } 'App::Sqitch::X', 'Should get an error for defined URI vs NULL registered URI'; is $@->ident, 'engine', 'Defined URI error ident should be "engine"'; is $@->message, __x( 'Cannot register "{project}" with URI {uri}: already exists with NULL URI', project => 'engine', uri => $plan_uri, ), 'Defined URI error message should be correct'; # Try it when the registered URI is NULL. $plan_proj = 'groovy'; throws_ok { $engine->register_project } 'App::Sqitch::X', 'Should get an error for different URIs'; is $@->ident, 'engine', 'Different URI error ident should be "engine"'; is $@->message, __x( 'Cannot register "{project}" with URI {uri}: already exists with URI {reg_uri}', project => 'groovy', uri => $plan_uri, reg_uri => 'http://example.com/', ), 'Different URI error message should be correct'; # Try with a NULL project URI. $plan_uri = undef; throws_ok { $engine->register_project } 'App::Sqitch::X', 'Should get an error for NULL plan URI'; is $@->ident, 'engine', 'NULL plan URI error ident should be "engine"'; is $@->message, __x( 'Cannot register "{project}" without URI: already exists with URI {uri}', project => 'groovy', uri => 'http://example.com/', ), 'NULL plan uri error message should be correct'; # It should succeed when the name and URI are the same. $plan_uri = 'http://example.com/'; ok $engine->register_project, 'Register "groovy" again'; is_deeply [ $engine->registered_projects ], ['engine', 'groovy'], 'Should still have two registered projects'; is_deeply $engine->dbh->selectall_arrayref( 'SELECT project, uri, creator_name, creator_email FROM projects ORDER BY created_at' ), [ ['engine', undef, $sqitch->user_name, $sqitch->user_email], ['groovy', 'http://example.com/', $sqitch->user_name, $sqitch->user_email], ], 'Both projects should still be registered'; # Now try the same URI but a different name. $plan_proj = 'bob'; throws_ok { $engine->register_project } 'App::Sqitch::X', 'Should get error for an project with the URI'; is $@->ident, 'engine', 'Existing URI error ident should be "engine"'; is $@->message, __x( 'Cannot register "{project}" with URI {uri}: project "{reg_proj}" already using that URI', project => $plan_proj, uri => $plan_uri, reg_proj => 'groovy', ), 'Exising URI error message should be correct'; } ###################################################################### # Test log_deploy_change(). my $plan = $target->plan; my $change = $plan->change_at(0); my ($tag) = $change->tags; is $change->name, 'users', 'Should have "users" change'; ok !$engine->is_deployed_change($change), 'The change should not be deployed'; is_deeply [$engine->are_deployed_changes($change)], [], 'The change should not be deployed'; ok $engine->log_deploy_change($change), 'Deploy "users" change'; ok $engine->is_deployed_change($change), 'The change should now be deployed'; is_deeply [$engine->are_deployed_changes($change)], [$change->id], 'The change should now be deployed'; is $engine->earliest_change_id, $change->id, 'Should get users ID for earliest change ID'; is $engine->earliest_change_id(1), undef, 'Should get no change offset 1 from earliest'; is $engine->latest_change_id, $change->id, 'Should get users ID for latest change ID'; is $engine->latest_change_id(1), undef, 'Should get no change offset 1 from latest'; is_deeply all_changes($engine), [[ $change->id, 'users', 'engine', 'User roles', $sqitch->user_name, $sqitch->user_email, $change->planner_name, $change->planner_email, ]],'A record should have been inserted into the changes table'; is_deeply get_dependencies($engine, $change->id), [], 'Should have no dependencies'; is_deeply [ $engine->changes_requiring_change($change) ], [], 'Change should not be required'; my @event_data = ([ 'deploy', $change->id, 'users', 'engine', 'User roles', $engine->_log_requires_param($change), $engine->_log_conflicts_param($change), $engine->_log_tags_param($change), $sqitch->user_name, $sqitch->user_email, $change->planner_name, $change->planner_email ]); is_deeply all_events($engine), \@event_data, 'A record should have been inserted into the events table'; is_deeply all_tags($engine), [[ $tag->id, '@alpha', $change->id, 'engine', 'Good to go!', $sqitch->user_name, $sqitch->user_email, $tag->planner_name, $tag->planner_email, ]], 'The tag should have been logged'; is $engine->name_for_change_id($change->id), 'users@alpha', 'name_for_change_id() should return the change name with tag'; ok my $state = $engine->current_state, 'Get the current state'; isa_ok my $dt = delete $state->{committed_at}, 'App::Sqitch::DateTime', 'committed_at value'; is $dt->time_zone->name, 'UTC', 'committed_at TZ should be UTC'; is_deeply $state, { project => 'engine', change_id => $change->id, script_hash => $change->script_hash, change => 'users', note => 'User roles', committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, tags => ['@alpha'], planner_name => $change->planner_name, planner_email => $change->planner_email, planned_at => $change->timestamp, }, 'The rest of the state should look right'; is_deeply all( $engine->current_changes ), [{ change_id => $change->id, script_hash => $change->script_hash, change => 'users', committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, committed_at => $dt, planner_name => $change->planner_name, planner_email => $change->planner_email, planned_at => $change->timestamp, }], 'Should have one current change'; is_deeply all( $engine->current_tags('nonesuch') ), [], 'Should have no current chnages for nonexistent project'; is_deeply all( $engine->current_tags ), [{ tag_id => $tag->id, tag => '@alpha', committed_at => dt_for_tag( $engine, $tag->id ), committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, planner_name => $tag->planner_name, planner_email => $tag->planner_email, planned_at => $tag->timestamp, }], 'Should have one current tags'; is_deeply all( $engine->current_tags('nonesuch') ), [], 'Should have no current tags for nonexistent project'; my @events = ({ event => 'deploy', project => 'engine', change_id => $change->id, change => 'users', note => 'User roles', requires => $engine->_log_requires_param($change), conflicts => $engine->_log_conflicts_param($change), tags => $engine->_log_tags_param($change), committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, committed_at => dt_for_event($engine, 0), planned_at => $change->timestamp, planner_name => $change->planner_name, planner_email => $change->planner_email, }); is_deeply all( $engine->search_events ), \@events, 'Should have one event'; ###################################################################### # Test log_new_tags(). ok $engine->log_new_tags($change), 'Log new tags for "users" change'; is_deeply all_tags($engine), [[ $tag->id, '@alpha', $change->id, 'engine', 'Good to go!', $sqitch->user_name, $sqitch->user_email, $tag->planner_name, $tag->planner_email, ]], 'The tag should be the same'; # Delete that tag. $engine->dbh->do('DELETE FROM tags'); is_deeply all_tags($engine), [], 'Should now have no tags'; # Put it back. ok $engine->log_new_tags($change), 'Log new tags for "users" change again'; is_deeply all_tags($engine), [[ $tag->id, '@alpha', $change->id, 'engine', 'Good to go!', $sqitch->user_name, $sqitch->user_email, $tag->planner_name, $tag->planner_email, ]], 'The tag should be back'; ###################################################################### # Test log_revert_change(). First shift existing event dates. ok $engine->log_revert_change($change), 'Revert "users" change'; ok !$engine->is_deployed_change($change), 'The change should no longer be deployed'; is_deeply [$engine->are_deployed_changes($change)], [], 'The change should no longer be deployed'; is $engine->earliest_change_id, undef, 'Should get undef for earliest change'; is $engine->latest_change_id, undef, 'Should get undef for latest change'; is_deeply all_changes($engine), [], 'The record should have been deleted from the changes table'; is_deeply all_tags($engine), [], 'And the tag record should have been removed'; is_deeply get_dependencies($engine, $change->id), [], 'Should still have no dependencies'; is_deeply [ $engine->changes_requiring_change($change) ], [], 'Change should not be required'; push @event_data, [ 'revert', $change->id, 'users', 'engine', 'User roles', $engine->_log_requires_param($change), $engine->_log_conflicts_param($change), $engine->_log_tags_param($change), $sqitch->user_name, $sqitch->user_email, $change->planner_name, $change->planner_email ]; is_deeply all_events($engine), \@event_data, 'The revert event should have been logged'; is $engine->name_for_change_id($change->id), undef, 'name_for_change_id() should no longer return the change name'; is $engine->current_state, undef, 'Current state should be undef again'; is_deeply all( $engine->current_changes ), [], 'Should again have no current changes'; is_deeply all( $engine->current_tags ), [], 'Should again have no current tags'; unshift @events => { event => 'revert', project => 'engine', change_id => $change->id, change => 'users', note => 'User roles', requires => $engine->_log_requires_param($change), conflicts => $engine->_log_conflicts_param($change), tags => $engine->_log_tags_param($change), committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, committed_at => dt_for_event($engine, 1), planned_at => $change->timestamp, planner_name => $change->planner_name, planner_email => $change->planner_email, }; is_deeply all( $engine->search_events ), \@events, 'Should have two events'; ###################################################################### # Test log_fail_change(). ok $engine->log_fail_change($change), 'Fail "users" change'; ok !$engine->is_deployed_change($change), 'The change still should not be deployed'; is_deeply [$engine->are_deployed_changes($change)], [], 'The change still should not be deployed'; is $engine->earliest_change_id, undef, 'Should still get undef for earliest change'; is $engine->latest_change_id, undef, 'Should still get undef for latest change'; is_deeply all_changes($engine), [], 'Still should have not changes table record'; is_deeply all_tags($engine), [], 'Should still have no tag records'; is_deeply get_dependencies($engine, $change->id), [], 'Should still have no dependencies'; is_deeply [ $engine->changes_requiring_change($change) ], [], 'Change should not be required'; push @event_data, [ 'fail', $change->id, 'users', 'engine', 'User roles', $engine->_log_requires_param($change), $engine->_log_conflicts_param($change), $engine->_log_tags_param($change), $sqitch->user_name, $sqitch->user_email, $change->planner_name, $change->planner_email ]; is_deeply all_events($engine), \@event_data, 'The fail event should have been logged'; is $engine->current_state, undef, 'Current state should still be undef'; is_deeply all( $engine->current_changes ), [], 'Should still have no current changes'; is_deeply all( $engine->current_tags ), [], 'Should still have no current tags'; unshift @events => { event => 'fail', project => 'engine', change_id => $change->id, change => 'users', note => 'User roles', requires => $engine->_log_requires_param($change), conflicts => $engine->_log_conflicts_param($change), tags => $engine->_log_tags_param($change), committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, committed_at => dt_for_event($engine, 2), planned_at => $change->timestamp, planner_name => $change->planner_name, planner_email => $change->planner_email, }; is_deeply all( $engine->search_events ), \@events, 'Should have 3 events'; # From here on in, use a different committer. my $user2_name = 'Homer Simpson'; my $user2_email = 'homer@example.com'; $mock_sqitch->mock( user_name => $user2_name ); $mock_sqitch->mock( user_email => $user2_email ); ###################################################################### # Test a change with dependencies. ok $engine->log_deploy_change($change), 'Deploy the change again'; ok $engine->is_deployed_tag($tag), 'The tag again should be deployed'; is $engine->earliest_change_id, $change->id, 'Should again get users ID for earliest change ID'; is $engine->earliest_change_id(1), undef, 'Should still get no change offset 1 from earliest'; is $engine->latest_change_id, $change->id, 'Should again get users ID for latest change ID'; is $engine->latest_change_id(1), undef, 'Should still get no change offset 1 from latest'; ok my $change2 = $plan->change_at(1), 'Get the second change'; is_deeply [sort $engine->are_deployed_changes($change, $change2)], [$change->id], 'Only the first change should be deployed'; my ($req) = $change2->requires; ok $req->resolved_id($change->id), 'Set resolved ID in required depend'; # Send this change back in time. $engine->dbh->do( 'UPDATE changes SET committed_at = ?', undef, '2013-03-30 00:47:47', ); ok $engine->log_deploy_change($change2), 'Deploy second change'; is $engine->earliest_change_id, $change->id, 'Should still get users ID for earliest change ID'; is $engine->earliest_change_id(1), $change2->id, 'Should get "widgets" offset 1 from earliest'; is $engine->earliest_change_id(2), undef, 'Should get no change offset 2 from earliest'; is $engine->latest_change_id, $change2->id, 'Should get "widgets" ID for latest change ID'; is $engine->latest_change_id(1), $change->id, 'Should get "user" offset 1 from earliest'; is $engine->latest_change_id(2), undef, 'Should get no change offset 2 from latest'; is_deeply all_changes($engine), [ [ $change->id, 'users', 'engine', 'User roles', $user2_name, $user2_email, $change->planner_name, $change->planner_email, ], [ $change2->id, 'widgets', 'engine', 'All in', $user2_name, $user2_email, $change2->planner_name, $change2->planner_email, ], ], 'Should have both changes and requires/conflcits deployed'; is_deeply [sort $engine->are_deployed_changes($change, $change2)], [sort $change->id, $change2->id], 'Both changes should be deployed'; is_deeply get_dependencies($engine, $change->id), [], 'Should still have no dependencies for "users"'; is_deeply get_dependencies($engine, $change2->id), [ [ $change2->id, 'conflict', 'dr_evil', undef, ], [ $change2->id, 'require', 'users', $change->id, ], ], 'Should have both dependencies for "widgets"'; is_deeply [ $engine->changes_requiring_change($change) ], [{ project => 'engine', change_id => $change2->id, change => 'widgets', asof_tag => undef, }], 'Change "users" should be required by "widgets"'; is_deeply [ $engine->changes_requiring_change($change2) ], [], 'Change "widgets" should not be required'; push @event_data, [ 'deploy', $change->id, 'users', 'engine', 'User roles', $engine->_log_requires_param($change), $engine->_log_conflicts_param($change), $engine->_log_tags_param($change), $user2_name, $user2_email, $change->planner_name, $change->planner_email, ], [ 'deploy', $change2->id, 'widgets', 'engine', 'All in', $engine->_log_requires_param($change2), $engine->_log_conflicts_param($change2), $engine->_log_tags_param($change2), $user2_name, $user2_email, $change2->planner_name, $change2->planner_email, ]; is_deeply all_events($engine), \@event_data, 'The new change deploy should have been logged'; is $engine->name_for_change_id($change2->id), 'widgets@HEAD', 'name_for_change_id() should return name with symbolic tag @HEAD'; ok $state = $engine->current_state, 'Get the current state again'; isa_ok $dt = delete $state->{committed_at}, 'App::Sqitch::DateTime', 'committed_at value'; is $dt->time_zone->name, 'UTC', 'committed_at TZ should be UTC'; is_deeply $state, { project => 'engine', change_id => $change2->id, script_hash => $change2->script_hash, change => 'widgets', note => 'All in', committer_name => $user2_name, committer_email => $user2_email, planner_name => $change2->planner_name, planner_email => $change2->planner_email, planned_at => $change2->timestamp, tags => [], }, 'The state should reference new change'; my @current_changes = ( { change_id => $change2->id, script_hash => $change2->script_hash, change => 'widgets', committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_change( $engine, $change2->id ), planner_name => $change2->planner_name, planner_email => $change2->planner_email, planned_at => $change2->timestamp, }, { change_id => $change->id, script_hash => $change->script_hash, change => 'users', committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_change( $engine, $change->id ), planner_name => $change->planner_name, planner_email => $change->planner_email, planned_at => $change->timestamp, }, ); is_deeply all( $engine->current_changes ), \@current_changes, 'Should have two current changes in reverse chronological order'; my @current_tags = ( { tag_id => $tag->id, tag => '@alpha', committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_tag( $engine, $tag->id ), planner_name => $tag->planner_name, planner_email => $tag->planner_email, planned_at => $tag->timestamp, }, ); is_deeply all( $engine->current_tags ), \@current_tags, 'Should again have one current tags'; unshift @events => { event => 'deploy', project => 'engine', change_id => $change2->id, change => 'widgets', note => 'All in', requires => $engine->_log_requires_param($change2), conflicts => $engine->_log_conflicts_param($change2), tags => $engine->_log_tags_param($change2), committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_event($engine, 4), planner_name => $change2->planner_name, planner_email => $change2->planner_email, planned_at => $change2->timestamp, }, { event => 'deploy', project => 'engine', change_id => $change->id, change => 'users', note => 'User roles', requires => $engine->_log_requires_param($change), conflicts => $engine->_log_conflicts_param($change), tags => $engine->_log_tags_param($change), committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_event($engine, 3), planner_name => $change->planner_name, planner_email => $change->planner_email, planned_at => $change->timestamp, }; is_deeply all( $engine->search_events ), \@events, 'Should have 5 events'; ###################################################################### # Test deployed_changes(), deployed_changes_since(), load_change, and # change_offset_from_id(), and change_id_offset_from_id() can_ok $engine, qw( deployed_changes deployed_changes_since load_change change_offset_from_id change_id_offset_from_id ); my $change_hash = { id => $change->id, name => $change->name, project => $change->project, note => $change->note, timestamp => $change->timestamp, planner_name => $change->planner_name, planner_email => $change->planner_email, tags => ['@alpha'], }; my $change2_hash = { id => $change2->id, name => $change2->name, project => $change2->project, note => $change2->note, timestamp => $change2->timestamp, planner_name => $change2->planner_name, planner_email => $change2->planner_email, tags => [], }; is_deeply [$engine->deployed_changes], [$change_hash, $change2_hash], 'Should have two deployed changes'; is_deeply [$engine->deployed_changes_since($change)], [$change2_hash], 'Should find one deployed since the first one'; is_deeply [$engine->deployed_changes_since($change2)], [], 'Should find none deployed since the second one'; is_deeply $engine->load_change($change->id), $change_hash, 'Should load change 1'; is_deeply $engine->load_change($change2->id), $change2_hash, 'Should load change 2'; is_deeply $engine->load_change('whatever'), undef, 'load() should return undef for uknown change ID'; is_deeply $engine->change_offset_from_id($change->id, undef), $change_hash, 'Should load change with no offset'; is_deeply $engine->change_offset_from_id($change2->id, 0), $change2_hash, 'Should load change with offset 0'; is_deeply $engine->change_id_offset_from_id($change->id, undef), $change->id, 'Should get change ID with no offset'; is_deeply $engine->change_id_offset_from_id($change2->id, 0), $change2->id, 'Should get change ID with offset 0'; # Now try some offsets. is_deeply $engine->change_offset_from_id($change->id, 1), $change2_hash, 'Should find change with offset 1'; is_deeply $engine->change_offset_from_id($change2->id, -1), $change_hash, 'Should find change with offset -1'; is_deeply $engine->change_offset_from_id($change->id, 2), undef, 'Should find undef change with offset 2'; is_deeply $engine->change_id_offset_from_id($change->id, 1), $change2->id, 'Should find change ID with offset 1'; is_deeply $engine->change_id_offset_from_id($change2->id, -1), $change->id, 'Should find change ID with offset -1'; is_deeply $engine->change_id_offset_from_id($change->id, 2), undef, 'Should find undef change ID with offset 2'; # Revert change 2. ok $engine->log_revert_change($change2), 'Revert "widgets"'; is_deeply [$engine->deployed_changes], [$change_hash], 'Should now have one deployed change ID'; is_deeply [$engine->deployed_changes_since($change)], [], 'Should find none deployed since that one'; # Add another one. ok $engine->log_deploy_change($change2), 'Log another change'; is_deeply [$engine->deployed_changes], [$change_hash, $change2_hash], 'Should have both deployed change IDs'; is_deeply [$engine->deployed_changes_since($change)], [$change2_hash], 'Should find only the second after the first'; is_deeply [$engine->deployed_changes_since($change2)], [], 'Should find none after the second'; ok $state = $engine->current_state, 'Get the current state once more'; isa_ok $dt = delete $state->{committed_at}, 'App::Sqitch::DateTime', 'committed_at value'; is $dt->time_zone->name, 'UTC', 'committed_at TZ should be UTC'; is_deeply $state, { project => 'engine', change_id => $change2->id, script_hash => $change2->script_hash, change => 'widgets', note => 'All in', committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, tags => [], planner_name => $change2->planner_name, planner_email => $change2->planner_email, planned_at => $change2->timestamp, }, 'The new state should reference latest change'; # These were reverted and re-deployed, so might have new timestamps. $current_changes[0]->{committed_at} = dt_for_change( $engine, $change2->id ); $current_changes[1]->{committed_at} = dt_for_change( $engine, $change->id ); is_deeply all( $engine->current_changes ), \@current_changes, 'Should still have two current changes in reverse chronological order'; is_deeply all( $engine->current_tags ), \@current_tags, 'Should still have one current tags'; unshift @events => { event => 'deploy', project => 'engine', change_id => $change2->id, change => 'widgets', note => 'All in', requires => $engine->_log_requires_param($change2), conflicts => $engine->_log_conflicts_param($change2), tags => $engine->_log_tags_param($change2), committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_event($engine, 6), planner_name => $change2->planner_name, planner_email => $change2->planner_email, planned_at => $change2->timestamp, }, { event => 'revert', project => 'engine', change_id => $change2->id, change => 'widgets', note => 'All in', requires => $engine->_log_requires_param($change2), conflicts => $engine->_log_conflicts_param($change2), tags => $engine->_log_tags_param($change2), committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_event($engine, 5), planner_name => $change2->planner_name, planner_email => $change2->planner_email, planned_at => $change2->timestamp, }; is_deeply all( $engine->search_events ), \@events, 'Should have 7 events'; ###################################################################### # Deploy the new changes with two tags. $plan->add( name => 'fred', note => 'Hello Fred' ); $plan->add( name => 'barney', note => 'Hello Barney' ); $plan->tag( name => 'beta', note => 'Note beta' ); $plan->tag( name => 'gamma', note => 'Note gamma' ); ok my $fred = $plan->get('fred'), 'Get the "fred" change'; ok $engine->log_deploy_change($fred), 'Deploy "fred"'; sleep 0.1; # Give SQLite a little time to tick microseconds. ok my $barney = $plan->get('barney'), 'Get the "barney" change'; ok $engine->log_deploy_change($barney), 'Deploy "barney"'; is $engine->earliest_change_id, $change->id, 'Earliest change should sill be "users"'; is $engine->earliest_change_id(1), $change2->id, 'Should still get "widgets" offset 1 from earliest'; is $engine->earliest_change_id(2), $fred->id, 'Should get "fred" offset 2 from earliest'; is $engine->earliest_change_id(3), $barney->id, 'Should get "barney" offset 3 from earliest'; is $engine->latest_change_id, $barney->id, 'Latest change should be "barney"'; is $engine->latest_change_id(1), $fred->id, 'Should get "fred" offset 1 from latest'; is $engine->latest_change_id(2), $change2->id, 'Should get "widgets" offset 2 from latest'; is $engine->latest_change_id(3), $change->id, 'Should get "users" offset 3 from latest'; $state = $engine->current_state; # MySQL's group_concat() does not by default sort by row order, alas. $state->{tags} = [ sort @{ $state->{tags} } ] if $class eq 'App::Sqitch::Engine::mysql'; is_deeply $state, { project => 'engine', change_id => $barney->id, script_hash => $barney->script_hash, change => 'barney', note => 'Hello Barney', committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, committed_at => dt_for_change( $engine,$barney->id), tags => [qw(@beta @gamma)], planner_name => $barney->planner_name, planner_email => $barney->planner_email, planned_at => $barney->timestamp, }, 'Barney should be in the current state'; unshift @current_changes => { change_id => $barney->id, script_hash => $barney->script_hash, change => 'barney', committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_change( $engine, $barney->id ), planner_name => $barney->planner_name, planner_email => $barney->planner_email, planned_at => $barney->timestamp, }, { change_id => $fred->id, script_hash => $fred->script_hash, change => 'fred', committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_change( $engine, $fred->id ), planner_name => $fred->planner_name, planner_email => $fred->planner_email, planned_at => $fred->timestamp, }; is_deeply all( $engine->current_changes ), \@current_changes, 'Should have all four current changes in reverse chron order'; my ($beta, $gamma) = $barney->tags; if (my $format = $p{add_second_format}) { my $set = sprintf $format, 'committed_at'; $engine->dbh->do( "UPDATE tags SET committed_at = $set WHERE tag = '\@gamma'" ); } unshift @current_tags => { tag_id => $gamma->id, tag => '@gamma', committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_tag( $engine, $gamma->id ), planner_name => $gamma->planner_name, planner_email => $gamma->planner_email, planned_at => $gamma->timestamp, }, { tag_id => $beta->id, tag => '@beta', committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_tag( $engine, $beta->id ), planner_name => $beta->planner_name, planner_email => $beta->planner_email, planned_at => $beta->timestamp, }; is_deeply all( $engine->current_tags ), \@current_tags, 'Should now have three current tags in reverse chron order'; unshift @events => { event => 'deploy', project => 'engine', change_id => $barney->id, change => 'barney', note => 'Hello Barney', requires => $engine->_log_requires_param($barney), conflicts => $engine->_log_conflicts_param($barney), tags => $engine->_log_tags_param($barney), committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_event($engine, 8), planner_name => $barney->planner_name, planner_email => $barney->planner_email, planned_at => $barney->timestamp, }, { event => 'deploy', project => 'engine', change_id => $fred->id, change => 'fred', note => 'Hello Fred', requires => $engine->_log_requires_param($fred), conflicts => $engine->_log_conflicts_param($fred), tags => $engine->_log_tags_param($fred), committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_event($engine, 7), planner_name => $fred->planner_name, planner_email => $fred->planner_email, planned_at => $fred->timestamp, }; is_deeply all( $engine->search_events ), \@events, 'Should have 9 events'; ###################################################################### # Test search_events() parameters. is_deeply all( $engine->search_events(limit => 2) ), [ @events[0..1] ], 'The limit param to search_events should work'; is_deeply all( $engine->search_events(offset => 4) ), [ @events[4..$#events] ], 'The offset param to search_events should work'; is_deeply all( $engine->search_events(limit => 3, offset => 4) ), [ @events[4..6] ], 'The limit and offset params to search_events should work together'; is_deeply all( $engine->search_events( direction => 'DESC' ) ), \@events, 'Should work to set direction "DESC" in search_events'; is_deeply all( $engine->search_events( direction => 'desc' ) ), \@events, 'Should work to set direction "desc" in search_events'; is_deeply all( $engine->search_events( direction => 'descending' ) ), \@events, 'Should work to set direction "descending" in search_events'; is_deeply all( $engine->search_events( direction => 'ASC' ) ), [ reverse @events ], 'Should work to set direction "ASC" in search_events'; is_deeply all( $engine->search_events( direction => 'asc' ) ), [ reverse @events ], 'Should work to set direction "asc" in search_events'; is_deeply all( $engine->search_events( direction => 'ascending' ) ), [ reverse @events ], 'Should work to set direction "ascending" in search_events'; throws_ok { $engine->search_events( direction => 'foo' ) } 'App::Sqitch::X', 'Should catch exception for invalid search direction'; is $@->ident, 'DEV', 'Search direction error ident should be "DEV"'; is $@->message, 'Search direction must be either "ASC" or "DESC"', 'Search direction error message should be correct'; is_deeply all( $engine->search_events( committer => 'Simpson$' ) ), \@events, 'The committer param to search_events should work'; is_deeply all( $engine->search_events( committer => "^Homer" ) ), [ @events[0..5] ], 'The committer param to search_events should work as a regex'; is_deeply all( $engine->search_events( committer => 'Simpsonized$' ) ), [], qq{Committer regex should fail to match with "Simpsonized\$"}; is_deeply all( $engine->search_events( change => 'users' ) ), [ @events[5..$#events] ], 'The change param to search_events should work with "users"'; is_deeply all( $engine->search_events( change => 'widgets' ) ), [ @events[2..4] ], 'The change param to search_events should work with "widgets"'; is_deeply all( $engine->search_events( change => 'fred' ) ), [ $events[1] ], 'The change param to search_events should work with "fred"'; is_deeply all( $engine->search_events( change => 'fre$' ) ), [], 'The change param to search_events should return nothing for "fre$"'; is_deeply all( $engine->search_events( change => '(er|re)' ) ), [@events[1, 5..8]], 'The change param to search_events should return match "(er|re)"'; is_deeply all( $engine->search_events( event => [qw(deploy)] ) ), [ grep { $_->{event} eq 'deploy' } @events ], 'The event param should work with "deploy"'; is_deeply all( $engine->search_events( event => [qw(revert)] ) ), [ grep { $_->{event} eq 'revert' } @events ], 'The event param should work with "revert"'; is_deeply all( $engine->search_events( event => [qw(fail)] ) ), [ grep { $_->{event} eq 'fail' } @events ], 'The event param should work with "fail"'; is_deeply all( $engine->search_events( event => [qw(revert fail)] ) ), [ grep { $_->{event} ne 'deploy' } @events ], 'The event param should work with "revert" and "fail"'; is_deeply all( $engine->search_events( event => [qw(deploy revert fail)] ) ), \@events, 'The event param should work with "deploy", "revert", and "fail"'; is_deeply all( $engine->search_events( event => ['foo'] ) ), [], 'The event param should return nothing for "foo"'; # Add an external project event. ok my $ext_plan = App::Sqitch::Plan->new( sqitch => $sqitch, target => $target, project => 'groovy', ), 'Create external plan'; ok my $ext_change = $ext_plan->add( plan => $ext_plan, name => 'crazyman', note => 'Crazy, right?', ), "Create external change"; # Because we're gonna use a regular expression on events.project to # get events from multiple projects, we need to make sure that we get # things in the proper order, such as on MySQL 5.5, where there is no # datetime precision. So pretend we're about to insert another # "engine" project record to get the MySQL engine to wait out a clock # second tick before inserting our "groovy" change. This is purely so # we get things back in the proper order for the `project => 'g'` test # below. In reality it shouldn't matter much. $engine->_prepare_to_log(events => $barney); ok $engine->log_deploy_change($ext_change), 'Log the external change'; my $ext_event = { event => 'deploy', project => 'groovy', change_id => $ext_change->id, change => $ext_change->name, note => $ext_change->note, requires => $engine->_log_requires_param($ext_change), conflicts => $engine->_log_conflicts_param($ext_change), tags => $engine->_log_tags_param($ext_change), committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_event($engine, 9), planner_name => $user2_name, planner_email => $user2_email, planned_at => $ext_change->timestamp, }; is_deeply all( $engine->search_events( project => '^engine$' ) ), \@events, 'The project param to search_events should work'; is_deeply all( $engine->search_events( project => '^groovy$' ) ), [$ext_event], 'The project param to search_events should work with external project'; is_deeply all( $engine->search_events( project => 'g' ) ), [$ext_event, @events], 'The project param to search_events should match across projects'; is_deeply all( $engine->search_events( project => 'nonexistent' ) ), [], qq{Project regex should fail to match with "nonexistent"}; # Make sure we do not see these changes where we should not. ok !grep( { $_ eq $ext_change->id } $engine->deployed_changes), 'deployed_changes should not include external change'; ok !grep( { $_ eq $ext_change->id } $engine->deployed_changes_since($change)), 'deployed_changes_since should not include external change'; is $engine->earliest_change_id, $change->id, 'Earliest change should sill be "users"'; isnt $engine->latest_change_id, $ext_change->id, 'Latest change ID should not be from external project'; throws_ok { $engine->search_events(foo => 1) } 'App::Sqitch::X', 'Should catch exception for invalid search param'; is $@->ident, 'DEV', 'Invalid search param error ident should be "DEV"'; is $@->message, 'Invalid parameters passed to search_events(): foo', 'Invalid search param error message should be correct'; throws_ok { $engine->search_events(foo => 1, bar => 2) } 'App::Sqitch::X', 'Should catch exception for invalid search params'; is $@->ident, 'DEV', 'Invalid search params error ident should be "DEV"'; is $@->message, 'Invalid parameters passed to search_events(): bar, foo', 'Invalid search params error message should be correct'; ###################################################################### # Now that we have a change from an externa project, get its state. ok $state = $engine->current_state('groovy'), 'Get the "groovy" state'; isa_ok $dt = delete $state->{committed_at}, 'App::Sqitch::DateTime', 'groofy committed_at value'; is $dt->time_zone->name, 'UTC', 'groovy committed_at TZ should be UTC'; is_deeply $state, { project => 'groovy', change_id => $ext_change->id, script_hash => $ext_change->script_hash, change => $ext_change->name, note => $ext_change->note, committer_name => $sqitch->user_name, committer_email => $sqitch->user_email, tags => [], planner_name => $ext_change->planner_name, planner_email => $ext_change->planner_email, planned_at => $ext_change->timestamp, }, 'The rest of the state should look right'; ###################################################################### # Test change_id_for(). for my $spec ( [ 'change_id only', { change_id => $change->id }, $change->id, ], [ 'change only', { change => $change->name }, $change->id, ], [ 'change + tag', { change => $change->name, tag => 'alpha' }, $change->id, ], [ 'change@HEAD', { change => $change->name, tag => 'HEAD' }, $change->id, ], [ 'tag only', { tag => 'alpha' }, $change->id, ], [ 'ROOT', { tag => 'ROOT' }, $change->id, ], [ 'FIRST', { tag => 'FIRST' }, $change->id, ], [ 'HEAD', { tag => 'HEAD' }, $barney->id, ], [ 'LAST', { tag => 'LAST' }, $barney->id, ], [ 'project:ROOT', { tag => 'ROOT', project => 'groovy' }, $ext_change->id, ], [ 'project:HEAD', { tag => 'HEAD', project => 'groovy' }, $ext_change->id, ], ) { my ( $desc, $params, $exp_id ) = @{ $spec }; is $engine->change_id_for(%{ $params }), $exp_id, "Should find id for $desc"; } for my $spec ( [ 'unkonwn id', { change_id => 'whatever' }, ], [ 'unkonwn change', { change => 'whatever' }, ], [ 'unkonwn tag', { tag => 'whatever' }, ], [ 'change + unkonwn tag', { change => $change->name, tag => 'whatever' }, ], [ 'change@ROOT', { change => $change->name, tag => 'ROOT' }, ], [ 'change + different project', { change => $change->name, project => 'whatever' }, ], [ 'tag + different project', { tag => 'alpha', project => 'whatever' }, ], ) { my ( $desc, $params ) = @{ $spec }; is $engine->change_id_for(%{ $params }), undef, "Should find nothing for $desc"; } ###################################################################### # Test change_id_for_depend(). my $id = '4f1e83f409f5f533eeef9d16b8a59e2c0aa91cc1'; my $i; for my $spec ( [ 'id only', { id => $id }, { id => $id }, ], [ 'change + tag', { change => 'bart', tag => 'epsilon' }, { name => 'bart' } ], [ 'change only', { change => 'lisa' }, { name => 'lisa' }, ], [ 'tag only', { tag => 'sigma' }, { name => 'maggie' }, ], ) { my ( $desc, $dep_params, $chg_params ) = @{ $spec }; # Test as an internal dependency. INTERNAL: { ok my $change = $plan->add( name => 'foo' . ++$i, %{$chg_params}, ), "Create internal $desc change"; # Tag it if necessary. if (my $tag = $dep_params->{tag}) { ok $plan->tag(name => $tag), "Add tag internal \@$tag"; } # Should start with unsatisfied dependency. ok my $dep = App::Sqitch::Plan::Depend->new( plan => $plan, project => $plan->project, %{ $dep_params }, ), "Create internal $desc dependency"; is $engine->change_id_for_depend($dep), undef, "Internal $desc depencency should not be satisfied"; # Once deployed, dependency should be satisfied. ok $engine->log_deploy_change($change), "Log internal $desc change deployment"; is $engine->change_id_for_depend($dep), $change->id, "Internal $desc depencency should now be satisfied"; # Revert it and try again. sleep 0.1; # Give SQLite a little time to tick microseconds. ok $engine->log_revert_change($change), "Log internal $desc change reversion"; is $engine->change_id_for_depend($dep), undef, "Internal $desc depencency should again be unsatisfied"; } # Now test as an external dependency. EXTERNAL: { # Make sure we have unique IDs. $_->{id} = 'dcb10d16276c9be8956274740d9f332bd71344ed' for grep { $_->{id} } $dep_params, $chg_params; # Make Change and Tag return registered external project "groovy". $dep_params->{project} = 'groovy'; my $line_mocker = Test::MockModule->new('App::Sqitch::Plan::Line'); $line_mocker->mock(project => $dep_params->{project}); ok my $change = App::Sqitch::Plan::Change->new( plan => $plan, name => 'foo' . ++$i, %{$chg_params}, ), "Create external $desc change"; # Tag it if necessary. if (my $tag = $dep_params->{tag}) { ok $change->add_tag(App::Sqitch::Plan::Tag->new( plan => $plan, change => $change, name => $tag, ) ), "Add tag external \@$tag"; } # Should start with unsatisfied dependency. ok my $dep = App::Sqitch::Plan::Depend->new( plan => $plan, project => $plan->project, %{ $dep_params }, ), "Create external $desc dependency"; is $engine->change_id_for_depend($dep), undef, "External $desc depencency should not be satisfied"; # Once deployed, dependency should be satisfied. ok $engine->log_deploy_change($change), "Log external $desc change deployment"; is $engine->change_id_for_depend($dep), $change->id, "External $desc depencency should now be satisfied"; # Revert it and try again. sleep 0.1; # Give SQLite a little time to tick microseconds. ok $engine->log_revert_change($change), "Log external $desc change reversion"; is $engine->change_id_for_depend($dep), undef, "External $desc depencency should again be unsatisfied"; } } ok my $ext_change2 = App::Sqitch::Plan::Change->new( plan => $ext_plan, name => 'outside_in', ), "Create another external change"; ok $ext_change2->add_tag( my $ext_tag = App::Sqitch::Plan::Tag->new( plan => $plan, change => $ext_change2, name => 'meta', ) ), 'Add tag external "meta"'; ok $engine->log_deploy_change($ext_change2), 'Log the external change with tag'; # Make sure name_for_change_id() works properly. ok $engine->dbh->do(q{DELETE FROM tags WHERE project = 'engine'}), 'Delete the engine project tags'; is $engine->name_for_change_id($change2->id), 'widgets@HEAD', 'name_for_change_id() should return "widgets@HEAD" for its ID'; is $engine->name_for_change_id($ext_change2->id), 'outside_in@meta', 'name_for_change_id() should return "outside_in@meta" for its ID'; # Make sure current_changes and current_tags are project-scoped. is_deeply all( $engine->current_changes ), \@current_changes, 'Should have only the "engine" changes from current_changes'; is_deeply all( $engine->current_changes('groovy') ), [ { change_id => $ext_change2->id, script_hash => $ext_change2->script_hash, change => $ext_change2->name, committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_change( $engine, $ext_change2->id ), planner_name => $ext_change2->planner_name, planner_email => $ext_change2->planner_email, planned_at => $ext_change2->timestamp, }, { change_id => $ext_change->id, script_hash => $ext_change->script_hash, change => $ext_change->name, committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_change( $engine, $ext_change->id ), planner_name => $ext_change->planner_name, planner_email => $ext_change->planner_email, planned_at => $ext_change->timestamp, } ], 'Should get only requestd project changes from current_changes'; is_deeply all( $engine->current_tags ), [], 'Should no longer have "engine" project tags'; is_deeply all( $engine->current_tags('groovy') ), [{ tag_id => $ext_tag->id, tag => '@meta', committer_name => $user2_name, committer_email => $user2_email, committed_at => dt_for_tag( $engine, $ext_tag->id ), planner_name => $ext_tag->planner_name, planner_email => $ext_tag->planner_email, planned_at => $ext_tag->timestamp, }], 'Should get groovy tags from current_chages()'; ###################################################################### # Test changes with multiple and cross-project dependencies. ok my $hyper = $plan->add( name => 'hypercritical', requires => ['engine:fred', 'groovy:crazyman'], ), 'Create change "hypercritial" in current plan'; $_->resolved_id( $engine->change_id_for_depend($_) ) for $hyper->requires; ok $engine->log_deploy_change($hyper), 'Log change "hyper"'; is_deeply [ $engine->changes_requiring_change($hyper) ], [], 'No changes should require "hypercritical"'; is_deeply [ $engine->changes_requiring_change($fred) ], [{ project => 'engine', change_id => $hyper->id, change => $hyper->name, asof_tag => undef, }], 'Change "hypercritical" should require "fred"'; is_deeply [ $engine->changes_requiring_change($ext_change) ], [{ project => 'engine', change_id => $hyper->id, change => $hyper->name, asof_tag => undef, }], 'Change "hypercritical" should require "groovy:crazyman"'; # Add another change with more depencencies. ok my $ext_change3 = App::Sqitch::Plan::Change->new( plan => $ext_plan, name => 'elsewise', requires => [ App::Sqitch::Plan::Depend->new( plan => $ext_plan, project => 'engine', change => 'fred', ), App::Sqitch::Plan::Depend->new( plan => $ext_plan, change => 'crazyman', ), ] ), "Create a third external change"; $_->resolved_id( $engine->change_id_for_depend($_) ) for $ext_change3->requires; ok $engine->log_deploy_change($ext_change3), 'Log change "elsewise"'; is_deeply [ sort { $b->{change} cmp $a->{change} } $engine->changes_requiring_change($fred) ], [ { project => 'engine', change_id => $hyper->id, change => $hyper->name, asof_tag => undef, }, { project => 'groovy', change_id => $ext_change3->id, change => $ext_change3->name, asof_tag => undef, }, ], 'Change "fred" should be required by changes in two projects'; is_deeply [ sort { $b->{change} cmp $a->{change} } $engine->changes_requiring_change($ext_change) ], [ { project => 'engine', change_id => $hyper->id, change => $hyper->name, asof_tag => undef, }, { project => 'groovy', change_id => $ext_change3->id, change => $ext_change3->name, asof_tag => undef, }, ], 'Change "groovy:crazyman" should be required by changes in two projects'; ###################################################################### # Test begin_work() and finish_work(). can_ok $engine, qw(begin_work finish_work); my $mock_dbh = Test::MockModule->new(ref $engine->dbh, no_auto => 1); my $txn; $mock_dbh->mock(begin_work => sub { $txn = 1 }); $mock_dbh->mock(commit => sub { $txn = 0 }); $mock_dbh->mock(rollback => sub { $txn = -1 }); my @do; $mock_dbh->mock(do => sub { shift; @do = @_; }); ok $engine->begin_work, 'Begin work'; is $txn, 1, 'Should have started a transaction'; ok $engine->finish_work, 'Finish work'; is $txn, 0, 'Should have committed a transaction'; ok $engine->begin_work, 'Begin work again'; is $txn, 1, 'Should have started another transaction'; ok $engine->rollback_work, 'Rollback work'; is $txn, -1, 'Should have rolled back a transaction'; $mock_dbh->unmock('do'); ###################################################################### # Revert and re-deploy all the changes. my @all_changes = ($change, $change2, $fred, $barney, $ext_change, $ext_change2, $hyper, $ext_change3); ok $engine->log_revert_change($_), 'Revert "' . $_->name . '" change' for reverse @all_changes; ok $engine->log_deploy_change($_), 'Deploy "' . $_->name . '" change' for @all_changes; if ($class eq 'App::Sqitch::Engine::pg') { # Test _update_ids by old ID; required only for pg, which was the # only engine that existed at the time. my @proj_changes = ($change, $change2, $fred, $barney, $hyper); my @proj_tags = ($change->tags, $beta, $gamma); my @all_tags = (@proj_tags, $ext_tag); my $upd_change = $engine->dbh->prepare( 'UPDATE changes SET change_id = ? WHERE change_id = ?' ); my $upd_tag = $engine->dbh->prepare( 'UPDATE tags SET tag_id = ? WHERE tag_id = ?' ); for my $change (@proj_changes) { $upd_change->execute($change->old_id, $change->id); } for my $tag (@proj_tags) { $upd_tag->execute($tag->old_id, $tag->id); } # Mock Engine to silence the info notice. my $mock_engine = Test::MockModule->new('App::Sqitch::Engine'); $mock_engine->mock(plan => $plan); $mock_engine->mock(_update_ids => sub { shift }); is $engine->_update_ids, 10, 'Update IDs by old ID should return 10'; # All of the current project changes should be updated. is_deeply [ map { [@{$_}[0,1]] } @{ all_changes($engine) }], [ map { [ $_->id, $_->name ] } @all_changes ], 'All of the change IDs should have been updated'; # All of the current project tags should be updated. is_deeply [ map { [@{$_}[0,1]] } @{ all_tags($engine) }], [ map { [ $_->id, $_->format_name ] } @all_tags ], 'All of the tag IDs should have been updated'; # Now reset them so they have to be found by name. $i = 0; for my $change (@proj_changes) { $upd_change->execute($change->old_id . $i++, $change->id); } for my $tag (@proj_tags) { $upd_tag->execute($tag->old_id . $i++, $tag->id); } is $engine->_update_ids, 10, 'Update IDs by name should also return 10'; # All of the current project changes should be updated. is_deeply [ map { [@{$_}[0,1]] } @{ all_changes($engine) }], [ map { [ $_->id, $_->name ] } @all_changes ], 'All of the change IDs should have been updated by name'; # All of the current project tags should be updated. is_deeply [ map { [@{$_}[0,1]] } @{ all_tags($engine) }], [ map { [ $_->id, $_->format_name ] } @all_tags ], 'All of the tag IDs should have been updated by name'; } ###################################################################### # Add a reworked change. ok my $rev_change = $plan->rework( name => 'users' ), 'Rework change "users"'; my $deploy_file = $rev_change->deploy_file; my $tmp_dir = dir( tempdir CLEANUP => 1 ); $deploy_file->copy_to($tmp_dir); my $fh = $deploy_file->opena or die "Cannot open $deploy_file: $!\n"; try { say $fh '-- Append line to reworked script so it gets a new SHA-1 hash'; close $fh; $_->resolved_id( $engine->change_id_for_depend($_) ) for $rev_change->requires; ok $engine->log_deploy_change($rev_change), 'Deploy the reworked change'; } finally { # Restore the reworked script. $tmp_dir->file( $deploy_file->basename )->copy_to($deploy_file); }; # Make sure that change_id_for() chokes on the dupe. MOCKVENT: { my $sqitch_mocker = Test::MockModule->new(ref $sqitch); my @args; $sqitch_mocker->mock(vent => sub { shift; push @args => \@_ }); throws_ok { $engine->change_id_for( change => 'users') } 'App::Sqitch::X', 'Should die on ambiguous change spec'; is $@->ident, 'engine', 'Mode should be "engine"'; is $@->message, __ 'Change Lookup Failed', 'And it should report change lookup failure'; is_deeply \@args, [ [__x( 'Change "{change}" is ambiguous. Please specify a tag-qualified change:', change => 'users', )], [ ' * ', $rev_change->format_name . '@HEAD' ], [ ' * ', $change->format_tag_qualified_name ], ], 'Should have vented output for lookup failure'; } is $engine->change_id_for( change => 'users', tag => 'alpha'), $change->id, 'change_id_for() should find the tag-qualified change ID'; is $engine->change_id_for( change => 'users', tag => 'HEAD'), $rev_change->id, 'change_id_for() should find the reworked change ID @HEAD'; ###################################################################### # Tag and Rework the change again. ok $plan->tag(name => 'theta'), 'Tag the plan "theta"'; ok $engine->log_new_tags($rev_change), 'Log new tag'; ok my $rev_change2 = $plan->rework( name => 'users' ), 'Rework change "users" again'; $fh = $deploy_file->opena or die "Cannot open $deploy_file: $!\n"; try { say $fh '-- Append another line to reworked script for a new SHA-1 hash'; close $fh; $_->resolved_id( $engine->change_id_for_depend($_) ) for $rev_change2->requires; ok $engine->log_deploy_change($rev_change2), 'Deploy the reworked change'; } finally { # Restore the reworked script. $tmp_dir->file( $deploy_file->basename )->copy_to($deploy_file); }; # make sure that change_id_for is still good with things. for my $spec ( [ 'alpha instance of change', { change => 'users', tag => 'alpha' }, $change->id, ], [ 'HEAD instance of change', { change => 'users', tag => 'HEAD' }, $rev_change2->id, ], [ 'second instance of change by tag', { change => 'users', tag => 'theta' }, $rev_change->id, ], ) { my ( $desc, $params, $exp_id ) = @{ $spec }; is $engine->change_id_for(%{ $params }), $exp_id, "Should find id for $desc"; } # Unmock everything and call it a day. $mock_dbh->unmock_all; $mock_sqitch->unmock_all; ###################################################################### # Let's make sure script_hash upgrades work. $engine->dbh->do('UPDATE changes SET script_hash = change_id'); ok $engine->_update_script_hashes, 'Update script hashes'; # Make sure they were updated properly. my $sth = $engine->dbh->prepare( 'SELECT change_id, script_hash FROM changes WHERE project = ?', ); $sth->execute($plan->project); while (my $row = $sth->fetch) { my $change = $plan->get($row->[0]); is $row->[1], $change->script_hash, 'Should have updated script hash for ' . $change->name; } # Make sure no other projects were updated. $sth = $engine->dbh->prepare( 'SELECT change_id, script_hash FROM changes WHERE project <> ?', ); $sth->execute($plan->project); while (my $row = $sth->fetch) { is $row->[1], $row->[0], 'Change ID and script hash should be ' . substr $row->[0], 0, 6; } ###################################################################### # All done. done_testing; }; } sub dt_for_change { my $engine = shift; my $col = sprintf $engine->_ts2char_format, 'committed_at'; my $dtfunc = $engine->can('_dt'); $dtfunc->($engine->dbh->selectcol_arrayref( "SELECT $col FROM changes WHERE change_id = ?", undef, shift )->[0]); } sub dt_for_tag { my $engine = shift; my $col = sprintf $engine->_ts2char_format, 'committed_at'; my $dtfunc = $engine->can('_dt'); $dtfunc->($engine->dbh->selectcol_arrayref( "SELECT $col FROM tags WHERE tag_id = ?", undef, shift )->[0]); } sub all { my $iter = shift; my @res; while (my $row = $iter->()) { push @res => $row; } return \@res; } sub dt_for_event { my ($engine, $offset) = @_; my $col = sprintf $engine->_ts2char_format, 'committed_at'; my $dtfunc = $engine->can('_dt'); my $dbh = $engine->dbh; return $dtfunc->($engine->dbh->selectcol_arrayref(qq{ SELECT ts FROM ( SELECT ts, rownum AS rnum FROM ( SELECT $col AS ts FROM events ORDER BY committed_at ASC ) ) WHERE rnum = ? }, undef, $offset + 1)->[0]) if $dbh->{Driver}->{Name} eq 'Oracle'; return $dtfunc->($engine->dbh->selectcol_arrayref( "SELECT FIRST 1 SKIP $offset $col FROM events ORDER BY committed_at ASC", )->[0]) if $dbh->{Driver}->{Name} eq 'Firebird'; return $dtfunc->($engine->dbh->selectcol_arrayref( "SELECT $col FROM events ORDER BY committed_at ASC LIMIT 1 OFFSET $offset", )->[0]); } sub all_changes { shift->dbh->selectall_arrayref(q{ SELECT change_id, c.change, project, note, committer_name, committer_email, planner_name, planner_email FROM changes c ORDER BY committed_at }); } sub all_tags { shift->dbh->selectall_arrayref(q{ SELECT tag_id, tag, change_id, project, note, committer_name, committer_email, planner_name, planner_email FROM tags ORDER BY committed_at }); } sub all_events { shift->dbh->selectall_arrayref(q{ SELECT event, change_id, e.change, project, note, requires, conflicts, tags, committer_name, committer_email, planner_name, planner_email FROM events e ORDER BY committed_at }); } sub get_dependencies { shift->dbh->selectall_arrayref(q{ SELECT change_id, type, dependency, dependency_id FROM dependencies WHERE change_id = ? ORDER BY dependency }, undef, shift); } 1; App-Sqitch-0.9996/t/lib/LC.pm000644 000767 000024 00000000604 13133201371 015676 0ustar00davidstaff000000 000000 package LC; our $TIME = do { if ($^O eq 'MSWin32') { require Win32::Locale; Win32::Locale::get_locale(); } else { require POSIX; POSIX::setlocale( POSIX::LC_TIME() ); } }; # https://github.com/theory/sqitch/issues/230#issuecomment-103946451 # https://rt.cpan.org/Ticket/Display.html?id=104574 $TIME = 'en_US_POSIX' if $TIME eq 'C.UTF-8'; 1; App-Sqitch-0.9996/t/lib/MockOutput.pm000644 000767 000024 00000002120 13133201371 017505 0ustar00davidstaff000000 000000 package MockOutput; use 5.010; use strict; use warnings; use utf8; use Test::MockModule 0.05; our $MOCK = Test::MockModule->new('App::Sqitch'); my @mocked = qw( trace trace_literal debug debug_literal info info_literal comment comment_literal emit emit_literal vent vent_literal warn warn_literal page page_literal prompt ask_y_n ); my $INPUT; sub prompt_returns { $INPUT = $_[1]; } my $Y_N; sub ask_y_n_returns { $Y_N = $_[1]; } my %CAPTURED; __PACKAGE__->clear; for my $meth (@mocked) { $MOCK->mock($meth => sub { shift; push @{ $CAPTURED{$meth} } => [@_]; }); my $get = sub { my $ret = $CAPTURED{$meth}; $CAPTURED{$meth} = []; return $ret; }; no strict 'refs'; *{"get_$meth"} = $get; } $MOCK->mock(prompt => sub { shift; push @{ $CAPTURED{prompt} } => [@_]; return $INPUT; }); $MOCK->mock(ask_y_n => sub { shift; push @{ $CAPTURED{ask_y_n} } => [@_]; return $Y_N; }); sub clear { %CAPTURED = map { $_ => [] } @mocked; } 1; App-Sqitch-0.9996/t/lib/upgradable_registries/000755 000767 000024 00000000000 13133201371 021410 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/lib/upgradable_registries/firebird.sql000644 000767 000024 00000030622 13133201371 023722 0ustar00davidstaff000000 000000 /* * Sqitch database deployment metadata v1.0.; */ /* * Required PAGE SIZE = 16384 to avoid error: "key size exceeds * implementation restriction for index..." */ -- Table: releases CREATE TABLE releases ( version FLOAT NOT NULL PRIMARY KEY, installed_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL, installer_name VARCHAR(255) NOT NULL, installer_email VARCHAR(255) NOT NULL ); UPDATE RDB$RELATIONS SET RDB$DESCRIPTION = 'Sqitch registry releases.' WHERE RDB$RELATION_NAME = 'RELEASES'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Version of the Sqitch registry.' WHERE RDB$RELATION_NAME = 'RELEASES' AND RDB$FIELD_NAME = 'VERSION'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Date the registry release was installed.' WHERE RDB$RELATION_NAME = 'VERSIONS' AND RDB$FIELD_NAME = 'INSTALLED_AT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the user who installed the registry release.' WHERE RDB$RELATION_NAME = 'VERSIONS' AND RDB$FIELD_NAME = 'INSTALLER_NAME'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Email address of the user who installed the registry release.' WHERE RDB$RELATION_NAME = 'VERSIONS' AND RDB$FIELD_NAME = 'INSTALLER_EMAIL'; -- Table: projects CREATE TABLE projects ( project VARCHAR(255) NOT NULL PRIMARY KEY, uri VARCHAR(255) UNIQUE, created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL, creator_name VARCHAR(255) NOT NULL, creator_email VARCHAR(255) NOT NULL ); -- Description (comments) UPDATE RDB$RELATIONS SET RDB$DESCRIPTION = 'Sqitch projects deployed to this database.' WHERE RDB$RELATION_NAME = 'PROJECTS'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Unique Name of a project.' WHERE RDB$RELATION_NAME = 'PROJECTS' AND RDB$FIELD_NAME = 'PROJECT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Optional project URI.' WHERE RDB$RELATION_NAME = 'PROJECTS' AND RDB$FIELD_NAME = 'URI'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Date the project was added to the database.' WHERE RDB$RELATION_NAME = 'PROJECTS' AND RDB$FIELD_NAME = 'CREATED_AT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the user who added the project.' WHERE RDB$RELATION_NAME = 'PROJECTS' AND RDB$FIELD_NAME = 'CREATOR_NAME'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Email address of the user who added the project.' WHERE RDB$RELATION_NAME = 'PROJECTS' AND RDB$FIELD_NAME = 'CREATOR_EMAIL'; -- Table: changes CREATE TABLE changes ( change_id VARCHAR(40) NOT NULL PRIMARY KEY, change VARCHAR(255) NOT NULL, project VARCHAR(255) NOT NULL REFERENCES projects(project) ON UPDATE CASCADE, note BLOB SUB_TYPE TEXT DEFAULT '' NOT NULL, committed_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL, committer_name VARCHAR(255) NOT NULL, committer_email VARCHAR(255) NOT NULL, planned_at TIMESTAMP NOT NULL, planner_name VARCHAR(255) NOT NULL, planner_email VARCHAR(255) NOT NULL ); -- Description (comments) UPDATE RDB$RELATIONS SET RDB$DESCRIPTION = 'Tracks the changes currently deployed to the database.' WHERE RDB$RELATION_NAME = 'CHANGES'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Change primary key.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'CHANGE_ID'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of a deployed change.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'CHANGE'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the Sqitch project to which the change belongs.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'PROJECT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Description of the change.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'NOTE'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Date the change was deployed.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'COMMITTED_AT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the user who deployed the change.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'COMMITTER_NAME'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Email address of the user who deployed the change.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'COMMITTER_EMAIL'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Date the change was added to the plan.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'PLANNED_AT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the user who planed the change.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'PLANNER_NAME'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Email address of the user who planned the change.' WHERE RDB$RELATION_NAME = 'CHANGES' AND RDB$FIELD_NAME = 'PLANNER_EMAIL'; -- Table: tags CREATE TABLE tags ( tag_id CHAR(40) NOT NULL PRIMARY KEY, tag VARCHAR(250) NOT NULL, project VARCHAR(255) NOT NULL REFERENCES projects(project) ON UPDATE CASCADE, change_id CHAR(40) NOT NULL REFERENCES changes(change_id) ON UPDATE CASCADE, note BLOB SUB_TYPE TEXT DEFAULT '' NOT NULL, committed_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL, committer_name VARCHAR(512) NOT NULL, committer_email VARCHAR(512) NOT NULL, planned_at TIMESTAMP NOT NULL, planner_name VARCHAR(512) NOT NULL, planner_email VARCHAR(512) NOT NULL, UNIQUE(project, tag) ); -- Description (comments) UPDATE RDB$RELATIONS SET RDB$DESCRIPTION = 'Tracks the tags currently applied to the database.' WHERE RDB$RELATION_NAME = 'TAGS'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Tag primary key.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'TAG_ID'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Project-unique tag name.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'TAG'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the Sqitch project to which the tag belongs.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'PROJECT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'ID of last change deployed before the tag was applied.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'CHANGE_ID'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Description of the tag.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'NOTE'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Date the tag was applied to the database.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'COMMITTED_AT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the user who applied the tag.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'COMMITTER_NAME'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Email address of the user who applied the tag.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'COMMITTER_EMAIL'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Date the tag was added to the plan.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'PLANNED_AT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the user who planed the tag.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'PLANNER_NAME'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Email address of the user who planned the tag.' WHERE RDB$RELATION_NAME = 'TAGS' AND RDB$FIELD_NAME = 'PLANNER_EMAIL'; -- Table: dependencies CREATE TABLE dependencies ( change_id CHAR(40) NOT NULL REFERENCES changes(change_id) ON UPDATE CASCADE ON DELETE CASCADE, type VARCHAR(8) NOT NULL, dependency VARCHAR(512) NOT NULL, dependency_id CHAR(40) REFERENCES changes(change_id) ON UPDATE CASCADE CHECK ( (type = 'require' AND dependency_id IS NOT NULL) OR (type = 'conflict' AND dependency_id IS NULL) ), PRIMARY KEY (change_id, dependency) ); -- Description (comments) UPDATE RDB$RELATIONS SET RDB$DESCRIPTION = 'Tracks the currently satisfied dependencies.' WHERE RDB$RELATION_NAME = 'DEPENDENCIES'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'ID of the depending change.' WHERE RDB$RELATION_NAME = 'DEPENDENCIES' AND RDB$FIELD_NAME = 'CHANGE_ID'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Type of dependency.' WHERE RDB$RELATION_NAME = 'DEPENDENCIES' AND RDB$FIELD_NAME = 'TYPE'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Dependency name.' WHERE RDB$RELATION_NAME = 'DEPENDENCIES' AND RDB$FIELD_NAME = 'DEPENDENCY'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Change ID the dependency resolves to.' WHERE RDB$RELATION_NAME = 'DEPENDENCIES' AND RDB$FIELD_NAME = 'DEPENDENCY_ID'; -- Table: events CREATE TABLE events ( event VARCHAR(6) NOT NULL CHECK (event IN ('deploy', 'revert', 'fail')), change_id CHAR(40) NOT NULL, change VARCHAR(512) NOT NULL, project VARCHAR(255) NOT NULL REFERENCES projects(project) ON UPDATE CASCADE, note BLOB SUB_TYPE TEXT DEFAULT '' NOT NULL, requires BLOB SUB_TYPE TEXT DEFAULT '' NOT NULL, conflicts BLOB SUB_TYPE TEXT DEFAULT '' NOT NULL, tags BLOB SUB_TYPE TEXT DEFAULT '' NOT NULL, committed_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL, committer_name VARCHAR(512) NOT NULL, committer_email VARCHAR(512) NOT NULL, planned_at TIMESTAMP NOT NULL, planner_name VARCHAR(512) NOT NULL, planner_email VARCHAR(512) NOT NULL, PRIMARY KEY (change_id, committed_at) ); -- Description (comments) UPDATE RDB$RELATIONS SET RDB$DESCRIPTION = 'Contains full history of all deployment events.' WHERE RDB$RELATION_NAME = 'EVENTS'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Type of event.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'EVENT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Change ID.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'CHANGE_ID'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Change name.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'CHANGE'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the Sqitch project to which the change belongs.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'PROJECT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Description of the change.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'NOTE'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Array of the names of required changes.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'REQUIRES'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Array of the names of conflicting changes.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'CONFLICTS'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Tags associated with the change.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'TAGS'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Date the event was committed.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'COMMITTED_AT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the user who committed the event.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'COMMITTER_NAME'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Email address of the user who committed the event.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'COMMITTER_EMAIL'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Date the event was added to the plan.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'PLANNED_AT'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Name of the user who planed the change.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'PLANNER_NAME'; UPDATE RDB$RELATION_FIELDS SET RDB$DESCRIPTION = 'Email address of the user who plan planned the change.' WHERE RDB$RELATION_NAME = 'EVENTS' AND RDB$FIELD_NAME = 'PLANNER_EMAIL'; COMMIT; App-Sqitch-0.9996/t/lib/upgradable_registries/mysql.sql000644 000767 000024 00000017667 13133201371 023317 0ustar00davidstaff000000 000000 BEGIN; SET SESSION sql_mode = ansi; CREATE TABLE releases ( version FLOAT PRIMARY KEY COMMENT 'Version of the Sqitch registry.', installed_at TIMESTAMP NOT NULL COMMENT 'Date the registry release was installed.', installer_name VARCHAR(255) NOT NULL COMMENT 'Name of the user who installed the registry release.', installer_email VARCHAR(255) NOT NULL COMMENT 'Email address of the user who installed the registry release.' ) ENGINE InnoDB, CHARACTER SET 'utf8', COMMENT 'Sqitch registry releases.' ; CREATE TABLE projects ( project VARCHAR(255) PRIMARY KEY COMMENT 'Unique Name of a project.', uri VARCHAR(255) NULL UNIQUE COMMENT 'Optional project URI', created_at DATETIME(6) NOT NULL COMMENT 'Date the project was added to the database.', creator_name VARCHAR(255) NOT NULL COMMENT 'Name of the user who added the project.', creator_email VARCHAR(255) NOT NULL COMMENT 'Email address of the user who added the project.' ) ENGINE InnoDB, CHARACTER SET 'utf8', COMMENT 'Sqitch projects deployed to this database.' ; CREATE TABLE changes ( change_id VARCHAR(40) PRIMARY KEY COMMENT 'Change primary key.', "change" VARCHAR(255) NOT NULL COMMENT 'Name of a deployed change.', project VARCHAR(255) NOT NULL COMMENT 'Name of the Sqitch project to which the change belongs.' REFERENCES projects(project) ON UPDATE CASCADE, note TEXT NOT NULL COMMENT 'Description of the change.', committed_at DATETIME(6) NOT NULL COMMENT 'Date the change was deployed.', committer_name VARCHAR(255) NOT NULL COMMENT 'Name of the user who deployed the change.', committer_email VARCHAR(255) NOT NULL COMMENT 'Email address of the user who deployed the change.', planned_at DATETIME(6) NOT NULL COMMENT 'Date the change was added to the plan.', planner_name VARCHAR(255) NOT NULL COMMENT 'Name of the user who planed the change.', planner_email VARCHAR(255) NOT NULL COMMENT 'Email address of the user who planned the change.' ) ENGINE InnoDB, CHARACTER SET 'utf8', COMMENT 'Tracks the changes currently deployed to the database.' ; CREATE TABLE tags ( tag_id VARCHAR(40) PRIMARY KEY COMMENT 'Tag primary key.', tag VARCHAR(255) NOT NULL COMMENT 'Project-unique tag name.', project VARCHAR(255) NOT NULL COMMENT 'Name of the Sqitch project to which the tag belongs.' REFERENCES projects(project) ON UPDATE CASCADE, change_id VARCHAR(40) NOT NULL COMMENT 'ID of last change deployed before the tag was applied.' REFERENCES changes(change_id) ON UPDATE CASCADE, note VARCHAR(255) NOT NULL COMMENT 'Description of the tag.', committed_at DATETIME(6) NOT NULL COMMENT 'Date the tag was applied to the database.', committer_name VARCHAR(255) NOT NULL COMMENT 'Name of the user who applied the tag.', committer_email VARCHAR(255) NOT NULL COMMENT 'Email address of the user who applied the tag.', planned_at DATETIME(6) NOT NULL COMMENT 'Date the tag was added to the plan.', planner_name VARCHAR(255) NOT NULL COMMENT 'Name of the user who planed the tag.', planner_email VARCHAR(255) NOT NULL COMMENT 'Email address of the user who planned the tag.', UNIQUE(project, tag) ) ENGINE InnoDB, CHARACTER SET 'utf8', COMMENT 'Tracks the tags currently applied to the database.' ; CREATE TABLE dependencies ( change_id VARCHAR(40) NOT NULL COMMENT 'ID of the depending change.' REFERENCES changes(change_id) ON UPDATE CASCADE ON DELETE CASCADE, type VARCHAR(8) NOT NULL COMMENT 'Type of dependency.', dependency VARCHAR(255) NOT NULL COMMENT 'Dependency name.', dependency_id VARCHAR(40) NULL COMMENT 'Change ID the dependency resolves to.' REFERENCES changes(change_id) ON UPDATE CASCADE, PRIMARY KEY (change_id, dependency) ) ENGINE InnoDB, CHARACTER SET 'utf8', COMMENT 'Tracks the currently satisfied dependencies.' ; CREATE TABLE events ( event ENUM ('deploy', 'fail', 'revert') NOT NULL COMMENT 'Type of event.', change_id VARCHAR(40) NOT NULL COMMENT 'Change ID.', "change" VARCHAR(255) NOT NULL COMMENT 'Change name.', project VARCHAR(255) NOT NULL COMMENT 'Name of the Sqitch project to which the change belongs.' REFERENCES projects(project) ON UPDATE CASCADE, note TEXT NOT NULL COMMENT 'Description of the change.', requires TEXT NOT NULL COMMENT 'List of the names of required changes.', conflicts TEXT NOT NULL COMMENT 'List of the names of conflicting changes.', tags TEXT NOT NULL COMMENT 'List of tags associated with the change.', committed_at DATETIME(6) NOT NULL COMMENT 'Date the event was committed.', committer_name VARCHAR(255) NOT NULL COMMENT 'Name of the user who committed the event.', committer_email VARCHAR(255) NOT NULL COMMENT 'Email address of the user who committed the event.', planned_at DATETIME(6) NOT NULL COMMENT 'Date the event was added to the plan.', planner_name VARCHAR(255) NOT NULL COMMENT 'Name of the user who planed the change.', planner_email VARCHAR(255) NOT NULL COMMENT 'Email address of the user who plan planned the change.', PRIMARY KEY (change_id, committed_at) ) ENGINE InnoDB, CHARACTER SET 'utf8', COMMENT 'Contains full history of all deployment events.' ; -- ## BEGIN 5.5 -- MySQL does not support checks, so we kind of create our own. The checkit() -- function works sort of like a CHECK: if the first argument is 0 or NULL, it -- throws the second argument as an exception. Conveniently, verify scripts -- can also use it to ensure an error is thrown when a change cannot be -- verified. Requires MySQL 5.5.0. DELIMITER | CREATE FUNCTION checkit(doit INTEGER, message VARCHAR(256)) RETURNS INTEGER DETERMINISTIC BEGIN IF doit IS NULL OR doit = 0 THEN SIGNAL SQLSTATE 'ERR0R' SET MESSAGE_TEXT = message; END IF; RETURN doit; END; | CREATE TRIGGER ck_insert_dependency BEFORE INSERT ON dependencies FOR EACH ROW BEGIN -- DO does not work. http://bugs.mysql.com/bug.php?id=69647 SET @dummy := checkit( (NEW.type = 'require' AND NEW.dependency_id IS NOT NULL) OR (NEW.type = 'conflict' AND NEW.dependency_id IS NULL), 'Type must be "require" with dependency_id set or "conflict" with dependency_id not set' ); END; | CREATE TRIGGER ck_update_dependency BEFORE UPDATE ON dependencies FOR EACH ROW BEGIN -- DO does not work. http://bugs.mysql.com/bug.php?id=69647 SET @dummy := checkit( (NEW.type = 'require' AND NEW.dependency_id IS NOT NULL) OR (NEW.type = 'conflict' AND NEW.dependency_id IS NULL), 'Type must be "require" with dependency_id set or "conflict" with dependency_id not set' ); END; | DELIMITER ; -- ## END 5.5 COMMIT; App-Sqitch-0.9996/t/lib/upgradable_registries/oracle.sql000644 000767 000024 00000021536 13133201371 023405 0ustar00davidstaff000000 000000 CREATE TABLE ®istry..releases ( version FLOAT PRIMARY KEY, installed_at TIMESTAMP WITH TIME ZONE DEFAULT current_timestamp NOT NULL, installer_name VARCHAR2(512 CHAR) NOT NULL, installer_email VARCHAR2(512 CHAR) NOT NULL ); COMMENT ON TABLE ®istry..releases IS 'Sqitch registry releases.'; COMMENT ON COLUMN ®istry..releases.version IS 'Version of the Sqitch registry.'; COMMENT ON COLUMN ®istry..releases.installed_at IS 'Date the registry release was installed.'; COMMENT ON COLUMN ®istry..releases.installer_name IS 'Name of the user who installed the registry release.'; COMMENT ON COLUMN ®istry..releases.installer_email IS 'Email address of the user who installed the registry release.'; CREATE TABLE ®istry..projects ( project VARCHAR2(512 CHAR) PRIMARY KEY, uri VARCHAR2(512 CHAR) NULL UNIQUE, created_at TIMESTAMP WITH TIME ZONE DEFAULT current_timestamp NOT NULL, creator_name VARCHAR2(512 CHAR) NOT NULL, creator_email VARCHAR2(512 CHAR) NOT NULL ); COMMENT ON TABLE ®istry..projects IS 'Sqitch projects deployed to this database.'; COMMENT ON COLUMN ®istry..projects.project IS 'Unique Name of a project.'; COMMENT ON COLUMN ®istry..projects.uri IS 'Optional project URI'; COMMENT ON COLUMN ®istry..projects.created_at IS 'Date the project was added to the database.'; COMMENT ON COLUMN ®istry..projects.creator_name IS 'Name of the user who added the project.'; COMMENT ON COLUMN ®istry..projects.creator_email IS 'Email address of the user who added the project.'; CREATE TABLE ®istry..changes ( change_id CHAR(40) PRIMARY KEY, change VARCHAR2(512 CHAR) NOT NULL, project VARCHAR2(512 CHAR) NOT NULL REFERENCES ®istry..projects(project), note VARCHAR2(4000 CHAR) DEFAULT '', committed_at TIMESTAMP WITH TIME ZONE DEFAULT current_timestamp NOT NULL, committer_name VARCHAR2(512 CHAR) NOT NULL, committer_email VARCHAR2(512 CHAR) NOT NULL, planned_at TIMESTAMP WITH TIME ZONE NOT NULL, planner_name VARCHAR2(512 CHAR) NOT NULL, planner_email VARCHAR2(512 CHAR) NOT NULL ); COMMENT ON TABLE ®istry..changes IS 'Tracks the changes currently deployed to the database.'; COMMENT ON COLUMN ®istry..changes.change_id IS 'Change primary key.'; COMMENT ON COLUMN ®istry..changes.change IS 'Name of a deployed change.'; COMMENT ON COLUMN ®istry..changes.project IS 'Name of the Sqitch project to which the change belongs.'; COMMENT ON COLUMN ®istry..changes.note IS 'Description of the change.'; COMMENT ON COLUMN ®istry..changes.committed_at IS 'Date the change was deployed.'; COMMENT ON COLUMN ®istry..changes.committer_name IS 'Name of the user who deployed the change.'; COMMENT ON COLUMN ®istry..changes.committer_email IS 'Email address of the user who deployed the change.'; COMMENT ON COLUMN ®istry..changes.planned_at IS 'Date the change was added to the plan.'; COMMENT ON COLUMN ®istry..changes.planner_name IS 'Name of the user who planed the change.'; COMMENT ON COLUMN ®istry..changes.planner_email IS 'Email address of the user who planned the change.'; CREATE TABLE ®istry..tags ( tag_id CHAR(40) PRIMARY KEY, tag VARCHAR2(512 CHAR) NOT NULL, project VARCHAR2(512 CHAR) NOT NULL REFERENCES ®istry..projects(project), change_id CHAR(40) NOT NULL REFERENCES ®istry..changes(change_id), note VARCHAR2(4000 CHAR) DEFAULT '', committed_at TIMESTAMP WITH TIME ZONE DEFAULT current_timestamp NOT NULL, committer_name VARCHAR2(512 CHAR) NOT NULL, committer_email VARCHAR2(512 CHAR) NOT NULL, planned_at TIMESTAMP WITH TIME ZONE NOT NULL, planner_name VARCHAR2(512 CHAR) NOT NULL, planner_email VARCHAR2(512 CHAR) NOT NULL, UNIQUE(project, tag) ); COMMENT ON TABLE ®istry..tags IS 'Tracks the tags currently applied to the database.'; COMMENT ON COLUMN ®istry..tags.tag_id IS 'Tag primary key.'; COMMENT ON COLUMN ®istry..tags.tag IS 'Project-unique tag name.'; COMMENT ON COLUMN ®istry..tags.project IS 'Name of the Sqitch project to which the tag belongs.'; COMMENT ON COLUMN ®istry..tags.change_id IS 'ID of last change deployed before the tag was applied.'; COMMENT ON COLUMN ®istry..tags.note IS 'Description of the tag.'; COMMENT ON COLUMN ®istry..tags.committed_at IS 'Date the tag was applied to the database.'; COMMENT ON COLUMN ®istry..tags.committer_name IS 'Name of the user who applied the tag.'; COMMENT ON COLUMN ®istry..tags.committer_email IS 'Email address of the user who applied the tag.'; COMMENT ON COLUMN ®istry..tags.planned_at IS 'Date the tag was added to the plan.'; COMMENT ON COLUMN ®istry..tags.planner_name IS 'Name of the user who planed the tag.'; COMMENT ON COLUMN ®istry..tags.planner_email IS 'Email address of the user who planned the tag.'; CREATE TABLE ®istry..dependencies ( change_id CHAR(40) NOT NULL REFERENCES ®istry..changes(change_id) ON DELETE CASCADE, type VARCHAR2(8) NOT NULL, dependency VARCHAR2(1024 CHAR) NOT NULL, dependency_id CHAR(40) NULL REFERENCES ®istry..changes(change_id), CHECK ( (type = 'require' AND dependency_id IS NOT NULL) OR (type = 'conflict' AND dependency_id IS NULL) ), PRIMARY KEY (change_id, dependency) ); COMMENT ON TABLE ®istry..dependencies IS 'Tracks the currently satisfied dependencies.'; COMMENT ON COLUMN ®istry..dependencies.change_id IS 'ID of the depending change.'; COMMENT ON COLUMN ®istry..dependencies.type IS 'Type of dependency.'; COMMENT ON COLUMN ®istry..dependencies.dependency IS 'Dependency name.'; COMMENT ON COLUMN ®istry..dependencies.dependency_id IS 'Change ID the dependency resolves to.'; CREATE TYPE ®istry..sqitch_array AS varray(1024) OF VARCHAR2(512); / CREATE TABLE ®istry..events ( event VARCHAR2(6) NOT NULL CHECK (event IN ('deploy', 'revert', 'fail')), change_id CHAR(40) NOT NULL, change VARCHAR2(512 CHAR) NOT NULL, project VARCHAR2(512 CHAR) NOT NULL REFERENCES ®istry..projects(project), note VARCHAR2(4000 CHAR) DEFAULT '', requires ®istry..SQITCH_ARRAY DEFAULT ®istry..SQITCH_ARRAY() NOT NULL, conflicts ®istry..SQITCH_ARRAY DEFAULT ®istry..SQITCH_ARRAY() NOT NULL, tags ®istry..SQITCH_ARRAY DEFAULT ®istry..SQITCH_ARRAY() NOT NULL, committed_at TIMESTAMP WITH TIME ZONE DEFAULT current_timestamp NOT NULL, committer_name VARCHAR2(512 CHAR) NOT NULL, committer_email VARCHAR2(512 CHAR) NOT NULL, planned_at TIMESTAMP WITH TIME ZONE NOT NULL, planner_name VARCHAR2(512 CHAR) NOT NULL, planner_email VARCHAR2(512 CHAR) NOT NULL ); CREATE UNIQUE INDEX ®istry..events_pkey ON ®istry..events(change_id, committed_at); COMMENT ON TABLE ®istry..events IS 'Contains full history of all deployment events.'; COMMENT ON COLUMN ®istry..events.event IS 'Type of event.'; COMMENT ON COLUMN ®istry..events.change_id IS 'Change ID.'; COMMENT ON COLUMN ®istry..events.change IS 'Change name.'; COMMENT ON COLUMN ®istry..events.project IS 'Name of the Sqitch project to which the change belongs.'; COMMENT ON COLUMN ®istry..events.note IS 'Description of the change.'; COMMENT ON COLUMN ®istry..events.requires IS 'Array of the names of required changes.'; COMMENT ON COLUMN ®istry..events.conflicts IS 'Array of the names of conflicting changes.'; COMMENT ON COLUMN ®istry..events.tags IS 'Tags associated with the change.'; COMMENT ON COLUMN ®istry..events.committed_at IS 'Date the event was committed.'; COMMENT ON COLUMN ®istry..events.committer_name IS 'Name of the user who committed the event.'; COMMENT ON COLUMN ®istry..events.committer_email IS 'Email address of the user who committed the event.'; COMMENT ON COLUMN ®istry..events.planned_at IS 'Date the event was added to the plan.'; COMMENT ON COLUMN ®istry..events.planner_name IS 'Name of the user who planed the change.'; COMMENT ON COLUMN ®istry..events.planner_email IS 'Email address of the user who plan planned the change.'; App-Sqitch-0.9996/t/lib/upgradable_registries/pg.sql000644 000767 000024 00000020636 13133201371 022546 0ustar00davidstaff000000 000000 BEGIN; SET client_min_messages = warning; CREATE SCHEMA IF NOT EXISTS :"registry"; COMMENT ON SCHEMA :"registry" IS 'Sqitch database deployment metadata v1.0.'; CREATE TABLE :"registry".releases ( version REAL PRIMARY KEY, installed_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), installer_name TEXT NOT NULL, installer_email TEXT NOT NULL ); COMMENT ON TABLE :"registry".releases IS 'Sqitch registry releases.'; COMMENT ON COLUMN :"registry".releases.version IS 'Version of the Sqitch registry.'; COMMENT ON COLUMN :"registry".releases.installed_at IS 'Date the registry release was installed.'; COMMENT ON COLUMN :"registry".releases.installer_name IS 'Name of the user who installed the registry release.'; COMMENT ON COLUMN :"registry".releases.installer_email IS 'Email address of the user who installed the registry release.'; CREATE TABLE :"registry".projects ( project TEXT PRIMARY KEY, uri TEXT NULL UNIQUE, created_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), creator_name TEXT NOT NULL, creator_email TEXT NOT NULL ):tableopts; COMMENT ON TABLE :"registry".projects IS 'Sqitch projects deployed to this database.'; COMMENT ON COLUMN :"registry".projects.project IS 'Unique Name of a project.'; COMMENT ON COLUMN :"registry".projects.uri IS 'Optional project URI'; COMMENT ON COLUMN :"registry".projects.created_at IS 'Date the project was added to the database.'; COMMENT ON COLUMN :"registry".projects.creator_name IS 'Name of the user who added the project.'; COMMENT ON COLUMN :"registry".projects.creator_email IS 'Email address of the user who added the project.'; CREATE TABLE :"registry".changes ( change_id TEXT PRIMARY KEY, change TEXT NOT NULL, project TEXT NOT NULL REFERENCES :"registry".projects(project) ON UPDATE CASCADE, note TEXT NOT NULL DEFAULT '', committed_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), committer_name TEXT NOT NULL, committer_email TEXT NOT NULL, planned_at TIMESTAMPTZ NOT NULL, planner_name TEXT NOT NULL, planner_email TEXT NOT NULL ):tableopts; COMMENT ON TABLE :"registry".changes IS 'Tracks the changes currently deployed to the database.'; COMMENT ON COLUMN :"registry".changes.change_id IS 'Change primary key.'; COMMENT ON COLUMN :"registry".changes.change IS 'Name of a deployed change.'; COMMENT ON COLUMN :"registry".changes.project IS 'Name of the Sqitch project to which the change belongs.'; COMMENT ON COLUMN :"registry".changes.note IS 'Description of the change.'; COMMENT ON COLUMN :"registry".changes.committed_at IS 'Date the change was deployed.'; COMMENT ON COLUMN :"registry".changes.committer_name IS 'Name of the user who deployed the change.'; COMMENT ON COLUMN :"registry".changes.committer_email IS 'Email address of the user who deployed the change.'; COMMENT ON COLUMN :"registry".changes.planned_at IS 'Date the change was added to the plan.'; COMMENT ON COLUMN :"registry".changes.planner_name IS 'Name of the user who planed the change.'; COMMENT ON COLUMN :"registry".changes.planner_email IS 'Email address of the user who planned the change.'; CREATE TABLE :"registry".tags ( tag_id TEXT PRIMARY KEY, tag TEXT NOT NULL, project TEXT NOT NULL REFERENCES :"registry".projects(project) ON UPDATE CASCADE, change_id TEXT NOT NULL REFERENCES :"registry".changes(change_id) ON UPDATE CASCADE, note TEXT NOT NULL DEFAULT '', committed_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), committer_name TEXT NOT NULL, committer_email TEXT NOT NULL, planned_at TIMESTAMPTZ NOT NULL, planner_name TEXT NOT NULL, planner_email TEXT NOT NULL, UNIQUE(project, tag) ):tableopts; COMMENT ON TABLE :"registry".tags IS 'Tracks the tags currently applied to the database.'; COMMENT ON COLUMN :"registry".tags.tag_id IS 'Tag primary key.'; COMMENT ON COLUMN :"registry".tags.tag IS 'Project-unique tag name.'; COMMENT ON COLUMN :"registry".tags.project IS 'Name of the Sqitch project to which the tag belongs.'; COMMENT ON COLUMN :"registry".tags.change_id IS 'ID of last change deployed before the tag was applied.'; COMMENT ON COLUMN :"registry".tags.note IS 'Description of the tag.'; COMMENT ON COLUMN :"registry".tags.committed_at IS 'Date the tag was applied to the database.'; COMMENT ON COLUMN :"registry".tags.committer_name IS 'Name of the user who applied the tag.'; COMMENT ON COLUMN :"registry".tags.committer_email IS 'Email address of the user who applied the tag.'; COMMENT ON COLUMN :"registry".tags.planned_at IS 'Date the tag was added to the plan.'; COMMENT ON COLUMN :"registry".tags.planner_name IS 'Name of the user who planed the tag.'; COMMENT ON COLUMN :"registry".tags.planner_email IS 'Email address of the user who planned the tag.'; CREATE TABLE :"registry".dependencies ( change_id TEXT NOT NULL REFERENCES :"registry".changes(change_id) ON UPDATE CASCADE ON DELETE CASCADE, type TEXT NOT NULL, dependency TEXT NOT NULL, dependency_id TEXT NULL REFERENCES :"registry".changes(change_id) ON UPDATE CASCADE CHECK ( (type = 'require' AND dependency_id IS NOT NULL) OR (type = 'conflict' AND dependency_id IS NULL) ), PRIMARY KEY (change_id, dependency) ):tableopts; COMMENT ON TABLE :"registry".dependencies IS 'Tracks the currently satisfied dependencies.'; COMMENT ON COLUMN :"registry".dependencies.change_id IS 'ID of the depending change.'; COMMENT ON COLUMN :"registry".dependencies.type IS 'Type of dependency.'; COMMENT ON COLUMN :"registry".dependencies.dependency IS 'Dependency name.'; COMMENT ON COLUMN :"registry".dependencies.dependency_id IS 'Change ID the dependency resolves to.'; CREATE TABLE :"registry".events ( event TEXT NOT NULL CHECK (event IN ('deploy', 'revert', 'fail')), change_id TEXT NOT NULL, change TEXT NOT NULL, project TEXT NOT NULL REFERENCES :"registry".projects(project) ON UPDATE CASCADE, note TEXT NOT NULL DEFAULT '', requires TEXT[] NOT NULL DEFAULT '{}', conflicts TEXT[] NOT NULL DEFAULT '{}', tags TEXT[] NOT NULL DEFAULT '{}', committed_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), committer_name TEXT NOT NULL, committer_email TEXT NOT NULL, planned_at TIMESTAMPTZ NOT NULL, planner_name TEXT NOT NULL, planner_email TEXT NOT NULL, PRIMARY KEY (change_id, committed_at) ):tableopts; COMMENT ON TABLE :"registry".events IS 'Contains full history of all deployment events.'; COMMENT ON COLUMN :"registry".events.event IS 'Type of event.'; COMMENT ON COLUMN :"registry".events.change_id IS 'Change ID.'; COMMENT ON COLUMN :"registry".events.change IS 'Change name.'; COMMENT ON COLUMN :"registry".events.project IS 'Name of the Sqitch project to which the change belongs.'; COMMENT ON COLUMN :"registry".events.note IS 'Description of the change.'; COMMENT ON COLUMN :"registry".events.requires IS 'Array of the names of required changes.'; COMMENT ON COLUMN :"registry".events.conflicts IS 'Array of the names of conflicting changes.'; COMMENT ON COLUMN :"registry".events.tags IS 'Tags associated with the change.'; COMMENT ON COLUMN :"registry".events.committed_at IS 'Date the event was committed.'; COMMENT ON COLUMN :"registry".events.committer_name IS 'Name of the user who committed the event.'; COMMENT ON COLUMN :"registry".events.committer_email IS 'Email address of the user who committed the event.'; COMMENT ON COLUMN :"registry".events.planned_at IS 'Date the event was added to the plan.'; COMMENT ON COLUMN :"registry".events.planner_name IS 'Name of the user who planed the change.'; COMMENT ON COLUMN :"registry".events.planner_email IS 'Email address of the user who plan planned the change.'; COMMIT; App-Sqitch-0.9996/t/lib/upgradable_registries/sqlite.sql000644 000767 000024 00000005667 13133201371 023450 0ustar00davidstaff000000 000000 BEGIN; CREATE TABLE releases ( version FLOAT PRIMARY KEY, installed_at DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP, installer_name TEXT NOT NULL, installer_email TEXT NOT NULL ); CREATE TABLE projects ( project TEXT PRIMARY KEY, uri TEXT NULL UNIQUE, created_at DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP, creator_name TEXT NOT NULL, creator_email TEXT NOT NULL ); CREATE TABLE changes ( change_id TEXT PRIMARY KEY, change TEXT NOT NULL, project TEXT NOT NULL REFERENCES projects(project) ON UPDATE CASCADE, note TEXT NOT NULL DEFAULT '', committed_at DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP, committer_name TEXT NOT NULL, committer_email TEXT NOT NULL, planned_at DATETIME NOT NULL, planner_name TEXT NOT NULL, planner_email TEXT NOT NULL ); CREATE TABLE tags ( tag_id TEXT PRIMARY KEY, tag TEXT NOT NULL, project TEXT NOT NULL REFERENCES projects(project) ON UPDATE CASCADE, change_id TEXT NOT NULL REFERENCES changes(change_id) ON UPDATE CASCADE, note TEXT NOT NULL DEFAULT '', committed_at DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP, committer_name TEXT NOT NULL, committer_email TEXT NOT NULL, planned_at DATETIME NOT NULL, planner_name TEXT NOT NULL, planner_email TEXT NOT NULL, UNIQUE(project, tag) ); CREATE TABLE dependencies ( change_id TEXT NOT NULL REFERENCES changes(change_id) ON UPDATE CASCADE ON DELETE CASCADE, type TEXT NOT NULL, dependency TEXT NOT NULL, dependency_id TEXT NULL REFERENCES changes(change_id) ON UPDATE CASCADE CHECK ( (type = 'require' AND dependency_id IS NOT NULL) OR (type = 'conflict' AND dependency_id IS NULL) ), PRIMARY KEY (change_id, dependency) ); CREATE TABLE events ( event TEXT NOT NULL CHECK (event IN ('deploy', 'revert', 'fail')), change_id TEXT NOT NULL, change TEXT NOT NULL, project TEXT NOT NULL REFERENCES projects(project) ON UPDATE CASCADE, note TEXT NOT NULL DEFAULT '', requires TEXT NOT NULL DEFAULT '', conflicts TEXT NOT NULL DEFAULT '', tags TEXT NOT NULL DEFAULT '', committed_at DATETIME NOT NULL DEFAULT CURRENT_TIMESTAMP, committer_name TEXT NOT NULL, committer_email TEXT NOT NULL, planned_at DATETIME NOT NULL, planner_name TEXT NOT NULL, planner_email TEXT NOT NULL, PRIMARY KEY (change_id, committed_at) ); COMMIT; App-Sqitch-0.9996/t/lib/upgradable_registries/vertica.sql000644 000767 000024 00000007264 13133201371 023577 0ustar00davidstaff000000 000000 CREATE SCHEMA :"registry"; COMMENT ON SCHEMA :"registry" IS 'Sqitch database deployment metadata v1.0.'; CREATE TABLE :"registry".releases ( version FLOAT PRIMARY KEY, installed_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), installer_name VARCHAR(1024) NOT NULL, installer_email VARCHAR(1024) NOT NULL ); COMMENT ON TABLE :"registry".releases IS 'Sqitch registry releases.'; CREATE TABLE :"registry".projects ( project VARCHAR(1024) PRIMARY KEY ENCODING AUTO, uri VARCHAR(1024) NULL UNIQUE, created_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), creator_name VARCHAR(1024) NOT NULL, creator_email VARCHAR(1024) NOT NULL ); COMMENT ON TABLE :"registry".projects IS 'Sqitch projects deployed to this database.'; CREATE TABLE :"registry".changes ( change_id CHAR(40) PRIMARY KEY ENCODING AUTO, change VARCHAR(1024) NOT NULL, project VARCHAR(1024) NOT NULL REFERENCES :"registry".projects(project), note VARCHAR(65000) NOT NULL DEFAULT '', committed_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), committer_name VARCHAR(1024) NOT NULL, committer_email VARCHAR(1024) NOT NULL, planned_at TIMESTAMPTZ NOT NULL, planner_name VARCHAR(1024) NOT NULL, planner_email VARCHAR(1024) NOT NULL ); COMMENT ON TABLE :"registry".changes IS 'Tracks the changes currently deployed to the database.'; CREATE TABLE :"registry".tags ( tag_id CHAR(40) PRIMARY KEY ENCODING AUTO, tag VARCHAR(1024) NOT NULL, project VARCHAR(1024) NOT NULL REFERENCES :"registry".projects(project), change_id CHAR(40) NOT NULL REFERENCES :"registry".changes(change_id), note VARCHAR(65000) NOT NULL DEFAULT '', committed_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), committer_name VARCHAR(1024) NOT NULL, committer_email VARCHAR(1024) NOT NULL, planned_at TIMESTAMPTZ NOT NULL, planner_name VARCHAR(1024) NOT NULL, planner_email VARCHAR(1024) NOT NULL, UNIQUE(project, tag) ); COMMENT ON TABLE :"registry".tags IS 'Tracks the tags currently applied to the database.'; CREATE TABLE :"registry".dependencies ( change_id CHAR(40) NOT NULL REFERENCES :"registry".changes(change_id), type VARCHAR(8) NOT NULL ENCODING AUTO, dependency VARCHAR(2048) NOT NULL, dependency_id CHAR(40) NULL REFERENCES :"registry".changes(change_id), PRIMARY KEY (change_id, dependency) ); COMMENT ON TABLE :"registry".dependencies IS 'Tracks the currently satisfied dependencies.'; CREATE TABLE :"registry".events ( event VARCHAR(6) NOT NULL ENCODING AUTO, change_id CHAR(40) NOT NULL, change VARCHAR(1024) NOT NULL, project VARCHAR(1024) NOT NULL REFERENCES :"registry".projects(project), note VARCHAR(65000) NOT NULL DEFAULT '', requires LONG VARCHAR NOT NULL DEFAULT '{}', conflicts LONG VARCHAR NOT NULL DEFAULT '{}', tags LONG VARCHAR NOT NULL DEFAULT '{}', committed_at TIMESTAMPTZ NOT NULL DEFAULT clock_timestamp(), committer_name VARCHAR(1024) NOT NULL, committer_email VARCHAR(1024) NOT NULL, planned_at TIMESTAMPTZ NOT NULL, planner_name VARCHAR(1024) NOT NULL, planner_email VARCHAR(1024) NOT NULL, PRIMARY KEY (change_id, committed_at) ); COMMENT ON TABLE :"registry".events IS 'Contains full history of all deployment events.'; App-Sqitch-0.9996/t/lib/App/Sqitch/000755 000767 000024 00000000000 13133201371 017015 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/lib/App/Sqitch/Command/000755 000767 000024 00000000000 13133201371 020373 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/lib/App/Sqitch/Engine/000755 000767 000024 00000000000 13133201371 020222 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/lib/App/Sqitch/Engine/bad.pm000644 000767 000024 00000000063 13133201371 021305 0ustar00davidstaff000000 000000 package App::Sqitch::Engine::bad; die 'LOL BADZ'; App-Sqitch-0.9996/t/lib/App/Sqitch/Engine/good.pm000644 000767 000024 00000000226 13133201371 021510 0ustar00davidstaff000000 000000 package App::Sqitch::Engine::good; extends 'App::Sqitch::Engine'; 1; =head1 NAME good - Good stuff. =head1 SYNOPSIS =head1 DESCRIPTION =cut App-Sqitch-0.9996/t/lib/App/Sqitch/Command/bad.pm000644 000767 000024 00000000074 13133201371 021460 0ustar00davidstaff000000 000000 package App::Sqitch::Command::bad; use Moo; die 'LOL BADZ'; App-Sqitch-0.9996/t/lib/App/Sqitch/Command/good.pm000644 000767 000024 00000000242 13133201371 021657 0ustar00davidstaff000000 000000 package App::Sqitch::Command::good; use Moo; extends 'App::Sqitch::Command'; 1; =head1 NAME good - Good stuff. =head1 SYNOPSIS =head1 DESCRIPTION =cut App-Sqitch-0.9996/t/engine/deploy/000755 000767 000024 00000000000 13133201371 017035 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/engine/revert/000755 000767 000024 00000000000 13133201371 017050 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/engine/reworked/000755 000767 000024 00000000000 13133201371 017363 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/engine/sqitch.plan000644 000767 000024 00000000704 13133201371 017711 0ustar00davidstaff000000 000000 %project=engine + users 2012-07-16T17:25:07Z Barack Obama # User roles @alpha 2012-07-16T17:25:07Z Barack Obama # Good to go! + widgets [users !dr_evil] 2012-07-16T17:25:07Z Barack Obama # All in + func/add_user [users] 2012-10-09T18:28:29Z Barack Obama # Add users. + users [users@alpha] 2012-10-09T19:28:29Z Barack Obama # Add users. App-Sqitch-0.9996/t/engine/reworked/deploy/000755 000767 000024 00000000000 13133201371 020657 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/engine/reworked/revert/000755 000767 000024 00000000000 13133201371 020672 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/engine/reworked/revert/users@alpha.sql000644 000767 000024 00000000112 13133201371 023654 0ustar00davidstaff000000 000000 SET client_min_messages = warning; DROP SCHEMA IF EXISTS __myapp CASCADE; App-Sqitch-0.9996/t/engine/reworked/deploy/users@alpha.sql000644 000767 000024 00000000214 13133201371 023644 0ustar00davidstaff000000 000000 SET client_min_messages = warning; CREATE SCHEMA __myapp; CREATE TABLE __myapp.users ( nick TEXT PRIMARY KEY, name TEXT NOT NULL ); App-Sqitch-0.9996/t/engine/revert/func/000755 000767 000024 00000000000 13133201371 020003 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/engine/revert/users.sql000644 000767 000024 00000000112 13133201371 020724 0ustar00davidstaff000000 000000 SET client_min_messages = warning; DROP SCHEMA IF EXISTS __myapp CASCADE; App-Sqitch-0.9996/t/engine/revert/widgets.sql000644 000767 000024 00000000111 13133201371 021230 0ustar00davidstaff000000 000000 SET client_min_messages = warning; DROP TABLE IF EXISTS __myapp.widgets; App-Sqitch-0.9996/t/engine/revert/func/add_user.sql000644 000767 000024 00000000126 13133201371 022311 0ustar00davidstaff000000 000000 -- Revert func/add_user BEGIN; DROP FUNCTION __myapp.add_user(TEXT, TEXT); COMMIT; App-Sqitch-0.9996/t/engine/deploy/func/000755 000767 000024 00000000000 13133201371 017770 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/t/engine/deploy/users.sql000644 000767 000024 00000000214 13133201371 020714 0ustar00davidstaff000000 000000 SET client_min_messages = warning; CREATE SCHEMA __myapp; CREATE TABLE __myapp.users ( nick TEXT PRIMARY KEY, name TEXT NOT NULL ); App-Sqitch-0.9996/t/engine/deploy/widgets.sql000644 000767 000024 00000000300 13133201371 021215 0ustar00davidstaff000000 000000 -- requires: users -- conflicts: dr_evil SET client_min_messages = warning; CREATE TABLE __myapp.widgets ( name TEXT PRIMARY KEY, owner TEXT NOT NULL REFERENCES __myapp.users(nick) ); App-Sqitch-0.9996/t/engine/deploy/func/add_user.sql000644 000767 000024 00000000331 13133201371 022274 0ustar00davidstaff000000 000000 -- Deploy func/add_user -- requires: users BEGIN; CREATE FUNCTION __myapp.add_user( nick TEXT, pass TEXT ) RETURNS VOID LANGUAGE SQL AS $$ INSERT INTO __myapp.users VALUES(nick, MD5(pass)); $$; COMMIT; App-Sqitch-0.9996/lib/App/000755 000767 000024 00000000000 13133201371 015317 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/lib/LocaleData/000755 000767 000024 00000000000 13133201371 016570 5ustar00davidstaff000000 000000 App-Sqitch-0.9996/lib/sqitch-add-usage.pod000644 000767 000024 00000001532 13133201371 020427 0ustar00davidstaff000000 000000 =head1 Name sqitch-add-usage - Sqitch add usage statement =head1 Usage sqitch [options] add [change options] [