Debbugs/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::Correspondent;
   8
   9 =head1 NAME
  10
  11 Debbugs::Correspondent -- OO interface to bugs
  12
  13 =head1 SYNOPSIS
  14
  15    use Debbugs::Correspondent;
  16    Debbugs::Correspondent->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
  17
  18 =head1 DESCRIPTION
  19
  20
  21
  22 =cut
  23
  24 use Mouse;
  25 use strictures 2;
  26 use namespace::clean;
  27 use v5.10; # for state
  28
  29 use Mail::Address;
  30 use Debbugs::OOTypes;
  31 use Debbugs::Config qw(:config);
  32
  33 use Carp;
  34
  35 extends 'Debbugs::OOBase';
  36
  37 has name => (is => 'ro', isa => 'Str',
  38              required => 1,
  39              writer => '_set_name',
  40             );
  41
  42 has _mail_address => (is => 'bare', isa => 'Mail::Address',
  43                       lazy => 1,
  44                       handles => [qw(address phrase comment)],
  45                       builder => '_build_mail_address',
  46                      );
  47
  48 sub _build_mail_address {
  49     my @addr = Mail::Address->parse($_[0]->name) or
  50         confess("unable to parse mail address");
  51     if (@addr > 1) {
  52         warn("Multiple addresses to Debbugs::Correspondent");
  53     }
  54     return $addr[0];
  55 }
  56
  57 sub email {
  58     my $email = $_[0]->address;
  59     warn "No email" unless defined $email;
  60     return $email;
  61 }
  62
  63 sub url {
  64     my $self = shift;
  65     return $config{web_domain}.'/correspondent:'.$self->email;
  66 }
  67
  68 sub maintainer_url {
  69     my $self = shift;
  70     return $config{web_domain}.'/maintainer:'.$self->email;
  71 }
  72
  73 sub owner_url {
  74     my $self = shift;
  75     return $config{web_domain}.'/owner:'.$self->email;
  76 }
  77
  78 sub submitter_url {
  79     my $self = shift;
  80     return $config{web_domain}.'/submitter:'.$self->email;
  81 }
  82
  83 sub CARP_TRACE {
  84     my $self = shift;
  85     return 'Debbugs::Correspondent={name='.$self->name.'}';
  86 }
  87
  88
  89 __PACKAGE__->meta->make_immutable;
  90
  91 no Mouse;
  92 1;
  93
  94
  95 __END__
  96 # Local Variables:
  97 # indent-tabs-mode: nil
  98 # cperl-indent-level: 4
  99 # End: