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
24 use namespace::autoclean;
26 extends 'Debbugs::OOBase';
28 has 'members' => (is => 'bare',
32 writer => '_set_members',
33 predicate => '_has_members',
34 handles => {_add => 'push',
35 members => 'elements',
47 return [$self->members];
50 has 'member_hash' => (traits => ['Hash'],
52 # really a HashRef[Int], but type checking is too slow
55 reader => '_member_hash',
56 builder => '_build_member_hash',
57 clearer => '_clear_member_hash',
58 predicate => '_has_member_hash',
59 writer => '_set_member_hash',
60 handles => {# _add_member_hash => 'set',
61 _member_key_exists => 'exists',
62 _get_member_hash => 'get',
66 # because _add_member_hash needs to be fast, we are overriding the default set
67 # method which is very safe but slow, because it makes copies.
68 sub _add_member_hash {
73 throw_error("Hash keys passed to _add_member_hash must be defined" );
76 throw_error("Values passed to _add_member_hash must be integer");
79 while (my ($key, $value) = splice @kv, 0, 2 ) {
81 $self->{member_hash}{$key} = $value
83 wantarray ? return @return: return $return[0];
86 has 'universe' => (is => 'ro',
87 isa => 'Debbugs::Collection',
89 builder => '_build_universe',
90 writer => '_set_universe',
91 predicate => 'has_universe',
95 # By default, the universe is myself
101 my $new = bless { %{$self} }, ref $self;
102 if ($self->_has_members) {
103 $new->_set_members([$self->members]);
105 if ($self->_has_member_hash) {
106 $new->_set_member_hash({%{$self->_member_hash}})
113 return bless { %{$self} }, ref $self;
118 my $limit = $self->_shallow_clone();
119 # Set the universe to whatever my universe is (potentially myself)
120 # $limit->_set_universe($self->universe);
121 $limit->_set_members([]);
122 $limit->_clear_member_hash();
123 $limit->add($self->universe->get_or_create(@_)) if @_;
134 # we assume that if it's already a blessed reference, that it's the right
135 if (blessed($_[$i])) {
139 elsif ($self->_member_key_exists($_[$i])) {
142 push @need_to_add,$i;
145 # create and add by key
147 @return[@need_to_add] =
148 $self->add_by_key(@_[@need_to_add]);
152 $self->get(@_[@exists]);
154 # if we've only been asked to get or create one thing, then it's expected
155 # that we are returning only one thing
162 has 'constructor_args' => (is => 'rw',
169 # we'll assume that add does the right thing. around this in subclasses
170 return $self->add(@_);
176 for my $member (@_) {
177 if (not defined $member) {
178 confess("Undefined member to add");
180 push @members_added,$member;
181 if ($self->exists($member)) {
184 $self->_add($member);
185 $self->_add_member_hash($self->member_key($member),
189 return @members_added;
194 return $self->_get_member($self->_get_member_hash(@_));
204 return $self->_member_key_exists($self->member_key($_[0]));
207 sub _build_member_hash {
211 for my $member ($self->members) {
212 $hash->{$self->member_key($member)} =
220 return 'Debbugs::Collection={n_members='.$self->count().'}';
224 __PACKAGE__->meta->make_immutable;
230 # indent-tabs-mode: nil
231 # cperl-indent-level: 4