Merge pull request #1 from oposs/actions_tests_regex++

.github/workflows/build_and_test.yaml

@@ -0,0 +1,48 @@
+name: Unit Tests
+
+on:
+  push:
+    paths-ignore:
+      - '**.md'
+  pull_request:
+    paths-ignore:
+      - '**.md'
+
+jobs:
+  build:
+    strategy:
+      matrix:
+        os:
+          - ubuntu-20.04
+        perl:
+          - '5.22'
+          - '5.26'
+          - '5.32'
+
+      fail-fast: true
+    name: perl${{ matrix.perl }}/${{ matrix.os }}
+
+    runs-on: ${{ matrix.os }}
+
+    steps:
+
+      - name: Checkout
+        uses: actions/checkout@v1
+
+      - name: Setup perl
+        uses: shogo82148/actions-setup-perl@v1
+        with:
+          perl-version: ${{ matrix.perl }}
+
+      - name: Configure
+        run: perl Makefile.PL
+
+      - name: Make
+        run: make
+
+      - name: Test
+        run: make test
+
+      - name: Dist
+        run: make dist
+

CHANGES

@@ -1,3 +1,10 @@
+0.2.0 2022-02-11  Tobias Bossert (tobib at cpan.org)
+
+- Added endmarker tests
+- Improved endmarkers detection (we now search from bottom up)
+- Improved example
+
+
 0.1.2 2022-01-19  Tobias Bossert (tobib at cpan.org)
 
 - Fixed replace regex (end-of-script marker)

MANIFEST

@@ -2,6 +2,7 @@ AUTHORS
 CHANGES
 COPYRIGHT
 examples/lib/Fancy/Module.pm
+examples/lib/Other/Module.pm
 examples/my_program.pl
 examples/runit.sh
 examples/t/number_test.t
@@ -11,4 +12,17 @@ Makefile.PL
 MANIFEST			This list of files
 MANIFEST.SKIP
 Readme.md
+t/00_endmarkers.t
+t/test_data/Dummy0.pm
+t/test_data/Dummy0.pm_exp
+t/test_data/Dummy1.pm
+t/test_data/Dummy1.pm_exp
+t/test_data/Dummy2.pm
+t/test_data/Dummy2.pm_exp
+t/test_data/Dummy3.pm
+t/test_data/Dummy3.pm_exp
+t/test_data/Dummy4.pm
+t/test_data/Dummy4.pm_exp
+t/test_data/Dummy5.pm
+t/test_data/Dummy5.pm_exp
 VERSION

Readme.md

@@ -42,6 +42,6 @@ See separate subdirectory [examples/runit.sh](examples/runit.sh)
 
 ## Important notes
 
-- Make sure your script (the one under test) always ends with `__END__`, otherwise the regex to modify it fails silently
+- Make sure your script (the one under test) always ends with `__END__`, `__DATA__` or `1;`, otherwise the regex to modify it fails silently
 - To debug if your script is "deanonymized" use `warn()` instead of `print()` print is somewhat unreliable in this early stage
 - [Devel::Cover](https://metacpan.org/pod/Devel::Cover) on cpan

VERSION

@@ -1 +1 @@
-0.1.2
+0.2.0

examples/lib/Fancy/Module.pm

@@ -8,7 +8,10 @@ our @EXPORT = qw(is_it_the_number is_the_sum_the_number);
 
 my $anon = sub($number) {
     if ($number != 42) {
-        return "No, it's not";
+        my $sub_sub = sub($num) {
+            return "No, it's not";
+        };
+        &{$sub_sub}($number);
     }
 };
 

lib/Devel/Deanonymize.pm

@@ -12,21 +12,30 @@ by the statistic:
     }
 
 This script aims to solve this problem by wrapping each file in a sub and thus making these subs I<visible>.
-Code is based on https://github.com/pjcj/Devel--Cover/issues/51#issuecomment-17222928
+Code is based on L<https://github.com/pjcj/Devel--Cover/issues/51#issuecomment-17222928>
 
 =head1 SYNOPSIS
 
     # Perl scripts
     perl -MDevel::Cover=-ignore,^t/,Deanonymize -MDevel::Deanonymize=<inculde_pattern> your_script.pl
 
     # Perl tests
