如何在Perl中获取子文件驱动器号?

时间:2008-12-15 07:38:10

标签: perl drive-letter

我需要在Perl中获取子文件。有人可以帮助我吗? $ ENV {SYSTEMDRIVE}不起作用;它给了我真正的逻辑驱动器号,而不是被子函数。

4 个答案:

答案 0 :(得分:3)

您在寻找Win32::FileOp吗?

答案 1 :(得分:2)

感谢所有人,最后我通过更简单的方式解决了它 - 通过使用getcwd命令获取当前工作目录然后我使用了输出中的前两个字母 - 这么简单:-)

use Cwd;

my $driveletter = substr(getcwd, 0, 2); 

答案 2 :(得分:0)

如果您想自己动手,可以捕获subst命令的输出并对其进行处理,因为它会输出所有当前替换的驱动器。

SUBST [drive1: [drive2:]path]
SUBST drive1: /D
    drive1:        Specifies a virtual drive to which you want to assign a path.
    [drive2:]path  Specifies a physical drive and path you want to assign to
                   a virtual drive.
    /D             Deletes a substituted (virtual) drive.
Type SUBST with no parameters to display a list of current virtual drives.

C:\Documents and Settings\Administrator\My Documents>subst r: c:\bin

C:\Documents and Settings\Administrator\My Documents>subst
    R:\: => C:\bin

为了做到这一点,你需要一个函数来返回子输出,如下所示:

sub get_drive {
    my $drv = shift;
    my $ln;
    $drv = substr($drv,0,1);
    open (IN, "subst |");
    while ($ln = <IN>) {
            chomp ($ln);
            if ((substr($ln,0,1) eq $drv) && (substr($ln,1,6) eq ":\\: =>")) {
                    close (IN);
                    return substr($ln,8);
            }
    }
    close (IN);
    return $drv . ":\\";
}

print get_drive ("R:") . "\n";
print get_drive ("S:") . "\n";

输出:

C:\bin
S:\

在我的系统上只有一个替代驱动器。

答案 3 :(得分:0)

(响应时间很晚,我知道),但是直到今天我需要类似的东西,而Win32 :: FileOp不会在我的系统上编译。因此,我用“ real”调用了替代并替换了虚拟驱动器;代码段如下:

use strict;
use Data::Dumper;
use feature 'say';

my $DB=1;

$Data::Dumper::Indent = 1;
$Data::Dumper::Terse  = 1;
my %Virt;

exit main();

sub main
{
    my $rtn;
    my (@args) = @_;
    open CMD,"subst|" or die "can't run subst command";
    while (<CMD>) {
        chomp;
        my ($drv, $path) = split(/:\\: => /);
        $Virt{$drv} = $path;
    }

    my %rset; # result set
    while (my ($d,$p) = each %Virt) {
        $rset{$d} = expand($p);
    }
    #D say Dumper rset => \%rset;
    return $rtn;
}

# recursive call if expanded path has another 'virtual' drive
sub expand
{
    my ($loc) = @_;
    my $rtn = undef;
    my ($drv, $path) =  split(/:\\/, $loc);
    if ($a = $Virt{$drv}) {
        #D say "$a $path";
        $rtn = "$a\\$path";
        $rtn = expand($rtn);
    } else {
        #D say "$drv $path";
        $rtn = "$drv:\\$path";
    }
    return $rtn;
}

注意:我将#D用于quickNdirty调试语句

我对此进行了三个级别的测试,即w:等于x :, x:等于y:和y:等于c: