File Coverage

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


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.010';
12 4     4   780 use warnings;
  4         10  
  4         138  
13 4     4   57 use 5.20.0;
  4         17  
14 4     4   1277 use utf8;
  4         35  
  4         26  
15 4     4   1321 use Unicode::Normalize;
  4         4457  
  4         293  
16              
17 4     4   556 use Mouse;
  4         29661  
  4         23  
18              
19 4     4   1569 use feature qw/postderef signatures/;
  4         9  
  4         505  
20 4     4   41 no warnings qw/experimental::postderef experimental::signatures/;
  4         21  
  4         227  
21              
22 4     4   49 use overload '""' => \&stringify;
  4         9  
  4         42  
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             return $class->$orig() unless $args[0] =~ /^[[:alpha:]]/;
44              
45             if ($args[0] =~ /\b(and|,)\b/) {
46             # combined records, do not try to extract name and email.
47             $params->{record} = NFC($args[0]);
48             }
49             elsif ($args[0] =~ /([^<]+)<([^>]+)>$/) {
50             # see https://www.unicode.org/faq/normalization.html
51             $params->{name} = NFC($1);
52             $params->{email} = $2;
53             }
54             else {
55             $params->{name} = NFC($args[0]);
56             }
57             return $class->$orig($params) ;
58             };
59              
60 148     148 1 259 sub BUILD ($self, $args) {
  148         238  
  148         191  
  148         193  
61 148         345 my $name = $self->name;
62 148 100       322 if (defined $name) {
63 127         568 $name =~ s/\s+$//;
64 127         317 $name =~ s/^\s+//;
65 127         313 $self->name($name);
66             }
67 148         729 return;
68             }
69              
70 275     275 1 1197 sub identifier ($self) {
  275         386  
  275         389  
71 275   100     1453 return $self->name // $self->record // '';
      100        
72             }
73              
74 443     443 1 1952 sub stringify ($self, $=1, $=1) {
  443         558  
  443         539  
  443         606  
  443         582  
75 443 100       946 if (my $str = $self->name) {
76 423 100       1195 $str .= " <".$self->email.">" if $self->has_email;
77 423         2070 return $str;
78             }
79             else {
80 20   100     232 return $self->record // '';
81             }
82             }
83              
84             1;
85              
86             # ABSTRACT: Copyright owner class
87              
88             __END__
89              
90             =pod
91              
92             =encoding UTF-8
93              
94             =head1 NAME
95              
96             Software::Copyright::Owner - Copyright owner class
97              
98             =head1 VERSION
99              
100             version 0.010
101              
102             =head1 SYNOPSIS
103              
104             use Software::Copyright::Owner;
105              
106             # one owner
107             my $owner = Software::Copyright::Owner->new('Joe <joe@example.com>');
108              
109             $owner->name; # => is "Joe"
110             $owner->email; # => is 'joe@example.com'
111             $owner->identifier; # => is 'Joe'
112              
113             # stringification
114             my $s = "$owner"; # => is 'Joe <joe@example.com>'
115              
116             # several owners, separated by "and" or ","
117             my $owner2 = Software::Copyright::Owner->new('Joe <joe@example.com>, William, Jack and Averell');
118              
119             $owner2->name; # => is undef
120             $owner2->email; # => is undef
121             $owner2->record; # => is 'Joe <joe@example.com>, William, Jack and Averell'
122             $owner2->identifier; # => is 'Joe <joe@example.com>, William, Jack and Averell'
123              
124             # stringification
125             $s = "$owner2"; # => is 'Joe <joe@example.com>, William, Jack and Averell'
126              
127             =head1 DESCRIPTION
128              
129             This class holds the name and email of a copyright holder.
130              
131             =head1 CONSTRUCTOR
132              
133             The constructor can be called without argument or with a string
134             containing a name and an optional email address. E.g:
135              
136             my $owner = Software::Copyright::Owner->new();
137             my $owner = Software::Copyright::Owner->new('Joe');
138             my $owner = Software::Copyright::Owner->new('Joe <joe@example.com>');
139              
140             It can also be called with copyright assignment involving more than
141             one person. See synopsis for details.
142              
143             =head1 Methods
144              
145             =head2 name
146              
147             Set or get owner's name. Note that names with Unicode characters are
148             normalized to Canonical Composition (NFC). Name can be empty when the
149             copyright owners has more that one name (i.e. C<John Doe and Jane Doe>.
150              
151             =head2 record
152              
153             Set or get the record of a copyright. The record is set by constructor
154             when the owner contains more than one name.
155              
156             =head2 identifier
157              
158             Returns C<name> or C<record>.
159              
160             =head2 email
161              
162             Set or get owner's email
163              
164             =head2 stringify
165              
166             Returns a string containing name (or record) and email (if any) of the copyright
167             owner.
168              
169             =head2 Operator overload
170              
171             Operator C<""> is overloaded to call C<stringify>.
172              
173             =head1 AUTHOR
174              
175             Dominique Dumont
176              
177             =head1 COPYRIGHT AND LICENSE
178              
179             This software is Copyright (c) 2022 by Dominique Dumont <dod@debian.org>.
180              
181             This is free software, licensed under:
182              
183             The GNU General Public License, Version 3, June 2007
184              
185             =cut