Skip to content

Commit 395d78a

Browse files
ddmitovddmitov
committed
Perl Distribution Compactor
1 parent 7af84b9 commit 395d78a

File tree

12 files changed

+2649
-33
lines changed

12 files changed

+2649
-33
lines changed

‎CREDITS.md‎

Lines changed: 16 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -219,23 +219,32 @@ https://perlbrew.pl/
219219
https://github.com/skaji/relocatable-perl
220220
http://strawberryperl.com/
221221

222+
http://perldoc.perl.org/Encode.html
223+
http://perldoc.perl.org/File/Basename.html
224+
225+
https://metacpan.org/pod/File::Copy::Recursive
226+
https://metacpan.org/pod/Module::ScanDeps
227+
228+
http://www.perl.com/pub/2002/05/14/mod_perl.html
229+
222230
http://www.perlmonks.org/bare/?node_id=768448 "Permanently sort a hash"
223231
http://www.perlmonks.org/?node_id=27443 "Checking to see if a particular Module is installed"
232+
http://www.perlmonks.org/?node_id=982572 "ScanDeps usage"
224233

225234
http://stackoverflow.com/questions/1725097/how-can-i-disable-terminal-polling-for-cpan-used-from-crontab
226235
http://stackoverflow.com/questions/4510550/using-perl-how-do-i-decode-or-create-those-encodings-on-the-web
227236
http://stackoverflow.com/questions/5741101/easy-way-to-print-perl-array-with-a-little-formatting
228237
http://stackoverflow.com/questions/15210532/use-utf8-gives-me-wide-character-in-print
229238
http://stackoverflow.com/questions/787899/how-do-i-use-a-perl-module-from-a-relative-location
239+
http://stackoverflow.com/questions/229357/what-is-the-best-way-in-perl-to-copy-files-into-a-yet-to-be-created-directory-tr
230240

231241
http://perlmaven.com/manipulating-perl-arrays
232242
http://perlmaven.com/how-to-sort-a-hash-in-perl
233243
http://perlmaven.com/recursive-subroutines
234244

245+
http://www.comp.leeds.ac.uk/cgi-bin/Perl/displaytext/cgi-bin/read-input
235246
http://lauraliparulo.altervista.org/first-steps-in-sqlite-and-perl/
236-
http://www.perl.com/pub/2002/05/14/mod_perl.html
237247
http://www.tizag.com/perlT/perlhashes.php
238-
http://www.comp.leeds.ac.uk/cgi-bin/Perl/displaytext/cgi-bin/read-input
239248

240249
## HTML, CSS & JavaScript
241250
http://stackoverflow.com/questions/9051200/twitter-bootstrap-dropdown-menu
@@ -295,6 +304,11 @@ https://github.com/IQAndreas/markdown-licenses
295304
http://stackoverflow.com/questions/6695439/how-to-link-to-a-named-anchor-in-multimarkdown
296305
http://meta.stackexchange.com/questions/70356/key-stroke-combination-markdown
297306

307+
## Bash
308+
http://tldp.org/LDP/abs/html/fto.html
309+
https://www.shellhacks.com/bash-test-if-file-exists/
310+
https://www.shellcheck.net/
311+
298312
## Linux
299313
http://askubuntu.com/questions/501812/how-do-i-provide-arguments-to-a-command-run-from-gksudo
300314

‎compactor.cmd‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
2+
IF EXIST ./perl/bin/perl.exe (
3+
ECHO Going to compact the relocatable Perl for this copy of Perl Executing Browser.
4+
./perl/bin/perl.exe ./sdk/compactor.pl
5+
) ELSE (
6+
ECHO Relocatable Perl is not found for this copy of Perl Executing Browser.
7+
)

‎compactor.sh‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
#! /bin/sh
2+
3+
relocatable_perl="./perl/bin/perl"
4+
5+
if [ -e "$relocatable_perl" ]; then
6+
printf "\nGoing to compact the relocatable Perl for this copy of Perl Executing Browser.\n"
7+
$relocatable_perl ./sdk/compactor.pl
8+
else
9+
printf "\nRelocatable Perl is not found for this copy of Perl Executing Browser.\n"
10+
fi

‎makedmg.sh‎

