In Windows, how can I check where a shortcut file points to? In the following simple code, readlink doesn't show anything:
$dir = 's:\\aaaaa\\bbb';
.....
#img = readdir F;
#lnk = grep{/lnk$/} #img;
......
......
foreach (#lnk){
$where = readlink $dir.$_;
$a=$a;
}
According to perlport, readlink is not implemented on Windows. Instead you can use Win32::Shortcut to read shortcut .lnk files:
use strict;
use warnings;
use feature qw(say);
use Win32::Shortcut;
my $link = Win32::Shortcut->new();
$link->Load("test.lnk");
say "Shortcut to: $link->{'Path'} $link->{'Arguments'}";
$link->Close();
Related
I have a Perl script written on Server 2008. It works fine here.
I have copied it to my laptop, which is running Windows 10 Home Edition, Version 1993, OS Build 18362.959.
I also download Active Perl, for the very first time.
The script basically takes an input file and applies regular expressions to the content and then outputs the results to a file.
On Windows 10 it is not writing to the file, the file is not even created.
I have done a search on this issue but have not found a solution.
I tried the following code, found on one on the reply to the same issue. But it does not create or writes to the file. It works fine on server 2008. Am I missing something?
As mentioned this is the first time I downloaded ActivePerl version
Perl Version Details are as follows:
This is perl 5, version 28, subversion 1 (v5.28.1) built for MSWin32-x64-multi-thread
(with 1 registered patch, see perl -V for more detail)
Copyright 1987-2018, Larry Wall
Binary build 0000 [58a1981e] provided by ActiveState http://www.ActiveState.com
Built Apr 10 2020 17:28:14
Perl code is as follows:
use strict;
use IO::File;
my $FileHandle = new IO::File;
$FileName = "C:\\Users\\moons\\Documents\\Personal Planning\\Shopping\\ShoppingList.txt";
open ($FileHandle, "<$FileName") || print "Cannot open $FileName\n";
local $/;
my $FileContents = <$FileHandle>;
close($FileHandle);
$FileContents =~ s/(Add|Bad|Limit|Each).*\n|Add$|\nWeight\n\d{1,}\nea|\$\d{1,}\.\d\d\/100g\n//g;
Do more Regular expressions.
$FileContents =~ s/(.*)\n(.*)\n(\$\d{1,}\.\d\d)/$1,$3,$2/g;
printf $FileContents;
Above code works. Code below does not create or write to file.
$OutFile = "C:\\Users\\moons\\Documents\\Personal Planning\\Shopping\\test.txt";
$FileHandle = new IO::File;
open ($FileHandle, ">$OutFile") || print "Cannot open $OutFile\n";
printf $FileHandle $FileContents;
close($FileHandle);
Always use use strict; use warnings;.
my $OutFile = "C:\Users\moons\Documents\Personal Planning\Shopping\test.txt";
results in
Unrecognized escape \m passed through at a.pl line 3.
Unrecognized escape \D passed through at a.pl line 3.
Unrecognized escape \P passed through at a.pl line 3.
Unrecognized escape \S passed through at a.pl line 3.
You could use
my $OutFile = "C:\\Users\\moons\\Documents\\Personal Planning\\Shopping\\test.txt";
Whole thing:
use strict;
use warnings;
my $in_qfn = "C:\\Users\\moons\\Documents\\Personal Planning\\Shoppin\\ShoppingList.txt";
my $out_qfn = "C:\\Users\\moons\\Documents\\Personal Planning\\Shopping\\test.txt";
open(my $in_fh, '<', $in_qfn)
or die("Can't open \"$in_qfn\": $!\n");
open(my $out_fh, '>', $out_qfn)
or die("Can't create \"$out_qfn\": $!\n");
my $file;
{
local $/;
$file = <$in_fh>;
}
for ($file) {
s/(Add|Bad|Limit|Each).*\n|Add$|\nWeight\n\d{1,}\nea|\$\d{1,}\.\d\d\/100g\n//g;
s/(.*)\n(.*)\n(\$\d{1,}\.\d\d)/$1,$3,$2/g;
}
print $file;
I want to move files from a server that my Windows computer is connected to, to the actual computer. I have tried the code on my mac and it works fine, so I suspect the problem has to do with the fact that the files I wish to move are on a server or perhaps with Windows (I am unfamiliar with this OS). It is important to me to be able to use File::Find::Rule because there are many subdirectories within subdirectories that need to be searched.
use strict;
use warnings;
use File::Find::Rule;
use File::Copy;
# directory where files live
# my $dir = "\\172.18\user\folder\folder2";
# directory where TextGrids will be moved to
my $outdir = "\users\lisa\desktop\test";
my #files;
#files = File::Find::Rule -> file()
-> name("*_clean.TextGrid")
-> maxdepth()
-> in($dir);
foreach my $file (#files) {
$file =~ /(.*\\)(.*)/;
my $name = $2;
copy("$file", "$outdir/$name") or die "Copy failed: $!";
}
Edit: Ok, I've made some changes to the script below. But the strange thing is, that when I ask it to print each file, it gives me something like \\172.18\user\folder\folder/255/file.txt. I changed the regex to be (.*\/)(.*) and now the script works perfectly, though I don't know why!
use strict;
use warnings;
use File::Find::Rule;
use File::Copy;
# directory where files live
my $dir = "\\\\172.18\\user\\folder\\folder2";
# directory where TextGrids will be moved to
my $outdir = "C:\\Users\\lisa\\desktop\\test";
my #files;
#files = File::Find::Rule -> file()
-> name("*_clean.TextGrid")
-> maxdepth()
-> in($dir);
foreach my $file (#files) {
print "$file\n";
$file =~ /(.*\\)(.*)/;
my $name = $2;
copy("$file", "$outdir\\$name") or die "Copy failed: $!";
}
After your edit, the script works because the last directory separator in the string happens to be /, which is matched by the \/ in the regular expression. Even though you had \ in the input, the library you used to find the files added /s.
I have some suggestions:
You can avoid the need to escape (most) backslashes by using single quoted strings, unless you need the interpolation of the double quoted ones.
Escaping backslashes is optional unless followed by a single quote or another backslash:
my $outdir = '\users\lisa\desktop\test';
but
my $outdir = '\users\lisa\desktop\test\\';
$outdir = '\users\lisa\desktop\test\\\'ere is a path';
my $not_a_path = 'three backslashes\\\\\in between, all but the last need escaping';
'ere is a path is the last element in that path.
If you're dealing with Windows, consider using [\\/] in place of directory separator in regular expressions. (Or [\\\/] if you absolutely must use / as regular expression delimiter.)
Even if you have control over user input to only use \ in paths, libraries you use will usually add /, so it's better to be prepared for a combination of both.
$file =~ /(.*[\\\/])(.*)/;
$file =~ m{(.*[\\/])(.*)};
$file =~ m¤(.*[\\/])(.*)¤;
I also removed the superfluous quotes from around $file in the copy() call. Final result:
use strict;
use warnings;
use File::Find::Rule;
use File::Copy;
# directory where files live
my $dir = '\\172.18\user\folder\folder2';
# directory where TextGrids will be moved to
my $outdir = 'C:\Users\lisa\desktop\test';
my #files;
#files = File::Find::Rule -> file()
-> name("*_clean.TextGrid")
-> maxdepth()
-> in($dir);
foreach my $file (#files) {
print "$file\n";
$file =~ /(.*[\\\/])(.*)/;
my $name = $2;
copy($file, "$outdir\\$name") or die "Copy failed: $!";
}
use strict;
use warnings;
my $dir = "\\172.18\user\folder\folder2";
print("$dir\n");
my $outdir = "\users\lisa\desktop\test";
print("$outdir\n");
outputs
Unrecognized escape \d passed through at a.pl line 7.
\172.18Ser?older?older2
Sersisadesktop est
You need to escape your backslashes!
use strict;
use warnings;
my $dir = "\\\\172.18\\user\\folder\\folder2";
print("$dir\n");
my $outdir = "\\users\\lisa\\desktop\\test";
print("$outdir\n");
Don't ignore warnings.
There is following list of files in directory:
01 Born - Praised - Kissed.flac
02 Wunschkind.flac
03 You've got it.flac
04 Down in this Hole.flac
05 Wälsungenblut.flac
...
N. 0N Filename
#Yes, these are the songs of Oomph!
and following program on Perl:
use warnings;
use strict;
use utf8;
use open qw( :encoding(UTF-8) :std );
my #dirnames;
while ( (my $dirname = <>) =~ /\S/ ) {
chomp($dirname);
push (#dirnames, $dirname);
}
foreach my $dirname (#dirnames) {
opendir (DIR, $dirname);
while ( my $file = readdir(DIR) ) {
if(length($file)>5) {
print $file , "\n";
my $newfile;
$newfile = substr($file, 0, 2);
$newfile .= '.';
$newfile .= substr($file, 2);
rename ($dirname . '\\' . $file, $dirname . '\\' . $newfile) or die $!;
}
}
closedir DIR;
}
that gets the list of directories and renames the files in them by adding dot after number.
Program works correctly on all files, but when it try to rename file with umlaut in the filename, both of the Windows PowerShell and Command Line throw the error that Permission denied at the string with rename function.
How to solve this problem, guys?
UPD. Software:
Windows 8 x64
ActiveState ActivePerl 1601 (Perl 5.16)
Perl's readdir uses a legacy interface ("ANSI") since it can only handle file names consisting of bytes due to its unix heritage.
The "ANSI" interface uses a single-byte character encoding known as a code page. Your system's code page is 1251, and it doesn't provide a means of encoding "ä", so file names containing "ä" cannot be returned by readdir.
You need to avoid this "ANSI" interface (FindFirstFileA) and gain access to FindFirstFileW. This will provide the file name in UTF-16le, which you can pass to Win32API::File's MoveFileExW. Win32::Unicode::Dir's open+fetch does just that.
It's a dismal state of affairs. I've been meaning to address it, but it would be an extensive project.
use utf8;
use Win32 qw( );
BEGIN {
binmode(STDOUT, ':encoding(cp'.Win32::GetConsoleOutputCP().')');
binmode(STDERR, ':encoding(cp'.Win32::GetConsoleOutputCP().')');
}
use strict;
use warnings;
use feature qw( say );
use open ':encoding(UTF-8)';
use Encode qw( encode );
use Win32::Unicode::Dir qw( mvtreeW );
use Win32API::File qw( MoveFileExW );
my $dir_qfn = '.';
my $wdir = Win32::Unicode::Dir->new();
$wdir->open($dir_qfn)
or die("Can't open $dir_qfn: ".$wdir->error());
for ($wdir->fetch()) {
next if /^\.\.?\z/;
next if length() <= 5;
say;
my $o_fn = $_;
s/^..\K/./s;
my $n_fn = $_;
MoveFileExW(
encode('UTF-16le', "$dir_qfn/$o_fn\0"),
encode('UTF-16le', "$dir_qfn/$n_fn\0"),
0, # or MOVEFILE_REPLACE_EXISTING
)
or die("Can't rename $o_fn to $n_fn: $^E\n");
}
$wdir->close();
You are reading the directory as if it was in UTF-8, but you are really in Windows-1252 encoding. Lose the use open qw(...) and it should work.
Do you have access to "rename.pl"? can you do
perl rename.pl "s/^(\d\d)/$1./" *flac
?
In the unix/linux version, I'd simply change the first line:
#!perl -i.bak
Using Activestate perl on windows, where I've created the association with .pl, I can run a perl script directly from the command line.
myScript.pl
How can I do inplace editing of files if I still want to use the default association?
Sounds like a trick question, and I wonder if I am understanding you right.
perl -pi.bak myScript.pl myfiletochange
Just call perl, supply the switches and the script name, and off you go.
Now, it may be that you do not want to supply these extra arguments. If so, you can simply set the variable $^I, which will activate the inplace edit. E.g.:
$^I = ".bak"; # will set backup extension
Since you are going to be using a script you might want to do something like this:
sub edit_in_place
{
my $file = shift;
my $code = shift;
{
local #ARGV = ($file);
local $^I = '';
while (<>) {
&$code;
}
}
}
edit_in_place $file, sub {
s/search/replace/;
print;
};
if you want to create a backup then change local $^I = ''; to local $^I = '.bak';
I am using ps -C <executable name> on Linux, but the same does not work on Windows.
How can I perform the same check in Perl so that it is platform independent?
You might be able to use Win32::Process::List
use 5.12.0;
use warnings;
use Win32::Process::List;
my $P = Win32::Process::List->new();
if($P->IsError == 1) {
die $P->GetErrorText;
}
my %list = $P->GetProcesses();
foreach my $key (keys %list) {
# $list{$key} = process name, $key=PID
say sprintf("%25s %10s", $list{$key}, $key);
}
And process appropriately.