summaryrefslogtreecommitdiffstats
path: root/bin
diff options
context:
space:
mode:
Diffstat (limited to 'bin')
-rwxr-xr-xbin/metas/perl.d/perl-dist699
1 files changed, 342 insertions, 357 deletions
diff --git a/bin/metas/perl.d/perl-dist b/bin/metas/perl.d/perl-dist
index c916a95..a829bb9 100755
--- a/bin/metas/perl.d/perl-dist
+++ b/bin/metas/perl.d/perl-dist
@@ -10,145 +10,137 @@ use LWP::UserAgent qw();
use YAML::XS qw();
use version qw();
-# Override a package's name to conform to packaging guidelines.
-# Copied entries from CPANPLUS::Dist::Pacman and alot more
-# from searching for packages with perl in their name in
-# [extra] and [community]
-my %OVERRIDE = map { split /[\s=]+/ } split /\s*\n+\s*/, <<'END_OVERRIDES';
-
-libwww-perl = perl-libwww
-aceperl = perl-ace
-mod_perl = mod_perl
-
-glade-perl-two = perl-glade-two
-Gnome2-GConf = gconf-perl
-Gtk2-GladeXML = glade-perl
-Glib = glib-perl
-Gnome2 = gnome-perl
-Gnome2-VFS = gnome-vfs-perl
-Gnome2-Canvas = gnomecanvas-perl
-Gnome2-GConf = gconf-perl
-Gtk2 = gtk2-perl
-Cairo = cairo-perl
-Pango = pango-perl
-
-Perl-Critic = perl-critic
-Perl-Tidy = perl-tidy
-App-Ack = ack
-TermReadKey = perl-term-readkey
-
-END_OVERRIDES
+# Match unpredictible package names .
+my %OVERRIDE =
+ ('libwww-perl' => 'perl-libwww',
+ 'aceperl' => 'perl-ace',
+ 'mod_perl' => 'mod_perl',
+ 'glade-perl-two' => 'perl-glade-two',
+ 'Gnome2-GConf' => 'gconf-perl',
+ 'Gtk2-GladeXML' => 'glade-perl',
+ 'Glib' => 'glib-perl',
+ 'Gnome2' => 'gnome-perl',
+ 'Gnome2-VFS' => 'gnome-vfs-perl',
+ 'Gnome2-Canvas' => 'gnomecanvas-perl',
+ 'Gnome2-GConf' => 'gconf-perl',
+ 'Gtk2' => 'gtk2-perl',
+ 'Cairo' => 'cairo-perl',
+ 'Pango' => 'pango-perl',
+ 'Perl-Critic' => 'perl-critic',
+ 'Perl-Tidy' => 'perl-tidy',
+ 'App-Ack' => 'ack',
+ 'TermReadKey' => 'perl-term-readkey');
sub dist2pkg
{
- my ($name, $ver) = @_;
- return dist_pkgname($name), dist_pkgver($ver);
+ my ($name, $ver) = @_;
+ return dist_pkgname($name), dist_pkgver($ver);
}
# Copied from CPANPLUS::Dist::Arch
sub dist_pkgname
{
- my ($distname) = @_;
+ my ($distname) = @_;
- return $OVERRIDE{$distname} if exists $OVERRIDE{$distname};
+ return $OVERRIDE{$distname} if(exists($OVERRIDE{$distname}));
- # Package names should be lowercase and consist of alphanumeric
- # characters only (and hyphens!)...
- $distname = lc $distname;
- $distname =~ tr/_+/--/;
- $distname =~ tr/-a-z0-9//cd; # Delete all other chars
- $distname =~ tr/-/-/s;
+ # Package names should be lowercase and consist of alphanumeric
+ # characters only (and hyphens!)...
+ $distname = lc($distname);
+ $distname =~ tr/_+/--/;
+ $distname =~ tr/-a-z0-9//cd; # Delete all other chars
+ $distname =~ tr/-/-/s;
- # Delete leading or trailing hyphens...
- $distname =~ s/\A-//;
- $distname =~ s/-\z//;
+ # Delete leading or trailing hyphens...
+ $distname =~ s/\A-//;
+ $distname =~ s/-\z//;
- die qq{Dist name '$distname' completely violates packaging standards}
- if length $distname == 0;
+ die qq{Dist name '$distname' completely violates packaging standards}
+ if(length($distname) == 0);
- # Don't prefix the package with perl- if it IS perl...
- $distname = "perl-$distname" unless $distname eq 'perl';
+ # Don't prefix the package with perl- if it IS perl...
+ $distname = "perl-$distname" unless($distname eq 'perl');
- return $distname;
+ return $distname;
}
sub dist_pkgver
{
- my ($version) = @_;
+ my ($version) = @_;
- # Remove developer versions because pacman has no special logic
- # to handle comparing them to regular versions such as perl uses.
- $version =~ s/_[^_]+\z//;
+ # Remove developer versions because pacman has no special logic
+ # to handle comparing them to regular versions such as perl uses.
+ $version =~ s/_[^_]+\z//;
- # Package versions should be numbers and decimal points only...
- $version =~ tr/-_/../;
- $version =~ tr/0-9.//cd;
+ # Package versions should be numbers and decimal points only...
+ $version =~ tr/-_/../;
+ $version =~ tr/0-9.//cd;
- $version =~ tr/././s;
- $version =~ s/^[.]|[.]$//g;
+ $version =~ tr/././s;
+ $version =~ s/^[.]|[.]$//g;
- return $version;
+ return $version;
}
#---HELPER FUNCTION---
# Decide if the dist. is named after the module.
sub _ismainmod
{
- my ($mod_name, $dist_name) = @_;
+ my ($mod_name, $dist_name) = @_;
- $mod_name =~ tr/:/-/s;
- return (lc $mod_name) eq (lc $dist_name);
+ $mod_name =~ tr/:/-/s;
+ return lc($mod_name) eq lc($dist_name);
}
#---HELPER FUNCTION---
# Merges the right-hand deps into the left-hand deps.
sub _merge
{
- my ($left_deps, $right_deps) = @_;
-
- MERGE_LOOP:
- while ( my ($pkg, $ver) = each %$right_deps ) {
- if ( $left_deps->{$pkg} ) {
- my $leftver = version->parse($left_deps->{$pkg});
- my $rightver = version->parse($ver);
- next MERGE_LOOP if $leftver > $rightver;
- }
- $left_deps->{$pkg} = $ver;
- }
-
- return;
+ my ($left_deps, $right_deps) = @_;
+
+ MERGE_LOOP:
+ while(my ($pkg, $ver) = each(%$right_deps)) {
+ if($left_deps->{$pkg}) {
+ my $leftver = version->parse($left_deps->{$pkg});
+ my $rightver = version->parse($ver);
+ next MERGE_LOOP if $leftver > $rightver;
+ }
+ $left_deps->{$pkg} = $ver;
+ }
+
+ return;
}
#---HELPER FUNCTION---
# Merge duplicate deps into $left always storing the greatest version there.
sub _mergedups
{
- my ($left, $right) = @_;
+ my ($left, $right) = @_;
- for my $name (keys %$left) {
- my $rver = delete $right->{$name} or next;
- my $lver = $left->{$name};
- my $lvo = ($lver ? version->parse($lver) : 0);
- my $rvo = ($rver ? version->parse($rver) : 0);
- $left->{$name} = ($lvo > $rvo ? $lvo : $rvo);
- }
+ for my $name (keys %$left) {
+ my $rver = delete($right->{$name}) or next;
+ my $lver = $left->{$name};
+ my $lvo = ($lver ? version->parse($lver) : 0);
+ my $rvo = ($rver ? version->parse($rver) : 0);
+ $left->{$name} = ($lvo > $rvo ? $lvo : $rvo);
+ }
- return;
+ return;
}
#---HELPER FUNCTION---
sub _yankcheckers
{
- my ($deps_ref) = @_;
- my %checkdeps;
+ my ($deps_ref) = @_;
+ my %checkdeps;
- for my $testdep (grep { /^perl-pod-coverage$|perl-test-/ }
- keys %$deps_ref) {
- my $val = delete $deps_ref->{$testdep};
- $checkdeps{$testdep} = $val if defined $val;
- }
+ my @pkgs = keys %$deps_ref;
+ for my $testdep (grep { /^perl-pod-coverage$|perl-test-/ } @pkgs){
+ my $val = delete($deps_ref->{$testdep});
+ $checkdeps{$testdep} = $val if(defined($val));
+ }
- return \%checkdeps;
+ return \%checkdeps;
}
#---HELPER FUNCTION---
@@ -156,33 +148,33 @@ sub _yankcheckers
# form that the official ArchLinux perl package uses.
sub _perldepver
{
- my ($perlver) = @_;
+ my ($perlver) = @_;
- # Fix perl-style vstrings which have a leading "v".
- return $perlver if $perlver =~ s/\Av//;
- return $perlver unless $perlver =~ /\A(\d+)[.](\d{3})(\d{1,3})\z/;
+ # Fix perl-style vstrings which have a leading "v".
+ return $perlver if($perlver =~ s/\Av//);
+ return $perlver unless($perlver =~ /\A(\d+)[.](\d{3})(\d{1,3})\z/);
- # Re-apply the missing trailing zeroes.
- my $patch = $3;
- $patch .= q{0} x (3 - length($patch));
- return sprintf '%d.%d.%d', $1, $2, $patch;
+ # Re-apply the missing trailing zeroes.
+ my $patch = $3;
+ $patch .= q{0} x (3 - length($patch));
+ return sprintf('%d.%d.%d', $1, $2, $patch);
}
#---PUBLIC FUNCNTION---
# Translates CPAN module dependencies into ArchLinux package dependencies.
sub _reqs2deps
{
- my ($prereqs) = @_;
-
- my %pkgdeps;
-
- CPAN_DEP_LOOP:
- while (my ($name, $ver) = each %$prereqs) {
- # Sometimes a perl version is given as a prerequisite
- if ($name eq 'perl') {
- $pkgdeps{'perl'} = _perldepver($ver);
- next CPAN_DEP_LOOP;
- }
+ my ($prereqs) = @_;
+
+ my %pkgdeps;
+
+ CPAN_DEP_LOOP:
+ while(my ($name, $ver) = each(%$prereqs)) {
+ # Sometimes a perl version is given as a prerequisite
+ if($name eq 'perl') {
+ $pkgdeps{'perl'} = _perldepver($ver);
+ next CPAN_DEP_LOOP;
+ }
# Ideally we could take advantage of the perl package's provides list
# and add dependencies for core modules.
@@ -197,114 +189,114 @@ sub _reqs2deps
# as well. So until I get around to reporting these bugs I will
# just go back to not depending on packages provided by perl.
- # 0+$] is needed to force the perl version into number-dom
- # otherwise trailing zeros cause problems
- my $bundled_version = $Module::CoreList::version{ 0 + $] }->{$name};
- if ($bundled_version) {
- # Avoid parsing an empty string (causes an error) or 0.
- next CPAN_DEP_LOOP unless $ver;
-
- # Avoid parsing a bundled version of 0. Is this possible?
- my $bundle_vobj = version->parse($bundled_version);
- my $dep_vobj = version->parse($ver);
- next CPAN_DEP_LOOP if $bundle_vobj >= $dep_vobj;
- }
-
- my $dist = _distofmod($name);
- my $pkgname = dist_pkgname($dist);
-
- # If the module is not named after the distribution, ignore its
- # version which might not match the distribution.
- undef $ver unless _ismainmod($name, $dist);
-
- # If two module prereqs are in the same CPAN distribution then
- # the version required for the main module will override.
- # (because versions specified for other modules in the dist
- # are 0)
- $pkgdeps{$pkgname} ||= ($ver ? dist_pkgver($ver) : 0);
- }
-
- return \%pkgdeps;
+ # 0+$] is needed to force the perl version into number-dom
+ # otherwise trailing zeros cause problems
+ my $bundled_version = $Module::CoreList::version{0+$]}->{$name};
+ if($bundled_version) {
+ # Avoid parsing an empty string (causes an error) or 0.
+ next CPAN_DEP_LOOP unless($ver);
+
+ # Avoid parsing a bundled version of 0. Is this possible?
+ my $bundle_vobj = version->parse($bundled_version);
+ my $dep_vobj = version->parse($ver);
+ next CPAN_DEP_LOOP if($bundle_vobj >= $dep_vobj);
+ }
+
+ my $dist = _distofmod($name);
+ my $pkgname = dist_pkgname($dist);
+
+ # If the module is not named after the distribution, ignore its
+ # version which might not match the distribution.
+ undef $ver unless(_ismainmod($name, $dist));
+
+ # If two module prereqs are in the same CPAN distribution then
+ # the version required for the main module will override.
+ # (because versions specified for other modules in the dist
+ # are 0)
+ $pkgdeps{$pkgname} ||= ($ver ? dist_pkgver($ver) : 0);
+ }
+
+ return \%pkgdeps;
}
sub prereqs
{
- my ($pkgname, $prereqs) = @_;
-
- # maps perl names for different dependencies to ArchLinux's names
- my %namemap = ('configure' => 'makedepends',
- 'build' => 'makedepends',
- 'test' => 'checkdepends',
- 'runtime' => 'depends');
-
- my %pkgdeps;
- while (my ($perl, $arch) = each %namemap) {
- my $reqs = $prereqs->{$perl}{'requires'};
- my $deps; $deps = _reqs2deps($reqs) if $reqs;
-
- next unless keys %$deps;
- if ($pkgdeps{$arch}) { _merge($pkgdeps{$arch}, $deps); }
- else { $pkgdeps{$arch} = $deps; }
- }
-
- # ArchLinux now has a separate array for dependencies that we only
- # need for checking (aka "testing"). Older perl METAs do not
- # have this separated. Force any test modules to be checkdepends.
- if (! $pkgdeps{'checkdepends'} && $pkgname !~ /\Aperl-test-/) {
- my $checkdeps = {};
- my $makedeps = $pkgdeps{'makedepends'};
- _merge($checkdeps, _yankcheckers($makedeps));
- $pkgdeps{'checkdepends'} = $checkdeps;
- }
-
- # We at least require perl, if nothing else.
- unless (grep { scalar keys %$_ > 0 } values %pkgdeps) {
- $pkgdeps{'depends'}{'perl'} = 0;
- }
-
- _mergedups(@pkgdeps{qw/makedepends checkdepends/});
- _mergedups(@pkgdeps{qw/depends makedepends/});
-
- # Convert all deps into arrays of strings.
- for my $deptype (keys %pkgdeps) {
- $pkgdeps{$deptype} = _stringify($pkgdeps{$deptype});
- }
-
- return \%pkgdeps;
+ my ($pkgname, $prereqs) = @_;
+
+ # maps perl names for different dependencies to ArchLinux's names
+ my %namemap = ('configure' => 'makedepends',
+ 'build' => 'makedepends',
+ 'test' => 'checkdepends',
+ 'runtime' => 'depends');
+
+ my %pkgdeps;
+ while (my ($perl, $arch) = each(%namemap)) {
+ my $reqs = $prereqs->{$perl}{'requires'};
+ my $deps; $deps = _reqs2deps($reqs) if($reqs);
+
+ next unless(keys(%$deps));
+ if($pkgdeps{$arch}) { _merge($pkgdeps{$arch}, $deps); }
+ else { $pkgdeps{$arch} = $deps; }
+ }
+
+ # ArchLinux now has a separate array for dependencies that we only
+ # need for checking (aka "testing"). Older perl METAs do not
+ # have this separated. Force any test modules to be checkdepends.
+ if(!$pkgdeps{'checkdepends'} && $pkgname !~ /\Aperl-test-/) {
+ my $checkdeps = {};
+ my $makedeps = $pkgdeps{'makedepends'};
+ _merge($checkdeps, _yankcheckers($makedeps));
+ $pkgdeps{'checkdepends'} = $checkdeps;
+ }
+
+ # We at least require perl, if nothing else.
+ unless(grep { scalar(keys(%$_)) > 0 } values(%pkgdeps)) {
+ $pkgdeps{'depends'}{'perl'} = 0;
+ }
+
+ _mergedups(@pkgdeps{'makedepends', 'checkdepends'});
+ _mergedups(@pkgdeps{'depends', 'makedepends'});
+
+ # Convert all deps into arrays of strings.
+ for my $deptype (keys(%pkgdeps)) {
+ $pkgdeps{$deptype} = _stringify($pkgdeps{$deptype});
+ }
+
+ return \%pkgdeps;
}
#---HELPER FUNCTION---
sub _stringify
{
- my ($deps) = @_;
+ my ($deps) = @_;
- my @depstrs;
- for my $pkg (sort keys %$deps) {
- my $ver = $deps->{$pkg};
- my $str = ($ver eq '0' ? $pkg : "$pkg>=$ver");
- push @depstrs, $str;
- }
+ my @depstrs;
+ for my $pkg (sort(keys(%$deps))) {
+ my $ver = $deps->{$pkg};
+ my $str = ($ver eq '0' ? $pkg : "$pkg>=$ver");
+ push(@depstrs, $str);
+ }
- return \@depstrs;
+ return \@depstrs;
}
my $UA;
sub _distofmod
{
- my ($mod) = @_;
+ my ($mod) = @_;
- my $UA ||= LWP::UserAgent->new();
- my $url = "http://cpanmetadb.appspot.com/v1.0/package/$mod";
- my $resp = $UA->get($url);
- die "failed to lookup dist for $mod: " . $resp->status_line
- unless $resp->is_success;
+ my $UA ||= LWP::UserAgent->new();
+ my $url = "http://cpanmetadb.appspot.com/v1.0/package/$mod";
+ my $resp = $UA->get($url);
+ die "failed to lookup dist for $mod: " . $resp->status_line
+ unless($resp->is_success);
- $resp = YAML::XS::Load($resp->content);
- my $file = $resp->{'distfile'};
- $file =~ s{.*/}{};
- $file =~ s{-[^-]+\z}{};
+ $resp = YAML::XS::Load($resp->content);
+ my $file = $resp->{'distfile'};
+ $file =~ s{.*/}{};
+ $file =~ s{-[^-]+\z}{};
- return $file;
+ return $file;
}
#-----------------------------------------------------------------------------
@@ -315,252 +307,245 @@ use File::Basename qw(basename dirname);
use File::Spec::Functions qw(catfile catdir);
use File::Find qw(find);
-use JSON::XS qw(decode_json); # parse META.{json,yml} files
-use YAML::XS qw();
-use Pod::Select qw(); # search POD for description
+use JSON::XS qw(decode_json); # for META.json
+use YAML::XS (); # for META.yml
+use Pod::Select (); # search POD for description
-use Digest::MD5 qw(); # for md5sums & sha512sums
-use Digest::SHA qw();
+use Digest::MD5 (); # for md5sums & sha512sums
+use Digest::SHA ();
sub main
{
- my $distpath = shift or die "Usage: perl-dist [path to cpan dist file]\n";
- my $dir = dirname($distpath);
- my $file = basename($distpath);
- my $info = distinfo($file);
-
- chsrcdir(catdir($dir, 'src'), $file);
- $dir = extractdist($file);
-
- my $meta = loadmeta($dir);
- my $desc = $meta->{'abstract'};
- if (!$desc || $desc eq '~') {
- $meta->{'abstract'} = distdesc($dir, $info->{'mod'});
- }
-
- my ($name, $ver) = Convert::dist2pkg(@{$info}{'name', 'ver'});
- my $deps = Convert::prereqs($name, $meta->{'prereqs'});
-
- my %pbvars =
- ('pkgver' => $ver,
- 'pkgdesc' => $meta->{'abstract'},
-
- 'arch' => (xsdist($dir) ? ['i686', 'x86_64'] : 'any'),
- 'md5sums' => md5sums($file),
- 'sha512sums' => sha512sums($file),
- 'distdir' => $dir,
- %$deps,
- );
-
- # Since this is a perl distribution, use the perl-pkg template.
- printf "template\nperl-pkg %s\n\n", (-f "$dir/Build.PL" ? "MB" : "MM");
-
- printmeta(\%pbvars);
+ my $distpath = shift() or die "Usage: perl-dist [path to cpan dist file]\n";
+ my $dir = dirname($distpath);
+ my $file = basename($distpath);
+ my $info = distinfo($file);
+
+ chsrcdir(catdir($dir, 'src'), $file);
+ $dir = extractdist($file);
+
+ my $meta = loadmeta($dir);
+ my $desc = $meta->{'abstract'};
+ if(!$desc || $desc eq '~') {
+ $meta->{'abstract'} = distdesc($dir, $info->{'mod'});
+ }
+
+ my ($name, $ver) = Convert::dist2pkg(@{$info}{'name', 'ver'});
+ my $deps = Convert::prereqs($name, $meta->{'prereqs'});
+
+ my %pbvars =
+ ('pkgver' => $ver,
+ 'pkgdesc' => $meta->{'abstract'},
+ 'arch' => (xsdist($dir) ? ['i686', 'x86_64'] : 'any'),
+ 'md5sums' => md5sums($file),
+ 'sha512sums' => sha512sums($file),
+ 'distdir' => $dir,
+ %$deps,
+ );
+
+ # Since this is a perl distribution, use the perl-pkg template.
+ printf("template\nperl-pkg %s\n\n", (-f "$dir/Build.PL" ? "MB" : "MM"));
+
+ printmeta(\%pbvars);
+ return 0;
}
# Create the src/ directory and tarball symlink. Then chdir into it.
sub chsrcdir
{
- my ($srcdir, $distfile) = @_;
-
- unless (-d $srcdir) {
- mkdir $srcdir or die "mkdir $srcdir: $!";
- }
- chdir $srcdir or die "chdir $srcdir: $!";
- unless (-f $distfile) {
- symlink catfile('..', $distfile), $distfile or die "symlink $distfile: $!";
- }
+ my ($srcdir, $distfile) = @_;
- return $srcdir;
-}
+ unless(-d $srcdir) {
+ mkdir $srcdir or die "mkdir $srcdir: $!";
+ }
+ chdir($srcdir) or die "chdir $srcdir: $!";
+ unless(-f $distfile) {
+ symlink(catfile('..', $distfile), $distfile) or die "symlink $distfile: $!";
+ }
-sub envvar
-{
- my ($name) = @_;
- my $val = $ENV{uc $name};
- ($name => [ split /\s+/, $name ]);
+ return $srcdir;
}
sub distinfo
{
- my ($distfile) = @_;
-
- my @c = split /-/, $distfile;
- my $ver = pop @c;
- my $name = join q{-}, @c;
- my $mod = $name;
- $mod =~ s/-/::/g;
- return { 'name' => $name, 'ver' => $ver, 'mod' => $mod };
+ my ($distfile) = @_;
+
+ my @c = split(/-/, $distfile);
+ my $ver = pop(@c);
+ my $name = join(q{-}, @c);
+ my $mod = $name;
+ $mod =~ s/-/::/g;
+ return { 'name' => $name, 'ver' => $ver, 'mod' => $mod };
}
sub extractdist
{
- my ($file) = @_;
+ my ($file) = @_;
- system "bsdtar -xf $file";
- die "perl-dist: bsdtar failed to extract $file\n" unless $? == 0;
+ system("bsdtar -xf $file");
+ die "perl-dist: bsdtar failed to extract $file\n" unless($? == 0);
- opendir my $srcdir, '.' or die "opendir: $!";
- my @dirs = grep { -d $_ && !/\A[.]/ } readdir $srcdir;
- closedir $srcdir;
+ opendir(my $srcdir, '.') or die "opendir: $!";
+ my @dirs = grep { -d $_ && !/\A[.]/ } readdir($srcdir);
+ closedir($srcdir);
- die "perl-dist: many dirs (@dirs) inside the tarball $file\n"
- if @dirs > 1;
- die "perl-dist: no dirs found in tarball $file\n" if @dirs == 0;
- return $dirs[0];
+ die("perl-dist: many dirs (@dirs) inside the tarball $file\n")
+ if(@dirs > 1);
+ die("perl-dist: no dirs found in tarball $file\n") if(@dirs == 0);
+ return $dirs[0];
}
sub printmeta
{
- my ($pbvars) = @_;
- while (my ($name, $val) = each %$pbvars) {
- if (! defined $val || $val eq q{}) {
- warn "perl-dist: warning: $name is undefined\n";
- $val = q{};
- }
- print $name, "\n";
- print "$_\n" for (ref $val ? @$val : $val);
- print "\n";
- }
-
- # TODO: autodetect license type
- print "license\n$_\n\n" for (qw/PerlArtistic GPL/);
+ my ($pbvars) = @_;
+ while(my ($name, $val) = each(%$pbvars)) {
+ if(!defined($val) || $val eq q{}) {
+ warn("perl-dist: warning: $name is undefined\n");
+ $val = q{};
+ }
+ print($name, "\n");
+ print("$_\n") for (ref $val ? @$val : $val);
+ print("\n");
+ }
+
+ # TODO: autodetect license type
+ print("license\n$_\n\n") for (qw/PerlArtistic GPL/);
}
sub loadmeta
{
- my ($distdir) = @_;
+ my ($distdir) = @_;
- for my $metaext (qw/json yml/) {
- my $path = "$distdir/META.$metaext";
- next unless -f $path;
+ for my $metaext (qw/json yml/) {
+ my $path = "$distdir/META.$metaext";
+ next unless -f $path;
- open my $metafh, '<', $path or die "open: $!";
- my $meta = do { local $/; <$metafh> };
- close $metafh;
+ open(my $metafh, '<', $path) or die "open: $!";
+ my $meta = do { local $/; <$metafh> };
+ close($metafh);
- $meta = ($metaext eq 'json' ? decode_json($meta) :
- $metaext eq 'yml' ? YAML::XS::Load($meta) :
- die "internal error: unknown \$metaext: $metaext");
+ $meta = ($metaext eq 'json' ? decode_json($meta) :
+ $metaext eq 'yml' ? YAML::XS::Load($meta) :
+ die "internal error: unknown \$metaext: $metaext");
- upgrademeta($meta);
- return $meta;
- }
+ upgrademeta($meta);
+ return $meta;
+ }
- return undef;
+ return undef;
}
sub upgrademeta
{
- my ($meta) = @_;
+ my ($meta) = @_;
- return if exists $meta->{'prereqs'};
+ return if(exists($meta->{'prereqs'}));
- my $prereqs;
- $prereqs->{'configure'}{'requires'} = delete $meta->{'configure_requires'};
- $prereqs->{'build' }{'requires'} = delete $meta->{'build_requires'};
- $prereqs->{'runtime' }{'requires'} = delete $meta->{'requires'};
+ my $prereqs;
+ $prereqs->{'configure'}{'requires'} = delete($meta->{'configure_requires'});
+ $prereqs->{'build'}{'requires'} = delete($meta->{'build_requires'});
+ $prereqs->{'runtime'}{'requires'} = delete($meta->{'requires'});
- $meta->{'prereqs'} = $prereqs;
- return;
+ $meta->{'prereqs'} = $prereqs;
+ return;
}
sub xsdist
{
- my ($dir) = @_;
- my $isxs;
- find({ 'wanted' => sub { $isxs = 1 if /[.]xs$/ }, 'no_chdir' => 1 }, $dir);
- return $isxs;
+ my ($dir) = @_;
+ my $isxs;
+ find({ 'wanted' => sub { $isxs = 1 if(/[.]xs$/) }, 'no_chdir' => 1 }, $dir);
+ return $isxs;
}
#-----------------------------------------------------------------------------
sub distdesc
{
- my ($dir, $modname) = @_;
- return _poddesc($dir, $modname) || _readmedesc($dir, $modname);
+ my ($dir, $modname) = @_;
+ return _poddesc($dir, $modname) || _readmedesc($dir, $modname);
}
sub _poddesc
{
- my ($dir, $modname) = @_;
+ my ($dir, $modname) = @_;
- my $podselect = Pod::Select->new;
- $podselect->select('NAME');
+ my $podselect = Pod::Select->new;
+ $podselect->select('NAME');
- my $modpath = $modname; $modpath =~ s{::}{/}g;
- my $moddir = dirname($modpath);
- my $modfile = basename($modpath);
+ my $modpath = $modname; $modpath =~ s{::}{/}g;
+ my $moddir = dirname($modpath);
+ my $modfile = basename($modpath);
- # First check under lib/ for a "properly" pathed module, with
- # nested directories. Then search desperately for a .pm file that
- # matches the module's last name component.
+ # First check under lib/ for a "properly" pathed module, with
+ # nested directories. Then search desperately for a .pm file that
+ # matches the module's last name component.
- my @possible = glob "$dir/{lib/,}{$moddir/,}$modfile.{pod,pm}";
+ my @possible = glob("$dir/{lib/,}{$moddir/,}$modfile.{pod,pm}");
- PODSEARCH:
- for my $podpath ( @possible ) {
- next PODSEARCH unless -f $podpath;
+ PODSEARCH:
+ for my $podpath (@possible) {
+ next PODSEARCH unless(-f $podpath);
- # Read the NAME section of the POD into a scalar.
- my $namesect = q{};
- open my $podfile, '<', $podpath or next PODSEARCH;
- open my $podout, '>', \$namesect or die "open: $!";
+ # Read the NAME section of the POD into a scalar.
+ my $namesect = q{};
+ open(my $podfile, '<', $podpath) or next PODSEARCH;
+ open(my $podout, '>', \$namesect) or die "open: $!";
- $podselect->parse_from_filehandle($podfile, $podout);
+ $podselect->parse_from_filehandle($podfile, $podout);
- close $podfile;
- close $podout or die "close: $!";
+ close($podfile);
+ close($podout) or die "close: $!";
- next PODSEARCH unless $namesect;
+ next PODSEARCH unless($namesect);
- # Remove formatting codes.
- $namesect =~ s{ [IBCLEFSXZ] <(.*?)> }{$1}gxms;
- $namesect =~ s{ [IBCLEFSXZ] <<(.*?)>> }{$1}gxms;
+ # Remove formatting codes.
+ $namesect =~ s{ [IBCLEFSXZ] <(.*?)> }{$1}gxms;
+ $namesect =~ s{ [IBCLEFSXZ] <<(.*?)>> }{$1}gxms;
- # The short desc is on a line beginning with 'Module::Name - '
- return $1 if $namesect =~ / ^ \s* $modname [ -]+ ([^\n]+) /xms;
- }
+ # The short desc is on a line beginning with 'Module::Name - '
+ return $1 if($namesect =~ / ^ \s* $modname [ -]+ ([^\n]+) /xms);
+ }
- return undef;
+ return undef;
}
#---HELPER FUNCTION---
sub _readmedesc
{
- my ($dir, $modname) = @_;
+ my ($dir, $modname) = @_;
- my $path = catfile($dir, 'README');
- return undef unless -f $path;
- open my $fh, '<', $path or die "open: $!";
+ my $path = catfile($dir, 'README');
+ return undef unless(-f $path);
+ open(my $fh, '<', $path) or die "open: $!";
- while (<$fh>) {
- chomp;
- next unless /\ANAME/ ... /\A[A-Z]+/
- and / \A \s* ${modname} [\s\-]+ (.+) \z /x;
- return $1;
- }
+ while (<$fh>) {
+ chomp;
+ next unless((/\ANAME/ ... /\A[A-Z]+/)
+ && / \A \s* ${modname} [\s\-]+ (.+) \z /x);
+ return $1;
+ }
- close $fh;
- return undef;
+ close $fh;
+ return undef;
}
#-----------------------------------------------------------------------------
sub md5sums
{
- return [ map {
- open my $fh, '<', $_ or die "open: $!";
- my $md5 = Digest::MD5->new()->addfile($fh)->hexdigest;
- } @_ ]
+ return [ map {
+ open(my $fh, '<', $_) or die "open: $!";
+ my $md5 = Digest::MD5->new()->addfile($fh)->hexdigest;
+ } @_ ]
}
sub sha512sums
{
- return [ map {
- my $sha = Digest::SHA->new(512)->addfile($_)->hexdigest;
- } @_ ]
+ return [ map {
+ my $sha = Digest::SHA->new(512)->addfile($_)->hexdigest;
+ } @_ ]
}
-main(@ARGV);
+exit main(@ARGV);
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-11-29 16:33:31 +0100