I want to get all elements in clearcase, store them in an array, and then remove the symbolic links from that array. Problem is I don't know how to remove all elements in one array that are contained in another array since I'm new to perl.
Bellow is my code so far.
foreach ${dir} (#{code_vob_list})
{
${dir} =~ s/\n//;
open(FIND_FILES, "$cleartool find ${dir} -type f -exec 'echo \$CLEARCASE_PN' |") or die "Can't stat cleartool or execute : $!\n"; #This command gets all files
#{files_found} = <FIND_FILES>;
open(SYMBOLIC_FIND_FILES, "$cleartool find ${dir} -type l -exec 'echo \$CLEARCASE_PN' |") or die "Can't stat cleartool or execute : $!\n"; #This command get all symbolic links
#{symbolic_files_found} = <SYMBOLIC_FIND_FILES>;
#Filter away all strings contained in #{symbolic_files_found} from #{files_found}
foreach my ${file} (#{files_found})
{
#Here I will perform my actions on #{files_found} that not contains any symbolic link paths from #{symbolic_files_found}
}
}
Thanks in advance
To filter an array, you can use grep:
my #nonlinks = grep { my $f = $_;
! grep $_ eq $f, #symbolic_files_found }
#files_found;
But it's usually cleaner to use a hash.
my %files;
#files{ #files_found } = (); # All files are the keys.
delete #files{ #symbolic_files_found }; # Remove the links.
my #nonlinks = keys %files;
I suggest that you install and use List::Compare. The code would look like this
As I wrote in my comment, I'm not sure if you prefer to write your identifiers like that, and I'm also unclear if you've avoided backticks `...` (same as qx{...}) in favour of a pipe open for a reason, but this is closer to how I'd write your code
If you prefer, get_unique has a synonym get_Lonly which you may find more expressive
use List::Compare;
for my $dir ( #code_vob_list ) {
chomp $dir;
my #files_found = qx{$cleartool find $dir -type f -exec 'echo \$CLEARCASE_PN'};
chomp #files_found;
my #symbolic_files_found = qx{$cleartool find $dir -type l -exec 'echo \$CLEARCASE_PN'};
chomp #symbolic_files_found;
my $lc = List::Compare->new('--unsorted', \#files_found, \#symbolic_files_found);
my #unique = $lc->get_unique;
}
Related
Need to loop through a Unix directory and search each line in each file. If there is a pattern match delete the line. Was not able to get the line deletion to work so i'm just trying to find pattern and replace with another.
Populating an array with file names and looping through. I have a counter set it's looking at each of the lines in each file (at least they count is correct).
#!/usr/bin/perl -l
#!/usr/bin/perl -i.bak -w
#!/usr/bin/env perl
use strict;
use warnings;
use File::Find;
# 4-1-19
# pfs
# remove lines with dental code ADD2999 from all HMO Max load files in /home/hsxxx/dat/feeLoad directory
$| = 1;
chdir "/home/hstrn/dat/feeLoad";
chdir;
my $dir = </home/hstrn/dat/feeLoad/>;
my #files;
my $count=0;
opendir(DIR, $dir) or die "Cannot open directory $dir, Perl says $!\n";
while (my $file = readdir DIR)
{
push #files, "$dir/$file" unless -d "$dir/$file";
}
closedir DIR;
{
local #ARGV = #files;
while (<>)
{
s/ADD2999/sometext/g;
$count++;
}
print "Total lines read are: $count";
}
Would expect all strings ADD2999 to be replaced with sometext
To remove lines, you need to avoid printing them when writing to the new file. Your code doesn't write to any files at all???
This might be a job for existing tools.
find /home/hstrn/dat/feeLoad -maxdepth 1 -type f \
-exec perl -i~ -ne'print if !/ADD2999/' {} +
Use -i instead of -i~ if you want to avoid creating a backup. I prefer creating the backups, then deleting them once I've confirmed that everything is ok.
Show the files that are going to get deleted:
find /home/hstrn/dat/feeLoad -maxdepth 1 -type f -name '*~'
Delete the files:
find /home/hstrn/dat/feeLoad -maxdepth 1 -type f -name '*~' -delete
This would be my first attempt at the problem, but it could use some more corner case checking. E.g. how do you handle write-protected files, etc. It also assumes that the files are small enough to fit into memory for processing.
#!/usr/bin/perl
use warnings;
use strict;
use autodie;
use File::Spec;
use File::Slurper qw(read_text write_text);
my $count = 0;
my $dir = "tmp";
opendir(my $dh, $dir);
while (readdir $dh) {
# skip anything that shouldn't be processed
next if /^\.\.?$/; # . && ..
my $file = File::Spec->catfile($dir, $_);
next if -d $file; # directories
# slurp file content and replace text
my $content = read_text($file);
my $matches = ($content =~ s/ADD2999/sometext/g);
# count lines
my #eols = ($content =~ /(\n)/g);
$count += #eols;
# replace original file if contents were modified
write_text($file, $content) if $matches;
}
closedir($dh);
print "Total lines read are: $count\n";
exit 0;
Test run:
$ wc -l tmp/test*.txt
5 tmp/test2.txt
6 tmp/test.txt
11 total
$ fgrep ADD2999 tmp/*.txt
tmp/test2.txt:asddsada ADD2999 asdsadasd
tmp/test2.txt:21312398 ADD2999 dasdas
$ perl dummy.pl
Total lines read are: 11
$ fgrep ADD2999 tmp/*.txt
$ fgrep sometext tmp/*.txt
tmp/test2.txt:asddsada sometext asdsadasd
tmp/test2.txt:21312398 sometext dasdas
If the files are large you will need to use line-by-line processing approach (just showing the contents of the loop). That has the side-effect that all files will be touched, although they might not have any replacements in it:
# read file and replace text
open(my $ifh, '<', $file);
my $tmpfile = File::Spec->catfile($dir, "$_.$$");
open(my $ofh, '>', $tmpfile);
while (<$ifh>) {
s/ADD2999/sometext/g;
print $ofh $_;
}
$count += $.; # total lines in $ifh
close($ofh);
close($ifh);
# replace original file with new file
unlink($file);
rename($tmpfile, $file);
My requirement is to check if a nested directory structure is having any binary file or not.
The directory structure looks something like this:
DIR-A
|
|--DIR-X
| |
| |--DIR-X1
| |--DIR-X2
|
|--DIR-Y
| |
| |--DIR-Y1
| |--DIR-Y2
| |--DIR-Y3
|
|--DIR-Z
| |
| |--DIR-Z1
| |--DIR-Z2
| |--DIR-Z3
At any point in time there can be more directories at Level-1 or Level-2 i.e. there can be some more directories i.e. DIR-P, DIR-Q etc at level-1 and there can be DIR-X3 or DIR-Y4 at level-2.
I have written a sample code but it exits if it finds DIR-X1, Ideally it should exit if there is a binary file inside the directory.
#!/usr/bin/perl
my $someDir = "/path/of/DIR-A";
my #files = ();
my $file;
my $i=0;
opendir(DIR, "$someDir") or die "Cant open $someDir: $!\n";
#files = readdir(DIR);
foreach $file(#files)
{
unless ($file =~ /^[.][.]?\z/)
{
print "$i : $file \n";
$i++;
last;
}
}
if ($i != 0)
{
print "The directory contains files! \n";
exit 1;
}
else
{
print "This DIR-A is Empty! \n";
exit 0;
}
closedir(DIR);
Please suggest me get to the expected solution as below:
read DIR-A
print SUCCESS, if none of the nested directories have a binary file.
print ERROR, if at least one of the nested directories has a binary file.
Thanks!
Use File::Find::Rule
#!/usr/bin/env perl
use strict;
use warnings;
use File::Find::Rule;
my $someDir = "/path/of/DIR-A";
my #files = File::Find::Rule->file()
->name('*.bin')
->in($someDir);
This will get you all files with the extension '.bin'.
If you need to perform a per file test to check that they are 'binary' then you can use grep on your list of #files.
my #files = grep {-B} File::Find::Rule->file()
->in($someDir);
print "Binary files found\n" if #files;
Also:
use strict; use warnings;. It's good.
Code formatting is a really good thing. perltidy -pbp makes it easy.
I am unclear as to what a binary file is for your test. I am assuming that any file found in the directory structure traversed is a binary file. Using File::Find, which is a core module:
use File::Find;
my $error = 0;
find(\&wanted, #ARGV);
if( $error ) {
print "ERROR, $error files found\n";
}
else {
print "SUCCESS\n";
}
sub wanted {
if( -f $_ ) {
$error++;
}
}
You may add any test to the wanted function. The find function will invoke the function provided for each file found in the list of directories that is also passed, which will be traversed recursively in depth-first search order (much like the find command does.) Passing it #ARGV you may invoke the script with a list of directories as required (maybe using shell expansion like DIR-*.)
The test function will get the file name being traversed in $_, while the current working directory is set to the directory that contains the file.
You can use below script to find if binary file exist or not recursively.
#! /usr/bin/env perl
use warnings;
use strict;
use File::Find;
my $path="/path/of/DIR-A";
sub find_binary {
my $file = $File::Find::name;
if (-B $file && ! -d $file) {
print "ERROR: At least one of the nested directories has a binary file : $file\n";
exit;
}
}
find(\&find_binary,$path);
print("SUCCESS: None of the nested directories have a binary file. \n");
Use (warning: my) module File::Globstar:
use v5.10;
use File::Globstar qw(globstar);
my $dir = $ARGV[0] // '.';
say join "\n", grep { -B && ! -d } globstar "$dir/**";
If you want the list of files in a list, assign it instead of printing it:
my #nondirs = grep { -B && ! -d } globstar "$dir/**";
If you know the extender of the files, you can also do this:
my #nondirs = grep { -B && ! -d } globstar "$dir/**/*.png";
Note that the file test -B produces a truthy value for empty files which is maybe not what you want. In that case change the test to -B && -s && ! -d.
I'm trying to use the Unix/AIX find command piped to the head command to return the first file in a directory and assign it to a variable. However, all of my attempts have resulted in the all the files that find returns being assigned to the variable without the head command being applied.
Here's are my three attempts:
Attempt 1:
$first_file = `/usr/bin/find $my_path -type f -name $potential_file_names | head -n1`;
Attempt 2:
$first_file = `/usr/bin/find $my_path -type f -name $potential_file_names '|' head -n1`;
Attempt 3:
$first_file = `/usr/bin/find $my_path -type f -name $potential_file_names \\| head -n1`;
The $potential_file_names variable is a string with wildcard characters to return any file in the directory that's in the format "fileXXX.txt" where 'XXX' is a three digit number.
$potential_file_names = 'file???.txt';
The first attempt doesn't work because Perl appears to take exception to the pipe as it returns error, "sh[2]: 0403-057.
First attempt output:
file001.txt
file002.txt
file003.txt
file004.txt
file005.txt
The second and third attempts also fail. The error for them is, "sh[2]: |: not found."
The output for the second and third attempts is the same as the first attempt.
Is it possible to use the find command piped to head to return the first file in the directory I'm searching (in my case, "file001.txt"?
Update
I should mention that the file names may not start with 001, so I'll need the oldest file. The files are created sequentially, so grabbing the first file using find and piping to head -n1 works from the command line outside the script. It needs to be the oldest/first file because I'll be deleting files using a loop later in the script and this needs to find the oldest/first file for each iteration.
Thanks.
Try something like this:
open EXE, qq{/usr/bin/find $my_path -type f -name $potential_file_names | head -n1}
or die qq{Error running command $!};
my $file = <EXE>;
close(EXE);
Avoid using system and backticks when there are pure Perl equivalents; your code will be more portable and you won't have to worry about nasty shell quoting issues.
If you don't care about subdirectories, you can use readdir to get a list of files inside a particular directory:
#!/usr/bin/perl
use strict;
use warnings;
my $dir = 'foo';
opendir my $dh, $dir or die $!;
my #files = sort { -M "$dir/$b" <=> -M "$dir/$a" }
grep { /^file\d{3}\.txt$/ && -f "$dir/$_" } readdir $dh;
closedir $dh;
print $files[0];
This prints the name of the file with the oldest modified date, although you could certainly use another file test instead.
If you also want to search inside subdirectories, you can use File::Find, which is a core module:
use File::Find;
use File::Spec;
my #files;
my $dir = 'foo';
find(sub { push #files, $File::Find::name if /^file\d{3}\.txt$/ and -f $_; }, $dir);
my #sorted = sort { -M $b <=> -M $a } #files;
print $sorted[0];
This prints the path to the file with the oldest modified date.
Okay, some of the answers create a dogs breakfast for follow on coders but do point in the correct direction, with the module 'use File::Find;'
Sample of how I use it.
find (\&wanted, $directory); # start searching the path
sub wanted {
my $file = $File::Find::name;
if (-d $file ) {
$directoryMap{$file} = $file;
return;
}
if (-z $file) {
$zeroHash{$file} = 1;
return;
}
if ($file =~ /(AAF|MXF|NSV|Ogg|RM|SVI|SMI|WMV)$/i) {
my $size = -s $file;
if ($size) {
$hashmap{$file} = $size;
return;
}
else {
$rejectMap{$file} = 1;
return;
}
}
else {
$rejectMap{$file} = 1;
return;
}
}
I use this to look for specific files with a specific extension and then I stuff them into a hash - the whole code an be found in my github in my Perl Diretory (https://github.com/alexmac131/mediaData). you can change the wanted to something useful for you.
I need to find for a certain dirname, i have a code which greps for the latest-file . Could someone help me to find the ls -ltr dirname* without using the ls -ltr command in the perl script. Below code may help:
my $dir = "/abc/pqr/xyz";
opendir(my $DH, $dir) or die "Error opening $dir: $!";
my %files = map { $_ => (stat("$dir/$_"))[9] } grep(! /^\.\.?$/, readdir($DH));
closedir($DH);
my #sorted_files = sort { $files{$b} <=> $files{$a} } (keys %files);
print "the file is $sorted_files[0] \n";
I need a to find a dir name as new_123 in /abc/pqr/xyz. As ls -ltr new*, as these directories are created everyday so looking for new*.
Its a bit unclear what you are asking for, but:
I need a to find a dir name as new_123 in /abc/pqr/xyz. As ls -ltr
new*, as these directories are created everyday so looking for new*.
For that, you can use glob.
My PERL is a bit rusty but I think this would do it:
while (my $dir = glob("new*")) {
next unless (-d "$dir");
print "$dir\n";
}
If system calls are not a restriction, you can use find:
find /some/path/ -type d -name "new*"
I have a folder called Client which contains many subfolders. I want to create a Perl script to look at each of those subfolders and check for a folder there. If it is there, I want to skip it and move on, if it is not there, I want to create it and do some processing.
How do I go about looping through all of the subfolders and checking for the directory I want? I have found a lot of information on how to get all the files in a folder and/or subfolders, but nothing on checking for a directory within each subfolder.
Augh! Too much complexity in the other answers. The original question doesn't appear to be asking for a recursive traversal. As far as I can see, this is a perfectly sensible solution, and vastly more readable to boot:
foreach my $dir (glob "Client/*") {
next if ! -d $dir; # skip if it's not a directory
next if -d "$dir/subfolder"; # skip if subfolder already exists
mkdir "$dir/subfolder" or die; # create it
do_some_processing(); # do some processing
}
Seriously folks: opendir/readdir? Really?
It's pretty easy once you break it into steps. Get a list of the subdirectories with glob then see which ones don't have the second-level directory. If you are using a File::Find-like module, you are probably doing too much work:
#!perl
use strict;
use warnings;
use File::Spec::Functions;
my $start = 'Clients';
my $subdir = 'already_there';
# #queue is the list of directories you need to process
my #queue = grep { ! -d catfile( $_, $subdir ) } # filter for the second level
grep { -d } # filter for directories
glob catfile( $start, '*' ); # everything below $start
#!/usr/bin/perl
use strict;
use Fcntl qw( :DEFAULT :flock :seek );
use File::Spec;
use IO::Handle;
my $startdir = shift #ARGV || '.';
die "$startdir is not a directory\n"
unless -d $startdir;
my $verify_dir_name = 'MyDir';
my $dh = new IO::Handle;
opendir $dh, $startdir or
die "Cannot open $startdir: $!\n";
while(defined(my $cont = readdir($dh))) {
next
if $cont eq '.' || $cont eq '..';
my $fullpath = File::Spec->catfile($dir, $cont);
next
unless -d $fullpath && -r $fullpath && -w $fullpath;
my $verify_path = File::Spec->catfile($fullpath, $verify_dir_name);
next
if -d $verify_path;
mkdir($verify_path, 0755);
# do whatever other operations you want to $verify_path
}
closedir($dh);
The short answer is use File::FInd.
The long answer is first write a subroutine that validates the existence of the folder and if the folder is not there, create it and then do the processing needed. Then invoke the find method of the File::Find module with a reference to the subroutine and the starting folder to process all the subfolders.