Lines changed: 28 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -6,16 +6,16 @@ peb_bundle=$1
66
peb_pro=$(dirname $0)"/src/peb.pro"
77

88
require_bundle_config() {
9-
if [ -z "$(egrep -v '^\s*\t*#' $peb_pro | grep 'BUNDLE=1')" ]
10-
then
11-
echo "Failed to create dmg!"
12-
echo "Please, set BUNDLE=1 in $peb_pro file and rebuild project."
13-
echo
14-
echo "Here is one liner to update your configuration: "
15-
echo " perl -pi -e s,BUNDLE=0,BUNDLE=1,g $peb_pro"
16-
echo
17-
exit 1
18-
fi
9+
if [ -z "$(egrep -v '^\s*\t*#' $peb_pro | grep 'BUNDLE=1')" ]
10+
then
11+
echo "Failed to create dmg!"
12+
echo "Please, set BUNDLE=1 in $peb_pro file and rebuild project."
13+
echo
14+
echo "Here is one liner to update your configuration: "
15+
echo " perl -pi -e s,BUNDLE=0,BUNDLE=1,g $peb_pro"
16+
echo
17+
exit 1
18+
fi
1919
}
2020

2121
create_dmg() {
@@ -27,34 +27,33 @@ create_dmg() {
2727
echo "Finished."
2828
}
2929

30-
3130
echo "Perl Executing Browser DMG Packer, $makedmg_version"
3231
echo "Usage: makedmg.sh peb.app"
3332
echo
3433

3534
require_bundle_config
3635

3736
if [ -z "$macdeployqt_bin" ]
38-
then
39-
echo "No macdeployqt found in PATH"
40-
if [ -z "$QTDIR" ]
41-
then
42-
echo "Need to set QTDIR environment variable."
43-
echo "Enter full path to the main Qt SDK directory:"
44-
read qtdirname
45-
set QTDIR = $qtdirname
46-
if [ -z "$QTDIR" ]
47-
then
48-
echo "No QTDIR was set. I have quit now."
49-
exit
50-
fi
51-
echo ""
52-
fi
53-
macdeployqt_bin="$QTDIR/bin/macdeployqt"
37+
then
38+
echo "No macdeployqt found in PATH"
39+
if [ -z "$QTDIR" ]
40+
then
41+
echo "Need to set QTDIR environment variable."
42+
echo "Enter full path to the main Qt SDK directory:"
43+
read qtdirname
44+
set QTDIR = $qtdirname
45+
if [ -z "$QTDIR" ]
46+
then
47+
echo "No QTDIR was set. I have quit now."
48+
exit
49+
fi
50+
echo ""
51+
fi
52+
macdeployqt_bin="$QTDIR/bin/macdeployqt"
5453
fi
5554

5655
if [ -z "$1" ]
57-
then
56+
then
5857
echo "No command line argument supplied."
5958
echo "Trying to guess where peb.app is."
6059
peb_bundle=$(ls -d */peb.app)
@@ -68,4 +67,4 @@ if [ -z "$1" ]
6867
fi
6968

7069
create_dmg
71-
exit 0
70+
exit 0

‎resources/app/perl/ajax-test.pl‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,4 +3,4 @@
33
use strict;
44
use warnings;
55

6-
print "Hello from an AJAX Perl script!";
6+
print "Привет от AJAX Perl скрипт!<br>Hello from an AJAX Perl script!";

‎resources/app/perl/interactive-script.pl‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,11 @@
33
use strict;
44
use warnings;
55
use POSIX qw(strftime);
6+
use Encode qw(decode);
67
binmode STDOUT, ":utf8";
78

89
if (eval("require AnyEvent;")) {
10+
require AnyEvent;
911
AnyEvent->import();
1012
} else {
1113
print "AnyEvent module is missing in this Perl distribution.";
@@ -72,7 +74,7 @@
7274
}
7375

7476
if ($name =~ "input") {
75-
$input_text = $value;
77+
$input_text = decode('UTF-8', $value);
7678
}
7779
}
7880
}

‎resources/app/perl/sqlite.pl‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ ()
4747
}
4848

