Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
76 changes: 76 additions & 0 deletions src/main/perl/lib/less.pm
Original file line number Diff line number Diff line change
@@ -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;
30 changes: 30 additions & 0 deletions src/test/resources/unit/less_pragma.t
Original file line number Diff line number Diff line change
@@ -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;
Loading