Filter-signatures-0.19/0000755000175000017500000000000014456701275014431 5ustar corioncorionFilter-signatures-0.19/MANIFEST.SKIP0000644000175000017500000000037114456701274016327 0ustar corioncorion^\.git\/ ^\.github\/ ^\.travis.yml$ maint ^tags$ ^\.last_cover_stats Makefile$ ^blib ^pm_to_blib ^.*.bak ^.*.old ^t.*sessions ^cover_db ^.*\.log ^.*\.swp$ ^jar/ ^cpan/ ^MYMETA ^.prove ^.releaserc ^Filter-signatures-.*/ ^Filter-signatures-.*.tar.gz$ Filter-signatures-0.19/Makefile.PL0000644000175000017500000001556014456701274016411 0ustar corioncorion# -*- mode: perl; c-basic-offset: 4; indent-tabs-mode: nil; -*- use strict; use ExtUtils::MakeMaker qw(WriteMakefile); # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # Normalize version strings like 6.30_02 to 6.3002, # so that we can do numerical comparisons on it. my $eumm_version = $ExtUtils::MakeMaker::VERSION; $eumm_version =~ s/_//; my $module = 'Filter::signatures'; (my $main_file = "lib/$module.pm" ) =~ s!::!/!g; (my $distbase = $module) =~ s!::!-!g; my $distlink = $distbase; my @tests = map { glob $_ } 't/*.t', 't/*/*.t'; my %module = ( NAME => $module, AUTHOR => q{Max Maischein }, VERSION_FROM => $main_file, ABSTRACT_FROM => $main_file, META_MERGE => { "meta-spec" => { version => 2 }, resources => { repository => { web => "https://github.com/Corion/$distlink", url => "git://github.com/Corion/$distlink.git", type => 'git', }, bugtracker => { web => "https://github.com/Corion/$distbase/issues", # mailto => 'meta-bugs@example.com', }, license => "https://dev.perl.org/licenses/", }, dynamic_config => 0, # we promise to keep META.* up-to-date x_static_install => 1, # we are pure Perl and don't do anything fancy }, MIN_PERL_VERSION => '5.006', 'LICENSE'=> 'perl', PL_FILES => {}, BUILD_REQUIRES => { 'ExtUtils::MakeMaker' => 0, }, PREREQ_PM => { 'Filter::Simple' => '0.91', # I got spurious errors in MIME::Detect with older versions }, TEST_REQUIRES => { 'Test::More' => 0, 'Text::Balanced' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => "$distbase-*" }, test => { TESTS => join( ' ', @tests ) }, ); # This is so that we can do # require 'Makefile.PL' # and then call get_module_info sub get_module_info { %module } if( ! caller ) { # I should maybe use something like Shipwright... regen_README($main_file); regen_EXAMPLES() if -d 'examples'; WriteMakefile1(get_module_info); }; 1; sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } sub regen_README { # README is the short version that just tells people what this is # and how to install it eval { # Get description my $readme = join "\n", pod_section($_[0], 'NAME', 'no heading' ), pod_section($_[0], 'DESCRIPTION' ), <new(); # Read POD from Module.pm and write to README $parser->parse_from_file($_[0]); my $readme_mkdn = <as_markdown; [![Travis Build Status](https://travis-ci.org/Corion/$distlink.svg?branch=master)](https://travis-ci.org/Corion/$distlink) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/Corion/$distlink?branch=master&svg=true)](https://ci.appveyor.com/project/Corion/$distlink) STATUS update_file( 'README.mkdn', $readme_mkdn ); }; } sub pod_section { my( $filename, $section, $remove_heading ) = @_; open my $fh, '<', $filename or die "Couldn't read '$filename': $!"; my @section = grep { /^=head1\s+$section/.../^=/ } <$fh>; # Trim the section if( @section ) { pop @section if $section[-1] =~ /^=/; shift @section if $remove_heading; pop @section while @section and $section[-1] =~ /^\s*$/; shift @section while @section and $section[0] =~ /^\s*$/; }; @section = map { $_ =~ s!^=\w+\s+!!; $_ } @section; return join "", @section; } sub regen_EXAMPLES { my $perl = $^X; if ($perl =~/\s/) { $perl = qq{"$perl"}; }; (my $example_file = $main_file) =~ s!\.pm$!/Examples.pm!; my $examples = `$perl -w examples/gen_examples_pod.pl`; if ($examples) { warn "(Re)Creating $example_file\n"; $examples =~ s/\r\n/\n/g; update_file( $example_file, $examples ); }; }; sub update_file { my( $filename, $new_content ) = @_; my $content; if( -f $filename ) { open my $fh, '<:raw:encoding(UTF-8)', $filename or die "Couldn't read '$filename': $!"; local $/; $content = <$fh>; }; if( $content ne $new_content ) { if( open my $fh, '>:raw:encoding(UTF-8)', $filename ) { print $fh $new_content; } else { warn "Couldn't (re)write '$filename': $!"; }; }; } Filter-signatures-0.19/t/0000755000175000017500000000000014456701275014674 5ustar corioncorionFilter-signatures-0.19/t/00-load.t0000644000175000017500000000054314456701274016216 0ustar corioncorion#!perl -T use strict; use warnings; use Test::More tests => 1; my $module; BEGIN { $module = "Filter::signatures"; require_ok( $module ); } diag( sprintf "Testing %s %s, Perl %s", $module, $module->VERSION, $] ); for (sort grep /\.pm\z/, keys %INC) { s/\.pm\z//; s!/!::!g; eval { diag(join(' ', $_, $_->VERSION || '')) }; } Filter-signatures-0.19/t/08-argument-parser.t0000644000175000017500000000115614456701274020424 0ustar corioncorion#!perl -w use strict; use Test::More tests => 1; use Data::Dumper; require Filter::signatures; # Mimic parts of the setup of Filter::Simple my $extractor = $Filter::Simple::placeholder = $Filter::Simple::placeholder = qr/\Q$;\E(.{4})\Q$;\E/s; # Check that we are immune against Filter::Simple embedding a comma in its # placeholders for strings: my $placeholder = qq(\$value = $; ,$;); my $stuff = Filter::signatures::parse_argument_list("foo","\$name, $placeholder"); is $stuff, 'sub foo { my ($name,$value)=@_;' . $placeholder . ' if @_ <= 1;();', "Filter::Simple string substitution doesn't throw us off"; Filter-signatures-0.19/t/07-empty-block.t0000644000175000017500000000214214456701274017531 0ustar corioncorion#!perl -w use strict; use Test::More tests => 6; use Data::Dumper; require Filter::signatures; # Mimic parts of the setup of Filter::Simple my $extractor = $Filter::Simple::placeholder = $Filter::Simple::placeholder = qr/\Q$;\E(.{4})\Q$;\E/s; if( $^V >= 5.20 ) { require warnings; warnings->unimport('experimental::signatures'); require feature; feature->import( 'signatures'); }; sub run_code_ok { my( $name, $expected,$decl, @args ) = @_; local $_ = $decl; my $org; if( $^V >= 5.20 ) { $org = eval $_ or die $@; }; Filter::signatures::transform_arguments(); no warnings 'redefine'; my $l = eval $_; die $@ if $@; my $got = $l->(@args); my $native = $org ? $org->(@args ): $expected; is $got, $expected, $name or do { diag $decl; diag $_ }; is $expected, $native, "Sanity check vs native code"; } run_code_ok( "No signature", undef, <<'SUB' ); #line 1 sub {} SUB run_code_ok( "Empty block", undef, <<'SUB' ); #line 1 sub () {} SUB run_code_ok( "Empty block with defaults", undef, <<'SUB' ); #line 1 sub ($name='batman') {} SUB Filter-signatures-0.19/t/02-compile-direct.t0000644000175000017500000000377614456701274020214 0ustar corioncorion#!perl -w use strict; use Test::More tests => 9; use Data::Dumper; BEGIN{ $ENV{FORCE_FILTER_SIGNATURES} = 1; }; use Filter::signatures; use feature 'signatures'; no warnings 'experimental::signatures'; # Anonymous my $sub = sub ($name, $value) { return "'$name' is '$value'" }; SKIP: { is ref $sub, 'CODE', "we can compile a simple anonymous subroutine" or skip 1, $@; is $sub->("Foo", 'bar'), "'Foo' is 'bar'", "Passing parameters works"; } # Named sub foo1 ($name, $value) { return "'$name' is '$value'" }; SKIP: { is foo1("Foo", 'bar'), "'Foo' is 'bar'", "Passing parameters works (named)"; } # Named, with default sub foo2 ($name, $value='default') { return "'$name' is '$value'" }; SKIP: { is foo2("Foo"), "'Foo' is 'default'", "default parameters works"; } # Named, with default sub foo3 ($name, $value='default, with comma') { return "'$name' is '$value'" }; SKIP: { is foo3("Foo"), "'Foo' is 'default, with comma'", "default parameters works even with embedded comma"; } # No parameters sub foo5 () { return "We can call a sub without parameters" }; is foo5(), "We can call a sub without parameters", "A subroutine with an empty parameter list still compiles"; # Only slurpy discarding parameters sub foo6 (@) { return "We can call a sub with all-slurpy ignored parameters" }; is foo6('foo','bar','baz'), "We can call a sub with all-slurpy ignored parameters", "A subroutine with an all-slurpy ignored parameter list still compiles"; # Unnamed parameter in the middle sub foo7 ($foo, $, $bar) { return "$foo => $bar" }; is foo7('Hello','you','World'), "Hello => World", "A subroutine with unnamed parameter still compiles"; # Comments in the signature sub foo_comment ($foo, # foo $bar # $bar ) { return "$foo => $bar" }; is foo_comment('Hello','World'), "Hello => World", "We (well, Filter::Simple) supports ignoring comments"; Filter-signatures-0.19/t/06-linenumbers.t0000644000175000017500000000265714456701274017640 0ustar corioncorion#!perl -w use strict; use Test::More tests => 8; use Data::Dumper; require Filter::signatures; # Mimic parts of the setup of Filter::Simple my $extractor = $Filter::Simple::placeholder = $Filter::Simple::placeholder = qr/\Q$;\E(.{4})\Q$;\E/s; if( $^V >= 5.20 ) { require warnings; warnings->unimport('experimental::signatures'); require feature; feature->import( 'signatures'); }; sub identical_to_native { my( $name, $expected,$decl ) = @_; local $_ = $decl; my $org; if( $^V >= 5.20 ) { $org = eval $_ or die $@; }; Filter::signatures::transform_arguments(); no warnings 'redefine'; my $l = eval $_; die $@ if $@; my $got = $l->('foo','bar'); my $native = $org ? $org->('foo','bar') : $expected; is $got, $expected, $name or do { diag $decl; diag $_ }; is $expected, $native, "Sanity check vs native code"; } identical_to_native( "Anonymous subroutine", 5, <<'SUB' ); #line 1 sub ( $name , $value ) { return __LINE__ }; SUB identical_to_native( "Anonymous subroutine (traditional)", 2, <<'SUB' ); #line 1 sub ($name, $value) { return __LINE__ }; SUB identical_to_native( "Named subroutine", 6, <<'SUB' ); #line 1 sub foo2 ( $name , $value ) { return __LINE__ }; \&foo2 SUB identical_to_native( "Multiline default assignments", 6, <<'SUB' ); #line 1 sub ( $name , $value ='bar' ) { return __LINE__ }; SUB Filter-signatures-0.19/t/03-compilation-output.t0000644000175000017500000002162414456701274021161 0ustar corioncorion#!perl -w use strict; use Test::More tests => 30; use Data::Dumper; require Filter::signatures; # Mimic parts of the setup of Filter::Simple my $extractor = $Filter::Simple::placeholder = $Filter::Simple::placeholder = qr/\Q$;\E(.{4})\Q$;\E/s; # Anonymous $_ = <<'SUB'; sub ($name, $value) { return "'$name' is '$value'" }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Anonymous subroutines get converted"; sub { my ($name,$value)=@_;(); return "'$name' is '$value'" }; RESULT $_ = <<'SUB'; sub foo5 () { return "We can call a sub without parameters" }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Parameterless subroutines don't get converted"; sub foo5 { @_==0 or warn "Subroutine foo5 called with parameters.";(); return "We can call a sub without parameters" }; RESULT # Function default parameters $_ = <<'SUB'; sub mylog($msg, $when=time) { print "[$when] $msg\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Function default parameters get converted"; sub mylog { my ($msg,$when)=@_;$when = time if @_ <= 1;(); print "[$when] $msg\n"; }; RESULT # Empty parameter list $_ = <<'SUB'; sub mysub() { print "Yey\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Functions without parameters get converted properly"; sub mysub { @_==0 or warn "Subroutine mysub called with parameters.";(); print "Yey\n"; }; RESULT # Discarding parameters $_ = <<'SUB'; sub mysub($) { print "Yey\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Functions with unnamed parameters get converted properly"; sub mysub { my (undef)=@_;(); print "Yey\n"; }; RESULT # Discarding parameters $_ = <<'SUB'; sub mysub($foo, $, $bar) { print "Yey, $foo => $bar\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Functions without parameters get converted properly"; sub mysub { my ($foo,undef,$bar)=@_;(); print "Yey, $foo => $bar\n"; }; RESULT # Signature-less functions remain unchanged $_ = <<'SUB'; sub mysub { print "Yey\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Named functions without signature remain unchanged"; sub mysub { print "Yey\n"; }; RESULT $_ = <<'SUB'; sub { print "Yey\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Named functions without signature remain unchanged"; sub { print "Yey\n"; }; RESULT $_ = <<'SUB'; sub foo($bar,$baz) { print "Yey\n"; } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "RT #xxxxxx Single-line functions work"; sub foo { my ($bar,$baz)=@_;(); print "Yey\n"; } RESULT { local $TODO = "Recursive parentheses don't work on $]" if( $] < 5.010 ); $_ = <<'SUB'; sub staleUploads( $self, $timeout = 3600, $now = time() ) { } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Default arguments with parentheses work"; sub staleUploads { my ($self,$timeout,$now)=@_;$timeout = 3600 if @_ <= 1;$now = time() if @_ <= 2;(); } RESULT $_ = <<'SUB'; sub staleUploads( $self, $timeout = 3600, $now = time((()))) { } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Default arguments with multiple parentheses work"; sub staleUploads { my ($self,$timeout,$now)=@_;$timeout = 3600 if @_ <= 1;$now = time((())) if @_ <= 2;(); } RESULT $_ = <<'SUB'; sub ( $self, $now = localtime(1)) { } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Default arguments with parentheses and values work"; sub { my ($self,$now)=@_;$now = localtime(1) if @_ <= 1;(); } RESULT } $_ = <<'SUB'; sub ( $self, $cb = sub { }) { } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Default arguments with parentheses and values work"; sub { my ($self,$cb)=@_;$cb = sub { } if @_ <= 1;(); } RESULT $_ = <<'SUB'; sub f ($a,@) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Slurpy discard argument works"; sub f { my ($a,undef)=@_;(); ... } RESULT $_ = <<'SUB'; my @args; sub ( $self, $foo = $#args) { } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Default arguments that look like comments"; my @args; sub { my ($self,$foo)=@_;$foo = $#args if @_ <= 1;(); } RESULT $_ = <<'SUB'; sub f ($a = /\w/ ) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Argument lists containing regular expressions work"; sub f { my ($a)=@_;$a = /\w/ if @_ <= 0;(); ... } RESULT $_ = <<'SUB'; sub f ($a = \$b, $c=\@d, $e=\%f, $g=\&h, $i=\*j ) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Argument lists containing scalar references"; sub f { my ($a,$c,$e,$g,$i)=@_;$a = \$b if @_ <= 0;$c = \@d if @_ <= 1;$e = \%f if @_ <= 2;$g = \&h if @_ <= 3;$i = \*j if @_ <= 4;(); ... } RESULT $_ = <<'SUB'; sub f ($a = /\(/ ) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Argument lists containing unmatched parentheses work"; sub f { my ($a)=@_;$a = /\(/ if @_ <= 0;(); ... } RESULT $_ = <<'SUB'; sub f ($a = /[\(]/ ) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Characterclasses with unmatched quoted parentheses work"; sub f { my ($a)=@_;$a = /[\(]/ if @_ <= 0;(); ... } RESULT { local $TODO = "Recursive parentheses don't work on $]" if( $] < 5.010 ); $_ = <<'SUB'; sub f ($a = /[\)]/ ) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Characterclasses with unmatched quoted parentheses work"; sub f { my ($a)=@_;$a = /[\)]/ if @_ <= 0;(); ... } RESULT } { local $TODO = 'More robust regexp parsing needed'; $_ = <<'SUB'; sub f ($a = /[(]/ ) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Regular expressions containing characterclasses with unmatched parentheses work"; sub f { my ($a)=@_;$a = /\(/ if @_ <= 0;(); ... } RESULT $_ = <<'SUB'; sub f ($a = /[)]/ ) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Regular expressions containing characterclasses with unmatched parentheses work"; sub f { my ($a)=@_;$a = /[)]/ if @_ <= 0;(); ... } RESULT } { local $TODO = "Recursive parentheses don't work on $]" if( $] < 5.010 ); $_ = <<'SUB'; sub f ($a = qr(\() ) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Argument lists containing unmatched parentheses within qr-strings work"; sub f { my ($a)=@_;$a = qr(\() if @_ <= 0;(); ... } RESULT } $_ = <<'SUB'; sub f ($a = do { }) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "do-blocks work"; sub f { my ($a)=@_;$a = do { } if @_ <= 0;(); ... } RESULT { local $TODO = "Recursive parentheses don't work on $]" if( $] < 5.010 ); $_ = <<'SUB'; sub f ($a = substr("abc",0,1)) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Commas within subroutine calls don't split the argument lists"; sub f { my ($a)=@_;$a = substr("abc",0,1) if @_ <= 0;(); ... } RESULT } $_ = <<'SUB'; sub f ($a = /\,/, $b=1) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Commas within regular expression matches don't split the argument lists"; sub f { my ($a,$b)=@_;$a = /\,/ if @_ <= 0;$b = 1 if @_ <= 1;(); ... } RESULT $_ = <<'SUB'; sub f ($a = /\,/, $b=1) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Commas within regular expression matches don't split the argument lists"; sub f { my ($a,$b)=@_;$a = /\,/ if @_ <= 0;$b = 1 if @_ <= 1;(); ... } RESULT $_ = <<'SUB'; sub f ($a = do { $x = "abc"; return substr $x,0,1}) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Commas within do-blocks don't split the argument lists"; sub f { my ($a)=@_;$a = do { $x = "abc"; return substr $x,0,1} if @_ <= 0;(); ... } RESULT { local $TODO = "Recursive parentheses don't work on $]" if( $] < 5.010 ); $_ = <<'SUB'; sub f ($a = do { $x = "abc"; return substr($x,0,1)}) { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "do-blocks with parentheses work"; sub f { my ($a)=@_;$a = do { $x = "abc"; return substr($x,0,1)} if @_ <= 0;(); ... } RESULT } # This is a test for the placeholders that Filter::Simple supplies - if you # have enough of them, "interesting" characters pop up within these placeholders # We have an interesting dependency on the format of these placeholders. $_ = <<'SUB'; sub f ($a = "...(") { ... } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Parentheses in (replaced) string arguments work"; sub f { my ($a)=@_;$a = "...(" if @_ <= 0;(); ... } RESULT if( $Test::More::VERSION > 0.87 ) { # 5.8.x compatibility done_testing(); }; Filter-signatures-0.19/t/05-multiline-signature.t0000644000175000017500000000650514456701274021311 0ustar corioncorion#!perl -w use strict; use Test::More tests => 4; use Data::Dumper; use Text::Balanced 'extract_multiple', 'extract_quotelike'; require Filter::signatures; # Mimic parts of the setup of Filter::Simple my $extractor = $Filter::Simple::placeholder = $Filter::Simple::placeholder = qr/\Q$;\E(.{4})\Q$;\E/s; # Anonymous $_ = <<'SUB'; sub ( $name , $value ) { return "'$name' is '$value'" }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Multiline signatures get converted for anonymous subs"; sub { my ($name,$value)=@_;(); return "'$name' is '$value'" }; RESULT # Named $_ = <<'SUB'; sub foo ( $name , $value ) { return "'$name' is '$value'" }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Multiline signatures get converted for named subroutines"; sub foo { my ($name,$value)=@_;(); return "'$name' is '$value'" }; RESULT # Multiline defaults $_ = <<'SUB'; sub ( $name , $value ='bar' ) { return "'$name' is '$value'" }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Multiline default values"; sub { my ($name,$value)=@_;$value = 'bar' if @_ <= 1;(); return "'$name' is '$value'" }; RESULT # Weirdo comments # Filter::Simple resp. Text::Balanced do that filtering for us $_ = <<'SUB'; sub foo ( $name # foo , $value # bar ) { return "'$name' is '$value'" }; SUB # Replicate the setup that Filter::Simple does for us: our @components; no warnings 'once'; local *components = \@Filter::Simple::components; my $comment = qr/(?()-]|\^[A-Z]?)\} | (?:\$#?|[*\@\%]|\\&)\$*\s* (?: \{\s*(?:\^(?=[A-Z_]))?(?:\w|::|'\w)*\s*\} | (?:\^(?=[A-Z_]))?(?:\w|::|'\w)* | (?=\{) # ${ block } ) ) | \$\s*(?!::)(?:\d+|[][&`'#+*./|,";%=~:?!\@<>()-]|\^[A-Z]?) }x; my $code_no_comments = [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ]; my $instr; for (Text::Balanced::extract_multiple($_,$code_no_comments)) { if (ref()) { push @components, $_; $instr=0 } elsif ($instr) { $components[-1] .= $_ } else { push @components, $_; $instr=1 } }; my $count = 0; $_ = join "", map { ref $_ ? $;.pack('N',$count++).$; : $_ } @components; @components = grep { ref $_ } @components; Filter::signatures::transform_arguments(); # Now restore all the surviving placeholders: s/$extractor/${$components[unpack('N',$1)]}/g; is $_, <<'RESULT', "Multiline signatures with comments get converted"; sub foo { my ($name,$value)=@_;(); return "'$name' is '$value'" }; RESULT Filter-signatures-0.19/t/01-compile.t0000644000175000017500000000324714456701274016734 0ustar corioncorion#!perl -w use strict; use Test::More tests => 8; use Data::Dumper; BEGIN{ $ENV{FORCE_FILTER_SIGNATURES} = 1; }; use vars '$TODO'; $TODO = "Eval-compile and Filter::Simple don't play together"; my $sub = eval <<'PERL'; use Filter::signatures; use feature 'signatures'; sub ($name, $value) { return "'$name' is '$value'" } PERL SKIP: { is ref $sub, 'CODE', "we can compile a simple subroutine" or skip $@ => 1; is $sub->("Foo", 'bar'), "'Foo' is 'bar'", "Passing parameters works"; } $sub = eval <<'PERL'; use Filter::signatures; use feature 'signatures'; sub ($name, $value, @) { return "'$name' is '$value'" } PERL SKIP: { is ref $sub, 'CODE', "we can compile a simple subroutine" or skip $@ => 2; { my @warnings; local $SIG{__WARN__} = sub { push @warnings, \@_}; is $sub->("Foo", 'bar', 'baz'), "'Foo' is 'bar'", "Passing parameters works"; is_deeply \@warnings, [], "No warnings get raised during call" or diag Dumper \@warnings; } } # Test our synopsis $sub = eval <<'PERL'; use Filter::signatures; no warnings 'experimental::signatures'; # does not raise an error use feature 'signatures'; # this now works on <5.16 as well sub ( $name ) { "Hello $name"; } PERL SKIP: { is ref $sub, 'CODE', "we can compile a simple subroutine" or skip $@ => 2; { my @warnings; local $SIG{__WARN__} = sub { push @warnings, \@_}; is $sub->('world'), "Hello world", "Passing parameters works"; is_deeply \@warnings, [], "No warnings get raised during call" or diag Dumper \@warnings; } } Filter-signatures-0.19/t/09-defined-or.t0000644000175000017500000000172414456701274017326 0ustar corioncorion#!perl -w use strict; use Test::More tests => 2; use Data::Dumper; use Text::Balanced 'extract_multiple', 'extract_quotelike'; require Filter::signatures; # Mimic parts of the setup of Filter::Simple my $extractor = $Filter::Simple::placeholder = $Filter::Simple::placeholder = qr/\Q$;\E(.{4})\Q$;\E/s; # Defined-or $_ = <<'SUB'; sub ( $name , $value //= 'bar' ) { return "'$name' is '$value'" }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Multiline signatures get converted for anonymous subs"; sub { my ($name,$value)=@_;$value //= 'bar';(); return "'$name' is '$value'" }; RESULT $_ = <<'SUB'; sub ( $name , $value ||= 'bar' ) { return "'$name' is '$value'" }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Multiline signatures get converted for anonymous subs"; sub { my ($name,$value)=@_;$value ||= 'bar';(); return "'$name' is '$value'" }; RESULT Filter-signatures-0.19/README.mkdn0000644000175000017500000001701414456701274016243 0ustar corioncorion [![Travis Build Status](https://travis-ci.org/Corion/Filter-signatures.svg?branch=master)](https://travis-ci.org/Corion/Filter-signatures) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/Corion/Filter-signatures?branch=master&svg=true)](https://ci.appveyor.com/project/Corion/Filter-signatures) # NAME Filter::signatures - very simplistic signatures for Perl < 5.20 # SYNOPSIS use Filter::signatures; no warnings 'experimental::signatures'; # does not raise an error use feature 'signatures'; # this now works on <5.20 as well sub hello( $name ) { print "Hello $name\n"; } hello("World"); sub hello2( $name="world" ) { print "Hello $name\n"; } hello2(); # Hello world # DESCRIPTION This module implements a backwards compatibility shim for formal Perl subroutine signatures that were introduced to the Perl core with Perl 5.20. # CAVEATS The technique used is a very simplistic transform to allow for using very simplistic named formal arguments in subroutine declarations. This module does not implement warning if more or fewer parameters than expected are passed in. The module also implements default values for unnamed parameters by splitting the formal parameters on `/,/` and assigning the values if `@_` contains fewer elements than expected. Function calls as default values may work by accident. Commas within default values happen to work due to the design of [Filter::Simple](https://metacpan.org/pod/Filter%3A%3ASimple), which removes them for the application of this filter. ## Syntax peculiarities Note that this module inherits all the bugs of [Filter::Simple](https://metacpan.org/pod/Filter%3A%3ASimple) and potentially adds some of its own. ### Slashes Most notable is that Filter::Simple sometimes will misinterpret the division operator `/` as a leading character to starting a regex match: my $wait_time = $needed / $supply; This will manifest itself through syntax errors appearing where everything seems in order. The hotfix is to add a comment to the code that "closes" the misinterpreted regular expression: my $wait_time = $needed / $supply; # / for Filter::Simple A better hotfix is to upgrade to Perl 5.20 or higher and use the native signatures support there. No other code change is needed, as this module will disable its functionality when it is run on a Perl supporting signatures. ### Size operator interpreted as replacement Filter::Simple sometimes will misinterpret the file size operator on the default filehandle `-s _` as the start of a replacement my $filesize = -s _; \# Misinterpreted as my $filesize = -(s _;..._g); This will manifest itself through syntax errors appearing where everything seems in order. The hotfix is to indicate that `<_`> is a filehandle by prefixing it with `<*`>: my $filesize = -s *_; A better hotfix is to upgrade to Perl 5.20 or higher and use the native signatures support there. No other code change is needed, as this module will disable its functionality when it is run on a Perl supporting signatures. ## Parentheses in default expressisons Ancient versions of Perl before version 5.10 do not have recursive regular expressions. These will not be able to properly handle statements such as sub foo ($timestamp = time()) { } The hotfix is to rewrite these function signatures to not use parentheses. The better approach is to upgrade to Perl 5.20 or higher. ## Regular expression matches in default expressions To keep the argument parser simple, the parsing of regular expressions has been omitted. For Perl below 5.10, you cannot use regular expressions as default expressions. For higher Perl versions, this means that parentheses, curly braces and commas need to be explicitly escaped with a backslash when used as default expressions: sub foo( $x = /,/ ) { # WRONG! sub foo( $x = /\,/ ) { # GOOD! sub foo( $x = /[(]/ ) { # WRONG! sub foo( $x = /[\(]/ ) { # GOOD! The hotfix is to rewrite these default expressions with explicitly quoted commas, parentheses and curly braces. The better approach is to upgrade to Perl 5.20 or higher. ## Subroutine attributes Subroutine attributes are currently not supported at all. ## Line Numbers Due to a peculiarity of how Filter::Simple treats here documents in some versions, line numbers may get out of sync if you use here documents. If you spread your formal signatures across multiple lines, the line numbers may also go out of sync with the original document. ## `eval` [Filter::Simple](https://metacpan.org/pod/Filter%3A%3ASimple) does not trigger when using code such as eval <<'PERL'; use Filter::signatures; use feature 'signatures'; sub foo (...) { } PERL So, creating subroutines with signatures from strings won't work with this module. The workaround is to upgrade to Perl 5.20 or higher. ## Deparsing The generated code does not deparse identically to the code generated on a Perl with native support for signatures. # ENVIRONMENT If you want to force the use of this module even under versions of Perl that have native support for signatures, set `$ENV{FORCE_FILTER_SIGNATURES}` to a true value before the module is imported. # USAGE WITHOUT SOURCE CODE MODIFICATION If you have a source file that was written for use with signatures and you cannot modify that source file, you can run it as follows: perl -Mlib=some/directory -MFilter::signatures=global myscript.pl This is intended as a quick-fix solution and is not very robust. If your script modifies `@INC`, the filtering may not get a chance to modify the source code of the loaded module. This currently does not play well with (other) hooks in `@INC` as it only handles hooks that return a filehandle. Implementations for the rest are welcome. # SEE ALSO ["Signatures" in perlsub](https://metacpan.org/pod/perlsub#Signatures) [App::sigfix](https://metacpan.org/pod/App%3A%3Asigfix), which transforms your source code directly between the different notations without employing a source filter [signatures](https://metacpan.org/pod/signatures) - a module that doesn't use a source filter but optree modification instead [Sub::Signatures](https://metacpan.org/pod/Sub%3A%3ASignatures) - uses signatures to dispatch to different subroutines based on which subroutine matches the signature [Method::Signatures](https://metacpan.org/pod/Method%3A%3ASignatures) - this module implements subroutine signatures closer to Perl 6, but requires [PPI](https://metacpan.org/pod/PPI) and [Devel::Declare](https://metacpan.org/pod/Devel%3A%3ADeclare) [Function::Parameters](https://metacpan.org/pod/Function%3A%3AParameters) - adds two new keywords for declaring subroutines and parses their signatures. It supports more features than core Perl, closer to Perl 6, but requires a C compiler and Perl 5.14+. # REPOSITORY The public repository of this module is [http://github.com/Corion/filter-signatures](http://github.com/Corion/filter-signatures). # SUPPORT The public support forum of this module is [https://perlmonks.org/](https://perlmonks.org/). # BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at [https://rt.cpan.org/Public/Dist/Display.html?Name=Filter-signatures](https://rt.cpan.org/Public/Dist/Display.html?Name=Filter-signatures) or via mail to [filter-signatures-Bugs@rt.cpan.org](https://metacpan.org/pod/filter-signatures-Bugs%40rt.cpan.org). # AUTHOR Max Maischein `corion@cpan.org` # COPYRIGHT (c) Copyright 2015-2023 by Max Maischein `corion@cpan.org`. # LICENSE This module is released under the same terms as Perl itself. Filter-signatures-0.19/.gitignore0000644000175000017500000000024214456701274016416 0ustar corioncorionMakefile Makefile.old *.tar.gz *.bak pm_to_blib blib/ Filter-signatures-* Filter-signatures-*/ .prove .releaserc cover_db firefox-versions/ MYMETA.* Filter-signatures-0.19/META.yml0000644000175000017500000000150314456701275015701 0ustar corioncorion--- abstract: 'very simplistic signatures for Perl < 5.20' author: - 'Max Maischein ' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0' Text::Balanced: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Filter-signatures no_index: directory: - t - inc requires: Filter::Simple: '0.91' perl: '5.006' resources: bugtracker: https://github.com/Corion/Filter-signatures/issues license: https://dev.perl.org/licenses/ repository: git://github.com/Corion/Filter-signatures.git version: '0.19' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' x_static_install: 1 Filter-signatures-0.19/lib/0000755000175000017500000000000014456701275015177 5ustar corioncorionFilter-signatures-0.19/lib/Filter/0000755000175000017500000000000014456701275016424 5ustar corioncorionFilter-signatures-0.19/lib/Filter/signatures.pm0000644000175000017500000003647614456701274021165 0ustar corioncorionpackage Filter::signatures; use strict; use Filter::Simple; our $VERSION = '0.19'; =head1 NAME Filter::signatures - very simplistic signatures for Perl < 5.20 =head1 SYNOPSIS use Filter::signatures; no warnings 'experimental::signatures'; # does not raise an error use feature 'signatures'; # this now works on <5.20 as well sub hello( $name ) { print "Hello $name\n"; } hello("World"); sub hello2( $name="world" ) { print "Hello $name\n"; } hello2(); # Hello world =head1 DESCRIPTION This module implements a backwards compatibility shim for formal Perl subroutine signatures that were introduced to the Perl core with Perl 5.20. =head1 CAVEATS The technique used is a very simplistic transform to allow for using very simplistic named formal arguments in subroutine declarations. This module does not implement warning if more or fewer parameters than expected are passed in. The module also implements default values for unnamed parameters by splitting the formal parameters on C<< /,/ >> and assigning the values if C<< @_ >> contains fewer elements than expected. Function calls as default values may work by accident. Commas within default values happen to work due to the design of L, which removes them for the application of this filter. =head2 Syntax peculiarities Note that this module inherits all the bugs of L and potentially adds some of its own. =head3 Slashes Most notable is that Filter::Simple sometimes will misinterpret the division operator C<< / >> as a leading character to starting a regex match: my $wait_time = $needed / $supply; This will manifest itself through syntax errors appearing where everything seems in order. The hotfix is to add a comment to the code that "closes" the misinterpreted regular expression: my $wait_time = $needed / $supply; # / for Filter::Simple A better hotfix is to upgrade to Perl 5.20 or higher and use the native signatures support there. No other code change is needed, as this module will disable its functionality when it is run on a Perl supporting signatures. =head3 Size operator interpreted as replacement Filter::Simple sometimes will misinterpret the file size operator on the default filehandle C<< -s _ >> as the start of a replacement my $filesize = -s _; # Misinterpreted as my $filesize = -(s _;..._g); This will manifest itself through syntax errors appearing where everything seems in order. The hotfix is to indicate that C<<_>> is a filehandle by prefixing it with C<<*>>: my $filesize = -s *_; A better hotfix is to upgrade to Perl 5.20 or higher and use the native signatures support there. No other code change is needed, as this module will disable its functionality when it is run on a Perl supporting signatures. =head2 Parentheses in default expressisons Ancient versions of Perl before version 5.10 do not have recursive regular expressions. These will not be able to properly handle statements such as sub foo ($timestamp = time()) { } The hotfix is to rewrite these function signatures to not use parentheses. The better approach is to upgrade to Perl 5.20 or higher. =head2 Regular expression matches in default expressions To keep the argument parser simple, the parsing of regular expressions has been omitted. For Perl below 5.10, you cannot use regular expressions as default expressions. For higher Perl versions, this means that parentheses, curly braces and commas need to be explicitly escaped with a backslash when used as default expressions: sub foo( $x = /,/ ) { # WRONG! sub foo( $x = /\,/ ) { # GOOD! sub foo( $x = /[(]/ ) { # WRONG! sub foo( $x = /[\(]/ ) { # GOOD! The hotfix is to rewrite these default expressions with explicitly quoted commas, parentheses and curly braces. The better approach is to upgrade to Perl 5.20 or higher. =head2 Subroutine attributes Subroutine attributes are currently not supported at all. =head2 Line Numbers Due to a peculiarity of how Filter::Simple treats here documents in some versions, line numbers may get out of sync if you use here documents. If you spread your formal signatures across multiple lines, the line numbers may also go out of sync with the original document. =head2 C<< eval >> L does not trigger when using code such as eval <<'PERL'; use Filter::signatures; use feature 'signatures'; sub foo (...) { } PERL So, creating subroutines with signatures from strings won't work with this module. The workaround is to upgrade to Perl 5.20 or higher. =head2 Deparsing The generated code does not deparse identically to the code generated on a Perl with native support for signatures. =head1 ENVIRONMENT If you want to force the use of this module even under versions of Perl that have native support for signatures, set C<< $ENV{FORCE_FILTER_SIGNATURES} >> to a true value before the module is imported. =cut my $have_signatures = eval { require feature; feature->import('signatures'); 1 }; sub kill_comment { my( $str ) = @_; my @strings = ($str =~ /$Filter::Simple::placeholder/g); for my $ph (@strings) { my $index = unpack('N',$ph); if( ref $Filter::Simple::components[$index] and ${ $Filter::Simple::components[$index] } =~ /^#/ ) { #warn ">> $str contains comment ${$Filter::Simple::components[$index]}"; $str =~ s!\Q$;$ph$;\E!!g; }; } $str } sub parse_argument_list { my( $name, $arglist, $whitespace ) = @_; (my $args=$arglist) =~ s!^\(\s*(.*)\s*\)!$1!s; my @args; # A not so simple argument parser, but still good enough for < 5.10: # We want to split on the outermost commas, so we find the position of these # commas by replacing everything inside parentheses and curly brackets with # whitespace. Then we have the positions of the relevant commas and can extract # the arguments from that. Not elegant but works everywhere: if( length $args ) { my $splitlist = $args; my $repl = " " x length $;; $splitlist =~ s!\Q$;\E.{4}\Q$;\E!$repl $repl!sg; # remove all string placeholders 1 while ($splitlist =~ s!\\.! !g); # unquote all the things #warn $splitlist; 1 while ($splitlist =~ s!(\([^(){}]*\)|\{[^(){}]*\})!" " x length($1)!ge); # Now, remove all nested parentheses stuff #warn $splitlist; my @argument_positions; while( $splitlist =~ /,/g ) { push @argument_positions, pos($splitlist); }; push @argument_positions, length( $splitlist )+1; my $lastpos = 0; @args = map { kill_comment($_) } map { s!^\s*!!; s!\s*$!!; $_} map { my $r = substr $args, $lastpos, $_-$lastpos-1; #warn "$lastpos:$_:$r"; $lastpos=$_; $r } @argument_positions ; }; my $res; # Adjust how many newlines we gobble $whitespace ||= ''; #warn "[[$whitespace$args]]"; my $padding = () = (($whitespace . $args) =~ /\n/smg); if( @args ) { my @defaults; for( 0..$#args ) { # Keep everything on one line $args[$_] =~ s/\n/ /g; # Named argument with default if( $args[$_] =~ m!^\s*([\$\%\@]\s*\w+)\s*(//=|\|\|=|=)\s*(.*)$! ) { my $named = "$1"; my $op = "$2"; my $val = "$3"; if( $op eq '=' ) { push @defaults, "$named $op $val if \@_ <= $_;"; } else { push @defaults, "$named $op $val;"; } $args[$_] = $named; # Named argument } elsif( $args[$_] =~ /^\s*([\$\%\@]\s*\w+)\s*$/ ) { my $named = "$1"; $args[$_] = $named; # Slurpy discard } elsif( $args[$_] =~ /^\s*\$\s*$/ ) { $args[$_] = 'undef'; # Slurpy discard (at the end) } elsif( $args[$_] =~ /^\s*[\%\@]\s*$/ ) { $args[$_] = 'undef'; } else { #use Data::Dumper; #warn Dumper \@Filter::Simple::components; #die "Weird, unparsed argument '$args[$_]'"; }; }; # Make sure we return undef as the last statement of our initialization # See t/07* push @defaults, "();" if @args; $res = sprintf 'sub %s { my (%s)=@_;%s%s', $name, join(",", @args), join( "" , @defaults), "\n" x $padding; # die sprintf("Too many arguments for subroutine at %s line %d.\n", (caller)[1, 2]) unless @_ <= 2 # die sprintf("Too few arguments for subroutine at %s line %d.\n", (caller)[1, 2]) unless @_ >= 2 } else { $res = sprintf 'sub %s { @_==0 or warn "Subroutine %s called with parameters.";();', $name, $name; }; return $res } # This is the version that is most downwards compatible but doesn't handle # parentheses in default assignments sub transform_arguments { # This should also support # sub foo($x,$y,@) { ... }, throwing away additional arguments # Named or anonymous subs no warnings 'uninitialized'; s{\bsub(\s*)(\w*)(\s*)\((\s*)((?:[^)]*?\@?))(\s*)\)(\s*)\{}{ parse_argument_list("$2","$5","$1$3$4$6$7") }mge; $_ } if( $] >= 5.010 ) { # Perl 5.10 onwards has recursive regex patterns, and comments, and stuff # We have an interesting dependency on the format the string placeholders that # Filter::Simple supplies. They MUST be four characters wide. no warnings 'redefine'; eval <<'PERL_5010_onwards'; sub transform_arguments { # We also want to handle arbitrarily deeply nested balanced parentheses here no warnings 'uninitialized'; # If you are staring at this, somewhere in your source code, you have # $/ and you want to make sure there is a second slash on the same line, # like `local $/; # / for Filter::signatures` # Or "-s _" , this also trips up Filter::Simple. Replace by "-s *_" #my $msg = $_; #$msg =~ s!([\x00-\x09\x0b-\x1F])!sprintf "\\%03o", ord $1!ge; #print "$msg\n---\n"; #use Regexp::Debugger; s{(?\bsub\b) #1 (?>(\s*)) #2 (?>(\b\w+\b|)) #3 (\s*) #4 \( (\s*) #5 ( #6 ( #7 (?: \\. # regex escapes and references | (?>".{5}") # strings (that are placeholders) | (?>"[^"]+") # strings (that are not placeholders, mainly for the test suite) | \( (?7)? # recurse for parentheses \) | \{ (?7)? # recurse for curly brackets \} | (?>[^\\\(\)\{\}"]+) # other stuff )+ )* \@? # optional slurpy discard argument at the end ) (\s*)\) (\s*)\{}{ parse_argument_list("$3","$6","$2$4$5$9$10") }mgex; $_ } PERL_5010_onwards die $@ if $@; } sub import { my( $class, $scope ) = @_; # Guard against double-installation of our scanner if( $scope and $scope eq 'global' ) { my $scan; $scan = sub { my( $self, $filename ) = @_; # Find the filters/directories that are still applicable: my $idx = 0; $idx++ while ((!ref $INC[$idx] or $INC[$idx] != $scan) and $idx < @INC); $idx++; my @found; foreach my $prefix (@INC[ $idx..$#INC ]) { if (ref($prefix) eq 'CODE') { #... do other stuff - see text below .... @found = $prefix->( $self, $filename ); if( @found ) { # we found the module last; }; } else { my $realfilename = "$prefix/$filename"; next if ! -e $realfilename || -d _ || -b _; open my $fh, '<', $realfilename or die "Couldn't read '$realfilename': $!"; @found = (undef, $fh); }; }; if( !ref $found[0] ) { $found[0] = \(my $buf = ""); }; ${$found[0]} .= do { local $/; my $fh = $found[1]; my $content = <$fh>; $content }; # Prepend usages of "feature" with our filter ${$found[0]} =~ s!\b(use\s+feature\s+(['"])signatures\2)!use Filter::signatures;\n$1!gs; return @found }; # We need to run as early as possible to filter other modules unshift @INC, $scan; }; } if( (! $have_signatures) or $ENV{FORCE_FILTER_SIGNATURES} ) { FILTER_ONLY code_no_comments => \&transform_arguments, executable => sub { s!^\s*(use\s+feature\s*(['"])signatures\2;)!#$1!mg; s!^\s*(no\s+warnings\s*(['"])experimental::signatures\2;)!#$1!mg; }, ; # Set up a fake 'experimental::signatures' warnings category { package # hide from CPAN experimental::signatures; eval { require warnings::register; warnings::register->import(); } } } 1; =head1 USAGE WITHOUT SOURCE CODE MODIFICATION If you have a source file that was written for use with signatures and you cannot modify that source file, you can run it as follows: perl -Mlib=some/directory -MFilter::signatures=global myscript.pl This is intended as a quick-fix solution and is not very robust. If your script modifies C<@INC>, the filtering may not get a chance to modify the source code of the loaded module. This currently does not play well with (other) hooks in C<@INC> as it only handles hooks that return a filehandle. Implementations for the rest are welcome. =head1 SEE ALSO L L, which transforms your source code directly between the different notations without employing a source filter L - a module that doesn't use a source filter but optree modification instead L - uses signatures to dispatch to different subroutines based on which subroutine matches the signature L - this module implements subroutine signatures closer to Perl 6, but requires L and L L - adds two new keywords for declaring subroutines and parses their signatures. It supports more features than core Perl, closer to Perl 6, but requires a C compiler and Perl 5.14+. =head1 REPOSITORY The public repository of this module is L. =head1 SUPPORT The public support forum of this module is L. =head1 BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. =head1 AUTHOR Max Maischein C =head1 COPYRIGHT (c) Copyright 2015-2023 by Max Maischein C. =head1 LICENSE This module is released under the same terms as Perl itself. =cut Filter-signatures-0.19/META.json0000644000175000017500000000276314456701275016062 0ustar corioncorion{ "abstract" : "very simplistic signatures for Perl < 5.20", "author" : [ "Max Maischein " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Filter-signatures", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Filter::Simple" : "0.91", "perl" : "5.006" } }, "test" : { "requires" : { "Test::More" : "0", "Text::Balanced" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/Corion/Filter-signatures/issues" }, "license" : [ "https://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/Corion/Filter-signatures.git", "web" : "https://github.com/Corion/Filter-signatures" } }, "version" : "0.19", "x_serialization_backend" : "JSON::PP version 4.11", "x_static_install" : 1 } Filter-signatures-0.19/xt/0000755000175000017500000000000014456701275015064 5ustar corioncorionFilter-signatures-0.19/xt/99-todo.t0000644000175000017500000000216614456701274016461 0ustar corioncorionuse Test::More; use File::Spec; use File::Find; use strict; # Check that all files do not contain any # lines with "XXX" - such markers should # either have been converted into Todo-stuff # or have been resolved. # The test was provided by Andy Lester. require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => 2* @files; foreach my $file (@files) { source_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub source_file_ok { my $file = shift; open( my $fh, '<', $file ) or die "Can't open $file: $!"; my @lines = <$fh>; close $fh; my $n = 0; for ( @lines ) { ++$n; s/^/$file ($n): /; } my @x = grep /XXX/, @lines; if ( !is( scalar @x, 0, "Looking for XXXes in $file" ) ) { diag( $_ ) for @x; } @x = grep /<<<|>>>/, @lines; if ( !is( scalar @x, 0, "Looking for <<<<|>>>> in $file" ) ) { diag( $_ ) for @x; } } Filter-signatures-0.19/xt/99-changes.t0000644000175000017500000000133714456701274017123 0ustar corioncorion#!perl -w use warnings; use strict; use File::Find; use Test::More tests => 2; =head1 PURPOSE This test ensures that the Changes file mentions the current version and that a release date is mentioned as well =cut require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my $module = $module{NAME}; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; my $changes = do { local $/; open my $fh, 'Changes' or die $!; <$fh> }; ok $changes =~ /^(.*$version.*)$/m, "We find version $version for $module"; my $changes_line = $1; ok $changes_line =~ /$version\s+20\d\d-[01]\d-[0123]\d\b/, "We find a release date on the same line" or diag $changes_line; Filter-signatures-0.19/xt/99-manifest.t0000644000175000017500000000204414456701274017315 0ustar corioncorionuse strict; use Test::More; # Check that MANIFEST and MANIFEST.skip are sane : use File::Find; use File::Spec; my @files = qw( MANIFEST MANIFEST.SKIP ); plan tests => scalar @files * 4 +1 # MANIFEST existence check +1 # MYMETA.* non-existence check ; for my $file (@files) { ok(-f $file, "$file exists"); open my $fh, '<', $file or die "Couldn't open $file : $!"; my @lines = <$fh>; is_deeply([grep(/^$/, @lines)],[], "No empty lines in $file"); is_deeply([grep(/^\s+$/, @lines)],[], "No whitespace-only lines in $file"); is_deeply([grep(/^\s*\S\s+$/, @lines)],[],"No trailing whitespace on lines in $file"); if ($file eq 'MANIFEST') { chomp @lines; is_deeply([grep { s/\s.*//; ! -f } @lines], [], "All files in $file exist") or do { diag "$_ is mentioned in $file but doesn't exist on disk" for grep { ! -f } @lines }; # Exclude some files from shipping is_deeply([grep(/^MYMETA\.(yml|json)$/, @lines)],[],"We don't try to ship MYMETA.* $file"); }; close $fh; }; Filter-signatures-0.19/xt/99-unix-text.t0000644000175000017500000000174514456701274017463 0ustar corioncorionuse Test::More; # Check that all released module files are in # UNIX text format use File::Spec; use File::Find; use strict; my @files = ('Makefile.PL', 'MANIFEST', 'MANIFEST.SKIP', glob 't/*.t'); require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => scalar @files; foreach my $file (@files) { unix_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub unix_file_ok { my ($filename) = @_; local $/; open my $fh, '<', $filename or die "Couldn't open '$filename' : $!\n"; binmode $fh; my $content = <$fh>; my $i; my @lines = grep { /\x0D\x0A$/sm } map { sprintf "%s: %s\x0A", $i++, $_ } split /\x0A/, $content; unless (is(scalar @lines, 0,"'$filename' contains no windows newlines")) { diag $_ for @lines; }; close $fh; }; Filter-signatures-0.19/xt/99-test-prerequisites.t0000644000175000017500000000653514456701274021401 0ustar corioncorion#!perl -w use warnings; use strict; use Test::More; use Data::Dumper; use File::Find; =head1 DESCRIPTION This test checks whether all tests still pass when the optional test prerequisites for the test are not present. This is done by using L to rerun the test while excluding the optional prerequisite. =cut BEGIN { eval { require CPAN::Meta::Prereqs; require Parse::CPAN::Meta; require Perl::PrereqScanner::Lite; require Module::CoreList; require Test::Without::Module; require Capture::Tiny; Capture::Tiny->import('capture'); require Path::Class; Path::Class->import('dir'); }; if (my $err = $@) { warn "# $err"; plan skip_all => "Prerequisite needed for testing is missing"; exit 0; }; }; my @tests; if( @ARGV ) { @tests = @ARGV; } else { open my $manifest, '<', 'MANIFEST' or die "Couldn't read MANIFEST: $!"; @tests = grep { -f $_ } grep { m!^(t/.*\.t|scripts/.*\.pl)$! } map { s!\s*$!!; $_ } <$manifest> } plan tests => 0+@tests; my $meta = Parse::CPAN::Meta->load_file('META.json'); # Find what META.* declares my $explicit_test_prereqs = CPAN::Meta::Prereqs->new( $meta->{prereqs} )->merged_requirements->as_string_hash; my $minimum_perl = $meta->{prereqs}->{runtime}->{requires}->{perl} || 5.006; sub distributed_packages { my @modules; for( @_ ) { dir($_)->recurse( callback => sub { my( $child ) = @_; if( !$child->is_dir and $child =~ /\.pm$/) { push @modules, ((scalar $child->slurp()) =~ m/^\s*package\s+(?:#.*?\n\s+)*(\w+(?:::\w+)*)\b/msg); } }); }; map { $_ => $_ } @modules; } # Find what we distribute: my %distribution = distributed_packages('blib','t'); my $scanner = Perl::PrereqScanner::Lite->new; for my $test_file (@tests) { my $implicit_test_prereqs = $scanner->scan_file($test_file)->as_string_hash; my %missing = %{ $implicit_test_prereqs }; #warn Dumper \%missing; for my $p ( keys %missing ) { # remove core modules if( Module::CoreList::is_core( $p, undef, $minimum_perl)) { delete $missing{ $p }; #diag "$p is core for $minimum_perl"; } else { #diag "$p is not in core for $minimum_perl"; }; }; # remove explicit (test) prerequisites for my $k (keys %$explicit_test_prereqs) { delete $missing{ $k }; }; #warn Dumper $explicit_test_prereqs->as_string_hash; # Remove stuff from our distribution for my $k (keys %distribution) { delete $missing{ $k }; }; # If we have no apparent missing prerequisites, we're good my @missing = sort keys %missing; # Rerun the test without these modules and see whether it crashes my @failed; for my $candidate (@missing) { diag "Checking that $candidate is not essential"; my @cmd = ($^X, "-MTest::Without::Module=$candidate", "-Mblib", '-w', $test_file); my $cmd = join " ", @cmd; my ($stdout, $stderr, $exit) = capture { system( @cmd ); }; if( $exit != 0 ) { push @failed, [ $candidate, [@cmd]]; } elsif( $? != 0 ) { push @failed, [ $candidate, [@cmd]]; }; }; is 0+@failed, 0, $test_file or diag Dumper \@failed; }; done_testing; Filter-signatures-0.19/xt/99-pod.t0000644000175000017500000000145514456701274016276 0ustar corioncorionuse Test::More; # Check our Pod # The test was provided by Andy Lester, # who stole it from Brian D. Foy # Thanks to both ! use File::Spec; use File::Find; use strict; eval { require Test::Pod; Test::Pod->import; }; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; if ($@) { plan skip_all => "Test::Pod required for testing POD"; } elsif ($Test::Pod::VERSION < 0.95) { plan skip_all => "Test::Pod 0.95 required for testing POD"; } else { my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => scalar @files; foreach my $file (@files) { pod_file_ok($file); } } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } Filter-signatures-0.19/xt/copyright.t0000644000175000017500000000465014456701274017265 0ustar corioncorion#!perl use warnings; use strict; use File::Find; use Test::More tests => 1; use POSIX 'strftime'; my $this_year = strftime '%Y', localtime; my $last_modified_year = 0; my $is_checkout = -d '.git'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; #my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ('lib')); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub collect { my( $file ) = @_; note $file; my $modified_ts; if( $is_checkout ) { # diag `git log -1 --pretty="format:%ct" "$file"`; $modified_ts = `git log -1 --pretty="format:%ct" "$file"`; } else { $modified_ts = (stat($_))[9]; } my $modified_year; if( $modified_ts ) { $modified_year = strftime('%Y', localtime($modified_ts)); } else { $modified_year = 1970; }; open my $fh, '<', $file or die "Couldn't read $file: $!"; my @copyright = map { /\bcopyright\b.*?\d{4}-(\d{4})\b/i ? [ $_ => $1 ] : () } <$fh>; my $copyright = 0; for (@copyright) { $copyright = $_->[1] > $copyright ? $_->[1] : $copyright; }; return { file => $file, copyright_lines => \@copyright, copyright => $copyright, modified => $modified_year, }; }; my @results; for my $file (@files) { push @results, collect($file); }; for my $file (@results) { $last_modified_year = $last_modified_year < $file->{modified} ? $file->{modified} : $last_modified_year; }; note "Distribution was last modified in $last_modified_year"; my @out_of_date = grep { $_->{copyright} and $_->{copyright} < $last_modified_year } @results; if(! is 0+@out_of_date, 0, "All files have a current copyright year ($last_modified_year)") { for my $file (@out_of_date) { diag sprintf "%s modified %d, but copyright is %d", $file->{file}, $file->{modified}, $file->{copyright}; diag $_ for map {@$_} @{ $file->{copyright_lines}}; }; diag q{To fix (in a rough way, please review) run}; diag sprintf q{ perl -i -ple 's!(\bcopyright\b.*?\d{4}-)(\d{4})\b!${1}%s!i' %s}, $this_year, join ' ', map { $_->{file} } @out_of_date; }; Filter-signatures-0.19/xt/99-compile.t0000644000175000017500000000202514456701274017136 0ustar corioncorion#!perl use warnings; use strict; use File::Find; use Test::More; BEGIN { eval 'use Capture::Tiny ":all"; 1'; if ($@) { plan skip_all => "Capture::Tiny needed for testing"; exit 0; }; }; plan 'no_plan'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my $last_version = undef; sub check { #return if (! m{(\.pm|\.pl) \z}xmsi); my ($stdout, $stderr, $exit) = capture(sub { system( $^X, '-Mblib', '-c', $_ ); }); s!\s*\z!! for ($stdout, $stderr); if( $exit ) { diag $stderr; diag "Exit code: ", $exit; fail($_); } elsif( $stderr ne "$_ syntax OK") { diag $stderr; fail($_); } else { pass($_); }; } my @files; find({wanted => \&wanted, no_chdir => 1}, grep { -d $_ } 'blib/lib', 'examples', 'lib' ); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; for (@files) { check($_) } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } Filter-signatures-0.19/xt/99-synopsis.t0000644000175000017500000000301114456701274017371 0ustar corioncorionuse strict; use Test::More; use File::Spec; use File::Find; use File::Temp 'tempfile'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); #if( my $exe = $module{EXE_FILES}) { # push @files, @$exe; #}; plan tests => scalar @files; foreach my $file (@files) { synopsis_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/ and $_ !~ /\bDSL\.pm$/; # we skip that one as it initializes immediately } sub synopsis_file_ok { my( $file ) = @_; my $name = "SYNOPSIS in $file compiles"; open my $fh, '<', $file or die "Couldn't read '$file': $!"; my @synopsis = map { s!^\s\s!!; $_ } # outdent all code for here-docs grep { /^\s\s/ } # extract all verbatim (=code) stuff grep { /^=head1\s+SYNOPSIS$/.../^=/ } # extract Pod synopsis <$fh>; if( @synopsis ) { my($tmpfh,$tempname) = tempfile(); print {$tmpfh} join '', @synopsis; close $tmpfh; # flush it my $output = `$^X -Ilib -c $tempname 2>&1`; if( $output =~ /\ssyntax OK$/ ) { pass $name; } else { fail $name; diag $output; diag $_ for @synopsis; }; unlink $tempname or warn "Couldn't clean up $tempname: $!"; } else { SKIP: { skip "$file has no SYNOPSIS section", 1; }; }; } Filter-signatures-0.19/xt/99-versions.t0000644000175000017500000000315714456701274017365 0ustar corioncorion#!perl -w # Stolen from ChrisDolan on use.perl.org # http://use.perl.org/comments.pl?sid=29264&cid=44309 use warnings; use strict; use File::Find; use Test::More; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; sub read_file { open my $fh, '<', $_[0] or die "Couldn't read '$_[0]': $!"; binmode $fh; local $/; <$fh> } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } plan tests => 0+@files; my $last_version = undef; sub check { my $content = read_file($_); # only look at perl scripts, not sh scripts return if (m{blib/script/}xms && $content !~ m/\A \#![^\r\n]+?perl/xms); # what my version numbers look like my $version = qr/\d+\.\d+/; my @version_lines = grep { defined } $content =~ m/ [^\n]* \$VERSION \s* = \s* ["']($version)['"] | package \s+ \S+ \s+ ($version) \s* ; /gxms; if (@version_lines == 0) { fail($_); } for my $line (@version_lines) { $line =~ s/^\s+//; $line =~ s/\s+$//; if (!defined $last_version) { $last_version = shift @version_lines; diag "Checking for $last_version"; pass($_); } else { is($line, $last_version, $_); } } } for (@files) { check(); }; if (! defined $last_version) { fail('Failed to find any files with $VERSION'); } Filter-signatures-0.19/xt/meta-lint.t0000644000175000017500000000215714456701274017147 0ustar corioncorion#!perl -w # Stolen from ChrisDolan on use.perl.org # http://use.perl.org/comments.pl?sid=29264&cid=44309 use warnings; use strict; use File::Find; use Test::More; eval { #require Test::MinimumVersion::Fast; require Parse::CPAN::Meta; Parse::CPAN::Meta->import(); require CPAN::Meta::Validator; CPAN::Meta::Validator->VERSION(2.15); }; if ($@) { plan skip_all => "CPAN::Meta::Validator version 2.15 required for testing META files"; } else { plan tests => 4; } use lib '.'; our %module; require 'Makefile.PL'; # Loaded from Makefile.PL %module = get_module_info(); my $module = $module{NAME}; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; for my $meta_file ('META.yml', 'META.json') { my $meta = Parse::CPAN::Meta->load_file($meta_file); my $cmv = CPAN::Meta::Validator->new( $meta ); if(! ok $cmv->is_valid, "$meta_file is valid" ) { diag $_ for $cmv->errors; }; # Also check that the declared version matches the version in META.* is $meta->{version}, $version, "$meta_file version matches module version ($version)"; }; Filter-signatures-0.19/04-deparse.t.disabled0000644000175000017500000000644114456701274020234 0ustar corioncorion#!perl -w use strict; use Test::More tests => 11; use Data::Dumper; use feature 'signatures'; no warnings 'experimental::signatures'; require Filter::signatures; require B::Deparse; # Eval code while still expanding it with source filters sub compile { my( $str ) = @_; local $_ = $str; Filter::signatures::transform_arguments(); return $_ }; sub normalize { my( $str ) = @_; my $compiled = eval $str; die $@ if $@; my $deparse = B::Deparse->new("-sC"); my $body = $deparse->coderef2text($compiled); } sub deparses_identical { my( $str ) = @_; my $transformed = normalize(compile($str)); my $native = normalize($str); is $transformed, $native; } # Anonymous $_ = <<'SUB'; sub ($name, $value) { return "'$name' is '$value'" }; SUB deparses_identical( $_ ); Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Anonymous subroutines get converted"; sub { my ($name,$value)=@_; return "'$name' is '$value'" }; RESULT deparses_identical( $_ ); $_ = <<'SUB'; sub foo5 () { return "We can call a sub without parameters" }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Parameterless subroutines don't get converted"; sub foo5 { @_==0 or warn "Subroutine foo5 called with parameters."; return "We can call a sub without parameters" }; RESULT # Function default parameters $_ = <<'SUB'; sub mylog($msg, $when=time) { print "[$when] $msg\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Function default parameters get converted"; sub mylog { my ($msg,$when)=@_;$when=time if @_ <= 1; print "[$when] $msg\n"; }; RESULT # Empty parameter list $_ = <<'SUB'; sub mysub() { print "Yey\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Functions without parameters get converted properly"; sub mysub { @_==0 or warn "Subroutine mysub called with parameters."; print "Yey\n"; }; RESULT # Discarding parameters $_ = <<'SUB'; sub mysub($) { print "Yey\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Functions with unnamed parameters get converted properly"; sub mysub { my (undef)=@_; print "Yey\n"; }; RESULT # Discarding parameters $_ = <<'SUB'; sub mysub($foo, $, $bar) { print "Yey, $foo => $bar\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Functions without parameters get converted properly"; sub mysub { my ($foo,undef,$bar)=@_; print "Yey, $foo => $bar\n"; }; RESULT # Signature-less functions remain unchanged $_ = <<'SUB'; sub mysub { print "Yey\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Named functions without signature remain unchanged"; sub mysub { print "Yey\n"; }; RESULT $_ = <<'SUB'; sub { print "Yey\n"; }; SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "Named functions without signature remain unchanged"; sub { print "Yey\n"; }; RESULT $_ = <<'SUB'; sub foo($bar,$baz) { print "Yey\n"; } SUB Filter::signatures::transform_arguments(); is $_, <<'RESULT', "RT #xxxxxx Single-line functions work"; sub foo { my ($bar,$baz)=@_; print "Yey\n"; } RESULT done_testing;Filter-signatures-0.19/Changes0000644000175000017500000001027714456701274015732 0ustar corioncorion0.19 2023-07-22 * Various test suite fixes 0.18 2023-07-21 * Support //= in signatures, like 5.38 does * Various test suite fixes 0.17 2020-10-03 * Make some capture groups atomic to speed up matching * Documentation updates to mention more common code pitfalls that trip up Filter::Simple and Filter::signatures 0.16 2020-08-23 + Fix signature parsing when there are more than 40 placeholder strings This was an interesting bug to chase down. Filter::Simple replaces all strings with placeholders, but if you have enough of them, one of them becomes "\0\0\0(", which the signature parsing did not cope with. + "use feature 'signatures';" and "no warnings 'experimental::signatures';" are now allowed to have leading whitespace but still must be on a line of their own. 0.15 2018-08-19 + Add mention of App::sigfix and Babble + Document that only a reduced set of regular expression matches is correctly parsed in default expressions + Correctly parse do {} blocks in default expressions + Correctly parse function parameters in case of nested functions and blocks 0.14 2018-07-26 + Add code and documentation on how to load this module from the command line. This is mostly intended to give you a way to do a quick fix for using Perl code that requires signatures on a version of Perl that doesn't support them out of the box. 0.13 2018-05-11 + Support (well, ignore) comments in signatures This comes at the cost of erasing those comments from the source code. If you stack source filters and a source filters expects to extract value from the comments, this won't work anymore. ! More robustness when parsing the formal signature argument list. Too many strings in your source code could make the module behave erratically 0.12 2018-05-10 ! Make subroutines with empty body return C Pointed out in discussion at https://www.nntp.perl.org/group/perl.perl5.porters/2014/02/msg212580.html . Documentation fix by MANWAR, many thanks! 0.11 2018-02-28 + Support parentheses in default assignments on Perl 5.10 onwards sub foo( $now = time() ) { 0.10 2017-06-28 + Support multiline signatures . We also attempt to keep the line numbers correct 0.09 2017-01-16 + Support single-line functions In fact, we simply don't require the subroutine declaration to be on a separate line from other code. This adresses RT #119843 0.08 2016-12-19 ! Make signature-less subroutines work again instead of warning 0.07 2016-12-18 + Actually allow for empty parameter lists + Allow for unnamed/ignored parameters sub ($foo,$,$bar) { ... } . Adresses Github issue #1 0.06 2016-11-07 + Don't crash on empty function parameter lists. + Make module internals more testable . Add a test that verifies function default parameters actually parse as we expect. Thanks to Rolf Langsdorf for the discussion. 0.05 2016-09-29 . Bump Filter::Simple prerequisite to 0.91 Earlier versions gave problems with some of my modules If it works for you, no need to upgrade 0.04 2016-09-06 + Add support for defaults, and our own, very, _very_ simplicistic "expression parser" (which blindly splits on comma. This means that the following is now supported: sub foo( $bar, $baz='default' ) { return $baz }; print foo("two","parameters"); # parameters print foo("one"); # default The following will still fail horribly, because we don't parse expressions: sub foo( $bar, $baz=bar(1,2) ) { print $baz # "default" }; 0.03 2016-05-19 + Add our own fake 'experimental::signatures' warning category if we install our filter so that "no warnings 'experimental::signatures'" doesn't raise an error on Perl versions where we install our filter 0.02 2016-04-23 + Check does now not use the version of Perl but checks `use feature 'signatures'` + You can force the use of the module using an environment variable (not that you should) 0.01 2016-04-14 . Released on an unsuspecting world . Spun out of App::StarTraders (unreleased) Filter-signatures-0.19/README0000644000175000017500000000353714456701274015320 0ustar corioncorionFilter::signatures - very simplistic signatures for Perl < 5.20 DESCRIPTION This module implements a backwards compatibility shim for formal Perl subroutine signatures that were introduced to the Perl core with Perl 5.20. INSTALLATION This is a Perl module distribution. It should be installed with whichever tool you use to manage your installation of Perl, e.g. any of cpanm . cpan . cpanp -i . Consult https://www.cpan.org/modules/INSTALL.html for further instruction. Should you wish to install this module manually, the procedure is perl Makefile.PL make make test make install REPOSITORY The public repository of this module is L. SUPPORT The public support forum of this module is L. BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. SEE ALSO L L, which transforms your source code directly between the different notations without employing a source filter L - a module that doesn't use a source filter but optree modification instead L - uses signatures to dispatch to different subroutines based on which subroutine matches the signature L - this module implements subroutine signatures closer to Perl 6, but requires L and L L - adds two new keywords for declaring subroutines and parses their signatures. It supports more features than core Perl, closer to Perl 6, but requires a C compiler and Perl 5.14+. AUTHOR Max Maischein C LICENSE This module is released under the same terms as Perl itself. COPYRIGHT (c) Copyright 2015-2023 by Max Maischein C. Filter-signatures-0.19/MANIFEST0000644000175000017500000000104214456701274015556 0ustar corioncorion.gitignore 04-deparse.t.disabled Changes lib/Filter/signatures.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml README README.mkdn t/00-load.t t/01-compile.t t/02-compile-direct.t t/03-compilation-output.t t/05-multiline-signature.t t/06-linenumbers.t t/07-empty-block.t t/08-argument-parser.t t/09-defined-or.t testrules.yml xt/99-changes.t xt/99-compile.t xt/99-manifest.t xt/99-pod.t xt/99-synopsis.t xt/99-test-prerequisites.t xt/99-todo.t xt/99-unix-text.t xt/99-versions.t xt/copyright.t xt/meta-lint.t Filter-signatures-0.19/LICENSE0000644000175000017500000002127514456701274015444 0ustar corioncorion The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.Filter-signatures-0.19/testrules.yml0000644000175000017500000000012114456701274017177 0ustar corioncorion--- # This test suite can be run fully in parallel par: - t/*.t - xt/*.t