From 2348614dbfe7e611aabc50ee31561d2f2e702e82 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Thu, 7 Jun 2018 15:34:21 -0700 Subject: [PATCH] add collection and collection correspondent --- Debbugs/Collection/Correspondent.pm | 103 ++++++++++++++++++++++++++++ Debbugs/Correspondent.pm | 91 ++++++++++++++++++++++++ 2 files changed, 194 insertions(+) create mode 100644 Debbugs/Collection/Correspondent.pm create mode 100644 Debbugs/Correspondent.pm diff --git a/Debbugs/Collection/Correspondent.pm b/Debbugs/Collection/Correspondent.pm new file mode 100644 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 . + +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 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 . + +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: -- 2.39.2