X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCollection.pm;h=6e3d49d95ed9e30f3caca34035cb527be0a89e52;hb=cfd7a8f2d3990c8fbc8bb8012d99fdc467c46300;hp=ee478c6e6110026172d7971a2da374383378cf2e;hpb=0e16a5214d3617d0df54712869b2da0f3c64fcdb;p=debbugs.git diff --git a/Debbugs/Collection.pm b/Debbugs/Collection.pm index ee478c6..6e3d49d 100644 --- a/Debbugs/Collection.pm +++ b/Debbugs/Collection.pm @@ -12,6 +12,8 @@ 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 @@ -22,38 +24,186 @@ Debbugs::Collection -- Collection base class which can generate lots of objects 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', - apply => 'apply', + 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 => 'ro', - isa => 'HashRef[Int]', + 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', - handles => {_add_member_hash => 'set', + 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, @@ -67,27 +217,45 @@ sub _build_universe { 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->clone(); + my $limit = $self->_shallow_clone(); # Set the universe to whatever my universe is (potentially myself) - $limit->_set_universe($self->universe); - $limit->_set_members(); + # $limit->_set_universe($self->universe); + $limit->_set_members([]); $limit->_clear_member_hash(); - $limit->add($self->universe->get_or_create(@_)); + $limit->add($self->universe->get_or_add_by_key(@_)) if @_; return $limit; } -sub get_or_create { +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 - if (blessed($_[$i])) { - $return[$i] = - $_[$i]; + # 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; @@ -96,18 +264,32 @@ sub get_or_create { } } # create and add by key - @return[@need_to_add] = - $self->add_by_key(@_[@need_to_add]); - @return[@exists] = - $self->get(@_[@exists]); + 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', - default => sub {[]}, + 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 @@ -116,23 +298,38 @@ sub add_by_key { sub add { my $self = shift; - my @members_to_add; + 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(), + $self->count()-1, ); } - $self->_add(@members_to_add); - return @members_to_add; + 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; - return $self->_get_member($self->_get_member_hash(@_)); + my @res = map {$self->_get_member($_)} + $self->_get_member_hash(@_); + wantarray?@res:$res[0]; } @@ -140,11 +337,22 @@ 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 = {}; @@ -156,8 +364,23 @@ sub _build_member_hash { return $hash; } -__PACKAGE__->meta->make_immutable; +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__