Perl to check the sub directories and change the onwership - linux

I am trying to write a perl script which checks all the directories in the current directory and then accordingly penetrates in the subsequent directories to the point where it contains the last directory. This is what I have written:
#!/usr/bin/perl -w
use strict;
my #files = <*>;
foreach my $file (#files){
if (-d $file){
my $cmd = qx |chown deep:deep $file|;
my $chdir = qx |cd $file|;
my #subfiles = <*>:
foreach my $ subfile(#subfiles){
if (-d $file){
my $cmd = qx |chown deep:deep $subfile|;
my $chdir = qx |cd $subfile|;
. # So, on in subdirectories
.
.
}
}
}
}
Now, some of the directories I have conatins around 50 sub directories. How can I penetrate through it without writing 50 if conditions? Please suggest. Thank you.

Well, a CS101 way (if this is just an exercise) is to use a recursive function
sub dir_perms {
$path = shift;
opendir(DIR, $path);
my #files = grep { !/^\.{1,2}$/ } readdir(DIR); # ignore ./. and ./..
closedir(DIR);
for (#files) {
if ( -d $_ ) {
dir_perms($_);
}
else {
my $cmd = qx |chown deep:deep $_|;
system($cmd);
}
}
}
dir_perms(".");
But I'd also look at File::Find for something more elegant and robust (this can get caught in a circular link trap, and errors out if you don't call it on a directory, etc.), and for that matter I'd look at plain old UNIX find(1), which can do exactly what you're trying to do with the -exec option, eg
/bin/bash$ find /path/to/wherever -type f -exec chown deep:deep {} \;

