diff --git a/src/main/perl/lib/less.pm b/src/main/perl/lib/less.pm new file mode 100644 index 000000000..40bce91f1 --- /dev/null +++ b/src/main/perl/lib/less.pm @@ -0,0 +1,76 @@ +package less; + +use strict; +use warnings; + +our $VERSION = '0.03'; + +sub _pack_tags { + return join ' ', @_; +} + +sub _unpack_tags { + return grep { defined and length } + map { split ' ' } + grep { defined } @_; +} + +sub stash_name { + return $_[0]; +} + +sub of { + my $class = shift; + + return unless defined wantarray; + + my $hinthash = (caller 0)[10] || {}; + my %tags; + @tags{ _unpack_tags($hinthash->{ $class->stash_name }) } = (); + + if (@_) { + exists $tags{$_} and return 1 for @_; + return; + } + + return keys %tags; +} + +sub import { + my $class = shift; + my $stash = $class->stash_name; + + @_ = 'please' if !@_; + + my %tags; + @tags{ _unpack_tags(@_, $^H{$stash}) } = (); + $^H{$stash} = _pack_tags(keys %tags); + + return; +} + +sub unimport { + my $class = shift; + my $stash = $class->stash_name; + + if (@_) { + my %tags; + @tags{ _unpack_tags($^H{$stash}) } = (); + delete @tags{ _unpack_tags(@_) }; + + my $new = _pack_tags(keys %tags); + if (length $new) { + $^H{$stash} = $new; + } + else { + delete $^H{$stash}; + } + } + else { + delete $^H{$stash}; + } + + return; +} + +1; diff --git a/src/test/resources/unit/less_pragma.t b/src/test/resources/unit/less_pragma.t new file mode 100644 index 000000000..b8d9a8fc1 --- /dev/null +++ b/src/test/resources/unit/less_pragma.t @@ -0,0 +1,30 @@ +use strict; +use warnings; +use Test::More; + +ok(!less->of, 'less has no active tags by default'); + +{ + use less; + ok(less->of('please'), 'use less defaults to please'); + is_deeply([sort less->of], ['please'], 'less->of lists active default tag'); +} + +ok(!less->of('please'), 'less hint is lexical'); + +{ + use less qw(memory CPU); + ok(less->of('memory'), 'less sees memory tag'); + ok(less->of('CPU'), 'less sees CPU tag'); + ok(less->of('CPU', 'disk'), 'less checks any requested tag'); + + { + no less 'CPU'; + ok(less->of('memory'), 'no less removes only named tag'); + ok(!less->of('CPU'), 'CPU tag removed'); + } + + ok(less->of('CPU'), 'outer less tags are restored'); +} + +done_testing;