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

package Simple::Filter::SanitiseCompiled;

# Load the basic Perl pragmas.
use 5.010000;
use strict;
use warnings;

# Load the Perl pragma Exporter.
use vars qw(@ISA @EXPORT @EXPORT_OK);
use Exporter 'import';

# Base class of this module.
our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export names
# by default without a very good reason. Use EXPORT_OK instead. Do not simply
# export all your public functions/methods/constants.

# This allows declaration use Simple::Filter::Macro ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.

# our %EXPORT_TAGS = ( 'all' => [ qw( to be filled in ) ] );

# our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

# Export the implemented subroutines and the global variable.
our @EXPORT = qw(
    SanitiseCompiled
);

# Set ter VERSION of this module.
our $VERSION = '0.03';

# Load the required Perl module.
use File::Basename;

# ---------------------------------------------------------------------------- #
# Subroutine SanitiseCompiled()                                                #
# ---------------------------------------------------------------------------- #
sub SanitiseCompiled {
    # Assigne the subroutine argument to the local variable.
    my $file = $_[0];
    # Check the filename extension.
    my (undef, undef, $ext) = fileparse($file, '\..*');
    if ($ext ne ".plc") {
        exit 1;
    };
    # Set the temporary file.
    my $tmpfile = "${file}.tmp";
    # Set the inblock variable to 0.
    my $inblock = 0;
    # Open the original file
    if (open IN, "<", $file) {
        ;
        # print "Successfully opened ${file}.\n";
    } else {
        # print "Failed to open ${file}.\n";
        exit 2;
    };
    # Create a tmp file
    if (open OUT, ">", "${tmpfile}") {
        ;
        # print "Successfully opened ${tmpfile}.\n";
    } else {
        # print "Failed to open ${tmpfile}.\n";
        exit 2;
    };
    # Write Shebang to file.
    print OUT "#!/usr/bin/perl\n";
    # Loop through each line in the original file.
    while (my $line = ) {
        # Check on empty lines and comments.
        if ($line =~ /^\s*$/ || $line =~ /^#/) {
            # Cheeck if key word is found.
            if ($line =~ /^#line 1\s*$/) {
                # Swap switch on given value.
                $inblock = ($inblock == 0 ? 1 : 0);
            };
        } else {
            # If it is not in the block print the line.
            if ($inblock == 0) {
                print OUT $line;
            };
        };
    };
    # Close both file handlers.
    close IN;
    close OUT;
    # Delete the original file.
    unlink($file);
    # Rename the tmp file to get back the original file.
    rename($tmpfile, $file);
};

1;

__END__