Unzipping files in perl with wildcard file name - perl

I am using the Archive::Zip module to extract a specific file.
my $file = shift
my $zip = Archive::Zip->('zipped.zip');
$zip->extractMember($file.'txt');
The problem is that sometimes the complete file name is not known, and I want to do something like this:
$zip->extractMember($file.*.'txt');
I searched around online and can't find anything for this module (or any similar module). Is there a module that allows for wildcarding in file extraction?

It seems you could use the documented membersMatching($regex) method:
my #files = $zip->membersMatching(qr/$file.*\.txt/);
$zip->extractMember($_) for #files;

Related

Find symlink using Find in Perl

I have faced some issue on how to find a symlink inside a directory using Find library, it can't be found and I am very new in using Perl.
use strict;
use warnings;
use File::Find::Rule;
use File::Find;
use File::Copy;
my #files = File::Find::Rule->file()
->name( 'table.txt' )
->in( '/a/b/c' );
for my $file (#files)
{
print "\nfile: $file\n";
Supposedly there is another directory that contain the specified file, table.txt, but it is a symlink that is /a/b/d, but the symlink is not there when it is printed out.
The File::Find::Rule implements the -X filetests, as methods. The one that tests whether an entry is a symlink (-l) is called symlink.
In my reading of the question you don't know the name of that directory (otherwise, why "find" a file in it?), except that it is a symbolic link. Then you need to first find directories which are symlinks, then find files in them. For this second task you'll need to tell the module to follow the links.
I use a test structure on disk
test_find/a/c/c.txt
test_find/a/b/b.txt
test_find/is_link -> a/c ("is_link" is a symbolic link to "a/c")
and from the directory right above it I run the program
use warnings;
use strict;
use feature 'say';
use File::Find::Rule;
my $top_dir = shift #ARGV || './test_find';
my #symlink_dirs = File::Find::Rule->directory->symlink->in($top_dir);
foreach my $dir (#symlink_dirs) {
my #files = File::Find::Rule->file->extras({follow => 1})->in($dir);
say "in $dir: #files";
}
which prints
in test_find/is_link: test_find/is_link/c.txt
Note that the program will find all files in all directories which are symlinks. Writing an explicit loop as above allows you to add code to decide which of the symlink-directories to actually search. If you don't mind looking through all of them you can just do
my #files = File::Find::Rule->file->extras({follow => 1})->in(#symlink_dirs);
See documentation for features to limit the search using what you know about the directory/file.
If the link directory is in a hierarchy not including the target, then simply search that hierarchy.
With test structure
other_hier/is_link -> ../test_find/a/c
test_find/a/c/c.txt
you only need to tell it to follow the links
my #all_files = File::Find::Rule # may use linebreaks and spaces
-> file
-> extras({ follow => 1 })
-> in('other_hier');
When added to the above program and printed this adds
another/is_link/c.txt
You can of course replace the literal 'other_hier' with $top_dir and invoke the program with argument other_hier (and make that other_hier directory and the link in it).
If both link and target are in the same hierarchy that is searched then you can't do this; the search would run into circular links (the module detects that and exits with error).

Perl recursively copy files of specific format [duplicate]

This question already has answers here:
How can I copy a directory recursively and filter filenames in Perl?
(5 answers)
Closed 8 years ago.
Note: The related question is solved by use of a deprecated module and is not consistent across OS. The answer to current question uses newer modules and hence is being posted here.
I have a module that in turn uses the File::NCopy CPAN module for recursively copying files from to .
The problem is - I need to recursively copy only the files of specific file type to the destination. Is there any way to filter the source by extension?
As an alternative - is there a way to copy all files except the hidden files? My main problem being the .git folder also gets copied - which is not desired.
Platform: MacOS
Alternatives explored:
1) File::Copy::Recursive module :- seems to provide only recursive copy of files or directories. Does not seem to help with either hidden files or exclude filter
2) Using rsync -avz --exclude=".*" :- unable to combine this with recursive copy functionality.
3) Homegrown solution similar to How can I copy a directory recursively and filter filenames in Perl? :- Might be the last resort - but does not seem portable unless tweaked and tested across different platforms. Will be falling back to this unless a module already exists.
4) https://metacpan.org/pod/Path::Class::Dir :- Seems plausible - will be running a quick implementation using this.
Implemented Solution:
I used the recursive module and the Path::Class::Dir
dir($sourceDir)->recurse(callback => sub {
my $file = shift;
return if($file eq '.' || $file eq '..');
return if -d $file;
if (<custom filter>)
{
my $path = file($file)->relative($sourceDir);
fcopy("$sourceDir/$path", "$destinationDir/$path") or die "Could not perform fcopy: $!";
}
});
Without the relative path - the destination folder structure does not seem to be the same as the source folder structure.
I think the easiest solution is to use File::Copy::Recursive to copy the directory structure fully, and then to go back with File::Find::Rule to determine all the dirs that you want to filter and then remove them.
Given that .git folders don't necessarily hold that much data, I think the performance hit from copying more files than you need to is likely to be pretty small. The following would be sufficient to accomplish what you desire:
use strict;
use warnings;
use File::Copy::Recursive qw(dircopy pathrmdir);
use File::Find::Rule;
my $src = '...src...';
my $dest = '...dest...';
dircopy($src, $dest) or die "Can't dircopy: $!";
my #git = File::Find::Rule->directory()
->name('.git')
->in($dest);
pathrmdir($_) or die "Can't remove $_: $!" for (#git);
Alternatively, if you'd like to roll your own, you might take a look at File::Find::Rule #Further Examples which includes an example on how to "ignore CVS directories".

Copying files with different extensions

I am new to perl and i am trying to create a script which can copy several files with different extensions from one directory to another. I am trying to use an Array but not sure if this is possible but i am open to other ways if it is easier.
My code looks something like this;
my $locationone = "filepath"
my $locationtwo = "filepath"
my #files = ("test.txt", "test.xml", "test.html");
if (-e #files){
rcopy($locationone, $locationtwo)
}
The code might be a little rough because i'm going off the top of my head and i'm still new to perl.
I'd really appreciate the help.
Regards
The original idea you have, is right, but it misses something.
...
use File::Copy; # you will use this for the copy!
...
my $dest_folder = "/path/to/dest/folder";
my #sources_filenames = ("test.txt", "test.xml", "test.html");
my $source_folder = "/path/to/source/folder";
We set some useful variables: folder names and an array of file names.
foreach my $filename (#sources_filename) {
We run into the file names
my $source_fullpath = "$source_folder/$filename"; # you could use
my $dest_fullpath = "$dest_folder/$filename"; # File::Spec "catfile" too.
Then we build (for each file) a full path starting name and a full path destination name.
copy($source_fullpath, $dest_fullpath) if -e $source_fullpath;
Lastly we copy only if file exists.
}
You can do something like this:
foreach my $file (#files)
{
next unless (-e "$locationone/$file");
`mv $locationone/$file $locationtwo`;
}

Perl - How to crawl a directory, parse every file in the directory and extract all comments to html file

I need some serious help, I'm new to perl and need help on how to create a perl script that would prompt the user for a directory containing perl files, parse every file in that directory and then extract all comments from each file to individual html files.
code examples or existing modules that already does this would be great.
Thank you!
PPI can be used to parse Perl code files. This should get you started on getting Perl files in a directory (assuming they have .pl extensions) and grabbing the comments. I'm not sure what you mean about the HTML piece:
use warnings;
use strict;
use PPI;
my $dir = shift;
for my $file (glob "$dir/*.pl") {
my $doc = PPI::Document->new($file);
for my $com (#{ $doc->find('PPI::Token::Comment') }) {
print $com->{content};
}
}
Update: Look at HTML::Template (but it may be overkill).
A simple cpan search with keyword "dir" turned up a whole slew of helpful modules. One of the ones I use a lot is:
IO::Dir
If you have a choice, here's a Ruby script
#!/usr/bin/env ruby
print "Enter directory: "
directory=File.join(gets.chomp,"*.pl")
directory="/home/yhlee/test/ruby/*.pl"
c=0
Dir[directory].each do |file|
c+=1
o = File.open("file_#{c}.html","w")
File.open(file).each do |line|
if line[/#/]
o.write ( line.scan(/;*\s+(#.*)$/)[0].first + "\n" ) if line[/;*\s+#/]
o.write ( line.scan(/^\s+(#.*)$/)[0].first + "\n") if line[/^\s+#/]
end
end
o.close
end

How do I return absolute path names for files using Perl glob?

I have some Perl code which has file glob operation.
$file1 = #ARGV[0];
#res1 = glob "$file1*";
I want the whole absolute paths to be reflected when i glob the files, not just the file names which is the case currently in my code.
e.g. when I do glob "*.pdf" i need the absolute paths of the pdf files to be matched and returned to my array variable by glob.
I tried using module use File::Basename;
but that seems to be used for parsing a file path into directory, file name , suffix.
How do I get this effect.
thanks,
-AD.
You want to use the core module Cwd to get the full path with respect to your current working directory.
use Cwd;
#res1 = map { Cwd::abs_path($_) } glob "$file1*";
You want to use the standard module File::Spec. It has a sub, rel2abs() which is exactly what you want. See perldoc File::Spec for details. Also, see perldoc perlmodlib for the list of standard modules and pragmatics that are install along with Perl.