File Coverage

blib/lib/Net/SFTP/Foreign/Attributes.pm
Criterion Covered Total %
statement 17 129 13.1
branch 0 58 0.0
condition 0 15 0.0
subroutine 6 25 24.0
pod 17 20 85.0
total 40 247 16.1


line stmt bran cond sub pod time code
1             package Net::SFTP::Foreign::Attributes;
2              
3             our $VERSION = '1.68_05';
4              
5 3     3   19 use strict;
  3         5  
  3         80  
6 3     3   13 use warnings;
  3         6  
  3         59  
7 3     3   13 use Carp;
  3         4  
  3         184  
8              
9 3     3   17 use Net::SFTP::Foreign::Constants qw( :att );
  3         4  
  3         265  
10 3     3   1332 use Net::SFTP::Foreign::Buffer;
  3         8  
  3         3645  
11              
12             sub new {
13 3     3 1 6 my $class = shift;
14 3         3478 return bless { flags => 0}, $class;
15             }
16              
17             sub new_from_stat {
18 0 0   0 0   if (@_ > 1) {
19 0           my ($class, undef, undef, $mode, undef,
20             $uid, $gid, undef, $size, $atime, $mtime) = @_;
21 0           my $self = $class->new;
22              
23 0           $self->set_perm($mode);
24 0           $self->set_ugid($uid, $gid);
25 0           $self->set_size($size);
26 0           $self->set_amtime($atime, $mtime);
27 0           return $self;
28             }
29 0           return undef;
30             }
31              
32             sub new_from_buffer {
33 0     0 1   my ($class, $buf) = @_;
34 0           my $self = $class->new;
35 0           my $flags = $self->{flags} = $buf->get_int32_untaint;
36              
37 0 0         if ($flags & SSH2_FILEXFER_ATTR_SIZE) {
38 0           $self->{size} = $buf->get_int64_untaint;
39             }
40              
41 0 0         if ($flags & SSH2_FILEXFER_ATTR_UIDGID) {
42 0           $self->{uid} = $buf->get_int32_untaint;
43 0           $self->{gid} = $buf->get_int32_untaint;
44             }
45              
46 0 0         if ($flags & SSH2_FILEXFER_ATTR_PERMISSIONS) {
47 0           $self->{perm} = $buf->get_int32_untaint;
48             }
49              
50 0 0         if ($flags & SSH2_FILEXFER_ATTR_ACMODTIME) {
51 0           $self->{atime} = $buf->get_int32_untaint;
52 0           $self->{mtime} = $buf->get_int32_untaint;
53             }
54              
55 0 0         if ($flags & SSH2_FILEXFER_ATTR_EXTENDED) {
56 0           my $n = $buf->get_int32;
57 0 0 0       $n >= 0 and $n <= 10000 or return undef;
58 0           my @pairs = map $buf->get_str, 1..2*$n;
59 0           $self->{extended} = \@pairs;
60             }
61              
62 0           $self;
63             }
64              
65             sub skip_from_buffer {
66 0     0 0   my ($class, $buf) = @_;
67 0           my $flags = $buf->get_int32;
68 0 0         if ($flags == ( SSH2_FILEXFER_ATTR_SIZE |
69             SSH2_FILEXFER_ATTR_UIDGID |
70             SSH2_FILEXFER_ATTR_PERMISSIONS |
71             SSH2_FILEXFER_ATTR_ACMODTIME )) {
72 0           $buf->skip_bytes(28);
73             }
74             else {
75 0           my $len = 0;
76 0 0         $len += 8 if $flags & SSH2_FILEXFER_ATTR_SIZE;
77 0 0         $len += 8 if $flags & SSH2_FILEXFER_ATTR_UIDGID;
78 0 0         $len += 4 if $flags & SSH2_FILEXFER_ATTR_PERMISSIONS;
79 0 0         $len += 8 if $flags & SSH2_FILEXFER_ATTR_ACMODTIME;
80 0           $buf->skip_bytes($len);
81 0 0         if ($flags & SSH2_FILEXFER_ATTR_EXTENDED) {
82 0           my $n = $buf->get_int32;
83 0           $buf->skip_str, $buf->skip_str for (1..$n);
84             }
85             }
86             }
87              
88             sub as_buffer {
89 0     0 1   my $a = shift;
90 0           my $buf = Net::SFTP::Foreign::Buffer->new(int32 => $a->{flags});
91              
92 0 0         if ($a->{flags} & SSH2_FILEXFER_ATTR_SIZE) {
93 0           $buf->put_int64(int $a->{size});
94             }
95 0 0         if ($a->{flags} & SSH2_FILEXFER_ATTR_UIDGID) {
96 0           $buf->put(int32 => $a->{uid}, int32 => $a->{gid});
97             }
98 0 0         if ($a->{flags} & SSH2_FILEXFER_ATTR_PERMISSIONS) {
99 0           $buf->put_int32($a->{perm});
100             }
101 0 0         if ($a->{flags} & SSH2_FILEXFER_ATTR_ACMODTIME) {
102 0           $buf->put(int32 => $a->{atime}, int32 => $a->{mtime});
103             }
104 0 0         if ($a->{flags} & SSH2_FILEXFER_ATTR_EXTENDED) {
105 0           my $pairs = $a->{extended};
106 0           $buf->put_int32(int(@$pairs / 2));
107 0           $buf->put_str($_) for @$pairs;
108             }
109              
110 0           $buf;
111             }
112              
113 0     0 1   sub flags { shift->{flags} }
114              
115 0     0 1   sub size { shift->{size} }
116              
117             sub set_size {
118 0     0 1   my ($self, $size) = @_;
119 0 0         if (defined $size) {
120 0           $self->{flags} |= SSH2_FILEXFER_ATTR_SIZE;
121 0           $self->{size} = $size;
122             }
123             else {
124 0           $self->{flags} &= ~SSH2_FILEXFER_ATTR_SIZE;
125             delete $self->{size}
126 0           }
127             }
128              
129 0     0 1   sub uid { shift->{uid} }
130              
131 0     0 1   sub gid { shift->{gid} }
132              
133             sub set_ugid {
134 0     0 1   my ($self, $uid, $gid) = @_;
135 0 0 0       if (defined $uid and defined $gid) {
    0 0        
136 0           $self->{flags} |= SSH2_FILEXFER_ATTR_UIDGID;
137 0           $self->{uid} = $uid;
138 0           $self->{gid} = $gid;
139             }
140             elsif (!defined $uid and !defined $gid) {
141 0           $self->{flags} &= ~SSH2_FILEXFER_ATTR_UIDGID;
142 0           delete $self->{uid};
143 0           delete $self->{gid};
144             }
145             else {
146 0           croak "wrong arguments for set_ugid"
147             }
148             }
149              
150 0     0 1   sub perm { shift->{perm} }
151              
152             sub set_perm {
153 0     0 1   my ($self, $perm) = @_;
154 0 0         if (defined $perm) {
155 0           $self->{flags} |= SSH2_FILEXFER_ATTR_PERMISSIONS;
156 0           $self->{perm} = $perm;
157             }
158             else {
159 0           $self->{flags} &= ~SSH2_FILEXFER_ATTR_PERMISSIONS;
160             delete $self->{perm}
161 0           }
162             }
163              
164 0     0 1   sub atime { shift->{atime} }
165              
166 0     0 1   sub mtime { shift->{mtime} }
167              
168             sub set_amtime {
169 0     0 1   my ($self, $atime, $mtime) = @_;
170 0 0 0       if (defined $atime and defined $mtime) {
    0 0        
171 0           $self->{flags} |= SSH2_FILEXFER_ATTR_ACMODTIME;
172 0           $self->{atime} = $atime;
173 0           $self->{mtime} = $mtime;
174             }
175             elsif (!defined $atime and !defined $mtime) {
176 0           $self->{flags} &= ~SSH2_FILEXFER_ATTR_ACMODTIME;
177 0           delete $self->{atime};
178 0           delete $self->{mtime};
179             }
180             else {
181 0           croak "wrong arguments for set_amtime"
182             }
183             }
184              
185 0 0   0 1   sub extended { @{shift->{extended} || [] } }
  0            
186              
187             sub set_extended {
188 0     0 1   my $self = shift;
189 0 0         @_ & 1 and croak "odd number of arguments passed to set_extended";
190 0 0         if (@_) {
191 0           $self->{flags} |= SSH2_FILEXFER_ATTR_EXTENDED;
192 0           $self->{extended} = [@_];
193             }
194             else {
195 0           $self->{flags} &= ~SSH2_FILEXFER_ATTR_EXTENDED;
196 0           delete $self->{extended};
197             }
198             }
199              
200             sub append_extended {
201 0     0 1   my $self = shift;
202 0 0         @_ & 1 and croak "odd number of arguments passed to append_extended";
203 0           my $pairs = $self->{extended};
204 0 0         if (@$pairs) {
205 0           push @$pairs, @_;
206             }
207             else {
208 0           $self->set_extended(@_);
209             }
210             }
211              
212             sub clone {
213 0     0 0   my $self = shift;
214 0           my $clone = { %$self };
215 0           bless $clone, ref $self;
216 0           $clone;
217             }
218              
219             1;
220             __END__