-    HARNESS_PERL_SWITCHES="-MDevel::Cover=-ignore,^t/,Deanonymize -MDevel::Deanonymize=<include_pattern"  prove t/
+    HARNESS_PERL_SWITCHES="-MDevel::Cover=-ignore,^t/,Deanonymize -MDevel::Deanonymize=<include_pattern>"  prove t/
 
 
 =head1 DEBUGGING
 
 If your tests suddenly fail for some weird reason, you can set C<DEANONYMIZE_DEBUG>. If this environment variable is set,
-we print out the filename for every modified file write its contents to C<filepath/filename_mod.pl>
+we print out the filename for every modified file write its contents to C<filepath/filename_mod.pl>.
+
+It is also important to note that the regex which matches the end-marker is not perfect. In general it can be summarized
+as follows:
+
+We start at the end of a file and search for the first occurrence of either C<__END__>, C<__DATA__> or C<1;>. To improve
+robustness, these markers must occur alone on their respective line.
+A special case is C<1> without semicolon: We only consider this case if its the very last character of a file.
+
+Files with no endmarkers at all are dangerous to use in conjunction with this module...
 
 
 =head1 EXAMPLES
@@ -70,8 +79,11 @@ SOFTWARE.
 package Devel::Deanonymize;
 use strict;
 use warnings FATAL => 'all';
+use base 'Exporter';
 
-our $VERSION = "0.1.2";
+our @EXPORT = qw(alterContent);
+
+our $VERSION = "0.2.0"; # Do not change manually, changed automatically on `make build` target
 
 my $include_pattern;
 
@@ -80,6 +92,34 @@ sub import {
     $include_pattern = $_[1] ? $_[1] : die("Devel::Deanonymize: An include Pattern must be specified \n");
 }
 
