--- /dev/null
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Collection;
+
+=head1 NAME
+
+Debbugs::Collection -- Collection base class which can generate lots of objects
+
+=head1 SYNOPSIS
+
+This base class is designed for holding collections of objects which can be
+uniquely identified by a key and added/generated by that same key.
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::autoclean;
+use List::AllUtils qw(pairmap);
+use Carp qw(croak);
+
+extends 'Debbugs::OOBase';
+
+=head1 METHODS
+
+=head2 Debbugs::Collection->new(%params|$params)
+
+Creates a new Debbugs::Collection object.
+
+Parameters:
+
+=over
+
+=item universe
+
+To avoid unnecessarily constructing new members, collections have a universe to
+which existing members can be obtained from. By default the universe is this
+collection. Generally, you should create exactly one universe for each
+collection type.
+
+=item schema
+
+Optional Debbugs::Schema object
+
+
+=back
+
+=head2 $collection->members()
+
+Returns list of members of this collection
+
+=head2 $collection->members_ref()
+
+Returns an ARRAYREF of members of this collection
+
+=head2 $collection->keys_of_members()
+
+Returns a list of the keys of all members of this collection
+
+=head2 $collection->member_key($member)
+
+Given a member, returns the key of that member
+
+=head2 $collection->exists($member_key)
+
+Returns true if a member with $member_key exists in the collection
+
+=head2 $collection->clone()
+
+Returns a clone of this collection with the same universe as this collection
+
+=head2 $collection->limit(@member_keys)
+
+Returns a new collection limited to the list of member keys passed. Will add new
+members to the universe if they do not currently exist.
+
+=head2 $collection->add($member)
+
+Add a member to this collection
+
+=head2 $collection->add_by_key($member_key)
+
+Add a member to this collection by key
+
+=head2 $collection->combine($collection2) or $collection + $collection2
+
+Combines the members of both collections together and returns the new collection
+
+=head2 $collection->get($member_key)
+
+Get member(s) by key, returning undef for keys which do not exist in the
+collection
+
+=head2 $collection->get_or_add_by_key($member_key)
+
+Get or add a member by the member key.
+
+=head2 $collection->count()
+
+Return the number of members in this collection
+
+=head2 $collection->grep({$_ eq 5})
+
+Return the members in this collection which satisfy the condition, setting $_
+locally to each member object
+
+=head2 $collection->join(', ')
+
+Returns the keys of the members of this collection joined
+
+=head2 $collection->apply({$_*2})
+
+Return the list of applying BLOCK to each member; each member can return 0 or
+more results
+
+=head2 $collection->map({$_*2})
+
+Returns the list of applying BLOCK to each member; each member should return
+exactly one result
+
+=head2 $collection->sort({$a <=> $b})
+
+Return the list of members sorted by BLOCK
+
+=cut
+
+has 'members' => (is => 'bare',
+ isa => 'ArrayRef',
+ traits => ['Array'],
+ default => sub {[]},
+ writer => '_set_members',
+ predicate => '_has_members',
+ handles => {_add => 'push',
+ members => 'elements',
+ count => 'count',
+ _get_member => 'get',
+ grep => 'grep',
+ map => 'map',
+ sort => 'sort',
+ },
+ );
+
+sub apply {
+ my $self = shift;
+ my $block = shift;
+ my @r;
+ for ($self->members) {
+ push @r,$block->();
+ }
+ return @r;
+}
+
+sub members_ref {
+ my $self = shift;
+ return [$self->members];
+}
+
+has 'member_hash' => (traits => ['Hash'],
+ is => 'bare',
+ # really a HashRef[Int], but type checking is too slow
+ isa => 'HashRef',
+ lazy => 1,
+ reader => '_member_hash',
+ builder => '_build_member_hash',
+ clearer => '_clear_member_hash',
+ predicate => '_has_member_hash',
+ writer => '_set_member_hash',
+ handles => {# _add_member_hash => 'set',
+ _member_key_exists => 'exists',
+ _get_member_hash => 'get',
+ },
+ );
+
+# because _add_member_hash needs to be fast, we are overriding the default set
+# method which is very safe but slow, because it makes copies.
+sub _add_member_hash {
+ my ($self,@kv) = @_;
+ pairmap {
+ defined($a)
+ or $self->meta->
+ throw_error("Hash keys passed to _add_member_hash must be defined" );
+ ($b eq int($b)) or
+ $self->meta->
+ throw_error("Values passed to _add_member_hash must be integer");
+ } @kv;
+ my @return;
+ while (my ($key, $value) = splice @kv, 0, 2 ) {
+ push @return,
+ $self->{member_hash}{$key} = $value
+ }
+ wantarray ? return @return: return $return[0];
+}
+
+=head2 $collection->universe
+
+
+=cut
+
+has 'universe' => (is => 'ro',
+ isa => 'Debbugs::Collection',
+ required => 1,
+ builder => '_build_universe',
+ writer => '_set_universe',
+ predicate => 'has_universe',
+ );
+
+sub _build_universe {
+ # By default, the universe is myself
+ return $_[0];
+}
+
+sub clone {
+ my $self = shift;
+ my $new = bless { %{$self} }, ref $self;
+ if ($self->_has_members) {
+ $new->_set_members([$self->members]);
+ }
+ if ($self->_has_member_hash) {
+ $new->_set_member_hash({%{$self->_member_hash}})
+ }
+ return $new;
+}
+
+sub _shallow_clone {
+ my $self = shift;
+ return bless { %{$self} }, ref $self;
+}
+
+sub limit {
+ my $self = shift;
+ my $limit = $self->_shallow_clone();
+ # Set the universe to whatever my universe is (potentially myself)
+ # $limit->_set_universe($self->universe);
+ $limit->_set_members([]);
+ $limit->_clear_member_hash();
+ $limit->add($self->universe->get_or_add_by_key(@_)) if @_;
+ return $limit;
+}
+
+sub get_or_add_by_key {
+ my $self = shift;
+ return () unless @_;
+ my @return;
+ my @exists;
+ my @need_to_add;
+ for my $i (0..$#_) {
+ # we assume that if it's already a blessed reference, that it's the
+ # right object to return
+ if (ref $_[$i]) {
+ croak "Passed a reference instead of a key to get_or_add_by_key";
+ }
+ elsif ($self->_member_key_exists($_[$i])) {
+ push @exists,$i;
+ } else {
+ push @need_to_add,$i;
+ }
+ }
+ # create and add by key
+ if (@need_to_add) {
+ @return[@need_to_add] =
+ $self->add_by_key(@_[@need_to_add]);
+ }
+ if (@exists) {
+ @return[@exists] =
+ $self->get(@_[@exists]);
+ }
+ # if we've only been asked to get or create one thing, then it's expected
+ # that we are returning only one thing
+ if (@_ == 1) {
+ return $return[0];
+ }
+ return @return;
+}
+
+has 'constructor_args' => (is => 'rw',
+ isa => 'ArrayRef',
+ lazy => 1,
+ builder => '_build_constructor_args',
+ );
+
+sub _build_constructor_args {
+ return [];
+}
+
+sub add_by_key {
+ my $self = shift;
+ # we'll assume that add does the right thing. around this in subclasses
+ return $self->add(@_);
+}
+
+sub add {
+ my $self = shift;
+ my @members_added;
+ for my $member (@_) {
+ if (not defined $member) {
+ confess("Undefined member to add");
+ }
+ push @members_added,$member;
+ if ($self->exists($member)) {
+ next;
+ }
+ $self->_add($member);
+ $self->_add_member_hash($self->member_key($member),
+ $self->count()-1,
+ );
+ }
+ return @members_added;
+}
+
+use overload '+' => "combine",
+ '""' => "CARP_TRACE";
+
+sub combine {
+ my $self = shift;
+ my $return = $self->clone;
+ $return->add($_->members) for @_;
+ return $return;
+}
+
+sub get {
+ my $self = shift;
+ my @res = map {$self->_get_member($_)}
+ $self->_get_member_hash(@_);
+ wantarray?@res:$res[0];
+}
+
+
+sub member_key {
+ return $_[1];
+}
+
+sub keys_of_members {
+ my $self = shift;
+ return $self->map(sub {$self->member_key($_)});
+}
+
+sub exists {
+ my $self = shift;
+ return $self->_member_key_exists($self->member_key($_[0]));
+}
+
+sub join {
+ my $self = shift;
+ my $joiner = shift;
+ return CORE::join($joiner,$self->keys_of_members);
+}
+
+sub _build_member_hash {
+ my $self = shift;
+ my $hash = {};
+ my $i = 0;
+ for my $member ($self->members) {
+ $hash->{$self->member_key($member)} =
+ $i++;
+ }
+ return $hash;
+}
+
+sub CARP_TRACE {
+ my $self = shift;
+ my @members = $self->members;
+ if (@members > 5) {
+ @members = map {$self->member_key($_)}
+ @members[0..4];
+ push @members,'...';
+ } else {
+ @members = map {$self->member_key($_)} @members;
+ }
+ return __PACKAGE__.'={n_members='.$self->count().
+ ',members=('.CORE::join(',',@members).')}';
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
projects / debbugs.git / blobdiff