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. Will add new
83 members to the universe if they do not currently exist.
85 =head2 $collection->add($member)
87 Add a member to this collection
89 =head2 $collection->add_by_key($member_key)
91 Add a member to this collection by key
93 =head2 $collection->combine($collection2) or $collection + $collection2
95 Combines the members of both collections together and returns the new collection
97 =head2 $collection->get($member_key)
99 Get member(s) by key, returning undef for keys which do not exist in the
102 =head2 $collection->get_or_add_by_key($member_key)
104 Get or add a member by the member key.
106 =head2 $collection->count()
108 Return the number of members in this collection
110 =head2 $collection->grep({$_ eq 5})
112 Return the members in this collection which satisfy the condition, setting $_
113 locally to each member object
115 =head2 $collection->join(', ')
117 Returns the keys of the members of this collection joined
119 =head2 $collection->apply({$_*2})
121 Return the list of applying BLOCK to each member; each member can return 0 or
124 =head2 $collection->map({$_*2})
126 Returns the list of applying BLOCK to each member; each member should return
129 =head2 $collection->sort({$a <=> $b})
131 Return the list of members sorted by BLOCK
135 has 'members' => (is => 'bare',
139 writer => '_set_members',
140 predicate => '_has_members',
141 handles => {_add => 'push',
142 members => 'elements',
144 _get_member => 'get',
155 for ($self->members) {
163 return [$self->members];
166 has 'member_hash' => (traits => ['Hash'],
168 # really a HashRef[Int], but type checking is too slow
171 reader => '_member_hash',
172 builder => '_build_member_hash',
173 clearer => '_clear_member_hash',
174 predicate => '_has_member_hash',
175 writer => '_set_member_hash',
176 handles => {# _add_member_hash => 'set',
177 _member_key_exists => 'exists',
178 _get_member_hash => 'get',
182 # because _add_member_hash needs to be fast, we are overriding the default set
183 # method which is very safe but slow, because it makes copies.
184 sub _add_member_hash {
189 throw_error("Hash keys passed to _add_member_hash must be defined" );
192 throw_error("Values passed to _add_member_hash must be integer");
195 while (my ($key, $value) = splice @kv, 0, 2 ) {
197 $self->{member_hash}{$key} = $value
199 wantarray ? return @return: return $return[0];
202 =head2 $collection->universe
207 has 'universe' => (is => 'ro',
208 isa => 'Debbugs::Collection',
210 builder => '_build_universe',
211 writer => '_set_universe',
212 predicate => 'has_universe',
215 sub _build_universe {
216 # By default, the universe is myself
222 my $new = bless { %{$self} }, ref $self;
223 if ($self->_has_members) {
224 $new->_set_members([$self->members]);
226 if ($self->_has_member_hash) {
227 $new->_set_member_hash({%{$self->_member_hash}})
234 return bless { %{$self} }, ref $self;
239 my $limit = $self->_shallow_clone();
240 # Set the universe to whatever my universe is (potentially myself)
241 # $limit->_set_universe($self->universe);
242 $limit->_set_members([]);
243 $limit->_clear_member_hash();
244 $limit->add($self->universe->get_or_add_by_key(@_)) if @_;
248 sub get_or_add_by_key {
255 # we assume that if it's already a blessed reference, that it's the
256 # right object to return
258 croak "Passed a reference instead of a key to get_or_add_by_key";
260 elsif ($self->_member_key_exists($_[$i])) {
263 push @need_to_add,$i;
266 # create and add by key
268 @return[@need_to_add] =
269 $self->add_by_key(@_[@need_to_add]);
273 $self->get(@_[@exists]);
275 # if we've only been asked to get or create one thing, then it's expected
276 # that we are returning only one thing
283 has 'constructor_args' => (is => 'rw',
286 builder => '_build_constructor_args',
289 sub _build_constructor_args {
295 # we'll assume that add does the right thing. around this in subclasses
296 return $self->add(@_);
302 for my $member (@_) {
303 if (not defined $member) {
304 confess("Undefined member to add");
306 push @members_added,$member;
307 if ($self->exists($member)) {
310 $self->_add($member);
311 $self->_add_member_hash($self->member_key($member),
315 return @members_added;
318 use overload '+' => "combine",
319 '""' => "CARP_TRACE";
323 my $return = $self->clone;
324 $return->add($_->members) for @_;
330 my @res = map {$self->_get_member($_)}
331 $self->_get_member_hash(@_);
332 wantarray?@res:$res[0];
340 sub keys_of_members {
342 return $self->map(sub {$self->member_key($_)});
347 return $self->_member_key_exists($self->member_key($_[0]));
353 return CORE::join($joiner,$self->keys_of_members);
356 sub _build_member_hash {
360 for my $member ($self->members) {
361 $hash->{$self->member_key($member)} =
369 my @members = $self->members;
371 @members = map {$self->member_key($_)}
375 @members = map {$self->member_key($_)} @members;
377 return __PACKAGE__.'={n_members='.$self->count().
378 ',members=('.CORE::join(',',@members).')}';
382 __PACKAGE__->meta->make_immutable;
388 # indent-tabs-mode: nil
389 # cperl-indent-level: 4