File Coverage

blib/lib/Net/DAV/LockManager/Simple.pm
Criterion Covered Total %
statement 32 32 100.0
branch 6 6 100.0
condition n/a
subroutine 9 9 100.0
pod 0 7 0.0
total 47 54 87.0


line stmt bran cond sub pod time code
1             package Net::DAV::LockManager::Simple;
2              
3 14     14   50782 use Net::DAV::Lock;
  14         28  
  14         365  
4              
5 14     14   67 use strict;
  14         27  
  14         4339  
6              
7             our $VERSION = '1.304';
8             $VERSION = eval $VERSION;
9              
10             #
11             # This reference implementation of the lock management database interface
12             # provides an example of the simplest case of a pluggable lock management
13             # backend mechanism which can be swapped in for any other sort of
14             # implementation without concern for the operation of the lock manager
15             # itself.
16             #
17              
18             #
19             # Create a new lock manager context. Optionally accepts an array
20             # containing a default set of locks.
21             #
22             sub new {
23 58     58 0 18179 my $class = shift;
24              
25 58         197 return bless \@_, $class;
26             }
27              
28             #
29             # Stub method. Simply present to adhere to the lock management interface
30             # used within this package.
31             #
32             sub close {
33 2     2 0 229 return;
34             }
35              
36             #
37             # Given a normalized string representation of a resource path, return
38             # the first lock found. Otherwise, return undef if none is located.
39             #
40             sub get {
41 357     357 0 1138 my ($self, $path) = @_;
42              
43 357         530 foreach my $lock (@$self) {
44 243 100       421 if ($lock->path eq $path) {
45 73         167 return $lock;
46             }
47             }
48              
49 284         466 return undef;
50             }
51              
52             #
53             # Given a path string, return all objects indexed whose path is a descendant
54             # of the one specified.
55             #
56             sub list_descendants {
57 54     54 0 569 my ($self, $path) = @_;
58              
59 54 100       121 return grep { $_->path ne '/' } @$self if $path eq '/';
  5         10  
60 46         111 return grep { index($_->path, "$path/") == 0 } @$self;
  27         52  
61             }
62              
63             #
64             # Given a Net::DAV::Lock object, replace any other locks whose
65             # path corresponds to that which is stored in the list.
66             #
67             sub update {
68 4     4 0 9 my ($self, $lock) = @_;
69              
70 4         13 for (my $i=0; $$self[$i]; $i++) {
71 7 100       18 if ($$self[$i]->path eq $lock->path) {
72 4         12 $$self[$i] = $lock;
73             }
74             }
75              
76 4         11 return $lock;
77             }
78              
79             #
80             # Add the given lock object to the list.
81             #
82             sub add {
83 58     58 0 118 my ($self, $lock) = @_;
84              
85 58         115 push @$self, $lock;
86              
87 58         189 return $lock;
88             }
89              
90             #
91             # Given a lock, the database record which contains the corresponding
92             # path will be removed.
93             #
94             sub remove {
95 4     4 0 10 my ($self, $lock) = @_;
96              
97 4         11 @{$self} = grep { $_->path ne $lock->path } @{$self};
  4         12  
  9         21  
  4         9  
98             }
99              
100             1;
101              
102             __END__