Copy the last modified Dir from one location to another using Perl - perl

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.

Related

How do I detect a case-insensitive file system in Perl?

I tried using File::Spec->case_tolerant, but it returns false on HFS+, which is wrong. I suspect it's because File::Spec::Unix always returns false. My current workaround is this function:
my $IS_CASE_INSENSITIVE;
sub _is_case_insensitive {
unless (defined $IS_CASE_INSENSITIVE) {
$IS_CASE_INSENSITIVE = 0;
my ($uc) = glob uc __FILE__;
if ($uc) {
my ($lc) = glob lc __FILE__;
$IS_CASE_INSENSITIVE = 1 if $lc;
}
}
return $IS_CASE_INSENSITIVE;
}
But that's a hack since: 1) on a case-sensitive file system both of those files might exists; and 2) different volumes can have different file systems.
In truth, every directory considered must be checked on its own. This is because, on Unix-like systems, any directory can be a different file system than some other directory. Furthermore, use of glob is not very reliable; from perlport:
Don't count on filename globbing. Use opendir, readdir, and closedir instead.
But I think that #borodin is onto something with the use of -e. So here's a function that uses -e to determine whether the specified directory is on a case-insensitive file system:
my %IS_CASE_INSENSITIVE;
sub is_case_insensitive {
my $dir = shift;
unless (defined $IS_CASE_INSENSITIVE{$dir}) {
$IS_CASE_INSENSITIVE{$dir} = -e uc $dir && -e lc $dir;
}
return $IS_CASE_INSENSITIVE{$dir};
}
You could probably add some heuristics for Windows to just cache the value for the drive letter, since that defines a mount point. And of course, it will fail on case-sensisitve file systems if both uppercase and lowercase variations of the directory exist. But otherwise, unless there is some other way to tell more globally which directories match to which mount points, you have to check for any directory.
I suggest you make use of the core File::Temp module to create a new unique file that has lower-case characters in its name. The file is set to be deleted when the object is destroyed, which is when the subroutine exits if not before.
If the file doesn't exist when access by the upper-cased file name then the filing system is case-sensitive.
If the upper-cased name does exist then we have to check that we haven't happened upon a file whose upper-case version was already there, so we delete the file. If the upper-case entry has now gone then the filing system is case-insensitive.
If the upper-cased name is still there then it is a file that existed before we created the temporary file. We just loop around and create a new temporary file with a different name, although the chances of this happening are absolutely tiny. If you prefer you can minimize this possibility even further by using an outlandish value for SUFFIX. Just be careful that the characters you use are valid on any fileing system that you wish to test.
I've tested this on both Windows 7 and Ubuntu.
use strict;
use warnings;
use 5.010;
use autodie;
use File::Temp ();
printf "File system %s case_insensitive\n", case_insensitive() ? "is" : "isn't";
sub case_insensitive {
while () {
my $tmp = File::Temp->new(
TEMPLATE => 'tempXXXXXX',
SUFFIX => '.tmp',
UNLINK => 1,
);
my $uc_filename = uc $tmp->filename;
return 0 if not -e $uc_filename;
$tmp = undef;
return 1 if not -e $uc_filename;
}
}

Open a directory and sort files by date created

