1 # This module is part of debbugs, and
2 # is released under the terms of the GPL version 2, or any later
3 # version (at your option). See the file README and COPYING for more
5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
7 package Debbugs::Collection;
11 Debbugs::Collection -- Collection base class which can generate lots of objects
15 This base class is designed for holding collections of objects which can be
16 uniquely identified by a key and added/generated by that same key.
26 use namespace::autoclean;
27 use List::AllUtils qw(pairmap);
30 extends 'Debbugs::OOBase';
34 =head2 Debbugs::Collection->new(%params|$params)
36 Creates a new Debbugs::Collection object.
44 To avoid unnecessarily constructing new members, collections have a universe to
45 which existing members can be obtained from. By default the universe is this
46 collection. Generally, you should create exactly one universe for each
51 Optional Debbugs::Schema object
56 =head2 $collection->members()
58 Returns list of members of this collection
60 =head2 $collection->members_ref()
62 Returns an ARRAYREF of members of this collection
64 =head2 $collection->keys_of_members()
66 Returns a list of the keys of all members of this collection
68 =head2 $collection->member_key($member)
70 Given a member, returns the key of that member
72 =head2 $collection->exists($member_key)
74 Returns true if a member with $member_key exists in the collection
76 =head2 $collection->clone()
78 Returns a clone of this collection with the same universe as this collection
80 =head2 $collection->limit(@member_keys)
82 Returns a new collection limited to the list of member keys passed
84 =head2 $collection->add($member)
86 Add a member to this collection
88 =head2 $collection->add_by_key($member_key)
90 Add a member to this collection by key
92 =head2 $collection->get($member_key)
94 Get member(s) by key, returning undef for keys which do not exist in the
97 =head2 $collection->get_or_add_by_key($member_key)
99 Get or add a member by the member key.
101 =head2 $collection->count()
103 Return the number of members in this collection
105 =head2 $collection->grep({$_ eq 5})
107 Return the members in this collection which satisfy the condition, setting $_
108 locally to each member object
110 =head2 $collection->join(', ')
112 Returns the keys of the members of this collection joined
114 =head2 $collection->apply({$_*2}) $collection->map({$_*2})
116 Return the list of applying BLOCK to each member
118 =head2 $collection->sort({$a <=> $b})
120 Return the list of members sorted by BLOCK
124 has 'members' => (is => 'bare',
128 writer => '_set_members',
129 predicate => '_has_members',
130 handles => {_add => 'push',
131 members => 'elements',
133 _get_member => 'get',
143 return [$self->members];
146 has 'member_hash' => (traits => ['Hash'],
148 # really a HashRef[Int], but type checking is too slow
151 reader => '_member_hash',
152 builder => '_build_member_hash',
153 clearer => '_clear_member_hash',
154 predicate => '_has_member_hash',
155 writer => '_set_member_hash',
156 handles => {# _add_member_hash => 'set',
157 _member_key_exists => 'exists',
158 _get_member_hash => 'get',
162 # because _add_member_hash needs to be fast, we are overriding the default set
163 # method which is very safe but slow, because it makes copies.
164 sub _add_member_hash {
169 throw_error("Hash keys passed to _add_member_hash must be defined" );
172 throw_error("Values passed to _add_member_hash must be integer");
175 while (my ($key, $value) = splice @kv, 0, 2 ) {
177 $self->{member_hash}{$key} = $value
179 wantarray ? return @return: return $return[0];
182 =head2 $collection->universe
187 has 'universe' => (is => 'ro',
188 isa => 'Debbugs::Collection',
190 builder => '_build_universe',
191 writer => '_set_universe',
192 predicate => 'has_universe',
195 sub _build_universe {
196 # By default, the universe is myself
202 my $new = bless { %{$self} }, ref $self;
203 if ($self->_has_members) {
204 $new->_set_members([$self->members]);
206 if ($self->_has_member_hash) {
207 $new->_set_member_hash({%{$self->_member_hash}})
214 return bless { %{$self} }, ref $self;
219 my $limit = $self->_shallow_clone();
220 # Set the universe to whatever my universe is (potentially myself)
221 # $limit->_set_universe($self->universe);
222 $limit->_set_members([]);
223 $limit->_clear_member_hash();
224 $limit->add($self->universe->get_or_add_by_key(@_)) if @_;
228 sub get_or_add_by_key {
235 # we assume that if it's already a blessed reference, that it's the
236 # right object to return
238 croak "Passed a reference instead of a key to get_or_add_by_key";
240 elsif ($self->_member_key_exists($_[$i])) {
243 push @need_to_add,$i;
246 # create and add by key
248 @return[@need_to_add] =
249 $self->add_by_key(@_[@need_to_add]);
253 $self->get(@_[@exists]);
255 # if we've only been asked to get or create one thing, then it's expected
256 # that we are returning only one thing
263 has 'constructor_args' => (is => 'rw',
266 builder => '_build_constructor_args',
269 sub _build_constructor_args {
275 # we'll assume that add does the right thing. around this in subclasses
276 return $self->add(@_);
282 for my $member (@_) {
283 if (not defined $member) {
284 confess("Undefined member to add");
286 push @members_added,$member;
287 if ($self->exists($member)) {
290 $self->_add($member);
291 $self->_add_member_hash($self->member_key($member),
295 return @members_added;
300 my @res = map {$self->_get_member($_)}
301 $self->_get_member_hash(@_);
302 wantarray?@res:$res[0];
310 sub keys_of_members {
312 return $self->map(sub {$self->member_key($_[0])});
317 return $self->_member_key_exists($self->member_key($_[0]));
323 return CORE::join($joiner,$self->keys_of_members);
326 sub _build_member_hash {
330 for my $member ($self->members) {
331 $hash->{$self->member_key($member)} =
339 my @members = $self->members;
341 @members = map {$self->member_key($_)}
345 @members = map {$self->member_key($_)} @members;
347 return __PACKAGE__.'={n_members='.$self->count().
348 ',members=('.CORE::join(',',@members).')}';
352 __PACKAGE__->meta->make_immutable;
358 # indent-tabs-mode: nil
359 # cperl-indent-level: 4