add collection and collection correspondent

diff --git a/Debbugs/Collection/Correspondent.pm b/Debbugs/Collection/Correspondent.pm
new file mode 100644 (file)
index 0000000..76a386f
--- /dev/null
+++ b/Debbugs/Collection/Correspondent.pm
@@ -0,0 +1,103 @@
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Collection::Correspondent;
+
+=head1 NAME
+
+Debbugs::Collection::Correspondent -- Bug generation factory
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::autoclean;
+use Debbugs::Common qw(make_list hash_slice);
+use Debbugs::OOTypes;
+use Debbugs::Status qw(get_bug_statuses);
+
+use Debbugs::Correspondent;
+
+extends 'Debbugs::Collection';
+
+has '+members' => (isa => 'ArrayRef[Debbugs::Correspondent]');
+
+around BUILDARGS => sub {
+    my $orig = shift;
+    my $class = shift;
+
+    my %args;
+    if (@_==1 and ref($_[0]) eq 'HASH') {
+        %args = %{$_[0]};
+    } else {
+        %args = @_;
+    }
+    $args{members} //= [];
+    if (exists $args{correspondent}) {
+        push @{$args{members}},
+            _member_constructor(correspondent => $args{correspondent},
+                                hash_slice(%args,qw(schema constructor_args)),
+                               );
+        delete $args{bugs};
+    }
+    return $class->$orig(%args);
+};
+
+sub _member_constructor {
+    # handle being called $self->_member_constructor;
+    my $self;
+    if ((@_ % 2) == 1) {
+        $self = shift;
+    }
+    my %args = @_;
+    my @return;
+    my $schema;
+    if (exists $args{schema}) {
+        $schema = $args{schema};
+    } elsif (defined $self and $self->has_schema) {
+        $schema = $self->schema;
+    }
+    for my $corr (make_list($args{correspondent})) {
+       push @return,
+           Debbugs::Correspondent->new(name => $corr,
+                                       defined $schema?(schema => $schema):(),
+                                      );
+    }
+    return @return;
+}
+
+around add_by_key => sub {
+    my $orig = shift;
+    my $self = shift;
+    my @members =
+        _member_constructor(correspondent => [@_],
+                            $self->has_schema?(schema => $self->schema):(),
+                            constructor_args => $self->constructor_args,
+                           );
+    return $self->$orig(@members);
+};
+
+sub member_key {
+    return $_[1]->name;
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:

diff --git a/Debbugs/Correspondent.pm b/Debbugs/Correspondent.pm
new file mode 100644 (file)
index 0000000..bb07504
--- /dev/null
+++ b/Debbugs/Correspondent.pm
@@ -0,0 +1,91 @@
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Correspondent;
+
+=head1 NAME
+
+Debbugs::Correspondent -- OO interface to bugs
+
+=head1 SYNOPSIS
+
+   use Debbugs::Correspondent;
+   Debbugs::Correspondent->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::clean;
+use v5.10; # for state
+
+use Mail::Address;
+use Debbugs::OOTypes;
+use Debbugs::Config qw(:config);
+
+use Carp;
+
+extends 'Debbugs::OOBase';
+
+has name => (is => 'ro', isa => 'Str',
+            required => 1,
+            writer => '_set_name',
+           );
+
+has _mail_address => (is => 'bare', isa => 'Mail::Address',
+                     lazy => 1,
+                     handles => [qw(address phrase comment)],
+                     builder => '_build_mail_address',
+                    );
+
+sub _build_mail_address {
+    my @addr = Mail::Address->parse($_[0]->name) or
+       confess("unable to parse mail address");
+    if (@addr > 1) {
+       warn("Multiple addresses to Debbugs::Correspondent");
+    }
+    return $addr[0];
+}
+
+sub email {
+    my $email = $_[0]->address;
+    warn "No email" unless defined $email;
+    return $email;
+}
+
+sub url {
+    my $self = shift;
+    return $config{web_domain}.'/correspondent:'.$self->email;
+}
+
+sub maintainer_url {
+    my $self = shift;
+    return $config{web_domain}.'/maintainer:'.$self->email;
+}
+
+sub owner_url {
+    my $self = shift;
+    return $config{web_domain}.'/owner:'.$self->email;
+}
+
+sub submitter_url {
+    my $self = shift;
+    return $config{web_domain}.'/submitter:'.$self->email;
+}
+
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End: