package CPANPLUS::Dist::Debora::Package; # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later use 5.016; use warnings; use utf8; our $VERSION = '0.016'; use Carp qw(croak); use Config; use CPAN::Meta; use English qw(-no_match_vars); use File::Basename qw(dirname); use File::Path qw(remove_tree); use File::Spec::Functions qw(catdir catfile splitdir splitpath); use File::Temp qw(tempdir); use Net::Domain qw(hostfqdn); use Software::LicenseUtils 0.103014; use CPANPLUS::Dist::Debora::License; use CPANPLUS::Dist::Debora::Pod; use CPANPLUS::Dist::Debora::Util qw( parse_version module_is_distributed_with_perl decode_utf8 can_run run find_most_recent_mtime find_shared_objects ); # Map some distribution names to special package names. my %PACKAGE_NAME_FOR = ( 'ack' => 'ack', 'App-Licensecheck' => 'licensecheck', 'App-perlbrew' => 'perlbrew', 'TermReadKey' => 'perl-Term-ReadKey', ); # Version quirks. my %VERSION_FOR = ('BioPerl-Run' => sub { parse_version($_[0])->normal }); # Modules with summaries and descriptions. my %POD_FOR = ( 'ack' => 'ack', 'App-Licensecheck' => 'licensecheck', 'TermReadKey' => 'ReadKey.pm.PL', 'TimeDate' => 'Date::Parse', 'YAML-LibYAML' => 'YAML::XS', ); # Common modules whose license might not be guessed. my %LICENSE_FOR = ( 'AnyEvent' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Apache-Htpasswd' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Cache-Cache' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Canary-Stability' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'CGI-FormBuilder' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'CGI-FormBuilder-Source-Perl' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Crypt-CBC' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Encode-Detect' => 'MPL-1.1', 'Guard' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Iterator' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Iterator-Util' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Lingua-EN-Words2Nums' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Lingua-Stem-Snowball-Da' => 'GPL-2.0-only', 'Mozilla-CA' => 'MPL-2.0', 'Socket6' => 'BSD', 'String-ShellQuote' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'Sub-Delete' => 'Artistic-1.0-Perl OR GPL-1.0-or-later', 'XML-Writer' => 'CC0-1.0', ); sub new { my ($class, %attrs) = @_; my $attrs = $class->_buildargs(%attrs); return bless $attrs, $class; } sub _buildargs { my ($class, %attrs) = @_; if (!exists $attrs{module}) { croak 'No module'; } my $builddir = $attrs{builddir} = $attrs{module}->status->extract; if (!defined $builddir) { croak 'No builddir'; } if (!exists $attrs{installdirs}) { $attrs{installdirs} = 'vendor'; } my $installdirs = $attrs{installdirs}; if ($installdirs ne 'vendor' && $installdirs ne 'site') { croak "installdirs is neither 'vendor' nor 'site': '$installdirs'"; } if (!exists $attrs{build_number}) { $attrs{build_number} = 1; } my $build_number = $attrs{build_number}; if ($build_number !~ m{\A [1-9]\d* \z}xms) { croak "build_number is not a positive integer: '$build_number'"; } $attrs{last_modification} = find_most_recent_mtime($builddir); return \%attrs; } sub _read { my ($self, $name, $default) = @_; if (!exists $self->{$name}) { $self->{$name} = $default->(); } return $self->{$name}; } sub module { my $self = shift; return $self->{module}; } sub installdirs { my $self = shift; return $self->{installdirs}; } sub sourcefile { my $self = shift; my $sourcefile = $self->_read('sourcefile', sub { $self->module->status->fetch }); return $sourcefile; } sub sourcedir { my $self = shift; my $sourcedir = $self->_read('sourcedir', sub { dirname($self->sourcefile) }); return $sourcedir; } sub last_modification { my $self = shift; return $self->{last_modification}; } sub builddir { my $self = shift; return $self->{builddir}; } sub outputdir { my $self = shift; my $outputdir = $self->_read('outputdir', sub { dirname($self->builddir) }); return $outputdir; } sub stagingdir { my $self = shift; my $stagingdir = $self->_read('stagingdir', sub { tempdir('stagingXXXX', DIR => $self->outputdir) }); return $stagingdir; } sub shared_objects { my $self = shift; my $shared_objects = $self->_read('shared_objects', sub { $self->_get_shared_objects }); return $shared_objects; } sub is_noarch { my $self = shift; my $is_noarch = $self->_read('is_noarch', sub { $self->_get_is_noarch }); return $is_noarch; } sub module_name { my $self = shift; my $module_name = $self->_read('module_name', sub { $self->_get_module_name }); return $module_name; } sub dist_name { my $self = shift; return $self->module->package_name; } sub name { my $self = shift; my $name = $self->_read('name', sub { $self->_normalize_name($self->dist_name) }); return $name; } sub dist_version { my $self = shift; return $self->module->package_version; } sub version { my $self = shift; my $version = $self->_read('version', sub { $self->_normalize_version($self->dist_version) }); return $version; } sub build_number { my $self = shift; return $self->{build_number}; } sub author { my $self = shift; my $author = $self->_read('author', sub { $self->_get_author }); return $author; } sub packager { my $self = shift; my $packager = $self->_read('packager', sub { $self->_get_packager }); return $packager; } sub vendor { my $self = shift; my $vendor = $self->_read('vendor', sub { $self->_get_vendor }); return $vendor; } sub url { my $self = shift; # A link to MetaCPAN is more useful than the homepage. my $url = $self->_read('url', sub { 'https://metacpan.org/dist/' . $self->dist_name }); return $url; } sub summary { my $self = shift; my $summary = $self->_read('summary', sub { $self->_get_summary }); return $summary; } sub description { my $self = shift; my $description = $self->_read('description', sub { $self->_get_description }); return $description; } sub dependencies { my $self = shift; my $dependencies = $self->_read('dependencies', sub { $self->_get_dependencies }); return $dependencies; } sub copyrights { my $self = shift; my $copyrights = $self->_read('copyrights', sub { $self->_get_copyrights }); return $copyrights; } sub licenses { my $self = shift; my $licenses = $self->_read('licenses', sub { $self->_get_licenses }); return $licenses; } sub license { my $self = shift; my $license = $self->_read('license', sub { $self->_get_license }); return $license; } sub files { my $self = shift; my $files = $self->_read('files', sub { [@{$self->_get_docfiles}, @{$self->_get_stagingfiles}] }); return $files; } sub files_by_type { my ($self, $type) = @_; my @files = map { $_->{name} } grep { $_->{type} eq $type } @{$self->files}; return \@files; } sub mb_opt { my $self = shift; my $installdirs = $self->installdirs; return << "END_MB_OPT"; --installdirs $installdirs END_MB_OPT } sub mm_opt { my $self = shift; my $installdirs = $self->installdirs; return << "END_MM_OPT"; INSTALLDIRS=$installdirs END_MM_OPT } sub sanitize_stagingdir { my $self = shift; my $fail_count = 0; my $finddepth = sub { my $dir = shift; opendir my $dh, $dir or croak "Could not traverse '$dir': $OS_ERROR"; ENTRY: while (defined(my $entry = readdir $dh)) { next ENTRY if $entry eq q{.} || $entry eq q{..}; my $path = catfile($dir, $entry); # Skip symbolic links. next ENTRY if -l $path; # Process sub directories first. if (-d $path) { __SUB__->($path); } # Sanitize the permissions. my @stat = lstat $path; if (!@stat) { error("Could not stat '$path': $OS_ERROR"); next ENTRY; } my $old_mode = $stat[2] & oct '0777'; my $new_mode = ($old_mode & oct '0755') | oct '0200'; if ($old_mode != $new_mode) { if (!chmod $new_mode, $path) { error("Could not chmod '$path': $OS_ERROR"); ++$fail_count; } } # Remove empty directories and some files. if (-d $path) { rmdir $path; } else { if ( $entry eq 'perllocal.pod' || $entry eq '.packlist' || $entry =~ m{[.]la \z}xms || ($entry =~ m{[.]bs \z}xms && -z $path)) { if (!unlink $path) { error("Could not remove '$path': $OS_ERROR"); ++$fail_count; } } } } closedir $dh; return; }; $finddepth->($self->stagingdir); return $fail_count == 0; } sub remove_stagingdir { my $self = shift; my $stagingdir = $self->{stagingdir}; if (defined $stagingdir) { remove_tree($stagingdir); delete $self->{stagingdir}; } return 1; } sub rpm_cmd { my $self = shift; state $rpm_cmd = can_run('rpm'); return $rpm_cmd; } sub rpm_eval { my ($self, $expr) = @_; my $string = q{}; my $rpm_cmd = $self->rpm_cmd; if ($rpm_cmd) { my @eval_cmd = ($rpm_cmd, '--eval', $expr); my $output = q{}; if (run(command => \@eval_cmd, buffer => \$output)) { chomp $output; $string = eval { decode_utf8($output) } // q{}; } } return $string; } sub sudo_cmd { my $self = shift; my $module = $self->module; my $backend = $module->parent; my $config = $backend->configure_object; my $sudo_cmd = $config->get_program('sudo') // 'sudo'; return $sudo_cmd; } sub DESTROY { my $self = shift; my $stagingdir = $self->{stagingdir}; if (defined $stagingdir) { ##no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { remove_tree($stagingdir) }; } return; } ## no critic (Subroutines::ProhibitExcessComplexity) sub _normalize_name { my ($self, $dist_name) = @_; my $name; if (exists $PACKAGE_NAME_FOR{$dist_name}) { $name = $PACKAGE_NAME_FOR{$dist_name}; } else { $name = $dist_name; # Prepend "perl-" unless the name starts with "perl-". if ($name !~ m{\A perl-}xms) { $name = 'perl-' . $name; } } return $name; } sub _normalize_version { my ($self, $dist_version) = @_; my $dist_name = $self->dist_name; my $version = $dist_version // 0; if (exists $VERSION_FOR{$dist_name}) { $version = $VERSION_FOR{$dist_name}->($version); } $version =~ s{\A v}{}xms; # Strip "v". return $version; } sub _unnumify_version { my ($self, $dist_version) = @_; my $version = $self->_normalize_version(parse_version($dist_version)->normal); return $version; } sub _get_meta { my $self = shift; my $meta; my $builddir = $self->builddir; META: for (qw(META.json META.yml)) { my $metafile = catfile($builddir, $_); if (-f $metafile) { $meta = eval { CPAN::Meta->load_file($metafile) }; last META if defined $meta; } } return $meta; } sub _meta { my $self = shift; my $meta = $self->_read('meta', sub { $self->_get_meta }); return $meta; } sub _get_pod { my $self = shift; my $builddir = $self->builddir; my $name = $POD_FOR{$self->dist_name} // $self->module_name; my @dirs = map { catdir($builddir, $_) } qw(blib/lib blib/bin lib bin .); my $pod = CPANPLUS::Dist::Debora::Pod->find($name, @dirs, $builddir); return $pod; } sub _pod { my $self = shift; return $self->_read('pod', sub { $self->_get_pod }); } sub _get_shared_objects { my $self = shift; my $stagingdir = $self->{stagingdir}; if (!defined $stagingdir) { croak 'Call shared_objects after the distribution has been built'; } my $shared_objects = find_shared_objects($stagingdir); return $shared_objects; } sub _get_is_noarch { my $self = shift; # Searching for source code files isn't reliable as there are Perl # distributions with C files in example directories. # # Instead, we look for an "auto" directory and search for shared objects # after the distribution has been installed in the staging directory. my $stagingdir = $self->{stagingdir}; if (!defined $stagingdir) { croak 'Call is_arch after the distribution has been built'; } my $is_noarch = @{$self->shared_objects} == 0; if ($is_noarch) { my $installdirs = $self->installdirs; my $archdir = $Config{"install${installdirs}arch"}; if (defined $archdir) { my $autodir = catdir($stagingdir, $archdir, 'auto'); if (-d $autodir) { $is_noarch = 0; } } } return $is_noarch; } sub _get_module_name { my $self = shift; my $name = $self->module->module; # Is there a .pm file with the distribution's name? my @module = split qr{-}xms, $self->dist_name; my $filename = catfile($self->builddir, 'lib', @module) . '.pm'; if (-f $filename) { $name = join q{::}, @module; } return $name; } sub _get_author { my $self = shift; my $name; my $author = $self->module->author; if (defined $author && ref $author ne 'CPANPLUS::Module::Author::Fake') { $name = $author->author; } return $name; } sub _get_packager { my $self = shift; my $name; my $email; my $EMAIL = qr{ \A (?:([^<]*) \h+)? # name <? ([^>]+@[^>]+) >? # email }xms; if ($self->rpm_eval('%{?packager}') =~ $EMAIL) { $name = $1; $email = $2; } if (!$name) { NAME: for my $key (qw(DEBFULLNAME NAME GITLAB_USER_NAME)) { if ($ENV{$key}) { $name = eval { decode_utf8($ENV{$key}) }; last NAME if $name; } } } for my $key (qw(DEBEMAIL EMAIL GITLAB_USER_EMAIL)) { if ($ENV{$key}) { my $value = eval { decode_utf8($ENV{$key}) }; if ($value && $value =~ $EMAIL) { if (!$name) { $name = $1; } if (!$email) { $email = $2; } } } } my $user; my @pw = eval { getpwuid $UID }; if (@pw) { $user = eval { decode_utf8($pw[0]) }; if (!$name) { my $gecos = eval { decode_utf8($pw[6]) }; if ($gecos) { ($name) = split qr{,}xms, $gecos; } } } if (!$user) { USER: for my $key (qw(LOGNAME USER USERNAME)) { if ($ENV{$key}) { $user = eval { decode_utf8($ENV{$key}) }; last USER if $user; } } } if (!$user) { $user = 'nobody'; } if (!$name) { $name = $user; } if (!$email) { my $host = hostfqdn; $host =~ s{[.]$}{}xms; $email = $user . q{@} . $host; } return "$name <$email>"; } sub _get_vendor { my $self = shift; my $vendor = $self->rpm_eval('%{?vendor}'); if (!$vendor || $vendor =~ m{%}xms) { $vendor = 'CPANPLUS'; } return $vendor; } sub _get_summary_from_meta { my $self = shift; my $summary; my $meta = $self->_meta; if (defined $meta) { my $text = $meta->{abstract}; if ($text && $text !~ m{unknown}xmsi) { $summary = $text; } } return $summary; } sub _get_summary_from_pod { my $self = shift; my $summary; my $pod = $self->_pod; if (defined $pod) { $summary = $pod->summary; } return $summary; } sub _get_summary { my $self = shift; my $summary = $self->_get_summary_from_meta // $self->_get_summary_from_pod // 'Module for the Perl programming language'; $summary =~ s{\v+}{ }xmsg; # Replace newlines. $summary =~ s{[.]+ \z}{}xms; # Remove trailing dots. $summary =~ s{\A (?:An? | The) \h+}{}xmsi; # Remove leading articles. return ucfirst $summary; } sub _get_description { my $self = shift; my $description = q{}; my $pod = $self->_pod; if (defined $pod) { $description = $pod->description; } if (!$description) { my $module_name = $self->module_name; $description = "$module_name is a module for the Perl programming language."; } return $description; } sub _get_requires { my $self = shift; my %requires; my $prereqs = $self->module->status->prereqs // {}; my $meta = $self->_meta; if (defined $meta && ref $meta->{prereqs} eq 'HASH') { my $meta_runtime = $meta->{prereqs}->{runtime} // {}; my $meta_requires = $meta_runtime->{requires} // {}; # We can only have dependencies that are in the prereqs. %requires = map { $_ => $meta_requires->{$_} } grep { exists $prereqs->{$_} } keys %{$meta_requires}; } else { %requires = %{$prereqs}; } return \%requires; } sub _get_dependencies { my $self = shift; my %requires = %{$self->_get_requires}; my $backend = $self->module->parent; # Sometimes versions are numified and cannot be compared with stringified # versions. my %version_for = ( 'Algorithm::Diff' => sub {0}, 'BioPerl' => sub { $self->_unnumify_version($_[0]) }, 'Catalyst' => sub {0}, 'Catalyst::Runtime' => sub {0}, 'CGI::Simple' => sub {0}, 'DBD::Pg' => sub { $self->_unnumify_version($_[0]) }, 'strict' => sub {0}, 'Time::Local' => sub {0}, 'warnings' => sub {0}, ); my %dependency; MODULE: for my $module_name (keys %requires) { my $module = $backend->module_tree($module_name); next MODULE if !$module; # Task::Weaken is only a build dependency. next MODULE if $module_name eq 'Task::Weaken'; # Ignore dependencies on modules for VMS and Windows. next MODULE if $module_name =~ m{\A (?:VMS | Win32)}xms; my $dist_name = $module->package_name; my $version = parse_version($requires{$module_name}); my $is_core = $module_name eq 'perl' || module_is_distributed_with_perl($module_name, $version) || $module->package_is_perl_core; if (exists $version_for{$module_name}) { $version = $version_for{$module_name}->($version); } if (!exists $dependency{$module_name} || $dependency{$module_name}->{version} < $version) { $dependency{$module_name} = { dist_name => $dist_name, version => $version, is_module => $module_name ne 'perl', is_core => $is_core, }; } } my @dependencies = map { { module_name => $_, dist_name => $dependency{$_}->{dist_name}, package_name => $self->_normalize_name($dependency{$_}->{dist_name}), version => $self->_normalize_version($dependency{$_}->{version}), is_module => $dependency{$_}->{is_module}, is_core => $dependency{$_}->{is_core}, } } sort { uc $a cmp uc $b } keys %dependency; return \@dependencies; } sub _get_copyrights { my $self = shift; my @copyrights; my $pod = $self->_pod; if (defined $pod) { push @copyrights, @{$pod->copyrights}; } if (!@copyrights) { my $author = $self->author; my $holder = $author ? "$author and possibly others" : 'unknown authors'; my $time = $self->last_modification; my $year = (gmtime $time)[5] + 1900; push @copyrights, {year => $year, holder => $holder}; } return \@copyrights; } sub _get_licenses_from_meta { my $self = shift; my @licenses; my $meta = $self->_meta; if (defined $meta) { my $keys = $meta->{license}; if (defined $keys) { if (!ref $keys) { $keys = [$keys]; } my %ignore_key = map { $_ => 1 } qw(open_source unrestricted); for my $key (grep { !exists $ignore_key{$_} } @{$keys}) { my @license = Software::LicenseUtils->guess_license_from_meta_key($key, 2); if (@license) { push @licenses, @license; } } } } return \@licenses; } sub _get_licenses_from_pod { my $self = shift; my @licenses; my $pod = $self->_pod; if (defined $pod) { my @license = Software::LicenseUtils->guess_license_from_pod($pod->text); if (@license) { push @licenses, @license; } } return \@licenses; } sub _get_licenses { my $self = shift; my %copyright = %{$self->copyrights->[-1]}; my $get_license = sub { my $spdx_expression = shift; my $license = eval { Software::LicenseUtils->new_from_spdx_expression({ spdx_expression => $spdx_expression, %copyright }); }; if (!$license) { $license = CPANPLUS::Dist::Debora::License->new({ package => $self, %copyright }); } return $license; }; my %unique_guesses = map { $_->name => $_ } @{$self->_get_licenses_from_meta}, @{$self->_get_licenses_from_pod}; # Add the copyright year and author to the guessed licenses. my @licenses = map { $get_license->($_->spdx_expression) } values %unique_guesses; if (!@licenses) { push @licenses, $get_license->($LICENSE_FOR{$self->dist_name}); } my @sorted_licenses = sort { $a->spdx_expression cmp $b->spdx_expression } @licenses; return \@sorted_licenses; } sub _get_license { my $self = shift; my @names = map { $_->spdx_expression } @{$self->licenses}; my $license = join ' AND ', map { @names > 1 && m{\b OR \b}xmsi ? "($_)" : $_ } @names; return $license; } sub _get_docfiles { my $self = shift; my $LICENSE = qr{ \A (?: COPYING(?:[.](?:LESSER|LIB))? | COPYRIGHT | LICEN[CS]E ) (?:[.](?:md|mkdn|pod|txt))? \z }xmsi; my $CHANGELOG = qr{ \A (?: Change(?:s|Log) ) (?:[.](?:md|mkdn|pod|txt))? \z }xmsi; my $DOC = qr{ \A (?: AUTHORS | BUGS | CONTRIBUTING | CREDITS | FAQ | NEWS | README | THANKS | TODO ) (?:[.](?:md|mkdn|pod|txt))? \z }xmsi; my %regex_for = ( 'license' => $LICENSE, 'changelog' => $CHANGELOG, 'doc' => $DOC, ); my @files; my $fix_permissions = sub { my $dir = shift; chmod oct '0755', $dir; opendir my $dh, $dir or croak "Could not traverse '$dir': $OS_ERROR"; ENTRY: while (defined(my $entry = readdir $dh)) { next ENTRY if $entry eq q{.} || $entry eq q{..}; my $path = catfile($dir, $entry); # Skip symbolic links. next ENTRY if -l $path; if (-d $path) { __SUB__->($path); } else { chmod oct '0644', $path; } } closedir $dh; return; }; my $find = sub { my $dir = shift; opendir my $dh, $dir or croak "Could not traverse '$dir': $OS_ERROR"; ENTRY: while (defined(my $entry = readdir $dh)) { next ENTRY if $entry eq q{.} || $entry eq q{..}; my $path = catfile($dir, $entry); # Skip symbolic links. next ENTRY if -l $path; if (-d $path) { if ($entry eq 'examples') { $fix_permissions->($path); my $file = {name => $entry, type => 'doc'}; push @files, $file; } } elsif (-s $path) { TYPE: for my $type (keys %regex_for) { if ($entry =~ $regex_for{$type}) { chmod oct '0644', $path; my $file = {name => $entry, type => $type}; push @files, $file; last TYPE; } } } } closedir $dh; return; }; $find->($self->builddir); my @sorted_files = sort { $a->{name} cmp $b->{name} } @files; return \@sorted_files; } sub _get_excludedirs { my $self = shift; # A list of directories that are provided by Perl and must not be removed # by packages. my @vars = qw( installsitearch installsitebin installsitelib installsiteman1dir installsiteman3dir installsitescript installvendorarch installvendorbin installvendorlib installvendorman1dir installvendorman3dir installvendorscript ); my %excludedirs = map { $_ => 1 } qw(/etc); VAR: for my $var (@vars) { my $value = $Config{$var}; next VAR if !$value; if ($var =~ m{arch \z}xms) { $value = catdir($value, 'auto'); } my ($volume, $path) = File::Spec->splitpath($value, 1); my ($dir, @dirs) = splitdir($path); while (@dirs) { $dir = catdir($dir, shift @dirs); $excludedirs{$dir} = 1; } } return \%excludedirs; } sub _get_stagingfiles { my $self = shift; my $stagingdir = $self->stagingdir; my $stagingdir_length = length $stagingdir; my $excludedirs = $self->_get_excludedirs; my @files; my $find = sub { my $dir = shift; opendir my $dh, $dir or croak "Could not traverse '$dir': $OS_ERROR"; ENTRY: while (defined(my $entry = readdir $dh)) { next ENTRY if $entry eq q{.} || $entry eq q{..}; my $path = catfile($dir, $entry); my $name = substr $path, $stagingdir_length; my $type = -l $path ? 'link' : -d $path ? 'dir' : 'file'; if ($type eq 'file') { my ($volume, $dirs, $file) = splitpath($name); my %subdir = map { $_ => 1 } splitdir($dirs); if (exists $subdir{etc}) { $type = 'config'; } elsif (exists $subdir{man}) { $type = 'man'; } } if (!exists $excludedirs->{$name}) { my $file = {name => $name, type => $type}; push @files, $file; } # Skip symbolic links. next ENTRY if -l $path; if (-d $path) { __SUB__->($path); } } closedir $dh; return; }; $find->($stagingdir); my @sorted_files = sort { $a->{name} cmp $b->{name} } @files; return \@sorted_files; } 1; __END__ =encoding UTF-8 =head1 NAME CPANPLUS::Dist::Debora::Package - Base class for package formats =head1 VERSION version 0.016 =head1 SYNOPSIS use parent qw(CPANPLUS::Dist::Debora::Package); my $name = $package->name; my $version = $package->version; my $summary = $package->summary; my $description = $package->description; my @licenses = @{$package->licenses}; my @dependencies = @{$package->dependencies}; my @files = @{$package->files}; =head1 DESCRIPTION This module collects information on a yet to be created Debian or RPM package. The information is obtained from a L<CPANPLUS::Module> object, the file system and the environment. Among other things, the module gets the package name, a short summary, a description, the license and the dependencies. =head1 SUBROUTINES/METHODS Any methods marked I<Abstract> must be implemented by subclasses. =head2 new my $package = CPANPLUS::Dist::Debora::Package->new( module => $module, installdirs => 'vendor', build_number => 1, ); Creates a new object. The L<CPANPLUS::Module> object parameter is mandatory. All other attributes are optional. =head2 format_priority I<Abstract> my $priority = CPANPLUS::Dist::Debora::Package->format_priority; Checks whether the package format is available. Returns 0 if the required package tools are not available, 1 if the tools are available and 2 or higher if the format is the operating system's native format. =head2 create I<Abstract> my $ok = $package->create(verbose => 0|1); Creates a package. =head2 install I<Abstract> my $ok = $package->install(verbose => 0|1); Installs the package. =head2 outputname I<Abstract> my $outputname = $package->outputname; Returns the package filename, e.g. F<~/rpmbuild/RPMS/noarch/perl-Some-Module-1.0-1.noarch.rpm>. =head2 module my $module = $package->module; Returns the L<CPANPLUS::Module> object that was passed to the constructor. =head2 installdirs my $installdirs = $package->installdirs; Returns the installation location, which can be "vendor" or "site". Defaults to "vendor". =head2 sourcefile my $sourcefile = $package->sourcefile; Returns the path to the Perl distribution's source archive, e.g. F<~/.cpanplus/authors/id/S/SO/SOMEBODY/Some-Module-1.0.tar.gz>. =head2 sourcedir my $sourcedir = $package->sourcedir; Returns the path to the Perl distribution's source directory, e.g. F<~/.cpanplus/authors/id/S/SO/SOMEBODY>. =head2 last_modification my $timestamp = $package->last_modification; Returns the last modification time of the source. =head2 builddir my $builddir = $package->builddir; Returns the directory the source archive was extracted to, e.g. F<~/.cpanplus/5.36.1/build/XXXX/Some-Module-1.0>. =head2 outputdir my $outputdir = $package->outputdir; Returns the build directory's parent directory, e.g. F<~/.cpanplus/5.36.1/build/XXXX>. =head2 stagingdir my $stagingdir = $package->stagingdir; Returns the staging directory where CPANPLUS installs the Perl distribution, e.g. F<~/.cpanplus/5.36.1/build/XXXX/stagingYYYY>. =head2 shared_objects for my $shared_object (@{$package->shared_objects}) { say $shared_object; } Returns a list of shared object files in the staging directory. This method must only be called after the distribution has been built. =head2 is_noarch my $is_no_arch = $package->is_noarch; Returns true if the package is independent of the hardware architecture. This method must only be called after the distribution has been built. =head2 module_name my $module_name = $package->module_name; Returns the name of the package's main module, e.g. "Some::Module". =head2 dist_name my $dist_name = $package->dist_name; Returns the Perl distribution's name, e.g. "Some-Module". =head2 name my $name = $package->name; Returns the package name, e.g. "perl-Some-Module" or "libsome-module-perl". =head2 dist_version my $dist_name = $package->dist_name; Returns the Perl distribution's version. =head2 version my $version = $package->version; Returns the package version. =head2 build_number my $build_number = $package->build_number; Returns the build number. Defaults to 1. The Debian revision and RPM release starts with the build number. =head2 author my $author = $package->author; Returns the name of the Perl distribution's author. =head2 packager my $packager = $package->packager; Returns the packager's name and email address. Taken from the RPM macro %packager, the environment variables C<DEBFULLNAME>, C<DEBEMAIL>, C<NAME>, C<EMAIL> or the password database. All environment variables and files have to be encoded in ASCII or UTF-8. =head2 vendor my $vendor = $package->vendor; Returns "CPANPLUS" or the value of the RPM macro C<%vendor>. =head2 url my $url = $package->url; Returns a web address that links to the Perl distribution's documentation, e.g. "https://metacpan.org/dist/Some-Module". =head2 summary my $summary = $package->summary; Returns the Perl distribution's one-line description. =head2 description my $description = $package->description; Returns the Perl distribution's description. =head2 dependencies for my $dependency (@{$package->dependencies}) { my $module_name = $dependency->{module_name}; my $dist_name = $dependency->{dist_name}; my $package_name = $dependency->{package_name}; my $version = $dependency->{version}; my $is_core = $dependency->{is_core}; my $is_module = $dependency->{is_module}; } Builds a list of Perl modules that the package depends on. =head2 copyrights for my $copyright (@{$package->copyrights}) { my $year = $copyright->{year}; my $holder = $copyright->{holder}; } Returns the copyright years and holders. =head2 licenses for my $license (@{$package->licenses}) { my $full_text = $license->license; } Returns L<Software::License> objects. =head2 license my $license = $package->license; Returns a license identifier, e.g. "Artistic-1.0-Perl OR GPL-1.0-or-later". Returns "Unknown" if no license information was found. =head2 files for my $file (@{$package->files}) { my $name = $file->{name}; my $type = $file->{type}; } Builds a list of files that CPANPLUS installed in the staging directory. Searches the build directory for README, LICENSE and other documentation files. Possible types are "changelog", "config", "dir", "doc", "file", "license", "link" and "man". =head2 files_by_type for my $file (@{$package->files_by_type($type)}) { my $name = $file->{name}; } Returns all files of the given type. =head2 mb_opt local $ENV{PERL_MB_OPT} = $package->mb_opt; Returns the options that are passed to C<perl Build.PL>. =head2 mm_opt local $ENV{PERL_MM_OPT} = $package->mm_opt; Returns the options that are passed to C<perl Makefile.PL>. =head2 sanitize_stagingdir my $ok = $package->sanitize_stagingdir; Fixes permissions. Removes empty directories and files like F<perllocal.pod> and F<.packlist>. =head2 remove_stagingdir my $ok = $package->remove_stagingdir; Removes the staging directory. =head2 rpm_cmd my $rpm_cmd = $self->rpm_cmd; Returns the path to the rpm command. =head2 rpm_eval my $expr = '%{?packager}'; my $string = $package->rpm_eval($expr); Evaluates an expression with rpm and returns the result or the empty string. =head2 sudo_cmd my $sudo_cmd = $self->sudo_cmd; Returns the path to the sudo command. =head1 DIAGNOSTICS See L<CPANPLUS::Dist::Debora> for diagnostics. =head1 CONFIGURATION AND ENVIRONMENT See L<CPANPLUS::Dist::Debora> for supported files and environment variables. =head1 DEPENDENCIES Requires the module L<Software::License> from CPAN. =head1 INCOMPATIBILITIES None. =head1 BUGS AND LIMITATIONS Some operating systems numify Perl distribution versions but not consistently. This module sticks closely to the version string, which seems to be the most common approach. =head1 SEE ALSO L<CPANPLUS::Dist::Debora::Package::Debian>, L<CPANPLUS::Dist::Debora::Package::RPM>, L<CPANPLUS::Dist::Debora::Package::Tar>, L<CPANPLUS::Dist::Debora::License>, L<CPANPLUS::Dist::Debora::Pod>, L<CPANPLUS::Dist::Debora::Util> =head1 AUTHOR Andreas Vögele E<lt>voegelas@cpan.orgE<gt> =head1 LICENSE AND COPYRIGHT Copyright (C) 2025 Andreas Vögele This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut