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}) $collection->map({$_*2})
121 Return the list of applying BLOCK to each member
123 =head2 $collection->sort({$a <=> $b})
125 Return the list of members sorted by BLOCK
129 has 'members' => (is => 'bare',
133 writer => '_set_members',
134 predicate => '_has_members',
135 handles => {_add => 'push',
136 members => 'elements',
138 _get_member => 'get',
148 return [$self->members];
151 has 'member_hash' => (traits => ['Hash'],
153 # really a HashRef[Int], but type checking is too slow
156 reader => '_member_hash',
157 builder => '_build_member_hash',
158 clearer => '_clear_member_hash',
159 predicate => '_has_member_hash',
160 writer => '_set_member_hash',
161 handles => {# _add_member_hash => 'set',
162 _member_key_exists => 'exists',
163 _get_member_hash => 'get',
167 # because _add_member_hash needs to be fast, we are overriding the default set
168 # method which is very safe but slow, because it makes copies.
169 sub _add_member_hash {
174 throw_error("Hash keys passed to _add_member_hash must be defined" );
177 throw_error("Values passed to _add_member_hash must be integer");
180 while (my ($key, $value) = splice @kv, 0, 2 ) {
182 $self->{member_hash}{$key} = $value
184 wantarray ? return @return: return $return[0];
187 =head2 $collection->universe
192 has 'universe' => (is => 'ro',
193 isa => 'Debbugs::Collection',
195 builder => '_build_universe',
196 writer => '_set_universe',
197 predicate => 'has_universe',
200 sub _build_universe {
201 # By default, the universe is myself
207 my $new = bless { %{$self} }, ref $self;
208 if ($self->_has_members) {
209 $new->_set_members([$self->members]);
211 if ($self->_has_member_hash) {
212 $new->_set_member_hash({%{$self->_member_hash}})
219 return bless { %{$self} }, ref $self;
224 my $limit = $self->_shallow_clone();
225 # Set the universe to whatever my universe is (potentially myself)
226 # $limit->_set_universe($self->universe);
227 $limit->_set_members([]);
228 $limit->_clear_member_hash();
229 $limit->add($self->universe->get_or_add_by_key(@_)) if @_;
233 sub get_or_add_by_key {
240 # we assume that if it's already a blessed reference, that it's the
241 # right object to return
243 croak "Passed a reference instead of a key to get_or_add_by_key";
245 elsif ($self->_member_key_exists($_[$i])) {
248 push @need_to_add,$i;
251 # create and add by key
253 @return[@need_to_add] =
254 $self->add_by_key(@_[@need_to_add]);
258 $self->get(@_[@exists]);
260 # if we've only been asked to get or create one thing, then it's expected
261 # that we are returning only one thing
268 has 'constructor_args' => (is => 'rw',
271 builder => '_build_constructor_args',
274 sub _build_constructor_args {
280 # we'll assume that add does the right thing. around this in subclasses
281 return $self->add(@_);
287 for my $member (@_) {
288 if (not defined $member) {
289 confess("Undefined member to add");
291 push @members_added,$member;
292 if ($self->exists($member)) {
295 $self->_add($member);
296 $self->_add_member_hash($self->member_key($member),
300 return @members_added;
303 use overload '+' => "combine",
304 '""' => "CARP_TRACE";
308 my $return = $self->clone;
309 $return->add($_->members) for @_;
315 my @res = map {$self->_get_member($_)}
316 $self->_get_member_hash(@_);
317 wantarray?@res:$res[0];
325 sub keys_of_members {
327 return $self->map(sub {$self->member_key($_)});
332 return $self->_member_key_exists($self->member_key($_[0]));
338 return CORE::join($joiner,$self->keys_of_members);
341 sub _build_member_hash {
345 for my $member ($self->members) {
346 $hash->{$self->member_key($member)} =
354 my @members = $self->members;
356 @members = map {$self->member_key($_)}
360 @members = map {$self->member_key($_)} @members;
362 return __PACKAGE__.'={n_members='.$self->count().
363 ',members=('.CORE::join(',',@members).')}';
367 __PACKAGE__->meta->make_immutable;
373 # indent-tabs-mode: nil
374 # cperl-indent-level: 4