Is it possible to use Perl's move function from File::Copy or any other perl module to replace
system("mv -f /../directory1/* /../directory2/");
OR
replace a code like,
#!/usr/bin/perl -w
use strict;
use warnings;
use File::Copy;
my $dir1= "/..path../directory1";
my $dir2="/..path../directory2";
opendir DH, $dir1;
while(my $file = readdir DH) {
move "$dir1/$file" , "$dir2/$file";
}
closedir DH;
What i want to do is move all the contents from directory1 to directory2 using some Perl module, instead of writing a code for it.
Exploring the possibility of using a simple perl line, may be like,
move ("directory1/*","directory2/" ) ; using some perl module.
Related
I have a perl script and its been executing from "/root/pkt/sw/se/tool" path and would need the complete directory path inside the script.
Can you please let me know how would i get the complete path?
sample.pl
our ($tool_dir);
use strict;
use warnings;
BEGIN {
$tool_dir = $0;
my $home_path = $tool_dir
$home_path =~ s|\w*/\w*/\w*$||;
my $target_path ="obj/Linux-i686/usr/share/ddlc/lib";
$lib_dir = "$home_path$target_path";
unshift(#INC, $lib_dir);
}
And i am executing this script from "pkt/sw/se/tool" path but here i am getting only "pkt/sw/se/tool" instead of "/root/pkt/sw/se/tool"
my perl script is available under /root/pkt/sw/se/tools/sample.pl
You can use the CWD module (http://perldoc.perl.org/Cwd.html) (code take from that page)
use Cwd;
my $dir = getcwd;
use Cwd 'abs_path';
my $abs_path = abs_path($file);
or you could execute the pwd command
$cwd = `pwd`;
If you just want the directory, not the full path, you could check out an existing answer at Print current directory using Perl
Use one of the modules already mentioned, never use backticks - unless you fully understand the risks and implications of doing so. If you do want to run 'pwd' then call it via something like IPC::Run3.
Examples:
#!/usr/bin/perl
use strict;
use warnings;
use Cwd;
use IPC::Run3;
# CWD
my $working_dir_cwd = getcwd;
print "Woring Dir (Cwd): $working_dir_cwd\n";
# IPC::Run3
my ($in, $out, $err);
my #command = qw/pwd/;
run3 \#command, $in, \$out, \$err or die $?;
print "Working Dir (pwd): $out\n";
You can use FindBin to locate directory of original perl script.
use FindBin;
use lib "$FindBin::Bin/../../../obj/Linux-i686/usr/share/ddlc/lib";
I want to copy the folder from one directory to another.
For Example
I have folder in D drive like Sample it that itself contain many folder.I want to copy this sample folder with its sub folders to some other drive.Here i have done something but it copies only the files.
#!/usr/bin/env perl
use strict;
use warnings;
use File::Copy,
my $source_dir = "aa";
my $target_dir = "bb";
opendir(my $DIR, $source_dir) || die "can't opendir $source_dir: $!";
my #files = readdir($DIR);
foreach my $t (#files)
{
if(-f "$source_dir/$t" ) {
#Check with -f only for files (no directories)
copy "$source_dir/$t", "$target_dir/$t";
}
}
closedir($DIR);
Please help with this...
Thanks in advance
You need to use either the File::Copy::Recursive module, which has a number of related functions from which you probably want dircopy; or the File::Mirror module, which has a mirror function that does the same as dircopy, plus a recursive function that allows you to provide a block of code to control exactly how the nodes will be copied.
use strict;
use warnings;
use File::Copy::Recursive qw(dircopy);
dircopy($source_dir,$target_dir) or die("$!\n");
I'm trying to write a script that prints out the file structure starting at the folder the script is located in. The script works fine without the recursive call but with that call it prints the contents of the first folder and crashes with the following message: closedir() attempted on invalid dirhandle DIR at printFiles.pl line 24. The folders are printed and the execution reaches the last line but why isn't the recursive call done? And how should I solve this instead?
#!/usr/bin/perl -w
printDir(".");
sub printDir{
opendir(DIR, $_[0]);
local(#files);
local(#dirs);
(#files) = readdir(DIR);
foreach $file (#files) {
if (-f $file) {
print $file . "\n";
}
if (-d $file && $file ne "." && $file ne "..") {
push(#dirs, $file);
}
}
foreach $dir (#dirs) {
print "\n";
print $dir . "\n";
printDir($dir);
}
closedir(DIR);
}
You should always use strict; and use warnings; at the start of your Perl program, especially before you ask for help with it. That way Perl will show up a lot of straightforward errors that you may not notice otherwise.
The invalid filehandle error is likely because DIR is a global directory handle and has been closed already by a previous execution of the subroutine. It is best to always used lexical handles for both files and directories, and to test the return code to make sure the open succeeded, like this
opendir my $dh, $_[0] or die "Failed to open $_[0]: $!";
One advantage of lexical file handles is that they are closed implicitly when they go out of scope, so there is no need for your closedir call at the end of the subroutine.
local isn't meant to be used like that. It doesn't suffice as a declaration, and you are creating a temporary copy of a global variable that everything can access. Best to use my instead, like this
my #dirs;
my #files = readdir $dh;
Also, the file names you are using from readdir have no path, and so your file tests will fail unless you either chdir to the directory being processed or append the directory path string to the file name before testing it.
Use the File::Find module. The way i usually do this is using the find2perl tool which comes with perl, which takes the same parameters as find and creates a suitable perl script using File::Find. Then i fine-tune the generated script to do what i want it to do. But it's also possible to use File::Find directly.
Why not use File::Find?
use strict; #ALWAYS!
use warnings; #ALWAYS!
use File::Find;
find(sub{print "$_\n";},".");
I want to download files with .gz extension using Perl. I have wrote the following code:
#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple;
my $url = 'http://www.ebi.ac.uk/thornton-srv/databases/pdbsum/2kri/igrow.out.gz';
my $file = 'prot-prot.txt';
getstore($url, $file);
But I have realized that this code only works with text files and not compressed files. Any idea how I should change this code in order to download .gz files?
Thanks;
#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple;
my $url = 'http://www.ebi.ac.uk/thornton-srv/databases/pdbsum/2kri/igrow.out.gz';
my $file = 'igrow.out.gz';
getstore($url, $file);
If you want the perl script to unzip the file, you can either uses system() to run gunzip or search CPAN for a suitable perl module.
if you don't like typing 'igrow.out.gz twice (with the possibility of forgetting to change one of the filenames) replace $file = ... with something like
(my $file = $url) =~ s!^.*/!!;
Use File::Fetch.
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 \©_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");