+sub alterContent {
+    my $input = shift;
+    my $subName = shift;
+    # define everything in a sub, so Devel::Cover will DTRT
+    # NB this introduces no extra linefeeds so D::C's line numbers
+    # in reports match the file on disk
+    # - In general, we match only if <white_space>*ENDMARKER<white_space>*<end_of_line>
+    # - We only allow `1` without a semicolon if found at the very end
+    $input =~ s/(.*?package\s+\S+)(.*)^[\s]*(__END__|1;|1\Z|__DATA__)[\s]*$(.*)\Z/$1sub $subName {$2} $subName();$3$4/sgm;
+
+    # unhide private methods to avoid "Variable will not stay shared"
+    # warnings that appear due to change of applicable scoping rules
+    # Note: not '\s*' in the start of string, to avoid matching and
+    # removing blank lines before the private sub definitions.
+    $input =~ s/(^[\t| ]*)my\s+(\S+\s*=\s*sub.*)$/$1our $2/gm;
+
+    return $input
+}
+
+sub hasEndmarker {
+    my $input = shift;
+    if ($input =~ /^[\s]*(__END__|1;|1\Z|__DATA__)[\s]*$(.*)\Z/gms) {
+        return 1;
+    }
+    return 0;
+}
+
+
 sub modify_files {
     # Internal notes:
     # Basically, this code replaces every file path in @INC with a reference to an anonymous sub which wraps each
@@ -96,21 +136,12 @@ sub modify_files {
             my $module_text = <$fh>;
             close $fh;
 
-            if (not $module_text =~ /(__END__|1;|__DATA__)/) {
+            if (not hasEndmarker($module_text)) {
                 warn("Devel::Deanonymize: Found no endmarker in file `$filename` - skipping\n");
                 return ();
             }
 
-            # define everything in a sub, so Devel::Cover will DTRT
-            # NB this introduces no extra linefeeds so D::C's line numbers
-            # in reports match the file on disk
-            $module_text =~ s/(.*?package\s+\S+)(.*)(__END__|1;|__DATA__)/$1sub classWrapper {$2} classWrapper();\n$3/s;
-
-            # unhide private methods to avoid "Variable will not stay shared"
-            # warnings that appear due to change of applicable scoping rules
-            # Note: not '\s*' in the start of string, to avoid matching and
-            # removing blank lines before the private sub definitions.
-            $module_text =~ s/^[ \t]*my\s+(\S+\s*=\s*sub.*)$/our $1/gm;
+            $module_text = alterContent($module_text, "_anon");
 
             # filehandle on the scalar
             open $fh, '<', \$module_text;
@@ -143,5 +174,4 @@ UNITCHECK {
     modify_files();
 }
 
-
 1;

t/00_endmarkers.t

@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Devel::Deanonymize qw(alterContent);
+
+sub read_file {
+    my $path = shift;
+    my $fh;
+    open $fh, '<', $path or die "Can't open `$path`: $!";
+    my $file_content = do {
+        local $/;
+        <$fh>
+    };
+    return $file_content;
+}
+
+
+my @files = ("Dummy0.pm", "Dummy1.pm", "Dummy2.pm", "Dummy3.pm", "Dummy4.pm", "Dummy5.pm");
+my @test_titles = (
+    "`1;` endmarker, with evil variables ",
+    "`1;` endmarker, with evil comment",
+    "`__END__` endmarker, with anon sub",
+    "`1;` endmarker, open =cut section",
+    "`1` endmarker, no semicolon",
+    "No endmarker"
+);
+for my $idx (0 .. $#files) {
+    my $input = read_file("t/test_data/$files[$idx]");
+    my $expected = read_file("t/test_data/$files[$idx]_exp");
+    my $res1 = Devel::Deanonymize::alterContent($input, "wrapper_$idx");
+    # if ($files[$idx] eq "Dummy3.pm") {
+    #     print $res1;
+    # }
+    ok $res1 eq $expected, $files[$idx] .": ". $test_titles[$idx];
+    eval($res1);
+    if ($@) {
+        print $@ . "\n";
+        fail "eval failed";
+    }
+    else {
+        ok 1, "$files[$idx]: eval modified ";
+    }
+}
+done_testing();
+

t/test_data/Dummy0.pm

@@ -0,0 +1,11 @@
+package Dummy0;
+use strict;
+use warnings FATAL => 'all';
+
+
+sub test {
+    my $val = 1;
+    my $val2 = "__END__";
+}
+
+1;

t/test_data/Dummy0.pm_exp

@@ -0,0 +1,11 @@
+package Dummy0;sub wrapper_0 {
+use strict;
+use warnings FATAL => 'all';
+
+
+sub test {
+    my $val = 1;
+    my $val2 = "__END__";
+}
+
+} wrapper_0();1;

t/test_data/Dummy1.pm

@@ -0,0 +1,18 @@
+package Dummy1;
+use strict;
+use warnings FATAL => 'all';
+
+=head3 test2()
+
+This is a comment for this function containing evil characters
+1;
+
+=cut
+sub test2 {
+    my $val = 1;
+    my $val2 = "__DATA__";
+}
+
+
+
+1;

t/test_data/Dummy1.pm_exp

@@ -0,0 +1,18 @@
+package Dummy1;sub wrapper_1 {
+use strict;
+use warnings FATAL => 'all';
+
+=head3 test2()
+
+This is a comment for this function containing evil characters
+1;
+
+=cut
+sub test2 {
+    my $val = 1;
+    my $val2 = "__DATA__";
+}
+
+
+
+} wrapper_1();1;

t/test_data/Dummy2.pm

@@ -0,0 +1,19 @@
+package Dummy2;
+use strict;
+use warnings FATAL => 'all';
+
+
+sub test3 {
+    my $val = "hello";
+    my $val2 = "__END__";
+}
+
+my $t = sub {
+  my $hello = 1;
+};
+
+
+
+1;
+
+__END__

t/test_data/Dummy2.pm_exp

@@ -0,0 +1,19 @@
+package Dummy2;sub wrapper_2 {
+use strict;
+use warnings FATAL => 'all';
+
+
+sub test3 {
+    my $val = "hello";
+    my $val2 = "__END__";
+}
+
+our $t = sub {
+  my $hello = 1;
+};
+
+
+
+1;
+
+} wrapper_2();__END__