patchprov

#!/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