X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCollection.pm;h=552c0f391068b2ea3296f09982973b47c0460f14;hb=88426d7018c2471de7f2dc1964c3eda3fe45b9c7;hp=a18cd8343de6aadadf70abe939c63c8e5015e8e1;hpb=29ffae11e29d83a96d53c5825e876914e4ac7aa7;p=debbugs.git diff --git a/Debbugs/Collection.pm b/Debbugs/Collection.pm index a18cd83..552c0f3 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,9 +24,103 @@ 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 + +=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->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}) $collection->map({$_*2}) + +Return the list of applying BLOCK to each member + +=head2 $collection->sort({$a <=> $b}) + +Return the list of members sorted by BLOCK + +=cut + has 'members' => (is => 'bare', isa => 'ArrayRef', traits => ['Array'], @@ -49,19 +145,45 @@ sub members_ref { has 'member_hash' => (traits => ['Hash'], is => 'bare', - isa => 'HashRef[Int]', + # 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', + 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, @@ -87,28 +209,33 @@ sub clone { 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->_clear_member_hash(); - $limit->add($self->universe->get_or_create(@_)) if @_; + $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; @@ -135,9 +262,14 @@ sub get_or_create { 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 @@ -165,7 +297,9 @@ sub add { 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]; } @@ -173,11 +307,22 @@ sub member_key { return $_[1]; } +sub keys_of_members { + my $self = shift; + return $self->map(sub {$self->member_key($_[0])}); +} + 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 = {}; @@ -191,7 +336,16 @@ sub _build_member_hash { sub CARP_TRACE { my $self = shift; - return 'Debbugs::Collection={n_members='.$self->count().'}'; + 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).')}'; }