File Coverage

lib/SMB/v1/Command.pm
Criterion Covered Total %
statement 12 21 57.1
branch 0 4 0.0
condition 0 5 0.0
subroutine 4 6 66.6
pod 1 2 50.0
total 17 38 44.7


line stmt bran cond sub pod time code
1             # SMB-Perl library, Copyright (C) 2014 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::v1::Command;
17              
18 1     1   2743 use strict;
  1         2  
  1         26  
19 1     1   5 use warnings;
  1         2  
  1         24  
20              
21 1     1   4 use parent 'SMB::Command';
  1         2  
  1         5  
22              
23 1     1   52 use SMB::v1::Header;
  1         2  
  1         225  
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::v1::Command::*"
31             unless $class =~ /^SMB::v1::Command::(\w+)/;
32              
33 0 0 0       die "Invalid header '$header', should be isa SMB::v1::Header"
34             unless $header && $header->isa('SMB::v1::Header');
35              
36 0           my $self = $class->SUPER::new(
37             1, $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::v1::Header::FLAGS_RESPONSE;
48             }
49              
50             1;