File Coverage

blib/lib/Net/OAuth2/Scheme/Option/Defines.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	6	6	100.0
condition			n/a
subroutine	16	16	100.0
pod	3	3	100.0
total	80	80	100.0

use warnings;
use strict;
package Net::OAuth2::Scheme::Option::Defines;
BEGIN {
  $Net::OAuth2::Scheme::Option::Defines::VERSION = '0.020002_099';
}
# ABSTRACT: functions for creating option groups and default values

our (@ISA, @EXPORT, @EXPORT_OK);
BEGIN {
  @EXPORT = qw(Default_Value Define_Group);
  @EXPORT_OK = qw(All_Classes);
}
use parent qw(Exporter);

my $_marker; # value does not matter

# _mark(CLASS)
# marks the class as containing stuff that we care about
sub _mark {
    my $class = shift;
    no strict 'refs';
    ${"${class}::_Has_Defaults_Or_Groups"} = \ $_marker;
}

# _is_marked(CLASS)
# does this class contain stuff that we care about
sub _is_marked {
    my $class = shift;
    no strict 'refs';
    no warnings 'uninitialized';
    return ${"${class}::_Has_Defaults_Or_Groups"} == \ $_marker;
}

# All_Classes(CLASS)
# return all classes in the ancestor tree of CLASS
# that contain stuff that we care about
sub All_Classes {
    my $class = shift;
    no strict 'refs';
    return
      ((map { All_Classes($_) } @{"${class}::ISA"}),
       (_is_marked($class) ? ($class) : ()));
}

sub Default_Value {
    my ($oname, $value) = @_;
    my $class = caller;
    _mark($class);
    no strict 'refs';
    ${"${class}::Default"}{$oname} = $value;

    # suppress warning about Default only being used once
    ${"${class}::Default"}{''} = 0;
}

sub Define_Group {
    my ($gname, $default, @keys) = @_;
    my $class = caller;
    _mark($class);

    # if no keys given, assume single-option group
    # with option name as the group name
    @keys = ($gname) unless @keys;

    no strict 'refs';
    ${"${class}::Group"}{$gname} =
      +{
        keys => \@keys,
        (defined($default)
         ? (default => ["pkg_${gname}_${default}"])
         : ()),
       };
    # suppress warning about Group only being used once
    ${"${class}::Group"}{''} = +{ keys => [] };
}

1;


__END__