I want to get the details of a directory as like number of files and subdirectories in it and permissions for those.
Yes! it's easy to do it on linux machines using back ticks to execute a command.But is there a way to make the script platform independent.
thanks :)
You can use directory handles (opendir and readdir) to get the contents of directories and File::stat to get the permissions
You might want to consider using Path::Class. This both gives you an easy interface and also handles all the cross platform things (including the difference between "\" and "/" on your platform) for you.
use Path::Class qw(file dir);
my $dir = dir("/etc");
my $dir_count = 0;
my $file_count = 0;
while (my $file = $dir->next) {
# $file is a Path::Class::File or Path::Class::Dir object
if ($file->is_dir) {
$dir_count++;
} else {
$file_count++;
}
my $mode = $file->stat->mode;
$mode = sprintf '%o', $mode; # convert to octal "0755" form
print "Found $file, with mode $mode\n";
}
print "Found $dir_count dirs and $file_count files\n";
Related
I am writing a script to read the content of multiple sub folder in a directory.
And recently i need to read the content of folder inside multiple sub-folder.
Want to ask how can i write the code to read those folder inside multiple sub-folder.
This is the new conditions
Multiple Sub-folder -> Local folder -> fileAAA.csv
how do i read this fileAAA in Local folder of Multiple Sub-folder?
Currently the code i am writing was in this condition and it works well.
Multiple Sub-folder -> fileAAA.csv
Able to read fileAAA from multiple Sub-folder
Below is the code i use to read
Multiple Sub-folder -> fileAAA.csv
my ( $par_dir, $sub_dir );
opendir( $par_dir, "$parent" );
while ( my $sub_folders = readdir($par_dir) ) {
next if ( $sub_folders =~ /^..?$/ ); # skip . and ..
my $path = $parent . '/' . $sub_folders;
next unless ( -d $path ); # skip anything that isn't a directory
opendir( $sub_dir, $path );
while ( my $file = readdir($sub_dir) ) {
next unless $file =~ /\.csv?$/i;
my $full_path = $path . '/' . $file;
print_file_names($full_path);
}
closedir($sub_dir);
$flag = 0;
}
closedir($par_dir);
......
Updated
You should look at the File::Find module which has everything already in place to do searches like this, and has taken account of all corner cases for you
I wrote that on my tablet and at the time I couldn't offer sample code to support it. I believe this will do what you're asking for, which is simply to find all CSV files at any level beneath a parent directory
use strict;
use warnings;
use File::Find qw/ find /;
STDOUT->autoflush;
my $parent = '/Multiple Sub-folder';
find(sub {
return unless -f and /\.csv$/i;
print_file_names($File::Find::name);
}, $parent);
sub print_file_names {
my ($fn) = #_;
print $fn, "\n";
}
Without using moudle try this
Instead of opendir can you try glob for subdirectory search.
In below script i make a subroutine for continuous search.
When elsif condition is satisfied the path of the directory is will go to the find subroutine then it'll seach and so on.
my $v = "/Multiple Sub-folder";
find($v);
sub find{
my ($s) = #_;
foreach my $ma (glob "$s/*")
{
if(-f $ma)
{
if($ma =~m/.csv$/) # Here search for csv files.
{
print "$ma\n";
}
}
elsif(-d $ma)
{
find("$ma")
}
}
}
But can you use File::Find module for search the files in the directory as the answer of Borodin Which is the best approach.
What I am aiming to do is pretty much what it says in the title.
I have the following line of code which simply prints out [view archive] and when I click it the browser just downloads the zip file.
print "\<a href=\"http:\/\/intranet.domain.com\/~devcvs\/view-file.cgi?file=$reviewdata{'document'}&review_id=$reviewdata{'id'}\"\>[view archive]\<\/a\>\n";
What I would love to do is to list the files contained within this zip file anywhere on the page, e.g. just underneath or even a new page which this link links to and takes the filename as a parameter.
I believe once this is done the browser should take care of the rest in terms of just clicking these files and viewing them in the browser as they will be pdfs and html files which I don't foresee any problems with.
I am sure there is a module that does this but I am unsure of how to accomplish my goal using it.
Any help is much appreciated.
Have a look at Archive::Zip :
use strict;
use warnings;
use Archive::Zip qw/ :ERROR_CODES :CONSTANTS /;
my $zipFile = 'someZip.zip';
my $zip = Archive::Zip->new();
unless ( $zip->read( $zipFile ) == AZ_OK ) { # Make sure archive got read
die 'read error';
}
my #files = $zip->memberNames(); # Lists all members in archive
print $_, "\n" for #files;
Using Archive::Zip certainly makes the code easier, and you should probably install that module if you are going to work extensively on zip files.
However, for those who prefer not to install anything, there is a way to list the content of a zip file just using the core module IO::Uncompress::Unzip (already part of any standard Perl distribution).
use strict;
use warnings;
use IO::Uncompress::Unzip qw($UnzipError);
my $zipFile = '/path/to/zipfile.zip';
my $u = IO::Uncompress::Unzip->new($zipFile)
or die "Error: $UnzipError\n";
my $status;
for ($status = 1; $status > 0; $status = $u->nextStream()) {
my $header = $u->getHeaderInfo();
my $zippedFile = $header->{Name};
if ($zippedFile =~ /\/$/) {
last if $status < 0;
next;
}
print "$zippedFile\n";
}
I am writing an SFTP module using a Java class (Yes. I know it's stupid. Yes, I know about Net::SFTP. It's political why we have to do it this way).
The underlying Java program has basically a few classes to get, put, list, and remove the file from the server. In these calls, you have to give it a directory and file. There is no way to move outside of your original directory. You're stuck doing the tracking yourself.
I decided it would be nice if I kept track of your remote directory, and created a Chdir Method that tracks the directory you're in from the root of the FTP. All I do is store the directory inside an attribute and use it in the other commands. Very simple and it works.
The problem is that the stored directory name gets longer and longer. For example, if the directory is foo/bar/barfoo, and you do $ftp->Chdir("../.."), your new directory would be foo/bar/barfoo/../.. and not foo. Both are technically correct, but the first is cleaner and easier to understand.
I would like some code that will allow me to simplify the directory name. I thought about using File::Spec::canonpath, but that specifically says it does not do this. It refered me to Cwd, but that depends upon direct access to the machine, and I'm connecting via FTP.
I've come up with the following code snippet, but it really lacks elegance. It should be simpler to do, and more obvious what it is doing:
use strict;
use warnings;
my $directory = "../foo/./bar/./bar/../foo/barbar/foo/barfoo/../../fubar/barfoo/..";
print "Directory = $directory\n";
$directory =~ s{(^|[^.])\.\/}{$1}g;
print "Directory = $directory\n";
while ($directory =~ s{[^/]+/\.\.(/|$)}{}) {
print "Directory = $directory\n";
}
$directory =~ s{/$}{};
print "Directory = $directory\n";
Any idea? I'd like to avoid having to install CPAN modules. They can be extremely difficult to install on our server.
If I were writing this, I would split the directory string on / and iterate over each piece. Maintaining a stack of pieces, a .. entry means "pop", . means do nothing, and anything else means push that string onto the stack. When you are done, just join the stack with / as the delimiter.
my #parts = ();
foreach my $part (File::Spec->splitdir($directory)) {
if ($part eq '..') {
# Note that if there are no directory parts, this will effectively
# swallow any excess ".." components.
pop(#parts);
} elsif ($part ne '.') {
push(#parts, $part);
}
}
my $simplifiedDirectory = (#parts == 0) ? '.' : File::Spec->catdir(#parts);
If you want to keep leading .. entries, you will have to do something like this instead:
my #parts = ();
my #leadingdots = ();
foreach my $part (File::Spec->splitdir($directory)) {
if ($part eq '..') {
if (#parts == 0) {
push(#leadingdots, '..');
} else {
pop(#parts);
}
} elsif ($part ne '.') {
push(#parts, $part);
}
}
my $simplifiedDirectory = File::Spec->catdir((#leadingdots, #parts));
I have a pure Perl module on CPAN for trimming paths: Path::Trim. Download, copy and use it from your working directory. Should be easy.
I am not sure if you can access that directory.
If you can, you can go to that directory and do a getcwd there:
my $temp = getcwd; # save the current directory
system ("cd $directory"); # change to $directory
$directory = getcwd;
system ("cd $temp"); # switch back to the original directory
The SFTP protocol supports the realpath command that does just what you want.
I am reading a directory having some archive files and uncompressing the archive files one by one.
Everything seems well however the files are getting uncompressed in the folder which has the main perl code module which is running the sub modules.
I want the archive to be generated in the folder I specify.
This is my code:
sub ExtractFile
{
#Read the folder which was copied in the output path recursively and extract if any file is compressed
my $dirpath = $_[0];
opendir(D, "$dirpath") || die "Can't open dir $dirpath: $!\n";
my #list = readdir(D);
closedir(D);
foreach my $f (#list)
{
print " \$f = $f";
if(-f $dirpath."/$f")
{
#print " File in directory $dirpath \n ";#is \$f = $f\n";
my($file_name, $file_dirname,$filetype)= fileparse($f,qr{\..*});
#print " \nThe file extension is $filetype";
#print " \nThe file name is is $file_name";
# If compressed file then extract the file
if($filetype eq ".tar" or $filetype eq ".tzr.gz")
{
my $arch_file = $dirpath."/$f";
print "\n file to be extracted is $arch_file";
my $tar = Archive::Tar->new($arch_file);
#$tar->extract() or die ("Cannot extract file $arch_file");
#mkdir($dirpath."/$file_name");
$tar->extract_file($arch_file,$dirpath."/$file_name" ) or die ("Cannot extract file $arch_file");
}
}
if(-d $dirpath."/$f")
{
if($f eq "." or $f eq "..")
{ next; }
print " Directory\n";# is $f";
ExtractFile($dirpath."/$f");
}
}
}
The method ExtractFile is called recursively to loop all the archives.
When using $tar->extract() it uncompresses in the folder which calls this method.
When I use $tar->extract_file($arch_file,$dirpath."/$file_name") I get an error :
No such file in archive: '/home/fsang/dante/workspace/output/s.tar' at /home/fsang/dante/lib/Extraction.pm line 80
Please help I have checked that path and input output there is no issue with it.
Seems some usage problem I am not aware of for $tar->extract_file().
Many thanks for anyone resolving this issue.
Regards,
Sakshi
You've misunderstood extract_file. The first parameter is the name of a file inside the archive to extract. You're passing in the path of the archive itself. You passed that to new; you don't need to pass it in again. As the error message explains, s.tar does not contain a file named /home/fsang/dante/workspace/output/s.tar, so extract_file fails.
You can get a list of files in the archive by using $tar->list_files.
A simpler solution may be to temporarily chdir to the directory you want to extract the archive into. File::pushd provides an easy way to do that.
a typo?
$tar->extract_file($arch_file,$dirpath."/$file_name" )
should probably be
$tar->extract_file($arch_file,$dirpath."/".$file_name)
$tarFile = "test.tar.gz";
$myTar = Archive::Tar->new($tarFile);
foreach my $member ($myTar->list_files())
{
my $res = $myTar->extract_file( $member , 'C:/temp/'.$member );
print "Exract error!\n" unless ($res);
}
I see a gun being brought to a Swiss Army knife fight.
Here's a *nix one-liner that does what you want:
find /source/dir -name "*.tar" -exec tar -C /target/dir -xvzf '{}' \; -print
Is there a need to write a script for this?
You aren't necessarily doing anything special other than debug lines.
My static web pages are built from a huge bunch of templates which are inter-included using Template Toolkit's "import" and "include", so page.html looks like this:
[% INCLUDE top %]
[% IMPORT middle %]
Then top might have even more files included.
I have very many of these files, and they have to be run through to create the web pages in various languages (English, French, etc., not computer languages). This is a very complicated process and when one file is updated I would like to be able to automatically remake only the necessary files, using a makefile or something similar.
Are there any tools like makedepend for C files which can parse template toolkit templates and create a dependency list for use in a makefile?
Or are there better ways to automate this process?
Template Toolkit does come with its own command line script called ttree for building TT websites ala make.
Here is an ttree.cfg file I use often use on TT website projects here on my Mac:
# directories
src = ./src
lib = ./lib
lib = ./content
dest = ./html
# pre process these site file
pre_process = site.tt
# copy these files
copy = \.(png|gif|jpg)$
# ignore following
ignore = \b(CVS|RCS)\b
ignore = ^#
ignore = ^\.DS_Store$
ignore = ^._
# other options
verbose
recurse
Just running ttree -f ttree.cfg will rebuild the site in dest only updating whats been changed at source (in src) or in my libraries (in lib).
For more fine grained dependencies have a look a Template Dependencies.
Update - And here is my stab at getting dependency list by subclassing Template::Provider:
{
package MyProvider;
use base 'Template::Provider';
# see _dump_cache in Template::Provider
sub _dump_deps {
my $self = shift;
if (my $node = $self->{ HEAD }) {
while ($node) {
my ($prev, $name, $data, $load, $next) = #$node;
say {*STDERR} "$name called from " . $data->{caller}
if exists $data->{caller};
$node = $node->[ 4 ];
}
}
}
}
use Template;
my $provider = MyProvider->new;
my $tt = Template->new({
LOAD_TEMPLATES => $provider,
});
$tt->process( 'root.tt', {} ) or die $tt->error;
$provider->_dump_deps;
The code above displays all dependencies called (via INCLUDE, INSERT, PROCESS and WRAPPER) and where called from within the whole root.tt tree. So from this you could build a ttree dependency file.
/I3az/
In case all you care about are finding file names mentioned in directives such as INCLUDE, PROCESS, WRAPPER etc, one imagine even using sed or perl from the command line to generate the dependencies.
However, if there are subtler dependencies (e.g., you reference an image using <img> in your HTML document whose size is calculated using the Image plugin, the problem can become much less tractable.
I haven't really tested it but something like the following might work:
#!/usr/bin/perl
use strict; use warnings;
use File::Find;
use File::Slurp;
use Regex::PreSuf;
my ($top) = #ARGV;
my $directive_re = presuf qw( INCLUDE IMPORT PROCESS );
my $re = qr{
\[%-? \s+ $directive_re \s+ (\S.+) \s+ -?%\]
}x;
find(\&wanted => $top);
sub wanted {
return unless /\.html\z/i;
my $doc = read_file $File::Find::name;
printf "%s : %s\n", $_, join(" \\\n", $doc =~ /$re/g );
}
After reading the ttree documentation, I decided to create something myself. I'm posting it here in case it's useful to the next person who comes along. However, this is not a general solution, but one which works only for a few limited cases. It worked for this project since all the files are in the same directory and there are no duplicate includes. I've documented the deficiencies as comments before each of the routines.
If there is a simple way to do what this does with ttree which I missed, please let me know.
my #dependencies = make_depend ("first_file.html.tmpl");
# Bugs:
# Insists files end with .tmpl (mine all do)
# Does not check the final list for duplicates.
sub make_depend
{
my ($start_file) = #_;
die unless $start_file && $start_file =~ /\.tmpl/ && -f $start_file;
my $dir = $start_file;
$dir =~ s:/[^/]*$::;
$start_file =~ s:\Q$dir/::;
my #found_files;
find_files ([$start_file], \#found_files, $dir);
return #found_files;
}
# Bugs:
# Doesn't check for including the same file twice.
# Doesn't allow for a list of directories or subdirectories to find the files.
# Warning about files which aren't found switched off, due to
# [% INCLUDE $file %]
sub find_files
{
my ($files_ref, $foundfiles_ref, $dir) = #_;
for my $file (#$files_ref) {
my $full_name = "$dir/$file";
if (-f $full_name) {
push #$foundfiles_ref, $full_name;
my #includes = get_includes ($full_name);
if (#includes) {
find_files (\#includes, $foundfiles_ref, $dir);
}
} else {
# warn "$full_name not found";
}
}
}
# Only recognizes two includes, [% INCLUDE abc.tmpl %] and [% INCLUDE "abc.tmpl" %]
sub get_includes
{
my ($start_file) = #_;
my #includes;
open my $input, "<", $start_file or die "Can't open $start_file: $!";
while (<$input>) {
while (/\[\%-?\s+INCLUDE\s+(?:"([^"]+)"|(.*))\s+-?\%\]/g) {
my $filename = $1 ? $1 : $2;
push #includes, $filename;
}
}
close $input or die $!;
return #includes;
}