Debbugs/Collection.pm

   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
   4 # information.
   5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
   6
   7 package Debbugs::Collection;
   8
   9 =head1 NAME
  10
  11 Debbugs::Collection -- Collection base class which can generate lots of objects
  12
  13 =head1 SYNOPSIS
  14
  15
  16 =head1 DESCRIPTION
  17
  18
  19
  20 =cut
  21
  22 use Mouse;
  23 use strictures 2;
  24 use namespace::autoclean;
  25
  26 extends 'Debbugs::OOBase';
  27
  28 has 'members' => (is => 'bare',
  29                   isa => 'ArrayRef',
  30                   traits => ['Array'],
  31                   default => sub {[]},
  32                   writer => '_set_members',
  33                   handles => {_add => 'push',
  34                               members => 'elements',
  35                               count => 'count',
  36                               _get_member => 'get',
  37                               grep => 'grep',
  38                               apply => 'apply',
  39                               sort => 'sort',
  40                              },
  41                  );
  42
  43 has 'member_hash' => (traits => ['Hash'],
  44                       is => 'ro',
  45                       isa => 'HashRef[Int]',
  46                       lazy => 1,
  47                       reader => '_member_hash',
  48                       builder => '_build_member_hash',
  49                       clearer => '_clear_member_hash',
  50                       predicate => '_has_member_hash',
  51                       handles => {_add_member_hash => 'set',
  52                                   _member_key_exists => 'exists',
  53                                   _get_member_hash => 'get',
  54                                  },
  55                      );
  56
  57 has 'universe' => (is => 'ro',
  58                    isa => 'Debbugs::Collection',
  59                    required => 1,
  60                    builder => '_build_universe',
  61                    writer => '_set_universe',
  62                    predicate => 'has_universe',
  63                   );
  64
  65 sub _build_universe {
  66     # By default, the universe is myself
  67     return $_[0];
  68 }
  69
  70 sub limit {
  71     my $self = shift;
  72     my $limit = $self->clone();
  73     # Set the universe to whatever my universe is (potentially myself)
  74     $limit->_set_universe($self->universe);
  75     $limit->_set_members();
  76     $limit->_clear_member_hash();
  77     $limit->add($self->universe->get_or_create(@_));
  78     return $limit;
  79 }
  80
  81 sub get_or_create {
  82     my $self = shift;
  83     my @return;
  84     my @exists;
  85     my @need_to_add;
  86     for my $i (0..$#_) {
  87         # we assume that if it's already a blessed reference, that it's the right
  88         if (blessed($_[$i])) {
  89             $return[$i] =
  90                 $_[$i];
  91         }
  92         elsif ($self->_member_key_exists($_[$i])) {
  93             push @exists,$i;
  94         } else {
  95             push @need_to_add,$i;
  96         }
  97     }
  98     # create and add by key
  99     @return[@need_to_add] =
 100         $self->add_by_key(@_[@need_to_add]);
 101     @return[@exists] =
 102         $self->get(@_[@exists]);
 103     return @return;
 104 }
 105
 106 has 'constructor_args' => (is => 'rw',
 107                            isa => 'ArrayRef',
 108                            default => sub {[]},
 109                           );
 110
 111 sub add_by_key {
 112     my $self = shift;
 113     # we'll assume that add does the right thing. around this in subclasses
 114     return $self->add(@_);
 115 }
 116
 117 sub add {
 118     my $self = shift;
 119     my @members_to_add;
 120     for my $member (@_) {
 121         if ($self->exists($member)) {
 122             next;
 123         }
 124         $self->_add($member);
 125         $self->_add_member_hash($self->member_key($member),
 126                                 $self->count(),
 127                                );
 128     }
 129     $self->_add(@members_to_add);
 130     return @members_to_add;
 131 }
 132
 133 sub get {
 134     my $self = shift;
 135     return $self->_get_member($self->_get_member_hash(@_));
 136 }
 137
 138
 139 sub member_key {
 140     return $_[1];
 141 }
 142
 143 sub exists {
 144     my $self = shift;
 145     return $self->_member_key_exists($self->member_key($_[0]));
 146 }
 147
 148 sub _build_member_hash {
 149     my $self = shift;
 150     my $hash = {};
 151     my $i = 0;
 152     for my $member ($self->members) {
 153         $hash->{$self->member_key($member)} =
 154             $i++;
 155     }
 156     return $hash;
 157 }
 158
 159 __PACKAGE__->meta->make_immutable;
 160
 161 1;
 162
 163 __END__
 164 # Local Variables:
 165 # indent-tabs-mode: nil
 166 # cperl-indent-level: 4
 167 # End: