Fetch and upload files and prefixed files to s3 using perl - perl

I am trying to fetch files from s3 using Amazon::S3 module in Perl . I am successfully able to download files which are not prefixed but unable to fetch prefixed files like test/abc.txt.
I am using below code.
sub export_bucket {
my ($conn, $bucket, $directory) = #_;
$bucket = $conn->bucket($bucket);
my $response = $bucket->list();
print $response->{bucket}."\n";
for my $key (#{ $response->{keys} }) {
print "\t".$key->{key}."\n";
_export_file($conn,$bucket,$key->{key}, $directory.'/'.$key->{key});
}
}
sub _export_file {
my ($conn,$bucket,$name,$path) = #_;
print "Downloading $name file","\n";
my $test = $bucket->get_key_filename($name,'GET',$path);
print Dumper($test);
my $acl = $bucket->get_acl($name);
print Dumper($acl);
open my $acl_file, '>', $path.'.acl';
print $acl_file $acl;
close $acl_file;
}
Suggest me what changes should i make so that when a prefixed/folder comes i should be able to download the folder as well.
Thanks

You need to modify you code to create the target directory on your local filesystem if it does not already exist. It should look something like this:
use File::Path qw[make_path];
sub export_bucket {
my ( $conn, $bucket, $directory ) = #_;
$bucket = $conn->bucket($bucket);
my $response = $bucket->list();
print $response->{bucket} . "\n";
for my $key ( #{ $response->{keys} } ) {
print "\t" . $key->{key} . "\n";
_export_file( $conn, $bucket, $key->{key}, $directory . '/' . $key->{key} );
}
}
sub _export_file {
my ( $conn, $bucket, $name, $path ) = #_;
print "Downloading $name file", "\n";
my $test = $bucket->get_key_filename( $name, 'GET', $path );
print Dumper($test);
my $acl = $bucket->get_acl($name);
print Dumper($acl);
## get path directory part
my ($dir_part) = $path =~ /(.+)\/[^\/]+$/;
unless ( -d $dir_part ) {
make_path($dir_part);
}
open my $acl_file, '>', $path . '.acl';
print $acl_file $acl;
close $acl_file;
}

Perhaps $directory has a trailing "/" already in the case that is failing (or $key->{key} has a preceding slash)? Try debug-printing $directory and $path in the code to see exactly what your string arguments are.

Related

How to go one up folder level using perl?

I'd like to know to search sub-folders if I'm already in the subdirectory.
ex: ..build/clean/test/subfolder <-----
i've already scripted on how to get to test but can't figure out how to go into the subfolder.
The script looks something like this:
Directory Handle in Perl Not Working Properly
sub response {
foreach my $arg (#ARGV) {
print "Investigating $arg directory below:-\n";
opendir(my $DIR, $arg) or die "You've Passed Invalid Directory as Arguments\n";
my $size = 0;
while(my $fileName = readdir $DIR) {
next if $fileName =~ /^\./;
my $path = File::Spec->catfile( $arg, $fileName );
if( -d $path) {
say "Folder1($arg, $fileName)"
}
$size++;
}
closedir $DIR;
if($size == 0) {
print "The $arg is an empty directory\n";
}
}
This is the sub folder
sub Folder1
{
my $prevPath = shift;
my $receivedFolder = shift;
my $realPath = "$prevPath/$receivedFolder";
my $path = File::Spec->rel2abs($realPath);
print "$path\n";
print "$receivedFolder Folder Received\n";
foreach my $folder (#folder)
{
opendir(DIR, $path) or die "You've Passed Invalid Directory as Arguments\n";
while(my $file = readdir $DIR) {
next if $file =~ /^\./;
my $path1 = File::Spec->catfile( $folder, $file );
if( -d $path1) {
say "Folder2($folder2, $file)"
}
closedir(DIR);
}
The sub 2 folder
sub Folder2 {
my $prevPath1 = shift;
my $receivedFolder1 = shift;
my $realPath1 = "$prevPath1/$receivedFolder1";
my $path1 = File::Spec->rel2abs($realPath1);
print "$path1\n";
print "$receivedFolder1 Folder Received\n";
opendir(DIR, $path1) or die "You've Passed Invalid Directory as Arguments\n";
while(my $file = readdir DIR) {
print "Current Folder has $file file\n";
}
closedir(DIR)
}
I'd like to read the files inside of sub 2 folder. However, i keep going back to the main directory using the sub 2 folder.
my #arg = ('clean');
my #folder = ('logs');
However, inside the build directory there is also a logs folder. It will be re-directed to there instead of the ../clean/test/logs
For working with paths, I'd strongly recommend Path::Tiny.
use Path::Tiny 'path';
my $path = path "/home/tai/Documents/";
for my $child ( $path->children ) {
print "$child\n" if $child->is_file;
}
my $parent = $path->parent;
print "PARENT: $parent\n";
The question is not very well conveyed without any attempt to provide a code.
Perhaps something like following code snippet can clarify possible approach to the problem.
use strict;
use warnings;
use feature 'say';
my $dir = '.';
folder_dive($dir);
sub folder_dive {
my $folder = shift;
say "In folder: $folder";
for ( glob("$folder/*") ) {
say "directory $_" if -d; # if we got a directory
say "file $_" if -f; # if we got a file
say "\ta file" if -f;
say "\ta link" if -l;
say "\ta socket" if -S;
say "\ta pipe" if -p;
say "\ta block device" if -b;
say "\ta char device" if -c;
say "\ta text" if -T;
say "\ta binary" if -B;
say "\treadable" if -r;
say "\twritable" if -w;
say "\texecutable" if -x;
say "\towned by user" if -o;
say "\treadable by real user" if -R;
say "\twritable by real user" if -W;
say "\texecutable by real user" if -X;
say "\towned by real user" if -O;
say "\tzero size" if -z;
say "\tnonzero size" if -s;
say "\tsetuid" if -u;
say "\tsetguid" if -g;
say "\tsticky bit set" if -k;
say "\tisatty is true" if -t;
folder_dive("$_") if -d; # if we got a directory
}
}
Please visit following page How to ask
Documentation Perl File Test Operators

Perl -two list matching elements

I am trying to grab the list of the files jenkins has updated from last build and latest build and stored in a perl array.
Now i have list of files and folders in source code which are considered as sensitive in terms of changes like XXXX\yyy/., XXX/TTTT/FFF.txt,...in FILE.TXT
i want that script should tell me if any these sensitive files was part of my changed files and if yes list its name so that we can double check with development team about is change before we trigger build .
How should i achieve this , and how to ,compare multiple files under one path form the changed path files .
have written below script ---which is called inside the jenkins with %workspace# as argument
This is not giving any matching result.
use warnings;
use Array::Utils qw(:all);
$url = `curl -s "http://localhost:8080/job/Rev-number/lastStableBuild/" | findstr "started by"`;
$url =~ /([0-9]+)/;
system("cd $ARGV[1]");
#difffiles = `svn diff -r $1:HEAD --summarize`;
chomp #difffiles;
foreach $f (#difffiles) {
$f = substr( $f, 8 );
$f = "$f\n";
}
open FILE, '/path/to/file'
or die "Can't open file: $!\n";
#array = <FILE>;
#isect = intersect( #difffiles, #array );
print #isect;
I have manged to solve this issue using below perl script -
sub Verifysensitivefileschanges()
{
$count1=0;
#isect = intersect(#difffiles,#sensitive);
#print "ISECT=#isect\n";
foreach $t (#isect)
{
if (#isect) {print "Matching element found -- $t\n"; $count1=1;}
}
return $count1;
}
sub Verifysensitivedirschanges()
{
$count2=0;
foreach $g (#difffiles)
{
$dirs = dirname($g);
$filename = basename($g);
#print "$dirs\n";
foreach $j (#array)
{
if( "$j" =~ /\Q$dirs/)
{print "Sensitive path files changed under path $j and file name is $filename\n";$count2=1;}
}
}
return $count2;
}

Search directory and store in hash

From user's input, I should able to search its sub directories until the fixed directory which named 'list'. The question is how to store the path into hash so that I could retrieve the data and display it afterwards.
my directory tree:
->blue -->Aug21 --->projA ---->list ----->name
/tmp/general/place/brand->red -->Jan03
->yellow -->June22 --->projB ---->list
directory.pl:
use strict;
use warnings;
print "Searching Directory...\n";
&search_dir('/tmp/general/place/brand'); #could be 'tmp/general/place/brand/blue/Aug21'
my ($input,$tt,$str,$fn,#pp,#cap);
sub search_dir{
$input=shift;
opendir DH,$input or die"$!";
while($_=readdir(DH)){
next if $_ eq "." or $_ eq "..";
if ($_ eq "list"){
$fn = $input.'/'.$_;
push #pp, $fn;
return;
}
else{
$fn = $input.'/'.$_;
}
if(-d $fn){
push #cap,$fn;
}
}
if(scalar #cap == 0){
return;
}
foreach (#cap){
&search_dir($_) ;
}
}
if (#pp){
print "Located directory...\n";
foreach $tt (#pp){
$str='/tmp/general/place/brand';
$tt=~ s/$str//g;
print $tt,"\n";
#Hash? $file{$color}{$date}{$quantity}{$list}= split (/\//,$tt);
}
}
else {
print "Could not locate directory\n";
}
Expected Output:
Searching Directory...
Located Directory...
/blue/Aug21/projA/list
/yellow/June22/projB/list
Info :1
Color :blue
Date :Aug21
Project :projA
Info :2
Color :yellow
Date :June22
Project:projB
Under linux it maybe easier to use find. Quick and dirty but it will do the job.
my #dirs = `/usr/bin/find -name "/tmp/general/place/brand/" -type d`;
chomp(#dirs);
my $data = {};
foreach my $dir (#dirs){
my #path = split(/\//,$dir);
#you have found a list in the right depth
if (scalar(#path) >= 7 && $path[7] eq 'list'){
$dir =~ s!/tmp/general/place/brand!!is;
print "Found $dir\n";
print "Color :".$path[4];
...
}
}

Perl recursion through filesystem (without File:Find) follows "top" one path only

The general problem: Iterate through a windows folder structure, without the use of Find::File and rename all folders to be some short value. This is intended to fix the classic "windows file paths are more then 256 characters" problem.
My problem: I've got everything working, except that it will correctly process a single path through the tree, but not any others and I can't see why.
Note: use File:Find is still present, though not used, and the code is likely in-elegant. It renames the current folder, then iterates through subfolders.
Code:
use strict;
use File::Find;
use File::Copy;
use File::Path;
my $target = "E:\\bl10s\\";
opendir( DIR, $target );
my $newFolderName = 0;
my $file;
while ( $file = readdir(DIR) ) {
# A file test to check that it is a directory
# Use -f to test for a file
next if ( $file eq "." );
next if ( $file eq ".." );
next if ( -f "$target\\$file" );
print "$target/$file" . "\n";
while ( -e $target . $newFolderName ) {
$newFolderName++;
}
print $target. $file . " rename to " . $target . $newFolderName . "\n";
rename( $target . $file, $target . $newFolderName );
}
closedir(DIR);
opendir( DIR, $target );
while ( $file = readdir(DIR) ) {
next if ( $file eq "." );
next if ( $file eq ".." );
if ( -f "$target\\$file" )
{
print "Failed name check on itterator main line \n";
}
my $nextDirectoryPathCalled = $target . $file;
print "Re-iterating on: " . $nextDirectoryPathCalled;
my $someint = &stripper($nextDirectoryPathCalled);
}
closedir(DIR);
# find( \&dir_names, $target );
sub stripper {
print "\nNew level\n";
print "$_[0] . \n";
my $target = $_[0] . "\\";
opendir( DIR, $target );
my $newFolderName = 0;
my $file;
while ( $file = readdir(DIR) ) {
# A file test to check that it is a directory
# Use -f to test for a file
next if ( $file eq "." );
next if ( $file eq ".." );
next if ( -f "$target\\$file" );
print "TARGET: $target FILE: $file" . "\n";
while ( -e $target . $newFolderName ) {
$newFolderName++;
}
print $target
. $file
. " rename to "
. $target
. $newFolderName . "\n";
rename( $target . $file, $target . $newFolderName );
}
closedir(DIR);
opendir( DIR, $target );
while ( $file = readdir(DIR) ) {
next if ( $file eq "." );
next if ( $file eq ".." );
next if ( -f "$target\\$file" );
my $nextDirectoryPathCalled = $target . $file;
print "Re-iterating on: " . $nextDirectoryPathCalled;
&stripper($nextDirectoryPathCalled);
}
closedir(DIR);
}
Any ideas? Feel free to be critical...
Thanks
When doing recursion, it is important that each level has its own set of variables, and does not change those of upper levels. Take for example this implementation of the factorial, which is:
fac(n) = 1 · 2 · 3 · … · n
In naïve Perl code, we could write
sub fac {
$n = shift;
return 1 if $n < 2;
return $n * fac($n-1);
}
Output for fac(10) is 1. This is cleary wrong, we expected 1*2*3*4*5*6*7*8*9*10 = 3628800.
The problem is that each recursion level assigned to the same $n variable. We have the following call stack:
fac(10)
$n = 10
fac(9) * $n
$n = 9
fac(8) * $n * $n
$n = 8
...
fac(1) * $n * $n * $n * $n * $n * $n * $n * $n * $n * $n
$n = 1
return 1
So all of that evaluates to 1. Duh.
We can give each level a different $n variable by declaring it with my:
sub fac {
my $n = shift;
return 1 if $n < 2;
return $n * fac($n-1);
}
Now, everything works as expected.
In Perl, bareword filehandles are global variables. When you do
opendir DIR, $somepath;
then you assign a handle to that global bareword. While recursing, you constantly reassign to it. When your function returns from a lower level, the handle does not get the previous value back.
Instead, you should use lexical variables for your handles as well:
opendir my $dir, $somepath;
Then each invocation of your subroutine has its own, non-global dirhandle, and everything should work as expected.
Using File::Find handles all of that complexity behind the scenes, and just makes the correct element directly available to your callback. It is robust, widely used, so you should really see if you shouldn't be using the find function from that module instead.

How to rename directories recursively

I want to rename directories recursively using File::Find::Rule, eg. remove extra spaces in each found but as I understand the module doesn't do finddepth and renames only one. Is there a way to do that. Thanks.
use autodie;
use strict ;
use warnings;
use File::Find::Rule;
my $dir = 'D:/Test';
my #fd = File::Find::Rule->directory
->in( $dir );
for my $fd ( #fd ) {
my $new = $fd;
$new =~ s/\s\s+/ /g;
print "$new\n";
rename $fd, $new;
}
You want to process the deeper results first, so process the list in reverse. You can only rename the leaf part of the path; you'll get to the more shallow parts later.
use Path::Class qw( dir );
for ( reverse #fd ) {
my $dir = dir($_);
my $parent = $dir->parent;
my $old_leaf = my $new_leaf = $dir->dir_list(-1);
$new_leaf =~ s/\s+/ /g;
if ($new_leaf ne $old_leaf) {
my $old_file = $parent->dir($old_leaf);
my $new_file = $parent->dir($new_leaf);
# Prevent accidental deletion of files.
if (-e $new_file) {
warn("$new_file already exists\n");
next;
}
rename($old_file, $new_file);
}
}
Answer to original question:
I don't see how FFR comes into play.
rename 'Test1/Test2/Test3', 'Test1/Test2/Dir3';
rename 'Test1/Test2', 'Test1/Dir2';
rename 'Test1', 'Dir1';
For arbitrary paths,
use Path::Class qw( dir );
my #parts1 = dir('Test1/Test2/Test3')->dir_list();
my #parts2 = dir('Dir1/Dir2/Dir3' )->dir_list();
die if #parts1 != #parts2;
for (reverse 0..$#parts1) {
my $path1 = dir(#parts1[ 0..$_ ]);
my $path2 = dir(#parts2[ 0..$_ ]);
rename($path1, $path2);
}
Or maybe you want to rename all Test1 to Dir1, Test2 to Dir2, and Test3 to Dir3, process the list in reverse order.
my %map = (
'Test1' => 'Dir1',
'Test2' => 'Dir2',
'Test3' => 'Dir3',
);
my $pat = join '|', map quotemeta, keys %map;
for ( reverse #fd ) {
my $o = $_;
my $n = $_;
$n =~ s{/\K($pat)\z}{$map{$1}};
if ($n ne $o) {
if (-e $n) {
warn("$n already exists\n");
next;
}
rename($o, $n);
}
}
I have a module for doing actions recursively in a directory tree. It didn't have the ability to act on the directories themselves though, so it took a little updating. I have uploaded version 0.03 of my File::chdir::WalkDir, but until it shows up, it can be installed from its GitHub repo, and now available using your fav CPAN utility. This script would then remove spaces from directory names inside the base directory 'Test' relative to the working directory:
#!/usr/bin/env perl
use strict;
use warnings;
use File::chdir::WalkDir 0.030;
use File::Copy;
my $job = sub {
my ($name, $in_dir) = #_;
#ONLY act on directories
return 0 unless (-d $name);
my $new_name = $name;
if ($new_name =~ s/\s+/ /g) {
move($name, $new_name);
}
};
walkdir( 'Test', $job, {'act_on_directories' => 1} );