perldoc File::Find has examples for what you are doing. Eg,
use File::Find;
finddepth(\&wanted, #directories_to_search);
sub wanted { ... }
further down the doc, it says you can use find2perl to create the wanted{} subproc.
find2perl / -name .nfs\* -mtime +7 \
-exec rm -f {} \; -o -fstype nfs -prune

NOTE: The OS usually won't let you change ownership of a file or directory unless you are the superuser (i.e. root).
Now, we got that out of the way...
The File::Find module does what you want. Use use warnings; instead of -w:
use strict;
use warnings;
use feature qw(say);
use autodie;
use File::Find;
finddepth sub {
return unless -d; # You want only directories...
chown deep, deep, $File::Find::name
or warn qq(Couldn't change ownership of "$File::Find::name\n");
}, ".";
The File::Find package imports a find and a finddepth subroutine into your Perl program.
Both work pretty much the same. They both recurse deeply into your directory and both take as their first argument a subroutine that's used to operate on the found files, and list of directories to operate on.
The name of the file is placed in $_ and you are placed in the directory of that file. That makes it easy to run the standard tests on the file. Here, I'm rejecting anything that's not a directory. It's one of the few places where I'll use $_ as the default.
The full name of the file (from the directory you're searching is placed in $File::Find::name and the name of that file's directory is $File::Find::dir.
I prefer to put my subroutine embedded in my find, but you can also put a reference to another subroutine in there too. Both of these are more or less equivalent:
my #directories;
find sub {
return unless -d;
push #directories, $File::Find::name;
}, ".";
my #directories;
find \&wanted, ".";
sub wanted {
return unless -d;
push #directories, $File::Find::name;
}
In both of these, I'm gathering the names of all of the directories in my path and putting them in #directories. I like the first one because it keeps my wanted subroutine and my find together. Plus, the mysteriously undeclared #directories in my subroutine doesn't look so mysterious and undeclared. I declared my #directories; right above the find.
By the way, this is how I usually use find. I find what I want, and place them into an array. Otherwise, you're stuck putting all of your code into your wanted subroutine.

Related

finding a file in directory using perl script

I'm trying to develop a perl script that looks through all of the user's directories for a particular file name without the user having to specify the entire pathname to the file.
For example, let's say the file of interest was data.list. It's located in /home/path/directory/project/userabc/data.list. At the command line, normally the user would have to specify the pathname to the file like in order to access it, like so:
cd /home/path/directory/project/userabc/data.list
Instead, I want the user just to have to enter script.pl ABC in the command line, then the Perl script will automatically run and retrieve the information in the data.list. which in my case, is count the number of lines and upload it using curl. the rest is done, just the part where it can automatically locate the file
Even though very feasible in Perl, this looks more appropriate in Bash:
#!/bin/bash
filename=$(find ~ -name "$1" )
wc -l "$filename"
curl .......
The main issue would of course be if you have multiple files data1, say for example /home/user/dir1/data1 and /home/user/dir2/data1. You will need a way to handle that. And how you handle it would depend on your specific situation.
In Perl that would be much more complicated:
#! /usr/bin/perl -w
eval 'exec /usr/bin/perl -S $0 ${1+"$#"}'
if 0; #$running_under_some_shell
use strict;
# Import the module File::Find, which will do all the real work
use File::Find ();
# Set the variable $File::Find::dont_use_nlink if you're using AFS,
# since AFS cheats.
# for the convenience of &wanted calls, including -eval statements:
# Here, we "import" specific variables from the File::Find module
# The purpose is to be able to just type '$name' instead of the
# complete '$File::Find::name'.
use vars qw/*name *dir *prune/;
*name = *File::Find::name;
*dir = *File::Find::dir;
*prune = *File::Find::prune;
# We declare the sub here; the content of the sub will be created later.
sub wanted;
# This is a simple way to get the first argument. There is no
# checking on validity.
our $filename=$ARGV[0];
# Traverse desired filesystem. /home is the top-directory where we
# start our seach. The sub wanted will be executed for every file
# we find
File::Find::find({wanted => \&wanted}, '/home');
exit;
sub wanted {
# Check if the file is our desired filename
if ( /^$filename\z/) {
# Open the file, read it and count its lines
my $lines=0;
open(my $F,'<',$name) or die "Cannot open $name";
while (<$F>){ $lines++; }
print("$name: $lines\n");
# Your curl command here
}
}
You will need to look at the argument-parsing, for which I simply used $ARGV[0] and I do dont know what your curl looks like.
A more simple (though not recommended) way would be to abuse Perl as a sort of shell:
#!/usr/bin/perl
#
my $fn=`find /home -name '$ARGV[0]'`;
chomp $fn;
my $wc=`wc -l '$fn'`;
print "$wc\n";
system ("your curl command");
Following code snippet demonstrates one of many ways to achieve desired result.
The code takes one parameter, a word to look for in all subdirectories inside file(s) data.list. And prints out a list of found files in a terminal.
The code utilizes subroutine lookup($dir,$filename,$search) which calls itself recursively once it come across a subdirectory.
The search starts from current working directory (in question was not specified a directory as start point).
use strict;
use warnings;
use feature 'say';
my $search = shift || die "Specify what look for";
my $fname = 'data.list';
my $found = lookup('.',$fname,$search);
if( #$found ) {
say for #$found;
} else {
say 'Not found';
}
exit 0;
sub lookup {
my $dir = shift;
my $fname = shift;
my $search = shift;
my $files;
my #items = glob("$dir/*");
for my $item (#items) {
if( -f $item && $item =~ /\b$fname\b/ ) {
my $found;
open my $fh, '<', $item or die $!;
while( my $line = <$fh> ) {
$found = 1 if $line =~ /\b$search\b/;
if( $found ) {
push #{$files}, $item;
last;
}
}
close $fh;
}
if( -d $item ) {
my $ret = lookup($item,$fname,$search);
push #{$files}, $_ for #$ret;
}
}
return $files;
}
Run as script.pl search_word
Output sample
./capacitor/data.list
./examples/data.list
./examples/test/data.list
Reference:
glob,
Perl file test operators

How to add a line to multiple text files under different sub-directories only if the line doesn't exist?

I have a directory called "technology" and under "technology" directory I have multiple sub-directories nested up to two levels max.
Under every sub-directory I have at least one "*.txt" file which could have up to 20 to 30 lines entry in it.
Now, I want to add "Remarks" line in every *.txt files spanning across multiple sub-directories only if the line is not there already.
I am getting list of all files under sub-directory using:
find ./ -name '*.txt'
I am using below mention Perl script to update entries, with new remarks as shown below.
/technology$ perl -p -i -e 's/Remarks.*/Remarks: NEW Value/' 'find ./ -name *.txt'
Problem with above script is that it only updates the existing remarks field.
How can I add an entry (one liner remarks) to ONLY those files that don't actually have it already?
I want to add line to only those files that don't contain a "Remarks line".
It isn't entirely clear if you want to update the rows containing Remarks in the files that already contain such a line or you want to leave those files unchanged and only add a line at the end of those file that don't contain remarks.
Fortunately, there isn't much difference. This code should work for "edit existing Remarks lines; add a new Remarks line if there isn't one already":
#!/usr/bin/env perl -i
use strict;
use warnings;
my $num_remarks = 0;
while (<>)
{
$num_remarks++ if s/Remarks.*/Remarks: NEW Value $$/;
print;
}
continue
{
if (eof)
{
print "Remarks: NEW Value $$\n" if $num_remarks == 0;
$num_remarks = 0;
}
}
The alternative requirement "leave existing Remarks lines unchanged; add a new Remarks line if there isn't one" can be handled with:
#!/usr/bin/env perl -i
use strict;
use warnings;
my $num_remarks = 0;
while (<>)
{
$num_remarks++ if m/Remarks/; # m// instead of s///
print;
}
continue
{
if (eof)
{
print "Remarks: NEW Value $$\n" if $num_remarks == 0;
$num_remarks = 0;
}
}
There are probably shorter ways to write this code. Both variants include the PID of the Perl process in the 'Remarks' line when it is added. This makes it easier to see when things are changed.

Having a small Issue running a Perl scripts IF statement.

I created a small script in Perl and I am really new to this. I'm supposed to have a script that looks at an argument given and create a directory tree in the given argument. This part of the script works. The second part (which is the nested if statement) does not when you do not give an argument and it asks you to input a directory of your choice. I believe the nested if statement is messing up due to the $file input but I'm not entirely sure whats wrong. This is probably something really simple, but I have not been able to find the solution. Thank you in advance for the help and tips.
#! /usr/bin/perl
if ($#ARGV == -1)
{
print "Please enter default directory:";
my $file=<STDIN>;
if (-d $file)
{
chdir $file;
system("mkdir Data");
system("mkdir Data/Image");
system("mkdir Data/Cache");
print "Structure Created";
}
else
{
print "Directory does not exsist";
}
}
else
{
chdir $ARGV[0];
system("mkdir Data");
system("mkdir Data/Image");
system("mkdir Data/Cache");
print ("Structure Created");
}
print ("\n");
The test -d $file is failing because what is entered via STDIN also has the newline, after the string that specifies the directory name. You need chomp($file);
However, there are a few more points I would like to bring up.
Most importantly, there is repeated code in both branches. You really do not want to do that. It can, and does, cause trouble later. Instead, decide on the directory name, and then make it.
Second, there is no reason to go out to the system in order to make a directory. It is far better to do it in Perl, and there are good modules for this.
use strict;
use warnings;
use File::Path qw(make_path);
my $dir;
if (not #ARGV) {
print "Please enter default directory: ";
$dir = <STDIN>;
chomp $dir;
}
else {
$dir = $ARGV[0];
}
die "No directory $dir" if not -d $dir;
my $orig_cwd = chdir $dir or die "Can't chdir to $dir: $!";
my #dirs = map { "Data/$_" } qw(Image Cache);
my #dirs_made = make_path( #dirs, { verbose => 1 } );
print "Created directories:\n";
print "$_\n" for #dirs_made;
I build the directory list using map so to avoid repeated strings with Data/..., and for later flexibility. You can of course just type the names in, but that tends to invite silly mistakes.
I used File::Path to make the directories. It builds the whole path, like mkdir -p, and has a few other useful options that you can pass in { }, including error handling. There are other modules as well, for example Path::Tiny with its mkpath (and a lot of other goodies).
Note that with chdir you probably want to record the current working directory, that it returns, and that you want to check for error. But you don't have to chdir, if there are no other reasons for that. Just include the $dir name in the map
# No chdir needed here
my #dirs = map { "$dir/Data/$_" } qw(Image Cache);

how to combine directory path in perl

I am having a perl script in which i am giving path to directory as input.
Directory has xml files inside it.
In my code i am iterating through all the xml files and creating absolute path for all xml files. Code is working fine.
#!/usr/bin/perl
use File::Spec;
$num_args = $#ARGV + 1;
if ($num_args != 1) {
print "\nUsage: $0 <input directory>\n";
exit;
}
my $dirPath = $ARGV[0];
opendir(DIR, $dirPath);
my #docs = grep(/\.xml$/,readdir(DIR));
foreach my $file (#docs)
{
my $abs_path = join("",$dir,$file);
print "absolute path is $abs_path";
}
Question i have here is,
joining $dirPath and $file with no separator which means that $dirPath must end in a "/". So is there any way or built in function in perl which take cares of this condition and replaces the join method.
All i want is not to worry about the separator "/". Even if script is called with path as "/test/dir_to_process" or "/test/dir_to_process/", i should be able to produce the correct absolute path to all xml files present without worrying about the separator.
Let me know if anyone has any suggestions.
Please take heed of the advice you are given. It is ridiculous to keep asking questions when comments and answers to previous posts are being ignored.
You must always use strict and use warnings at the top of every Perl program you write, and declare every variable using my. It isn't hard to do, and you will be reprimanded if you post code that doesn't have these measures in place.
You use the File::Spec module in your program but never make use of it. It is often easier to use File::Spec::Functions instead, which exports the methods provided by File::Spec so that there is no need to use the object-oriented call style.
catfile will correctly join a file (or directory) name to a path, doing the right thing if path separators are incorrect. This rewrite of your program works fine.
#!/usr/bin/perl
use strict;
use warnings;
use File::Spec::Functions 'catfile';
if (#ARGV != 1) {
print "\nUsage: $0 <input directory>\n";
exit;
}
my ($dir_path) = #ARGV;
my $xml_pattern = catfile($dir_path, '*.xml');
while ( my $xml_file = glob($xml_pattern) ) {
print "Absolute path is $xml_file\n";
}
The answer is in the documentation for File::Spec, e.g., catfile:
$path = File::Spec->catfile( #directories, $filename );
or catpath:
$full_path = File::Spec->catpath( $volume, $directory, $file );
This will add the trailing slash if not there:
$dirPath =~ s!/*$!/!;

Move files to another folder, including creation date in filename

I am able to move files from one folder to another but the issue is I want the new created file in the new folder as its created date and filename.
For instance
/scripts/a.log
moved to
/log/8june2012a.log
cp filename "`date +%Y%m%d`filename"
This copies filename as 20120608filename. For your example this is what you want:
cp filename "`date +%d%b%Y`filename"
This copies filename as 08jun2012filename. If you want move your file instead of copying use mv instead of cp:
mv filename "`date +%d%b%Y`filename"
Here is a solution in Perl.
#!/usr/bin/perl
use strict;
use warnings;
use File::Copy 'move';
use Time::Piece 'localtime';
my $indir = '/scripts';
my $outdir = '/log';
# get all of the files in the scripts dir
chdir $indir;
my #files = grep -f, glob '*';
foreach my $infile (#files) {
# get the date that the file was created
my $file_created_date = localtime( (stat $infile)[9] );
my $outfile = $file_created_date->strftime('%d%B%Y').$infile;
move $infile, "$outdir/$outfile";
}
As an aside, I would format the date as %Y%m%d (yyyymmdd) as it gives you a consistent format and allows you to sort by date more easily.
Another solution.
use strict ;
use File::stat ;
use POSIX qw(strftime);
my $File = 'mv.pl';
my $NewFile=strftime("%d%B%Y",localtime(stat($File)->ctime)) . $File ;
rename $File, $NewFile;
Using a couple of CPAN modules this can be made straightforward. File::Copy has been a core module since Perl v5.0, but Date::Format and Path::Class will need installing unless you already have them.
I have taken your requirement literally, and this solution prefixes the original file with the creation date using %e%B%Y as the format, with upper case translated to lower case and spaces stripped. However this isn't very readable and the directory listing will not automatically sort in date order, so I recommend using %Y-%m-%d- instead by replacing the line containing the call to strftime with
my $date = lc strftime('%Y-%m-%d-', #date)
At present the code just prints a list of the files it is going to move and their destination. To actually do the move you should uncomment the call to move.
use strict;
use warnings;
use Path::Class 'dir';
use Date::Format 'strftime';
use File::Copy 'move';
my $source = dir '/scripts/';
my $dest = dir '/log/';
for my $file (grep { not $_->is_dir } $source->children) {
my #date = localtime $file->stat->ctime;
(my $date = lc strftime('%e%B%Y', #date)) =~ tr/\x20//d;
my $newfile = $dest->file($date.$file->basename);
print "move $file -> $newfile\n";
# move $file, $newfile;
}
use File::Copy;
move("a.log",$DIRECTORY.get_timestamp().".log");
Your get_timestamp function should generate the date.
I wrote a demo for you,
#!/bin/bash
DATE=`date +"%e%B%Y" | tr -d ' ' | tr A-Z a-z`
for FILENAME in *.log
do
cp "${FILENAME}" "/log/${DATE}${FILENAME}"
done
you can run this in your "scripts" directory.

Resources