Debbugs/Collection/Correspondent.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::Correspondent;
   8
   9 =head1 NAME
  10
  11 Debbugs::Collection::Correspondent -- Bug generation factory
  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 use Debbugs::Common qw(make_list hash_slice);
  26 use Debbugs::OOTypes;
  27 use Debbugs::Status qw(get_bug_statuses);
  28
  29 use Debbugs::Correspondent;
  30
  31 extends 'Debbugs::Collection';
  32
  33 has '+members' => (isa => 'ArrayRef[Debbugs::Correspondent]');
  34
  35 around BUILDARGS => sub {
  36     my $orig = shift;
  37     my $class = shift;
  38
  39     my %args;
  40     if (@_==1 and ref($_[0]) eq 'HASH') {
  41         %args = %{$_[0]};
  42     } else {
  43         %args = @_;
  44     }
  45     $args{members} //= [];
  46     if (exists $args{correspondent}) {
  47         push @{$args{members}},
  48             _member_constructor(correspondent => $args{correspondent},
  49                                 hash_slice(%args,qw(schema constructor_args)),
  50                                );
  51         delete $args{bugs};
  52     }
  53     return $class->$orig(%args);
  54 };
  55
  56 sub _member_constructor {
  57     # handle being called $self->_member_constructor;
  58     my $self;
  59     if ((@_ % 2) == 1) {
  60         $self = shift;
  61     }
  62     my %args = @_;
  63     my @return;
  64     my $schema;
  65     if (exists $args{schema}) {
  66         $schema = $args{schema};
  67     } elsif (defined $self and $self->has_schema) {
  68         $schema = $self->schema;
  69     }
  70     for my $corr (make_list($args{correspondent})) {
  71         push @return,
  72             Debbugs::Correspondent->new(name => $corr,
  73                                         defined $schema?(schema => $schema):(),
  74                                        );
  75     }
  76     return @return;
  77 }
  78
  79 around add_by_key => sub {
  80     my $orig = shift;
  81     my $self = shift;
  82     my @members =
  83         _member_constructor(correspondent => [@_],
  84                             $self->has_schema?(schema => $self->schema):(),
  85                             constructor_args => $self->constructor_args,
  86                            );
  87     return $self->$orig(@members);
  88 };
  89
  90 sub member_key {
  91     return $_[1]->name;
  92 }
  93
  94
  95 __PACKAGE__->meta->make_immutable;
  96
  97 1;
  98
  99 __END__
 100 # Local Variables:
 101 # indent-tabs-mode: nil
 102 # cperl-indent-level: 4
 103 # End: