File Coverage

blib/lib/Adapter/Async/OrderedList/Array.pm
Criterion Covered Total %
statement 52 80 65.0
branch 4 24 16.6
condition 4 17 23.5
subroutine 10 13 76.9
pod 8 10 80.0
total 78 144 54.1


line stmt bran cond sub pod time code
1             package Adapter::Async::OrderedList::Array;
2             $Adapter::Async::OrderedList::Array::VERSION = '0.017';
3 2     2   19799 use strict;
  2         3  
  2         72  
4 2     2   10 use warnings;
  2         3  
  2         53  
5              
6 2     2   468 use parent qw(Adapter::Async::OrderedList);
  2         249  
  2         8  
7              
8             =head1 NAME
9              
10             Adapter::Async::OrderedList::Array - arrayref adapter
11              
12             =head1 VERSION
13              
14             version 0.017
15              
16             =head1 DESCRIPTION
17              
18             See L for the API.
19              
20             =cut
21              
22             sub new {
23 2     2 1 86 my $self = shift->SUPER::new(@_);
24 2   50     22 $self->{data} ||= [];
25 2         7 $self
26             }
27              
28             sub clear {
29 2     2 1 1362 my $self = shift;
30 2         4 @{$self->{data}} = ();
  2         6  
31 2         6 $self->bus->invoke_event('clear');
32 2         21 Future->wrap
33             }
34              
35             sub splice:method {
36 8     8 1 12 my ($self, $idx, $len, $data) = @_;
37 8   100     30 $idx ||= 0;
38 8   50     45 $data ||= [];
39 8         10 my @rslt = splice @{$self->{data}}, $idx, $len, @$data;
  8         23  
40 8         25 $self->bus->invoke_event(splice => $idx, $len, $data => \@rslt);
41 8         2883 Future->wrap($idx, $len, $data, \@rslt);
42             }
43              
44             # XXX weakrefs
45             sub move {
46 3     3 1 695 my ($self, $idx, $len, $offset) = @_;
47 3         4 my @data = splice @{$self->{data}}, $idx, $len;
  3         10  
48 3         4 splice @{$self->{data}}, $idx + $offset, 0, @data;
  3         8  
49 3         9 $self->bus->invoke_event(move => $idx, $len, $offset);
50 3         2598 Future->wrap($idx, $len, $offset);
51             }
52              
53             # XXX needs updating
54             sub modify {
55 1     1 1 1160 my ($self, $idx, $data) = @_;
56 1 50       2 die "row out of bounds" unless @{$self->{data}} >= $idx;
  1         5  
57 1         3 $self->{data}[$idx] = $data;
58 1         4 $self->bus->invoke_event(modify => $idx, $data);
59 1         929 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 0 0       0 return Future->wrap(
81             $idx + $delta
82             ) if $self->{data}[$idx + $delta] eq $data;
83             }
84 0 0       0 if($idx - $delta >= 0) {
85 0 0       0 return Future->wrap(
86             $idx - $delta
87             ) 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 17     17 1 3635 my $self = shift;
101 17         19 Future->wrap(scalar @{$self->{data}});
  17         63  
102             }
103              
104             =head1 get
105              
106             =cut
107              
108             sub get {
109 6     6 1 2720 my ($self, %args) = @_;
110 6 50       9 return Future->fail('unknown item') if grep $_ > @{$self->{data}}, @{$args{items}};
  17         30  
  6         13  
111 6         6 my @items = @{$self->{data}}[@{$args{items}}];
  6         15  
  6         8  
112 6 100       14 if(my $code = $args{on_item}) {
113 2         2 my @idx = @{$args{items}};
  2         3  
114 2         6 $code->(shift(@idx), $_) for @items;
115             }
116 6         1742 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   my ($self, %args) = @_;
139 0   0       my $idx = delete $args{start} || 0;
140 0           my $code = delete $args{on_item};
141 0           my $max = $#{$self->{data}};
  0            
142 0 0 0       $args{end} //= $idx + $args{count} if exists $args{count};
143 0   0       $args{end} //= $max;
144 0           while($idx < $args{end}) {
145 0 0         last if $idx > $max;
146 0           $code->($idx, $self->{data}[$idx]);
147 0           ++$idx;
148             }
149             Future->done
150 0           }
151              
152             1;
153              
154             __END__