4949
if (eval("require DBI;")) {
50+
require DBI;
5051
DBI->import();
5152
} else {
5253
html_header();

‎sdk/compactor.pl‎

Lines changed: 106 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,106 @@
1+
2+
use strict;
3+
use warnings;
4+
use 5.010;
5+
6+
# Core modules:
7+
use Config;
8+
use Cwd qw (getcwd);
9+
use File::Basename qw (basename);
10+
use File::Copy;
11+
use File::Spec;
12+
use FindBin qw($Bin);
13+
use File::Spec::Functions qw(catdir);
14+
use lib catdir($Bin, "lib");
15+
16+
# Non-core CPAN modules:
17+
# File::Copy::Recursive and Module::ScanDeps are loaded from
18+
# the 'lib' subdirectory of the directory of this script:
19+
use File::Copy::Recursive qw (fcopy);
20+
use Module::ScanDeps;
21+
22+
print "\nPerl Distribution Compactor for Perl Executing Browser version 0.1.\n\n";
23+
24+
# Directory paths:
25+
my $root = getcwd;
26+
my $app_directory = catdir($root, "resources", "app");
27+
my $perl_directory = catdir($root, "perl");
28+
my $bin_original = catdir($perl_directory, "bin");
29+
my $bin_compacted = catdir($perl_directory, "bin-compacted");
30+
my $lib_original = catdir($perl_directory, "lib");
31+
my $lib_compacted = catdir($perl_directory, "lib-compacted");
32+
33+
# Copying the Perl interpreter:
34+
if ($Config{osname} !~ "MSWin32") {
35+
fcopy (catdir($bin_original, "perl"), catdir($bin_compacted, "perl"));
36+
} else {
37+
fcopy (catdir($bin_original, "perl.exe"), catdir($bin_compacted, "perl.exe"));
38+
39+
my @libraries = traverse_directory($bin_original, ".dll");
40+
foreach my $library (@libraries) {
41+
my $filename = basename($library, ".dll");
42+
fcopy ($library, catdir($bin_compacted, $filename));
43+
}
44+
}
45+
46+
print "Perl interpreter copied.\n\n";
47+
48+
# Subroutine invocation to
49+
# get recursively all Perl scripts in the 'resources/app' subdirectory:
50+
my @scripts = traverse_directory($app_directory, ".pl");
51+
52+
# Get all dependencies from all Perl scripts:
53+
my $script_counter;
54+
foreach my $script (@scripts) {
55+
$script_counter++;
56+
print "Script Nr. $script_counter: $script\n";
57+
58+
my $dependencies_hashref =
59+
scan_deps(files => [$script], recurse => 3, compile => 'true');
60+
61+
my $module_counter;
62+
while (my($partial_path, $module_name) = each(%{$dependencies_hashref})) {
63+
foreach my $include_path (@INC) {
64+
my $module_full_path = catdir($include_path, $partial_path);
65+
if (-e $module_full_path) {
66+
$module_counter++;
67+
print "Dependency Nr. $module_counter: $module_full_path";
68+
69+
fcopy ($module_full_path, catdir($lib_compacted, $partial_path));
70+
print " ... copied.\n";
71+
}
72+
}
73+
}
74+
75+
print "\n";
76+
}
77+
78+
# Rename Perl directories:
79+
rename $bin_original, catdir($perl_directory, "bin-original");
80+
rename $bin_compacted, catdir($perl_directory, "bin");
81+
82+
rename $lib_original, catdir($perl_directory, "lib-original");
83+
rename $lib_compacted, catdir($perl_directory, "lib");
84+
85+
# Perl scripts recursive lister subroutine:
86+
sub traverse_directory {
87+
my ($entry, $file_extension) = @_;
88+
my @files;
89+
90+
return if not -d $entry;
91+
opendir (my $directory_handle, $entry) or die $!;
92+
while (my $subentry = readdir $directory_handle) {
93+
next if $subentry eq '.' or $subentry eq '..';
94+
my $full_path = catdir($entry, $subentry);
95+
if (-f $full_path and $full_path =~ $file_extension) {
96+
push @files, $full_path;
97+
} else {
98+
my @subdirectory_files =
99+
traverse_directory ($full_path, $file_extension);
100+
push @files, @subdirectory_files;
101+
}
102+
}
103+
close $directory_handle;
104+
105+
return @files;
106+
}

0 commit comments

Comments
 (0)