File Coverage

lib/SMB/v2/Command.pm
Criterion Covered Total %
statement 12 22 54.5
branch 0 6 0.0
condition 0 5 0.0
subroutine 4 6 66.6
pod 1 2 50.0
total 17 41 41.4


line stmt bran cond sub pod time code
1             # SMB-Perl library, Copyright (C) 2014-2018 Mikhael Goikhman, migo@cpan.org
2             #
3             # This program is free software: you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation, either version 3 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program. If not, see .
15              
16             package SMB::v2::Command;
17              
18 1     1   310 use strict;
  1         1  
  1         19  
19 1     1   3 use warnings;
  1         1  
  1         18  
20              
21 1     1   3 use parent 'SMB::Command';
  1         2  
  1         3  
22              
23 1     1   40 use SMB::v2::Header;
  1         1  
  1         156  
24              
25             sub new ($$%) {
26 0     0 1   my $class = shift;
27 0   0       my $header = shift || '';
28 0           my %options = @_;
29              
30 0 0         die "Invalid sub-class $class, should be SMB::v2::Command::*"
31             unless $class =~ /^SMB::v2::Command::(\w+)/;
32              
33 0 0 0       die "Invalid header '$header', should be isa SMB::v2::Header"
34             unless $header && $header->isa('SMB::v2::Header');
35              
36 0           my $self = $class->SUPER::new(
37             2, $1, $header,
38             %options,
39             );
40              
41 0           return $self;
42             }
43              
44             sub prepare_response ($) {
45 0     0 0   my $self = shift;
46              
47 0           $self->header->{flags} |= SMB::v2::Header::FLAGS_RESPONSE;
48 0 0         $self->header->credits(31) if $self->header->credits > 31;
49             }
50              
51             1;