X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCollection.pm;h=cbfd56b31eb8dbb283fdcefbabe1f5372c8e8e1a;hb=78d0e4e290ccf88f7a7c968ffb2527ad7f6b9463;hp=a18cd8343de6aadadf70abe939c63c8e5015e8e1;hpb=29ffae11e29d83a96d53c5825e876914e4ac7aa7;p=debbugs.git

diff --git a/Debbugs/Collection.pm b/Debbugs/Collection.pm
index a18cd83..cbfd56b 100644
--- a/Debbugs/Collection.pm
+++ b/Debbugs/Collection.pm
@@ -22,6 +22,7 @@ Debbugs::Collection -- Collection base class which can generate lots of objects
 use Mouse;
 use strictures 2;
 use namespace::autoclean;
+use List::AllUtils qw(pairmap);
 
 extends 'Debbugs::OOBase';
 
@@ -49,19 +50,40 @@ 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];
+}
+
 has 'universe' => (is => 'ro',
                    isa => 'Debbugs::Collection',
                    required => 1,
@@ -87,9 +109,14 @@ 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([]);
@@ -135,9 +162,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