File Coverage

blib/lib/BACnet/PDUTypes/Abort.pm
Criterion Covered Total %
statement 38 42 90.4
branch 2 4 50.0
condition n/a
subroutine 9 9 100.0
pod 0 4 0.0
total 49 59 83.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package BACnet::PDUTypes::Abort;
4              
5 27     27   171 use warnings;
  27         49  
  27         1522  
6 27     27   181 use strict;
  27         49  
  27         677  
7              
8 27     27   115 use bytes;
  27         45  
  27         145  
9              
10 27     27   768 use BACnet::APDU;
  27         48  
  27         1101  
11              
12             require BACnet::PDUTypes::Utils;
13              
14 27     27   130 use parent 'BACnet::PDUTypes::PDU';
  27         51  
  27         192  
15              
16             sub construct {
17 3     3 0 259750 my ( $class, @rest ) = @_;
18              
19 3         10 my %args = (
20             invoke_id => undef,
21             service_choice => undef,
22             flags => 0x00,
23             @rest,
24             );
25              
26             my $self = {
27             data => '',
28             invoke_id => $args{invoke_id},
29             service_choice => $args{service_choice},
30             flags => $args{flags},
31 3         9 };
32              
33             $self->{data} .= pack( 'C',
34 3         17 ( $BACnet::APDU::apdu_types->{'Abort'} << 4 ) | $self->{flags} );
35              
36 3         4 $self->{data} .= pack( 'C', $args{invoke_id} );
37              
38             $self->{data} .= pack(
39             'C',
40             $BACnet::PDUTypes::Utils::abort_reason->{
41             $self->{service_choice}
42             }
43 3         10 );
44              
45 3         8 return bless $self, $class;
46              
47             }
48              
49             sub parse {
50              
51 3     3 0 6 my ( $class, $data_in ) = @_;
52              
53 3         6 my $self = bless { data => $data_in, }, $class;
54              
55 3 50       8 if ( length($data_in) < 3 ) {
56 0         0 $self->{error} = "Abort: too short";
57 0         0 return $self;
58             }
59              
60 3         4 my $offset = 0;
61              
62 3         10 $self->{flags} = unpack( 'C', substr( $data_in, $offset, 1 ) ) & 0x0f;
63              
64 3         5 $offset += 1;
65              
66 3         4 $self->{invoke_id} = unpack( 'C', substr( $data_in, $offset, 1 ) );
67 3         3 $offset += 1;
68              
69             my $service_choice = $BACnet::PDUTypes::Utils::abort_reason_rev->{
70 3         9 unpack( 'C', substr( $data_in, $offset, 1 ) ) };
71              
72 3 50       8 if ( !defined $service_choice ) {
73 0         0 $self->{error} = "Abort: unknown service choice";
74 0         0 return $self;
75             }
76              
77 3         4 $self->{service_choice} = $service_choice;
78              
79 3         6 return $self;
80             }
81              
82             sub service_choice {
83 6     6 0 3284 my ($self) = @_;
84              
85 6         15 return $self->{service_choice};
86             }
87              
88             sub invoke_id {
89 6     6 0 8 my ($self) = @_;
90              
91 6         51 return $self->{invoke_id};
92             }
93              
94             1;