File Coverage

blib/lib/bitflag.pm

Criterion	Covered	Total	%
statement	39	40	97.5
branch	17	20	85.0
condition			n/a
subroutine	6	7	85.7
pod			n/a
total	62	67	92.5

package bitflag;

use 5.008007;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT_OK = qw ( getmask );
our @EXPORT = qw( );
our $VERSION = 0.01;

no strict 'refs';

    my ($caller,%FLAGMAP);
    my ($igcase,$mask) = (0,1);

sub import
{
    my $class = shift;
    return unless @_;
    $caller = caller; # i.e. = caller[0]

#    print "bitflag::import from caller $caller\n";

    my ($head) = @_;

    # begin optiomally assign $igcase,$mask using an options hash as first argument
    if ( ref($head) eq 'HASH' )
    {
        $igcase = $head->{ic} if exists $head->{ic};
        $head->{sm} = delete $head->{startmask}  if exists $head->{startmask};
        $mask = $head->{sm} if exists $head->{sm};
        shift;
    }
    else
    #   or only $mask simply with a numeric first argument
    {
        if ($head =~ qr{\A\d+\Z})
        {
            $mask = shift  ;
        }
    }
    # end   optiomally assign ...

    foreach my $flagname (@_)
    {
        *{$caller.'::'.$flagname} = sub () {$mask};
        my $flagalias = $igcase ? lc($flagname) : $flagname;
        $FLAGMAP{$flagalias} = $mask;
        $mask <<= 1
    }

#    $class->export_to_level(2,$class,'getmask');
    *{$caller.'::getmask'} =
    sub
    {
        my $r = 0;
        foreach my $v (@_)
        {
            my $vkey = $igcase ? lc($v) : $v;
            if ( exists $FLAGMAP{$vkey} )
            {
                $r |= $FLAGMAP{$vkey};
            }
            else
            {
                warn "unknown flagname: $v\n";
            }
        }
        $r
    }
    unless defined *{$caller.'::getmask'};
}


1;
__END__