File Coverage

blib/lib/Data/Radius/Dictionary.pm

Criterion	Covered	Total	%
statement	46	51	90.2
branch	10	20	50.0
condition	2	5	40.0
subroutine	15	16	93.7
pod	1	10	10.0
total	74	102	72.5

package Data::Radius::Dictionary;

use v5.10;
use strict;
use warnings;

use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(attr_id attr_name const_name const_value vnd_name vnd_id));

use Data::Radius::DictionaryParser ();

sub new {
    my ($class, %h) = @_;
    return bless({ %h }, $class);
}

sub _combine_existing_dicts {
    my ($class, @dict_paths) = @_;

    my @existing_paths;
    foreach my $dict_path ( @dict_paths ) {
        if ( -r $dict_path ) {
            push @existing_paths => $dict_path;
        }
    }

    return @existing_paths ? [ map { '$INCLUDE ' . $_ } @existing_paths ] : undef;
}

sub from_multiple_files {
    my ($class, @files) = @_;

    my $arref_of_includes = $class->_combine_existing_dicts(@files);
    if ( !$arref_of_includes || !@{$arref_of_includes} ) {
        warn 'No usable RADIUS dictionaries was provided';
        return undef;
    }

    return Data::Radius::DictionaryParser->new()
                ->parse_str_array($arref_of_includes);
}

sub load_file {
    my ($class, $file) = @_;
    return Data::Radius::DictionaryParser->new()->parse_file($file);
}

sub attribute {
    my ($self, $attr_name) = @_;
    return undef if (! $attr_name);
    # hash-ref with {id, type, vendor, parent}
    return $self->attr_name()->{ $attr_name };
}

sub attribute_name {
    my ($self, $vendor_name, $id) = @_;
    return $self->attr_id()->{ $vendor_name // '' }{$id};
}

sub tlv_attribute_name {
    my ($self, $parent, $id) = @_;
    return $parent->{tlv_attr_id}{ $id };
}

sub vendor_id {
    my ($self, $vendor_name) = @_;
    return undef if (! $vendor_name);
    return $self->vnd_name()->{ $vendor_name };
}

sub vendor_name {
    my ($self, $vendor_id) = @_;
    return undef if (! $vendor_id);
    return $self->vnd_id()->{ $vendor_id };
}

# VALUE    Service-Type Login-User 1
# Convert 'Login-User' to 1
sub value {
    my ($self, $attr_name, $const_name) = @_;
    return undef if (! defined $const_name);
    return $self->const_value()->{ $attr_name } ? $self->const_value()->{ $attr_name }{ $const_name } : undef;
}

sub constant {
    my ($self, $attr_name, $const_value) = @_;
    return undef if (! defined $const_value);
    return $self->const_name()->{ $attr_name } ? $self->const_name()->{ $attr_name }{ $const_value } : undef;
}

1;

__END__