I will add some extra file while I make .exe file using perl (PP). Please see my below code for making .exe file.
pp -gui -a 7z.exe -a 7z.dll -o gui_curl.exe gui_curl.pl
Both file are added when .exe build, But it does not work. I don't know why?
I used both file in my code, like below:-
system("7z.exe a $current_dir/$file_name.tar $current_dir");
system("7z.exe a $current_dir/$file_name.gz $current_dir/$file_name.tar");
Please suggest me how to use this file. I don't want to put this file outside from exe
This is my suggested solution. It does not use 7zip which I have no idea how to make work within pp.
It's based on Archive::Tar instead.
#!/usr/bin/perl
use strict;
use warnings;
use Cwd;
use Archive::Tar;
my $current_dir = getcwd();
my $file_name = 'archive';
my #files_to_archive;
opendir(DIR, $current_dir) or die $!;
while (my $file = readdir(DIR)) {
next if ($file =~ m/^\./);
push #files_to_archive, $file;
}
closedir(DIR);
my $tar = Archive::Tar->new;
$tar->add_files(#files_to_archive);
$tar->write("$current_dir/$file_name.tgz", COMPRESS_GZIP);
my $extract_dir = '/tmp/test_arc';
mkdir $extract_dir unless (-d $extract_dir );
chdir $extract_dir;
$tar->extract('archive.tar');
Afterwards, you run
pp -o zipper.exe archive.pl -M Archive::Tar
and you should have your standalone archiver.
Related
This is perl 5, version 30, subversion 1 (v5.30.1) built for MSWin32-x64-multi-thread
Win10
cygwin
I can't figure out how to use opendir. Here is my example code:
sub test($) {
my $dir = shift;
opendir (DIR, $dir) || die "Couldn't open dir $dir $!";
}
sub main() {
my $dir = `pwd`;
test($dir);
}
Error message
Couldn't open dir /home/skidmarks/Projects/Perl
Invalid argument at ./test.py line .
pwd returns a unix formatted directory path ('/'). I have tried it with a windows formatted directory path ('\'). The only thing that works is to use a literal string for the path, e.g., "." or "some_directory_path".
Can't I use a variable in opendir for the path?
The qx (backticks) returns the newline as well, so you need chomp $dir;.
Better yet, why not use Perl's facilities
use Cwd qw(cwd);
my $dir = cwd;
and now you don't have to worry about system commands and how exactly they return.
As the OP uses pwd from cygwin, even once the linefeed is gone the obtained path is unix-style and this conflicts with MSWin32 build of Perl (as reported when opening the file). Using a portable tool (like Cwd above) and a Windows build of Perl should avoid such problems.
Or use a tool to convert paths, like cygpath. See this post
Try following piece of code, it works well with Strawberry perl.
Also try to put full path in double quotes "c:\Program Files\Common Files".
If directory name is not provided then the script will list current directory
Usage: perl script.pl "C:\Users\User_name"
use strict;
use warnings;
use feature 'say';
my $dir_name = shift || '.';
opendir(my $dir, $dir_name)
or die "Couldn't open $dir_name";
map{ say } readdir($dir);
closedir $dir;
NOTE: Navigate in Cygwin terminal to target directory and issue command pwd. Perl script run in Cygwin perhaps will expect the path in this form.
Latest version of Cygwin was installed and tested with slightly modified code -- works fine.
NOTE: pwd is Linux/UNIX command which produces an error in MS Windows, but works in Cygwin which emulates Linux/UNIX environment (binary incompatible, requires recompilation of the programs)
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
sub test($) {
my $dir = shift;
opendir(my $dh, $dir)
or die "Couldn't open dir $dir $!";
map{ say } readdir($dh);
close $dh;
}
sub main() {
my $dir = `pwd`;
chomp $dir;
print "[$dir]\n";
test($dir);
}
main();
Function main is not required in perl (main() function is C/C++ entrance point) and normally code looks like following
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $dir = `pwd`; # pwd is UNIX/Linux command will give an error in MS Windows
chomp $dir; # trim \n at the end of $dir
say "DIRECTORY: [$dir]"; # Let's check what we got
test($dir);
sub test {
my $dir = shift;
opendir(my $dh, $dir)
or die "Couldn't open dir $dir $!";
map{ say } readdir($dh);
close $dh;
}
Recently with a project I inherited a simple perl script that generates a PDF of the page:
#!/usr/bin/perl
use CGI;
my $file="showdata.pdf";
my $filepath= "/tmp/$file";
system("wkhtmltopdf \"sample.com/showdata.php?".$ENV{"QUERY_STRING"}."\" $filepath");
print ("Content-Type:application/x-download\n");
print ("Content-Disposition: attachment; filename=$file\n\n");
open FILE, "< $filepath" or die "can't open : $!";
binmode FILE;
local $/ = \10240;
while (<FILE>){
print $_;
}
close FILE;
unlink ($filepath);
I am concerned direct substitution variable $ENV{"QUERY_STRING"}. However, in a cursory testing, I did not reveal any problems. I was not able to create/delete files in a known writable directory. I tried not well or problems in the script should not be?
Yes, that's insecure. What if QUERY_STRING was "; rm -fr /;?
Then your system call would be:
wkhtmltopdf "sample.com/showdata.php?"; rm -fr /; /tmp/showdata.pdf
Accessing $ENV{"QUERY_STRING"} directly is insecure. In my case, my digital parameter 'o' must be forced to be integer. There is secure script version:
#!/usr/bin/perl
use CGI;
my $query = new CGI;
my $o = int($query->param('o'));
my $file="showdata.pdf";
my $filepath= "/tmp/$file";
system("wkhtmltopdf \"sample.com/showdata.php?o=".$o."\" $filepath");
print ("Content-Type:application/x-download\n");
print ("Content-Disposition: attachment; filename=$file\n\n");
open FILE, "< $filepath" or die "can't open : $!";
binmode FILE;
local $/ = \10240;
while (<FILE>){
print $_;
}
close FILE;
unlink ($filepath);
If you concern about security, run your Perl script with taint option -T.
For example, the following script will halt your script with warning: Insecure $ENV{PATH} while running with -T switch at ./foo.pl line 4.
#!/usr/bin/perl -T
my $foo = $ENV{FOO};
system("ls -l $foo");
Note: option -t can be used instead of -T if you just need warning.
I want to copy the folder from one directory to another.
For Example
I have folder in D drive like Sample it that itself contain many folder.I want to copy this sample folder with its sub folders to some other drive.Here i have done something but it copies only the files.
#!/usr/bin/env perl
use strict;
use warnings;
use File::Copy,
my $source_dir = "aa";
my $target_dir = "bb";
opendir(my $DIR, $source_dir) || die "can't opendir $source_dir: $!";
my #files = readdir($DIR);
foreach my $t (#files)
{
if(-f "$source_dir/$t" ) {
#Check with -f only for files (no directories)
copy "$source_dir/$t", "$target_dir/$t";
}
}
closedir($DIR);
Please help with this...
Thanks in advance
You need to use either the File::Copy::Recursive module, which has a number of related functions from which you probably want dircopy; or the File::Mirror module, which has a mirror function that does the same as dircopy, plus a recursive function that allows you to provide a block of code to control exactly how the nodes will be copied.
use strict;
use warnings;
use File::Copy::Recursive qw(dircopy);
dircopy($source_dir,$target_dir) or die("$!\n");
I tried to run a simple copy of one file to another folder using Perl
system("copy template.html tmp/$id/index.html");
but I got the error error: The syntax of the command is incorrect.
When I change it to
system("copy template.html tmp\\$id\\index.html");
The system copies another file to the tmp\$id foler
Can someone help me?
I suggest you use File::Copy, which comes with your Perl distribution.
use strict; use warnings;
use File::Copy;
print copy('template.html', "tmp/$id/index.html");
You do not need to worry about the slashes or backslashes on Windows because the module will take care of that for you.
Note that you have to set relative paths from your current working directory, so both template.html as well as the dir tmp/$id/ needs to be there. If you want to create the folders on the fly, take a look at File::Path.
Update: Reply to comment below.
You can use this program to create your folders and copy the files with in-place substitution of the IDs.
use strict; use warnings;
use File::Path qw(make_path);
my $id = 1; # edit ID here
# Create output folder
make_path("tmp/$id");
# Open the template for reading and the new file for writing
open $fh_in, '<', 'template.html' or die $!;
open $fh_out, '>', "tmp\\$id\index.html" or die $!;
# Read the template
while (<$fh_in>) {
s/ID/$id/g; # replace all instances of ID with $id
print $fh_out $_; # print to new file
}
# Close both files
close $fh_out;
close $fh_in;
I have a directory hierarchy with a bunch of files. Some of the directories start with a ..
I want to copy the hierarchy somewhere else, leaving out all files and dirs that start with a .
How can one do that?
I think what you want is File::Copy::Recursive's rcopy_glob():
rcopy_glob()
This function lets you specify a
pattern suitable for perl's glob() as
the first argument. Subsequently each
path returned by perl's glob() gets
rcopy()ied.
It returns and array whose items are
array refs that contain the return
value of each rcopy() call.
It forces behavior as if
$File::Copy::Recursive::CPRFComp is
true.
If you're able to solve this problem without Perl, you should check out rsync. It's available on Unix-like systems, on Windows via cygwin, and perhaps as a stand-alone tool on Windows. It will do what you need and a whole lot more.
rsync -a -v --exclude='.*' foo/ bar/
If you aren't the owner of all of the files, use -rOlt instead of -a.
Glob ignores dot files by default.
perl -lwe'rename($_, "foo/$_") or warn "failure renaming $_: $!" for glob("*")'
The code below does the job in a simple way but doesn't handle symlinks, for example.
#! /usr/bin/perl
use warnings;
use strict;
use File::Basename;
use File::Copy;
use File::Find;
use File::Spec::Functions qw/ abs2rel catfile file_name_is_absolute rel2abs /;
die "Usage: $0 src dst\n" unless #ARGV == 2;
my($src,$dst) = #ARGV;
$dst = rel2abs $dst unless file_name_is_absolute $dst;
$dst = catfile $dst, basename $src if -d $dst;
sub copy_nodots {
if (/^\.\z|^[^.]/) {
my $image = catfile $dst, abs2rel($File::Find::name, $src);
if (-d $_) {
mkdir $image
or die "$0: mkdir $image: $!";
}
else {
copy $_ => $image
or die "$0: copy $File::Find::name => $image: $!\n";
}
}
}
find \©_nodots => $src;
cp -r .??*
almost perfect, because it misses files beginning with . and followed by a single sign. like - .d or .e
echo .[!.] .??*
this is even better
or:
shopt -s dotglob ; cp -a * destination; shopt -u dotglob
I found File::Copy::Recursive's rcopy_glob().
The following is what is showed in the docs but is deceptive.
use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
it does not import rcopy_glob() and the only way I found to use it was to be explict as follows:
use File::Copy::Recursive;
File::Copy::Recursive::rcopy_glob("glob/like/path","dest/path");