Using a variable as a directory name in perl - perl

I am using a user input variable as my initial directory name, but when trying to expand the directory and create sub-folders, utilizing that variable causes issue in the path.
#!/usr/bin/perl
use strict;
use warnings;
print "What would you like to name your directory?\n";
chomp( my $directory = <STDIN> );
mkdir $directory, 0755;
mkdir $directory/data, 0755; ##<----<<Error begins here##
mkdir $directory/data/image, 0755;
mkdir $directory/data/cache, 0755;

Unquoted / in Perl means division or regular expression match. Quote it if it's part of a string:
mkdir "$directory/data", 0755;

Or try
use File::Path qw/ make_path /;
make_path( "${directory}/data/image", "${directory}/data/cache" );
it will create the intermediate directories for you.
You may also want to look at the Path::Tiny or Path::Class modules, which have a nicer OO-interface for file operations.

Related

Perl `dirname` prints dot instead of full path

I am trying to implement a perl script and I need to get a directory of my executed file.
For example if my file that I'm executing is at C:\Scripts\MyScript.pl I would like to get C:\Scripts.
I tried dirname but it does not seem to do what i want. It just prints .
I understand that I need to use dirname and abs_path together, however abs_path seems buggy to me because it returns some UNIX looking directory and then concatenates it with the actual path which obviously is invalid path in the end.
Here is my proof of concept.
# The initial variable with file
say $0; # C:\Users\sed\AppData\Roaming\npm\node_modules\my-test-module\my-test-file
# This is just a current directory
say dirname($0); # .
# This looks like a bug to me, the shell is opened in C:/Users/sed so it is related
say abs_path($0); # /c/Users/sed/C:/Users/sed/AppData/Roaming/npm/node_modules/my-test-module\my-test-file
# This is what I need, except I don't need that first UNIX looking part
say dirname(abs_path($0)); # /c/Users/sed/C:/Users/sed/AppData/Roaming/npm/node_modules/my-test-module
A quick look at:
perldoc File::Basename
shows why it may not be the best choice for what you need to do.
Please try File::Spec instead.
C:\Users\Ken> echo C:\Scripts\MyScript.pl | perl -MFile::Spec -lne "print $_; ($v,$d,$f)=File::Spec->splitpath($_); print $v.$d;"
C:\Scripts\MyScript.pl
C:\Scripts\
Type:
perldoc File::Spec
for more information. BTW, I tested with Strawberry perl v5.24.1
use FindBin qw( $RealBin );
say $RealBin;
Common use:
use lib $RealBin;
or
use lib "$RealBin/lib";
Using Strawberry Perl v5.26.1 I found that starting the script directly as in MyScript.pl gave a different result to starting it with Perl i.e. perl MyScript.pl. In the latter case I got the useless relative (dot) output.
The following worked for me in both cases:
use File::Basename;
use File::Spec;
my (undef, $this_script_folder, undef) = fileparse(File::Spec->rel2abs( __FILE__ ));

Using File::Path to create directory, but owner and group are not set correctly

