File Coverage

blib/lib/Simple/Filter/SanitiseCompiled.pm
Criterion Covered Total %
statement 17 38 44.7
branch 0 14 0.0
condition 0 3 0.0
subroutine 6 7 85.7
pod 0 1 0.0
total 23 63 36.5


line stmt bran cond sub pod time code
1             package Simple::Filter::SanitiseCompiled;
2              
3             # Load the basic Perl pragmas.
4 1     1   1013 use 5.010000;
  1         3  
5 1     1   5 use strict;
  1         2  
  1         19  
6 1     1   4 use warnings;
  1         2  
  1         39  
7              
8             # Load the Perl pragma Exporter.
9 1     1   12 use vars qw(@ISA @EXPORT @EXPORT_OK);
  1         3  
  1         95  
10 1     1   7 use Exporter 'import';
  1         2  
  1         78  
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   6 use File::Basename;
  1         2  
  1         387  
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__