I have a scenario where i need to list all the directories under msystem on a remote machine which contains a log.txt.If it is found then get the list using ll command from the msystem directory file.How can achieve this
this is the directory structure
msystem
dir1 dir2/info/log.txt dir3/ dir4/info/log.txt
my $ssh = Net::SSH::Perl->new($hostname, protocol => '1,2', debug => 0, interactive => 1);
$ssh->login($username, $password);
($stdout,$stderr,$exit) = $ssh->cmd("$check_lock_file");
if((defined $stderr) && ($stderr =~ /No such file or directory/))
{
($stdout,$stderr,$exit) = $ssh->cmd("What command to be used and get the ouput");
if((defined $stderr) && ($stderr =~ /No such file or directory/))
{
print ""Error;
print "$stderr";
exit;
}
elsif($exit eq '0')
{
print "dir2 dir4";
}
}
You can also do that using SFTP:
use Net::SFTP::Foreign;
my $sftp = Net::SFTP::Foreign->new($hostname,
user => $user, password => $password);
my #files = $sftp->find('/path/to/mysystem',
wanted => qr{^(?:.*/)?log\.txt$});
print "$_->{longname}\n" for #files;
Though, running find in the remote host is going to be faster.
Use find with exec.
Simply:
...$ssh->cmd("find mysystem/ -name "log.txt" -exec ls -la {} \\;");
elsif($exit eq '0')
{
foreach my $line (split(/\n/,$stdout)){
print $line."\n";
}
}
Related
I'm trying to get the following perl script to work. First, a fastq-file is read, this file is then used to be analysed by a number of programs.
Code:
use warnings;
use PBS::Client;
$directory = $ARGV[0];
opendir(DIR, $directory);
#files=();
while ($file = readdir(DIR)) {
push(#files, $file);
}
closedir(DIR);
#fastq_files = grep(/fastq/, #files);
$client = PBS::Client->new();
foreach $fastq (#fastq_files){
#commands = ();
$wd = "/store/www/labresults_QC/snRNA_sequence_analyser/".$ARGV[0];
$name = $fastq."_process_map";
$queue = "system";
$wallt = "72:00:00";
chomp($fastq);
$fastq =~ /.+[^\.fastq]/;
push (#commands, "/opt/fastx_toolkit-0.0.13.2/bin/fastq_quality_filter -q 30 -p 80 -i " . $fastq . " -o ";
push (#commands, "/opt/fastx_toolkit-0.0.13.2/bin/fastx_clipper -i " . $& . "_qc.fastq -o " . $& . "_qc_clipped.fastq -v -l 15 -a TGGAATTCTCGGGTGCCAAGG -Q33\n");
push (#commands, "/opt/fastx_toolkit-0.0.13.2/bin/fastx_collapser -i " . $& . "_qc_clipped.fastq -o " . $& . "_qc_clipped_collapse.fa -v -Q33\n");
push (#commands, "/opt/bowtie-1.0.0/bowtie -f /opt/genomes/9606/GRCh37/bowtie/GRCh37 " . $& . "_qc_clipped_collapse.fa " . $& . "_mapped.sam -k 100 -n 0 -l 25 --best");
$job = PBS::Client::Job -> new(
wd => $wd,
queue => $queue,
name => $name,
wallt => $wallt,
cmd => [[#commands]]);
$client -> qsub($job);
}
However, when trying to execute through a Linux commandline, it gives this error message:
open3: exec of /store/www/labresults_QC/snRNA_sequence_analyser/data/data_raw/test_run/n8XyeYIkfv failed at /store/bin/perl_libs/lib/perl5//PBS/Client.pm line 150
The error message points to this piece of code in the PBS Client module:
#-------------------------------------------------------------------
# Thanks to Sander Hulst
sub call_qsub
{
my #args = #_;
# If the qsub command fails, for instance, pbs_server is not running,
# PBS::Client's qsub should not silently ignore. Disable any reaper
# functions so the exit code can be captured
use Symbol qw(gensym);
use IPC::Open3;
my $stdout = gensym();
my $stderr = gensym();
{
local $SIG{CHLD} = sub{};
my $pid = open3(gensym, $stdout, $stderr, #args); # This is line 150
waitpid($pid,0);
}
confess <$stderr> if ($?);
return <$stdout>;
}
#-------------------------------------------------------------------
Anyone got a clue what this means?
EDIT
After some investigation it seems that this line is failing: $client -> qsub($job);
but I don't know why. Any ideas what I'm doing wrong?
FINAL EDIT:
So, we finally found the real cause of the problem. It turned out something went wrong in the latest installation of PBS::Client we did. So we reverted to an older version, and the problem was gone!
The module generates a script then tries to execute it without having made it executable. Workaround:
use PBS::Client qw( );
BEGIN {
my $orig_genScript = \&PBS::Client::genScript;
my $new_genScript = sub {
my $script_qfn = $orig_genScript->(#_);
chmod(0700, $script_qfn) or die $!;
return $script_qfn;
};
no warnings 'redefine';
*PBS::Client::genScript = $new_genScript;
}
Im a beginner. I have written a perl script which does the following
-Create a directory under “/x01/abcd/abc_logs/abcd_Logs” by the current date, in the format of “YYYYMMDD” if it has not already been created.
i.e: if the script is run on “01st of jan 2013”, the directory “20130101” will be created under the said path. So whenever there is a need to inspect the logs always look for a directory by the current date.
-Check if the log file(s) have already been downloaded earlier within the same day, and if not log(s) will be downloaded to the TODAY’s directory.
Im having a hard time, coming up with a solution to print a message when there are no files in the share. This is of course when the user specify 2 or more files that are not there in the share. I know that this happens because there is a "die" statement in the "sub get_LOGS". I just cannot seem to understand how to return a message when all the files I specify do not happen to be in the share.
usage of this script is as follows
./abc_logs ....<file(n)>
following is the script.
my $LOGS_LOCAL_PATH = "/x02/abc/abcba2/";
chomp $LOGS_LOCAL_PATH;
my $LOGS_REM_PATH = "/x01/INT/abc/vabc2/";
chomp $LOGS_REM_PATH;
my $TODAY = `date +%Y%m%d`;
chomp $TODAY;
my #GETLOOP = #ARGV;
unless ($#ARGV >= 0) {
print "\nUsage: gtp_logs.pl <file1> <file2> <file3>.....<file(n)>\n\n";
exit;
}
system("clear");
unless ( -d "$LOGS_LOCAL_PATH"."$TODAY") {
print "Directory \"$TODAY\" doesn't exist. So creating the directory..!\n";
print "OK..Done.....!\n\n";
system("mkdir $LOGS_LOCAL_PATH/$TODAY");
}
else {
print "Directory already exists. Logs will be downloaded to ==> \"$LOGS_LOCAL_PATH$TODAY\".....!\n\n";
}
# if_DOWNLOADED($LOGS_LOCAL_PATH,$TODAY,#GETLOOP);
chdir("$LOGS_LOCAL_PATH"."$TODAY") || die "cannot cd to ($!)";
foreach my $GETL (#GETLOOP) {
my $is_downloaded = if_DOWNLOADED($LOGS_LOCAL_PATH,$TODAY,$GETL);
if(!$is_downloaded)
{
get_LOGS("172.25.70.221","abc","abc2","/x01/INT/abc",$GETL);
print "File \"$GETL\" downloaded to ==> \"$LOGS_LOCAL_PATH$TODAY\"\n\n";
}
else
{
print "File \"$GETL\" has already been Downloaded to ==> \"$LOGS_LOCAL_PATH$TODAY\"\n\n";
}
}
sub get_LOGS {
my $LOG_HOST = shift;
my $REM_USER = shift;
my $REM_PASSW = shift;
my $REM_PATH = shift;
my $REM_FILE = shift;
print "Connecting to the sftp share! Please wait....!\n";
my $sftp = Net::SFTP::Foreign->new($LOG_HOST, user => $REM_USER, password => $REM_PASSW);
$sftp->setcwd($REM_PATH) or die "unable to change cwd: " . $sftp->error;
print "OK. On the share! Downloading the file \"$REM_FILE\"...................!\n\n\n\n";
$sftp->error and die "Problem connecting to the share...!!!! " . $sftp->error;
$sftp->get($REM_FILE) or die "File does not seem to be present on the remote share. Please re-request..!!!" . $sftp->error;
return $REM_FILE;
}
sub if_DOWNLOADED {
my $DWD_FILE_PATH = shift;
my $DWD_DIR = shift;
my $DWD_FILE = shift;
if (-e "$DWD_FILE_PATH/$DWD_DIR/$DWD_FILE")
{
return 1;
}
else
{
return 0;
}
}
Please can someone help me finding a solution to this matter? Please try to use the same script and modify.
/V
Some comments to your code:
Use strict and warnings in order to catch lots of errors early.
Read some book on style (i.e. Damian Conway's Perl Best Practices). But in any case try to be consistent when naming variables, subroutines, and everything and also with their case.
When you have to use some calculated value in several places, try to calculate it once and save it in a variable.
Don't use subroutines for trivial things.
You don't need to call chomp on variables you have defined and that don't have a "\n" character at the end.
Opening a new SFTP connection for every file transfer is very inefficient. You can open just one at the beginning and use it for all the transfers.
And now, a simplified version of your script:
#!/usr/bin/perl
use strict;
use warnings;
my $host = "172.25.70.221";
my $user = "abc";
my $password = "abc1234321";
my $LOGS_LOCAL_PATH = "/x02/ABC/abc2";
my $LOGS_REM_PATH = "/x01/INT/abc/vim";
my $TODAY = `date +%Y%m%d`;
chomp $TODAY;
my $TODAY_LOCAL_PATH = "$LOGS_LOCAL_PATH/$TODAY";
my #files = #ARGV;
#files or die "\nUsage: gtp_logs.pl <file1> <file2> <file3>.....<file(n)>\n\n";
system("clear");
if ( -d $TODAY_LOCAL_PATH) {
print "Directory already exists. Logs will be downloaded to ==> \"$TODAY_LOCAL_PATH\".....!\n\n";
}
else {
print "Directory \"$TODAY\" doesn't exist. So creating the directory..!\n";
mkdir "$TODAY_LOCAL_PATH" or die "unable to create directory: $!\n";
print "OK..Done.....!\n\n";
}
chdir $TODAY_LOCAL_PATH or die "cannot cd to ($!)\n";
my $sftp = Net::SFTP::Foreign->new($host, user => $user, password => $password);
$sftp->error
and die "Problem connecting to the share...!!!! " . $sftp->error;
my $ok = 0;
my $failed = 0;
foreach my $file (#files) {
if (-e "$TODAY_LOCAL_PATH/$file") {
print "File \"$file\" has already been Downloaded to ==> \"$TODAY_LOCAL_PATH\"\n";
}
else {
if ($sftp->get("$LOGS_REM_PATH/$file")) {
print "File \"$file\" downloaded to ==> \"$TODAY_LOCAL_PATH\"\n";
$ok++;
}
else {
print "Unable to download file \"$file\" : " . $sftp->error . "\n";
$failed++;
}
}
}
print "$ok files have been downloaded, $failed files failed!\n\n";
I've hacked the script below together to let me generate traps to a test server. What I really need is something that will generate traps at a large scale so that I can check my tools on the receiving end to find out where the bottleneck is, such as UDP, Net::SNMP, Perl, etc.
I had hoped this script would let me generate something like 10k events/second but I am sadly mistaken.
Does anyone know if I can do this in Perl or have a suggestion of another way to do it?
#! /usr/bin/perl
use strict;
use warnings;
use Log::Fast;
use FindBin;
use Getopt::Long;
use File::Basename;
use Cwd qw(abs_path);
my $ROOT_DIR = abs_path("$FindBin::Bin/..");
use POSIX qw/strftime/;
use Net::SNMP qw(:ALL);
use Time::HiRes qw( time sleep );
#FIXME - I had to add below for Perl 5.10 users.
# on Perl 5.10, I would get the following when running:
# perl -e"autoflush STDOUT, 1;"
# Can't locate object method "autoflush" via package "IO::Handle" at -e line 1.
use FileHandle;
# Create default logger, will reconfigure it as soon as we read configuration from database
my $log = Log::Fast->global();
my $myname = $0;
$myname =~ s{.*/}{}; # leave just program name without path
# Command line options
my $options = {
debug => 0,
verbose => 0,
logfile => "./$myname.log",
help => 0,
community => "public",
trapsource => "127.0.0.1",
timelimit => 1,
};
sub usage_and_exit {
my ($exit_code) = #_;
print STDERR qq{
This program is used to generate SNMP traps to a specified host at a specified rate
Usage: $myname [-o --option]
-h : this (help) message
-d : debug level (0-5) (0 = disabled [default])
-v : Also print results to STDERR
-l : log file (defaults to local dir
-r : Rate (events/sec)
-ts : host to generate messages FROM
-td : host to generate messages TO
-tl : Run for this many seconds (default 1)
-c : community
Example: $myname -td 192.168.28.29 -r 1 -tl 5 -v
};
exit($exit_code);
}
GetOptions(
'debug|d=i' => \$options->{debug},
'help|h!' => \$options->{help},
'verbose|v!' => \$options->{verbose},
'logfile|l=s' => \$options->{logfile},
'rate|r=i' => \$options->{rate},
'trapsource|ts=s' => \$options->{trapsource},
'trapdest|td=s' => \$options->{trapdest},
'community|c=s' => \$options->{community},
'timelimit|tl=i' => \$options->{timelimit},
) or usage_and_exit(1); # got some invalid options
if ( $options->{help} ) {
usage_and_exit(0);
}
# Reconfigure log to use logfile (as we finally got it from $settings), also
# set proper level and output based on $options{verbose} and $options{debug}
setup_log();
# Finally we are initialized, announce this to the world :-)
$log->INFO("Program initialized successfully");
my $date = strftime "%Y-%m-%d %H:%M:%S", localtime;
# start func
my $period = 1 / $options->{rate};
my $start = time();
my $limit = time() + $options->{timelimit};
my $total = $options->{rate} * $options->{timelimit};
$log->INFO("Generating $options->{rate} trap(s) every second for $options->{timelimit} seconds (1 every $period seconds, $total total events)");
while($start < $limit) {
my $elapsed = time() - $start;
if ($elapsed < $period) {
sleep($period - $elapsed);
my ($session, $error) = Net::SNMP->session(
-hostname => $options->{trapdest},
-community => $options->{community},
-port => SNMP_TRAP_PORT, # Need to use port 162
-version => 'snmpv2c'
);
if (!defined($session)) {
$log->INFO("ERROR: %s.", $error);
exit 1;
}
my $result = $session->snmpv2_trap(
-varbindlist => [
'1.3.6.1.2.1.1.3.0', TIMETICKS, 600,
'1.3.6.1.6.3.1.1.4.1.0', OBJECT_IDENTIFIER, '1.3.6.1.4.1.326',
'1.3.6.1.6.3.18.1.3.0', IPADDRESS, $options->{trapsource}
]
);
if (!defined($result)) {
$log->INFO("ERROR: %s.", $session->error());
} else {
$log->INFO("SNMPv2-Trap-PDU sent from $options->{trapsource} to $options->{trapdest}.");
}
} else {
$start = time();
}
}
#-------------------------------------------
# There should only be subs from here down
#-------------------------------------------
# =================================================================================================
# Helper functions
# =================================================================================================
# commify not used yet
sub commify {
my $text = reverse $_[0];
$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
return scalar reverse $text;
}
sub setup_log {
my $log_dir = dirname($options->{logfile});
# Create log dir, and build log path if not provided by command line option
if ( !-d $log_dir ) {
mkdir( $log_dir, 0755 ) or die("mkdir $log_dir: $!");
}
if ( !$options->{logfile} ) {
$options->{logfile} = $log_dir . "/" . basename( $0, '.pl' ) . '.log';
}
my $log_options = {};
# Set up output to file or both file and stderr
if ( $options->{verbose} ) {
# make multiplexer FH sending data both to file and STDERR
open( my $fh, '>>:tee', $options->{logfile}, \*STDERR )
or die("$options->{logfile}: $!");
$fh->autoflush(1);
$log_options->{fh} = $fh;
}
else {
open( my $fh, '>>', $options->{logfile} ) or die("$options->{logfile}: $!");
$log_options->{fh} = $fh;
}
# Setup extra information to put in every log line, depending on debug level
if ( $options->{debug} > 1 ) {
$log_options->{prefix} = "%D %T %S [%L] ";
}
else {
$log_options->{prefix} = "%D %T [%L] ";
}
$log_options->{level} = $options->{debug} > 0 ? 'DEBUG' : 'INFO';
$log->config($log_options);
$SIG{__WARN__} = sub {
my $msg = shift;
$msg =~ s/\n//;
$log->WARN($msg);
};
$log->INFO("Starting logging to $options->{logfile} with pid $$");
}
sub DEBUG {
my ( $level, #log_args ) = #_;
if ( $options->{debug} >= $level ) {
$log->DEBUG(#log_args);
}
}
Perhaps use something like Parallel::ForkManager ? In addition, with specific regard to testing scalability of your SNMP collector, you'll probably be interested in the use case of receiving the traps from many HOSTS, not just a single host sending traps at a high rate. For that, you might want to look at using pssh.
One problem might be the slowness of Net::SNMP in pure-perl - perhaps exectuting snmptest or snmptrap via the shell might be faster ? Worth a try.
First let me state, clamd has been proven to respond correctly:
$ echo PING | nc -U /var/run/clamav/clamd.sock
PONG
the scanner was setup as follows:
#set up a Clamav scanner
use File::VirusScan;
use File::VirusScan::ResultSet;
my $scanner = File::VirusScan->new({
engines => {
'-Daemon::ClamAV::Clamd' => {
socket_name => '/var/run/clamav/clamd.sock',
},
},
});
and the whole script works fine on a Solaris 11 box. I'm running this on a Linux CentOS 5.3 (Final) I did have a problem installing File::VirusScan from CPAN, the latest version 0.102 won't compile and CPAN testers seems to confirm this as 435 fails out of 437. So I downloaded the prev 0.101 version from CPAN, the version I'm also running in Solaris and manually installed apparently ok
perl -v
This is perl, v5.8.8 built for x86_64-linux-thread-multi
sub scanner {
$|++; # buffer disabled
(my $path, my $logClean) = #_;
my $recurse = 5;
print color "yellow";
print "[i] Building file scan queue - recurse deepth $recurse \n";
print color "green";
print "SCAN QUEUE:0";
#Get list of files
if( $rootPath){
use File::Find::Rule;
my $finder = File::Find::Rule->maxdepth($recurse)->file->relative->start("$$path");
while( my $file = $finder->match() ){
$|++;
#$file = substr($file,length($rootPath)); #remove path bloat
push(#scanList,"/$file");
print "\rSCAN QUEUE:" .scalar(#scanList); #update screen
}
}else{
push(#scanList,"$$path");
}
print "\rSCANING:0";
#set up a Clamav scanner
use File::VirusScan;
use File::VirusScan::ResultSet;
my $scanner = File::VirusScan->new({
engines => {
'-Daemon::ClamAV::Clamd' => {
socket_name => '/var/run/clamav/clamd.sock',
},
},
});
#scan each file
my $scanning = 0;
my $complete = -1;
foreach $scanFile (#scanList){
$scanning++;
##################################################
#scan this file
$results = $scanner->scan($rootPath.$scanFile);
##################################################
#array of hashes
my $centDone = int(($scanning/scalar(#scanList))*100);
if($centDone > $complete){
$complete = $centDone;
}
if($centDone < 100){
#\r to clear/update line
$format = "%-9s %-60s %-15s %-5s";
printf $format, ("\rSCANING:", substr($scanFile,-50), "$scanning/".scalar(#scanList), "$centDone%");
}else{
print "\rSCAN COMPLETE ";
}
# array ref
foreach $result (#$results) {
#array of pointers to hashes
#print 'data:'
#print 'state:'
if($$result{state} ne "clean"){
if($$result{data} =~ /^Clamd returned error: 2/){
$$result{data} = "File too big to scan";
}
push(#scanResults,[$scanFile,$$result{state},$$result{data}]); # results
}elsif($$logClean){
push(#scanResults,[$scanFile,$$result{state},$$result{data}]);
}
unless($$result{state} eq "clean"){
print color "red";
print "\r$scanFile,$$result{state},$$result{data}\n";
print color "green";
print "\rSCANING: $scanning/".scalar(#scanList)." : $centDone%";
if($$result{state} eq "virus"){
push(#scanVirus,scalar(#scanResults)-1); #scanResuts index of virus
}elsif($$result{state} eq "error"){
push(#scanError,scalar(#scanResults)-1); #scanResuts index of Error
}
}
}
} print "\n";
}
Looking at the source code for the Clamd package the following script should approximate the call it is attempting and will hopefully give you a better idea of how it's failing. Try saving it to a separate file (like test.pl) and run it using "perl test.pl":
use IO::Socket::UNIX;
use IO::Select;
my $socket_name = '/var/run/clamav/clamd.sock';
my $sock = IO::Socket::UNIX->new(Peer => $socket_name);
if(!defined($sock)) {
die("Couldn't create socket for path $socket_name");
}
my $s = IO::Select->new($sock);
if(!$s->can_write(5)) {
$sock->close;
die("Timeout waiting to write PING to clamd daemon at $socket_name");
}
if(!$sock->print("SESSION\nPING\n")) {
$sock->close;
die('Could not ping clamd');
}
if(!$sock->flush) {
$sock->close;
die('Could not flush clamd socket');
}
if(!$s->can_read($self->{5})) {
$sock->close;
die("Timeout reading from clamd daemon at $socket_name");
}
my $ping_response;
if(!$sock->sysread($ping_response, 256)) {
$sock->close;
die('Did not get ping response from clamd');
}
if(!defined $ping_response || $ping_response ne "PONG\n") {
$sock->close;
die("Unexpected response from clamd: $ping_response");
}
It looks like the various antivirus engines need to be installed separately from the File::VirusScan base library. Does the following return an error?
perl -mFile::VirusScan::Engine::Daemon::ClamAV::Clamd -e ''
If it displays an error that it can't locate Clamd.pm, you need to install that engine module.
If it doesn't display an error, you'll need to post more details, such as the code you're actually using to perform the scan and/or the error output (if any).
I need to delete all content (files and folders) under a given folder. The problems is the folder has millions of files and folders inside it. So I don't want to load all the file names in one go.
Logic should be like this:
iterate a folder without load everything
get a file or folder
delete it
(verbose that the file or folder "X" was deleted)
go to the next one
I'm trying something like this:
sub main(){
my ($rc, $help, $debug, $root) = ();
$rc = GetOptions ( "HELP" => \$help,
"DEBUG" => \$debug,
"ROOT=s" => \$root);
die "Bad command line options\n$usage\n" unless ($rc);
if ($help) { print $usage; exit (0); }
if ($debug) {
warn "\nProceeding to execution with following parameters: \n";
warn "===============================================================\n";
warn "ROOT = $root\n";
} # write debug information to STDERR
print "\n Starting to delete...\n";
die "usage: $0 dir ..\n" unless $root;
*name = *File::Find::name;
find \&verbose, #ARGV;
}
sub verbose {
if (!-l && -d _) {
print "rmdir $name\n";
} else {
print "unlink $name\n";
}
}
main();
It's working fine, but whenever "find" reads the huge folder, the application gets stuck and I can see the system memory for Perl increasing until timeout. Why? Is it trying to load all the files in one go?
Thanks for your help.
The remove_tree function from File::Path can portably and verbosely remove a directory hierarchy, keeping the top directory, if desired.
use strict;
use warnings;
use File::Path qw(remove_tree);
my $dir = '/tmp/dir';
remove_tree($dir, {verbose => 1, keep_root => 1});
Pre-5.10, use the rmtree function from File::Path. If you still want the top directory, you could just mkdir it again.
use File::Path;
my $dir = '/tmp/dir';
rmtree($dir, 1); # 1 means verbose
mkdir $dir;
The perlfaq points out that File::Find does the hard work of traversing a directory, but the work isn't that hard (assuming your directory tree is free of named pipes, block devices, etc.):
sub traverse_directory {
my $dir = shift;
opendir my $dh, $dir;
while (my $file = readdir($dh)) {
next if $file eq "." || $file eq "..";
if (-d "$dir/$file") {
&traverse_directory("$dir/$file");
} elsif (-f "$dir/$file") {
# $dir/$file is a regular file
# Do something with it, for example:
print "Removing $dir/$file\n";
unlink "$dir/$file" or warn "unlink $dir/$file failed: $!\n";
} else {
warn "$dir/$file is not a directory or regular file. Ignoring ...\n";
}
}
closedir $dh;
# $dir might be empty at this point. If you want to delete it:
if (rmdir $dir) {
print "Removed $dir/\n";
} else {
warn "rmdir $dir failed: $!\n";
}
}
Substitute your own code for doing something with a file or (possibly) empty directory, and call this function once on the root of the tree that you want to process. Lookup the meanings of opendir/closedir, readdir, -d, and -f if you haven't encountered them before.
What's wrong with:
`rm -rf $folder`; // ??
You can use File::Find to systematically traverse the directory and delete the files and directories under it.
OK, I gave in and used Perl builtins but you should use File::Path::rmtree which I had totally forgotten about:
#!/usr/bin/perl
use strict; use warnings;
use Cwd;
use File::Find;
my ($clean) = #ARGV;
die "specify directory to clean\n" unless defined $clean;
my $current_dir = getcwd;
chdir $clean
or die "Cannot chdir to '$clean': $!\n";
finddepth(\&wanted => '.');
chdir $current_dir
or die "Cannot chdir back to '$current_dir':$!\n";
sub wanted {
return if /^[.][.]?\z/;
warn "$File::Find::name\n";
if ( -f ) {
unlink or die "Cannot delete '$File::Find::name': $!\n";
}
elsif ( -d _ ) {
rmdir or die "Cannot remove directory '$File::Find::name': $!\n";
}
return;
}
Download the unix tools for windows and then you can do rm -rv or whatever.
Perl is a great tool for a lot of purposes, but this one seems better done by a specialised tool.
Here's a cheap "cross-platform" method:
use Carp qw<carp croak>;
use English qw<$OS_NAME>;
use File::Spec;
my %deltree_op = ( nix => 'rm -rf %s', win => 'rmdir /S %s' );
my %group_for
= ( ( map { $_ => 'nix' } qw<linux UNIX SunOS> )
, ( map { $_ => 'win' } qw<MSWin32 WinNT> )
);
my $group_name = $group_for{$OS_NAME};
sub chop_tree {
my $full_path = shift;
carp( "No directory $full_path exists! We're done." ) unless -e $full_path;
croak( "No implementation for $OS_NAME!" ) unless $group_name;
my $format = $deltree_op{$group_name};
croak( "Could not find command format for group $group_name" ) unless $format;
my $command = sprintf( $format, File::Spec->canonpath( $full_path ));
qx{$command};
}