1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
#!/usr/bin/perl
use warnings;
use strict;
use Test::More qw(no_plan);
use File::Fu;
my $tmp = File::Fu->dir('tmp');
mkdir($tmp);
# make a file
my $file = $tmp + 'file';
is($file, 'tmp/file');
my $fh = $file->open('>');
print $fh "yay\n";
close($fh) or die "cannot write '$file' $!";
ok($file->e);
# hardlink
my $link = $file->link($tmp->file('link')->stringify);
is($link, 'tmp/link');
$file->unlink;
ok(! $file->e);
ok($link->e, 'link still there');
# TODO stat
{
my $fh = $link->open;
chomp(my $line = <$fh>);
is($line, 'yay');
}
my $sl = $link->symlink($tmp->file('symlink')->stringify);
is($sl, 'tmp/symlink');
ok($sl->l, 'is a link');
is($sl->readlink, 'tmp/link');
ok(! $sl->e, 'target does not exist (relativity)');
$sl->unlink;
ok(! $sl->l, 'gone');
$sl = $link->basename->symlink($sl);
ok($sl->e, 'exists');
ok($sl->l, 'is a link');
# renaming
my $linknow = $link->rename('tmp/linknow');
is($linknow, 'tmp/linknow');
ok(! $link->e);
ok(! $sl->e);
is($link, 'tmp/link');
$linknow->rename($link);
ok($link->e);
ok($sl->e);
ok(!$linknow->e);
is($linknow, 'tmp/linknow');
$link->unlink;
ok(! $link->e);
ok(! $sl->e);
$sl->unlink;
ok(! $sl->l);
# symlink->symlink->symlink
{
my $tmp = File::Fu->dir('tmp.links.' . $$);
$tmp->mkdir;
my $file = $tmp->file('file')->touch;
is($file->resolve, $file);
my $link = $file->basename->symlink($tmp + 'link1');
is($link->resolve, $file);
$tmp->remove;
}
# relative symlink
{
my $file = $tmp->file('file')->touch;
ok($file->e);
my $dir = $tmp->subdir('dir')->mkdir;
ok($dir->d);
my $link = $file->relative_symlink($dir + 'and');
ok($link->l);
ok($link->e);
$file->unlink;
ok(! $file->e);
ok(! $link->e);
$link->unlink;
$dir->rmdir;
}
rmdir($tmp) or die "cannot delete '$tmp'";
# vim:ts=2:sw=2:et:sta
|
