如何使用 Perl 创建符号链接？

Question

我正在尝试在 Perl 中运行以下代码：

symlink($oldname,$newname) or die print "$!\n";

但我收到一条错误消息：

The symlink function is unimplemented at C:\...\CreateSymlink.pl line 14.

如果我将代码更改为：

link($oldname,$newname) or die print "$!\n";

那么创建的硬链接没有错误。

使用 activestate Perl 和 Windows 7 32 位。

任何想法为什么会发生这种情况？我正在尝试为文件创建符号链接。

P.S：我是 Perl 的新手。

Answer 1

“符号链接”是哪种“类型”？ ;-)

• 捷径.LNK？ （Win95+，不透明）
• junction point? （Win2K+，仅限本地文件系统/目录）
• 真正的NTFS symbolic link？ (Vista/2008/Win7+)

哦，请阅读上面的符号链接 Wikipedia 文章以了解 mklink 命令；-) Back-ticks (or system) 可以成为好朋友，但请注意：

Windows Vista/Windows 7 中的默认安全设置不允许非提升的管理员和所有非管理员创建符号链接。可以[通过安全策略设置]更改此行为... .

编码愉快。

---

WinAPI CreateSymbolicLink 函数可能可以直接使用；我不确定它是否“受到”与上述mklink 命令相同的限制。但是，this thread 表示它仍然有效。

---

FWIW，这在 Strawberry Perl 5.12 中“有效”。 YMMV，我只是输入了这个并且从未使用过它:-)

use Win32::API;
$fn = Win32::API->new(
    # Note "A" function, IDK how to use Unicdoe
    "kernel32", "BOOLEAN CreateSymbolicLinkA(LPTSTR lpSymlinkFileName, LPTSTR lpTargetFileName, DWORD flags)"
);

unlink("src.txt");
unlink("lnk.txt");
open(FH,">src.txt") or die $!;
close(FH);

print "src.txt exists? " , (-f "src.txt"), "\n";
print "lnk.txt exists? " , (-f "lnk.txt"), "\n";
$hr = $fn->Call("lnk.txt", "src.txt", 0);
print "Result: ", $hr, "\n";
print "lnk.txt exists? ", (-f "lnk.txt"), "\n";

open(FH,">>src.txt") or die $!;
print FH "hello world!\n";
close(FH);

open(FH,"<lnk.txt") or die $!;
print "linked data: ", scalar(<FH>), "\n";
close(FH);

我的结果（以“管理员”身份运行——可能不适用于“其他用户”——我不知道为什么，但我的 cmd.exe 总是以提升的权限打开）：

src.txt 存在吗？ 1
lnk.txt 存在吗？
结果：
lnk.txt 存在吗？ 1
关联数据：hello world！

目录列表：

2011 年 10 月 22 日下午 02:53  。
2011 年 10 月 22 日下午 2:53  ..
2011 年 10 月 22 日下午 2:54 636 foo.pl
10/22/2011 02:53 PM  lnk.txt [src.txt]
10/22/2011 02:53 PM 14 src.txt

我不知道 NTFS 符号链接和“UNIX”符号链接之间可能存在什么 [细微的] 差异（如果有的话）。此外，上述 不会工作 pre-Vista/2008 -- NTFS 的早期版本不 支持符号链接（并且 Windows 的早期版本没有 @987654330 @函数）。

Answer 2

解决方法：

my $oldfilename = File::Spec->catfile($oldname);
my $newfilename = File::Spec->catfile($newname);
if(-f $newfilename){ } else {
    @args = ("mklink", $newfilename, $oldfilename);
    system(@args) == 0; }