File Coverage

blib/lib/Software/Copyright/Owner.pm
Criterion Covered Total %
statement 46 46 100.0
branch 6 6 100.0
condition 5 7 71.4
subroutine 11 11 100.0
pod 3 3 100.0
total 71 73 97.2


line stmt bran cond sub pod time code
1             #
2             # This file is part of Software-Copyright
3             #
4             # This software is Copyright (c) 2022 by Dominique Dumont <dod@debian.org>.
5             #
6             # This is free software, licensed under:
7             #
8             # The GNU General Public License, Version 3, June 2007
9             #
10             package Software::Copyright::Owner;
11             $Software::Copyright::Owner::VERSION = '0.011';
12 4     4   758 use warnings;
  4         9  
  4         134  
13 4     4   48 use 5.20.0;
  4         14  
14 4     4   1366 use utf8;
  4         35  
  4         38  
15 4     4   1426 use Unicode::Normalize;
  4         4673  
  4         283  
16              
17 4     4   537 use Mouse;
  4         30384  
  4         25  
18              
19 4     4   1544 use feature qw/postderef signatures/;
  4         10  
  4         561  
20 4     4   37 no warnings qw/experimental::postderef experimental::signatures/;
  4         27  
  4         231  
21              
22 4     4   38 use overload '""' => \&stringify;
  4         9  
  4         46  
23              
24             has name => (
25             is => 'rw',
26             isa => 'Str',
27             );
28              
29             has record => (
30             is => 'rw',
31             isa => 'Str',
32             );
33              
34             has email => (
35             is => 'rw',
36             isa => 'Str',
37             predicate => 'has_email',
38             );
39              
40             around BUILDARGS => sub ($orig, $class, @args) {
41             my $params = { } ;
42              
43             # detect garbage in string argument
44             if ($args[0] !~ /^[[:alpha:]]/) {
45             # don't try to be smart, keep the record as is: garbage in, garbage out
46             $params->{record} = $args[0];
47             }
48             elsif ($args[0] =~ /\b(and|,)\b/) {
49             # combined records, do not try to extract name and email.
50             $params->{record} = NFC($args[0]);
51             }
52             elsif ($args[0] =~ /([^<]+)<([^>]+)>$/) {
53             # see https://www.unicode.org/faq/normalization.html
54             $params->{name} = NFC($1);
55             $params->{email} = $2;
56             }
57             else {
58             $params->{name} = NFC($args[0]);
59             }
60             return $class->$orig($params) ;
61             };
62              
63 151     151 1 279 sub BUILD ($self, $args) {
  151         210  
  151         212  
  151         197  
64 151         361 my $name = $self->name;
65 151 100       364 if (defined $name) {
66 130         578 $name =~ s/\s+$//;
67 130         328 $name =~ s/^\s+//;
68 130         336 $self->name($name);
69             }
70 151         778 return;
71             }
72              
73 285     285 1 1252 sub identifier ($self) {
  285         415  
  285         369  
74 285   100     1551 return $self->name // $self->record // '';
      50        
75             }
76              
77 449     449 1 3183 sub stringify ($self, $=1, $=1) {
  449         625  
  449         631  
  449         561  
  449         640  
78 449 100       1065 if (my $str = $self->name) {
79 428 100       1363 $str .= " <".$self->email.">" if $self->has_email;
80 428         2164 return $str;
81             }
82             else {
83 21   50     197 return $self->record // '';
84             }
85             }
86              
87             1;
88              
89             # ABSTRACT: Copyright owner class
90              
91             __END__
92              
93             =pod
94              
95             =encoding UTF-8
96              
97             =head1 NAME
98              
99             Software::Copyright::Owner - Copyright owner class
100              
101             =head1 VERSION
102              
103             version 0.011
104              
105             =head1 SYNOPSIS
106              
107             use Software::Copyright::Owner;
108              
109             # one owner
110             my $owner = Software::Copyright::Owner->new('Joe <joe@example.com>');
111              
112             $owner->name; # => is "Joe"
113             $owner->email; # => is 'joe@example.com'
114             $owner->identifier; # => is 'Joe'
115              
116             # stringification
117             my $s = "$owner"; # => is 'Joe <joe@example.com>'
118              
119             # several owners, separated by "and" or ","
120             my $owner2 = Software::Copyright::Owner->new('Joe <joe@example.com>, William, Jack and Averell');
121              
122             $owner2->name; # => is undef
123             $owner2->email; # => is undef
124             $owner2->record; # => is 'Joe <joe@example.com>, William, Jack and Averell'
125             $owner2->identifier; # => is 'Joe <joe@example.com>, William, Jack and Averell'
126              
127             # stringification
128             $s = "$owner2"; # => is 'Joe <joe@example.com>, William, Jack and Averell'
129              
130             =head1 DESCRIPTION
131              
132             This class holds the name and email of a copyright holder.
133              
134             =head1 CONSTRUCTOR
135              
136             The constructor can be called without argument or with a string
137             containing a name and an optional email address. E.g:
138              
139             my $owner = Software::Copyright::Owner->new();
140             my $owner = Software::Copyright::Owner->new('Joe');
141             my $owner = Software::Copyright::Owner->new('Joe <joe@example.com>');
142              
143             It can also be called with copyright assignment involving more than
144             one person. See synopsis for details.
145              
146             =head1 Methods
147              
148             =head2 name
149              
150             Set or get owner's name. Note that names with Unicode characters are
151             normalized to Canonical Composition (NFC). Name can be empty when the
152             copyright owners has more that one name (i.e. C<John Doe and Jane
153             Doe>) or if the string passed to C<new()> contains unexpected
154             information (like a year).
155              
156             =head2 record
157              
158             Set or get the record of a copyright. The record is set by constructor
159             when the owner contains more than one name or if the owner contains
160             unexpected information.
161              
162             =head2 identifier
163              
164             Returns C<name> or C<record>.
165              
166             =head2 email
167              
168             Set or get owner's email
169              
170             =head2 stringify
171              
172             Returns a string containing name (or record) and email (if any) of the copyright
173             owner.
174              
175             =head2 Operator overload
176              
177             Operator C<""> is overloaded to call C<stringify>.
178              
179             =head1 AUTHOR
180              
181             Dominique Dumont
182              
183             =head1 COPYRIGHT AND LICENSE
184              
185             This software is Copyright (c) 2022 by Dominique Dumont <dod@debian.org>.
186              
187             This is free software, licensed under:
188              
189             The GNU General Public License, Version 3, June 2007
190              
191             =cut