Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 144 lines (123 sloc) 3.31 KB
#!/usr/bin/perl
##
## Name:
## patchprov
##
## Description:
## Patch the provides list in the perl package PKGBUILD. This script
## grabs provided libraries from perl and fills in provides array in
## PKGBUILD
##
## Usage:
## patchprov [path to PKGBUILD]
##
## Caveats:
## The path code is not platform independent and will only work in POSIX.
##
## Changelog:
## 06/10/14 JD Rewrite from scratch for perl 5.20.0 and ArchLinux.
## 23/12/28 MV Rewrite to use Perl directly
##
## Authors:
## Justin "juster" Davis <jrcd83@gmail.com>
## Mark Vainomaa <mikroskeem@mikroskeem.eu>
use warnings;
use strict;
use Module::CoreList;
sub err
{
print STDERR "patchprov: error: @_\n";
exit 1;
}
# TODO: why was this used at first place?
#my %distmods = (
# 'PathTools' => 'Cwd',
# 'Scalar-List-Utils' => 'List::Util',
# 'IO-Compress' => 'IO::Compress::Gzip',
#);
sub perlcorepkgs {
my @modules = ();
foreach my $m (Module::CoreList->find_modules()) {
# Grab module version
my $ver = $Module::CoreList::version{$]}{$m};
# Skip packages with undefined version values, as they are either:
# - not present in this version
# - internal core modules
if(!defined $ver) {
next;
}
# Fix up the module name
my $fixed = lc $m;
$fixed =~ s/::/-/g;
$fixed =~ s/perl-//;
$fixed =~ s/-perl$//;
push @modules, "perl-$fixed" . ((defined $ver) ? '=' . $ver : '');
}
return sort { lc($a) cmp lc($b) } @modules;
}
## Formats the provided lines into a neatly formatted bash array. The first arg
## is the name of the bash variable to assign it to.
sub basharray
{
my $vname = shift;
## Sort entries and surround with quotes.
my @lns = sort map { qq{'$_'} } @_;
$lns[0] = "$vname=($lns[0]";
## Indent lines for OCD geeks.
if (@lns > 1) {
my $ind = length($vname) + 2;
splice @lns, 1, @lns-1,
map { (' ' x $ind) . $_ } @lns[1 .. $#lns];
}
$lns[$#lns] .= ')';
return map { "$_\n" } @lns;
}
## Patch the PKGBUILD at the given path with a new provides array, overwriting
## the old one.
sub patchpb
{
my $pbpath = shift;
open my $fh, '<', $pbpath or die "open: $!";
my @lines = <$fh>;
close $fh;
my($i, $j);
for ($i = 0; $i < @lines; $i++) {
last if($lines[$i] =~ /^provides=/);
}
if ($i == @lines) {
err("failed to find provides array in PKGBUILD");
}
for ($j = $i; $j < @lines; $j++) {
last if($lines[$j] =~ /[)]/);
}
if ($j == @lines) {
err("failed to find end of provides array");
}
splice @lines, $i, $j-$i+1, basharray('provides', @_);
## Avoid corrupting the existing PKGBUILD in case of a crash, etc.
if (-f "$pbpath.$$") {
err("pbpath.$$ temporary file already exists, please remove it.");
}
open $fh, '>', "$pbpath.$$" or die "open: $!";
print $fh @lines;
close $fh or die "close: $!";
rename "$pbpath.$$", "$pbpath" or die "rename: $!";
return;
}
## Program entrypoint.
sub main
{
if (@_ < 1) {
print STDERR "usage: $0 [PKGBUILD path]\n";
exit 2;
}
my ($pbpath) = @_;
if (! -f $pbpath) {
err("$pbpath is not a valid file.");
} else {
patchpb($pbpath, perlcorepkgs());
}
exit 0;
}
main(@ARGV);
# EOF