Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Initial working release.

  • Loading branch information...
commit 9f395856a3ce1055e5d59be3375f58a70d57f5b6 0 parents
@yak1ex authored
4 .gitignore
@@ -0,0 +1,4 @@
+filtered-v*.tar.gz
+filtered-v*/
+.build/
+*.BAK
4 Changes
@@ -0,0 +1,4 @@
+Revision history for {{$dist->name}}
+
+{{$NEXT}}
+ * Initial release.
20 MANIFEST.SKIP
@@ -0,0 +1,20 @@
+# Version control files and dirs.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+\B\.git\b
+
+# Makemaker generated files and dirs.
+^MANIFEST\.
+^Makefile$
+^blib/
+^MakeMaker-\d
+
+# Temp, old and emacs backup files.
+~$
+\.old$
+\.BAK$
+^#.*#$
+^\.#
+\B\.build\b
76 README.md
@@ -0,0 +1,76 @@
+# NAME
+
+filtered - Apply source filter on external module
+
+# SYNOPSIS
+
+ # Apply source filter YourFilter.pm on Target.pm, then result can be used as FilteredTarget
+ use filtered by => 'YourFilter', as => 'FilteredTarget', on => 'Target', qw(func);
+ my $obj = FilteredTarget->new;
+
+ # You can omit `as' option and `on' key
+ use filtered by => 'YourFilter', 'Target', qw(func);
+ my $obj = Target->new; # Target is filtered
+
+ # You can use differnt module with the same filter
+ use filtered by => 'YourFilter', as => 'FilteredTarget1', on => 'Target1', qw(func);
+ use filtered by => 'YourFilter', as => 'FilteredTarget2', on => 'Target2', qw(func);
+
+ # or, you can also use differnt filters on the same module
+ use filtered by => 'YourFilter1', as => 'FilteredTarget1', on => 'Target', qw(func);
+ use filtered by => 'YourFilter2', as => 'FilteredTarget2', on => 'Target', qw(func);
+
+# DESCRIPTION
+
+Source filter has unlimited power to enhance Perl.
+However, source filter is usually applied on your own sources.
+This module enables you to apply source filter on external module.
+
+# OPTIONS
+
+Rest of the options are passed to `import` of filtered module.
+
+- `by`
+
+Specify source filter module you want to apply on an external module.
+
+- `as`
+
+Specify package name for filtered module.
+This option can be omitted. If omitted, original names are used.
+
+- `on`
+
+`on` keyword can be ommited.
+
+# CAVEATS
+
+- Replacement by `as` is applied in limited context.
+
+If you specified `as =` FilteredTarget, on => Target>, the following codes:
+
+ package Target::work;
+ package Target;
+ Target::work::call();
+
+are transformed into as follows:
+
+ package FilteredTarget::work;
+ package FilteredTarget;
+ FilteredTarget::work::call();
+
+Actually, only `'\bpackage\s+Target\b'` and `'\bTarget::\b'` are replaced.
+
+# SEE ALSO
+
+- [http://github.com/yak1ex/filtered](http://github.com/yak1ex/filtered) - Github repository
+- [Filter::Simple](http://search.cpan.org/perldoc?Filter::Simple) - Helper module to implement source filter
+
+# AUTHOR
+
+Yasutaka ATARASHI <yakex@cpan.org>
+
+# LICENSE
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
25 dist.ini
@@ -0,0 +1,25 @@
+name = filtered
+author = Yasutaka ATARASHI <yakex@cpan.org>
+license = Perl_5
+copyright_holder = Yasutaka ATARASHI
+copyright_year = 2012
+
+[@Git]
+tag_format = %v
+tag_message = Released as %v
+
+[@Basic]
+
+[ReadmeAnyFromPod]
+type = markdown
+filename = README.md
+location = root
+
+[NextRelease]
+filename = Changes
+
+[OurPkgVersion]
+[CheckVersionIncrement]
+[PodSyntaxTests]
+[PodCoverageTests]
+[Test::Perl::Critic]
237 lib/filtered.pm
@@ -0,0 +1,237 @@
+use strict;
+use warnings;
+
+package filtered::hook; ## no critic (RequireFilenameMatchesPackage)
+
+# VERSION
+
+sub new
+{
+ my ($self, %arg) = @_;
+ my $class = ref($self) || $self;
+ return bless {
+ _FILTER => $arg{FILTER},
+ }, $class;
+}
+
+# NOTE: To store data in object is probably not good idea because this prohibits re-entrance.
+sub init
+{
+ my ($self, $target, $as) = @_;
+
+ $self->{_TARGET} = $target;
+ $self->{_AS} = $as;
+ return $self;
+}
+
+sub filtered::hook::INC
+{
+ my ($self, $filename) = @_;
+ $self->{_FILENAME} = $filename;
+ shift @INC; # TODO: Gain robustness # NOTE: Just one time application
+
+#print "SELF: $self / FILTER: $self->{_FILTER} / AS: $self->{_AS} / FILENAME: $filename\n";
+
+# NOTE: The following part is based on perldoc -f require
+ if (exists $INC{$self}{$filename}) {
+ # return 1 in original require
+ return (sub {
+ if($_[1]) {
+ delete $INC{$filename};
+ $_ = "1;\n";
+ $_[1] = 0;
+ return 1;
+ } else {
+ return 0;
+ }
+ }, 1) if $INC{$self}{$filename};
+ die "Compilation failed in require";
+ }
+ my ($realfilename,$result);
+ ITER: {
+ foreach my $prefix (@INC) {
+ $realfilename = "$prefix/$filename";
+ if (-f $realfilename) {
+ $INC{$self}{$filename} = $realfilename;
+ last ITER;
+ }
+ }
+ die "Can't find $filename in \@INC";
+ }
+
+ open my $fh, '<', $realfilename;
+ my $qr1 = qr/\b(package\s+)$self->{_TARGET}\b/;
+ my $qr2 = qr/\b$self->{_TARGET}::\b/;
+ return (sub {
+ my ($sub, $state) = @_;
+ if($state == 1) { # Inject filter at the beginning
+ delete $INC{$filename};
+ $_ = 'use '.$self->{_FILTER}.";\n";
+ $_[1] = 0;
+ } elsif(eof($fh)) {
+ close $fh;
+ return 0;
+ } elsif(defined $self->{_AS}) {
+ $_ = <$fh>;
+ s {$qr1} {${1}$self->{_AS}};
+ s {$qr2} {$self->{_AS}::};
+ } else {
+ $_ = <$fh>;
+ }
+ return 1;
+ }, 1);
+}
+
+package filtered;
+
+# VERSION
+
+use Carp;
+
+my %hook;
+
+sub import
+{
+ my ($class, @args) = @_;
+ my ($filter, $target, $as);
+ while(1) {
+ if($args[0] eq 'by') {
+ shift @args;
+ $filter = shift @args;
+ } elsif($args[0] eq 'as') {
+ shift @args;
+ $as = shift @args;
+ } elsif($args[0] eq 'on') {
+ shift @args;
+ $target = shift @args;
+ last;
+ } else {
+ $target = shift @args;
+ last;
+ }
+ }
+
+ croak '`by\' must be specified' if ! defined($filter);
+ croak '`on\' or target name must be specified' if ! defined($target);
+ $hook{$filter} = filtered::hook->new(FILTER => $filter) if ! exists $hook{$filter};
+ unshift @INC, $hook{$filter}->init($target, $as);
+ if(!defined eval "require $target") {
+ delete $INC{$hook{$filter}{_FILENAME}}; # For error in internal require
+ croak "Can't load $target by $@";
+ }
+ if(defined $as) {
+ @_ = ($as, @args);
+ } else {
+ @_ = ($target, @args);
+ }
+ {
+ no strict 'refs'; ## no critic (ProhibitNoStrict)
+ no warnings 'once';
+ my $import = *{$_[0].'::import'}{CODE};
+ if(defined $import) {
+ goto &$import;
+ } elsif ($_[0]->isa('Exporter')) {
+ $_[0]->export_to_level(1, @_);
+ }
+ }
+}
+
+1;
+__END__
+=pod
+
+=head1 NAME
+
+filtered - Apply source filter on external module
+
+=head1 SYNOPSIS
+
+ # Apply source filter YourFilter.pm on Target.pm, then result can be used as FilteredTarget
+ use filtered by => 'YourFilter', as => 'FilteredTarget', on => 'Target', qw(func);
+ my $obj = FilteredTarget->new;
+
+ # You can omit `as' option and `on' key
+ use filtered by => 'YourFilter', 'Target', qw(func);
+ my $obj = Target->new; # Target is filtered
+
+ # You can use differnt module with the same filter
+ use filtered by => 'YourFilter', as => 'FilteredTarget1', on => 'Target1', qw(func);
+ use filtered by => 'YourFilter', as => 'FilteredTarget2', on => 'Target2', qw(func);
+
+ # or, you can also use differnt filters on the same module
+ use filtered by => 'YourFilter1', as => 'FilteredTarget1', on => 'Target', qw(func);
+ use filtered by => 'YourFilter2', as => 'FilteredTarget2', on => 'Target', qw(func);
+
+=head1 DESCRIPTION
+
+Source filter has unlimited power to enhance Perl.
+However, source filter is usually applied on your own sources.
+This module enables you to apply source filter on external module.
+
+=head1 OPTIONS
+
+Rest of the options are passed to C<import> of filtered module.
+
+=over 4
+
+=item C<by>
+
+Specify source filter module you want to apply on an external module.
+
+=item C<as>
+
+Specify package name for filtered module.
+This option can be omitted. If omitted, original names are used.
+
+=item C<on>
+
+C<on> keyword can be ommited.
+
+=back
+
+=head1 CAVEATS
+
+=over 4
+
+=item Replacement by C<as> is applied in limited context.
+
+If you specified C<as => FilteredTarget, on => Target>, the following codes:
+
+ package Target::work;
+ package Target;
+ Target::work::call();
+
+are transformed into as follows:
+
+ package FilteredTarget::work;
+ package FilteredTarget;
+ FilteredTarget::work::call();
+
+Actually, only C<'\bpackage\s+Target\b'> and C<'\bTarget::\b'> are replaced.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<http://github.com/yak1ex/filtered> - Github repository
+
+=item *
+
+L<Filter::Simple> - Helper module to implement source filter
+
+=back
+
+=head1 AUTHOR
+
+Yasutaka ATARASHI <yakex@cpan.org>
+
+=head1 LICENSE
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
2  perlcritic.rc
@@ -0,0 +1,2 @@
+[BuiltinFunctions::ProhibitStringyEval]
+allow_includes = true
14 t/FilterTest.pm
@@ -0,0 +1,14 @@
+package FilterTest;
+
+use strict;
+
+require Exporter;
+our (@ISA) = qw(Exporter);
+our (@EXPORT_OK) = qw(call);
+
+sub call
+{
+ return 'FOOFOOFOO';
+}
+
+1;
21 t/FilterTest2.pm
@@ -0,0 +1,21 @@
+package FilterTest2::internal;
+
+sub call
+{
+ return 'FOOFOOFOOFOO';
+}
+
+package FilterTest2;
+
+use strict;
+
+require Exporter;
+our (@ISA) = qw(Exporter);
+our (@EXPORT_OK) = qw(call);
+
+sub call
+{
+ return FilterTest2::internal::call();
+}
+
+1;
14 t/FilterTest3.pm
@@ -0,0 +1,14 @@
+package FilterTest3;
+
+use strict;
+
+require Exporter;
+our (@ISA) = qw(Exporter);
+our (@EXPORT_OK) = qw(call);
+
+sub call
+{
+ return 'FOOFOOZOTZOT';
+}
+
+1;
9 t/MyFilter.pm
@@ -0,0 +1,9 @@
+package MyFilter;
+
+use Filter::Simple;
+
+FILTER sub {
+ s/FOO/BAR/g;
+};
+
+1;
9 t/MyFilter2.pm
@@ -0,0 +1,9 @@
+package MyFilter2;
+
+use Filter::Simple;
+
+FILTER sub {
+ s/FOOFOO/BAR/g;
+};
+
+1;
9 t/MyFilter3.pm
@@ -0,0 +1,9 @@
+package MyFilter3;
+
+use Filter::Simple;
+
+FILTER sub {
+ s/FOO/ZOT/g;
+};
+
+1;
37 t/import.t
@@ -0,0 +1,37 @@
+use Test::More tests => 10;
+
+use FindBin;
+use lib "$FindBin::Bin";
+
+package a;
+
+BEGIN { ::use_ok('filtered', by => 'MyFilter', as => 'FilteredTest', on => 'FilterTest', 'call'); }
+
+# Duplicated use should have no effect
+BEGIN { ::use_ok('filtered', by => 'MyFilter', as => 'FilteredTest', on => 'FilterTest', 'call'); }
+
+# Duplicated use should have no effect
+BEGIN { ::use_ok('filtered', by => 'MyFilter', as => 'FilteredTest', 'FilterTest', 'call'); }
+
+::is(call(), 'BARBARBAR');
+
+package b;
+
+# Different filter should be available
+BEGIN { ::use_ok('filtered', by => 'MyFilter2', as => 'FilteredTest2', on => 'FilterTest', 'call'); }
+
+::is(call(), 'BARFOO');
+
+package c;
+
+# Different target should be available
+BEGIN { ::use_ok('filtered', by => 'MyFilter2', as => 'FilteredTest3', on => 'FilterTest2', 'call'); }
+
+::is(FilteredTest3::call(), 'BARBAR');
+
+package d;
+
+# Different target should be available
+BEGIN { ::use_ok('filtered', by => 'MyFilter2', 'FilterTest3', 'call'); }
+
+::is(FilterTest3::call(), 'BARZOTZOT');
31 t/simple.t
@@ -0,0 +1,31 @@
+use Test::More tests => 12;
+use Test::Exception;
+
+use FindBin;
+use lib "$FindBin::Bin";
+
+BEGIN { use_ok('filtered', by => 'MyFilter', as => 'FilteredTest', on => 'FilterTest'); }
+
+# Duplicated use should have no effect
+BEGIN { use_ok('filtered', by => 'MyFilter', as => 'FilteredTest', on => 'FilterTest'); }
+
+# Duplicated use should have no effect
+BEGIN { use_ok('filtered', by => 'MyFilter', as => 'FilteredTest', 'FilterTest'); }
+
+BEGIN { throws_ok { die $@ if ! defined eval "use filtered by => 'MyFilter', 'NotExistentFilterTest'"; } qr/Can't find .* in \@INC/, 'Not-existent module' }
+
+BEGIN { throws_ok { die $@ if ! defined eval "use filtered by => 'NotExistentMyFilter', 'FilterTest'"; } qr/Can't load /, 'Not-existent filter' }
+
+# Different filter should be available
+BEGIN { use_ok('filtered', by => 'MyFilter2', as => 'FilteredTest2', on => 'FilterTest'); }
+
+# Different target should be available
+BEGIN { use_ok('filtered', by => 'MyFilter2', as => 'FilteredTest3', on => 'FilterTest2'); }
+
+# Different target should be available
+BEGIN { use_ok('filtered', by => 'MyFilter2', 'FilterTest3'); }
+
+is(FilteredTest::call(), 'BARBARBAR');
+is(FilteredTest2::call(), 'BARFOO');
+is(FilteredTest3::call(), 'BARBAR');
+is(FilterTest3::call(), 'BARZOTZOT');
Please sign in to comment.
Something went wrong with that request. Please try again.