I need to open directories and sort the files by the time they were created. I can find some discussion, using tags for Perl, sorting, and files, on sorting files based on date of modification. I assume this is a more common need than sorting by date of creation. I use Perl. There is some previous postings on sorting by creation date in other languages other than Perl, such as php or java.
For example, I need to do the following:
opendir(DIR, $ARGV[0]);
my #files = "sort-by-date-created" (readdir(DIR));
closedir(DIR);
do things with #files...
The CPAN has a page on the sort command, but it's not very accessible to me, and I don't find the words "date" or "creation" on the page.
In response to an edit, I should say I use Mac, OS 10.7. I know that in the Finder, there is a sort by creation date option, so there must be some kind of indication for date of creation somehow attached to files in this system.
In response to an answer, here is another version of the script that attempts to sort the files:
#!/usr/bin/perl
use strict; use warnings;
use File::stat; # helps with sorting files by ctime, the inode date that hopefully can serve as creation date
my $usage = "usage: enter name of directory to be scanned for SNP containing lines\n";
die $usage unless #ARGV == 1;
opendir(DIR, $ARGV[0]); #open directory for getting file list
#my #files = (readdir(DIR));
my #file_list = grep ! /^\./, readdir DIR;
closedir(DIR);
print scalar #file_list."\n";
for my $file (sort {
my $a_stat = stat($a);
my $b_stat = stat($b);
$a_stat->mtime <=> $b_stat->mtime;
} #file_list ) {
say "$file";
}
You can customize the sorting order by providing a subroutine or code block to the sort function.
In this sub or block, you need to use the special variables $a and $b, which represent the values from the #array as they are compared.
The sub or block needs to return a value less than, equal to, or greater than 0 to indicate whether $a is less than, equal to, or greater than $b (respectively).
You may use the special comparison operators (<=> for numbers, cmp for strings) to do this for you.
So the default sort sort #numbers is equivalent to sort {$a <=> $b} #numbers.
In the case of sorting by creation time, you can use the stat function to get that information about the file. It returns an array of information about the file, some of which may not be applicable to your platform. Last modification time of the file is generally safe, but creation time is not. The ctime (11th value that it returns) is as close as you can get (it represents inode change time on *nix, creation time on win32), which is expressed as the number of seconds since the epoch, which is convenient because it means you can do a simple numeric sort.
my #files = sort {(stat $a)[10] <=> (stat $b)[10]} readdir($dh);
I'm not sure if you want to filter out the directories also. If that is the case, you'll probably also want to use grep.
I need to open directories and sort the files by the time they were created.
You can't. The creation time simply does not exist. There are three time elements tracked by *nix like operating systems:
mtime: This is the time the file was last modified.
atime: This is the time the file was last accessed.
ctime: This is the time when the inode was last modified.
In Unix, certain file information is stored in the inode. This includes the various things you see when you take the Perl stat of a file. This is the name of the user, the size of the file, the device it's on, the link count, and ironically, the mtime, atime, and ctime timestamps.
Why no creation time? Because how would you define it? What if I move a file? Should there be a new creation time (By the way, ctime won't change with a move). What if I copy the file? Should the new copy have a new creation time? What if I did a copy, then deleted the original? What if I edited a file? How about if I changed everything in the file with my edit? Or I edited the file, then renamed it to a completely new name?
Even on Windows that has a file creation time, doesn't really track the file creation. It merely tracks when the directory entry was created which is sort of what ctime does. And, you can even modify this creation time via the Windows API. I suspect that the Mac's file creation time is a relic of the HFS file system, and really doesn't point to a file creation time as much as the time the directory entry was first created.
As others have pointed out. You can add into the sort routine a block of code stating how you want something sorted. Here's a quickie example. Note I use File::stat which gives me a nice by name interface to the old stat command. If I used the old stat command, I would get an array, and then have to figure out where in the array the item I want is located. Here, the stat command gives me a stat object, and I can use the mtime, atime, or ctime method for pulling out the right time.
I also use the <=> which is a comparison operator specifically made for the sort command block.
The sort command gives you two items $a and $b. You use these two items to figure out what you want, adn then use either <=> or cmp to say whether $a is bigger, $b is bigger, or they're both the same size.
#! /usr/bin/env perl
use 5.12.0;
use warnings;
use File::stat;
my $dir_name = shift;
if ( not defined $dir_name ) {
die qq(Usage: $0 <directory>);
}
opendir(my $dir_fh, $dir_name);
my #file_list;
while ( my $file = readdir $dir_fh) {
if ( $file !~ /^\./ ) {
push #file_list, "$dir_name/$file"
}
}
closedir $dir_fh;
say scalar #file_list;
for my $file (sort {
my $a_stat = stat($a);
my $b_stat = stat($b);
$a_stat->ctime <=> $b_stat->ctime;
} #file_list ) {
say "$file";
}
OS X stores the creation date in Mac-specific metadata, so the standard Perl filesystem functions don't know about it. You can use the MacOSX::File module to access this information.
#!/usr/bin/env perl
use strict;
use warnings;
opendir(DIR, $ARGV[0]);
chdir($ARGV[0]);
my #files = sort { (stat($a))[10] <=> (stat($b))[10] } (readdir(DIR));
closedir(DIR);
print join("\n",#files);
stat gives you all kinds of status info for files. field 10 of that is ctime (on filesystems that support it) which is inode change time (not creation time).
Mojo::File brings some interesting and readable ways to do it.
#!/usr/bin/env perl
use Mojo::File 'path';
my $files_list = path( '/whatever/dir/path/' )->list;
# Returns an array of Mojo::File
my #files = sort { $a->stat->ctime <=> $b->stat->ctime }
map { $_ } $files_list->each;
# Returns an array of paths sorted by modification date (if needed)
my #paths = map { $_->realpath->to_string } #files;

Renaming Sub-directories in Perl

#!/usr/bin/perl -w
use strict;
use File::Copy;
use File::Spec;
my($chptr, $base_path, $new, $dir);
$dir = "Full Metal Alchemist"; #Some dir
opendir(FMA, $dir) or die "Can't open FMA dir";
while($chptr = readdir FMA){
$base_path = File::Spec->rel2abs($dir).'/'; #find absolute path of $fir
if($chptr =~ m(Chapter\w*\d*)){ #some regex to avoid the .. and . dirs
$new = join(" 0", split(/\W/, $chptr)); #modify said sub directory
rename "$base_path$chptr", "$base_path$new" ? print "Renames $base_path$chptr to
$base_path$new\n" : die "rename failed $!";
}
}
closedir FMA;
Originally, my script only used the relative path to preform the move op, but for some reason, this leaves the sub directories unaffected. My next step was to go to absolute pathing but to no avail. I am just learning Perl so I feel like I'm making a simple mistake. Where have I gone wrong? TIA
You could exclude . and .. as follows:
if ( $child ne '.' and $child ne '..' ) { ... }
Some general remarks:
Always have a very clear spec of what you want to do. That also helps everybody trying to help you.
It's not clear what goes wrong here. Maybe your regex simply doesn't match the directories you want it to match? What is the problem?
Try to make very specific parts (like the name of the directory where you want to start processing) into parameters. Obviously, some specifics are harder to make into parameters, like what and how to rename.
Using opendir, readdir, rename and File::Spec is fine for starting. There's an easier way, though: take a look at the Path::Class module, and specifically its two subclasses. They provide a well-crafted abstraction layer over File::Spec (and more), and it's basically a one-stop service for filesystem operations.

file permission in dir

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*

Perl - How to open directory - Return name of lowest numerically numbered filename using posix and or abs?

Well I am back again, stuck on another seemingly simple routine.
I need to figure out how to do this with Perl.
1- I open a directory full of files named 1.txt, 2.txt ~ 100.txt.
(But sometimes the lowest numbered filename could in fact be any number (27.txt) due to 0-26.txt already removed from directory.)
(I found out how to implement ABS sort so; 1,2,3 not 1,10,11 ~ 2,20 was the order returned.)
use POSIX;
my #files = </home/****/users/*.txt>;
foreach $file (#files) {
##$file ABS($file)
##and so on..
##EXAMPLE NOT TRIED
}
2- I just want to return the lowest numbered file name in the directory into a $var.
Do I have to read the whole directory into an array, do an abs sort, then grab the first one in the array off?
Is there a more efficient way to grab the lowest numbered file?
More info:
The files were created by/with a loop so, I also contemplated grabbing the oldest file first if the creation time is actually that sensitive. But, I am a beginner and don't know if creation time is accurate enough, and how to use it or if in fact that is a viable solution.
Thanks for the help, I always find the best people here.
use strict;
use warnings;
use File::Slurp qw(read_dir);
use File::Spec::Functions qw(catfile);
my $directory = 'some/directory';
my #files = read_dir($directory);
my #ordered;
{
no warnings 'numeric';
#ordered = sort { $a <=> $b } #files;
}
my $lowest_file = catfile $directory, $ordered[0];