File Coverage

blib/lib/BACnet/PDUTypes/Error.pm
Criterion Covered Total %
statement 56 64 87.5
branch 5 10 50.0
condition n/a
subroutine 14 14 100.0
pod 0 6 0.0
total 75 94 79.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package BACnet::PDUTypes::Error;
4              
5 27     27   170 use warnings;
  27         61  
  27         1549  
6 27     27   147 use strict;
  27         52  
  27         650  
7              
8 27     27   208 use bytes;
  27         64  
  27         299  
9              
10 27     27   637 use BACnet::APDU;
  27         69  
  27         957  
11 27     27   186 use BACnet::DataTypes::SequenceValue;
  27         73  
  27         1088  
12              
13             require BACnet::PDUTypes::Utils;
14              
15 27     27   143 use BACnet::ServiceRequestSequences::ReadProperty;
  27         47  
  27         742  
16 27     27   13331 use BACnet::ServiceRequestSequences::SubscribeCOV;
  27         79  
  27         1188  
17              
18 27     27   152 use parent 'BACnet::PDUTypes::PDU';
  27         50  
  27         136  
19              
20             our $service_choice_service_request_skeleton = {
21             5 =>
22             $BACnet::ServiceRequestSequences::SubscribeCOV::negative_response_skeleton,
23             12 =>
24             $BACnet::ServiceRequestSequences::ReadProperty::negative_response_skeleton,
25             };
26              
27             sub construct {
28 3     3 0 13883 my ( $class, @rest ) = @_;
29              
30 3         58 my %args = (
31             invoke_id => undef,
32             service_choice => undef,
33             service_request => undef,
34             @rest,
35             );
36              
37             my $self = {
38             data => '',
39             invoke_id => $args{invoke_id},
40             service_choice => $args{service_choice},
41             service_request => $args{service_request},
42 3         18 };
43              
44             $self->{data} .=
45 3         26 pack( 'C', ( $BACnet::APDU::apdu_types->{'Error'} << 4 ) );
46              
47 3         11 $self->{data} .= pack( 'C', $args{invoke_id} );
48              
49             $self->{data} .= pack(
50             'C',
51             $BACnet::PDUTypes::Utils::confirmed_service->{
52             $self->{service_choice}
53             }
54 3         14 );
55              
56 3         22 $self->{data} .= $self->{service_request}->data();
57              
58 3         17 return bless $self, $class;
59              
60             #flags are 0000
61              
62             }
63              
64             sub parse {
65              
66 3     3 0 9 my ( $class, $data_in, $skeleton ) = @_;
67              
68 3         10 my $self = bless { data => $data_in, }, $class;
69              
70 3 50       14 if ( length($data_in) < 3 ) {
71 0         0 $self->{error} = "Error: too short";
72 0         0 return $self;
73             }
74              
75 3         5 my $offset = 0;
76 3         8 $offset += 1;
77              
78 3         13 $self->{invoke_id} = unpack( 'C', substr( $data_in, $offset, 1 ) );
79 3         7 $offset += 1;
80              
81             my $service_choice = $BACnet::PDUTypes::Utils::confirmed_service_rev->{
82 3         13 unpack( 'C', substr( $data_in, $offset, 1 ) ) };
83              
84 3 50       11 if ( !defined $service_choice ) {
85 0         0 $self->{error} = "Error: unknown service choice";
86 0         0 return $self;
87             }
88              
89 3         8 $self->{service_choice} = $service_choice;
90 3         7 $offset += 1;
91              
92 3 50       6 if ( !defined $skeleton ) {
93             $skeleton =
94 0         0 $service_choice_service_request_skeleton->{ $self->{service_choice} };
95             }
96              
97 3 50       10 if ( !defined $skeleton ) {
98 0         0 $self->{error} = "Error: unknown service choice";
99 0         0 return $self;
100             }
101              
102             $self->{service_request} =
103 3         25 BACnet::DataTypes::SequenceValue->parse( substr( $data_in, $offset ),
104             $skeleton );
105              
106 3 50       15 if ( defined $self->{service_request}->{error} ) {
107 0         0 $self->{error} = "Error: error in service request";
108             }
109 3         14 return $self;
110             }
111              
112             sub service_choice {
113 6     6 0 7507 my ($self) = @_;
114              
115 6         26 return $self->{service_choice};
116             }
117              
118             sub service_request {
119 6     6 0 12 my ($self) = @_;
120              
121 6         17 return $self->{service_request};
122             }
123              
124             sub invoke_id {
125 6     6 0 11 my ($self) = @_;
126              
127 6         17 return $self->{invoke_id};
128             }
129              
130             sub flags {
131 6     6 0 77 my ($self) = @_;
132              
133 6         20 return 0;
134             }
135              
136             1;