#!/usr/bin/perl
use strict;
use warnings;
use RPM::SpecEditor;
use Getopt::Long;

# Insert a dependency between another package dependencies. Return true if
# succeeded, otherwise false because no dependencies were supplied.
sub insert_between {
    my ($what, @dependencies) = @_;

    if (!@dependencies) {
        return 0;
    }

    # Locate last dependency smaller then a dependency to insert
    my $what_symbol = CORE::fc($what->getChild(0)->symbol);
    my $last_smaller;
    for (@dependencies) {
        if (CORE::fc($_->symbol) lt $what_symbol) {
            $last_smaller = $_;
            next;
        }
        if (CORE::fc($_->symbol) gt $what_symbol) {
            last;
        }
    }

    # Insert it after the last smaller
    if (defined $last_smaller) {
        if ($last_smaller->nextSibling) {
            $last_smaller->insertAfter($what->removeChild(0));
        } else {
            $last_smaller->getParent->insertAfter($what);
        }
        return 1;
    }

    # Or insert it before the first dependency because none is smaller
    if ($dependencies[0]->previousSibling) {
        $dependencies[0]->insertBefore($what->removeChild(0));
    } else {
        $dependencies[0]->getParent->insertBefore($what);
    }
    return 1;
}

# Add BuildRequires: perl-*
sub add_br_perl_dash {
    my ($dom, $what) = @_;

    # Already presented
    if ($dom->findDependencies('BuildRequires', $what)) {
        return;
    }

    # This perl-* dependency will be inserted on a suitable place.
    my $what_dependency = RPM::SpecEditor::Node->new(
        type => 'BuildRequires'
    )->addChild(RPM::SpecEditor::Node->new(
            type => 'dependency',
            symbol => $what
        )
    );

    # Insert between Perl package dependencies.
    if (insert_between($what_dependency,
            $dom->findDependencies('BuildRequires', qr/\Aperl(?:\z|-)/))) {
        return;
    }

    # Or insert before first Perl module dependency.
    if ((my $perl) = $dom->findDependencies('BuildRequires', qr/^perl\(/)) {
        $perl->getParent->insertBefore($what_dependency);
        return;
    }

    # Or insert between any dependencies according to lexicographical order
    if (insert_between($what_dependency,
            $dom->findDependencies('BuildRequires', undef))) {
        return;
    }

    # Or insert at the end of the main package section, but before any
    # kind of a dependency.
    my ($node, $last_nondep_tag);
    for ($node = $dom->getChild(0); defined $node; $node=$node->nextSibling) {
        if ($node->type eq 'line' and
            $node->value =~ /\A%(?:description|package)/) {
            last;
        }
        if ($node->isDependencyTag) {
            last;
        }
        if ($node->isTag) {
            $last_nondep_tag = $node;
        }

    }
    if (defined $last_nondep_tag) {
        $last_nondep_tag->insertAfter($what_dependency);
        return;
    }
    if (defined $node and $node->isDependencyTag) {
        # For a case when a dependency tag precedes a non-dependency tag
        $node->insertBefore($what_dependency);
        return;
    }

    # Or report an error
    die "I don't know where to insert `BuildRequires: $what'!\n";
}

# Renames dependencies, it preserves versions
sub rename_deps {
    my ($dom, $from, $to, @type) = @_;
    if (@type) {
        for my $what (@type) {
            for ($dom->findDependencies($what, $from)) {
                $_->symbol($to);
            }
        }
    } else {
        for ($dom->findDependencies(undef, $from)) {
            $_->symbol($to);
        }
    }
}


# Parse arguments
my @add_br_perl_dash;
my ($rename_dep_from, $rename_dep_to, @rename_dep_types);
GetOptions(
    'add-br-perl-dash=s' => \@add_br_perl_dash,
    'rename-dep-from=s' => \$rename_dep_from,
    'rename-dep-to=s' => \$rename_dep_to,
    'rename-dep-type=s' => \@rename_dep_types,
) or die "Wrong invocation!\n";

if ($rename_dep_from xor $rename_dep_to) {
    die "You need to specify both --rename-dep-from and --rename-dep-to options!\n"
}

my $file = $ARGV[0];

# Parse input spec
my $spec = RPM::SpecEditor->new(defined $file ?
    (file => $file) : (handle => \*STDIN));

# Perform requested modifications
for (@add_br_perl_dash) {
    add_br_perl_dash($spec->dom, $_);
}

if ($rename_dep_from) {
    rename_deps($spec->dom, $rename_dep_from, $rename_dep_to, @rename_dep_types);
}

# Save modifed spec
$spec->save(defined $file ? (file => $file) : (handle => \*STDOUT) );

__END__
=encoding utf8

=head1 NAME

rsemodernizeperl - Update Perl specfication file

=head1 SYNOPSIS

B<rsemodernizeperl> I<OPTIONS>

B<rsemodernizeperl> I<OPTIONS> I<SPEC_FILE>

=head1 DESCRIPTION

This tool parses an RPM specification from a file given as an argument or from
the standard input. Then it modifies the specification according to the
I<OPTIONS>. Finally, it save the modified specification into the I<SPEC_FILE>
file or to the standard output.

=head1 OPTIONS

=head2 --add-br-perl-dash=I<SYMBOL>

It adds a C<BuildRequires: I<SYMBOL>> tag into a proper place in the
specification. The symbol must be C<perl> or start with C<perl->. You can use
this option multiple times to insert different build-requires.

=head2 --rename-dep-from=I<OLD_SYMBOL>

=head2 --rename-dep-to=I<NEW_SYMBOL>

=head2 --rename-dep-type=I<TAG>

This replaces all occurrences of I<OLD_SYMBOL> dependencies
with I<NEW_SYMBOL> dependency. Both B<--rename-dep-from> and
B<--rename-dep-to> options must be specified at the same time. Version
constains will be preserved.

By default, all kinds of dependencies (BuildRequires, Conflicts, Provides
etc.) are renamed. You can use B<--rename-dep-type> option to restrict the
dependency type to I<TAG>. You can supply this option multiple times to affect
more dependency types.

=head1 EXIT CODE

Returns zero, if no error occurred. Otherwise non-zero code is returned.

=head1 EXAMPLE

To add build-time dependency on perl-generators:

    $ rsemodernizeperl --add-br-perl-dash=perl-generators perl-Foo.spec

To rename build- and run-time dependencies from perl to perl-interpreter:

    $ rsemodernizeperl --rename-dep-from=perl --rename-dep-to=perl-interpreter \
        --rename-dep-type=BuildRequires --rename-dep-type=Requires

=head1 AUTHOR

Petr Písař <ppisar@redhat.com>

=head1 COPYING

Copyright (C) 2016, 2017  Petr Písař <ppisar@redhat.com>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut

