Compare commits

...

151 commits

Author SHA1 Message Date
08d7a9f7af Release 2.4.0
-----BEGIN PGP SIGNATURE-----
 
 iQIzBAABCAAdFiEElCuQdazKBOkDfHP+0xtVY9rB1PoFAmYS3jkACgkQ0xtVY9rB
 1PqSxBAAvPPMSrrxdfGAL9anzCDZArRrtplbS1493fj+OiNIjDWSGsJwm1mZX1ny
 i04te8Hne/ppZs/CrYAe0PZGl6LowswBKFuHkft//f9maeXG/zl+Uh4E7dYWhXik
 N0+9cgh/ngKJ5QgQelfNxZGrHTZZmbbnNfrtuMPqGIDGIDSzNw2qlqdFzp9VxRth
 /dbLLAHoRXY2uRhSgSnEhnk+zJyxR9od5tU3p094xyUEhbBkNRzCE4TwA9oGvyFQ
 N6onEo4wj5w8Mqtu5p6BY5IktYIgechJxF86Sqy27UU/uNQyzeaG2Qs+diwScpop
 9eOsEUDY5mi7oLs4KME0SGqF/V54Spv+QDGks7bftvSQf3WQvFWX+w1fYymbtctD
 US1caKlsleODnQGmyXEBPyNwGmsLmbaF03yIW1BtLfibDxKeDXK0e2zznpBHRRGO
 2klSjH+qd2hqDT3eYNP8SLpRPUdWiuHP2fb1LV+VzjO7vR4iPLdjvTddFEsm7u2M
 IknSXtxCzJuBD4Dz9fZ/fbVEp+2wYmbtKgqmcnKSNtZ5GaFrmA96mekAbyVWYwdB
 IHuscAWlZSCwJJVPp3VMVGVdXfbYhLJRC+Ft6QAzJeJZ2Q44dxnmPDLQHpngNXWJ
 3YhZ62j5C0wInTh0NzUiDbGkxHwY1v4xJC4OXrR6k8+qqPOe1J4=
 =SC3E
 -----END PGP SIGNATURE-----
gpgsig -----BEGIN PGP SIGNATURE-----
 
 iQIzBAABCAAdFiEEdnljh8gT62W19LaLaFR4GgSIQhwFAmZdM3cACgkQaFR4GgSI
 Qhx/GA/7BbccrVBYNEnu1TJ9riozvN0k1AO6LE96R7QJQH+hpVcM+al4uIc2+GXA
 gcgoVtdADv7nD3DMtQsJlPxQsS+RFjaipZy3kdLSZyU3EixK/Zy2GtK0zjYLMlI/
 rGEEkPx0um3MBm/gtvfZ/pK9i9v2Au61jn49+z4moPnfc4Gk6ZlRXtggDP4ApHPp
 uHeQmr34AZ+dAcc+cs7bCuZvzxxv97WNB7dfFA8RR3+5cQzkbw+Fjjp4GT1J6ifA
 pn4znVZCdb4HhqjFoQzRi68x61MVdhEq4309Mm8xGi7fTqWgxoRPZjKmgpLUF0Wp
 rUNpmd+whNiebMhi0G1yYl1+Pf0x5Thoa7x66M6YWrSMwbr5KJuU3XFNQAr787ls
 pN3nXimX3jw1Mrp8QP4WQby563jHqG4yzBNn+qX22xXxhZOctDJFUDmGZMHHRD5D
 +GICfmgCEp1Ph/YlP4x34jnC4phoIKRs1pUQuIKZM9ECN5Pg6spbT5BmuOn2AhtF
 dLgdSfXAEhnfhxNzf+uvHgelgeeXpTTZEJbX63XoZelK337f1n9CL4Cbumm3JCNS
 YcgJV5L/lw7jRHcaSnyKY37b6iw5+vOdr5yibgJN1LlCGVEbHdpBOPoFZkBA1cTM
 TouP87RHfb47yu+W8WYnBZ+Tr9M6h1S7gfTJ+qjJf244wWaYLO8=
 =Q/B6
 -----END PGP SIGNATURE-----

Pull in upstream Stow 2.4.0
2024-06-03 13:07:34 +10:00
Adam Spiers
1e2513417d
Merge pull request #108 from aspiers/release-v2.4.0 2024-04-07 18:55:18 +01:00
Adam Spiers
a7b1200b63
Merge pull request #97 from ilyagr/patch-1 2024-04-07 18:54:44 +01:00
Adam Spiers
20031c0001 Rebuild META.* 2024-04-07 18:38:12 +01:00
Adam Spiers
9985de7c78 HOWTO-RELEASE: THANKS is no longer being updated 2024-04-07 18:34:35 +01:00
Adam Spiers
413278f178 Update NEWS for v2.4.0 2024-04-07 18:32:51 +01:00
Adam Spiers
fdac519bdf Bump version to 2.4.0 2024-04-07 18:24:49 +01:00
Adam Spiers
49aa3458e5 Add details on how to view coverage locally
Unfortunately for now, Coveralls reports don't include source due
to #84, but this is a good workaround.
2024-04-07 18:22:56 +01:00
Adam Spiers
cbc12d7a3b stow: remove misleading comment about current dir
The current directory is changed by within_target_do() which is called
by `plan_stow()`, `plan_unstow()`, and `process_tasks()`.  It is not
changed when constructing a new `Stow` object, so remove this outdated
and misleading comment.

Fixes #102.
2024-04-07 18:00:03 +01:00
Adam Spiers
143dbf83e2
Merge pull request #107 from aspiers/improve-dotfiles-fix 2024-04-07 17:56:54 +01:00
Adam Spiers
94ed916466 t/unstow.t: move final set of tests into a subtest 2024-04-07 17:44:44 +01:00
Adam Spiers
c0b8890b14 t/unstow.t: remove superfluous spaces 2024-04-07 17:24:13 +01:00
Adam Spiers
93fc195ddb Fix unstowing with --compat --dotfiles
Unstowing with `--dotfiles` didn't work with `--compat`, because when
traversing the target tree rather than the package tree, there was no
mechanism for mapping a `.foo` file or directory back to its original
`dot-foo` and determine whether it should be unstowed.

So add a reverse `unadjust_dotfile()` mapping mechanism to support
this.
2024-04-07 17:21:44 +01:00
Adam Spiers
723ddcf3a4 t/dotfiles.t: improve language in test names and assertion messages
We use the term "directory" (or "dir" for short) rather than "folder".
Also explicitly say whether a test is stowing or unstowing, and fix
the odd typo.
2024-04-07 17:21:10 +01:00
Adam Spiers
34421ba5cf stow_contents: fix bugs and corner cases with type mismatch conflicts
If the target directory as a file named X and a package has a
directory named X, or vice-versa, then it is impossible for Stow
to stow that entry X from the package, even if --adopt is supplied.

However we were previously only handling the former case, and not the
latter, and the test for the former was actually broken.  So fix
stow_contents() to handle both cases correctly, fix the broken test,
and add a new test for the latter case.
2024-04-07 17:21:10 +01:00
Adam Spiers
8ed799a3a3 t/unstow.t: create a bunch of unowned files to make tests more robust
This should make it harder for Stow to do the right thing.
2024-04-07 17:21:10 +01:00
Adam Spiers
afa50077c9 dotfiles: switch {un,}stow_{contents,node}() recursion parameters
Stow walks the package and target tree hierarchies by using mutually
recursive pairs of functions:

- `stow_contents()` and `stow_node()`
- `unstow_contents()` and `unstow_node()`

As Stow runs its planning from the target directory (`plan_*()` both
call `within_target_do()`), previously the parameters for these
included:

- `$target_subpath` (or `$target_subdir` in the `*_node()` functions):
  the relative path from the target top-level directory to the target
  subdirectory (initially `.` at the beginning of recursion).  For
  example, this could be `dir1/subdir1/file1`.

- `$source`: the relative path from the target _subdirectory_ (N.B. _not_
  top-level directory) to the package subdirectory.  For example, if
  the relative path to the Stow directory is `../stow`, this could be
  `../../../stow/pkg1/dir1/subdir1/file1`.  This is used when stowing
  to construct a new link, or when unstowing to detect whether the
  link can be unstowed.

Each time it descends into a further subdirectory of the target and
package, it appends the new path segment onto both of these, and also
prefixes `$source` with another `..`.  When the `--dotfiles` parameter
is enabled, it adjusts `$target_subdir`, performing the `dot-foo` =>
`.foo` adjustment on all segments of the path in one go.  In this
case, `$target_subpath` could be something like `.dir1/subdir1/file1`,
and the corresponding `$source` could be something like
`../../../stow/pkg1/dot-dir1/subdir1/file1`.

However this doesn't leave an easy way to obtain the relative path
from the target _top-level_ directory to the package subdirectory
(i.e. `../stow/pkg1/dot-dir1/subdir1/file1`), which is needed for
checking its existence and if necessary iterating over its contents.

The current implementation solves this by including an extra `$level`
parameter which tracks the recursion depth, and uses that to strip the
right number of leading path segments off the front of `$source`.
(In the above example, it would remove `../..`.)

This implementation isn't the most elegant because:

- It involves adding things to `$source` and then removing them again.

- It performs the `dot-` => `.` adjustment on every path segment
  at each level, which is overkill, since when recursing down a level,
  only adjustment on the final subdirectory is required since the higher
  segments have already had any required adjustment.

  This in turn requires `adjust_dotfile` to be more complex than it
  needs to be.

  It also prevents a potential future where we might want Stow to
  optionally start iterating from within a subdirectory of the whole
  package install image / target tree, avoiding adjustment at higher
  levels and only doing it at the levels below the starting point.

- It requires passing an extra `$level` parameter which can be
  automatically calculated simply by counting the number of slashes
  in `$target_subpath`.

So change the `$source` recursion parameter to instead track the
relative path from the top-level package directory to the package
subdirectory or file being considered for (un)stowing, and rename it
to avoid the ambiguity caused by the word "source".

Also automatically calculate the depth simply by counting the number
of slashes, and reconstruct `$source` when needed by combining the
relative path to the Stow directory with the package name and
`$target_subpath`.

Closes #33.
2024-04-07 17:21:07 +01:00
Adam Spiers
744ba651f5 unstow_link_node(): don't register conflicts when unstowing unowned links 2024-04-07 15:47:38 +01:00
Adam Spiers
06fdfc185f merge unstow_orig.t into unstow.t and fix unstowing logic
There was a ton of duplication which is not maintainable, so refactor
everything into a single test which still covers the differences.

This in turn revealed some issues in the unstowing logic:

- We shouldn't conflict if we find a file which isn't a link or a
  directory; we can just skip over it.

- Unstowing with `--dotfiles` was using the wrong variable to obtain
  the package path, and as a result having to perform an unnecessary
  call to `adjust_dotfile()`.

So fix those at the same time.
2024-04-07 15:47:38 +01:00
Adam Spiers
001b287b1b allow playground/ directory for testing stuff 2024-04-07 15:47:38 +01:00
Adam Spiers
a7c251c316 tidy up MANIFEST.SKIP 2024-04-07 15:47:38 +01:00
Adam Spiers
5e21f47879 read_a_link(): clarify debug message when it's a real link 2024-04-07 15:47:38 +01:00
Adam Spiers
a070116621 Fix Dockerfile by updating from jessie to bookworm 2024-04-07 13:50:09 +01:00
Adam Spiers
fee2225dc9
Merge pull request #106 from aspiers/dev 2024-04-06 15:37:36 +01:00
Adam Spiers
5bb65f60d6 Update manifest files to keep ./Build distcheck happy 2024-04-06 15:09:53 +01:00
Adam Spiers
748a34b211 Revert "testutil: Add sanity check for cwd"
This reverts commit 5d4e68291e.

It turns out that this broke `make distcheck`.
2024-04-06 14:59:52 +01:00
Adam Spiers
7815bc8b44 Revert "Remove unnecessary AM_MAKEINFOFLAGS tweak"
This reverts commit 1a20a3f7ee.

It turns out that `texi2dvi` _does_ require `-I $(srcdir)` for
`@verbatiminclude default-ignore-list` to work after all.  It's needed
not for a normal docs build, but when `make distcheck` is run,
presumably because `distcheck` runs from a different directory.
2024-04-06 14:54:32 +01:00
Adam Spiers
c691b8fa6e Makefile.am: include DEFAULT_IGNORE_LIST in doc_deps 2024-04-06 14:39:16 +01:00
Adam Spiers
2a647d125f iterate over directories in sorted order
This makes behaviour more deterministic, and makes debugging easier.
2024-04-06 13:33:53 +01:00
Adam Spiers
e9ad20576c t/unstow.t: convert to use subtests 2024-04-06 11:59:23 +01:00
Adam Spiers
6d6781dcef t/unstow_orig.t: use like() for regexp matching tests
This is better because it outputs the mismatching value when
the matching check fails.
2024-04-06 11:59:10 +01:00
Adam Spiers
599944bce1 t/unstow_orig.t: use is() for equality tests
This is better because it outputs the mismatching values when
the equality check fails.
2024-04-06 11:51:37 +01:00
Adam Spiers
bca711fac2 tests: use stderr_like() instead of home-grown STDERR capturing
The STDERR capturing in testutil just reinvents Test::Output which
we already use in chkstow.t, so it's pointless to reinvent that wheel.
2024-04-06 11:33:18 +01:00
Adam Spiers
ebfbb6cc13 testutil: rename parameter names to be less confusing
$target was the source of the link, and $source was the
target (destination) of the link.  Obviously this was hopelessly
confusing, so rename to avoid this.
2024-04-05 22:32:12 +01:00
Adam Spiers
238346f134 manual: clarify the pros and cons and history of --compat 2024-04-05 22:28:40 +01:00
Adam Spiers
96ada510fd
Merge pull request #105 from aspiers/github-workflow 2024-04-05 01:57:29 +01:00
Adam Spiers
58c1946ed9 Port Travis CI workflow to a GitHub CI workflow
Travis is no longer free, so move to GitHub.  (In the future ideally
we should reduce dependencies on proprietary platforms.)
2024-04-05 01:52:42 +01:00
Adam Spiers
4cde7eb19f t/stow.t: fix typos, whitespace, and ordering of lines 2024-04-01 23:58:17 +01:00
Adam Spiers
67081cec02 testutil: use croak() instead of die() for more useful errors 2024-04-01 23:58:17 +01:00
Adam Spiers
1282acf6b5 t/stow: use like() instead of ok(... =~ /.../) 2024-04-01 23:58:17 +01:00
Adam Spiers
4cac249ddc rename $path => $target_path in node helpers
is_a_node(), is_a_dir(), is_a_link() all operate on paths within
the target directory, so make this explicit by avoiding the vague
variable name "$path".
2024-04-01 23:58:17 +01:00
Adam Spiers
2c9065995c fold_tree: rename $target parameter to $target_subdir
$target is vague and could refer to the top-level target directory,
so rename to clarify.
2024-04-01 22:39:32 +01:00
Adam Spiers
8f6a320b50 fold_tree: rename $source parameter to $pkg_subpath
$source is vague and confusing as per the manual.
2024-04-01 22:39:32 +01:00
Adam Spiers
bae7890aa5 unstow_node / unstow_existing_node: rename foldable return value
$parent is a bit vague so rename to $parent_in_pkg.
2024-04-01 22:39:32 +01:00
Adam Spiers
b3ed86d616 unstow_valid_link: rename $existing_path
Unqualified references to "path" are horribly vague, so rename to
$existing_pkg_path_from_cwd for clarity.
2024-04-01 22:39:32 +01:00
Adam Spiers
c45a0632a9 stow_node: rename $existing_path
Unqualified references to "path" are horribly vague, so rename to
$existing_pkg_path_from_cwd for clarity.
2024-04-01 22:39:32 +01:00
Adam Spiers
3c904dade2 link_owned_by_package: rename $source => $link_dest
The use of the word "source" to describe a link's destination is
confusing in the context of Stow for reasons explained in the manual.

So rename the $source variable to avoid this.
2024-04-01 22:39:32 +01:00
Adam Spiers
381fd71155 remove or rename XXX
Remove old XXX FIXMEs which tell us nothing useful and may not be
relevant any more.

Also rename another XXX to an industry-standard FIXME.
2024-04-01 22:39:32 +01:00
Adam Spiers
221449d640 unstow_node: remove redundant return 2024-04-01 22:39:32 +01:00
Adam Spiers
a337a2fcd0 Change debug indentation in some helpers
These helpers can be called at more deeply nested levels, so they
should be indented more than they were.
2024-04-01 22:39:32 +01:00
Adam Spiers
08e1c902ec unstow_link_node: rename $existing_path
Unqualified references to "path" are horribly vague, so rename to
$existing_pkg_path_from_cwd for clarity.
2024-04-01 22:39:32 +01:00
Adam Spiers
4272e7c4bb unstow_link_node: rename $existing_source => $link_dest
The use of the word "source" to describe a link's destination is
confusing in the context of Stow for reasons explained in the manual.

So rename the $existing_source variable to $link_dest avoid this.
2024-04-01 22:39:32 +01:00
Adam Spiers
4525b9447d unstow_contents: remove reference to "source"
The use of the word "source" is confusing in the context of Stow for
reasons explained in the manual.
2024-04-01 22:39:32 +01:00
Adam Spiers
a8c93487c3 stow_node: remove comments about implementation details from POD
These don't add much value, and the reference to $source was out of
date anyway.
2024-04-01 22:39:32 +01:00
Adam Spiers
b137191d27 stow_node: rename $second_source => $link_dest
The use of the word "source" to describe a link's destination is
confusing in the context of Stow for reasons explained in the manual.

So rename the $second_source variable to avoid this.
2024-04-01 22:39:32 +01:00
Adam Spiers
b5a467fd06 foldable: make more understandable
Improve variable names, POD, and add helpful comments.
2024-04-01 22:39:32 +01:00
Adam Spiers
cc521ec14e foldable: rename $path to $target_node_path
$path is horribly vague, so rename it to be more informative.
2024-04-01 22:39:32 +01:00
Adam Spiers
09a34e7272 foldable: add debug for different cases when not foldable 2024-04-01 22:39:32 +01:00
Adam Spiers
1b597999e2 read_a_link: improve variable names
$path is horribly vague, so rename to $link to be more informative.

Also the use of "$target" to describe a link's destination is very
confusing in the context of Stow for reasons explained in the manual.
So rename to $link_dest.
2024-04-01 22:39:32 +01:00
Adam Spiers
79f90d39b3 parent_link_scheduled_for_removal: tweak debug 2024-04-01 22:39:32 +01:00
Adam Spiers
2c255af187 t/unstow_orig: split into subtests 2024-04-01 22:39:32 +01:00
Adam Spiers
6cf41850b3 foldable: rename $target => $target_subdir
The $target variable was ambiguous, as it could have referred to the
path to the target directory, or the path to a sub-directory in the
target, as well as its intended meaning of a subpath relative to the
target directory.  So rename it to try to find the balance between
clarity and verbosity.
2024-04-01 22:39:32 +01:00
Adam Spiers
2851b36df4 find_stowed_path: rename $path / $dest to $pkg_path_from_cwd
$path is horribly vague, so rename to be more informative.
2024-04-01 22:39:32 +01:00
Adam Spiers
0daf352200 unstow_node: rename $path to $pkg_path_from_cwd
$path is horribly vague, so rename to be more informative.
2024-04-01 22:39:32 +01:00
Adam Spiers
6b9bbc9cbb link_dest_within_stow_dir: rename $path to $pkg_subpath
$path is horribly vague, so rename to be more informative.
2024-04-01 22:39:32 +01:00
Adam Spiers
170d161692 find_containing_marked_stow_dir: rename $path to $pkg_path_from_cwd
$path is horribly vague, so rename to be more informative.
2024-04-01 22:39:32 +01:00
Adam Spiers
75c892abc6 unstow_* helpers: rename $path to $pkg_path_from_cwd
$path is horribly vague, so rename to be more informative.
2024-04-01 22:39:32 +01:00
Adam Spiers
c0060443ee marked_stow_dir: rename $path to $dir
It's always a directory, so make this explicit.
2024-04-01 22:39:32 +01:00
Adam Spiers
caefb641b8 find_stowed_path: reintroduce missing comment lines
These lines were accidentally removed by 84367681.
2024-04-01 22:39:32 +01:00
Adam Spiers
10c86841de stow_contents / unstow_node: rename $target => $target_sub{dir,path}
This is very similar to a previous commit which did the same rename in
stow_node().

The $target variable was ambiguous, as it could have referred to the
path to the target directory, or the path to a sub-directory in the
target, as well as its intended meaning of a subpath relative to the
target directory.  So rename it to try to find the balance between
clarity and verbosity.
2024-04-01 22:39:32 +01:00
Adam Spiers
8a17d8b4f2 manual: use American punctuation of "vs."
GNU and Stow are both originally from the USA, so it makes sense
to stay consistent with American English.
2024-04-01 22:39:32 +01:00
Adam Spiers
0782be7106 Remove unstow_*_orig() functions
Refactor the compat mode code to reuse the existing unstow_contents()
and unstow_node().  This allows us to remove the parallel versions in
unstow_contents_orig() and unstow_node(), which contained a lot of
duplicated code and were a significant maintenance burden.
2024-04-01 22:39:32 +01:00
Adam Spiers
4054d40a2a emacs: tweak more cperl indentation config to match existing style 2024-04-01 22:39:32 +01:00
Adam Spiers
456424c560 unstow_node_orig: replace a bunch of duplicated code with unstow_link_node() 2024-04-01 22:39:32 +01:00
Adam Spiers
517384407b unstow_node: extract new unstow_existing_node() sub 2024-04-01 22:39:32 +01:00
Adam Spiers
42cc1d2e60 unstow_node: extract new unstow_link_node() sub 2024-04-01 22:39:32 +01:00
Adam Spiers
cc592bdc44 unstow_node: extract new unstow_valid_link() sub 2024-04-01 22:39:32 +01:00
Adam Spiers
1f752a3c94 stow_node: rename $target => $target_subpath
The $target variable was ambiguous, as it could have referred to the
path to the target directory, or the path to a sub-directory in the
target, as well as its intended meaning of a subpath relative to the
target directory.  So rename it to try to find the balance between
clarity and verbosity.
2024-04-01 22:39:32 +01:00
Adam Spiers
86f03d115d t/dotfiles.t: switch to subtests 2024-04-01 22:39:32 +01:00
Adam Spiers
a328c2cd4b t/stow: convert to subtests() 2024-04-01 22:39:32 +01:00
Adam Spiers
0871a483cf rename $existing_source => $existing_link_dest
Source can be ambiguous, as mentioned in the manual.
2024-04-01 00:39:18 +01:00
Adam Spiers
e0212d4f49 stow_node(): fix odd whitespace 2024-04-01 00:35:35 +01:00
Adam Spiers
f60c203c45 should_skip_target(): add docs explaining its purpose 2024-04-01 00:34:39 +01:00
Adam Spiers
c2da8b416d do_link(): improve variable names 2024-04-01 00:34:19 +01:00
Adam Spiers
48c6b5956b Add emacs config to prevent insertion of hard tabs 2024-04-01 00:07:33 +01:00
Adam Spiers
bffc347a19 Remove hard tabs 2024-04-01 00:06:24 +01:00
Adam Spiers
8c09d41054 add unit tests for adjust_dotfiles() 2024-03-31 23:52:00 +01:00
Adam Spiers
2f762e3908 Merge commit 'pullreqs/70' into dev 2024-03-31 23:41:02 +01:00
Adam Spiers
e8c46cf058 manual: disambiguate meaning of "source" 2024-03-31 23:20:22 +01:00
Adam Spiers
373ef62e70 manual: clarify that installation image is pre-installation 2024-03-31 23:20:22 +01:00
Adam Spiers
245dc83849 Stow.pm: reformat old comment style as pod
As previously noted, the old comment style was difficult to edit.
It's also not idiomatic Perl style, so reformat as pod.  This exposes
more of the inner workings of Stow as documentation, but that
shouldn't be a problem.

As part of this change, remove outdated and sometimes misleading
information about if/when each function throws an exception.
2024-03-31 23:19:08 +01:00
Adam Spiers
f4f3836c5f Stow.pm: rename $ldest to $link_dest for clarity 2024-03-31 15:38:38 +01:00
Adam Spiers
1be40c0532 Stow.pm: reformat comments
Some methods had comments with a prefix which made the paragraph
inconveniently narrow, and made refilling it really awkward.  So
switch to a more natural comment style.
2024-03-31 15:33:14 +01:00
Adam Spiers
11d4ff01d7 manual: avoid double spaces after "i.e." 2024-03-31 15:25:35 +01:00
Adam Spiers
2791d00d06 manual: Expand the definition of symlinks and disambiguate "target"
Target can have two opposing meanings:

1. the target directory where symlinks are managed by Stow, and
2. the destinations of those symlinks

