diff options
author | Justin Davis <jrcd83@gmail.com> | 2011-10-07 21:02:44 +0200 |
---|---|---|
committer | Justin Davis <jrcd83@gmail.com> | 2011-10-07 21:02:44 +0200 |
commit | 8f99f0bafeb61b2f42650c703dedf377000cc53a (patch) | |
tree | 8e91235701852cd93d92f2c3f2b8c8c8386698ac | |
parent | 479da567c5bd8105e49cef7c6a92d8da85528690 (diff) | |
download | genpkg-8f99f0bafeb61b2f42650c703dedf377000cc53a.tar.gz genpkg-8f99f0bafeb61b2f42650c703dedf377000cc53a.tar.xz |
Reformat perl-dist perl script. Trying out a new style.
-rwxr-xr-x | bin/metas/perl.d/perl-dist | 699 |
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); |