How can I find a file, user owned by tree and group owned by tree? And how can I find a whole directory inside which files are owned by tree?
The File::Find module is a standard Perl module (i.e., it is available on all installations of Perl). You can use File::Find to go through a directory tree and search for the file you want.
To use, you create a wanted subroutine that parses the files, then have the find subroutine include that wanted routine in its call. The File::Find module is a bit klutzy because it was originally only meant to use for the find2perl command.
Here's some completely untested code. Notice that you do yucky stuff like using global variables and package variables. It's one of the reasons I don't like File::Find.
use File::Find;
our $myUid = getpwnam('tree');
our $muGid = getgrnam('tree');
find (\&wanted, #dirList);
sub wanted {
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($File::Find::name);
next if (not -f $File::Find::name);
next if ($uid != $myUid);
next if ($gid != $myGid);
print qq(File "$File::Find::name" is owned by group 'tree' and user 'tree'\n);
}
I wrote my own File::Find called File::OFind because it's more object oriented. You can get that from here. It's a bit easier to understand. (Again, completely untested):
use File::OFind;
# Really should test if these return something
my $myUid = getpwnam('tree');
my $muGid = getgrnam('tree');
# Create your directory search object
my $find = File::OFind->new(STAT => 1, $directory);
# Now keep looping and examining each file
while($find->Next) {
next if ($find->Uid != $myUid);
next if ($find->Gid != $myGid);
next if ($find->Type ne "f"); #Is this a file?
print $find->Name . " is owned by group and user tree\n";
}
The builtin Perl functions you will need to accomplish this task include getpwnam, getgrnam, and stat.
($name,$passwd,$uid,$gid,
$quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam 'tree';
will return a lot of useful information about the user tree. For this task you will be particularly interested in the $uid field. Likewise,
($name,$passwd,$gid,$members) = getgrnam 'tree';
retrieves data about the group tree. You will be most interested in the $gid field. Finally, the stat function
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($filename);
returns a 13-element array with system information about a file (or a directory). For your task, you are looking for files such that the user and group ids returned from stat($filename) match the user and group ids returned from getpwnam and getgrnam.
File::Find::Rule makes this clean and simple:
use File::Find::Rule;
my $uid_tree = getpwnam('tree');
my $gid_tree = getgrnam('tree');
my #files =
File::Find::Rule
->file()
->uid($uid_tree)
->gid($gid_tree)
->in('.');
Ref:
File::Find::Rule
getpw* and getgr*
Related
Is there a Perl module (preferably core) that has a function that will tell me if a given filename is inside a directory (or a subdirectory of the directory, recursively)?
For example:
my $f = "/foo/bar/baz";
# prints 1
print is_inside_of($f, "/foo");
# prints 0
print is_inside_of($f, "/foo/asdf");
I could write my own, but there are some complicating factors such as symlinks, relative paths, whether it's OK to examine the filesystem or not, etc. I'd rather not reinvent the wheel.
Path::Tiny is not in core, but it has no non-core dependencies, so is a very quick and easy installation.
use Path::Tiny qw(path);
path("/usr/bin")->subsumes("/usr/bin/perl"); # true
Now, it does this entirely by looking at the file paths (after canonicalizing them), so it may or may not be adequate depending on what sort of behaviour you're expecting in edge cases like symlinks. But for most purposes it should be sufficient. (If you want to take into account hard links, the only way is to search through the entire directory structure and compare inode numbers.)
If you want the function to work for only a filename (without a path) and a path, you can use File::Find:
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;
sub is_inside_of {
my ($file, $path) = #_;
my $found;
find( sub { $found = 1 if $_ eq $file }, $path);
return $found
}
If you don't want to check the filesystem, but only process the path, see File::Spec for some functions that can help you. If you want to process symlinks, though, you can't avoid touching the file system.
fairly new to perl so this is most likely is not the best code which is why I am posting. I got this to work but was wondering if there is a better way. I do not have the ability to download modules. I am copying the last modified directory in a build folder from one server to another server. The argument allows me to choose which build directory to choose from.
Thanks
#!C:\strawberry\perl
use warnings;
use strict;
use File::Copy::Recursive;
my $NewFolder = `(dir /o-d/ad/b \\\\myserver1.name.com\\builds\\$ARGV[0] | head -1)`;
chomp($NewFolder);
$dir1 = "\\\\myserver1.name.com\\builds\\$ARGV[0]/$NewFolder";
$dir2 = "\\\\myserver2.name.com\\builds\\$ARGV[0]/Backup/$NewFolder";
File::Copy::Recursive::dircopy $dir1, $dir2 or die "Copy failed: $!";
Use forward slashes. It just makes your code easier to read:
$dir1 = "\\\\myserver1.name.com\\builds\\$ARGV[0]/$NewFolder";
vs.
$dir1 = "//myserver1.name.com/builds/$ARGV[0]/$NewFolder";
Also, don't do system calls where Perl can do it. For example, Perl can see the last modification date of a file via the stat. Even better is the File::stat module that makes the stat command so much easier to use.
Don't use #ARGV in your programs. Instead, read the variables from #ARGV into your own variables. It makes your program easier to understand, and your own variables have limited scope while #ARGV is global.
Use modern conventions. Variable names should be in all lower case, and use underscores to separate out words. That is $new_folder vs. $NewFolder. Is this arbitrary? Yes, but it's a convention followed by most Perl developers. It means not wondering if the variable is $newFolder, $NewFolder, or $newfolder because you know by these rules it is $new_folder.
And finally, use autodie; This will kill your program whenever a file operation fails. This turns perl from a check function for errors programming language into a exception checking language. This way, you don't have to worry whether or not you have to check for a failed IO operation.
Here's a completely untested, error ridden example:
use strict;
use warnings;
use autodie;
use File::Copy::Recursive qw(dircopy); #Optional Module
use File::Stat;
use constants {
ORIG_SERVER => '//myserver1.name.com/builds',
TO_SERVER => '//myserver2.name.com/builds',
};
my $from_directory = shift;
#
# Find newest directory
#
opendir my $dir_fh, ORIG_SERVER . "/$from_directory";
my $newest_directory;
while ( my $sub_directory = readdir $dir_fh ) {
next if $sub_directory eq "." or $sub_directory eq "..";
next unless -d $sub_directory;
if ( not defined $newest_directory ) {
$youngest_directory = $sub_directory;
next;
}
my $youngest_directory_stat = stat ORIG_SERVER . "/$directory/$newest_directory";
my $sub_directory_stat = stat ORIG_SERVER . "/$directory/$sub_directory";
if ( $newest_directory_stat->mtime > $sub_directory_stat->mtime ) {
$newest_directory = $sub_directory;
}
}
dircopy ORIG_SERVER . "/$directory/$youngest_directory",
TO_SERVER . "/$directory/$youngest_directory/backup";
My program is a lot longer than your program because your program depended upon various system operating commands, like dir and head which I don't believe is a standard Windows OS command. Instead, I read each entry under that directory into my loop. Anything that's not a directory, I toss (next if -d $sub_directory) and I toss out the special directories . and ...
After that, I use stat to find the youngest directory which to me means the one with the newest modification time. Note that Unix doesn't store creation time. However, according to perlport ctime is creation time on Win32, so you might prefer that instead of mtime.
If I didn't use File::stat, instead of this:
my $youngest_directory_stat = stat ORIG_SERVER . "/$directory/$newest_directory";
my $sub_directory_stat = stat ORIG_SERVER . "/$directory/$sub_directory";
if ( $newest_directory_stat->mtime > $sub_directory_stat->mtime ) {
$newest_directory = $sub_directory;
}
I could have done this:
my $newest = ORIG_SERVER . "/$directory/$newest_directory";
my $sub_dir = ORIG_SERVER . "/$directory/$sub_directory";
if ( stat( $newest )[9] > stat( $sub_dir )[9] ) {
$newest_directory = $sub_directory;
}
The stat command without File::stat returns an array of values, and I could have simply used the [9] element of that array. However, what is 9? Even though it could of saved me a few lines of code, and including an extra Perl module, it's better to use File::stat.
One thing you notice is that constants don't interpolate which means I have to keep doing things like this:
my $youngest_directory_stat = stat ORIG_SERVER . "/$directory/$newest_directory";
However, you can use this bit of Perlish black magic to interpolate constants inside quotes:
my $youngest_directory_stat = stat "#{[ORIG_SERVER]}/$directory/$newest_directory";
Hope that helps.
I am writing a script that goes through our large directory of Perl Scripts and checks for certain things. Right now, it takes two kinds of input: the main directory, or a single file. If a single file is provided, it runs the main function on that file. If the main directory is provided, it runs the main function on every single .pm and .pl inside that directory (due to the recursive nature of the directory traversal).
How can I write it (or what package may be helpful)- so that I can also enter one of the seven SUBdirectories, and it will traverse ONLY that subdirectory (instead of the entire thing)?
I can't really see the difference in processing between the two directory arguments. Surely, using File::Find will just do the right thing in both instances.
Something like this...
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
my $input = shift;
if (-f $input) {
# Handle a single file
handle_a_file($input);
} else {
# Handler a directory
handle_a_directory($input);
}
sub handle_a_file {
my $file = shift;
# Do whatever you need to with a single file
}
sub handle_a_directory {
my $dir = shift;
find(\&do this, $dir);
}
sub do_this {
return unless -f;
return unless /\.p[ml]$/;
handle_a_file($File::Find::name);
}
One convenient way would be to use the excellent Path::Class module, more precisely: the traverse() method of Path::Class::Dir. You'd control what to process from within the callback function which is supplied as the first argument to traverse(). The manpages has sample snippets.
Using the built-ins like opendir is perfectly fine, of course.
I've just turned to using Path::Class almost everywhere, though, as it has so many nice convenience methods and simply feels right. Be sure to read the docs for Path::Class::File to know what's available. Really does the job 99% of the time.
If you know exactly what directory and subdirectories you want to look at you can use glob("$dir/*/*/*.txt") for example to get ever .txt file in 3rd level of the given $dir
In cPanel, they tell you to insert this code into the beginning of Perl files. I'm not sure what it does. I've tried code with and without this in the beginning of the file and it seems to all work the same. I haven't tested that out with cron running the code, but only as myself. By "tested it out", I mean using print lines, database connections & returns, subs, vars, etc...
BEGIN
{
my $base_module_dir = (-d '/home/root/perl' ? '/home/root/perl' : ( getpwuid($>) )[7] . '/perl/');
unshift #INC, map { $base_module_dir . $_ } #INC;
}
It is designed to set your module search path. Specifically, it sets the default location (first location checked) the user's local perl/ directory. It not only adds that directory but makes it a new root for #INC. It does this for every entry in #INC. In a limited access environment such as those that use CPanel this insures you scripts (general cgi) user your modules over any other.
BEGIN means it occurs before any code not in the block.
The first line determines if /home/root/perl exists and is a directory. If both are true it assigns that to $base_module_dir, otherwise it assigns <user home>/perl/ to the variable. Remember, in perl you can index a function call directly if it returns a list.
It finds the user's home directory with getpwuid($>). getpwuid() gets user account information for a given user (generally from passwd on a Unix system) and returns it as a list. $> is the effective user id of the script. The reason for the index of 7 is that is the location of the home directory in the list (and it is the 8th field in passwd if memory serves).
It then prepends ALL entries in #INC with $base_module_dir and inserts those modified entries at the front of #INC. So it's not just adding $base_module_dir as a directory but is adding that as a new root for all entries in #INC. That's why it uses map instead of just adding a single entry.
Maybe a bit easier to read:
# The BEGIN block is explained in perldoc perlmod
BEGIN {
# Prefix all dirs already in the include path, with root's perl path if it exists, or the
# current user's perl path if not and make perl look for modules in those paths first:
# Example:
# "/usr/lib/perl" => "/home/root/perl/usr/lib/perl, /usr/lib/perl"
my $root_user_perl_dir = '/home/root/perl';
# Fetch user home dir in a non-intuitive way:
# my $user_perl_dir = ( getpwuid($>) )[7] . '/perl/');
# Fetch user home dir slightly more intuitive:
my $current_userid = $>; # EFFECTIVE_USER_ID see perldoc perlvar
# See perldoc perlfunc / perldoc -f getpwuid
my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell,$expire)
= getpwuid($current_userid);
my $current_user_home_dir = $dir;
my $user_perl_dir = $current_user_home_dir . '/perl/';
my $base_module_dir = '';
if (-d $root_user_perl_dir ) {
# Use this if the path exists
$base_module_dir = $root_user_perl_dir;
}
else {
# or fallback to current user's path
$base_module_dir = $user_perl_dir;
}
# Generate the new paths
my #prefixed_INC = map { $base_module_dir . $_ } #INC;
# Add the generated paths in front of the existing ones.
#INC = (#prefixed_INC, #INC);
}
This code sets up Perl to prefer modules in either /home/root/perl--if it exists and is a directory--or ~/perl when looking for modules to load. It basically takes every path that the Perl would normally use and bases them in that chosen directory.
Likely, this allows the user to have a debugging or bugfix version of a system module and for Perl to prefer that instead.
It does this in a BEGIN block because it's the only way to make sure that a block of logic can be run to modify #INC to affect the behavior of use statements.
I have a directory structure that looks like:
Foo::Bar::Baz::1
Foo::Bar::Baz::2 etc
Can I list the packages from something like:
use Foo::Bar::Baz;
Thanks!
Edit: Made it more clear what the modules are.
If you want to load all modules in your include path with a certain prefix (e.g. everything under a::b::c, you can use Module::Find.
For example:
use Module::Find 'useall';
my #loaded = useall 'Foo::Bar::Baz'; # loads everything under Foo::Bar::Baz
This depends on your #INC path being set up with the necessary directories, so do any required manipulation (e.g. with use lib) first.
Normally a script such as a/b/c.pl won't have a namespace other than main. Perhaps you are thinking of discovering modules with names such as a/b/c.pm (which is a bad name, since lower-cased package names are generally reserved for Perl internals).
However, given a directory path, you can look for potential Perl modules using File::Find:
use strict;
use warnings;
use File::Find;
use Data::Dumper;
my #modules;
sub wanted
{
push #modules, $_ if m/\.pm$/
}
find(\&wanted, 'A/B');
print "possible modules found:\n";
print Dumper(\#modules)'
This might be overkill, but you can inspect the symbol table before and after loading the module and see what changed:
use strict; use warnings;
my %original = map { $_ => 1 } get_namespaces("::");
require Inline;
print "New namespaces since 'require Inline' call are:\n";
my #new_namespaces = sort grep !defined $original{$_}, get_namespaces("::");
foreach my $new_namespace (#new_namespaces) {
print "\t$new_namespace\n";
}
sub get_namespaces {
# recursively inspect symbol table for known namespaces
my $pkg = shift;
my #namespace = ();
my %s = eval "%" . $pkg;
foreach my $key (grep /::$/, keys %s) {
next if $key eq "main::";
push #namespace, "$pkg$key", get_namespaces("$pkg$key");
}
return #namespace;
}
New namespaces since 'require Inline' call are:
::AutoLoader::
::Config::
::Digest::
::Digest::MD5::
::Dos::
::EPOC::
::Exporter::
::Exporter::Heavy::
::File::
::File::Spec::
::File::Spec::Cygwin::
::File::Spec::Unix::
::File::Spec::Win32::
::Inline::Files::
::Inline::denter::
::Scalar::
::Scalar::Util::
::Socket::
::VMS::
::VMS::Filespec::
::XSLoader::
::vars::
::warnings::register::
Just to be clear, are you looking at random packages in random Perl code?
Or for Perl modules, e.g. "a/b/c/d1.pm" with module "a::b::c::d1"?
In either case, you can not use a single "use" statement to load them all.
What you need to do is to find all the appropriate files, using either glob or File::Find.
In the first case (modules), you can then load them either by require-ing each file, OR by converting filename into module name (s#/#::#g; s#\.pm$##;) and calling use on each module individually.
As far as actual packages nested in random Perl files, those packages can be:
Listed by grepping each file (again, found via glob or File::Find) for /^package (.*);/
Actually loaded by executing require $file for each file.
In this case, please note that the package name for each of those packages in a/b/c/1.pl will NOT need to be related to "a::b::c" - e.g. they CAN be named by the file author "p1", "a::p1" or "a::b::c::p1_something".