I'm trying to write a small Perl script which creates a directory structure. To create the directories, I use the standard module File::Path, as follows:
make_path($directory,
{
owner => 'apache',
group => 'apache',
mode => 0500
}
);
When executing the script, the directory is created as wanted and the umask is set as expected, but both owner and group of the file are "root". This is wrong, but where is the error? No error message is printed or given by the error-parameter.
Thanks in advance,
Jost
I just tried it and got the same outcome as you. I looked at the documentation:
perldoc File::Path
...and no mention of 'owner' option. However, searching the latest version (2.08, AFAICT) documentation, and it's there. Can you check the version of the module on your system?
perl -MFile::Path -e 'print $File::Path::VERSION'
If you're not running 2.08, that might be the problem. I'm attempting to track down the changelog for the module right now, but having difficulty...
[ Later ]
OK, so here's what you want to do:
#!/usr/bin/perl -w
use strict;
use File::Path qw( make_path );
my $directory = $ARGV[0];
my $owner = 33;
make_path( $directory, { mode => 0500 } );
chown 33, 33, $directory;
Ultimately, the last line is the one you want to take note of. You can't set the owner when you create it with that version of File::Path, but you can change it. The 33 in my example is the UID of the www-data user on my system; clearly, you want to change 33 to something more sensible for your system. Also, you will need to make sure that your script runs with privileges that are capable of doing this. For example, if you run this as a lowly user, it won't work, but if you run it as root, the chown will work. You might want to find some middle ground there.
I would argue that this is a bug in File::Path; it quietly ignores keys that it doesn't recognize.
#!/usr/bin/perl
use strict;
use warnings;
use File::Path;
print "Using File::Path version $File::Path::VERSION with Perl $]\n";
my $tmpdir = "/tmp/file-path-test-$$";
print "Creating $tmpdir\n";
mkdir $tmpdir, 0777 or die "$tmpdir: $!\n";
my #result = File::Path::make_path
( "$tmpdir/new-dir",
{ owner => 'kst',
mode => 0500,
nosuchkey => 'WTF?' } );
print "Created ( #result )\n";
(Note that this assumes you have an account on your system named "kst"; adjust as needed for your system.)
When I run this under sudo using File::Path version 2.07_03 with Perl 5.010001, the created directory is owned by root; when I do exactly the same thing, but using File::Path version 2.08_01 with Perl 5.014000, the directory is owned by kst. In either case, there's no indication of a problem with the unrecognized keys (owner and nosuchkey for the older version, just nosuchkey for the newer version).
perldoc File::Path doesn't address this issue (unless I missed it), and I don't see any clean way for a program to determine whether the File::Path it's using can handle the newer options. (You could check $File::Path:VERSION, but that requires knowing when a new option was implemented.)
I've just reported this.
Answer by Kenny is useful only when you want to create single directory, not more nested directories - eg. make_path ( 'foo/bar' );
In second case only owner/group of last directory will be changed.
More correct way can be something like this:
#!/usr/bin/perl -w
use strict;
use File::Path qw( make_path );
use File::Spec;
my $directory = $ARGV[0];
my $gid = getgrnam( "my_group" );
my $uid = getpwnam( "my_user" );
make_path( $directory, { mode => 0750 } );
my #directories = File::Spec->splitdir( $directory );
my #path;
foreach my $dir ( #directories ) {
push( #path, $dir );
chown $uid, $gid, File::Spec->catdir( #path );
}

Print current directory using Perl

I have this code to print the current directory using Perl:
use Cwd qw(abs_path);
my $path = abs_path($0);
print "$path\n";
But it is displaying the filename of my script along with the directory.
Like this:
C:\Perl\duration.pl
I want it only to display C:\Perl\.
How can I do it?
To get the current working directory (pwd on many systems), you could use cwd() instead of abs_path:
use Cwd qw();
my $path = Cwd::cwd();
print "$path\n";
Or abs_path without an argument:
use Cwd qw();
my $path = Cwd::abs_path();
print "$path\n";
See the Cwd docs for details.
To get the directory your perl file is in from outside of the directory:
use File::Basename qw();
my ($name, $path, $suffix) = File::Basename::fileparse($0);
print "$path\n";
See the File::Basename docs for more details.
Each of the following snippets get the script's directory, which is not the same as the current directory. It's not clear which one you want.
use FindBin qw( $RealBin );
say $RealBin;
or
use Cwd qw( abs_path );
use File::Basename qw( dirname );
say dirname(abs_path($0));
or
use Cwd qw( abs_path );
use Path::Class qw( file );
say file(abs_path($0))->dir;
Use:
print($ENV{'PWD'});
But I think it doesn't work on Windows...
Just remove the '$0'
use Cwd qw(abs_path);
my $path = abs_path();
print "$path\n";
Here is one simple solution:
use Cwd;
my $cwd = cwd();
print "Current working directory: '$cwd()'";
I hope this will help.
You could use FindBin:
use FindBin '$RealBin';
print "$RealBin\n";
FindBin is a standard module that is installed when you install Perl. To get a list of the standard pragmatics and modules, see perldoc perlmodlib.
I used my script in dirs with symlinks.
The script parses the path and executes commands depending on the path.
I was faced with the correct determination of the current path.
Here is example:
root#srv apache # pwd
/services/apache
root#srv apache # readlink -f .
/services/apache2225
Cwd module disclosures path (analogue of readlink -f)
http://perldoc.perl.org/Cwd.html
root#server apache # perl -e 'use Cwd; print cwd . "\n";'
/services/apache2225
If you need to get current path like pwd, you can use $ENV{'PWD'}
root#srv apache # perl -e 'use Cwd; print $ENV{'PWD'}."\n";'
/services/apache
Thank you.

How can I copy a directory except for all of the hidden files in Perl?

I have a directory hierarchy with a bunch of files. Some of the directories start with a ..
I want to copy the hierarchy somewhere else, leaving out all files and dirs that start with a .
How can one do that?
I think what you want is File::Copy::Recursive's rcopy_glob():
rcopy_glob()
This function lets you specify a
pattern suitable for perl's glob() as
the first argument. Subsequently each
path returned by perl's glob() gets
rcopy()ied.
It returns and array whose items are
array refs that contain the return
value of each rcopy() call.
It forces behavior as if
$File::Copy::Recursive::CPRFComp is
true.
If you're able to solve this problem without Perl, you should check out rsync. It's available on Unix-like systems, on Windows via cygwin, and perhaps as a stand-alone tool on Windows. It will do what you need and a whole lot more.
rsync -a -v --exclude='.*' foo/ bar/
If you aren't the owner of all of the files, use -rOlt instead of -a.
Glob ignores dot files by default.
perl -lwe'rename($_, "foo/$_") or warn "failure renaming $_: $!" for glob("*")'
The code below does the job in a simple way but doesn't handle symlinks, for example.
#! /usr/bin/perl
use warnings;
use strict;
use File::Basename;
use File::Copy;
use File::Find;
use File::Spec::Functions qw/ abs2rel catfile file_name_is_absolute rel2abs /;
die "Usage: $0 src dst\n" unless #ARGV == 2;
my($src,$dst) = #ARGV;
$dst = rel2abs $dst unless file_name_is_absolute $dst;
$dst = catfile $dst, basename $src if -d $dst;
sub copy_nodots {
if (/^\.\z|^[^.]/) {
my $image = catfile $dst, abs2rel($File::Find::name, $src);
if (-d $_) {
mkdir $image
or die "$0: mkdir $image: $!";
}
else {
copy $_ => $image
or die "$0: copy $File::Find::name => $image: $!\n";
}
}
}
find \&copy_nodots => $src;
cp -r .??*
almost perfect, because it misses files beginning with . and followed by a single sign. like - .d or .e
echo .[!.] .??*
this is even better
or:
shopt -s dotglob ; cp -a * destination; shopt -u dotglob
I found File::Copy::Recursive's rcopy_glob().
The following is what is showed in the docs but is deceptive.
use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
it does not import rcopy_glob() and the only way I found to use it was to be explict as follows:
use File::Copy::Recursive;
File::Copy::Recursive::rcopy_glob("glob/like/path","dest/path");

How do I create a directory and parent directories in one Perl command?

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).