File Coverage

blib/lib/Data/Radius/Constants.pm
Criterion Covered Total %
statement 16 23 69.5
branch 0 8 0.0
condition n/a
subroutine 6 7 85.7
pod 1 1 100.0
total 23 39 58.9


line stmt bran cond sub pod time code
1             package Data::Radius::Constants;
2 3     3   2793 use strict;
  3         7  
  3         76  
3 3     3   12 use warnings;
  3         4  
  3         165  
4              
5             our %RFC_TYPES;
6              
7             BEGIN {
8 3     3   96 %RFC_TYPES = (
9             # RADIUS Codes
10             ACCESS_REQUEST => 1,
11             ACCESS_ACCEPT => 2,
12             ACCESS_REJECT => 3,
13             ACCOUNTING_REQUEST => 4,
14             ACCOUNTING_RESPONSE => 5,
15             ACCOUNTING_STATUS => 6,
16             ACCESS_CHALLENGE => 11,
17             # unused - not exported
18             STATUS_SERVER => 12,
19             STATUS_CLIENT => 13,
20             # rfc3576
21             DISCONNECT_REQUEST => 40,
22             DISCONNECT_ACCEPT => 41,
23             DISCONNECT_REJECT => 42,
24             COA_REQUEST => 43,
25             COA_ACCEPT => 44,
26             COA_REJECT => 45,
27             );
28             }
29 3     3   15 use constant \%RFC_TYPES;
  3         5  
  3         594  
30              
31 3     3   17 use Exporter qw(import);
  3         5  
  3         206  
32              
33             our @EXPORT_OK = (
34             keys (%RFC_TYPES),
35             qw(
36             %RFC_TYPES
37             %RADIUS_PACKET_TYPES
38             accepting_packet_type
39             )
40             );
41             our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
42              
43 3     3   1255 use Const::Fast;
  3         6110  
  3         15  
44              
45             # include all canonical type names and some aliases
46             const our %RADIUS_PACKET_TYPES => (
47             %RFC_TYPES,
48             # and aliases
49             'COA' => COA_REQUEST,
50             'DM' => DISCONNECT_REQUEST,
51             'POD' => DISCONNECT_REQUEST,
52             'ACCT' => ACCOUNTING_REQUEST,
53             'AUTH' => ACCESS_REQUEST,
54             );
55              
56             const my %accepting_types => (
57             &ACCESS_REQUEST => {
58             &ACCESS_ACCEPT => 1,
59             &ACCESS_REJECT => 0,
60             &ACCESS_CHALLENGE => undef, # this requires explicit handling
61             },
62             &ACCOUNTING_REQUEST => {
63             &ACCOUNTING_RESPONSE => 1,
64             },
65             &ACCOUNTING_STATUS => {
66             &ACCOUNTING_RESPONSE => 1,
67             },
68             &DISCONNECT_REQUEST => {
69             &DISCONNECT_ACCEPT => 1,
70             &DISCONNECT_REJECT => 0,
71             },
72             &COA_REQUEST => {
73             &COA_ACCEPT => 1,
74             &COA_REJECT => 0,
75             },
76             );
77              
78             sub accepting_packet_type {
79 0     0 1   my ($req_type, $response_type) = @_;
80             $req_type = $RADIUS_PACKET_TYPES{$req_type}
81 0 0         if exists $RADIUS_PACKET_TYPES{$req_type};
82 0 0         return undef unless exists $accepting_types{$req_type};
83 0           my $atr = $accepting_types{$req_type};
84             $response_type = $RADIUS_PACKET_TYPES{$response_type}
85 0 0         if exists $RADIUS_PACKET_TYPES{$response_type};
86 0 0         return undef unless exists $atr->{$response_type};
87 0           return $atr->{$response_type};
88             }
89              
90             1;
91              
92             __END__