So try to move away from this by using the word "destination" for
symlinks.
2024-03-31 15:25:26 +01:00
Adam Spiers
d12f107f3c NEWS: more updates in preparation for next release 2024-03-31 14:11:36 +01:00
Adam Spiers
8436768144 Eliminate erroneous warning when unstowing (#65)
When unstowing a package, cleanup_invalid_links() is invoked to remove
any invalid links owned by Stow.  It was invoking link_owned_by_package()
to check whether each existing link is owned by Stow.  This in turn
called find_stowed_path() which since 40a0807185 was not allowing for
the possibility that it could be passed a symlink *not* owned by Stow
with an absolute target and consequently emitting an erroneous warning.

So remove this erroneous warning, and refactor find_stowed_path()
to use two new helper functions for detecting stow directories:
link_dest_within_stow_dir() and find_containing_marked_stow_dir().
Also refactor the logic within each to be simpler and more accurate,
and add more test cases to the corresponding parts of the test suite.

Fixes #65.
Closes #103.

https://github.com/aspiers/stow/issues/65
2024-03-31 14:03:47 +01:00
Adam Spiers
877fc0ce7e cleanup_invalid_links: add test for non-cleanup of an unowned link 2024-03-31 12:24:02 +01:00
Adam Spiers
541faf68eb cleanup_invalid_links: improve docs 2024-03-31 12:16:42 +01:00
Adam Spiers
08b06ccb40 t/cleanup_invalid_links: divide into subtests
This makes the code and test output both more legible.
2024-03-31 12:16:42 +01:00
Adam Spiers
a2beb7b371 Separate treatment of .stow and .nonstow marked dirs
Placing a .stow file in a directory tells Stow that this directory
should be considered a Stow directory.  This is already
well-documented.

There was an undocumented and slightly broken feature where placing a
.nonstow file in a directory was treated in exactly the same way.  The
intention was for .nonstow to cause Stow to skip stowing into and
unstowing from that directory and any of its descendants.  However, it
also caused Stow to consider symlinks into any of those directories as
owned by Stow, even though that was clearly not the intention.  So
separate treatment of .stow and .nonstow markers, so that while both
provide protection against Stow stowing and unstowing, only .stow
affects the symlink ownership logic in find_stowed_path() and
marked_stow_dir().

Probably no one uses the undocumented .nonstow feature, so it may make
sense to remove this in future.
2024-03-31 12:15:53 +01:00
Adam Spiers
287d8016f6 join_paths: improve docs to clarify purpose / differences
join_paths() is used in specific ways and has specific behaviour
required which is nuanced and not obvious at first sight.  So make
this explicit for future reference.
2024-03-31 12:04:09 +01:00
Adam Spiers
4d711fc4ac Make join_paths correctly handle absolute paths
Previously join_paths() was incorrectly handling absolute paths, for
example join_paths('a/b', '/c/d') would return 'a/b/c/d' rather than
'/c/d'.  This was a problem when following a symlink in
find_stowed_path(), because if the symlink was not owned by Stow and
pointed to an absolute path, find_stowed_path() might accidentally
deem the link owned by Stow, if c/d was a valid path relative to the
current directory.
2024-03-31 12:02:58 +01:00
Adam Spiers
ff4d87efaf Disable emacs auto-fill-mode
This completely messes up the current function documentation.
2024-03-31 12:02:58 +01:00
Adam Spiers
d1480195b6 Move setting of cperl-indent-level to .dir-locals.el
This removes duplication.
2024-03-31 12:02:58 +01:00
Adam Spiers
66ca2826d6 Highlight an issue with prove overriding TEST_VERBOSE 2024-03-31 12:02:57 +01:00
Adam Spiers
1657c5b772 t/find_stowed_path.t: Add a couple of missing spaces 2024-03-10 17:40:17 +00:00
Adam Spiers
9db0de3005 Add some helpful comments
Explain a few things in preparation for a bugfix.
2024-03-10 17:40:17 +00:00
Adam Spiers
aa03922520 manual: fix duplicated "of" typo 2024-03-09 17:57:04 +00:00
Adam Spiers
9ce37d9575 Remove $stow_path parameter from unstow_{contents,node}{,_orig}()
Unlike with the stow_{contents,node}{,_orig}() counterpart functions,
when unstowing, it's not necessary to pass the $stow_path parameter
because it can never differ from $self->{stow_path}.

The stow_*() functions need this for the corner case of unfolding a
tree which is stowed from a different stow directory to the one being
used for the current stowing operation (see the "Multiple Stow
Directories" section of the manual).
2024-03-09 17:57:04 +00:00
Adam Spiers
4e2776224f Tweak text of error and debug messages 2024-03-09 17:57:04 +00:00
Adam Spiers
b7bf77da52 Add a missing period to the stow_contents() comments. 2024-03-09 17:57:04 +00:00
Adam Spiers
72084f6fec Add a comment explaining that $node_target can be adjusted for dot- prefix 2024-03-09 17:57:04 +00:00
Adam Spiers
a3700e7171 Add a comment explaining path in stow_contents() 2024-03-09 17:57:04 +00:00
Adam Spiers
20bee7428e Add a comment explaining $stow_path parameter of stow_contents()
At first sight this parameter looks redundant since we have
$self->{stow_path}, but in one case the value can differ from that,
so mention that explicitly.
2024-03-09 17:57:04 +00:00
Adam Spiers
f51fc1248c plan_*: rename $path to $pkg_path for clarity
$path is a vague variable name.
2024-03-09 17:57:04 +00:00
Adam Spiers
457fa98527 dotfiles.t: improve comment descriptions 2024-03-09 17:57:04 +00:00
Adam Spiers
6519ee8426 aclocal.m4: update to 1.16.5 2024-03-09 17:56:57 +00:00
Adam Spiers
5d4e68291e testutil: Add sanity check for cwd 2024-03-09 17:56:57 +00:00
Adam Spiers
2c7d3d4762 manual: update the Reporting Bugs / Known Bugs sections 2024-03-09 17:56:48 +00:00
Adam Spiers
c30792270e manual: use @email{} for email addresses 2024-03-09 17:56:41 +00:00
Adam Spiers
cb4b0c6a9a Remove trailing whitespace 2024-03-09 17:56:41 +00:00
Adam Spiers
a426a5979d testutil: clarify reason for default paths in new_Stow() 2024-03-09 17:56:29 +00:00
Adam Spiers
72140071ad manual: improve explanation of target directory definition
Bring this more up to date by mentioning the dotfiles use case.
2024-03-09 17:56:14 +00:00
Adam Spiers
478c7b921d Add watch target to Makefile for easier hacking 2024-03-09 17:56:14 +00:00
Adam Spiers
28a4e82741 CONTRIBUTING: document how to test using prove(1) 2024-03-09 17:56:02 +00:00
Ilya Grigoriev
6f76606390
Add .gitmodules to the default ignore list 2022-08-12 20:43:56 -07:00
Adam Spiers
a829eeb4a0 Upgrade aclocal to 1.16.3 2021-04-15 15:11:30 +01:00
Adam Spiers
ee240c5bf2 cleanup_invalid_links: it's a bug if called with a non-directory 2021-04-15 15:11:30 +01:00
Adam Spiers
6870e96873 CONTRIBUTING: Add a section on how to run the tests 2021-04-15 15:11:30 +01:00
Adam Spiers
64e0dc8793 Beef up README.md and add CONTRIBUTING.md 2021-04-15 15:11:30 +01:00
Adam Spiers
205158a528 manual: request --verbose=5 for bug reports 2021-04-15 15:11:30 +01:00
Adam Spiers
5b0efb3757 AUTHORS: mention THANKS file 2021-04-15 15:11:30 +01:00
Adam Spiers
a3f526edc2 NEWS: update for 2.3.2 2021-04-15 15:11:30 +01:00
Adam Spiers
134e448aec NEWS: set org-blank-before-new-entry 2021-04-15 15:11:30 +01:00
Adam Spiers
e76dda400a Skip unnecessary planning 2021-04-15 15:11:30 +01:00
Adam Spiers
c0c01a6c61 cleanup_invalid_links: improve handling of scheduled actions 2021-04-15 15:11:30 +01:00
Adam Spiers
208f383580 Further improve debug output 2021-04-15 15:11:30 +01:00
Adam Spiers
396357dc67 Rename path_owned_by_package() to link_owned_by_package() 2021-04-15 15:11:30 +01:00
Adam Spiers
832135e269 Make cleanup_invalid_links() more explicit
And add some debug.
2021-04-15 15:11:30 +01:00
Adam Spiers
86f4694d96 Improve debug indent levels 2021-04-15 15:11:30 +01:00
Adam Spiers
c872baba2d Add support for emacs dumb-jump
Allow easy navigation to function definitions in emacs.

The rg (ripgrep) search is needed because as the dumb-jump README says:

   [...] the default searcher (git-grep) won't be able to search
   outside of the project root. This edge case will be fixed in a
   future release.

See: https://github.com/jacktasia/dumb-jump
2021-04-15 15:11:30 +01:00
Adam Spiers
90278f854c Move to explicit debug indentation levels 2021-04-15 15:11:30 +01:00
Adam Spiers
8d7b7a7310 foldable(): fix debug indentation 2021-04-15 15:11:30 +01:00
Adam Spiers
9f4f8185ac should_skip_target_which_is_stow_dir(): fix debug indentation 2021-04-15 15:11:30 +01:00
Adam Spiers
3aae830e56 HOWTO-RELEASE: maintainer-clean is better than distclean 2021-04-15 15:11:30 +01:00
Adam Spiers
0b72724066 Correct comment about overriding the check rule
We actually override check-TESTS.
2021-04-15 15:11:30 +01:00
Adam Spiers
1a20a3f7ee Remove unnecessary AM_MAKEINFOFLAGS tweak
We no longer need to ensure that texi2any (a.k.a. makeinfo) is called
with -I $(srcdir) in order to make the

    @verbatiminclude default-ignore-list

in the manual work, because texi2any includes the current working
directory by default anyway.  Presumably this behaviour was introduced
after this AM_MAKEINFOFLAGS was previously added, because it was
needed at some point in the past.
2021-04-15 15:11:30 +01:00
Adam Spiers
8cd6cadd3d Replace broken gmane links with links to lists.gnu.org
gmane has been dead for quite a while:

    https://lars.ingebrigtsen.no/2020/01/06/whatever-happened-to-news-gmane-org/
2021-04-15 15:11:29 +01:00
Adam Spiers
d18b5e99a0 aclocal.m4: update to 1.16.2
This only updates copyright notices to 2020, and URLs to https.
2021-04-15 15:11:29 +01:00
Adam Spiers
69614059a8 Ditch texinfo.tex from distribution 2021-04-15 15:11:29 +01:00
36 changed files with 3200 additions and 9977 deletions

1
.coveralls.yml Normal file
View file

@ -0,0 +1 @@
repo_token: xl1m2EiKjG4YlJQ0KjTTBNDRcAFD0lCVt

6
.dir-locals.el Normal file
View file

@ -0,0 +1,6 @@
((cperl-mode . ((dumb-jump-force-searcher . rg)
(cperl-indent-level . 4)
(cperl-close-paren-offset . -4)
(cperl-indent-subs-specially . nil)
(indent-tabs-mode . nil)
(eval . (auto-fill-mode -1)))))

2
.dumbjump Normal file
View file

@ -0,0 +1,2 @@
+bin/*.in
+lib/*.pm.in

80
.github/workflows/test.yml vendored Normal file
View file

@ -0,0 +1,80 @@
# This file is part of GNU Stow.
#
# GNU Stow is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# GNU Stow is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see https://www.gnu.org/licenses/.
name: Test suite
on:
push:
branches: [master]
pull_request:
branches: [master]
types: [opened, synchronize, reopened, ready_for_review]
jobs:
# call-simple-perl-test:
# uses: perl-actions/github-workflows/.github/workflows/simple-perltester-workflow.yml@main
# with:
# since-perl: 5.14
test:
name: Perl ${{ matrix.perl-version }}
runs-on: ubuntu-latest
strategy:
matrix:
perl-version:
- '5.38'
- '5.36'
- '5.34'
- '5.32'
- '5.30'
container:
# This Docker image should avoid the need to run:
#
# cpanm -n Devel::Cover::Report::Coveralls
image: perldocker/perl-tester:${{ matrix.perl-version }}
steps:
- run: apt-get update && apt-get install -y sudo texinfo texlive
- name: Checkout code
uses: actions/checkout@v2
# - uses: awalsh128/cache-apt-pkgs-action@latest
# with:
# debug: true
# packages: texinfo texlive
# version: 1.0
- run: autoreconf --install
- name: ./configure && make
run: |
eval `perl -V:siteprefix`
# Note: this will complain Test::Output isn't yet installed:
./configure --prefix=$siteprefix && make
# but that's OK because we install it here:
make cpanm
#- name: Run tests
# run: make test
- run: make distcheck
- run: perl Build.PL
- run: ./Build build
- run: cover -test -report coveralls
- run: ./Build distcheck

3
.gitignore vendored
View file

@ -9,7 +9,8 @@
/bin/stow
/doc/stow.info
/doc/version.texi
tmp-testing-trees/
/playground/
tmp-testing-trees*/
_build/
autom4te.cache/
blib/

View file

@ -1,3 +1,7 @@
This file documents the high-level history of Stow, and some of its
major contributors. See also the THANKS file for a more complete list
of contributors.
Stow was originally written by Bob Glickstein <bobg+stow@zanshin.com>,
Zanshin Software, Inc.

123
CONTRIBUTING.md Normal file
View file

@ -0,0 +1,123 @@
Contributing to GNU Stow
========================
Development of Stow, and GNU in general, is a volunteer effort, and
you can contribute. If you'd like to get involved, it's a good idea to join
the [stow-devel](https://lists.gnu.org/mailman/listinfo/stow-devel)
mailing list.
Bug reporting
-------------
Please follow the procedure described in [the "Reporting Bugs"
section](https://www.gnu.org/software/stow/manual/html_node/Reporting-Bugs.html#Reporting-Bugs)
of [the manual](README.md#documentation).
Development
-----------
For [development sources](https://savannah.gnu.org/git/?group=stow)
and other information, please see the [Stow project
page](http://savannah.gnu.org/projects/stow/) at
[savannah.gnu.org](http://savannah.gnu.org).
There is also a
[stow-devel](https://lists.gnu.org/mailman/listinfo/stow-devel)
mailing list (see [Mailing lists](README.md#mailing-lists)).
Please be aware that all program source files (excluding the test
suite) end in `.in`, and are pre-processed by `Makefile` into
corresponding files with that prefix stripped before execution. So if
you want to test any modifications to the source, make sure that you
change the `.in` files and then run `make` to regenerate the
pre-processed versions before doing any testing. To avoid forgetting
(which can potentially waste a lot of time debugging the wrong code),
you can automatically run `make` in an infinite loop every second via:
make watch
(You could even use fancier approaches like
[`inotifywait(1)`](https://www.man7.org/linux/man-pages/man1/inotifywait.1.html)
or [Guard](https://guardgem.org/). But those are probably overkill in
this case where the simple `while` loop is plenty good enough.)
Testing
~~~~~~~
The test suite can be found in the [`t/`](t/) subdirectory. You can
run the test suite via:
make check
Tests can be run individually as follows. First you have to ensure
that the `t/`, `bin/`, and `lib/` directories are on Perl's search path.
Assuming that you run all tests from the root of the repository tree,
this will do the job:
export PERL5LIB=t:bin:lib
(Not all tests require all of these, but it's safer to include all of
them.)
Secondly, be aware that if you want to test modifications to the
source files, you will need to run `make watch`, or `make` before each
test run as explained above.
Now running an individual test is as simple as:
perl t/chkstow.t
or with a given debugging verbosity corresponding to the `-v` / `--verbose`
command-line option:
TEST_VERBOSE=4 perl t/chkstow.t
The [`prove(1)` test runner](https://perldoc.perl.org/prove) is another
good alternative which provides several handy extra features. Invocation
is very similar, e.g.:
prove t/stow.t
or to run the whole suite:
prove
However currently there is an issue where this interferes with
`TEST_VERBOSE`.
If you want to create test files for experimentation, it is
recommended to put them in a subdirectory called `playground/` since
this will be automatically ignored by git and the build process,
avoiding any undesirable complications.
Test coverage
~~~~~~~~~~~~~
To view test coverage reports, first ensure that
[`Devel::Cover`](https://metacpan.org/dist/Devel-Cover) is installed.
Then type `make coverage`. The last lines of the output should
include something like:
HTML output written to /home/user/path/to/stow/cover_db/coverage.html
which you can open in a web browser to view the report.
Translating Stow
----------------
Stow is not currently multi-lingual, but patches would be very
gratefully accepted. Please e-mail
[stow-devel](https://lists.gnu.org/mailman/listinfo/stow-devel) if you
intend to work on this.
Maintainers
-----------
Stow is currently being maintained by Adam Spiers. Please use [the
mailing lists](README.md#mailing-lists).
Helping the GNU project
-----------------------
For more general information, please read [How to help
GNU](https://www.gnu.org/help/).

View file

@ -3,6 +3,7 @@ aclocal.m4
automake/install-sh
automake/mdate-sh
automake/missing
automake/texinfo.tex
bin/chkstow
bin/chkstow.in
bin/stow
@ -11,6 +12,7 @@ Build.PL
ChangeLog
configure
configure.ac
CONTRIBUTING.md
COPYING
default-ignore-list
doc/ChangeLog.OLD
@ -19,7 +21,6 @@ doc/manual.pdf
doc/stow.8
doc/stow.info
doc/stow.texi
doc/texinfo.tex
doc/version.texi
INSTALL.md
lib/Stow.pm
@ -43,12 +44,12 @@ t/find_stowed_path.t
t/foldable.t
t/ignore.t
t/join_paths.t
t/link_dest_within_stow_dir.t
t/parent.t
t/stow.t
t/rc_options.t
t/testutil.pm
t/unstow.t
t/unstow_orig.t
tools/get-version
THANKS
TODO

View file

@ -83,7 +83,14 @@
^doc/HOWTO-RELEASE$
# Avoid test files
tmp-testing-trees
.travis.yml
tmp-testing-trees*
^.coveralls.yml
^.github/workflows/
^.travis.yml
^docker/
^[a-zA-Z]*-docker.sh
^playground/
# Avoid development config
^.dir-locals.el
^.dumbjump

View file

@ -4,7 +4,7 @@
"unknown"
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.4224",
"generated_by" : "Module::Build version 0.4234",
"license" : [
"gpl_1"
],
@ -37,11 +37,11 @@
"provides" : {
"Stow" : {
"file" : "lib/Stow.pm",
"version" : "v2.3.2-fixbug56727"
"version" : "v2.4.0"
},
"Stow::Util" : {
"file" : "lib/Stow/Util.pm",
"version" : "v2.3.2-fixbug56727"
"version" : "v2.4.0"
}
},
"release_status" : "stable",
@ -55,6 +55,6 @@
"url" : "git://git.savannah.gnu.org/stow.git"
}
},
"version" : "v2.3.2-fixbug56727",
"x_serialization_backend" : "JSON::PP version 4.00"
"version" : "v2.4.0",
"x_serialization_backend" : "JSON::PP version 4.16"
}

View file

@ -9,7 +9,7 @@ build_requires:
configure_requires:
Module::Build: '0'
dynamic_config: 1
generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010'
generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010'
license: gpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@ -18,10 +18,10 @@ name: Stow
provides:
Stow:
file: lib/Stow.pm
version: v2.3.2-fixbug56727
version: v2.4.0
Stow::Util:
file: lib/Stow/Util.pm
version: v2.3.2-fixbug56727
version: v2.4.0
requires:
Carp: '0'
IO::File: '0'
@ -30,5 +30,5 @@ resources:
homepage: https://savannah.gnu.org/projects/stow
license: http://www.gnu.org/licenses/gpl-2.0.html
repository: git://git.savannah.gnu.org/stow.git
version: v2.3.2-fixbug56727
version: v2.4.0
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

View file

@ -32,26 +32,26 @@ pmstowdir = $(pmdir)/Stow
pm_DATA = lib/Stow.pm
pmstow_DATA = lib/Stow/Util.pm
TEXINFO_TEX = doc/texinfo.tex
export TEXI2DVI_BUILD_MODE = clean
AM_MAKEINFOFLAGS = -I $(srcdir)
# We require this -I parameter to ensure that the include of the
# default ignore list in the manual works. Unfortunately this is
# the only way to do it:
# default ignore list in the manual works correctly, even when the
# manual is being built via make distcheck from a different directory.
# Unfortunately this is the only way to do it:
#
# http://article.gmane.org/gmane.comp.sysutils.automake.bugs/4334/match=passing+parameters
# https://lists.gnu.org/archive/html/bug-automake/2008-09/msg00040.html
#
# even though it annoyingly produces a warning with the -Wall option
# to AM_INIT_AUTOMAKE which has to be silenced via -Wno-override.
TEXI2DVI = texi2dvi $(AM_MAKEINFOFLAGS)
doc_deps = $(info_TEXINFOS) doc/version.texi
DEFAULT_IGNORE_LIST = $(srcdir)/default-ignore-list
doc_deps = $(info_TEXINFOS) doc/version.texi $(DEFAULT_IGNORE_LIST)
TESTS_DIR = $(srcdir)/t
TESTS_OUT = tmp-testing-trees
TESTS_OUT = tmp-testing-trees tmp-testing-trees-compat
TESTS_ENVIRONMENT = $(PERL) -Ibin -Ilib -I$(TESTS_DIR)
# This is a kind of hack; TESTS needs to be set to ensure that the
@ -77,7 +77,7 @@ check_DATA = $(TESTS_OUT)
# Note that automake's `check' rule cannot be overridden
# for some weird reason:
#
# http://thread.gmane.org/gmane.comp.sysutils.automake.general/13040/focus=13041
# https://lists.gnu.org/archive/html/automake/2011-09/msg00029.html
#
# so we override check-TESTS instead which is where the real work is
# done anyway. Unfortunately this produces a warning with the -Wall
@ -87,6 +87,10 @@ check-TESTS:
dir=$(TESTS_DIR); \
$(TESTS_ENVIRONMENT) -MTest::Harness -e 'runtests(@ARGV)' "$${dir#./}"/*.t
coverage:
PERL5OPT=-MDevel::Cover $(MAKE) check-TESTS
cover
$(TESTS_OUT):
mkdir -p $@
@ -95,7 +99,6 @@ EXTRA_DIST = \
bin/stow.in bin/chkstow.in lib/Stow.pm.in lib/Stow/Util.pm.in \
doc/manual-split \
$(TESTS) t/testutil.pm \
$(TEXINFO_TEX) \
$(DEFAULT_IGNORE_LIST) \
$(CPAN_FILES)
CLEANFILES = $(bin_SCRIPTS) $(pm_DATA) $(pmstow_DATA)
@ -193,7 +196,7 @@ doc/stow.8: bin/stow.in Makefile.am
#
# If it were not for a troublesome dependency on doc/$(am__dirstamp):
#
# http://article.gmane.org/gmane.comp.sysutils.automake.general/13192
# https://lists.gnu.org/archive/html/automake/2011-11/msg00107.html
#
# we could have achieved this using the built-in rules combined with
# install-data-hook to rename from stow.pdf to manual.pdf etc. on
@ -302,3 +305,28 @@ ChangeLog: doc/ChangeLog.OLD
else \
echo "Not in a git repository; can't update ChangeLog."; \
fi
# Watch for changes, and if any rebuilds are required, also do a
# make install.
#
# If we solved https://github.com/aspiers/stow/issues/84, we could
# probably ditch this:
watch:
@echo "Watching for changes to program source files ..."
@while true; do \
if $(MAKE) 2>&1 | \
grep -vE 'make\[[1-9]\]: (Entering|Leaving) directory ' | \
grep -v 'Nothing to be done'; \
then \
echo; \
echo "-----------------------------------------------------"; \
echo "make found things to rebuild; doing $(MAKE) install ..."; \
echo; \
$(MAKE) install; \
echo; \
echo ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>"; \
echo; \
fi; \
sleep 1; \
done 2>&1 | \
grep -vE 'make\[[1-9]\]: (Entering|Leaving) directory '

82
NEWS
View file

@ -1,5 +1,81 @@
News file for Stow.
* Changes in version 2.4.0
*** --dotfiles now works with directories
A long-standing bug preventing the --dotfiles option from working
correctly with directories has been fixed.
It should also works in combination with the --compat option.
*** Eliminated a spurious warning on unstowing
2.3.1 introduced a benign but annoying warning when unstowing
in certain circumstances. It looked like:
BUG in find_stowed_path? Absolute/relative mismatch between Stow dir X and path Y
This was caused by erroneous logic, and has now been fixed.
*** Unstowing logic has been improved in other cases
Several other improvements have been made internally to the
unstowing logic. These changes should all be either invisible
(except for changes to debug output) or improvements, but if you
encounter any unexpected behaviour, please report it as directed
in the manual.
*** Improved debug output
Extra output resulting from use of the -v / --verbose flag
now appears in a more logical and understandable way.
*** Janitorial tasks
Users are not substantially affected by these changes.
***** Added some more information from the web page to the README
***** Made some improvements to the documentation
***** Improve readability of source code
Quite a few extra details have been added in comments to clarify
how the code works. Many variable names have also been
improved. The comments of many Stow class methods have been
converted into Perl POD format.
***** Added a =CONTRIBUTING.md= file
***** Add a =watch= target to =Makefile=
=make watch= provides easy continual pre-processing during
development, which reduces the risk of debugging the wrong code.
***** Removed texinfo.tex from the distribution
This eliminates existing and future bit-rot.
***** Updated aclocal.m4 from 1.15.1 to 1.16.5
This mostly just updates copyright notices to 2021, and URLs to https.
***** Replace broken gmane links with links to lists.gnu.org
[[https://lars.ingebrigtsen.no/2020/01/06/whatever-happened-to-news-gmane-org/][gmane has been dead for quite a while.]]
***** Improve support for navigating / editing source via emacs
******* Support source navigation in emacs via [[https://github.com/jacktasia/dumb-jump][dumb-jump]].
******* Configure cperl-mode to match existing coding style.
*** Various maintainer tweaks
Further improved the release process and its documentation in
various minor ways.
* Changes in version 2.3.1
*** Remove dependencies on Hash::Merge and Clone::Choose
@ -138,6 +214,7 @@ News file for Stow.
consistency.
- INSTALL.md now also documents how to build directly from git.
*** Fixes for bugs, tests, and other technical debt
***** Add Docker files for convenient testing across multiple Perl versions
@ -235,7 +312,7 @@ due to Stow::Util missing $VERSION.
stow directory path being calculated as
../../../usr/home/user/local/stow relative to the target.
See http://article.gmane.org/gmane.comp.gnu.stow.bugs/8820 for details.
See https://lists.gnu.org/archive/html/bug-stow/2013-04/msg00000.html for details.
*** Fix stowing of relative links when --no-folding is used.
@ -276,7 +353,7 @@ due to Stow::Util missing $VERSION.
Thanks to Gabriele Balducci for reporting this problem:
http://thread.gmane.org/gmane.comp.gnu.stow.general/6676
https://lists.gnu.org/archive/html/help-stow/2014-09/msg00000.html
*** Internal code cleanups
@ -586,4 +663,5 @@ due to Stow::Util missing $VERSION.
org-export-with-toc: nil
org-export-with-author: nil
org-toc-odd-levels-only: t
org-blank-before-new-entry: ((heading . auto) (plain-list-item . auto))
End:

View file

@ -60,6 +60,56 @@ You can get the latest information about Stow from the home page:
http://www.gnu.org/software/stow/
Installation
------------
See [`INSTALL.md`](INSTALL.md) for installation instructions.
Documentation
-------------
Documentation for Stow is available
[online](https://www.gnu.org/software/stow/manual/), as is
[documentation for most GNU
software](https://www.gnu.org/software/manual/). Once you have Stow
installed, you may also find more information about Stow by running
`info stow` or `man stow`, or by looking at `/usr/share/doc/stow/`,
`/usr/local/doc/stow/`, or similar directories on your system. A
brief summary is available by running `stow --help`.
Mailing lists
-------------
Stow has the following mailing lists:
- [help-stow](https://lists.gnu.org/mailman/listinfo/help-stow) is for
general user help and discussion.
- [stow-devel](https://lists.gnu.org/mailman/listinfo/stow-devel) is
used to discuss most aspects of Stow, including development and
enhancement requests.
- [bug-stow](https://lists.gnu.org/mailman/listinfo/bug-stow) is for
bug reports.
Announcements about Stow are posted to
[info-stow](http://lists.gnu.org/mailman/listinfo/info-stow) and also,
as with most other GNU software, to
[info-gnu](http://lists.gnu.org/mailman/listinfo/info-gnu)
([archive](http://lists.gnu.org/archive/html/info-gnu/)).
Security reports that should not be made immediately public can be
sent directly to the maintainer. If there is no response to an urgent
issue, you can escalate to the general
[security](http://lists.gnu.org/mailman/listinfo/security) mailing
list for advice.
The Savannah project also has a [mailing
lists](https://savannah.gnu.org/mail/?group=stow) page.
Getting involved
----------------
Please see the [`CONTRIBUTING.md` file](CONTRIBUTING.md).
License
-------
@ -71,18 +121,6 @@ are permitted in any medium without royalty provided the copyright
notice and this notice are preserved. This file is offered as-is,
without any warranty.
Installation
------------
See [`INSTALL.md`](INSTALL.md) for installation instructions.
Feedback
--------
Please do send comments, questions, and constructive criticism. The
mailing lists and any other communication channels are detailed on the
above home page.
Brief history and authorship
----------------------------

2
TODO
View file

@ -4,7 +4,7 @@
install-info, amongst other things:
*** http://unix.stackexchange.com/questions/73426/dealing-with-gnu-stow-conflicts
*** http://article.gmane.org/gmane.comp.gnu.stow.general/6661
*** https://lists.gnu.org/archive/html/help-stow/2013-04/msg00016.html
* Get permission for next documentation release to be under FDL 1.3

4
aclocal.m4 vendored
View file

@ -14,8 +14,8 @@
m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])])
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.71],,
[m4_warning([this file was generated for autoconf 2.71.
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.72],,
[m4_warning([this file was generated for autoconf 2.72.
You have another version of autoconf. It may work, but is not guaranteed to.
If you have problems, you may need to regenerate the build system entirely.
To do so, use the procedure documented by the package, typically 'autoreconf'.])])

1
automake/.gitignore vendored
View file

@ -2,3 +2,4 @@ install-sh
missing
mdate-sh
test-driver
texinfo.tex

View file

@ -123,6 +123,5 @@ sub list {
# Local variables:
# mode: perl
# cperl-indent-level: 4
# End:
# vim: ft=perl

View file

@ -474,7 +474,6 @@ sub main {
my ($options, $pkgs_to_unstow, $pkgs_to_stow) = process_options();
my $stow = new Stow(%$options);
# current dir is now the target directory
$stow->plan_unstow(@$pkgs_to_unstow);
$stow->plan_stow (@$pkgs_to_stow);
@ -849,6 +848,5 @@ sub version {
# Local variables:
# mode: perl
# cperl-indent-level: 4
# end:
# vim: ft=perl

View file

@ -15,11 +15,11 @@ dnl along with this program. If not, see https://www.gnu.org/licenses/.
dnl Process this file with Autoconf to produce configure dnl
AC_INIT([stow], [2.3.2-fixbug56727], [bug-stow@gnu.org])
AC_INIT([stow], [2.4.0], [bug-stow@gnu.org])
AC_PREREQ([2.61])
AC_CONFIG_AUX_DIR([automake])
# Unfortunately we have to disable warnings for overrides, because we
# need to override the built-in `check' rule and also the TEXI2DVI
# need to override the built-in `check-TESTS' rule and also the TEXI2DVI
# variable.
AM_INIT_AUTOMAKE([-Wall -Werror -Wno-override dist-bzip2 foreign])
AC_PROG_INSTALL

View file

@ -13,6 +13,7 @@ _darcs
\.git
\.gitignore
\.gitmodules
.+~ # emacs backup files
\#.*\# # emacs autosave files

View file

@ -21,17 +21,16 @@ Release procedure
version=$( tools/get-version ) && echo $version
- Ensure NEWS contains the latest changes, and that any new
contributors have been added to THANKS. If necessary, commit
- Ensure NEWS contains the latest changes. If necessary, commit
any additions:
git commit -m "Prepare NEWS and THANKS for $version release"
git commit -m "Prepare NEWS for $version release"
- Check CPAN distribution will work via Module::Build:
- Start from a clean slate:
make distclean
make maintainer-clean
autoreconf -iv
- Generate stow, chkstow, and lib/Stow.pm via:

View file

@ -19,13 +19,13 @@ This manual describes GNU Stow version @value{VERSION}
Software and documentation is copyrighted by the following:
@copyright{} 1993, 1994, 1995, 1996 Bob Glickstein <bobg+stow@@zanshin.com>
@copyright{} 1993, 1994, 1995, 1996 Bob Glickstein @email{bobg+stow@@zanshin.com}
@*
@copyright{} 2000, 2001 Guillaume Morin <gmorin@@gnu.org>
@copyright{} 2000, 2001 Guillaume Morin @email{gmorin@@gnu.org}
@*
@copyright{} 2007 Kahlil (Kal) Hodgson <kahlil@@internode.on.net>
@copyright{} 2007 Kahlil (Kal) Hodgson @email{kahlil@@internode.on.net}
@*
@copyright{} 2011 Adam Spiers <stow@@adamspiers.org>
@copyright{} 2011 Adam Spiers @email{stow@@adamspiers.org}
@quotation
Permission is granted to make and distribute verbatim copies of this
@ -99,7 +99,7 @@ appear to be installed in a single directory tree.
* Multiple Stow Directories:: Further segregating software.
* Target Maintenance:: Cleaning up mistakes.
* Resource Files:: Setting default command line options.
* Compile-time vs Install-time:: Faking out `make install'.
* Compile-time vs. Install-time:: Faking out `make install'.
* Bootstrapping:: When stow and perl are not yet stowed.
* Reporting Bugs:: How, what, where, and when to report.
* Known Bugs:: Don't report any of these.
@ -220,9 +220,12 @@ to be installed in a particular directory structure --- e.g., with
@cindex target directory
A @dfn{target directory} is the root of a tree in which one or more
packages wish to @emph{appear} to be installed. A common, but by no
means the only such location is @file{/usr/local}. The examples in this
manual will use @file{/usr/local} as the target directory.
packages wish to @emph{appear} to be installed. @file{/usr/local} is a
common choice for this, but by no means the only such location. Another
common choice is @file{~} (i.e.@: the user's @code{$HOME} directory) in
the case where Stow is being used to manage the user's configuration
(``dotfiles'') and other files in their @code{$HOME}. The examples in
this manual will use @file{/usr/local} as the target directory.
@cindex stow directory
A @dfn{stow directory} is the root of a tree containing separate
@ -240,6 +243,11 @@ installation image for Perl includes: a @file{bin} directory containing
containing Texinfo documentation; a @file{lib/perl} directory containing
Perl libraries; and a @file{man/man1} directory containing man pages.
@quotation Note
This is a @emph{pre-}installation image which exists even before Stow
has installed any symlinks into the target directory which point to it.
@end quotation
@cindex package directory
@cindex package name
A @dfn{package directory} is the root of a tree containing the
@ -255,15 +263,68 @@ target directory, @file{/usr/local/stow} is the stow directory,
@file{/usr/local/stow/perl} is the package directory, and
@file{bin/perl} within is part of the installation image.
@anchor{symlink}
@cindex symlink
@cindex symlink source
@cindex symlink destination
@cindex relative symlink
@cindex absolute symlink
A @dfn{symlink} is a symbolic link. A symlink can be @dfn{relative} or
@dfn{absolute}. An absolute symlink names a full path; that is, one
starting from @file{/}. A relative symlink names a relative path; that
is, one not starting from @file{/}. The target of a relative symlink is
computed starting from the symlink's own directory. Stow only
creates relative symlinks.
A @dfn{symlink} is a symbolic link, i.e.@: an entry on the filesystem
whose path is sometimes called the @dfn{symlink source}, which points to
another location on the filesystem called the @dfn{symlink destination}.
There is no guarantee that the destination actually exists.
In general, symlinks can be @dfn{relative} or @dfn{absolute}. A symlink
is absolute when the destination names a full path; that is, one
starting from @file{/}. A symlink is relative when the destination
names a relative path; that is, one not starting from @file{/}. The
destination of a relative symlink is computed starting from the
symlink's own directory, i.e.@: the directory containing the symlink
source.
@quotation Note
Stow only creates symlinks within the target directory which point to
locations @emph{outside} the target directory and inside the stow
directory.
Consequently, we avoid referring to symlink destinations as symlink
@emph{targets}, since this would result in the word ``target'' having
two different meanings:
@enumerate
@item
the target directory, i.e.@: the directory into which Stow targets
installation, where symlinks are managed by Stow, and
@item
the destinations of those symlinks.
@end enumerate
If we did not avoid the second meaning of ``target'', then it would lead
to confusing language, such as describing Stow as installing symlinks
into the target directory which point to targets @emph{outside} the
target directory.
Similarly, the word ``source'' can have two different meanings in this
context:
@enumerate
@item
the installation image, or some of its contents, and
@item
the location of symlinks (the ``source'' of the link, vs.@: its
destination).
@end enumerate
Therefore it should also be avoided, or at least care taken to ensure
that the meaning is not ambiguous.
@end quotation
@c ===========================================================================
@node Invoking Stow, Ignore Lists, Terminology, Top
@ -383,7 +444,7 @@ refolding (@pxref{tree refolding}). If a new subdirectory is
encountered whilst stowing a new package, the subdirectory is created
within the target, and its contents are symlinked, rather than just
creating a symlink for the directory. If removal of symlinks whilst
unstowing a package causes a subtree to be foldable (i.e. only
unstowing a package causes a subtree to be foldable (i.e.@: only
containing symlinks to a single package), that subtree will not be
removed and replaced with a symlink.
@ -428,13 +489,15 @@ doing. Verbosity levels are from 0 to 5; 0 is the default. Using
@item -p
@itemx --compat
Scan the whole target tree when unstowing. By default, only
directories specified in the @dfn{installation image} are scanned
during an unstow operation. Scanning the whole tree can be
prohibitive if your target tree is very large. This option restores
the legacy behaviour; however, the @option{--badlinks} option to the
@command{chkstow} utility may be a better way of ensuring that your
installation does not have any dangling symlinks (@pxref{Target
Scan the whole target tree when unstowing. By default, only directories
specified in the @dfn{installation image} are scanned during an unstow
operation. Previously Stow scanned the whole tree, which can be
prohibitive if your target tree is very large, but on the other hand has
the advantage of unstowing previously stowed links which are no longer
present in the installation image and therefore orphaned. This option
restores the legacy behaviour; however, the @option{--badlinks} option
to the @command{chkstow} utility may be a better way of ensuring that
your installation does not have any dangling symlinks (@pxref{Target
Maintenance}).
@item -V
@ -813,7 +876,7 @@ This is much faster and cleaner than performing two separate
invocations of stow, because redundant folding/unfolding operations
can be factored out. In addition, all the operations are calculated
and merged before being executed (@pxref{Deferred Operation}), so the
amount of of time in which GNU Emacs is unavailable is minimised.
amount of time in which GNU Emacs is unavailable is minimised.
You can mix and match any number of actions, for example,
@ -893,7 +956,7 @@ directory.
@end table
@c ===========================================================================
@node Resource Files, Compile-time vs Install-time, Target Maintenance, Top
@node Resource Files, Compile-time vs. Install-time, Target Maintenance, Top
@chapter Resource Files
@cindex resource files
@cindex configuration files
@ -960,8 +1023,8 @@ resource files. This is also true of any package names given in the
resource file.
@c ===========================================================================
@node Compile-time vs Install-time, Bootstrapping, Resource Files, Top
@chapter Compile-time vs Install-time
@node Compile-time vs. Install-time, Bootstrapping, Resource Files, Top
@chapter Compile-time vs. Install-time
Software whose installation is managed with Stow needs to be installed
in one place (the package directory, e.g. @file{/usr/local/stow/perl})
@ -1043,7 +1106,7 @@ following sections.
@end menu
@c ---------------------------------------------------------------------------
@node GNU Emacs, Other FSF Software, Compile-time vs Install-time, Compile-time vs Install-time
@node GNU Emacs, Other FSF Software, Compile-time vs. Install-time, Compile-time vs. Install-time
@section GNU Emacs
Although the Free Software Foundation has many enlightened practices
@ -1076,7 +1139,7 @@ make do-install prefix=/usr/local/stow/emacs
@end example
@c ---------------------------------------------------------------------------
@node Other FSF Software, Cygnus Software, GNU Emacs, Compile-time vs Install-time
@node Other FSF Software, Cygnus Software, GNU Emacs, Compile-time vs. Install-time
@section Other FSF Software
The Free Software Foundation, the organization behind the GNU project,
@ -1097,7 +1160,7 @@ and @samp{make install} steps to work correctly without needing to
``fool'' the build process.
@c ---------------------------------------------------------------------------
@node Cygnus Software, Perl and Perl 5 Modules, Other FSF Software, Compile-time vs Install-time
@node Cygnus Software, Perl and Perl 5 Modules, Other FSF Software, Compile-time vs. Install-time
@section Cygnus Software
Cygnus is a commercial supplier and supporter of GNU software. It has
@ -1126,7 +1189,7 @@ is recompiling files. Usually it will work just fine; otherwise,
install manually.
@c ---------------------------------------------------------------------------
@node Perl and Perl 5 Modules, , Cygnus Software, Compile-time vs Install-time
@node Perl and Perl 5 Modules, , Cygnus Software, Compile-time vs. Install-time
@section Perl and Perl 5 Modules
Perl 4.036 allows you to specify different locations for installation
@ -1229,7 +1292,7 @@ find cpan.* \( -name .exists -o -name perllocal.pod \) -print | \
@c ---------------------------------------------------------------------------
@node Bootstrapping, Reporting Bugs, Compile-time vs Install-time, Top
@node Bootstrapping, Reporting Bugs, Compile-time vs. Install-time, Top
@chapter Bootstrapping
Suppose you have a stow directory all set up and ready to go:
@ -1264,9 +1327,32 @@ perl/bin/perl stow/bin/stow -vv *
@node Reporting Bugs, Known Bugs, Bootstrapping, Top
@chapter Reporting Bugs
Please send bug reports to the current maintainers by electronic
mail. The address to use is @samp{<bug-stow@@gnu.org>}. Please
include:
You can report bugs to the current maintainers in one of three ways:
@enumerate
@item
Send e-mail to @email{bug-stow@@gnu.org}.
@item
File an issue in @uref{https://savannah.gnu.org/bugs/?group=stow,
the Savannah bug tracker}.
@item
File an issue in
@uref{https://github.com/aspiers/stow/issues/, the GitHub project}.
@end enumerate
While GitHub is arguably the most convenient of these three options, it
@uref{https://www.gnu.org/software/repo-criteria-evaluation.html#GitHub,
is not the most ethical or freedom-preserving way to host software
projects}. Therefore the GitHub project may be
@uref{https://github.com/aspiers/stow/issues/43, moved to a more ethical
hosting service} in the future.
Before reporting a bug, it is recommended to check whether it is already
known, so please first @pxref{Known Bugs}.
When reporting a new bug, please include:
@itemize @bullet
@item
@ -1287,12 +1373,13 @@ the precise command you gave;
@item
the output from the command (preferably verbose output, obtained by
adding @samp{--verbose=3} to the Stow command line).
adding @samp{--verbose=5} to the Stow command line).
@end itemize
If you are really keen, consider developing a minimal test case and
creating a new test. See the @file{t/} directory in the source for
lots of examples.
creating a new test. See the @file{t/} directory in the source for lots
of examples, and the @file{CONTRIBUTING.md} file for a guide on how to
contribute.
Before reporting a bug, please read the manual carefully, especially
@ref{Known Bugs}, to see whether you're encountering
@ -1303,13 +1390,22 @@ something that doesn't need reporting.
@node Known Bugs, GNU General Public License, Reporting Bugs, Top
@chapter Known Bugs
There are no known bugs in Stow version @value{VERSION}!
If you think you have found one, please @pxref{Reporting Bugs}.
Known bugs can be found in the following locations:
@c @itemize @bullet
@c @item
@c Put known bugs here
@c @end itemize
@itemize
@item
@uref{https://github.com/aspiers/stow/issues/, the GitHub issue tracker}
@item
@uref{https://savannah.gnu.org/bugs/?group=stow, the Savannah bug
tracker}
@item
the @uref{https://lists.gnu.org/archive/html/bug-stow/, bug-stow list
archives}
@end itemize
If you think you have found a new bug, please @pxref{Reporting Bugs}.
@c ===========================================================================
@node GNU General Public License, Index, Known Bugs, Top

File diff suppressed because it is too large Load diff

View file

@ -16,10 +16,9 @@
# Build docker image: `docker build -t stowtest`
# Run tests: (from stow src directory)
# `docker run --rm -it -v $(pwd):$(pwd) -w $(pwd) stowtest`
FROM debian:jessie
RUN printf "deb http://archive.debian.org/debian/ jessie main\ndeb-src http://archive.debian.org/debian/ jessie main\ndeb http://security.debian.org jessie/updates main\ndeb-src http://security.debian.org jessie/updates main" > /etc/apt/sources.list
FROM debian:bookworm
RUN DEBIAN_FRONTEND=noninteractive apt-get update -qq
RUN DEBIAN_FRONTEND=noninteractive \
apt-get update -qq && \
apt-get install -y -q \
autoconf \
bzip2 \

File diff suppressed because it is too large Load diff

View file

@ -32,12 +32,14 @@ Supporting utility routines for L<Stow>.
use strict;
use warnings;
use File::Spec;
use POSIX qw(getcwd);
use base qw(Exporter);
our @EXPORT_OK = qw(
error debug set_debug_level set_test_mode
join_paths parent canon_path restore_cwd adjust_dotfile
join_paths parent canon_path restore_cwd
adjust_dotfile unadjust_dotfile
);
our $ProgramName = 'stow';
@ -93,7 +95,7 @@ sub set_test_mode {
}
}
=head2 debug($level, $msg)
=head2 debug($level[, $indent_level], $msg)
Logs to STDERR based on C<$debug_level> setting. C<$level> is the
minimum verbosity level required to output C<$msg>. All output is to
@ -125,13 +127,18 @@ overriding, fixing invalid links
=cut
sub debug {
my ($level, $msg) = @_;
my $level = shift;
my $indent_level;
# Maintain backwards-compatibility in case anyone's relying on this.
$indent_level = $_[0] =~ /^\d+$/ ? shift : 0;
my $msg = shift;
if ($debug_level >= $level) {
my $indent = ' ' x $indent_level;
if ($test_mode) {
print "# $msg\n";
print "# $indent$msg\n";
}
else {
warn "$msg\n";
warn "$indent$msg\n";
}
}
}
@ -142,29 +149,53 @@ sub debug {
# Parameters: path1, path2, ... => paths
# Returns : concatenation of given paths
# Throws : n/a
# Comments : factors out redundant path elements:
# : '//' => '/' and 'a/b/../c' => 'a/c'
# Comments : Factors out some redundant path elements:
# : '//' => '/', and 'a/b/../c' => 'a/c'. We need this function
# : with this behaviour, even though b could be a symlink to
# : elsewhere, as noted in the perldoc for File::Spec->canonpath().
# : This behaviour is deliberately different to
# : Stow::Util::canon_path(), because the way join_paths() is used
# : relies on this. Firstly, there is no guarantee that the paths
# : exist, so a filesystem check is inappropriate.
# :
# : For example, it's used to determine the path from the target
# : directory to a symlink destination. So if a symlink
# : path/to/target/a/b/c points to ../../../stow/pkg/a/b/c,
# : then joining path/to/target/a/b with ../../../stow/pkg/a/b/c
# : yields path/to/stow/pkg/a/b/c, and it's crucial that the
# : path/to/stow prefix matches a recognisable stow directory.
#============================================================================
sub join_paths {
my @paths = @_;
# weed out empty components and concatenate
my $result = join '/', grep {! /\A\z/} @paths;
debug(5, 5, "| Joining: @paths");
my $result = '';
for my $part (@paths) {
next if ! length $part; # probably shouldn't happen?
$part = File::Spec->canonpath($part);
# factor out back references and remove redundant /'s)
my @result = ();
PART:
for my $part (split m{/+}, $result) {
next PART if $part eq '.';
if (@result && $part eq '..' && $result[-1] ne '..') {
pop @result;
if (substr($part, 0, 1) eq '/') {
$result = $part; # absolute path, so ignore all previous parts
}
else {
push @result, $part;
$result .= '/' if length $result && $result ne '/';
$result .= $part;
}
debug(7, 6, "| Join now: $result");
}
debug(6, 5, "| Joined: $result");
return join '/', @result;
# Need this to remove any initial ./
$result = File::Spec->canonpath($result);
# remove foo/..
1 while $result =~ s,(^|/)(?!\.\.)[^/]+/\.\.(/|$),$1,;
debug(6, 5, "| After .. removal: $result");
$result = File::Spec->canonpath($result);
debug(5, 5, "| Final join: $result");
return $result;
}
#===== METHOD ===============================================================
@ -181,7 +212,7 @@ sub parent {
my $path = join '/', @_;
my @elts = split m{/+}, $path;
pop @elts;
return join '/', @elts;
return join '/', @elts;
}
#===== METHOD ===============================================================
@ -209,17 +240,17 @@ sub restore_cwd {
}
sub adjust_dotfile {
my ($target) = @_;
my ($pkg_node) = @_;
(my $adjusted = $pkg_node) =~ s/^dot-([^.])/.$1/;
return $adjusted;
}
my @result = ();
for my $part (split m{/+}, $target) {
if (($part ne "dot-") && ($part ne "dot-.")) {
$part =~ s/^dot-/./;
}
push @result, $part;
}
return join '/', @result;
# Needed when unstowing with --compat and --dotfiles
sub unadjust_dotfile {
my ($target_node) = @_;
return $target_node if $target_node =~ /^\.\.?$/;
(my $adjusted = $target_node) =~ s/^\./dot-/;
return $adjusted;
}
=head1 BUGS
@ -232,6 +263,5 @@ sub adjust_dotfile {
# Local variables:
# mode: perl
# cperl-indent-level: 4
# end:
# vim: ft=perl

View file

@ -22,10 +22,11 @@
use strict;
use warnings;
use Test::More tests => 6;
use Test::More tests => 4;
use English qw(-no_match_vars);
use testutil;
use Stow::Util;
init_test_dirs();
cd("$TEST_DIR/target");
@ -34,48 +35,64 @@ my $stow;
# Note that each of the following tests use a distinct set of files
#
# nothing to clean in a simple tree
#
subtest('nothing to clean in a simple tree' => sub {
plan tests => 1;
make_path('../stow/pkg1/bin1');
make_file('../stow/pkg1/bin1/file1');
make_link('bin1', '../stow/pkg1/bin1');
make_path('../stow/pkg1/bin1');
make_file('../stow/pkg1/bin1/file1');
make_link('bin1', '../stow/pkg1/bin1');
$stow = new_Stow();
$stow->cleanup_invalid_links('./');
is(
scalar($stow->get_tasks), 0
=> 'nothing to clean'
);
});
$stow = new_Stow();
$stow->cleanup_invalid_links('./');
is(
scalar($stow->get_tasks), 0
=> 'nothing to clean'
);
subtest('cleanup an orphaned owned link in a simple tree' => sub {
plan tests => 3;
#
# cleanup a bad link in a simple tree
#
make_path('bin2');
make_path('../stow/pkg2/bin2');
make_file('../stow/pkg2/bin2/file2a');
make_link('bin2/file2a', '../../stow/pkg2/bin2/file2a');
make_invalid_link('bin2/file2b', '../../stow/pkg2/bin2/file2b');
make_path('bin2');
make_path('../stow/pkg2/bin2');
make_file('../stow/pkg2/bin2/file2a');
make_link('bin2/file2a', '../../stow/pkg2/bin2/file2a');
make_invalid_link('bin2/file2b', '../../stow/pkg2/bin2/file2b');
$stow = new_Stow();
$stow->cleanup_invalid_links('bin2');
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link');
is(scalar($stow->get_tasks), 1, 'one task cleaning up bad link');
is($stow->link_task_action('bin2/file2b'), 'remove', 'removal task for bad link');
$stow = new_Stow();
$stow->cleanup_invalid_links('bin2');
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link');
is(scalar($stow->get_tasks), 1, 'one task cleaning up bad link');
is($stow->link_task_action('bin2/file2b'), 'remove', 'removal task for bad link');
});
#
# dont cleanup a bad link not owned by stow
#
subtest("don't cleanup a bad link not owned by stow" => sub {
plan tests => 2;
make_path('bin3');
make_path('../stow/pkg3/bin3');
make_file('../stow/pkg3/bin3/file3a');
make_link('bin3/file3a', '../../stow/pkg3/bin3/file3a');
make_invalid_link('bin3/file3b', '../../empty');
make_path('bin3');
make_path('../stow/pkg3/bin3');
make_file('../stow/pkg3/bin3/file3a');
make_link('bin3/file3a', '../../stow/pkg3/bin3/file3a');
make_invalid_link('bin3/file3b', '../../empty');
$stow = new_Stow();
$stow->cleanup_invalid_links('bin3');
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link not owned by stow');
is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
$stow = new_Stow();
$stow->cleanup_invalid_links('bin3');
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link not owned by stow');
is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
});
subtest("don't cleanup a valid link in the target not owned by stow" => sub {
plan tests => 2;
make_path('bin4');
make_path('../stow/pkg4/bin4');
make_file('../stow/pkg4/bin4/file3a');
make_link('bin4/file3a', '../../stow/pkg4/bin4/file3a');
make_file("unowned");
make_link('bin4/file3b', '../unowned');
$stow = new_Stow();
$stow->cleanup_invalid_links('bin4');
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link not owned by stow');
is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
});

View file

@ -22,190 +22,214 @@
use strict;
use warnings;
use testutil;
use Test::More tests => 10;
use Test::More tests => 12;
use English qw(-no_match_vars);
use Stow::Util qw(adjust_dotfile unadjust_dotfile);
use testutil;
init_test_dirs();
cd("$TEST_DIR/target");
subtest('adjust_dotfile()', sub {
plan tests => 4;
my @TESTS = (
['file'],
['dot-'],
['dot-.'],
['dot-file', '.file'],
);
for my $test (@TESTS) {
my ($input, $expected) = @$test;
$expected ||= $input;
is(adjust_dotfile($input), $expected);
}
});
subtest('unadjust_dotfile()', sub {
plan tests => 4;
my @TESTS = (
['file'],
['.'],
['..'],
['.file', 'dot-file'],
);
for my $test (@TESTS) {
my ($input, $expected) = @$test;
$expected ||= $input;
is(unadjust_dotfile($input), $expected);
}
});
my $stow;
#
# process a dotfile marked with 'dot' prefix
#
subtest("stow dot-foo as .foo", sub {
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-foo');
$stow = new_Stow(dir => '../stow', dotfiles => 1);
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.foo'),
'../stow/dotfiles/dot-foo',
=> 'processed dotfile'
);
});
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-foo');
subtest("stow dot-foo as dot-foo without --dotfile enabled", sub {
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 0);
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-foo');
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.foo'),
'../stow/dotfiles/dot-foo',
=> 'processed dotfile'
);
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('dot-foo'),
'../stow/dotfiles/dot-foo',
=> 'unprocessed dotfile'
);
});
#
# ensure that turning off dotfile processing links files as usual
#
subtest("stow dot-emacs dir as .emacs", sub {
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
$stow = new_Stow(dir => '../stow', dotfiles => 0);
make_path('../stow/dotfiles/dot-emacs');
make_file('../stow/dotfiles/dot-emacs/init.el');
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-foo');
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs'),
'../stow/dotfiles/dot-emacs',
=> 'processed dotfile dir'
);
});
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('dot-foo'),
'../stow/dotfiles/dot-foo',
=> 'unprocessed dotfile'
);
subtest("stow dir marked with 'dot' prefix when directory exists in target", sub {
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/init.el');
make_path('.emacs.d');
#
# process folder marked with 'dot' prefix
#
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs.d/init.el'),
'../../stow/dotfiles/dot-emacs.d/init.el',
=> 'processed dotfile dir when dir exists (1 level)'
);
});
$stow = new_Stow(dir => '../stow', dotfiles => 1);
subtest("stow dir marked with 'dot' prefix when directory exists in target (2 levels)", sub {
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles/dot-emacs');
make_file('../stow/dotfiles/dot-emacs/init.el');
make_path('../stow/dotfiles/dot-emacs.d/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/dot-emacs.d/init.el');
make_path('.emacs.d');
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs'),
'../stow/dotfiles/dot-emacs',
=> 'processed dotfile folder'
);
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs.d/.emacs.d'),
'../../stow/dotfiles/dot-emacs.d/dot-emacs.d',
=> 'processed dotfile dir exists (2 levels)'
);
});
#
# process folder marked with 'dot' prefix
# when directory exists is target
#
subtest("stow dir marked with 'dot' prefix when directory exists in target", sub {
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles/dot-one/dot-two');
make_file('../stow/dotfiles/dot-one/dot-two/three');
make_path('.one/.two');
make_path('../stow/dotfiles/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/init.el');
make_path('.emacs.d');
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('./.one/.two/three'),
'../../../stow/dotfiles/dot-one/dot-two/three',
=> 'processed dotfile 2 dir exists (2 levels)'
);
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs.d/init.el'),
'../../stow/dotfiles/dot-emacs.d/init.el',
=> 'processed dotfile folder when folder exists (1 level)'
);
});
#
# process folder marked with 'dot' prefix
# when directory exists is target (2 levels)
#
subtest("dot-. should not have that part expanded.", sub {
plan tests => 2;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-');
make_path('../stow/dotfiles/dot-emacs.d/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/dot-emacs.d/init.el');
make_path('.emacs.d');
make_path('../stow/dotfiles/dot-.');
make_file('../stow/dotfiles/dot-./foo');
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs.d/.emacs.d'),
'../../stow/dotfiles/dot-emacs.d/dot-emacs.d',
=> 'processed dotfile folder exists (2 levels)'
);
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('dot-'),
'../stow/dotfiles/dot-',
=> 'processed dotfile'
);
is(
readlink('dot-.'),
'../stow/dotfiles/dot-.',
=> 'unprocessed dotfile'
);
});
#
# process folder marked with 'dot' prefix
# when directory exists is target
#
subtest("unstow .bar from dot-bar", sub {
plan tests => 3;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-bar');
make_link('.bar', '../stow/dotfiles/dot-bar');
make_path('../stow/dotfiles/dot-one/dot-two');
make_file('../stow/dotfiles/dot-one/dot-two/three');
make_path('.one/.two');
$stow->plan_unstow('dotfiles');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
ok(-f '../stow/dotfiles/dot-bar', 'package file untouched');
ok(! -e '.bar' => '.bar was unstowed');
});
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('./.one/.two/three'),
'../../../stow/dotfiles/dot-one/dot-two/three',
=> 'processed dotfile 2 folder exists (2 levels)'
);
subtest("unstow dot-emacs.d/init.el when .emacs.d/init.el in target", sub {
plan tests => 4;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/init.el');
make_path('.emacs.d');
make_link('.emacs.d/init.el', '../../stow/dotfiles/dot-emacs.d/init.el');
#
# corner case: paths that have a part in them that's just "$DOT_PREFIX" or
# "$DOT_PREFIX." should not have that part expanded.
#
$stow->plan_unstow('dotfiles');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
ok(-f '../stow/dotfiles/dot-emacs.d/init.el');
ok(! -e '.emacs.d/init.el', '.emacs.d/init.el unstowed');
ok(-d '.emacs.d/' => '.emacs.d left behind');
});
$stow = new_Stow(dir => '../stow', dotfiles => 1);
subtest("unstow dot-emacs.d/init.el in --compat mode", sub {
plan tests => 4;
$stow = new_compat_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-');
make_path('../stow/dotfiles/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/init.el');
make_path('.emacs.d');
make_link('.emacs.d/init.el', '../../stow/dotfiles/dot-emacs.d/init.el');
make_path('../stow/dotfiles/dot-.');
make_file('../stow/dotfiles/dot-./foo');
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('dot-'),
'../stow/dotfiles/dot-',
=> 'processed dotfile'
);
is(
readlink('dot-.'),
'../stow/dotfiles/dot-.',
=> 'unprocessed dotfile'
);
#
# simple unstow scenario
#
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-bar');
make_link('.bar', '../stow/dotfiles/dot-bar');
$stow->plan_unstow('dotfiles');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f '../stow/dotfiles/dot-bar' && ! -e '.bar'
=> 'unstow a simple dotfile'
);
#
# unstow process folder marked with 'dot' prefix
# when directory exists is target
#
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/init.el');
make_path('.emacs.d');
make_link('.emacs.d/init.el', '../../stow/dotfiles/dot-emacs.d/init.el');
$stow->plan_unstow('dotfiles');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f '../stow/dotfiles/dot-emacs.d/init.el' &&
! -e '.emacs.d/init.el' &&
-d '.emacs.d/'
=> 'unstow dotfile folder when folder already exists'
);
$stow->plan_unstow('dotfiles');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
ok(-f '../stow/dotfiles/dot-emacs.d/init.el');
ok(! -e '.emacs.d/init.el', '.emacs.d/init.el unstowed');
ok(-d '.emacs.d/' => '.emacs.d left behind');
});

View file

@ -16,65 +16,133 @@
# along with this program. If not, see https://www.gnu.org/licenses/.
#
# Testing find_stowed_path()
# Testing Stow:: find_stowed_path()
#
use strict;
use warnings;
use Test::More tests => 18;
use Test::More tests => 10;
use testutil;
use Stow::Util qw(set_debug_level);
init_test_dirs();
my $stow = new_Stow(dir => "$TEST_DIR/stow");
#set_debug_level(4);
subtest("find link to a stowed path with relative target" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../../stow/a/b/c");
is($path, "$TEST_DIR/stow/a/b/c", "path");
is($stow_path, "$TEST_DIR/stow", "stow path");
is($package, "a", "package");
# This is a relative path, unlike $ABS_TEST_DIR below.
my $target = "$TEST_DIR/target";
cd("$TEST_DIR/target");
$stow->set_stow_dir("../stow");
($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../../stow/a/b/c");
is($path, "../stow/a/b/c", "path from target directory");
is($stow_path, "../stow", "stow path from target directory");
is($package, "a", "from target directory");
my $stow = new_Stow(dir => "$TEST_DIR/stow", target => $target);
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../../stow/a/b/c");
is($path, "../stow/a/b/c", "path");
is($stow_path, "../stow", "stow path");
is($package, "a", "package");
});
make_path("stow");
cd("../..");
$stow->set_stow_dir("$TEST_DIR/target/stow");
my $stow = new_Stow(dir => "$ABS_TEST_DIR/stow", target => "$ABS_TEST_DIR/target");
($path, $stow_path, $package) =
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../stow/a/b/c");
is($path, "$TEST_DIR/target/stow/a/b/c", "path");
is($stow_path, "$TEST_DIR/target/stow", "stow path");
is($package, "a", "stow is subdir of target directory");
# Required by creation of stow2 and stow2/.stow below
cd("$ABS_TEST_DIR/target");
($path, $stow_path, $package) =
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../empty");
is($path, "", "empty path");
is($stow_path, "", "empty stow path");
is($package, "", "target is not stowed");
subtest("find link to a stowed path" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../../stow/a/b/c");
is($path, "../stow/a/b/c", "path from target directory");
is($stow_path, "../stow", "stow path from target directory");
is($package, "a", "from target directory");
});
make_path("$TEST_DIR/target/stow2");
make_file("$TEST_DIR/target/stow2/.stow");
subtest("find link to alien path not owned by Stow" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../alien");
is($path, "", "alien is not stowed, so path is empty");
is($stow_path, "", "alien, so stow path is empty");
is($package, "", "alien is not stowed in any package");
});
($path, $stow_path, $package) =
$stow->find_stowed_path("$TEST_DIR/target/a/b/c","../../stow2/a/b/c");
is($path, "$TEST_DIR/target/stow2/a/b/c", "path");
is($stow_path, "$TEST_DIR/target/stow2", "stow path");
is($package, "a", "detect alternate stow directory");
# Make a second stow directory within the target directory, so that we
# can check that links to package files within that stow directory are
# detected correctly.
make_path("stow2");
# Possible corner case with rogue symlink pointing to ancestor of
# stow dir.
($path, $stow_path, $package) =
$stow->find_stowed_path("$TEST_DIR/target/a/b/c","../../..");
is($path, "", "path");
is($stow_path, "", "stow path");
is($package, "", "corner case - link points to ancestor of stow dir");
# However this second stow directory is still "alien" to stow until we
# put a .stow file in it. So first test a symlink pointing to a path
# within this second stow directory
subtest("second stow dir still alien without .stow" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../stow2/a/b/c");
is($path, "", "stow2 not a stow dir yet, so path is empty");
is($stow_path, "", "stow2 not a stow dir yet so stow path is empty");
is($package, "", "not stowed in any recognised package yet");
});
# Now make stow2 a secondary stow directory and test that
make_file("stow2/.stow");
subtest(".stow makes second stow dir owned by Stow" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../stow2/a/b/c");
is($path, "stow2/a/b/c", "path");
is($stow_path, "stow2", "stow path");
is($package, "a", "detect alternate stow directory");
});
subtest("relative symlink pointing to target dir" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../..");
# Technically the target dir is not owned by Stow, since
# Stow won't touch the target dir itself, only its contents.
is($path, "", "path");
is($stow_path, "", "stow path");
is($package, "", "corner case - link points to target dir");
});
subtest("relative symlink pointing to parent of target dir" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../../..");
is($path, "", "path");
is($stow_path, "", "stow path");
is($package, "", "corner case - link points to parent of target dir");
});
subtest("unowned symlink pointing to absolute path inside target" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "$ABS_TEST_DIR/target/d");
is($path, "", "path");
is($stow_path, "", "stow path");
is($package, "", "symlink unowned by Stow points to absolute path outside target directory");
});
subtest("unowned symlink pointing to absolute path outside target" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "/dev/null");
is($path, "", "path");
is($stow_path, "", "stow path");
is($package, "", "symlink unowned by Stow points to absolute path outside target directory");
});
# Now make stow2 the primary stow directory and test that it still
# works when the stow directory is under the target directory
$stow->set_stow_dir("$ABS_TEST_DIR/target/stow2");
subtest("stow2 becomes the primary stow directory" => sub {
plan tests => 3;
my ($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../stow2/a/b/c");
is($path, "stow2/a/b/c", "path in stow2");
is($stow_path, "stow2", "stow path for stow2");
is($package, "a", "stow2 is subdir of target directory");
});

View file

@ -22,91 +22,40 @@
use strict;
use warnings;
use Stow::Util qw(join_paths);
use Stow::Util qw(join_paths set_debug_level);
use Test::More tests => 14;
#set_debug_level(4);
is(
join_paths('a/b/c', 'd/e/f'),
'a/b/c/d/e/f'
=> 'simple'
use Test::More tests => 22;
my @TESTS = (
[['a/b/c', 'd/e/f'], 'a/b/c/d/e/f' => 'simple'],
[['a/b/c', '/d/e/f'], '/d/e/f' => 'relative then absolute'],
[['/a/b/c', 'd/e/f'], '/a/b/c/d/e/f' => 'absolute then relative'],
[['/a/b/c', '/d/e/f'], '/d/e/f' => 'two absolutes'],
[['/a/b/c/', '/d/e/f/'], '/d/e/f' => 'two absolutes with trailing /'],
[['///a/b///c//', '/d///////e/f'], '/d/e/f' => "multiple /'s, absolute"],
[['///a/b///c//', 'd///////e/f'], '/a/b/c/d/e/f' => "multiple /'s, relative"],
[['', 'a/b/c'], 'a/b/c' => 'first empty'],
[['a/b/c', ''], 'a/b/c' => 'second empty'],
[['/', 'a/b/c'], '/a/b/c' => 'first is /'],
[['a/b/c', '/'], '/' => 'second is /'],
[['../a1/b1/../c1/', 'a2/../b2/e2'], '../a1/c1/b2/e2' => 'relative with ../'],
[['../a1/b1/../c1/', '/a2/../b2/e2'], '/b2/e2' => 'absolute with ../'],
[['../a1/../../c1', 'a2/../../'], '../..' => 'lots of ../'],
[['./', '../a2'], '../a2' => 'drop any "./"'],
[['./a1', '../../a2'], '../a2' => 'drop any "./foo"'],
[['a/b/c', '.'], 'a/b/c' => '. on RHS'],
[['a/b/c', '.', 'd/e'], 'a/b/c/d/e' => '. in middle'],
[['0', 'a/b'], '0/a/b' => '0 at start'],
[['/0', 'a/b'], '/0/a/b' => '/0 at start'],
[['a/b/c', '0', 'd/e'], 'a/b/c/0/d/e' => '0 in middle'],
[['a/b', '0'], 'a/b/0' => '0 at end'],
);
is(
join_paths('/a/b/c', '/d/e/f'),
'/a/b/c/d/e/f'
=> 'leading /'
);
is(
join_paths('/a/b/c/', '/d/e/f/'),
'/a/b/c/d/e/f'
=> 'trailing /'
);
is(
join_paths('///a/b///c//', '/d///////e/f'),
'/a/b/c/d/e/f'
=> 'mltiple /\'s'
);
is(
join_paths('', 'a/b/c'),
'a/b/c'
=> 'first empty'
);
is(
join_paths('a/b/c', ''),
'a/b/c'
=> 'second empty'
);
is(
join_paths('/', 'a/b/c'),
'/a/b/c'
=> 'first is /'
);
is(
join_paths('a/b/c', '/'),
'a/b/c'
=> 'second is /'
);
is(
join_paths('///a/b///c//', '/d///////e/f'),
'/a/b/c/d/e/f'
=> 'multiple /\'s'
);
is(
join_paths('../a1/b1/../c1/', '/a2/../b2/e2'),
'../a1/c1/b2/e2'
=> 'simple deref ".."'
);
is(
join_paths('../a1/b1/../c1/d1/e1', '../a2/../b2/c2/d2/../e2'),
'../a1/c1/d1/b2/c2/e2'
=> 'complex deref ".."'
);
is(
join_paths('../a1/../../c1', 'a2/../../'),
'../..'
=> 'too many ".."'
);
is(
join_paths('./a1', '../../a2'),
'../a2'
=> 'drop any "./"'
);
is(
join_paths('a/b/c', '.'),
'a/b/c'
=> '. on RHS'
);
for my $test (@TESTS) {
my ($inputs, $expected, $scenario) = @$test;
my $got = join_paths(@$inputs);
my $descr = "$scenario: in=[" . join(', ', map "'$_'", @$inputs) . "] exp=[$expected] got=[$got]";
is($got, $expected, $descr);
}

88
t/link_dest_within_stow_dir.t Executable file
View file

@ -0,0 +1,88 @@
#!/usr/bin/perl
#
# This file is part of GNU Stow.
#
# GNU Stow is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# GNU Stow is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see https://www.gnu.org/licenses/.
#
# Testing Stow::link_dest_within_stow_dir()
#
use strict;
use warnings;
use Test::More tests => 6;
use testutil;
use Stow::Util;
init_test_dirs();
# This is a relative path, unlike $ABS_TEST_DIR below.
my $stow = new_Stow(dir => "$TEST_DIR/stow",
target => "$TEST_DIR/target");
subtest("relative stow dir, link to top-level package file" => sub {
plan tests => 2;
my ($package, $path) =
$stow->link_dest_within_stow_dir("../stow/pkg/dir/file");
is($package, "pkg", "package");
is($path, "dir/file", "path");
});
subtest("relative stow dir, link to second-level package file" => sub {
plan tests => 2;
my ($package, $path) =
$stow->link_dest_within_stow_dir("../stow/pkg/dir/subdir/file");
is($package, "pkg", "package");
is($path, "dir/subdir/file", "path");
});
# This is an absolute path, unlike $TEST_DIR above.
$stow = new_Stow(dir => "$ABS_TEST_DIR/stow",
target => "$ABS_TEST_DIR/target");
subtest("relative stow dir, link to second-level package file" => sub {
plan tests => 2;
my ($package, $path) =
$stow->link_dest_within_stow_dir("../stow/pkg/dir/file");
is($package, "pkg", "package");
is($path, "dir/file", "path");
});
subtest("absolute stow dir, link to top-level package file" => sub {
plan tests => 2;
my ($package, $path) =
$stow->link_dest_within_stow_dir("../stow/pkg/dir/subdir/file");
is($package, "pkg", "package");
is($path, "dir/subdir/file", "path");
});
# Links with destination in the target are not pointing within
# the stow dir, so they're not owned by stow.
subtest("link to path in target" => sub {
plan tests => 2;
my ($package, $path) =
$stow->link_dest_within_stow_dir("./alien");
is($path, "", "alien is in target, so path is empty");
is($package, "", "alien is in target, so package is empty");
});
subtest("link to path outside target and stow dir" => sub {
plan tests => 2;
my ($package, $path) =
$stow->link_dest_within_stow_dir("../alien");
is($path, "", "alien is outside, so path is empty");
is($package, "", "alien is outside, so package is empty");
});

915
t/stow.t
View file

@ -22,7 +22,7 @@
use strict;
use warnings;
use Test::More tests => 118;
use Test::More tests => 22;
use Test::Output;
use English qw(-no_match_vars);
@ -37,520 +37,535 @@ my %conflicts;
# Note that each of the following tests use a distinct set of files
#
# stow a simple tree minimally
#
$stow = new_Stow(dir => '../stow');
subtest('stow a simple tree minimally', sub {
plan tests => 2;
my $stow = new_Stow(dir => '../stow');
make_path('../stow/pkg1/bin1');
make_file('../stow/pkg1/bin1/file1');
make_path('../stow/pkg1/bin1');
make_file('../stow/pkg1/bin1/file1');
$stow->plan_stow('pkg1');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink('bin1'),
'../stow/pkg1/bin1',
=> 'minimal stow of a simple tree'
);
#
# stow a simple tree into an existing directory
#
$stow = new_Stow();
make_path('../stow/pkg2/lib2');
make_file('../stow/pkg2/lib2/file2');
make_path('lib2');
$stow->plan_stow('pkg2');
$stow->process_tasks();
is(
readlink('lib2/file2'),
'../../stow/pkg2/lib2/file2',
=> 'stow simple tree to existing directory'
);
#
# unfold existing tree
#
$stow = new_Stow();
make_path('../stow/pkg3a/bin3');
make_file('../stow/pkg3a/bin3/file3a');
make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
make_path('../stow/pkg3b/bin3');
make_file('../stow/pkg3b/bin3/file3b');
$stow->plan_stow('pkg3b');
$stow->process_tasks();
ok(
-d 'bin3' &&
readlink('bin3/file3a') eq '../../stow/pkg3a/bin3/file3a' &&
readlink('bin3/file3b') eq '../../stow/pkg3b/bin3/file3b'
=> 'target already has 1 stowed package'
);
#
# Link to a new dir 'bin4' conflicts with existing non-dir so can't
# unfold
#
$stow = new_Stow();
make_file('bin4'); # this is a file but named like a directory
make_path('../stow/pkg4/bin4');
make_file('../stow/pkg4/bin4/file4');
$stow->plan_stow('pkg4');
%conflicts = $stow->get_conflicts();
ok(
$stow->get_conflict_count == 1 &&
$conflicts{stow}{pkg4}[0] =~
qr/existing target is neither a link nor a directory/
=> 'link to new dir bin4 conflicts with existing non-directory'
);
#
# Link to a new dir 'bin4a' conflicts with existing non-dir so can't
# unfold even with --adopt
#
#$stow = new_Stow(adopt => 1);
$stow = new_Stow();
make_file('bin4a'); # this is a file but named like a directory
make_path('../stow/pkg4a/bin4a');
make_file('../stow/pkg4a/bin4a/file4a');
$stow->plan_stow('pkg4a');
%conflicts = $stow->get_conflicts();
ok(
$stow->get_conflict_count == 1 &&
$conflicts{stow}{pkg4a}[0] =~
qr/existing target is neither a link nor a directory/
=> 'link to new dir bin4a conflicts with existing non-directory'
);
#
# Link to files 'file4b' and 'bin4b' conflict with existing files
# without --adopt
#
$stow = new_Stow();
# Populate target
make_file('file4b', 'file4b - version originally in target');
make_path ('bin4b');
make_file('bin4b/file4b', 'bin4b/file4b - version originally in target');
# Populate
make_path ('../stow/pkg4b/bin4b');
make_file('../stow/pkg4b/file4b', 'file4b - version originally in stow package');
make_file('../stow/pkg4b/bin4b/file4b', 'bin4b/file4b - version originally in stow package');
$stow->plan_stow('pkg4b');
%conflicts = $stow->get_conflicts();
is($stow->get_conflict_count, 2 => 'conflict per file');
for my $i (0, 1) {
like(
$conflicts{stow}{pkg4b}[$i],
qr/existing target is neither a link nor a directory/
=> 'link to file4b conflicts with existing non-directory'
);
}
#
# Link to files 'file4b' and 'bin4b' do not conflict with existing
# files when --adopt is given
#
$stow = new_Stow(adopt => 1);
# Populate target
make_file('file4c', "file4c - version originally in target\n");
make_path ('bin4c');
make_file('bin4c/file4c', "bin4c/file4c - version originally in target\n");
# Populate
make_path ('../stow/pkg4c/bin4c');
make_file('../stow/pkg4c/file4c', "file4c - version originally in stow package\n");
make_file('../stow/pkg4c/bin4c/file4c', "bin4c/file4c - version originally in stow package\n");
$stow->plan_stow('pkg4c');
is($stow->get_conflict_count, 0 => 'no conflicts with --adopt');
is($stow->get_tasks, 4 => 'two tasks per file');
$stow->process_tasks();
for my $file ('file4c', 'bin4c/file4c') {
ok(-l $file, "$file turned into a symlink");
$stow->plan_stow('pkg1');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink $file,
(index($file, '/') == -1 ? '' : '../' )
. "../stow/pkg4c/$file" => "$file points to right place"
readlink('bin1'),
'../stow/pkg1/bin1',
=> 'minimal stow of a simple tree'
);
is(cat_file($file), "$file - version originally in target\n" => "$file has right contents");
}
});
subtest('stow a simple tree into an existing directory', sub {
plan tests => 1;
my $stow = new_Stow();
#
# Target already exists but is not owned by stow
#
$stow = new_Stow();
make_path('../stow/pkg2/lib2');
make_file('../stow/pkg2/lib2/file2');
make_path('lib2');
make_path('bin5');
make_invalid_link('bin5/file5','../../empty');
make_path('../stow/pkg5/bin5/file5');
$stow->plan_stow('pkg2');
$stow->process_tasks();
is(
readlink('lib2/file2'),
'../../stow/pkg2/lib2/file2',
=> 'stow simple tree to existing directory'
);
});
$stow->plan_stow('pkg5');
%conflicts = $stow->get_conflicts();
like(
$conflicts{stow}{pkg5}[-1],
qr/not owned by stow/
=> 'target already exists but is not owned by stow'
);
subtest('unfold existing tree', sub {
plan tests => 3;
my $stow = new_Stow();
#
# Replace existing but invalid target
#
$stow = new_Stow();
make_path('../stow/pkg3a/bin3');
make_file('../stow/pkg3a/bin3/file3a');
make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
make_invalid_link('file6','../stow/path-does-not-exist');
make_path('../stow/pkg6');
make_file('../stow/pkg6/file6');
make_path('../stow/pkg3b/bin3');
make_file('../stow/pkg3b/bin3/file3b');
$stow->plan_stow('pkg6');
$stow->process_tasks();
is(
readlink('file6'),
'../stow/pkg6/file6'
=> 'replace existing but invalid target'
);
$stow->plan_stow('pkg3b');
$stow->process_tasks();
ok(-d 'bin3');
is(readlink('bin3/file3a'), '../../stow/pkg3a/bin3/file3a');
is(readlink('bin3/file3b'), '../../stow/pkg3b/bin3/file3b'
=> 'target already has 1 stowed package');
});
#
# Target already exists, is owned by stow, but points to a non-directory
# (can't unfold)
#
$stow = new_Stow();
#set_debug_level(4);
subtest("Package dir 'bin4' conflicts with existing non-dir so can't unfold", sub {
plan tests => 2;
my $stow = new_Stow();
make_path('bin7');
make_path('../stow/pkg7a/bin7');
make_file('../stow/pkg7a/bin7/node7');
make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
make_path('../stow/pkg7b/bin7/node7');
make_file('../stow/pkg7b/bin7/node7/file7');
make_file('bin4'); # this is a file but named like a directory
make_path('../stow/pkg4/bin4');
make_file('../stow/pkg4/bin4/file4');
$stow->plan_stow('pkg7b');
%conflicts = $stow->get_conflicts();
like(
$conflicts{stow}{pkg7b}[-1],
qr/existing target is stowed to a different package/
=> 'link to new dir conflicts with existing stowed non-directory'
);
$stow->plan_stow('pkg4');
%conflicts = $stow->get_conflicts();
is($stow->get_conflict_count, 1);
like(
$conflicts{stow}{pkg4}[0],
qr!cannot stow ../stow/pkg4/bin4 over existing target bin4 since neither a link nor a directory and --adopt not specified!
=> 'link to new dir bin4 conflicts with existing non-directory'
);
});
#
# stowing directories named 0
#
$stow = new_Stow();
subtest("Package dir 'bin4a' conflicts with existing non-dir " .
"so can't unfold even with --adopt", sub {
plan tests => 2;
my $stow = new_Stow(adopt => 1);
make_path('../stow/pkg8a/0');
make_file('../stow/pkg8a/0/file8a');
make_link('0' => '../stow/pkg8a/0'); # emulate stow
make_file('bin4a'); # this is a file but named like a directory
make_path('../stow/pkg4a/bin4a');
make_file('../stow/pkg4a/bin4a/file4a');
make_path('../stow/pkg8b/0');
make_file('../stow/pkg8b/0/file8b');
$stow->plan_stow('pkg4a');
%conflicts = $stow->get_conflicts();
is($stow->get_conflict_count, 1);
like(
$conflicts{stow}{pkg4a}[0],
qr!cannot stow directory ../stow/pkg4a/bin4a over existing non-directory target bin4a!
=> 'link to new dir bin4a conflicts with existing non-directory'
);
});
$stow->plan_stow('pkg8b');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-d '0' &&
readlink('0/file8a') eq '../../stow/pkg8a/0/file8a' &&
readlink('0/file8b') eq '../../stow/pkg8b/0/file8b'
=> 'stowing directories named 0'
);
subtest("Package files 'file4b' and 'bin4b' conflict with existing files", sub {
plan tests => 3;
my $stow = new_Stow();
#
# overriding already stowed documentation
#
$stow = new_Stow(override => ['man9', 'info9']);
# Populate target
make_file('file4b', 'file4b - version originally in target');
make_path('bin4b');
make_file('bin4b/file4b', 'bin4b/file4b - version originally in target');
make_path('../stow/pkg9a/man9/man1');
make_file('../stow/pkg9a/man9/man1/file9.1');
make_path('man9/man1');
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
# Populate stow package
make_path('../stow/pkg4b');
make_file('../stow/pkg4b/file4b', 'file4b - version originally in stow package');
make_path('../stow/pkg4b/bin4b');
make_file('../stow/pkg4b/bin4b/file4b', 'bin4b/file4b - version originally in stow package');
make_path('../stow/pkg9b/man9/man1');
make_file('../stow/pkg9b/man9/man1/file9.1');
$stow->plan_stow('pkg4b');
%conflicts = $stow->get_conflicts();
is($stow->get_conflict_count, 2 => 'conflict per file');
for my $i (0, 1) {
my $target = $i ? 'file4b' : 'bin4b/file4b';
like(
$conflicts{stow}{pkg4b}[$i],
qr,cannot stow ../stow/pkg4b/$target over existing target $target since neither a link nor a directory and --adopt not specified,
=> 'link to file4b conflicts with existing non-directory'
);
}
});
$stow->plan_stow('pkg9b');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
readlink('man9/man1/file9.1') eq '../../../stow/pkg9b/man9/man1/file9.1'
=> 'overriding existing documentation files'
);
subtest("Package files 'file4d' conflicts with existing directories", sub {
plan tests => 3;
my $stow = new_Stow();
#
# deferring to already stowed documentation
#
$stow = new_Stow(defer => ['man10', 'info10']);
# Populate target
make_path('file4d'); # this is a directory but named like a file to create the conflict
make_path('bin4d/file4d'); # same here
make_path('../stow/pkg10a/man10/man1');
make_file('../stow/pkg10a/man10/man1/file10.1');
make_path('man10/man1');
make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1'); # emulate stow
# Populate stow package
make_path('../stow/pkg4d');
make_file('../stow/pkg4d/file4d', 'file4d - version originally in stow package');
make_path('../stow/pkg4d/bin4d');
make_file('../stow/pkg4d/bin4d/file4d', 'bin4d/file4d - version originally in stow package');
make_path('../stow/pkg10b/man10/man1');
make_file('../stow/pkg10b/man10/man1/file10.1');
$stow->plan_stow('pkg4d');
%conflicts = $stow->get_conflicts();
is($stow->get_conflict_count, 2 => 'conflict per file');
for my $i (0, 1) {
my $target = $i ? 'file4d' : 'bin4d/file4d';
like(
$conflicts{stow}{pkg4d}[$i],
qr!cannot stow non-directory ../stow/pkg4d/$target over existing directory target $target!
=> 'link to file4d conflicts with existing non-directory'
);
}
});
$stow->plan_stow('pkg10b');
is($stow->get_tasks, 0, 'no tasks to process');
ok(
$stow->get_conflict_count == 0 &&
readlink('man10/man1/file10.1') eq '../../../stow/pkg10a/man10/man1/file10.1'
=> 'defer to existing documentation files'
);
subtest("Package files 'file4c' and 'bin4c' can adopt existing versions", sub {
plan tests => 8;
my $stow = new_Stow(adopt => 1);
#
# Ignore temp files
#
$stow = new_Stow(ignore => ['~', '\.#.*']);
# Populate target
make_file('file4c', "file4c - version originally in target\n");
make_path ('bin4c');
make_file('bin4c/file4c', "bin4c/file4c - version originally in target\n");
make_path('../stow/pkg11/man11/man1');
make_file('../stow/pkg11/man11/man1/file11.1');
make_file('../stow/pkg11/man11/man1/file11.1~');
make_file('../stow/pkg11/man11/man1/.#file11.1');
make_path('man11/man1');
# Populate stow package
make_path('../stow/pkg4c');
make_file('../stow/pkg4c/file4c', "file4c - version originally in stow package\n");
make_path ('../stow/pkg4c/bin4c');
make_file('../stow/pkg4c/bin4c/file4c', "bin4c/file4c - version originally in stow package\n");
$stow->plan_stow('pkg11');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
readlink('man11/man1/file11.1') eq '../../../stow/pkg11/man11/man1/file11.1' &&
!-e 'man11/man1/file11.1~' &&
!-e 'man11/man1/.#file11.1'
=> 'ignore temp files'
);
$stow->plan_stow('pkg4c');
is($stow->get_conflict_count, 0 => 'no conflicts with --adopt');
is($stow->get_tasks, 4 => 'two tasks per file');
$stow->process_tasks();
for my $file ('file4c', 'bin4c/file4c') {
ok(-l $file, "$file turned into a symlink");
is(
readlink $file,
(index($file, '/') == -1 ? '' : '../' )
. "../stow/pkg4c/$file" => "$file points to right place"
);
is(cat_file($file), "$file - version originally in target\n" => "$file has right contents");
}
#
# stowing links library files
#
$stow = new_Stow();
});
make_path('../stow/pkg12/lib12/');
make_file('../stow/pkg12/lib12/lib.so.1');
make_link('../stow/pkg12/lib12/lib.so', 'lib.so.1');
subtest("Target already exists but is not owned by stow", sub {
plan tests => 1;
my $stow = new_Stow();
make_path('lib12/');
make_path('bin5');
make_invalid_link('bin5/file5','../../empty');
make_path('../stow/pkg5/bin5/file5');
$stow->plan_stow('pkg12');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
readlink('lib12/lib.so.1') eq '../../stow/pkg12/lib12/lib.so.1' &&
readlink('lib12/lib.so' ) eq '../../stow/pkg12/lib12/lib.so'
=> 'stow links to libraries'
);
$stow->plan_stow('pkg5');
%conflicts = $stow->get_conflicts();
like(
$conflicts{stow}{pkg5}[-1],
qr/not owned by stow/
=> 'target already exists but is not owned by stow'
);
});
#
# unfolding to stow links to library files
#
$stow = new_Stow();
subtest("Replace existing but invalid target", sub {
plan tests => 1;
my $stow = new_Stow();
make_path('../stow/pkg13a/lib13/');
make_file('../stow/pkg13a/lib13/liba.so.1');
make_link('../stow/pkg13a/lib13/liba.so', 'liba.so.1');
make_link('lib13','../stow/pkg13a/lib13');
make_invalid_link('file6','../stow/path-does-not-exist');
make_path('../stow/pkg6');
make_file('../stow/pkg6/file6');
make_path('../stow/pkg13b/lib13/');
make_file('../stow/pkg13b/lib13/libb.so.1');
make_link('../stow/pkg13b/lib13/libb.so', 'libb.so.1');
$stow->plan_stow('pkg6');
$stow->process_tasks();
is(
readlink('file6'),
'../stow/pkg6/file6'
=> 'replace existing but invalid target'
);
});
$stow->plan_stow('pkg13b');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
readlink('lib13/liba.so.1') eq '../../stow/pkg13a/lib13/liba.so.1' &&
readlink('lib13/liba.so' ) eq '../../stow/pkg13a/lib13/liba.so' &&
readlink('lib13/libb.so.1') eq '../../stow/pkg13b/lib13/libb.so.1' &&
readlink('lib13/libb.so' ) eq '../../stow/pkg13b/lib13/libb.so'
=> 'unfolding to stow links to libraries'
);
subtest("Target already exists, is owned by stow, but points to a non-directory", sub {
plan tests => 1;
my $stow = new_Stow();
#set_debug_level(4);
#
# stowing to stow dir should fail
#
make_path('stow');
$stow = new_Stow(dir => 'stow');
make_path('bin7');
make_path('../stow/pkg7a/bin7');
make_file('../stow/pkg7a/bin7/node7');
make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
make_path('../stow/pkg7b/bin7/node7');
make_file('../stow/pkg7b/bin7/node7/file7');
make_path('stow/pkg14/stow/pkg15');
make_file('stow/pkg14/stow/pkg15/node15');
$stow->plan_stow('pkg7b');
%conflicts = $stow->get_conflicts();
like(
$conflicts{stow}{pkg7b}[-1],
qr/existing target is stowed to a different package/
=> 'link to new dir conflicts with existing stowed non-directory'
);
});
capture_stderr();
$stow->plan_stow('pkg14');
is($stow->get_tasks, 0, 'no tasks to process');
ok(
$stow->get_conflict_count == 0 &&
! -l 'stow/pkg15'
=> "stowing to stow dir should fail"
);
like($stderr,
qr/WARNING: skipping target which was current stow directory stow/
=> "stowing to stow dir should give warning");
uncapture_stderr();
subtest("stowing directories named 0", sub {
plan tests => 4;
my $stow = new_Stow();
#
# stow a simple tree minimally when cwd isn't target
#
cd('../..');
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
make_path('../stow/pkg8a/0');
make_file('../stow/pkg8a/0/file8a');
make_link('0' => '../stow/pkg8a/0'); # emulate stow
make_path("$TEST_DIR/stow/pkg16/bin16");
make_file("$TEST_DIR/stow/pkg16/bin16/file16");
make_path('../stow/pkg8b/0');
make_file('../stow/pkg8b/0/file8b');
$stow->plan_stow('pkg16');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink("$TEST_DIR/target/bin16"),
'../stow/pkg16/bin16',
=> "minimal stow of a simple tree when cwd isn't target"
);
$stow->plan_stow('pkg8b');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
ok(-d '0');
is(readlink('0/file8a'), '../../stow/pkg8a/0/file8a');
is(readlink('0/file8b'), '../../stow/pkg8b/0/file8b'
=> 'stowing directories named 0'
);
});
#
# stow a simple tree minimally to absolute stow dir when cwd isn't
# target
#
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => "$TEST_DIR/target");
subtest("overriding already stowed documentation", sub {
plan tests => 2;
my $stow = new_Stow(override => ['man9', 'info9']);
make_path("$TEST_DIR/stow/pkg17/bin17");
make_file("$TEST_DIR/stow/pkg17/bin17/file17");
make_path('../stow/pkg9a/man9/man1');
make_file('../stow/pkg9a/man9/man1/file9.1');
make_path('man9/man1');
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
$stow->plan_stow('pkg17');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink("$TEST_DIR/target/bin17"),
'../stow/pkg17/bin17',
=> "minimal stow of a simple tree with absolute stow dir"
);
make_path('../stow/pkg9b/man9/man1');
make_file('../stow/pkg9b/man9/man1/file9.1');
#
# stow a simple tree minimally with absolute stow AND target dirs when
# cwd isn't target
#
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => canon_path("$TEST_DIR/target"));
$stow->plan_stow('pkg9b');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
is(readlink('man9/man1/file9.1'), '../../../stow/pkg9b/man9/man1/file9.1'
=> 'overriding existing documentation files'
);
});
make_path("$TEST_DIR/stow/pkg18/bin18");
make_file("$TEST_DIR/stow/pkg18/bin18/file18");
subtest("deferring to already stowed documentation", sub {
plan tests => 3;
my $stow = new_Stow(defer => ['man10', 'info10']);
$stow->plan_stow('pkg18');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink("$TEST_DIR/target/bin18"),
'../stow/pkg18/bin18',
=> "minimal stow of a simple tree with absolute stow and target dirs"
);
make_path('../stow/pkg10a/man10/man1');
make_file('../stow/pkg10a/man10/man1/file10.1');
make_path('man10/man1');
make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1'); # emulate stow
#
# stow a tree with no-folding enabled -
# no new folded directories should be created, and existing
# folded directories should be split open (unfolded) where
# (and only where) necessary
#
cd("$TEST_DIR/target");
make_path('../stow/pkg10b/man10/man1');
make_file('../stow/pkg10b/man10/man1/file10.1');
sub create_pkg {
my ($id, $pkg) = @_;
$stow->plan_stow('pkg10b');
is($stow->get_tasks, 0, 'no tasks to process');
is($stow->get_conflict_count, 0);
is(readlink('man10/man1/file10.1'), '../../../stow/pkg10a/man10/man1/file10.1'
=> 'defer to existing documentation files'
);
});
my $stow_pkg = "../stow/$id-$pkg";
make_path ($stow_pkg);
make_file("$stow_pkg/$id-file-$pkg");
subtest("Ignore temp files", sub {
plan tests => 4;
my $stow = new_Stow(ignore => ['~', '\.#.*']);
# create a shallow hierarchy specific to this package which isn't
# yet stowed
make_path ("$stow_pkg/$id-$pkg-only-new");
make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
make_path('../stow/pkg11/man11/man1');
make_file('../stow/pkg11/man11/man1/file11.1');
make_file('../stow/pkg11/man11/man1/file11.1~');
make_file('../stow/pkg11/man11/man1/.#file11.1');
make_path('man11/man1');
# create a deeper hierarchy specific to this package which isn't
# yet stowed
make_path ("$stow_pkg/$id-$pkg-only-new2/subdir");
make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg");
make_link("$stow_pkg/$id-$pkg-only-new2/current", "subdir");
$stow->plan_stow('pkg11');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
is(readlink('man11/man1/file11.1'), '../../../stow/pkg11/man11/man1/file11.1');
ok(!-e 'man11/man1/file11.1~');
ok(!-e 'man11/man1/.#file11.1'
=> 'ignore temp files'
);
});
# create a hierarchy specific to this package which is already
# stowed via a folded tree
make_path ("$stow_pkg/$id-$pkg-only-old");
make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
subtest("stowing links library files", sub {
plan tests => 3;
my $stow = new_Stow();
# create a shared hierarchy which this package uses
make_path ("$stow_pkg/$id-shared");
make_file("$stow_pkg/$id-shared/$id-file-$pkg");
make_path('../stow/pkg12/lib12/');
make_file('../stow/pkg12/lib12/lib.so.1');
make_link('../stow/pkg12/lib12/lib.so', 'lib.so.1');
# create a partially shared hierarchy which this package uses
make_path ("$stow_pkg/$id-shared2/subdir-$pkg");
make_file("$stow_pkg/$id-shared2/$id-file-$pkg");
make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
}
make_path('lib12/');
foreach my $pkg (qw{a b}) {
create_pkg('no-folding', $pkg);
}
$stow->plan_stow('pkg12');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
is(readlink('lib12/lib.so.1'), '../../stow/pkg12/lib12/lib.so.1');
is(readlink('lib12/lib.so'), '../../stow/pkg12/lib12/lib.so'
=> 'stow links to libraries'
);
});
$stow = new_Stow('no-folding' => 1);
$stow->plan_stow('no-folding-a');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
my @tasks = $stow->get_tasks;
use Data::Dumper;
is(scalar(@tasks), 13 => "6 dirs, 7 links") || warn Dumper(\@tasks);
$stow->process_tasks();
subtest("unfolding to stow links to library files", sub {
plan tests => 5;
my $stow = new_Stow();
sub check_no_folding {
my ($pkg) = @_;
my $stow_pkg = "../stow/no-folding-$pkg";
is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
make_path('../stow/pkg13a/lib13/');
make_file('../stow/pkg13a/lib13/liba.so.1');
make_link('../stow/pkg13a/lib13/liba.so', 'liba.so.1');
make_link('lib13','../stow/pkg13a/lib13');
# check existing folded tree is untouched
is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old");
make_path('../stow/pkg13b/lib13/');
make_file('../stow/pkg13b/lib13/libb.so.1');
make_link('../stow/pkg13b/lib13/libb.so', 'libb.so.1');
# check newly stowed shallow tree is not folded
is_dir_not_symlink("no-folding-$pkg-only-new");
is_link("no-folding-$pkg-only-new/no-folding-file-$pkg",
"../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg");
$stow->plan_stow('pkg13b');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
is(readlink('lib13/liba.so.1'), '../../stow/pkg13a/lib13/liba.so.1');
is(readlink('lib13/liba.so' ), '../../stow/pkg13a/lib13/liba.so');
is(readlink('lib13/libb.so.1'), '../../stow/pkg13b/lib13/libb.so.1');
is(readlink('lib13/libb.so' ), '../../stow/pkg13b/lib13/libb.so'
=> 'unfolding to stow links to libraries'
);
});
# check newly stowed deeper tree is not folded
is_dir_not_symlink("no-folding-$pkg-only-new2");
is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
"../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
is_link("no-folding-$pkg-only-new2/current",
"../$stow_pkg/no-folding-$pkg-only-new2/current");
subtest("stowing to stow dir should fail", sub {
plan tests => 4;
make_path('stow');
$stow = new_Stow(dir => 'stow');
# check shared tree is not folded. first time round this will be
# newly stowed.
is_dir_not_symlink('no-folding-shared');
is_link("no-folding-shared/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared/no-folding-file-$pkg");
make_path('stow/pkg14/stow/pkg15');
make_file('stow/pkg14/stow/pkg15/node15');
# check partially shared tree is not folded. first time round this
# will be newly stowed.
is_dir_not_symlink('no-folding-shared2');
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
}
stderr_like(
sub { $stow->plan_stow('pkg14'); },
qr/WARNING: skipping target which was current stow directory stow/,
"stowing to stow dir should give warning"
);
check_no_folding('a');
is($stow->get_tasks, 0, 'no tasks to process');
is($stow->get_conflict_count, 0);
ok(
! -l 'stow/pkg15'
=> "stowing to stow dir should fail"
);
});
$stow = new_Stow('no-folding' => 1);
$stow->plan_stow('no-folding-b');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
@tasks = $stow->get_tasks;
is(scalar(@tasks), 11 => '4 dirs, 7 links') || warn Dumper(\@tasks);
$stow->process_tasks();
subtest("stow a simple tree minimally when cwd isn't target", sub {
plan tests => 2;
cd('../..');
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
check_no_folding('a');
check_no_folding('b');
make_path("$TEST_DIR/stow/pkg16/bin16");
make_file("$TEST_DIR/stow/pkg16/bin16/file16");
$stow->plan_stow('pkg16');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink("$TEST_DIR/target/bin16"),
'../stow/pkg16/bin16',
=> "minimal stow of a simple tree when cwd isn't target"
);
});
subtest("stow a simple tree minimally to absolute stow dir when cwd isn't", sub {
plan tests => 2;
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => "$TEST_DIR/target");
make_path("$TEST_DIR/stow/pkg17/bin17");
make_file("$TEST_DIR/stow/pkg17/bin17/file17");
$stow->plan_stow('pkg17');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink("$TEST_DIR/target/bin17"),
'../stow/pkg17/bin17',
=> "minimal stow of a simple tree with absolute stow dir"
);
});
subtest("stow a simple tree minimally with absolute stow AND target dirs when", sub {
plan tests => 2;
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => canon_path("$TEST_DIR/target"));
make_path("$TEST_DIR/stow/pkg18/bin18");
make_file("$TEST_DIR/stow/pkg18/bin18/file18");
$stow->plan_stow('pkg18');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink("$TEST_DIR/target/bin18"),
'../stow/pkg18/bin18',
=> "minimal stow of a simple tree with absolute stow and target dirs"
);
});
subtest("stow a tree with no-folding enabled", sub {
plan tests => 82;
# folded directories should be split open (unfolded) where
# (and only where) necessary
#
cd("$TEST_DIR/target");
sub create_pkg {
my ($id, $pkg) = @_;
my $stow_pkg = "../stow/$id-$pkg";
make_path ($stow_pkg);
make_file("$stow_pkg/$id-file-$pkg");
# create a shallow hierarchy specific to this package which isn't
# yet stowed
make_path ("$stow_pkg/$id-$pkg-only-new");
make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
# create a deeper hierarchy specific to this package which isn't
# yet stowed
make_path ("$stow_pkg/$id-$pkg-only-new2/subdir");
make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg");
make_link("$stow_pkg/$id-$pkg-only-new2/current", "subdir");
# create a hierarchy specific to this package which is already
# stowed via a folded tree
make_path ("$stow_pkg/$id-$pkg-only-old");
make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
# create a shared hierarchy which this package uses
make_path ("$stow_pkg/$id-shared");
make_file("$stow_pkg/$id-shared/$id-file-$pkg");
# create a partially shared hierarchy which this package uses
make_path ("$stow_pkg/$id-shared2/subdir-$pkg");
make_file("$stow_pkg/$id-shared2/$id-file-$pkg");
make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
}
foreach my $pkg (qw{a b}) {
create_pkg('no-folding', $pkg);
}
$stow = new_Stow('no-folding' => 1);
$stow->plan_stow('no-folding-a');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
my @tasks = $stow->get_tasks;
use Data::Dumper;
is(scalar(@tasks), 13 => "6 dirs, 7 links") || warn Dumper(\@tasks);
$stow->process_tasks();
sub check_no_folding {
my ($pkg) = @_;
my $stow_pkg = "../stow/no-folding-$pkg";
is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
# check existing folded tree is untouched
is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old");
# check newly stowed shallow tree is not folded
is_dir_not_symlink("no-folding-$pkg-only-new");
is_link("no-folding-$pkg-only-new/no-folding-file-$pkg",
"../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg");
# check newly stowed deeper tree is not folded
is_dir_not_symlink("no-folding-$pkg-only-new2");
is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
"../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
is_link("no-folding-$pkg-only-new2/current",
"../$stow_pkg/no-folding-$pkg-only-new2/current");
# check shared tree is not folded. first time round this will be
# newly stowed.
is_dir_not_symlink('no-folding-shared');
is_link("no-folding-shared/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared/no-folding-file-$pkg");
# check partially shared tree is not folded. first time round this
# will be newly stowed.
is_dir_not_symlink('no-folding-shared2');
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
}
check_no_folding('a');
$stow = new_Stow('no-folding' => 1);
$stow->plan_stow('no-folding-b');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
@tasks = $stow->get_tasks;
is(scalar(@tasks), 11 => '4 dirs, 7 links') || warn Dumper(\@tasks);
$stow->process_tasks();
check_no_folding('a');
check_no_folding('b');
});

View file

@ -24,11 +24,10 @@ package testutil;
use strict;
use warnings;
use Carp qw(croak);
use Carp qw(confess croak);
use File::Basename;
use File::Path qw(make_path remove_tree);
use File::Spec;
use IO::Scalar;
use Test::More;
use Stow;
@ -38,7 +37,6 @@ use base qw(Exporter);
our @EXPORT = qw(
$ABS_TEST_DIR
$TEST_DIR
$stderr
init_test_dirs
cd
new_Stow new_compat_Stow
@ -46,45 +44,41 @@ our @EXPORT = qw(
remove_dir remove_file remove_link
cat_file
is_link is_dir_not_symlink is_nonexistent_path
capture_stderr uncapture_stderr
);
our $TEST_DIR = 'tmp-testing-trees';
our $ABS_TEST_DIR = File::Spec->rel2abs('tmp-testing-trees');
our $stderr;
my $tied_err;
sub capture_stderr {
undef $stderr;
$tied_err = tie *STDERR, 'IO::Scalar', \$stderr;
}
sub uncapture_stderr {
undef $tied_err;
untie *STDERR;
}
sub init_test_dirs {
my $test_dir = shift || $TEST_DIR;
my $abs_test_dir = File::Spec->rel2abs($test_dir);
# Create a run_from/ subdirectory for tests which want to run
# from a separate directory outside the Stow directory or
# target directory.
for my $dir ("target", "stow", "run_from") {
my $path = "$TEST_DIR/$dir";
my $path = "$test_dir/$dir";
-d $path and remove_tree($path);
make_path($path);
}
# Don't let user's ~/.stow-global-ignore affect test results
$ENV{HOME} = $ABS_TEST_DIR;
$ENV{HOME} = $abs_test_dir;
return $abs_test_dir;
}
sub new_Stow {
my %opts = @_;
# These default paths assume that execution will be triggered from
# within the target directory.
$opts{dir} ||= '../stow';
$opts{target} ||= '.';
$opts{test_mode} = 1;
return new Stow(%opts);
my $stow = eval { new Stow(%opts) };
if ($@) {
confess "Error while trying to instantiate new Stow(%opts): $@";
}
return $stow;
}
sub new_compat_Stow {
@ -96,28 +90,28 @@ sub new_compat_Stow {
#===== SUBROUTINE ===========================================================
# Name : make_link()
# Purpose : safely create a link
# Parameters: $target => path to the link
# : $source => where the new link should point
# : $invalid => true iff $source refers to non-existent file
# Parameters: $link_src => path to the link
# : $link_dest => where the new link should point
# : $invalid => true iff $link_dest refers to non-existent file
# Returns : n/a
# Throws : fatal error if the link can not be safely created
# Comments : checks for existing nodes
#============================================================================
sub make_link {
my ($target, $source, $invalid) = @_;
my ($link_src, $link_dest, $invalid) = @_;
if (-l $target) {
my $old_source = readlink join('/', parent($target), $source)
or die "$target is already a link but could not read link $target/$source";
if ($old_source ne $source) {
die "$target already exists but points elsewhere\n";
if (-l $link_src) {
my $old_source = readlink join('/', parent($link_src), $link_dest)
or croak "$link_src is already a link but could not read link $link_src/$link_dest";
if ($old_source ne $link_dest) {
croak "$link_src already exists but points elsewhere\n";
}
}
die "$target already exists and is not a link\n" if -e $target;
my $abs_target = File::Spec->rel2abs($target);
my $target_container = dirname($abs_target);
my $abs_source = File::Spec->rel2abs($source, $target_container);
#warn "t $target c $target_container as $abs_source";
croak "$link_src already exists and is not a link\n" if -e $link_src;
my $abs_target = File::Spec->rel2abs($link_src);
my $link_src_container = dirname($abs_target);
my $abs_source = File::Spec->rel2abs($link_dest, $link_src_container);
#warn "t $link_src c $link_src_container as $abs_source";
if (-e $abs_source) {
croak "Won't make invalid link pointing to existing $abs_target"
if $invalid;
@ -126,8 +120,8 @@ sub make_link {
croak "Won't make link pointing to non-existent $abs_target"
unless $invalid;
}
symlink $source, $target
or die "could not create link $target => $source ($!)\n";
symlink $link_dest, $link_src
or croak "could not create link $link_src => $link_dest ($!)\n";
}
#===== SUBROUTINE ===========================================================
@ -157,11 +151,11 @@ sub make_file {
my ($path, $contents) = @_;
if (-e $path and ! -f $path) {
die "a non-file already exists at $path\n";
croak "a non-file already exists at $path\n";
}
open my $FILE ,'>', $path
or die "could not create file: $path ($!)\n";
or croak "could not create file: $path ($!)\n";
print $FILE $contents if defined $contents;
close $FILE;
}
@ -178,9 +172,9 @@ sub make_file {
sub remove_link {
my ($path) = @_;
if (not -l $path) {
die qq(remove_link() called with a non-link: $path);
croak qq(remove_link() called with a non-link: $path);
}
unlink $path or die "could not remove link: $path ($!)\n";
unlink $path or croak "could not remove link: $path ($!)\n";
return;
}
@ -195,9 +189,9 @@ sub remove_link {
sub remove_file {
my ($path) = @_;
if (-z $path) {
die "file at $path is non-empty\n";
croak "file at $path is non-empty\n";
}
unlink $path or die "could not remove empty file: $path ($!)\n";
unlink $path or croak "could not remove empty file: $path ($!)\n";
return;
}
@ -213,10 +207,10 @@ sub remove_dir {
my ($dir) = @_;
if (not -d $dir) {
die "$dir is not a directory";
croak "$dir is not a directory";
}
opendir my $DIR, $dir or die "cannot read directory: $dir ($!)\n";
opendir my $DIR, $dir or croak "cannot read directory: $dir ($!)\n";
my @listing = readdir $DIR;
closedir $DIR;
@ -227,16 +221,16 @@ sub remove_dir {
my $path = "$dir/$node";
if (-l $path or (-f $path and -z $path) or $node eq $Stow::LOCAL_IGNORE_FILE) {
unlink $path or die "cannot unlink $path ($!)\n";
unlink $path or croak "cannot unlink $path ($!)\n";
}
elsif (-d "$path") {
remove_dir($path);
}
else {
die "$path is not a link, directory, or empty file\n";
croak "$path is not a link, directory, or empty file\n";
}
}
rmdir $dir or die "cannot rmdir $dir ($!)\n";
rmdir $dir or croak "cannot rmdir $dir ($!)\n";
return;
}
@ -251,7 +245,7 @@ sub remove_dir {
#============================================================================
sub cd {
my ($dir) = @_;
chdir $dir or die "Failed to chdir($dir): $!\n";
chdir $dir or croak "Failed to chdir($dir): $!\n";
}
#===== SUBROUTINE ===========================================================
@ -264,7 +258,7 @@ sub cd {
#============================================================================
sub cat_file {
my ($file) = @_;
open F, $file or die "Failed to open($file): $!\n";
open F, $file or croak "Failed to open($file): $!\n";
my $contents = join '', <F>;
close(F);
return $contents;
@ -309,6 +303,5 @@ sub is_nonexistent_path {
# Local variables:
# mode: perl
# cperl-indent-level: 4
# end:
# vim: ft=perl

View file

@ -22,429 +22,528 @@
use strict;
use warnings;
use Test::More tests => 39;
use File::Spec qw(make_path);
use POSIX qw(getcwd);
use Test::More tests => 35;
use Test::Output;
use English qw(-no_match_vars);
use testutil;
use Stow::Util qw(canon_path);
init_test_dirs();
cd("$TEST_DIR/target");
my $repo = getcwd();
# Note that each of the following tests use a distinct set of files
init_test_dirs($TEST_DIR);
my $stow;
my %conflicts;
our $COMPAT_TEST_DIR = "${TEST_DIR}-compat";
our $COMPAT_ABS_TEST_DIR = init_test_dirs($COMPAT_TEST_DIR);
sub init_stow2 {
make_path('stow2'); # make our alternate stow dir a subdir of target
make_file('stow2/.stow');
}
sub create_unowned_files {
# Make things harder for Stow to figure out, by adding
# a bunch of alien files unrelated to Stow.
my @UNOWNED_DIRS = ('unowned-dir', '.unowned-dir', 'dot-unowned-dir');
for my $dir ('.', @UNOWNED_DIRS) {
for my $subdir ('.', @UNOWNED_DIRS) {
make_path("$dir/$subdir");
make_file("$dir/$subdir/unowned");
make_file("$dir/$subdir/.unowned");
make_file("$dir/$subdir/dot-unowned");
}
}
}
# Run a subtest twice, with compat off then on, in parallel test trees.
#
# unstow a simple tree minimally
#
$stow = new_Stow();
make_path('../stow/pkg1/bin1');
make_file('../stow/pkg1/bin1/file1');
make_link('bin1', '../stow/pkg1/bin1');
$stow->plan_unstow('pkg1');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f '../stow/pkg1/bin1/file1' && ! -e 'bin1'
=> 'unstow a simple tree'
);
# Params: $name[, $setup], $test_code
#
# unstow a simple tree from an existing directory
#
$stow = new_Stow();
# $setup is an optional ref to an options hash to pass into the new
# Stow() constructor, or a ref to a sub which performs setup before
# the constructor gets called and then returns that options hash.
sub subtests {
my $name = shift;
my $setup = @_ == 2 ? shift : {};
my $code = shift;
make_path('lib2');
make_path('../stow/pkg2/lib2');
make_file('../stow/pkg2/lib2/file2');
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
$stow->plan_unstow('pkg2');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f '../stow/pkg2/lib2/file2' && -d 'lib2'
=> 'unstow simple tree from a pre-existing directory'
);
$ENV{HOME} = $ABS_TEST_DIR;
cd($repo);
cd("$TEST_DIR/target");
create_unowned_files();
# cd first to allow setup to cd somewhere else.
my $opts = ref($setup) eq 'HASH' ? $setup : $setup->($TEST_DIR);
subtest($name, sub {
make_path($opts->{dir}) if $opts->{dir};
my $stow = new_Stow(%$opts);
$code->($stow, $TEST_DIR);
});
#
# fold tree after unstowing
#
$stow = new_Stow();
$ENV{HOME} = $COMPAT_ABS_TEST_DIR;
cd($repo);
cd("$COMPAT_TEST_DIR/target");
create_unowned_files();
# cd first to allow setup to cd somewhere else.
$opts = ref $setup eq 'HASH' ? $setup : $setup->($COMPAT_TEST_DIR);
subtest("$name (compat mode)", sub {
make_path($opts->{dir}) if $opts->{dir};
my $stow = new_compat_Stow(%$opts);
$code->($stow, $COMPAT_TEST_DIR);
});
}
make_path('bin3');
sub plan_tests {
my ($stow, $count) = @_;
plan tests => $stow->{compat} ? $count + 2 : $count;
}
make_path('../stow/pkg3a/bin3');
make_file('../stow/pkg3a/bin3/file3a');
make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
subtests("unstow a simple tree minimally", sub {
my ($stow) = @_;
plan tests => 3;
make_path('../stow/pkg3b/bin3');
make_file('../stow/pkg3b/bin3/file3b');
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
$stow->plan_unstow('pkg3b');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-l 'bin3' &&
readlink('bin3') eq '../stow/pkg3a/bin3'
=> 'fold tree after unstowing'
);
make_path('../stow/pkg1/bin1');
make_file('../stow/pkg1/bin1/file1');
make_link('bin1', '../stow/pkg1/bin1');
#
# existing link is owned by stow but is invalid so it gets removed anyway
#
$stow = new_Stow();
$stow->plan_unstow('pkg1');
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(-f '../stow/pkg1/bin1/file1');
ok(! -e 'bin1' => 'unstow a simple tree');
});
make_path('bin4');
make_path('../stow/pkg4/bin4');
make_file('../stow/pkg4/bin4/file4');
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
subtests("unstow a simple tree from an existing directory", sub {
my ($stow) = @_;
plan tests => 3;
$stow->plan_unstow('pkg4');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
! -e 'bin4/file4'
=> q(remove invalid link owned by stow)
);
make_path('lib2');
make_path('../stow/pkg2/lib2');
make_file('../stow/pkg2/lib2/file2');
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
$stow->plan_unstow('pkg2');
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(-f '../stow/pkg2/lib2/file2');
ok(-d 'lib2'
=> 'unstow simple tree from a pre-existing directory'
);
});
#
# Existing link is not owned by stow
#
$stow = new_Stow();
subtests("fold tree after unstowing", sub {
my ($stow) = @_;
plan tests => 3;
make_path('../stow/pkg5/bin5');
make_invalid_link('bin5', '../not-stow');
make_path('bin3');
$stow->plan_unstow('pkg5');
%conflicts = $stow->get_conflicts;
like(
$conflicts{unstow}{pkg5}[-1],
qr(existing target is not owned by stow)
=> q(existing link not owned by stow)
);
make_path('../stow/pkg3a/bin3');
make_file('../stow/pkg3a/bin3/file3a');
make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
#
# Target already exists, is owned by stow, but points to a different package
#
$stow = new_Stow();
make_path('../stow/pkg3b/bin3');
make_file('../stow/pkg3b/bin3/file3b');
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
$stow->plan_unstow('pkg3b');
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(-l 'bin3');
is(readlink('bin3'), '../stow/pkg3a/bin3'
=> 'fold tree after unstowing'
);
});
make_path('bin6');
make_path('../stow/pkg6a/bin6');
make_file('../stow/pkg6a/bin6/file6');
make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
subtests("existing link is owned by stow but is invalid so it gets removed anyway", sub {
my ($stow) = @_;
plan tests => 2;
make_path('../stow/pkg6b/bin6');
make_file('../stow/pkg6b/bin6/file6');
make_path('bin4');
make_path('../stow/pkg4/bin4');
make_file('../stow/pkg4/bin4/file4');
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
$stow->plan_unstow('pkg6b');
ok(
$stow->get_conflict_count == 0 &&
-l 'bin6/file6' &&
readlink('bin6/file6') eq '../../stow/pkg6a/bin6/file6'
=> q(ignore existing link that points to a different package)
);
$stow->plan_unstow('pkg4');
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(! -e 'bin4/file4'
=> q(remove invalid link owned by stow)
);
});
#
# Don't unlink anything under the stow directory
#
make_path('stow'); # make out stow dir a subdir of target
$stow = new_Stow(dir => 'stow');
subtests("Existing invalid link is not owned by stow", sub {
my ($stow) = @_;
plan tests => 3;
# emulate stowing into ourself (bizarre corner case or accident)
make_path('stow/pkg7a/stow/pkg7b');
make_file('stow/pkg7a/stow/pkg7b/file7b');
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
make_path('../stow/pkg5/bin5');
make_invalid_link('bin5', '../not-stow');
$stow->plan_unstow('pkg7b');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
ok(
$stow->get_conflict_count == 0 &&
-l 'stow/pkg7b' &&
readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
=> q(don't unlink any nodes under the stow directory)
);
$stow->plan_unstow('pkg5');
is($stow->get_conflict_count, 0, 'conflict count');
ok(-l 'bin5', 'invalid link not removed');
is(readlink('bin5'), '../not-stow' => "invalid link not changed");
});
subtests("Target already exists, is owned by stow, but points to a different package", sub {
my ($stow) = @_;
plan tests => 3;
#
# Don't unlink any nodes under another stow directory
#
$stow = new_Stow(dir => 'stow');
make_path('bin6');
make_path('../stow/pkg6a/bin6');
make_file('../stow/pkg6a/bin6/file6');
make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
make_path('stow2'); # make our alternate stow dir a subdir of target
make_file('stow2/.stow');
make_path('../stow/pkg6b/bin6');
make_file('../stow/pkg6b/bin6/file6');
# emulate stowing into ourself (bizarre corner case or accident)
make_path('stow/pkg8a/stow2/pkg8b');
make_file('stow/pkg8a/stow2/pkg8b/file8b');
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
$stow->plan_unstow('pkg6b');
is($stow->get_conflict_count, 0, 'conflict count');
ok(-l 'bin6/file6');
is(
readlink('bin6/file6'),
'../../stow/pkg6a/bin6/file6'
=> q(ignore existing link that points to a different package)
);
});
capture_stderr();
$stow->plan_unstow('pkg8a');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
ok(
$stow->get_conflict_count == 0 &&
-l 'stow2/pkg8b' &&
readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
=> q(don't unlink any nodes under another stow directory)
);
like($stderr,
qr/WARNING: skipping protected directory stow2/
=> "unstowing from ourself should skip stow");
uncapture_stderr();
subtests("Don't unlink anything under the stow directory",
sub {
make_path('stow');
return { dir => 'stow' };
# target dir defaults to parent of stow, which is target directory
},
sub {
plan tests => 5;
my ($stow) = @_;
#
# overriding already stowed documentation
#
$stow = new_Stow(override => ['man9', 'info9']);
make_file('stow/.stow');
# Emulate stowing into ourself (bizarre corner case or accident):
make_path('stow/pkg7a/stow/pkg7b');
make_file('stow/pkg7a/stow/pkg7b/file7b');
# Make a package be a link to a package of the same name inside another package.
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
make_path('../stow/pkg9a/man9/man1');
make_file('../stow/pkg9a/man9/man1/file9.1');
make_path('man9/man1');
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
stderr_like(
sub { $stow->plan_unstow('pkg7b'); },
$stow->{compat} ? qr/WARNING: skipping target which was current stow directory stow/ : qr//
=> "warn when unstowing from ourself"
);
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
is($stow->get_conflict_count, 0, 'conflict count');
ok(-l 'stow/pkg7b');
is(
readlink('stow/pkg7b'),
'../stow/pkg7a/stow/pkg7b'
=> q(don't unlink any nodes under the stow directory)
);
});
make_path('../stow/pkg9b/man9/man1');
make_file('../stow/pkg9b/man9/man1/file9.1');
$stow->plan_unstow('pkg9b');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
!-l 'man9/man1/file9.1'
=> 'overriding existing documentation files'
);
subtests("Don't unlink any nodes under another stow directory",
sub {
make_path('stow');
return { dir => 'stow' };
},
sub {
my ($stow) = @_;
plan tests => 5;
#
# deferring to already stowed documentation
#
$stow = new_Stow(defer => ['man10', 'info10']);
init_stow2();
# emulate stowing into ourself (bizarre corner case or accident)
make_path('stow/pkg8a/stow2/pkg8b');
make_file('stow/pkg8a/stow2/pkg8b/file8b');
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
make_path('../stow/pkg10a/man10/man1');
make_file('../stow/pkg10a/man10/man1/file10a.1');
make_path('man10/man1');
make_link('man10/man1/file10a.1' => '../../../stow/pkg10a/man10/man1/file10a.1');
stderr_like(
sub { $stow->plan_unstow('pkg8a'); },
qr/WARNING: skipping marked Stow directory stow2/
=> "warn when skipping unstowing"
);
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
is($stow->get_conflict_count, 0, 'conflict count');
ok(-l 'stow2/pkg8b');
is(
readlink('stow2/pkg8b'),
'../stow/pkg8a/stow2/pkg8b'
=> q(don't unlink any nodes under another stow directory)
);
});
# need this to block folding
make_path('../stow/pkg10b/man10/man1');
make_file('../stow/pkg10b/man10/man1/file10b.1');
make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
# This will be used by subsequent tests
sub check_protected_dirs_skipped {
my ($stderr) = @_;
for my $dir (qw{stow stow2}) {
like($stderr,
qr/WARNING: skipping marked Stow directory $dir/
=> "warn when skipping marked directory $dir");
}
}
subtests("overriding already stowed documentation",
{override => ['man9', 'info9']},
sub {
my ($stow) = @_;
plan_tests($stow, 2);
make_path('../stow/pkg10c/man10/man1');
make_file('../stow/pkg10c/man10/man1/file10a.1');
$stow->plan_unstow('pkg10c');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
ok(
$stow->get_conflict_count == 0 &&
readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
=> 'defer to existing documentation files'
);
make_file('stow/.stow');
init_stow2();
make_path('../stow/pkg9a/man9/man1');
make_file('../stow/pkg9a/man9/man1/file9.1');
make_path('man9/man1');
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
#
# Ignore temp files
#
$stow = new_Stow(ignore => ['~', '\.#.*']);
make_path('../stow/pkg9b/man9/man1');
make_file('../stow/pkg9b/man9/man1/file9.1');
my $stderr = stderr_from { $stow->plan_unstow('pkg9b') };
check_protected_dirs_skipped($stderr) if $stow->{compat};
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(!-l 'man9/man1/file9.1'
=> 'overriding existing documentation files'
);
});
make_path('../stow/pkg12/man12/man1');
make_file('../stow/pkg12/man12/man1/file12.1');
make_file('../stow/pkg12/man12/man1/file12.1~');
make_file('../stow/pkg12/man12/man1/.#file12.1');
make_path('man12/man1');
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
subtests("deferring to already stowed documentation",
{defer => ['man10', 'info10']},
sub {
my ($stow) = @_;
plan_tests($stow, 3);
$stow->plan_unstow('pkg12');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
!-e 'man12/man1/file12.1'
=> 'ignore temp files'
);
init_stow2();
make_path('../stow/pkg10a/man10/man1');
make_file('../stow/pkg10a/man10/man1/file10a.1');
make_path('man10/man1');
make_link('man10/man1/file10a.1' => '../../../stow/pkg10a/man10/man1/file10a.1');
#
# Unstow an already unstowed package
#
$stow = new_Stow();
$stow->plan_unstow('pkg12');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
ok(
$stow->get_conflict_count == 0
=> 'unstow already unstowed package pkg12'
);
# need this to block folding
make_path('../stow/pkg10b/man10/man1');
make_file('../stow/pkg10b/man10/man1/file10b.1');
make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
#
# Unstow a never stowed package
#
make_path('../stow/pkg10c/man10/man1');
make_file('../stow/pkg10c/man10/man1/file10a.1');
my $stderr = stderr_from { $stow->plan_unstow('pkg10c') };
check_protected_dirs_skipped($stderr) if $stow->{compat};
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
is($stow->get_conflict_count, 0, 'conflict count');
is(
readlink('man10/man1/file10a.1'),
'../../../stow/pkg10a/man10/man1/file10a.1'
=> 'defer to existing documentation files'
);
});
eval { remove_dir("$TEST_DIR/target"); };
mkdir("$TEST_DIR/target");
subtests("Ignore temp files",
{ignore => ['~', '\.#.*']},
sub {
my ($stow) = @_;
plan_tests($stow, 2);
$stow = new_Stow();
$stow->plan_unstow('pkg12');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
ok(
$stow->get_conflict_count == 0
=> 'unstow never stowed package pkg12'
);
init_stow2();
make_path('../stow/pkg12/man12/man1');
make_file('../stow/pkg12/man12/man1/file12.1');
make_file('../stow/pkg12/man12/man1/file12.1~');
make_file('../stow/pkg12/man12/man1/.#file12.1');
make_path('man12/man1');
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
#
# Unstowing when target contains a real file shouldn't be an issue.
#
make_file('man12/man1/file12.1');
my $stderr = stderr_from { $stow->plan_unstow('pkg12') };
check_protected_dirs_skipped($stderr) if $stow->{compat};
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(! -e 'man12/man1/file12.1' => 'man12/man1/file12.1 was unstowed');
});
$stow = new_Stow();
$stow->plan_unstow('pkg12');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
%conflicts = $stow->get_conflicts;
ok(
$stow->get_conflict_count == 1 &&
$conflicts{unstow}{pkg12}[0]
=~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
=> 'unstow pkg12 for third time'
);
subtests("Unstow an already unstowed package", sub {
my ($stow) = @_;
plan_tests($stow, 2);
#
# unstow a simple tree minimally when cwd isn't target
#
cd('../..');
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
my $stderr = stderr_from { $stow->plan_unstow('pkg12') };
check_protected_dirs_skipped($stderr) if $stow->{compat};
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
is($stow->get_conflict_count, 0, 'conflict count');
});
make_path("$TEST_DIR/stow/pkg13/bin13");
make_file("$TEST_DIR/stow/pkg13/bin13/file13");
make_link("$TEST_DIR/target/bin13", '../stow/pkg13/bin13');
subtests("Unstow a never stowed package", sub {
my ($stow) = @_;
plan tests => 2;
$stow->plan_unstow('pkg13');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f "$TEST_DIR/stow/pkg13/bin13/file13" && ! -e "$TEST_DIR/target/bin13"
=> 'unstow a simple tree'
);
eval { remove_dir($stow->{target}); };
mkdir($stow->{target});
#
# unstow a simple tree minimally with absolute stow dir when cwd isn't
# target
#
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => "$TEST_DIR/target");
$stow->plan_unstow('pkg12');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
is($stow->get_conflict_count, 0, 'conflict count');
});
make_path("$TEST_DIR/stow/pkg14/bin14");
make_file("$TEST_DIR/stow/pkg14/bin14/file14");
make_link("$TEST_DIR/target/bin14", '../stow/pkg14/bin14');
subtests("Unstowing when target contains real files shouldn't be an issue", sub {
my ($stow) = @_;
plan tests => 4;
$stow->plan_unstow('pkg14');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f "$TEST_DIR/stow/pkg14/bin14/file14" && ! -e "$TEST_DIR/target/bin14"
=> 'unstow a simple tree with absolute stow dir'
);
# Test both a file which do / don't overlap with the package
make_path('man12/man1');
make_file('man12/man1/alien');
make_file('man12/man1/file12.1');
#
# unstow a simple tree minimally with absolute stow AND target dirs
# when cwd isn't target
#
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => canon_path("$TEST_DIR/target"));
$stow->plan_unstow('pkg12');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
is($stow->get_conflict_count, 0, 'conflict count');
ok(-f 'man12/man1/alien', 'alien untouched');
ok(-f 'man12/man1/file12.1', 'file overlapping with pkg untouched');
});
make_path("$TEST_DIR/stow/pkg15/bin15");
make_file("$TEST_DIR/stow/pkg15/bin15/file15");
make_link("$TEST_DIR/target/bin15", '../stow/pkg15/bin15');
subtests("unstow a simple tree minimally when cwd isn't target",
sub {
my $test_dir = shift;
cd($repo);
return {
dir => "$test_dir/stow",
target => "$test_dir/target"
}
},
sub {
my ($stow, $test_dir) = @_;
plan tests => 3;
$stow->plan_unstow('pkg15');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f "$TEST_DIR/stow/pkg15/bin15/file15" && ! -e "$TEST_DIR/target/bin15"
=> 'unstow a simple tree with absolute stow and target dirs'
);
make_path("$test_dir/stow/pkg13/bin13");
make_file("$test_dir/stow/pkg13/bin13/file13");
make_link("$test_dir/target/bin13", '../stow/pkg13/bin13');
#
# unstow a tree with no-folding enabled -
# no refolding should take place
#
cd("$TEST_DIR/target");
$stow->plan_unstow('pkg13');
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(-f "$test_dir/stow/pkg13/bin13/file13", 'package file untouched');
ok(! -e "$test_dir/target/bin13" => 'bin13/ unstowed');
});
subtests("unstow a simple tree minimally with absolute stow dir when cwd isn't target",
sub {
my $test_dir = shift;
cd($repo);
return {
dir => canon_path("$test_dir/stow"),
target => "$test_dir/target"
};
},
sub {
plan tests => 3;
my ($stow, $test_dir) = @_;
make_path("$test_dir/stow/pkg14/bin14");
make_file("$test_dir/stow/pkg14/bin14/file14");
make_link("$test_dir/target/bin14", '../stow/pkg14/bin14');
$stow->plan_unstow('pkg14');
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(-f "$test_dir/stow/pkg14/bin14/file14");
ok(! -e "$test_dir/target/bin14"
=> 'unstow a simple tree with absolute stow dir'
);
});
subtests("unstow a simple tree minimally with absolute stow AND target dirs when cwd isn't target",
sub {
my $test_dir = shift;
cd($repo);
return {
dir => canon_path("$test_dir/stow"),
target => canon_path("$test_dir/target")
};
},
sub {
my ($stow, $test_dir) = @_;
plan tests => 3;
make_path("$test_dir/stow/pkg15/bin15");
make_file("$test_dir/stow/pkg15/bin15/file15");
make_link("$test_dir/target/bin15", '../stow/pkg15/bin15');
$stow->plan_unstow('pkg15');
$stow->process_tasks();
is($stow->get_conflict_count, 0, 'conflict count');
ok(-f "$test_dir/stow/pkg15/bin15/file15");
ok(! -e "$test_dir/target/bin15"
=> 'unstow a simple tree with absolute stow and target dirs'
);
});
sub create_and_stow_pkg {
my ($id, $pkg) = @_;
my $stow_pkg = "../stow/$id-$pkg";
make_path ($stow_pkg);
make_path($stow_pkg);
make_file("$stow_pkg/$id-file-$pkg");
# create a shallow hierarchy specific to this package and stow
# via folding
make_path ("$stow_pkg/$id-$pkg-only-folded");
make_path("$stow_pkg/$id-$pkg-only-folded");
make_file("$stow_pkg/$id-$pkg-only-folded/file-$pkg");
make_link("$id-$pkg-only-folded", "$stow_pkg/$id-$pkg-only-folded");
# create a deeper hierarchy specific to this package and stow
# via folding
make_path ("$stow_pkg/$id-$pkg-only-folded2/subdir");
make_path("$stow_pkg/$id-$pkg-only-folded2/subdir");
make_file("$stow_pkg/$id-$pkg-only-folded2/subdir/file-$pkg");
make_link("$id-$pkg-only-folded2",
"$stow_pkg/$id-$pkg-only-folded2");
# create a shallow hierarchy specific to this package and stow
# without folding
make_path ("$stow_pkg/$id-$pkg-only-unfolded");
make_path("$stow_pkg/$id-$pkg-only-unfolded");
make_file("$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
make_path ("$id-$pkg-only-unfolded");
make_path("$id-$pkg-only-unfolded");
make_link("$id-$pkg-only-unfolded/file-$pkg",
"../$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
# create a deeper hierarchy specific to this package and stow
# without folding
make_path ("$stow_pkg/$id-$pkg-only-unfolded2/subdir");
make_path("$stow_pkg/$id-$pkg-only-unfolded2/subdir");
make_file("$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
make_path ("$id-$pkg-only-unfolded2/subdir");
make_path("$id-$pkg-only-unfolded2/subdir");
make_link("$id-$pkg-only-unfolded2/subdir/file-$pkg",
"../../$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
# create a shallow shared hierarchy which this package uses, and stow
# its contents without folding
make_path ("$stow_pkg/$id-shared");
make_path("$stow_pkg/$id-shared");
make_file("$stow_pkg/$id-shared/file-$pkg");
make_path ("$id-shared");
make_path("$id-shared");
make_link("$id-shared/file-$pkg",
"../$stow_pkg/$id-shared/file-$pkg");
# create a deeper shared hierarchy which this package uses, and stow
# its contents without folding
make_path ("$stow_pkg/$id-shared2/subdir");
make_path("$stow_pkg/$id-shared2/subdir");
make_file("$stow_pkg/$id-shared2/file-$pkg");
make_file("$stow_pkg/$id-shared2/subdir/file-$pkg");
make_path ("$id-shared2/subdir");
make_path("$id-shared2/subdir");
make_link("$id-shared2/file-$pkg",
"../$stow_pkg/$id-shared2/file-$pkg");
make_link("$id-shared2/subdir/file-$pkg",
"../../$stow_pkg/$id-shared2/subdir/file-$pkg");
}
foreach my $pkg (qw{a b}) {
create_and_stow_pkg('no-folding', $pkg);
}
subtest("unstow a tree with no-folding enabled - no refolding should take place", sub {
cd("$TEST_DIR/target");
plan tests => 15;
$stow = new_Stow('no-folding' => 1);
$stow->plan_unstow('no-folding-b');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
use Data::Dumper;
#warn Dumper($stow->get_tasks);
foreach my $pkg (qw{a b}) {
create_and_stow_pkg('no-folding', $pkg);
}
$stow->process_tasks();
my $stow = new_Stow('no-folding' => 1);
$stow->plan_unstow('no-folding-b');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
is_nonexistent_path('no-folding-b-only-folded');
is_nonexistent_path('no-folding-b-only-folded2');
is_nonexistent_path('no-folding-b-only-unfolded/file-b');
is_nonexistent_path('no-folding-b-only-unfolded2/subdir/file-b');
is_dir_not_symlink('no-folding-shared');
is_dir_not_symlink('no-folding-shared2');
is_dir_not_symlink('no-folding-shared2/subdir');
$stow->process_tasks();
is_nonexistent_path('no-folding-b-only-folded');
is_nonexistent_path('no-folding-b-only-folded2');
is_nonexistent_path('no-folding-b-only-unfolded/file-b');
is_nonexistent_path('no-folding-b-only-unfolded2/subdir/file-b');
is_dir_not_symlink('no-folding-shared');
is_dir_not_symlink('no-folding-shared2');
is_dir_not_symlink('no-folding-shared2/subdir');
});
# Todo
#
# Test cleaning up subdirs with --paranoid option
# subtests("Test cleaning up subdirs with --paranoid option", sub {
# TODO
# });

View file

@ -1,403 +0,0 @@
#!/usr/bin/perl
#
# This file is part of GNU Stow.
#
# GNU Stow is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# GNU Stow is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see https://www.gnu.org/licenses/.
#
# Test unstowing packages in compat mode
#
use strict;
use warnings;
use File::Spec qw(make_path);
use Test::More tests => 37;
use Test::Output;
use English qw(-no_match_vars);
use testutil;
use Stow::Util qw(canon_path);
init_test_dirs();
cd("$TEST_DIR/target");
# Note that each of the following tests use a distinct set of files
my $stow;
my %conflicts;
#
# unstow a simple tree minimally
#
$stow = new_compat_Stow();
make_path('../stow/pkg1/bin1');
make_file('../stow/pkg1/bin1/file1');
make_link('bin1', '../stow/pkg1/bin1');
$stow->plan_unstow('pkg1');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f '../stow/pkg1/bin1/file1' && ! -e 'bin1'
=> 'unstow a simple tree'
);
#
# unstow a simple tree from an existing directory
#
$stow = new_compat_Stow();
make_path('lib2');
make_path('../stow/pkg2/lib2');
make_file('../stow/pkg2/lib2/file2');
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
$stow->plan_unstow('pkg2');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f '../stow/pkg2/lib2/file2' && -d 'lib2'
=> 'unstow simple tree from a pre-existing directory'
);
#
# fold tree after unstowing
#
$stow = new_compat_Stow();
make_path('bin3');
make_path('../stow/pkg3a/bin3');
make_file('../stow/pkg3a/bin3/file3a');
make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
make_path('../stow/pkg3b/bin3');
make_file('../stow/pkg3b/bin3/file3b');
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
$stow->plan_unstow('pkg3b');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-l 'bin3' &&
readlink('bin3') eq '../stow/pkg3a/bin3'
=> 'fold tree after unstowing'
);
#
# existing link is owned by stow but is invalid so it gets removed anyway
#
$stow = new_compat_Stow();
make_path('bin4');
make_path('../stow/pkg4/bin4');
make_file('../stow/pkg4/bin4/file4');
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
$stow->plan_unstow('pkg4');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
! -e 'bin4/file4'
=> q(remove invalid link owned by stow)
);
#
# Existing link is not owned by stow
#
$stow = new_compat_Stow();
make_path('../stow/pkg5/bin5');
make_invalid_link('bin5', '../not-stow');
$stow->plan_unstow('pkg5');
# Unlike the corresponding stow_contents.t test, this doesn't
# cause any conflicts.
#
#like(
# $Conflicts[-1], qr(can't unlink.*not owned by stow)
# => q(existing link not owned by stow)
#);
ok(
-l 'bin5' && readlink('bin5') eq '../not-stow'
=> q(existing link not owned by stow)
);
#
# Target already exists, is owned by stow, but points to a different package
#
$stow = new_compat_Stow();
make_path('bin6');
make_path('../stow/pkg6a/bin6');
make_file('../stow/pkg6a/bin6/file6');
make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
make_path('../stow/pkg6b/bin6');
make_file('../stow/pkg6b/bin6/file6');
$stow->plan_unstow('pkg6b');
ok(
$stow->get_conflict_count == 0 &&
-l 'bin6/file6' &&
readlink('bin6/file6') eq '../../stow/pkg6a/bin6/file6'
=> q(ignore existing link that points to a different package)
);
#
# Don't unlink anything under the stow directory
#
make_path('stow'); # make out stow dir a subdir of target
$stow = new_compat_Stow(dir => 'stow');
# emulate stowing into ourself (bizarre corner case or accident)
make_path('stow/pkg7a/stow/pkg7b');
make_file('stow/pkg7a/stow/pkg7b/file7b');
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
capture_stderr();
$stow->plan_unstow('pkg7b');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
ok(
$stow->get_conflict_count == 0 &&
-l 'stow/pkg7b' &&
readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
=> q(don't unlink any nodes under the stow directory)
);
like($stderr,
qr/WARNING: skipping target which was current stow directory stow/
=> "warn when unstowing from ourself");
uncapture_stderr();
#
# Don't unlink any nodes under another stow directory
#
$stow = new_compat_Stow(dir => 'stow');
make_path('stow2'); # make our alternate stow dir a subdir of target
make_file('stow2/.stow');
# emulate stowing into ourself (bizarre corner case or accident)
make_path('stow/pkg8a/stow2/pkg8b');
make_file('stow/pkg8a/stow2/pkg8b/file8b');
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
capture_stderr();
$stow->plan_unstow('pkg8a');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
ok(
$stow->get_conflict_count == 0 &&
-l 'stow2/pkg8b' &&
readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
=> q(don't unlink any nodes under another stow directory)
);
like($stderr,
qr/WARNING: skipping target which was current stow directory stow/
=> "warn when skipping unstowing");
uncapture_stderr();
#
# overriding already stowed documentation
#
# This will be used by this and subsequent tests
sub check_protected_dirs_skipped {
for my $dir (qw{stow stow2}) {
like($stderr,
qr/WARNING: skipping protected directory $dir/
=> "warn when skipping protected directory $dir");
}
uncapture_stderr();
}
$stow = new_compat_Stow(override => ['man9', 'info9']);
make_file('stow/.stow');
make_path('../stow/pkg9a/man9/man1');
make_file('../stow/pkg9a/man9/man1/file9.1');
make_path('man9/man1');
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
make_path('../stow/pkg9b/man9/man1');
make_file('../stow/pkg9b/man9/man1/file9.1');
capture_stderr();
$stow->plan_unstow('pkg9b');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
!-l 'man9/man1/file9.1'
=> 'overriding existing documentation files'
);
check_protected_dirs_skipped();
#
# deferring to already stowed documentation
#
$stow = new_compat_Stow(defer => ['man10', 'info10']);
make_path('../stow/pkg10a/man10/man1');
make_file('../stow/pkg10a/man10/man1/file10a.1');
make_path('man10/man1');
make_link('man10/man1/file10a.1' => '../../../stow/pkg10a/man10/man1/file10a.1');
# need this to block folding
make_path('../stow/pkg10b/man10/man1');
make_file('../stow/pkg10b/man10/man1/file10b.1');
make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
make_path('../stow/pkg10c/man10/man1');
make_file('../stow/pkg10c/man10/man1/file10a.1');
capture_stderr();
$stow->plan_unstow('pkg10c');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
ok(
$stow->get_conflict_count == 0 &&
readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
=> 'defer to existing documentation files'
);
check_protected_dirs_skipped();
#
# Ignore temp files
#
$stow = new_compat_Stow(ignore => ['~', '\.#.*']);
make_path('../stow/pkg12/man12/man1');
make_file('../stow/pkg12/man12/man1/file12.1');
make_file('../stow/pkg12/man12/man1/file12.1~');
make_file('../stow/pkg12/man12/man1/.#file12.1');
make_path('man12/man1');
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
capture_stderr();
$stow->plan_unstow('pkg12');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
!-e 'man12/man1/file12.1'
=> 'ignore temp files'
);
check_protected_dirs_skipped();
#
# Unstow an already unstowed package
#
$stow = new_compat_Stow();
capture_stderr();
$stow->plan_unstow('pkg12');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
ok(
$stow->get_conflict_count == 0
=> 'unstow already unstowed package pkg12'
);
check_protected_dirs_skipped();
#
# Unstow a never stowed package
#
eval { remove_dir("$TEST_DIR/target"); };
mkdir("$TEST_DIR/target");
$stow = new_compat_Stow();
capture_stderr();
$stow->plan_unstow('pkg12');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
ok(
$stow->get_conflict_count == 0
=> 'unstow never stowed package pkg12'
);
check_protected_dirs_skipped();
#
# Unstowing when target contains a real file shouldn't be an issue.
#
make_file('man12/man1/file12.1');
$stow = new_compat_Stow();
capture_stderr();
$stow->plan_unstow('pkg12');
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
%conflicts = $stow->get_conflicts;
ok(
$stow->get_conflict_count == 1 &&
$conflicts{unstow}{pkg12}[0]
=~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
=> 'unstow pkg12 for third time'
);
check_protected_dirs_skipped();
#
# unstow a simple tree minimally when cwd isn't target
#
cd('../..');
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
make_path("$TEST_DIR/stow/pkg13/bin13");
make_file("$TEST_DIR/stow/pkg13/bin13/file13");
make_link("$TEST_DIR/target/bin13", '../stow/pkg13/bin13');
$stow->plan_unstow('pkg13');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f "$TEST_DIR/stow/pkg13/bin13/file13" && ! -e "$TEST_DIR/target/bin13"
=> 'unstow a simple tree'
);
#
# unstow a simple tree minimally with absolute stow dir when cwd isn't
# target
#
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => "$TEST_DIR/target");
make_path("$TEST_DIR/stow/pkg14/bin14");
make_file("$TEST_DIR/stow/pkg14/bin14/file14");
make_link("$TEST_DIR/target/bin14", '../stow/pkg14/bin14');
$stow->plan_unstow('pkg14');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f "$TEST_DIR/stow/pkg14/bin14/file14" && ! -e "$TEST_DIR/target/bin14"
=> 'unstow a simple tree with absolute stow dir'
);
#
# unstow a simple tree minimally with absolute stow AND target dirs
# when cwd isn't target
#
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => canon_path("$TEST_DIR/target"));
make_path("$TEST_DIR/stow/pkg15/bin15");
make_file("$TEST_DIR/stow/pkg15/bin15/file15");
make_link("$TEST_DIR/target/bin15", '../stow/pkg15/bin15');
$stow->plan_unstow('pkg15');
$stow->process_tasks();
ok(
$stow->get_conflict_count == 0 &&
-f "$TEST_DIR/stow/pkg15/bin15/file15" && ! -e "$TEST_DIR/target/bin15"
=> 'unstow a simple tree with absolute stow and target dirs'
);
# Todo
#
# Test cleaning up subdirs with --paranoid option