relative absolute path perl - perl

Following directory setup:
/dira/dirb
/dira/dirb/myprog.pl
/dira/dirb/testa/myfilesdir Contains the following files
/dira/dirb/testa/myfilesdir/file1.txt
/dira/dirb/testa/myfilesdir/file2.txt
Current dir:
/dir/dirb
./myprog.pl -p testa/myfilesdir
Cycle through files
while (my $file_to_proc = readdir(DIR)) {
...
$file_to_proc = file1.txt
$file_to_proc = file2.txt
what I want is
$myfile = /dira/dirb/testa/myfilesdir/file1.txt
$myfile = /dira/dirb/testa/myfilesdir/file2.txt
Tried a few different perl module (CWD rel2abs) but it is using current directory. I can not use current directory because input could be relative or absolute path.

Use module File::Spec. Here an example:
use warnings;
use strict;
use File::Spec;
for ( #ARGV ) {
chomp;
if ( -f $_ ) {
printf qq[%s\n], File::Spec->rel2abs( $_ );
}
}
Run it like:
perl script.pl mydir/*
And it will print absolute paths of files.
UPDATED with a more efficient program. Thanks to TLP's suggestions.
use warnings;
use strict;
use File::Spec;
for ( #ARGV ) {
if ( -f ) {
print File::Spec->rel2abs( $_ ), "\n";
}
}

Related

Perl list files under multiple directories

I've currently got this to grab all files under Assets/Editor
#files = bsd_glob( "Assets/Editor/postprocessbuildplayer_*", GLOB_NOCASE );
But I would like to access all files starting with postprocessbuildplayer_ starting from Assets as my root folder.
Example:
Assets/Temp/Editor/PostprocessBuildPlayer_DWARF
Assets/Directory_1/Editor/PostprocessBuildPlayer_1
Assets/Editor/PostprocessBuildPlayer_Default
The entire script should anyone know a better way:
#!/usr/bin/perl
# Post Process Build Player -- Master
# Searches for other PostprocessBuildPlayer scripts and executes them. Make sure the other script
# have a name suffix with an underscore "_" like "PostprocessBuildPlayer_AnotherBuild" or whatever.
#
# Based on script by Rob Terrell, rob#stinkbot.com
use File::Glob ':glob';
# Grab all the PostprocessBuildPlayer files
#files = bsd_glob( "Assets/Editor/postprocessbuildplayer_*", GLOB_NOCASE );
foreach $file( #files )
{
if( !( $file =~ m/\./ ) )
{
system( "chmod", "755", $file );
print "PostProcessBuildPlayer: calling " . $file . "\n";
system( $file, $ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3], $ARGV[4], $ARGV[5], $ARGV[6] );
if ( $? == -1 )
{
print "command failed: $!\n";
}
else
{
printf "command exited with value %d", $? >> 8;
}
}
}
Use File::Find to recurse a directory tree
use strict;
use warnings;
use File::Find;
my #files;
find(sub {
push #files, File::Find::name if /^PostprocessBuildPlayer/;
}, 'Assets/');

How to rename multiple files with random names together

I have files with random names and i want to rename all them together like Trace1, Trace2 and so on.... any idea?
Or in Perl:
#!/usr/bin/perl
use strict;
use warnings;
# use dirname() to keep the renamed files in the same directory
use File::Basename qw( dirname );
my $i = 1;
for my $file (#ARGV) {
rename $file, dirname($file) . "/Trace$i";
print "$file -> Trace$i\n";
} continue { $i++ }
If you are new to Linux, you need to also remember to make the script executable (assuming the script was saved in the file named random-renamer):
chmod 755 random-renamer
And then to run it (rename all the files in the random-files directory):
./random-renamer random-files/*
You can just use a shell command:
i=1;
for f in *
do
mv $f "Trace$i"
i=$(($i+1))
done
This checks if there are any existing files named Trace# and avoids clobbering them.
use Path::Class qw( dir );
use List::Util qw( max );
my $dir = dir(...);
my #files =
map $_->basename(),
grep !$_->is_dir(),
$dir->children();
my $last =
max 0,
map /^Trace([0-9]+)\z/,
#files;
my $errors;
for (#files) {
my $old = $dir->file($_);
my $new = $dir->file("Trace" . ++$last);
if (!rename($new, $old)) {
warn("Can't rename \"$old\" to \"$new\": $!\n");
++$errors;
}
}
exit($errors ? 1 : 0);

How to check whether a file exists in a particular directory in perl?

How to check whether a particular file exists in a particular directory in perl?
Obvious method of checking that absolute directory name is prefix of absolute file name doesn't works as sometime absolute directory name is like /a/b/c/..
File::Find's find function could be used:
Program
#!/usr/bin/env perl
use strict;
use warnings;
use File::Find 'find';
# file 'foo' in path 'a/b/c'
my $file = 'foo';
my $directory = 'a';
sub check_existance {
if ( -e $_ && $_ eq $file ) {
print "Found file '$_' in directory '$File::Find::dir'\n";
}
}
find( \&check_existance, $directory );
Output
Found file 'foo' in directory 'a/b/c'
If you don't know the exact path you could use find2perl. It generates File::Find::find() code for you. To execute the command immediately:
$ find2perl /path/to/dir -name filename.txt -exec echo exists {} | perl
Code generated by find2perl
#! /usr/bin/perl -w
eval 'exec /usr/bin/perl -S $0 ${1+"$#"}'
if 0; #$running_under_some_shell
use strict;
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:
use vars qw/*name *dir *prune/;
*name = *File::Find::name;
*dir = *File::Find::dir;
*prune = *File::Find::prune;
sub wanted;
sub doexec ($#);
use Cwd ();
my $cwd = Cwd::cwd();
# Traverse desired filesystems
File::Find::find({wanted => \&wanted}, '/path/to/dir');
exit;
sub wanted {
/^filename\.txt\z/s &&
doexec(0, 'echo','exists','{}');
}
sub doexec ($#) {
my $ok = shift;
my #command = #_; # copy so we don't try to s/// aliases to constants
for my $word (#command)
{ $word =~ s#{}#$name#g }
if ($ok) {
my $old = select(STDOUT);
$| = 1;
print "#command";
select($old);
return 0 unless <STDIN> =~ /^y/;
}
chdir $cwd; #sigh
system #command;
chdir $File::Find::dir;
return !$?;
}
if (-e "/path/to/file/filename.txt") {
print("file exists");
}
?

How can I get all files in a directory, but not in subdirectories, in Perl?

How can I find all the files that match a certain criteria (-M, modification age in days) in a list of directories, but not in their subdirectories?
I wanted to use File::Find, but looks like it always goes to the subdirectories too.
#files = grep { -f && (-M) < 5 } <$_/*> for #folders;
Use readdir or File::Slurp::read_dir in conjunction with grep.
#!/usr/bin/perl
use strict;
use warnings;
use File::Slurp;
use File::Spec::Functions qw( canonpath catfile );
my #dirs = (#ENV{qw(HOME TEMP)});
for my $dir ( #dirs ) {
print "'$dir'\n";
my #files = grep { 2 > -M and -f }
map { canonpath(catfile $dir, $_) } read_dir $dir;
print "$_\n" for #files;
}
You can set File::Find::prune within the 'wanted' function to skip directory trees. Add something like $File::Find::prune = 1 if( -d && $File::Find::name ne ".");

How can I compare file list from a tar archive and directory?

I am still learning Perl. Can anyone please suggest me the Perl code to compare files from .tar.gz and a directory path.
Let's say I have tar.gz backup of following directory path which I have taken few days back.
a/file1
a/file2
a/file3
a/b/file4
a/b/file5
a/c/file5
a/b/d/file and so on..
Now I want to compare files and directories under this path with the tar.gz backup file.
Please suggest Perl code to do that.
See Archive::Tar.
The Archive::Tar and File::Find modules will be helpful. A basic example is shown below. It just prints information about the files in a tar and the files in a directory tree.
It was not clear from your question how you want to compare the files. If you need to compare the actual content, the get_content() method in Archive::Tar::File will likely be needed. If a simpler comparison is adequate (for example, name, size, and mtime), you won't need much more than methods used in the example below.
#!/usr/bin/perl
use strict;
use warnings;
# A utility function to display our results.
sub Print_file_info {
print map("$_\n", #_), "\n";
}
# Print some basic information about files in a tar.
use Archive::Tar qw();
my $tar_file = 'some_tar_file.tar.gz';
my $tar = Archive::Tar->new($tar_file);
for my $ft ( $tar->get_files ){
# The variable $ft is an Archive::Tar::File object.
Print_file_info(
$ft->name,
$ft->is_file ? 'file' : 'other',
$ft->size,
$ft->mtime,
);
}
# Print some basic information about files in a directory tree.
use File::Find;
my $dir_name = 'some_directory';
my #files;
find(sub {push #files, $File::Find::name}, $dir_name);
Print_file_info(
$_,
-f $_ ? 'file' : 'other',
-s,
(stat)[9],
) for #files;
Perl is kind of overkill for this, really. A shell script would do fine. The steps you need to take though:
Extract the tar to a temporary folder somewhere.
diff -uR the two folders and redirect the output somewhere (or perhaps pipe to less as appropriate)
Clean up the temporary folder.
And you're done. Shouldn't be more than 5-6 lines. Something quick and untested:
#!/bin/sh
mkdir $TEMP/$$
tar -xz -f ../backups/backup.tgz $TEMP/$$
diff -uR $TEMP/$$ ./ | less
rm -rf $TEMP/$$
Heres an example that checks to see if every file that is in an archive, also exists in a folder.
# $1 is the file to test
# $2 is the base folder
for file in $( tar --list -f $1 | perl -pe'chomp;$_=qq["'$2'$_" ]' )
do
# work around bash deficiency
if [[ -e "$( perl -eprint$file )" ]]
then
echo " $file"
else
echo "no $file"
fi
done
This is how I tested this:
I removed / renamed config, then ran the following:
bash test Downloads/update-dnsomatic-0.1.2.tar.gz Downloads/
Which gave the output of:
"Downloads/update-dnsomatic-0.1.2/"
no "Downloads/update-dnsomatic-0.1.2/config"
"Downloads/update-dnsomatic-0.1.2/update-dnsomatic"
"Downloads/update-dnsomatic-0.1.2/README"
"Downloads/update-dnsomatic-0.1.2/install.sh"
I am new to bash / shell programming, so there is probably a better way to do this.
This might be a good starting point for a good Perl program. It does what the question asked for though.
It was just hacked together, and ignores most of the best practices for Perl.
perl test.pl full \
Downloads/update-dnsomatic-0.1.2.tar.gz \
Downloads/ \
update-dnsomatic-0.1.2
#! /usr/bin/env perl
use strict;
use 5.010;
use warnings;
use autodie;
use Archive::Tar;
use File::Spec::Functions qw'catfile catdir';
my($action,$file,$directory,$special_dir) = #ARGV;
if( #ARGV == 1 ){
$file = *STDOUT{IO};
}
if( #ARGV == 3 ){
$special_dir = '';
}
sub has_file(_);
sub same_size($$);
sub find_missing(\%$);
given( lc $action ){
# only compare names
when( #{[qw'simple name names']} ){
my #list = Archive::Tar->list_archive($file);
say qq'missing file: "$_"' for grep{ ! has_file } #list;
}
# compare names, sizes, contents
when( #{[qw'full aggressive']} ){
my $next = Archive::Tar->iter($file);
my( %visited );
while( my $file = $next->() ){
next unless $file->is_file;
my $name = $file->name;
$visited{$name} = 1;
unless( has_file($name) ){
say qq'missing file: "$name"' ;
next;
}
unless( same_size( $name, $file->size ) ){
say qq'different size: "$name"';
next;
}
next unless $file->size;
unless( same_checksum( $name, $file->get_content ) ){
say qq'different checksums: "$name"';
next;
}
}
say qq'file not in archive: "$_"' for find_missing %visited, $special_dir;
}
}
sub has_file(_){
my($file) = #_;
if( -e catfile $directory, $file ){
return 1;
}
return;
}
sub same_size($$){
my($file,$size) = #_;
if( -s catfile($directory,$file) == $size ){
return $size || '0 but true';
}
return; # empty list/undefined
}
sub same_checksum{
my($file,$contents) = #_;
require Digest::SHA1;
my($outside,$inside);
my $sha1 = Digest::SHA1->new;
{
open my $io, '<', catfile $directory, $file;
$sha1->addfile($io);
close $io;
$outside = $sha1->digest;
}
$sha1->add($contents);
$inside = $sha1->digest;
return 1 if $inside eq $outside;
return;
}
sub find_missing(\%$){
my($found,$current_dir) = #_;
my(#dirs,#files);
{
my $open_dir = catdir($directory,$current_dir);
opendir my($h), $open_dir;
while( my $elem = readdir $h ){
next if $elem =~ /^[.]{1,2}[\\\/]?$/;
my $path = catfile $current_dir, $elem;
my $open_path = catfile $open_dir, $elem;
given($open_path){
when( -d ){
push #dirs, $path;
}
when( -f ){
push #files, $path, unless $found->{$path};
}
default{
die qq'not a file or a directory: "$path"';
}
}
}
}
for my $path ( #dirs ){
push #files, find_missing %$found, $path;
}
return #files;
}
After renaming config to config.rm, adding an extra char to README, changing a char in install.sh, and adding a file .test. This is what it outputted:
missing file: "update-dnsomatic-0.1.2/config"
different size: "update-dnsomatic-0.1.2/README"
different checksums: "update-dnsomatic-0.1.2/install.sh"
file not in archive: "update-dnsomatic-0.1.2/config.rm"
file not in archive: "update-dnsomatic-0.1.2/.test"