Reputation: 177
I need to get substed drive letter in Perl. Could anyone kindly help me? $ENV{SYSTEMDRIVE} does not work; it gives me real logical drive letter, not the substed one.
Upvotes: 2
Views: 3725
Reputation: 177
perl -e 'use Cwd; print( substr(getcwd(),10,1 )) ' # prints 10th char.
Upvotes: 2
Reputation: 91
(Really late response, I know) but just today I need something like this and Win32::FileOp would not compile on my system. So I invoked subst and substituted virtual drives with "real"; snippet follows:
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;
}
Notes: I use #D for quickNdirty debug statements
I tested this to three levels i.e. w: subst to x:, x: subst to y: and y: subst to c:
Upvotes: 0
Reputation: 881193
If you want to do it yourself, you could capture the output of the subst command and process it, since it outputs all current substituted drives.
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
In order to do this, you need a function to return the subst'ed output, as follows:
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";
This outputs:
C:\bin
S:\
on my system which has only the one subst'ed drive.
Upvotes: 0