pax_global_header00006660000000000000000000000064147742457270014535gustar00rootroot0000000000000052 comment=43cdb2903f72bacc88bb885fe302bed88a24a90e libsoftware-copyright-perl-0.015/000077500000000000000000000000001477424572700170315ustar00rootroot00000000000000libsoftware-copyright-perl-0.015/.gitignore000066400000000000000000000000341477424572700210160ustar00rootroot00000000000000Software-Copyright-* .build libsoftware-copyright-perl-0.015/Changes000066400000000000000000000024521477424572700203270ustar00rootroot00000000000000{{$NEXT}} 0.015 2025-04-05 * fix Software::Copyright:_create_or_merge function (Debian bug #1101987) 0.014 2024-12-23 * handle copyright year range like 2011-.. or 2023-20** 0.013 2024-01-13 * Fix test crash on older perl 0.012 2023-09-27 * refine copyright cleanup 0.011 2023-09-24 * ensure garbage in, garbage out mode (Debian #1052168) * improve statement cleanup 0.010 2023-06-15 * reduce verbosity of invalid year range warning 0.009 2023-05-25 * fix compat wih with < 5.028 0.008 2023-05-24 * clean copyright: also cleanup (C) * handle copyright specified with full date * add missing use Time::localtime 0.007 2022-12-30 * Fix test failure on perl 5.20 0.006 2022-12-29 * Copyright: add contains method 0.005 2022-11-11 * Copyright: handle statements that contain only year information * Copyright::Statement: * add add_years method * merge method now returns $self * handle statements that contain only year information 0.004 2022-08-11 * dist.ini: removed unused plugin 0.003 2022-07-25 * add missing MouseX::NativeTraits dependency 0.002 2022-07-23 * all tests: require module before testing synopsis (HEAD -> main) * Copyright: quote subtype 0.001 2022-07-22 * Initial release libsoftware-copyright-perl-0.015/README.org000066400000000000000000000013021477424572700204730ustar00rootroot00000000000000* Software::Copyright Perl module ** Description This class holds a copyright statement, i.e. a set of year range, name and email. On construction, a cleanup is done to make the statements more standard. Here are some cleanup examples: | Before | After | |-------------------------+----------------| | 2002-6 Joe | 2002-2006, Joe | | 2001,2002,2003,2004 Joe | 2001-2004, Joe | The constructor is also compatible with the string given by Debian's [[https://manpages.debian.org/licensecheck/licensecheck.1p.en.html][licensecheck]], i.e. the statements can be separated by "=/=". See [[file:lib/Software/Copyright.pm][Software::Copyright]] doc for more details. libsoftware-copyright-perl-0.015/dist.ini000066400000000000000000000022371477424572700205010ustar00rootroot00000000000000name = Software-Copyright author = Dominique Dumont license = GPL_3 copyright_holder = Dominique Dumont copyright_year = 2022 [MetaResources] homepage = https://gitlab.com/ddumont/software-copyright.git bugtracker.mailto = ddumont at cpan.org bugtracker.web = https://gitlab.com/ddumont/software-copyright/-/issues repository.url = https://gitlab.com/ddumont/software-copyright.git repository.web = https://gitlab.com/ddumont/software-copyright.git repository.type = git [Prereqs] perl = 5.020 [AutoPrereqs] [MetaJSON] [NextRelease] format = %v%T %{yyyy-MM-dd}d ; use 'V=2.234 dzil release' to override version number [Git::NextVersion] [Git::Check] allow_dirty = dist.ini allow_dirty = Changes [Git::Commit] [Git::Tag] [Git::Push] ; github push_to = upstream ; debian push_to = origin [@Filter] -bundle = @Basic -remove = Readme -remove = MakeMaker -remove = ExtraTests [ModuleBuild] mb_version = 0.34 [Test::PodSpelling] ; must come after Test::PodSpelling, see its man page [ExtraTests] [PkgVersion] [PodSyntaxTests] [PodWeaver] [Prepender] ;-- see https://metacpan.org/pod/Dist::Zilla::Plugin::Signature [Signature] libsoftware-copyright-perl-0.015/lib/000077500000000000000000000000001477424572700175775ustar00rootroot00000000000000libsoftware-copyright-perl-0.015/lib/Software/000077500000000000000000000000001477424572700213715ustar00rootroot00000000000000libsoftware-copyright-perl-0.015/lib/Software/Copyright.pm000066400000000000000000000140571477424572700237060ustar00rootroot00000000000000package Software::Copyright; use 5.20.0; use warnings; use utf8; use Unicode::Normalize; use Mouse; use Mouse::Util::TypeConstraints; use MouseX::NativeTraits; use Storable qw/dclone/; use Software::Copyright::Statement; use feature qw/postderef signatures/; no warnings qw/experimental::postderef experimental::signatures/; use overload '""' => \&stringify; use overload 'eq' => \&is_equal; use overload 'ne' => \&is_not_equal; sub _clean_copyright ($c) { # cut off everything after and including the first non-printable # (spare \n and \c though) $c =~ s![\x00-\x09\x0b\x0c\x0e\x1f].*!!; return $c; } sub _create_or_merge ($result, $c) { my $st = Software::Copyright::Statement->new($c); my $name = $st->name // ''; if ($result->{$name}) { $result->{$name}->merge($st); } elsif ($st->name) { $result->{$name} = $st; } elsif ($st->record) { $result->{$st->record} = $st; } else { $result->{unknown} = $st; } return; } subtype 'Copyright::Software::StatementHash' => as 'HashRef[Software::Copyright::Statement]'; coerce 'Copyright::Software::StatementHash' => from 'Str' => via { my $str = $_ ; my $result = {} ; my @year_only_data; my @data = split( m!(?:\s+/\s+)|(?:\s*\n\s*)!, $str); # split statement that can be licensecheck output or debfmt data foreach my $c ( @data ) { if ($c =~ /^[\d\s,.-]+$/) { push @year_only_data, $c; } else { # copyright contain letters, so hopefully some name _create_or_merge($result, $c); } } # year only data is dropped when other more significant data is # present (with names) if (@data eq @year_only_data) { # got only year data, save it. foreach my $c ( @data ) { _create_or_merge($result, $c); } } return $result; }; has statement_by_name => ( is => 'ro', coerce => 1, traits => ['Hash'], isa => 'Copyright::Software::StatementHash', default => sub { {} }, handles => { statement_list => 'values', owners => 'keys', statement => 'get', set_statement => 'set', }, required => 1, ); around BUILDARGS => sub ($orig, $class, @args) { my $str = _clean_copyright($args[0]); # cleanup $str =~ /^[\s\W]+|[\s\W]+$/g; return $class->$orig({ statement_by_name => $str, }) ; }; sub merge ($self, $input) { my $other = ref($input) ? $input : Software::Copyright->new($input); foreach my $owner ($other->owners) { my $from = $other->statement($owner); my $target = $self->statement($owner); if ($target) { $target->merge($from); } else { $self->set_statement($owner, dclone($from)); } } return; } sub stringify ($self, $=1, $=1) { return join("\n", reverse sort $self->statement_list); } sub is_equal ($self, $other, $=1) { return $self->stringify eq $other->stringify; } sub is_not_equal ($self, $other, $=1) { return $self->stringify ne $other->stringify; } sub is_valid ($self) { return (scalar grep {$_->name || $_->record } $self->statement_list) ? 1 : 0; } sub contains($self, $input) { my $other = ref($input) ? $input : Software::Copyright->new($input); my $result = 1 ; foreach my $other_owner ($other->owners) { my $other_st = $other->statement($other_owner); my $self_st = $self->statement($other_owner); if ($self_st) { $result &&= $self_st->contains($other_st); } else { $result = 0; } } return $result; } 1; # ABSTRACT: Copyright class __END__ =head1 SYNOPSIS use Software::Copyright; my $copyright = Software::Copyright->new('2020,2021, Joe '); # stringification my $s = "$copyright"; # => is "2020, 2021, Joe " # add with merge $copyright->merge('2018-2020 Averell'); # after addition $s = "$copyright"; # => is "2020, 2021, Joe \n2018-2020, Averell" # merge statement which adds email $copyright->merge('2016, Averell '); $s = "$copyright"; # => is "2020, 2021, Joe \n2016, 2018-2020, Averell " =head1 DESCRIPTION This class holds a copyright statement, i.e. a set of year range, name and email. =head1 CONSTRUCTOR The constructor is called with a copyright statement string. This string can be spread on several lines. The constructor is also compatible with the string given by Debian's L, i.e. the statements can be separated by "C". =head1 Methods =head2 statement Get the L object of a given user. =head2 statement_list Returns a list of L object for all users. =head2 stringify Returns a string containing a cleaned up copyright statement. =head2 is_valid Returns true if the copyright contains valid records, i.e. records with names. =head2 owners Return a list of statement owners. An owner is either a name or a record. =head2 statement Returns the L object for the given owner: my $statement = $copyright->statement('Joe Dalton'); =head2 merge Merge in a statement. This statement is either merged with a existing statement when the owner match or appended to the list of statements. The statement parameter can either be a string or an L object. =head2 contains Return 1 if the other copyright is contained in current copyright, i.e. all other statements are contained in current statements (See L for details on statement containment). For instance: =over =item * C<2016, Joe> copyright is contained in C<2014-2020, Joe> copyright. =item * C<2016, Joe> is contained in C<2014-2020, Joe / 2019, Jack> =item * C<2010, Joe> is B contained in C<2014-2020, Joe> =back =head1 Operator overload Operator C<"">, C and C are overloaded. =head1 See also L, L =cut libsoftware-copyright-perl-0.015/lib/Software/Copyright/000077500000000000000000000000001477424572700233415ustar00rootroot00000000000000libsoftware-copyright-perl-0.015/lib/Software/Copyright/Owner.pm000066400000000000000000000072071477424572700247770ustar00rootroot00000000000000package Software::Copyright::Owner; use warnings; use 5.20.0; use utf8; use Unicode::Normalize; use Mouse; use feature qw/postderef signatures/; no warnings qw/experimental::postderef experimental::signatures/; use overload '""' => \&stringify; has name => ( is => 'rw', isa => 'Str', ); has record => ( is => 'rw', isa => 'Str', ); has email => ( is => 'rw', isa => 'Str', predicate => 'has_email', ); around BUILDARGS => sub ($orig, $class, @args) { my $params = { } ; # detect garbage in string argument if ($args[0] !~ /^[[:alpha:]]/) { # don't try to be smart, keep the record as is: garbage in, garbage out $params->{record} = $args[0]; } elsif ($args[0] =~ /\b(and|,)\b/) { # combined records, do not try to extract name and email. $params->{record} = NFC($args[0]); } elsif ($args[0] =~ /([^<]+)<([^>]+)>$/) { # see https://www.unicode.org/faq/normalization.html $params->{name} = NFC($1); $params->{email} = $2; } else { $params->{name} = NFC($args[0]); } return $class->$orig($params) ; }; sub BUILD ($self, $args) { my $name = $self->name; if (defined $name) { $name =~ s/\s+$//; $name =~ s/^\s+//; $self->name($name); } return; } sub identifier ($self) { return $self->name // $self->record // ''; } sub stringify ($self, $=1, $=1) { if (my $str = $self->name) { $str .= " <".$self->email.">" if $self->has_email; return $str; } else { return $self->record // ''; } } 1; # ABSTRACT: Copyright owner class __END__ =head1 SYNOPSIS use Software::Copyright::Owner; # one owner my $owner = Software::Copyright::Owner->new('Joe '); $owner->name; # => is "Joe" $owner->email; # => is 'joe@example.com' $owner->identifier; # => is 'Joe' # stringification my $s = "$owner"; # => is 'Joe ' # several owners, separated by "and" or "," my $owner2 = Software::Copyright::Owner->new('Joe , William, Jack and Averell'); $owner2->name; # => is undef $owner2->email; # => is undef $owner2->record; # => is 'Joe , William, Jack and Averell' $owner2->identifier; # => is 'Joe , William, Jack and Averell' # stringification $s = "$owner2"; # => is 'Joe , William, Jack and Averell' =head1 DESCRIPTION This class holds the name and email of a copyright holder. =head1 CONSTRUCTOR The constructor can be called without argument or with a string containing a name and an optional email address. E.g: my $owner = Software::Copyright::Owner->new(); my $owner = Software::Copyright::Owner->new('Joe'); my $owner = Software::Copyright::Owner->new('Joe '); It can also be called with copyright assignment involving more than one person. See synopsis for details. =head1 Methods =head2 name Set or get owner's name. Note that names with Unicode characters are normalized to Canonical Composition (NFC). Name can be empty when the copyright owners has more that one name (i.e. C) or if the string passed to C contains unexpected information (like a year). =head2 record Set or get the record of a copyright. The record is set by constructor when the owner contains more than one name or if the owner contains unexpected information. =head2 identifier Returns C or C. =head2 email Set or get owner's email =head2 stringify Returns a string containing name (or record) and email (if any) of the copyright owner. =head2 Operator overload Operator C<""> is overloaded to call C. =cut libsoftware-copyright-perl-0.015/lib/Software/Copyright/Statement.pm000066400000000000000000000171451477424572700256530ustar00rootroot00000000000000package Software::Copyright::Statement; use 5.20.0; use warnings; use Mouse; use Array::IntSpan; use Carp; use Software::Copyright::Owner; use Date::Parse; use Time::localtime; use feature qw/postderef signatures/; no warnings qw/experimental::postderef experimental::signatures/; use overload '""' => \&stringify; use overload 'cmp' => \&compare; use overload '==' => \&_equal; use overload 'eq' => \&_equal; has span => ( is => 'ro', isa => 'Array::IntSpan', required => 1 , # may be an empty span ); sub range ($self) { return scalar $self->span->get_range_list; } has owner => ( is => 'rw', isa => 'Software::Copyright::Owner', required => 1, handles => { map { $_ => $_ } qw/name email record identifier/ }, ); sub __clean_copyright ($c) { $c =~ s/^©\s*//g; $c =~ s/\(c\)\s*//gi; # remove space around dash between number (eg. 2003 - 2004 => 2003-2004) $c =~ s/(\d+)\s*-\s*(?=\d+)/$1-/g; # extract year from YY-MM-DD:hh:mm:ss format $c =~ s/(\d{2,4}-\d\d-\d{2,4})[:\d]*/my @r = strptime($1); $r[5]+1900/gex; # remove extra years inside range, e,g 2003- 2004- 2008 -> 2003- 2008 $c =~ s/(?<=\b\d{4})\s*-\s*\d{4}(?=\s*-\s*(\d{4})\b)//g; # add space after a comma between years $c =~ s/\b(\d{4}),?\s+([\S^\d])/$1, $2/g; $c =~ s/\s+by\s+//g; $c =~ s/(\\n)*all\s+rights?\s+reserved\.?(\\n)*\s*//gi; # yes there are literal \n $c = '' if $c =~ /^\*No copyright/i; $c =~ s/\(r\)//g; # remove spurious characters at beginning or end of string $c =~ s!^[\s,/*]+|[\s,#/*-]+$!!g; $c =~ s/--/-/g; $c =~ s!\s+\*/\s+! !; # remove copyright word surrounded by non alpha char (like "@copyright{}"); $c =~ s/[^a-z0-9\s,.'"]+copyright[^a-z0-9\s,.'"]+//i; # libuv1 has copyright like "2000, -present" $c =~ s![,\s]*-present!'-'.(localtime->year() + 1900)!e; # texlive-extra has year range like 2023-20** $c =~ s!(\d+)-2\d\*\*!"$1-".(localtime->year() + 1900)!e; # texlive-extra has year range like 2011-.. $c =~ s!(\d+)-\.+!"$1-".(localtime->year() + 1900)!e; # cleanup markdown copyright $c =~ s/\[([\w\s]+)\]\(mailto:([\w@.+-]+)\)/$1 <$2>/; return $c; } sub __split_copyright ($c) { my ($years,$owner) = $c =~ /^(\d\d[\s,\d-]+)(.*)/; # say "undef year in $c" unless defined $years; if (not defined $years) { # try owner and years in reversed order (works also without year) ($owner,$years) = $c =~ m/(.*?)(\d\d[\s,\d-]+)?$/; } $owner //=''; my @data = defined $years ? split /(?<=\d)[,\s]+/, $years : (); $owner =~ s/^[\s.,-]+|[\s,*-]+$//g; return ($owner,@data); } around BUILDARGS => sub ($orig, $class, @args) { my $c = __clean_copyright($args[0]); my ($owner_str, @data) = __split_copyright($c); my $span = Array::IntSpan->new(); my $owner = Software::Copyright::Owner->new($owner_str); foreach my $year (@data) { last if $year =~ /[^\d-]/; # bail-out # take care of ranges written like 2002-3 $year =~ s/^(\d\d\d)(\d)-(\d)$/$1$2-$1$3/; # take care of ranges written like 2014-15 $year =~ s/^(\d\d)(\d\d)-(\d\d)$/$1$2-$1$3/; eval { # the value stored in range is not used. $span->set_range_as_string($year, $owner->identifier // 'unknown'); }; if ($@) { warn "Invalid year span: '$year' found in statement '$c'\n"; } } $span->consolidate(); return $class->$orig({ span => $span, owner => $owner, }) ; }; sub stringify ($self,$=1,$=1) { my $range = $self->span->get_range_list; return join (', ', grep { $_ } ($range, $self->owner)); } sub compare ($self, $other, $swap) { # we must force stringify before calling cmp return "$self" cmp "$other"; } sub _equal ($self, $other, $swap) { # we must force stringify before calling eq return "$self" eq "$other"; } sub merge ($self, $other) { if ($self->identifier eq $other->identifier ) { $self->email($other->email) if $other->email; $self->span->set_range_as_string(scalar $other->span->get_range_list, $other->identifier); $self->span->consolidate(); } else { croak "Cannot merge statement with mismatching owners"; } return $self; } sub add_years ($self, $range) { $self->span->set_range_as_string($range, $self->owner->identifier); $self->span->consolidate; return $self; } sub contains($self, $other) { return 0 unless $self->identifier eq $other->identifier; my $span = Array::IntSpan->new; $span->set_range_as_string(scalar $self->span->get_range_list, $self->identifier); # now $span is a copy of $self->span. Merge $other-span. $span->set_range_as_string(scalar $other->span->get_range_list, $self->identifier); $span->consolidate; # if other span is contained in self->span, the merged result is not changed. return scalar $span->get_range_list eq scalar $self->span->get_range_list ? 1 : 0; } 1; # ABSTRACT: a copyright statement for one owner __END__ =head1 SYNOPSIS use Software::Copyright::Statement; my $statement = Software::Copyright::Statement->new('2020,2021, Joe '); $statement->name; # => is "Joe" $statement->email; # => is 'joe@example.com' $statement->range; # => is '2020, 2021' # merge records $statement->merge(Software::Copyright::Statement->new('2022, Joe ')); $statement->range; # => is '2020-2022' # update the year range $statement->add_years('2015, 2016-2019')->stringify; # => is '2015-2022, Joe ' # stringification my $string = "$statement"; # => is '2015-2022, Joe ' # test if a statement "contains" another one my $st_2020 = Software::Copyright::Statement->new('2020, Joe '); $statement->contains($st_2020); # => is '1' =head1 DESCRIPTION This class holds one copyright statement, i.e. year range, name and email of one copyright contributor. On construction, a cleanup is done to make the statement more standard. Here are some cleanup example: 2002-6 Joe => 2002-2006, Joe 2001,2002,2003,2004 Joe => 2001-2004, Joe # found in markdown documents 2002 Joe mailto:joe@example.com => 2002, Joe =head1 CONSTRUCTOR The constructor can be called without argument or with a string containing: =over =item * a year range (optional) =item * a name (mandatory) =item * an email address (optional) =back E.g: my $st = Software::Copyright::Statement->new(); my $st = Software::Copyright::Statement->new('2002, Joe '); =head1 Methods =head2 name Set or get owner's name =head2 email Set or get owner's name =head2 owner Returns a L object. This object can be used as a string. =head2 merge Merge 2 statements. Note that the 2 statements must belong to the same owner (the name attributes must be identical). See the Synopsis for an example. This method returns C<$self> =head2 add_years Add a year range to the copyright owner. This method accepts year ranges like "2020", "2018, 2020", "2016-2020,2022". White spaces are ignored. This method returns C<$self> =head2 stringify Returns a string containing a year range (if any), a name and email (if any) of the copyright owner. =head2 contains Return 1 if the other statement is contained in current statement, i.e. owner or record are identical and other year range is contained in current year range. For instance: =over =item * C<2016, Joe> is contained in C<2014-2020, Joe> =item * C<2010, Joe> is B contained in C<2014-2020, Joe> =back =head2 Operator overload Operator C<""> is overloaded to call C. =cut libsoftware-copyright-perl-0.015/t/000077500000000000000000000000001477424572700172745ustar00rootroot00000000000000libsoftware-copyright-perl-0.015/t/copyright.t000066400000000000000000000171241477424572700214760ustar00rootroot00000000000000use 5.20.0; use Test::Differences; use Test::More; use Test::Synopsis::Expectation; use utf8; use warnings qw(FATAL utf8); # fatalize encoding glitches use Unicode::Normalize; use open ':std', ':encoding(utf8)'; use Time::localtime; my $current_year = (localtime->year() + 1900); use feature qw/postderef signatures/; no warnings qw/experimental::postderef experimental::signatures/; require_ok( 'Software::Copyright' ); synopsis_ok('lib/Software/Copyright.pm'); my @tests = ( [ '2002-06 Charles Kerr ', '2002-2006, Charles Kerr ' ], [ # found in texlive-extra '2022 -20** by Romain NOEL ', "2022-$current_year, Romain NOEL ", ], [ # found in texlive-extra '2011-.. Maïeul Rouquette', "2011-$current_year, Maïeul Rouquette", ], [ '2011 Heinrich Muller / 2002-2006 Charles Kerr ', "2011, Heinrich Muller \n2002-2006, Charles Kerr " ], [ '2002-6 Charles Kerr / 2002, 2003, 2004, 2005, 2007, 2008, 2010 Free Software / 2011 Heinrich Muller / 2002 vjt (irssi project)', "2011, Heinrich Muller \n2002-2006, Charles Kerr \n2002-2005, 2007, 2008, 2010, Free Software\n2002, vjt (irssi project)" ], [ q!2004-2015, Oliva f00 Oberto / 2001-2010, Paul bar Stevenson !, "2004-2015, Oliva f00 Oberto\n2001-2010, Paul bar Stevenson" ], [ '2005, Thomas Fuchs (http://script.aculo.us, http://mir.aculo.us) / 2005, Michael Schuerig (http://www.schuerig.de/michael/) / 2005, Jon Tirsen (http://www.tirsen.com)', "2005, Thomas Fuchs (http://script.aculo.us, http://mir.aculo.us)\n2005, Michael Schuerig (http://www.schuerig.de/michael/)\n2005, Jon Tirsen (http://www.tirsen.com)" ], [ '1998 Brian Bassett 2002 Noel Koethe 2003-2010 Jonathan Oxer 2006-2010 Jose Luis Tallon 2010 Nick Leverton 2011-2014 Dominique Dumont ', '2011-2014, Dominique Dumont 2010, Nick Leverton 2006-2010, Jose Luis Tallon 2003-2010, Jonathan Oxer 2002, Noel Koethe 1998, Brian Bassett ', ], [ '2015, Jonathan Stowe Jonathan Stowe 2015-2021 Jonathan Stowe ', '2015-2021, Jonathan Stowe ' ], [ 'Jonathan Stowe Jonathan Stowe 2015-2021', '2015-2021, Jonathan Stowe ' ], [ '2015, Dominique Dumont ', '2015, Dominique Dumont ' ], [ '2009 Steven G. Johnson / 2009 Matteo Frigo 2008 Steven G. Johnson / 2008 Matteo Frigo 2008 Steven G. Johnson / 2008 Matteo Frigo', '2008, 2009, Steven G. Johnson 2008, 2009, Matteo Frigo' ], [ '2001, Andrei Alexandrescu / 2001', '2001, Andrei Alexandrescu' ], [ # test merge of record using different normalizations. '2001, '.NFC("Éric Duchmol")."\n2002-2004 ".NFD("Éric Duchmol"), '2001-2004, Éric Duchmol' ], [ # another to test debian bug #1101987 '2018 Jelmer Vernooij 2020-2022 Jelmer Vernooij ', '2020-2022, Jelmer Vernooij 2018, Jelmer Vernooij ', ], [ '2015, 2018, Blaine Bublitz and Eric Schoffstall ', ], [ '2014, 2015, Blaine Bublitz, Eric Schoffstall and other contributors', ], [ 'Isaac Z. Schlueter and Contributors', ], [ q!Wenzel P. P. Peppmeyer Tony O'Dell Timo Paulssen Elizabeth Mattijsen!, ], ["\@copyright{} 2001--2023 Free Software Foundation, Inc.", '2001-2023, Free Software Foundation, Inc.'] ); subtest "single statement" => sub { my $statement = Software::Copyright->new('2014,2015-2022 Marcel '); is("$statement", '2014-2022, Marcel ', "check simplified statement"); ok($statement->is_valid, "check validity"); }; subtest "blank statement" => sub { my $statement = Software::Copyright->new(''); is("$statement", '', "check simplified statement"); eq_or_diff([$statement->owners],[], "check statement owners"); }; subtest "single invalid statement" => sub { my $statement = Software::Copyright->new('2014'); is($statement->is_valid,0, "check validity"); }; subtest "two statement" => sub { my $statement = Software::Copyright->new( '2014,2015-2022 Marcel / 2022 Thierry' ); is("$statement", "2022, Thierry\n2014-2022, Marcel ", "check simplified statement"); ok($statement->is_valid, "check validity"); }; subtest "just a year" => sub { my $statement = Software::Copyright->new('2022'); is("$statement", "2022", "check simplified statement"); ok(! $statement->is_valid, "check validity"); }; subtest "lots of test cases" => sub { foreach my $t (@tests) { my ($in,$expect) = @$t; $expect //= $in; my $label = length $in > 50 ? substr($in,0,30).'...' : $in ; $label =~ s/\n.*/.../; my $statement = Software::Copyright->new($in); eq_or_diff($statement->stringify,$expect,"Normalised statement '$label'"); ok($statement->is_valid, "check validity of $label"); } }; subtest "equal overload" => sub { my $in = '2015, Dominique Dumont '; my $left = Software::Copyright->new($in); my $right = Software::Copyright->new($in); my $other = Software::Copyright->new('2014,'.$in); cmp_ok($right => eq => $left, "test equal operator"); cmp_ok($right => ne => $other, "test not equal operator"); }; subtest "merge record" => sub { my $original = '2014,2015-2020 Marcel / 2002 Dod / 2015 Marc'; my @merge_tests = ( [ __LINE__, '2004-06 Marcel' , '2015, Marc 2004-2006, 2014-2020, Marcel 2002, Dod' ], [ __LINE__, '2004-06 Marcel / 2020 Billy' , '2020, Billy 2015, Marc 2004-2006, 2014-2020, Marcel 2002, Dod' ], ); foreach my $t (@merge_tests) { my $copyright = Software::Copyright->new($original); $copyright->merge(Software::Copyright->new($t->[1])); eq_or_diff("$copyright", $t->[2], "check merged copyright from line ".$t->[0]); is($copyright->is_valid, 1, "check validity of merged copyright"); } }; subtest "record contains another" => sub { my $original = '2014,2015-2020 Marcel / 2002 Dod / 2015 Marc'; my $copyright = Software::Copyright->new($original); my @contains_tests = ( [__LINE__, '2015, Marc / 2014-2020, Marcel / 2002, Dod', 1], [__LINE__, '2014-2020, Marcel / 2002, Dod', 1], [__LINE__, '2016, Marc / 2014-2020, Marcel / 2002, Dod', 0], [__LINE__, '2015, Yves / 2014-2020, Marcel / 2002, Dod', 0], ); foreach my $t (@contains_tests) { my ($line, $other, $expect) = $t->@*; my $res = $copyright->contains(Software::Copyright->new($other)); is($res, $expect, "check $other"); } }; done_testing; libsoftware-copyright-perl-0.015/t/owner.t000066400000000000000000000055651477424572700206260ustar00rootroot00000000000000use 5.20.0; use strict; use warnings; use utf8; use open ':std', ':encoding(utf8)'; use Test::More; use Test::Synopsis::Expectation; use Unicode::Normalize; use feature qw/postderef signatures/; no warnings qw/experimental::postderef experimental::signatures/; require_ok('Software::Copyright::Owner'); synopsis_ok('lib/Software/Copyright/Owner.pm'); subtest "just a name" => sub { my $owner = Software::Copyright::Owner->new("Marcel"); is("$owner", "Marcel", "check simple owner"); is($owner->name, "Marcel", "check name"); }; subtest "just an unicode name" => sub { my $owner = Software::Copyright::Owner->new(NFD("Éric")); is("$owner", NFC("Éric"), "check unicode owner"); is($owner->name, NFC("Éric"), "check name"); }; subtest "just a number" => sub { my $owner = Software::Copyright::Owner->new("2021"); is("$owner", "2021", "check owner string when a number was given"); is($owner->name, undef, "check owner name when a number was given"); is($owner->record, "2021", "check owner name when a number was given"); }; subtest "combined owners" => sub { my $str = "Blaine Bublitz, Eric Schoffstall and other contributors"; my $owner = Software::Copyright::Owner->new($str); is("$owner", $str, "check owner string"); is($owner->name, undef, "check owner name"); is($owner->record, $str, "check owner name"); is($owner->identifier, $str, "check owner identifier"); }; subtest "combined owners and email" => sub { my $str = 'Blaine Bublitz ,' . ' Eric Schoffstall and other contributors'; my $owner = Software::Copyright::Owner->new($str); is("$owner", $str, "check owner string"); is($owner->name, undef, "check owner name"); is($owner->record, $str, "check owner record"); is($owner->identifier, $str, "check owner identifier"); is($owner->email, undef, "check owner email"); }; subtest "name and email" => sub { my $owner = Software::Copyright::Owner->new("Marcel"); $owner->email( 'marcel@example.com' ); is("$owner", 'Marcel ', "check owner and email"); }; subtest "create with name and email" => sub { my @tests = ( ['Marcel ', Marcel => 'marcel@example.com'], ['Marcel ', Marcel => 'marcel2015@example.com'], ); foreach my $test (@tests) { my ($in, $name, $email, $out) = $test->@*; my $owner = Software::Copyright::Owner->new($in); is($owner->name, $name, "check name"); is($owner->email, $email, "check email"); is("$owner", $out // $in, "check owner and email"); } }; subtest "invalid owners" => sub { my $owner = Software::Copyright::Owner->new('**'); is($owner->name, undef, "check name"); is($owner->email, undef, "check email"); is($owner->record, "**", "check record"); }; done_testing; libsoftware-copyright-perl-0.015/t/perl-critic.t000066400000000000000000000010221477424572700216710ustar00rootroot00000000000000 use strict; use warnings; use File::Spec; use Test::More; use English qw(-no_match_vars); if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } eval { require Test::Perl::Critic; }; if ( $EVAL_ERROR ) { my $msg = 'Test::Perl::Critic required to criticise code'; plan( skip_all => $msg ); } my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); Test::Perl::Critic->import( -profile => $rcfile ); all_critic_ok(); libsoftware-copyright-perl-0.015/t/perlcriticrc000066400000000000000000000007301477424572700217040ustar00rootroot00000000000000severity = 4 # remove when https://github.com/Perl-Critic/PPI/issues/194 is fixed [-Subroutines::ProhibitSubroutinePrototypes] [TestingAndDebugging::ProhibitNoWarnings] allow = experimental::postderef experimental::signatures # model files are not modules [-Modules::RequireExplicitPackage] # model files finish with a data structure: the model [-Modules::RequireEndWithOne] [RegularExpressions::RequireExtendedFormatting] minimum_regex_length_to_complain_about = 25 libsoftware-copyright-perl-0.015/t/split-copyright.t000066400000000000000000000022101477424572700226150ustar00rootroot00000000000000# -*- cperl -*- use strict; use warnings; use 5.010; use Test::More; # see done_testing() use Test::Differences; require_ok( 'Software::Copyright::Statement' ); my @tests = ( [ '2015, Jonathan Stowe', [ 'Jonathan Stowe', '2015']], [ 'Jonathan Stowe 2015-2021', [ 'Jonathan Stowe', '2015-2021']], [ 'Jonathan Stowe 2004, 2015-2021', [ 'Jonathan Stowe', '2004', '2015-2021']], [ 'Jonathan Stowe ', [ 'Jonathan Stowe ']], [ '2004-2015, Oliva f00 Oberto', [ 'Oliva f00 Oberto', '2004-2015']], [ 'Oliva f00 Oberto 2004-2015', [ 'Oliva f00 Oberto', '2004-2015']], [ 'Dümônt 2004-2015', [ 'Dümônt', '2004-2015']], [ 'Dominique Dumont', [ 'Dominique Dumont']], [ '2015, Dominique Dumont ', [ 'Dominique Dumont ', '2015']], [ '2021', [ '', '2021']], [ '', ['']], ); foreach my $t (@tests) { my ($in,$expect) = @$t; my $label = length $in > 50 ? substr($in,0,30).'...' : $in ; my @res = Software::Copyright::Statement::__split_copyright($in); eq_or_diff(\@res,$expect,"__split_copyright '$label'"); } done_testing(); libsoftware-copyright-perl-0.015/t/statement.t000066400000000000000000000134151477424572700214710ustar00rootroot00000000000000use 5.20.0; use Test::More; use Test::Synopsis::Expectation; use Time::localtime; use feature qw/postderef signatures/; no warnings qw/experimental::postderef experimental::signatures/; require_ok('Software::Copyright::Statement'); synopsis_ok('lib/Software/Copyright/Statement.pm'); sub new_st($str) { return Software::Copyright::Statement->new($str); } subtest "blank statement" => sub { my $statement = new_st(''); is("$statement", '', "check simplified statement"); is($statement->name, undef, "check simplified statement name"); is($statement->email, undef, "check simplified statement email"); }; subtest "just a name" => sub { my $statement = new_st('Marcel '); is("$statement", 'Marcel ', "check simplified statement"); is($statement->name, 'Marcel', "check simplified statement name"); is($statement->email, 'marcel@example.com', "check simplified statement email"); }; subtest "O'name" => sub { my $statement = new_st(q!Tony O'Dell!); is($statement->name, "Tony O'Dell", "check simplified statement name"); }; subtest "single statement" => sub { my $statement = new_st('2014,2015-2022 Marcel '); is("$statement", '2014-2022, Marcel ', "check simplified statement"); }; subtest "just a number" => sub { my $statement = new_st('2021'); is($statement->name, undef, "check statement without name"); is("$statement", '2021', "check statement string without name"); }; subtest "combined owners" => sub { my $owner_str = "Blaine Bublitz, Eric Schoffstall and other contributors"; my $str = "2014, 2015, $owner_str"; my $owner = new_st($str); is("$owner", $str, "check statement string"); is($owner->name, undef, "check owner name"); is($owner->record, "Blaine Bublitz, Eric Schoffstall and other contributors", "check owner record"); }; subtest "combined owners and email" => sub { my $owner_str = 'Blaine Bublitz ,' . ' Eric Schoffstall and other contributors'; my $str = '2013-2018, '.$owner_str; my $owner = new_st($str); is("$owner", $str, "check statement string"); is($owner->name, undef, "check owner name"); is($owner->record, $owner_str, "check owner record"); is($owner->email, undef, "check owner email"); }; subtest "compare statements" => sub { my $one = new_st('2022 Thierry'); my $other = new_st('2014,2015-2022 Marcel '); is($one cmp $one, 0, "check cmp equal"); is($one cmp $other, 1, "check cmp equal"); is($other cmp $one, -1, "check cmp equal"); }; subtest "merge record" => sub { my $statement = new_st('2014,2015-2020 Marcel'); $statement->merge(new_st('2004-06 Marcel')); is("$statement", '2004-2006, 2014-2020, Marcel', "check simplified statement"); $statement->merge(new_st('2007-08 Marcel')); is("$statement", '2004-2008, 2014-2020, Marcel', "check statement after year merge"); $statement->merge(new_st('2021, Marcel')); is("$statement", '2004-2008, 2014-2021, Marcel', "check statement after 2021 year merge"); # add email $statement->merge(new_st('Marcel ')); is("$statement", '2004-2008, 2014-2021, Marcel ', "merge bad email address"); # fix email $statement->merge(new_st('2022, Marcel ')); is("$statement", '2004-2008, 2014-2022, Marcel ', "fix email"); }; subtest "add years" => sub { my $statement = new_st('2022, Marcel '); $statement->add_years(2010); is("$statement", '2010, 2022, Marcel ', "added year"); }; subtest "handle garbage" => sub { my $statement = new_st('(c)**b <= a and (c+1)**b > a'); # garbage in, garbage out is($statement.'',"b <= a and (c+1)**b > a","handle C code with (c)"); }; subtest "handle No Copyright given by licensecheck" => sub { my $statement = new_st('*No copyright*'); is($statement.'',"","handle No Copyright given by licensecheck"); }; subtest "contains record" => sub { my $statement = new_st('2015-2020 Marcel'); my @tests = ( ['2014, Marcel', 0 ], ['2015, Marcel', 1 ], ['2015-2019, Marcel', 1 ], ['2015-2019, Yves', 0 ], ); foreach my $t (@tests) { my ($str, $expect) = $t->@*; is($statement->contains(new_st($str)), $expect, "check $str"); } }; subtest "clean copyright" => sub { my $current_year = localtime->year() + 1900; my @tests = ( [ '(c) 2006-present Philipp Lehman,', "2006-$current_year, Philipp Lehman" ], [ # see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1033406 '2022 -01-17:16:26:37 -- Version 1.3 André Hilbig, mail@andrehilbig.de', '2022, Version 1.3 André Hilbig, mail@andrehilbig.de', ], [ 'Uwe Lueck 2012-11-06', '2012, Uwe Lueck' ], [ '2003 - 2004 - 2006 Alphonse', '2003-2006, Alphonse' ], [ '(C) Werenfried Spit 04-10-90', '1990, Werenfried Spit' ], [ '(c) 2003--2005 Alexej Kryukov .', '2003-2005, Alexej Kryukov .', ], [ # see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1052168 '@copyright{} 2001--2023 Free Software Foundation, Inc.', '2001-2023, Free Software Foundation, Inc.', ], [ 'protection under copyright law or other applicable laws.' ], ); foreach my $t (@tests) { my ($str, $expect) = $t->@*; is(new_st($str), $expect // $str, "check «$str»"); } }; done_testing;