File Coverage

blib/lib/Adapter/Async/OrderedList/Array.pm
Criterion Covered Total %
statement 64 100 64.0
branch 7 30 23.3
condition 10 31 32.2
subroutine 14 18 77.7
pod 8 13 61.5
total 103 192 53.6


line stmt bran cond sub pod time code
1             package Adapter::Async::OrderedList::Array;
2             $Adapter::Async::OrderedList::Array::VERSION = '0.019';
3 2     2   27729 use strict;
  2         2  
  2         45  
4 2     2   6 use warnings;
  2         2  
  2         46  
5              
6 2     2   345 use parent qw(Adapter::Async::OrderedList);
  2         207  
  2         8  
7              
8             =head1 NAME
9              
10             Adapter::Async::OrderedList::Array - arrayref adapter
11              
12             =head1 VERSION
13              
14             version 0.018
15              
16             =head1 DESCRIPTION
17              
18             See L for the API.
19              
20             =cut
21              
22             sub new {
23 2     2 1 90 my $self = shift->SUPER::new(@_);
24 2   50     19 $self->{data} ||= [];
25 2         8 $self
26             }
27              
28             sub clear {
29 4     4 1 1546 my $self = shift;
30 4         4 @{$self->{data}} = ();
  4         7  
31 4         10 $self->bus->invoke_event('clear');
32 4         40 Future->wrap
33             }
34              
35             sub splice:method {
36 16     16 1 17 my ($self, $idx, $len, $data) = @_;
37 16   100     49 $idx ||= 0;
38 16   50     46 $data ||= [];
39 16         12 my @rslt = splice @{$self->{data}}, $idx, $len, @$data;
  16         33  
40 16         34 $self->bus->invoke_event(splice => $idx, $len, $data => \@rslt);
41 16         1821 Future->wrap($idx, $len, $data, \@rslt);
42             }
43              
44             # XXX weakrefs
45             sub move {
46 3     3 1 423 my ($self, $idx, $len, $offset) = @_;
47 3         4 my @data = splice @{$self->{data}}, $idx, $len;
  3         5  
48 3         4 splice @{$self->{data}}, $idx + $offset, 0, @data;
  3         7  
49 3         6 $self->bus->invoke_event(move => $idx, $len, $offset);
50 3         1511 Future->wrap($idx, $len, $offset);
51             }
52              
53             # XXX needs updating
54             sub modify {
55 1     1 1 517 my ($self, $idx, $data) = @_;
56 1 50       2 die "row out of bounds" unless @{$self->{data}} >= $idx;
  1         4  
57 1         2 $self->{data}[$idx] = $data;
58 1         3 $self->bus->invoke_event(modify => $idx, $data);
59 1         524 Future->wrap
60             }
61              
62             sub delete {
63 0     0 0 0 my ($self, $idx) = @_;
64 0         0 $self->splice($idx, 1, [])
65             }
66              
67             # Locate matching element (via eq), starting at the given index
68             # and iterating either side until we hit it. For cases where splice
69             # activity may have moved the element but we're not expecting it to
70             # have gone far.
71             sub find_from {
72 0     0 0 0 my ($self, $idx, $data) = @_;
73 0         0 my $delta = 0;
74 0         0 my $end = $#{$self->{data}};
  0         0  
75 0 0       0 $idx = $end if $idx > $end;
76 0 0       0 $idx = 0 if $idx < 0;
77             ITEM:
78 0         0 while(1) {
79 0 0       0 if($idx + $delta <= $end) {
80             return Future->wrap(
81             $idx + $delta
82 0 0       0 ) if $self->{data}[$idx + $delta] eq $data;
83             }
84 0 0       0 if($idx - $delta >= 0) {
85             return Future->wrap(
86             $idx - $delta
87 0 0       0 ) if $self->{data}[$idx - $delta] eq $data;
88             }
89 0 0 0     0 last ITEM if $idx + $delta > $end && $idx - $delta < 0;
90 0         0 ++$delta;
91             }
92 0         0 Future->fail('not found');
93             }
94              
95             =head1 count
96              
97             =cut
98              
99             sub count {
100 23     23 1 2433 my $self = shift;
101 23         21 Future->wrap(scalar @{$self->{data}});
  23         68  
102             }
103              
104             =head1 get
105              
106             =cut
107              
108             sub get {
109 8     8 1 2266 my ($self, %args) = @_;
110 8 50       9 return Future->fail('unknown item') if grep $_ > @{$self->{data}}, @{$args{items}};
  25         35  
  8         15  
111 8         7 my @items = @{$self->{data}}[@{$args{items}}];
  8         20  
  8         6  
112 8 100       14 if(my $code = $args{on_item}) {
113 2         3 my @idx = @{$args{items}};
  2         2  
114 2         6 $code->(shift(@idx), $_) for @items;
115             }
116 8         932 Future->wrap(\@items)
117             }
118              
119             =head2 range
120              
121             Retrieves all items in a range.
122              
123             =over 4
124              
125             =item * start
126              
127             =item * end
128              
129             =item * count
130              
131             =item * on_item
132              
133             =back
134              
135             =cut
136              
137             sub range {
138 0     0 1 0 my ($self, %args) = @_;
139 0   0     0 my $idx = delete $args{start} || 0;
140 0         0 my $code = delete $args{on_item};
141 0         0 my $max = $#{$self->{data}};
  0         0  
142 0 0 0     0 $args{end} //= $idx + $args{count} if exists $args{count};
143 0   0     0 $args{end} //= $max;
144 0         0 while($idx < $args{end}) {
145 0 0       0 last if $idx > $max;
146 0         0 $code->($idx, $self->{data}[$idx]);
147 0         0 ++$idx;
148             }
149             Future->done
150 0         0 }
151              
152             sub find_idx {
153 12     12 0 2567 my ($self, $item, $code) = @_;
154 12         659 require List::BinarySearch;
155 12   50 24   1650 $code ||= sub { ($a // '') cmp ($b // '') };
  24   50     50  
      50        
156 12         30 my $idx = List::BinarySearch::binsearch($code, $item, $self->{data});
157 12 100       37 return defined($idx) ? Future->done($idx) : Future->fail('not found');
158             }
159              
160             sub find_insert_pos {
161 8     8 0 1604 my ($self, $item, $code) = @_;
162 8         30 require List::BinarySearch;
163 8   50 14   35 $code ||= sub { ($a // '') cmp ($b // '') };
  14   50     31  
      50        
164 8         34 my $idx = List::BinarySearch::binsearch_pos($code, $item, $self->{data});
165 8 50       22 return defined($idx) ? Future->done($idx) : Future->fail('not found');
166             }
167              
168             sub extract_first_by {
169 0     0 0   my ($self, $code, $start_idx) = @_;
170 0   0       $start_idx //= 0;
171 0           for my $idx ($start_idx..$#{$self->{data}}) {
  0            
172 0 0         if(grep $code->($_), $self->{data}[$idx]) {
173 0           return Future->done(CORE::splice @{$self->{data}}, $idx, 1);
  0            
174             }
175             }
176 0           return Future->done;
177             }
178              
179             1;
180              
181             __END__