line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Simple::Filter::SanitiseCompiled; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Load the basic Perl pragmas. |
4
|
1
|
|
|
1
|
|
958
|
use 5.010000; |
|
1
|
|
|
|
|
3
|
|
5
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
6
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
40
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# Load the Perl pragma Exporter. |
9
|
1
|
|
|
1
|
|
12
|
use vars qw(@ISA @EXPORT @EXPORT_OK); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
72
|
|
10
|
1
|
|
|
1
|
|
7
|
use Exporter 'import'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
75
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Base class of this module. |
13
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Items to export into callers namespace by default. Note: do not export names |
16
|
|
|
|
|
|
|
# by default without a very good reason. Use EXPORT_OK instead. Do not simply |
17
|
|
|
|
|
|
|
# export all your public functions/methods/constants. |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# This allows declaration use Simple::Filter::Macro ':all'; |
20
|
|
|
|
|
|
|
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK |
21
|
|
|
|
|
|
|
# will save memory. |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# our %EXPORT_TAGS = ( 'all' => [ qw( to be filled in ) ] ); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Export the implemented subroutines and the global variable. |
28
|
|
|
|
|
|
|
our @EXPORT = qw( |
29
|
|
|
|
|
|
|
SanitiseCompiled |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Set ter VERSION of this module. |
33
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# Load the required Perl module. |
36
|
1
|
|
|
1
|
|
7
|
use File::Basename; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
362
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
39
|
|
|
|
|
|
|
# Subroutine SanitiseCompiled() # |
40
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
41
|
|
|
|
|
|
|
sub SanitiseCompiled { |
42
|
|
|
|
|
|
|
# Assigne the subroutine argument to the local variable. |
43
|
0
|
|
|
0
|
0
|
|
my $file = $_[0]; |
44
|
|
|
|
|
|
|
# Check the filename extension. |
45
|
0
|
|
|
|
|
|
my (undef, undef, $ext) = fileparse($file, '\..*'); |
46
|
0
|
0
|
|
|
|
|
if ($ext ne ".plc") { |
47
|
0
|
|
|
|
|
|
exit 1; |
48
|
|
|
|
|
|
|
}; |
49
|
|
|
|
|
|
|
# Set the temporary file. |
50
|
0
|
|
|
|
|
|
my $tmpfile = "${file}.tmp"; |
51
|
|
|
|
|
|
|
# Set the inblock variable to 0. |
52
|
0
|
|
|
|
|
|
my $inblock = 0; |
53
|
|
|
|
|
|
|
# Open the original file |
54
|
0
|
0
|
|
|
|
|
if (open IN, "<", $file) { |
55
|
|
|
|
|
|
|
; |
56
|
|
|
|
|
|
|
# print "Successfully opened ${file}.\n"; |
57
|
|
|
|
|
|
|
} else { |
58
|
|
|
|
|
|
|
# print "Failed to open ${file}.\n"; |
59
|
0
|
|
|
|
|
|
exit 2; |
60
|
|
|
|
|
|
|
}; |
61
|
|
|
|
|
|
|
# Create a tmp file |
62
|
0
|
0
|
|
|
|
|
if (open OUT, ">", "${tmpfile}") { |
63
|
|
|
|
|
|
|
; |
64
|
|
|
|
|
|
|
# print "Successfully opened ${tmpfile}.\n"; |
65
|
|
|
|
|
|
|
} else { |
66
|
|
|
|
|
|
|
# print "Failed to open ${tmpfile}.\n"; |
67
|
0
|
|
|
|
|
|
exit 2; |
68
|
|
|
|
|
|
|
}; |
69
|
|
|
|
|
|
|
# Write Shebang to file. |
70
|
0
|
|
|
|
|
|
print OUT "#!/usr/bin/perl\n"; |
71
|
|
|
|
|
|
|
# Loop through each line in the original file. |
72
|
0
|
|
|
|
|
|
while (my $line = ) { |
73
|
|
|
|
|
|
|
# Check on empty lines and comments. |
74
|
0
|
0
|
0
|
|
|
|
if ($line =~ /^\s*$/ || $line =~ /^#/) { |
75
|
|
|
|
|
|
|
# Cheeck if key word is found. |
76
|
0
|
0
|
|
|
|
|
if ($line =~ /^#line 1\s*$/) { |
77
|
|
|
|
|
|
|
# Swap switch on given value. |
78
|
0
|
0
|
|
|
|
|
$inblock = ($inblock == 0 ? 1 : 0); |
79
|
|
|
|
|
|
|
}; |
80
|
|
|
|
|
|
|
} else { |
81
|
|
|
|
|
|
|
# If it is not in the block print the line. |
82
|
0
|
0
|
|
|
|
|
if ($inblock == 0) { |
83
|
0
|
|
|
|
|
|
print OUT $line; |
84
|
|
|
|
|
|
|
}; |
85
|
|
|
|
|
|
|
}; |
86
|
|
|
|
|
|
|
}; |
87
|
|
|
|
|
|
|
# Close both file handlers. |
88
|
0
|
|
|
|
|
|
close IN; |
89
|
0
|
|
|
|
|
|
close OUT; |
90
|
|
|
|
|
|
|
# Delete the original file. |
91
|
0
|
|
|
|
|
|
unlink($file); |
92
|
|
|
|
|
|
|
# Rename the tmp file to get back the original file. |
93
|
0
|
|
|
|
|
|
rename($tmpfile, $file); |
94
|
|
|
|
|
|
|
}; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
1; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
__END__ |