I have a problem with detecting symbolic links under Windows 10, which supports them. First I tried this:
if(! -l $import_filename) {
print "$0: $import_filename is not a symlink";
}
That doesn't work. It gets executed when $import_filename is a symlink. Then I tried this:
use File::stat;
use Fcntl;
my $statbuf = lstat($import_filename);
if(!($statbuf->mode & S_ISLNK)) {
print "$0: $import_filename is not a symlink";
}
And it seems to be a different way to say the same thing. As expected, is there any blessed way to do this under Windows versions with symlink/junction support? If there isn't, a command line tool is also an acceptable answer.
Given
>mklink file_symlink file
symbolic link created for file_symlink <<===>> file
>mklink /d dir_symlink dir
symbolic link created for dir_symlink <<===>> dir
>mklink /h file_hardlink file
Hardlink created for file_hardlink <<===>> file
>mklink /j dir_hardlink dir
Junction created for dir_hardlink <<===>> dir
>dir
...
2018-05-09 12:59 AM <JUNCTION> dir_hardlink [C:\...\dir]
2018-05-09 12:58 AM <SYMLINKD> dir_symlink [dir]
2018-05-09 12:56 AM 6 file_hardlink
2018-05-09 12:58 AM <SYMLINK> file_symlink [file]
...
You can use the following to detect file_symlink, dir_symlink and dir_hardlink (but not file_hardlink) as a link:
use Win32API::File qw( GetFileAttributes FILE_ATTRIBUTE_REPARSE_POINT );
my $is_link = GetFileAttributes($qfn) & FILE_ATTRIBUTE_REPARSE_POINT;
I don't know how to distinguish between hard links and symlinks (though differentiating between files and dirs can be done using & FILE_ATTRIBUTE_DIRECTORY).
There seem to be not much Perl support for working with symlinks on Windows (if any). Neither of related builtins are implemented, according to perlport page for symlink and for readlink.
Most importantly for your direct question, lstat isn't implemented either so one can't have a filetest for symlink. The perlport for -X says that
-g, -k, -l, -u, -A are not particularly meaningful.
I haven't found anything on CPAN, other than using the Windows API.
Then you can go to the Windows command line, and look for <SYMLINK> in dir output
# Build $basename and $path from $import_filename if needed
if ( not grep { /<SYMLINK>.*$basename/ } qx(dir $path) ) {
say "$0: $import_filename is not a symlink";
}
where $basename need be used since dir doesn't show the path. The components of a filename with full path can be obtained for example with the core module File::Spec
use File::Spec;
my ($vol, $path, $basename) = File::Spec->splitpath($import_filename);
If the filename has no path then $vol and $path are empty strings, which is OK for dir as it needs no argument for the current directory. If $import_filename by design refers to the current directory (has no path) then use it in the regex, with qx(dir) (no argument).
The dir output shows the target name as well, what can come in handy.
Related
I'm very new to Perl, and I would like to make a program that creates a directory and moves a file into that directory using the Unix command like:
mkdir test
Which I know would make a directory called "test". From there I would like to give more options like:
mv *.jpg test
That would move all .jpg files into my new directory.
So far I have this:
#!/usr/bin/perl
print "Folder Name:";
$fileName = <STDIN>;
chomp($fileType);
$result=`mkdir $fileName`;
print"Your folder was created \n";
Can anyone help me out with this?
Try doing this :
#!/usr/bin/perl
use strict; use warnings;
print "Folder Name:";
$dirName = <STDIN>;
chomp($dirName);
mkdir($dirName) && print "Your folder was created \n";
rename $_, "$dirName/$_" for <*.jpg>;
You will have a better control when using built-in perl functions than using Unix commands. That's the point of my snippet.
Most (if not all) Unix commands have a corresponding version as a function
e.g
mkdir - see here
mv - See here
Etc. either get a print out of the various manual pages (or probably have a trip down to the book shop - O'Reilly nut shell book is quite good along with others).
In perl you can use bash commands in backticks. However, what happens when the directory isn't created by the mkdir command? Your program doesn't get notified of this and continues on its merry way thinking that everything is fine.
You should use built in command in perl that do the same thing.
http://perldoc.perl.org/functions/mkdir.html
http://perldoc.perl.org/functions/rename.html
It is much easier to trap errors with those functions and fail gracefully. In addition, they run faster because you don't have to fork a new process for each command you run.
Perl has some functions similar to those of the shell. You can just use
mkdir $filename;
You can use backquotes to run a shell command, but it is only usefull if the command returns anything to its standard output, which mkdir does not. For commands without output, use system:
0 == system "mv *.jpg $folder" or die "Cannot move: $?";
How do I run a Perl script on multiple input files with the same extension?
perl scriptname.pl file.aspx
I'm looking to have it run for all aspx files in the current directory
Thanks!
In your Perl file,
my #files = <*.aspx>;
for $file (#files) {
# do something.
}
The <*.aspx> is called a glob.
you can pass those files to perl with wildcard
in your script
foreach (#ARGV){
print "file: $_\n";
# open your file here...
#..do something
# close your file
}
on command line
$ perl myscript.pl *.aspx
You can use glob explicitly, to use shell parameters without depending to much on the shell behaviour.
for my $file ( map {glob($_)} #ARGV ) {
print $file, "\n";
};
You may need to control the possibility of a filename duplicate with more than one parameter expanded.
For a simple one-liner with -n or -p, you want
perl -i~ -pe 's/foo/bar/' *.aspx
The -i~ says to modify each target file in place, and leave the original as a backup with an ~ suffix added to the file name. (Omit the suffix to not leave a backup. But if you are still learning or experimenting, that's a bad idea; removing the backups when you're done is a much smaller hassle than restoring the originals from a backup if you mess something up.)
If your Perl code is too complex for a one-liner (or just useful enough to be reusable) obviously replace -e '# your code here' with scriptname.pl ... though then maybe refactor scriptname.pl so that it accepts a list of file name arguments, and simply use scriptname.pl *.aspx to run it on all *.aspx files in the current directory.
If you need to recurse a directory structure and find all files with a particular naming pattern, the find utility is useful.
find . -name '*.aspx' -exec perl -pi~ -e 's/foo/bar/' {} +
If your find does not support -exec ... + try with -exec ... \; though it will be slower and launch more processes (one per file you find instead of as few as possible to process all the files).
To only scan some directories, replace . (which names the current directory) with a space-separated list of the directories to examine, or even use find to find the directories themselves (and then perhaps explore -execdir for doing something in each directory that find selects with your complex, intricate, business-critical, maybe secret list of find option predicates).
Maybe also explore find2perl to do this directory recursion natively in Perl.
If you are on Linux machine, you could try something like this.
for i in `ls /tmp/*.aspx`; do perl scriptname.pl $i; done
For example to handle perl scriptname.pl *.aspx *.asp
In linux: The shell expands wildcards, so the perl can simply be
for (#ARGV) {
operation($_); # do something with each file
}
Windows doesn't expand wildcards so expand the wildcards in each argument in perl as follows. The for loop then processes each file in the same way as above
for (map {glob} #ARGV) {
operation($_); # do something with each file
}
For example, this will print the expanded list under Windows
print "$_\n" for(map {glob} #ARGV);
You can also pass the path where you have your aspx files and read them one by one.
#!/usr/bin/perl -w
use strict;
my $path = shift;
my #files = split/\n/, `ls *.aspx`;
foreach my $file (#files) {
do something...
}
In Perl, how can I create a subdirectory and, at the same time, create parent directories if they do not exist? Like UNIX's mkdir -p command?
use File::Path qw(make_path);
make_path("path/to/sub/directory");
The deprecated mkpath and preferred make_path stemmed from a discussion in Perl 5 Porters thread that's archived here.
In a nutshell, Perl 5.10 testing turned up awkwardness in the argument parsing of the makepath() interface. So it was replaced with a simpler version that took a hash as the final argument to set options for the function.
Use mkpath from the File::Path module:
use File::Path qw(mkpath);
mkpath("path/to/sub/directory");
Kindly ignore if you are looking for a Perl module with 'mkdir -p' functionality but the following code would work:
my $dir = '/root/example/dir';
system ("mkdir -p $dir 2> /dev/null") == 0
or die "failed to create $dir. exiting...\n";
You can use a module but then you have to install it on each server you are going to port your code on. I usually prefer to use system function for a work like mkdir because it's a lesser overhead to import and call a module when I need it only once to create a directory.
ref http://perldoc.perl.org/File/Path.html
"The make_path function creates the given directories if they don't exists [sic!] before, much like the Unix command mkdir -p"
mkdir() allows you to create directories in your Perl script.
Example:
use strict;
use warnings;
my $directory = "tmp";
unless(mkdir($directory, 0755)) {
die "Unable to create $directory\n";
This program create a directory called "tmp" with permissions set to 0755 (only the owner has the permission to write to the directory; group members and others can only view files and list the directory contents).
I'm trying to create a process that renames all my filenames to Camel/Capital Case. The closest I have to getting there is this:
perl -i.bak -ple 's/\b([a-z])/\u$1/g;' *.txt # or similar .extension.
Which seems to create a backup file (which I'll remove when it's verified this does what I want); but instead of renaming the file, it renames the text inside of the file. Is there an easier way to do this? The theory is that I have several office documents in various formats, as I'm a bit anal-retentive, and would like them to look like this:
New Document.odt
Roffle.ogg
Etc.Etc
Bob Cat.flac
Cat Dog.avi
Is this possible with perl, or do I need to change to another language/combination of them?
Also, is there anyway to make this recursive, such that /foo/foo/documents has all files renamed, as does /foo/foo/documents/foo?
You need to use rename .
Here is it's signature:
rename OLDNAME,NEWNAME
To make it recursive, use it along with File::Find
use strict;
use warnings;
use File::Basename;
use File::Find;
#default searches just in current directory
my #directories = (".");
find(\&wanted, #directories);
sub wanted {
#renaming goes here
}
The following snippet, will perform the code inside wanted against all the files that are found. You have to complete some of the code inside the wanted to do what you want to do.
EDIT: I tried to accomplish this task using File::Find, and I don't think you can easily achieve it. You can succeed by following these steps :
if the parameter is a dir, capitalize it and obtain all the files
for each file, if it's a dir, go back at the beginning with this file as argument
if the file is a regular file, capitalize it
Perl just got in my way while writing this script. I wrote this script in ruby :
require "rubygems"
require "ruby-debug"
# camelcase files
class File
class << self
alias :old_rename :rename
end
def self.rename(arg1,arg2)
puts "called with #{arg1} and #{arg2}"
self.old_rename(arg1,arg2)
end
end
def capitalize_dir_and_get_files(dir)
if File.directory?(dir)
path_c = dir.split(/\//)
#base = path_c[0,path_c.size-1].join("/")
path_c[-1].capitalize!
new_dir_name = path_c.join("/")
File.rename(dir,new_dir_name)
files = Dir.entries(new_dir_name) - [".",".."]
files.map! {|file| File.join(new_dir_name,file)}
return files
end
return []
end
def camelize(dir)
files = capitalize_dir_and_get_files(dir)
files.each do |file|
if File.directory?(file)
camelize(file.clone)
else
dir_name = File.dirname(file)
file_name = File.basename(file)
extname = File.extname(file)
file_components = file_name.split(/\s+/)
file_components.map! {|file_component| file_component.capitalize}
new_file_name = File.join(dir_name,file_components.join(" "))
#if extname != ""
# new_file_name += extname
#end
File.rename(file,new_file_name)
end
end
end
camelize(ARGV[0])
I tried the script on my PC and it capitalizes all dirs,subdirs and files by the rule you mentioned. I think this is the behaviour you want. Sorry for not providing a perl version.
Most systems have the rename command ....
NAME
rename - renames multiple files
SYNOPSIS
rename [ -v ] [ -n ] [ -f ] perlexpr [ files ]
DESCRIPTION
"rename" renames the filenames supplied according to the rule specified as the first argument. The perlexpr argument is a Perl expression which
is expected to modify the $_ string in Perl for at least some of the filenames specified. If a given filename is not modified by the expression,
it will not be renamed. If no filenames are given on the command line, filenames will be read via standard input.
For example, to rename all files matching "*.bak" to strip the extension, you might say
rename 's/\.bak$//' *.bak
To translate uppercase names to lower, you’d use
rename 'y/A-Z/a-z/' *
OPTIONS
-v, --verbose
Verbose: print names of files successfully renamed.
-n, --no-act
No Action: show what files would have been renamed.
-f, --force
Force: overwrite existing files.
AUTHOR
Larry Wall
DIAGNOSTICS
If you give an invalid Perl expression you’ll get a syntax error.
Since Perl runs just fine on multiple platforms, let me warn you that FAT (and FAT32, etc) filesystems will ignore renames that only change the case of the file name. This is true under Windows and Linux and is probably true for other platforms that support the FAT filesystem.
Thus, in addition to Geo's answer, note that you may have to actually change the file name (by adding a character to the end, for example) and then change it back to the name you want with the correct case.
If you will only rename files on NTFS filesystems or only on ext2/3/4 filesystems (or other UNIX/Linux filesystems) then you probably don't need to worry about this. I don't know how the Mac OSX filesystem works, but since it is based on BSDs, I assume it will allow you to rename files by only changing the case of the name.
I'd just use the find command to recur the subdirectories and mv to do the renaming, but still leverage Perl to get the renaming right.
find /foo/foo/documents -type f \
-execdir bash -c 'mv "$0" \
"$(echo "$0" \
| perl -pe "s/\b([[:lower:]])/\u\$1/g; \
s/\.(\w+)$/.\l\$1/;")"' \
{} \;
Cryptic, but it works.
Another one:
find . -type f -exec perl -e'
map {
( $p, $n, $s ) = m|(.*/)([^/]*)(\.[^.]*)$|;
$n =~ s/(\w+)/ucfirst($1)/ge;
rename $_, $p . $n . $s;
} #ARGV
' {} +
Keep in mind that on case-remembering filesystems (FAT/NTFS), you'll need to rename the file to something else first, then to the case change. A direct rename from "etc.etc" to "Etc.Etc" will fail or be ignored, so you'll need to do two renames: "etc.etc" to "etc.etc~" then "etc.etc~" to "Etc.Etc", for example.
Currently, my Perl output is hard-coded to dump into the following Unix directory:
my $stat_dir = "/home/courses/" . **NEED DIR VAR HERE**;
The filename is built as such:
$stat_file = $stat_dir . "/" . $sess.substr($yr, 2, 2) . "_COURSES.csv";
I need a similar approach to building Unix directories, but I need to check if they exist first before creating them.
How can I do auto-numbering (revisions) of the $stat_file so that when these files get pumped into the same directory, they do not overwrite or append to existing files in the directory?
Erm... mkdir $stat_dir unless -d $stat_dir?
It really doesn't seem like a good idea to embed 'extra' questions like that.
Use the -d operator and File::Path.
use File::Path qw(make_path);
eval { make_path($dir) };
if ($#) {
print "Couldn't create $dir: $#";
}
make_path has an advantage over mkdir in that it can create trees of arbitrary depth.
And use -e to check file exists
my $fileSuffix = 0;
while (-e $filename) {
$filename = $filePrefix . ++$fileSuffix . $fileExtension;
}
Remember the directory's -d existence doesn't mean -w writable. But assuming you're in a personal area the mkdir($dir) unless(-d $dir) would work fine.
Perl has a built-in function mkdir
Take a look at perldoc perlfunc or the mkdir program from Perl Power Tools.
I believe it is safe to create a directory that already exists, take a look at the docs.