prepare_spec

#! /usr/bin/perl -w
#
# vim:sw=2:et
#
# Copyright (C) 1958-2021 SUSE LLC
#
# 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 2 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/>.

use strict;
use Data::Dumper;
use File::Basename;

our $debug        = 0;
our $base_package = "";
our $header_name;

{

  package SPDXMapper;

  use Text::Balanced 'extract_bracketed';
  use Data::Dumper;

  sub new {
    my ($class, $name, $line) = @_;
    my $self = {changes => {}, allowed => {}, exceptions => {}};

    bless $self, $class;
    $self->init();
    return $self;
  }

  sub init {
    my $self      = shift;
    my $scriptdir = File::Basename::dirname($0);
    open(MAP, "$scriptdir/licenses_changes.txt") || die "can't open licenses_changes.txt";

    # ignore header
    readline(*MAP);
    my %spdx;
    while (<MAP>) {
      chomp;
      my ($license, $oldstring) = split(/\t/, $_, 2);
      next unless length($license);
      die "$oldstring is given twice in $_" if defined $self->{map}->{$oldstring};
      $self->{changes}->{$oldstring} = $license;
      $self->{allowed}->{$license}   = 1;
    }
    close(MAP);
    my $token = join '|',
      map { '(?:(?<=[\s()])|^)' . quotemeta . '(?:(?=[\s()])|$)' }
      sort { length $b <=> length $a } keys %{$self->{changes}};
    $self->{token_re} = qr/($token)/;
    open(LIST, "$scriptdir/licenses_exceptions.txt") || die "can't open licenses_exceptions.txt";
    while (<LIST>) {
      chomp;
      $self->{exceptions}->{$_} = 1;
    }
    close(LIST);
  }

  # Partial implementation of SPDX 2.1 (with changes for expressions used at SUSE)
  sub parse {
    my ($self, $string) = @_;

    unless ($string) {
      $self->{tree} = ({license => ''});
      return $self->{tree};
    }

    # Normalize licenses, convert ";" to "and"
    my $before = $string;
    $string =~ s/\s*;\s*/ and /g;
    $string =~ s/$self->{token_re}/$self->{changes}->{$1}/xgo;

    $self->{tokens} = [_tokenize($string)];

    # Tokenize and parse expression
    $self->{tree} = $self->_expression();
    return $self->{tree};
  }

  sub replace_spdx($) {
    my ($self, $license) = @_;
    my $tree = eval { $self->parse($license); };
    if (my $err = $@) {
      chomp $err;
      print STDERR "Can't parse '$license' as SPDX: $err\n" if $debug;
      return $license;
    }
    my $out = _tree_to_string(_sorted_tree($tree));
    return $out;
  }

  sub _eat_token {
    my $self = shift;
    shift @{$self->{tokens}};
  }

  sub _current_token {
    my $self = shift;
    return undef unless @{$self->{tokens}};
    return $self->{tokens}->[0];
  }

  sub _parse_with {
    my $self  = shift;
    my $first = $self->_current_token();
    if ($first eq '(') {
      $self->_eat_token();
      my $node = $self->_parse_or();
      die "problem" unless $self->_current_token() eq ')';
      $self->_eat_token();
      return $node;
    }
    else {
      die "'$first' is not a valid SPDX license" unless $self->{allowed}->{$first};
      $self->_eat_token();
      if (($self->_current_token() || '') eq 'with') {
        $self->_eat_token();
        my $exception = $self->_current_token();
        die "'$exception' is not a valid SPDX exception" unless $self->{exceptions}->{$exception};
        $self->_eat_token();
        return {license => $first, exception => $exception};
      }
      return {license => $first};
    }
  }

  sub _parse_and {
    my $self = shift;

    my $left = $self->_parse_with();
    while (defined $self->_current_token() && $self->_current_token() eq 'and') {
      $self->_eat_token();
      $left = {op => 'and', left => $left, right => $self->_parse_with()};
    }
    return $left;
  }

  sub _parse_or {
    my $self = shift;

    my $left = $self->_parse_and();
    while (defined $self->_current_token() && $self->_current_token() eq 'or') {
      $self->_eat_token();
      $left = {op => 'or', left => $left, right => $self->_parse_and()};
    }
    return $left;
  }

  sub _expression {
    my $self = shift;
    my $node = $self->_parse_or();
    die("left tokens " . $self->_current_token()) if $self->_current_token();
    return $node;
  }

  sub _sorted_tree {
    my $tree = shift;

    return $tree unless $tree->{op};

    my $lt = _sorted_tree($tree->{left});
    my $rt = _sorted_tree($tree->{right});
    if ((_tree_to_string($lt) cmp _tree_to_string($rt)) > 0) {
      $tree->{left}  = $rt;
      $tree->{right} = $lt;
    }
    else {
      $tree->{right} = $rt;
      $tree->{left}  = $lt;
    }

    return $tree;
  }

  sub _spdx {
    my ($self, $license) = @_;
    $self->{allowed}->{$license} ? $license : die "Invalid SPDX license: $license\n";
  }

  sub _tokenize {
    my $string = shift;

    # Ignore outer parentheses
    $string =~ s/^\s*\((.*)\)\s*$/$1/ if ((extract_bracketed($string, '()'))[0] // '') eq $string;

    # Macro
    die "Invalid license expression: $string\n" if index($string, '%') >= 0;

    my @tokens;
    while (length $string) {

      # Compound expression
      if ($string =~ /^\s*\(/) {
        (my $token, $string) = extract_bracketed SPDXMapper::_trim($string), '()';
        die "Invalid license expression: $string\n" unless defined $token;
        if (substr($token, 0, 1) eq '(') {
          $token = substr($token, 1, length($token) - 2);
          push @tokens, '(';
          push @tokens, _tokenize($token);
          push @tokens, ')';
        }
        else {
          push @tokens, $token if defined $token;
        }
      }

      # Operator
      elsif ($string =~ s/^\s+(and|or|with)//i) { push @tokens, lc $1 }

      # Simple expression
      elsif ($string =~ s/^\s*((?:(?!\s+and|\s+or|\s+with).)+)//i) {
        push @tokens, SPDXMapper::_trim $1;
      }

      # This should not happen
      else { die "Invalid license expression: $string\n" }
    }

    return @tokens;
  }

  sub _tree_to_string {
    my $tree = shift;

    if ($tree->{op}) {
      my $ls = _tree_to_string($tree->{left});
      $ls = _wrap_mixed($tree->{left}, $tree->{op}, $ls);
      my $rs = _tree_to_string($tree->{right});
      $rs = _wrap_mixed($tree->{right}, $tree->{op}, $rs);
      return sprintf("$ls %s $rs", uc $tree->{op});
    }

    if ($tree->{exception}) {
      return sprintf("%s WITH %s", $tree->{license}, $tree->{exception});
    }
    return $tree->{license};
  }


  sub _trim {
    my $str = shift;
    $str =~ s/^\s+//;
    $str =~ s/\s+$//;
    return $str;
  }

  sub _wrap_mixed {
    my ($tree, $op, $str) = @_;
    return $tree->{op} && $tree->{op} ne $op ? "($str)" : $str;
  }

  sub internal_test {
    my $self = shift;

    use Test::More;
    use Data::Dumper;
    my $tree = $self->parse("MIT AND Apache-2.0");
    is_deeply($tree, {'left' => {'license' => 'MIT'}, 'op' => 'and', 'right' => {'license' => 'Apache-2.0'}});

    $tree = $self->parse('Academic Free License 2.1');
    is_deeply($tree, {'license' => 'AFL-2.1'});

    $tree = $self->parse('AGPL-3.0-only and Ruby and Artistic-1.0');
    my $ast = {
      'left'  => {'left' => {'license' => 'AGPL-3.0-only'}, 'op' => 'and', 'right' => {'license' => 'Ruby'}},
      'op'    => 'and',
      'right' => {'license' => 'Artistic-1.0'}
    };
    is_deeply($tree, $ast);

    $tree = $self->parse('LGPL-2.1-or-later WITH WxWindows-exception-3.1');
    $ast  = {license => 'LGPL-2.1-or-later', exception => 'WxWindows-exception-3.1'};
    is_deeply($tree, $ast);

    $tree = $self->parse("MIT OR Apache-2.0 OR CC0-1.0");
    is_deeply(
      $tree,
      {
        'op'    => 'or',
        'left'  => {'right'   => {'license' => 'Apache-2.0'}, 'left' => {'license' => 'MIT'}, 'op' => 'or'},
        'right' => {'license' => 'CC0-1.0'}
      }
    );
    $tree
      = $self->parse(
      'GPL-2.0-or-later AND MIT OR (Apache-2.0 AND LGPL-2.1-or-later WITH WxWindows-exception-3.1) OR (BSD-3-Clause AND CC0-1.0)'
      );
    $ast = {
      'op'   => 'or',
      'left' => {
        'right' => {
          'left'  => {'license' => 'Apache-2.0'},
          'op'    => 'and',
          'right' => {'license' => 'LGPL-2.1-or-later', 'exception' => 'WxWindows-exception-3.1'}
        },
        'left' => {'right' => {'license' => 'MIT'}, 'left' => {'license' => 'GPL-2.0-or-later'}, 'op' => 'and'},
        'op'   => 'or'
      },
      'right' => {'right' => {'license' => 'CC0-1.0'}, 'op' => 'and', 'left' => {'license' => 'BSD-3-Clause'}}
    };
    is_deeply($tree, $ast);

    is($self->replace_spdx("MIT or GPL-2.0+"),          "GPL-2.0-or-later OR MIT");
    is($self->replace_spdx("GPL-2.0; GPL-3.0"),         "GPL-2.0-only AND GPL-3.0-only");
    is($self->replace_spdx("MIT or GPL-2.0+ and BSD3"), "(BSD-3-Clause AND GPL-2.0-or-later) OR MIT");
    is(
      $self->replace_spdx("MIT and GPL-2.0+ or BSD3 WITH GCC-exception-3.1 and CC0-1.0"),
      "(BSD-3-Clause WITH GCC-exception-3.1 AND CC0-1.0) OR (GPL-2.0-or-later AND MIT)"
    );

    done_testing();
  }
}

{

  package Section;

  sub new {
    my ($class, $name, $line) = @_;
    my $self = {name => $name, lines => [], before_lines => 0, after_lines => 0, comment => undef};
    push(@{$self->{lines}}, $line) if defined $line;

    bless $self, $class;
    return $self;
  }

  sub name {
    return shift->{name};
  }

  sub set_before_lines {
    my ($self, $nr) = @_;
    $self->{before_lines} = $nr;
  }

  sub set_after_lines {
    my ($self, $nr) = @_;
    $self->{after_lines} = $nr;
  }

  sub print_comment {
    my $self = shift;
    $self->{comment}->print() if $self->{comment};
  }

  sub print_before_lines {
    my $self = shift;
    for (my $i = 0; $i < $self->{before_lines}; $i++) { print "\n"; }
  }

  sub print_after_lines {
    my $self = shift;
    for (my $i = 0; $i < $self->{after_lines}; $i++) { print "\n"; }
  }

  sub add_line {
    my ($self, $line) = @_;
    if ($line) {
      if ($self->{after_lines}) {
        for (my $i = 0; $i < $self->{after_lines}; $i++) { push(@{$self->{lines}}, ""); }
        $self->{after_lines} = 0;
      }
      die "Don't add to empty" if $self->{name} eq 'empty';
      push(@{$self->{lines}}, $line);
    }
    else {
      $self->{after_lines} += 1;
    }
  }

  sub set_comment {
    my ($self, $comment) = @_;
    die "No 2 comments" if $self->{comment};
    $self->{comment} = $comment;
    die "unmergable comment" if $self->{before_lines};
    $self->{before_lines}    = $comment->{before_lines};
    $comment->{before_lines} = 0;
  }

  sub merge_with_empty_after {
    my ($self, $section) = @_;
    $self->{after_lines} += scalar(@{$section->{lines}});
    return 1;
  }

  sub merge_with_empty_before {
    my ($self, $section) = @_;
    $self->{before_lines} += scalar(@{$section->{lines}});
    return 1;
  }

  sub print {
    my $self = shift;
    if ($debug) {
      print "Section $self->{name} B:$self->{before_lines} A:$self->{after_lines}\n";
      if ($self->{comment}) {
        print("Has comment:\n");
        for my $line (@{$self->{comment}->{lines}}) {
          print "    $line\n";
        }
      }
      for my $line (@{$self->{lines}}) {
        print "    $line\n";
      }
    }
    else {
      $self->print_before_lines();
      $self->print_comment();
      for my $line (@{$self->{lines}}) {
        print "$line\n";
      }
      $self->print_after_lines();
    }
  }

}

{

  package Tag;

  use base 'Section';

  sub new {
    use Carp 'confess';
    my ($class, $name, $value, $package) = @_;
    confess "no package " unless $package;

    my $self = $class->SUPER::new($name, $value);
    $self->{package} = $package;

    bless $self, $class;
    return $self;
  }

  sub print {
    my $self = shift;
    die("something is fishy: " . Dumper($self))
      unless ($self->{before_lines} == 0 || $self->{comment})
      && $self->{after_lines} == 0
      && length($self->{lines}) != 1;
    if ($debug) {
      printf("TAG '%s' = '%s' (package %s)\n", $self->{name}, $self->value(), $self->{package});
    }
    else {
      $self->print_before_lines();
      $self->print_comment();
      printf("%-16s%s\n", $self->{name} . ": ", $self->value());
    }

  }

  # we don't want merges
  sub merge_with_empty_after {
    return 0;
  }

  # we don't want merges
  sub merge_with_empty_before {
    return 0;
  }

  sub value {
    return shift->{lines}->[0];
  }

  sub set_value {
    my ($self, $value) = @_;
    $self->{lines}->[0] = $value;
  }

  sub add_line {
    my ($self, $line) = @_;
    die "You can't add to Tags: add_line($self->{name}, $line)";
  }
}

{

  package Preamble;

  use base 'Section';

  sub print {
    use Time::localtime;

    my $self = shift;
    if ($debug) {
      print "PREAMBLE B:$self->{before_lines} A:$self->{after_lines}\n";
      return;
    }
    print "$self->{vim_mode}\n" if $self->{vim_mode};

    my $thisyear = $ENV{COPYRIGHT_YEAR};
    $thisyear ||= localtime($ENV{SOURCE_DATE_EPOCH} || time)->year() + 1900;
    my @copyrights = @{$self->{copyright} || []};
    unshift @copyrights, "# Copyright (c) $thisyear SUSE LLC";

    my $copy_list = join("\n", @copyrights);

    print "#\n";
    if ($header_name) {
      print "# spec file for package $header_name\n";
    }
    else {
      print "# spec file\n";
    }
    print <<EOF;
#
$copy_list
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
# upon. The license for this file, and modifications and additions to the
# file, is the same license as for the pristine package itself (unless the
# license for the pristine package is not an Open Source License, in which
# case the license is the MIT License). An "Open Source License" is a
# license that conforms to the Open Source Definition (Version 1.9)
# published by the Open Source Initiative.

# Please submit bugfixes or comments via https://bugs.opensuse.org/
#
EOF
    if (defined $self->{footer}) {
      for my $footer (@{$self->{footer}}) {
        print "$footer\n";
      }
    }
    $self->print_after_lines();
  }

  sub add_copyright {
    my ($self, $copyright) = @_;
    if (!defined $self->{copyright}) {
      $self->{copyright} = [];
    }
    push(@{$self->{copyright}}, $copyright);
  }

  sub set_vim_mode {
    my ($self, $line) = @_;
    $self->{vim_mode} = $line;
  }

  sub add_footer {
    my ($self, $footer) = @_;
    if (!defined $self->{footer}) {
      $self->{footer} = [];
    }
    push(@{$self->{footer}}, $footer);
  }
}

{

  package Parser;

  sub new {
    my ($class, $base_package) = @_;
    my $self = {'sections' => [], current_package => $base_package};
    bless $self, $class;
    push(@{$self->{sections}}, Preamble->new("preamble", undef));
    return $self;
  }

# description is a big absorber but if it ends in comments, those comments aren't meant for it
  sub _split_final_comments {
    my $self    = shift;
    my $section = $self->current();
    return unless $section->{after_lines};
    return unless $section->{lines}->[-1] =~ m/^#/;

    my $comment = Section->new("comment", undef);
    my @lines;
    while ($section->{lines}->[-1] =~ m/^#/) {
      my $line = pop @{$section->{lines}};
      unshift @{$comment->{lines}}, $line;
    }
    push(@{$self->{sections}}, $comment);
  }

  sub create_section {
    my ($self, $name, $line) = @_;

    # now worst hack ever
    $self->_split_final_comments() if $self->current_name() eq 'description';
    my $section = Section->new($name, $line);
    push(@{$self->{sections}}, $section);
    return $section;
  }

  sub create_tag_section {
    my ($self, $name, $line) = @_;
    push(@{$self->{sections}}, Tag->new($name, $line, $self->{current_package}));
  }

  sub create_icecream_section {
    my ($self, $line) = @_;
    $line =~ s/^#\s*icecream\s*//;
    $self->find("preamble")->add_footer("# icecream $line") if $line ne '';
  }

  sub create_copyright_section {
    my ($self, $line) = @_;
    my $copyright = $line;
    $copyright =~ s{\s*(\d+|copyrights?|\(c\)|suse|linux|products|gmbh|nuremberg|n..?rnberg|germany|\W+)\s*}{}gi;
    if (length($copyright) <= 5) {    # not much left
      return;
    }
    $self->find("preamble")->add_copyright($line);
  }

  sub add_to_current_section {
    my ($self, $line) = @_;
    $self->current()->add_line($line);
  }

  sub current {
    return shift->{sections}->[-1];
  }

  sub current_name {
    return shift->current()->name();
  }

  sub find {
    my ($self, $name) = @_;
    for my $section (@{$self->{sections}}) {
      if ($section->name() eq $name) {
        return $section;
      }
    }
    return undef;
  }

  sub delete_section {
    my ($self, $section) = @_;
    $self->{sections} = [grep { $_ != $section } @{$self->{sections}}];
  }

  sub capitalize_case {
    my ($self, $tag) = @_;

    $tag = lc($tag);

    $tag =~ s/docdir/DocDir/i;
    $tag =~ s/arch/Arch/i;
    $tag =~ s/patch/Patch/i;
    $tag =~ s/source/Source/i;
    $tag =~ s/req/Req/i;
    $tag =~ s/pre/Pre/;
    $tag =~ s/confl/Confl/i;
    $tag =~ s/prov/Prov/i;
    $tag =~ s/url/URL/i;
    $tag =~ s/^(\w)/uc($1)/e;

    return $tag;
  }

  sub print_all {
    my $self = shift;

    for my $sections (@{$self->{sections}}) {
      $sections->print();
    }
  }

  sub set_current_pkg {
    my ($self, $arg) = @_;
    print "DEBUG: set_current_pkg receiving $arg\n" if $debug;
    my (@argarray) = split('\s+', $arg);
    my $curpack = $base_package;
    while (my $carg = shift @argarray) {
      next if ($carg eq "%description" || $carg eq "%package" || $carg eq "%prep");
      if ($carg eq "-l") {
        shift @argarray;
      }
      elsif ($carg eq "-n") {
        $curpack = shift @argarray;
      }
      else {
        $curpack = "$base_package-" if $base_package;
        $curpack .= $carg;
      }
    }
    print "DEBUG: set_current_pkg returning $curpack\n" if $debug;
    return $curpack;
  }

  sub read_and_parse_spec {
    my ($self, $specfile) = @_;
    my $ifhandler;
    $ifhandler->{disabled}         = 0;
    $ifhandler->{depth}            = 0;
    $ifhandler->{last_if_disabled} = 0;

    my @readspec;
    open(SPEC, '<', "$specfile") || die "can't read specfile";
    @readspec = <SPEC>;
    close SPEC;
    chomp @readspec;

    my @global_tags_list = (
      'Autoreq',        'Autoreqprov',  'BuildArch',   'BuildArchitectures',
      'BuildRequires',  'Conflicts',    'DocDir',      'Enhances',
      'Enhances',       'EssentialFor', 'ExcludeArch', 'ExclusiveArch',
      'Freshens',       'Group',        'Name',        'NoPatch',
      'NoSource',       'Obsoletes',    'Patch\d*',    'Prefix',
      'PreReq',         'Provides',     'Recommends',  'Requires',
      'Source\d*',      'Suggests',     'Summary',     'Supplements',
      'URL',            'Version',      'License',     'Release',
      'BuildConflicts', 'BuildPreReq',  'RemovePathPostfixes'
    );

    my $global_tags_re = '^\s*(' . join("|", @global_tags_list) . ')\s*:';

    my $section_tags_re = '^\s*%(clean|changelog|check|prep|build|install|pre|post|preun|postun|'
      . 'posttrans|package|description|files|triggerin|triggerun|triggerpostun|verifyscript)\b';

    my $definelist;

    while (@readspec) {
      $_ = shift @readspec;

      # trim all trailing whitespace (including \r, see issue 33)
      $_ =~ s/\s+$//;

      if ($self->current_name() eq 'description') {
        unless (m/^%/) {
          $self->add_to_current_section($_);
          next;
        }
      }

      if (/^\s*$/) {
        if ($self->current_name() eq 'empty' || $self->current_name() eq 'preamble') {
          $self->add_to_current_section("");
        }
        else {
          $self->create_section("empty", "");
        }
        next;
      }

      if ($self->current_name() eq "preamble") {
        if (/^# vim:/) {
          $self->current()->set_vim_mode($_);
          next;
        }

        if (/^#\s*needsrootforbuild\s*$/) {
          $self->current()->add_footer("# needsrootforbuild");
          next;
        }
        if (/^#\s*needsbinariesforbuild\s*$/) {
          $self->current()->add_footer("# needsbinariesforbuild");
          next;
        }
        if (/^#\s*needssslcertforbuild\s*$/) {
          $self->current()->add_footer("# needssslcertforbuild");
          next;
        }
        if (/^#\s*needspubkeyforbuild\s*$/) {
          $self->current()->add_footer("# needspubkeyforbuild");
          next;
        }

        next if m/^#\s*usedforbuild/;
        next if m/^#\s*norootforbuild/;

        if (/^#\s*nodebuginfo\s*$/) {
          $self->current()->add_footer("# nodebuginfo");
          next;
        }

        if (/^#\s*icecream/) {
          $self->create_icecream_section($_);
          next;
        }

        if (/^#\s*Copyright\s*/) {
          $self->create_copyright_section($_);

          # copy out everything until next blank line
          while ($readspec[0] !~ m/^#\s*$/) {
            $self->create_copyright_section(shift @readspec);
          }
          next;
        }
      }

      if (/^%\?__\*BuildRequires:/ || /^#!__\*BuildRequires:/) {
        $self->create_section("masked", $_);
        next;
      }

      if (/^#!BuildIgnore:/) {
        $self->create_section("buildignore", $_);
        next;
      }

      if (/^#/) {
        if ( $self->current_name() eq "description"
          || $self->current_name() eq "comment"
          || ($self->current_name() eq "preamble" && $self->current()->{after_lines} < 2))
        {
          $self->add_to_current_section($_);
        }
        else {
          $self->create_section("comment", $_);
        }
        next;
      }

      # remove, we add this ourselves
      next if /^%debug_package/;

      if (/^%define\s*vendor\s/ || /^%define\s*distribution\s/) {
        next;
      }

      if (/^\s*%if/ || /^\s*%\{/ || /^\s*%define/ || /^\s*%global/ || /^\s*%el/ || /^\s*%endif/) {
        $self->create_section("header", $_);
        if (/^\s*%if\s/) {
          my @args = split(/\s+/, $_);
          $_ =~ s/[\{\}\"]//g for (@args);
          $ifhandler->{"last_if_args"}     = join(":", @args);
          $ifhandler->{"last_if_disabled"} = 0;
          $ifhandler->{"last_if_if"}       = 1;
          $ifhandler->{"depth"}++;
          my $if_not = 0;
          if ($args[1] =~ /^\!/) {
            $args[1] =~ s/^\!//;
            $if_not = 1;
          }
          $args[2] = "" unless $args[2];
          if (
               ($args[1] eq "0")
            || ($args[1] eq "%name" && $args[2] eq "!=" && $args[3] eq $base_package)
            || ($args[1] eq "%name" && $args[2] eq "==" && $args[3] ne $base_package)
            || ($args[1]         && !$args[3] && !$if_not && $definelist->{$args[1]} && $definelist->{$args[1]} eq "0")
            || ($args[2] eq "==" && $args[3] ne "0" && $definelist->{$args[1]} && $definelist->{$args[1]} eq "0")
            || ($args[2] eq "!=" && $args[3] eq "0" && $definelist->{$args[1]} && $definelist->{$args[1]} eq "0")
            || ($args[1]         && !$args[3] && $if_not && $definelist->{$args[1]} && $definelist->{$args[1]} eq "1")
            || ( $args[1]
              && $args[2] eq "!="
              && $args[3] eq "1"
              && $definelist->{$args[1]}
              && $definelist->{$args[1]} eq "1")
            )
          {
            $ifhandler->{"disabled"}         = $ifhandler->{"depth"};
            $ifhandler->{"last_if_disabled"} = 1;
          }
        }
        elsif (/^\s*%if/) {
          $ifhandler->{"last_if_args"}     = "other";
          $ifhandler->{"last_if_disabled"} = 0;
          $ifhandler->{"last_if_if"}       = 0;
          $ifhandler->{"depth"}++;
        }
        elsif (/^\s*%endif/) {
          $ifhandler->{"last_if_args"} = "";
          $ifhandler->{"disabled"}     = 0 if $ifhandler->{"disabled"} == $ifhandler->{"depth"};
          $ifhandler->{"depth"}--;
        }
        elsif (/^\s*%else/) {
          $ifhandler->{"last_if_args"} .= ":else";
          if ($ifhandler->{"disabled"} == $ifhandler->{"depth"} && $ifhandler->{"last_if_disabled"} == 1) {
            $ifhandler->{"disabled"} = 0;
          }
          elsif ($ifhandler->{"disabled"} == 0 && $ifhandler->{"depth"} == 1 && $ifhandler->{"last_if_if"} == 1) {
            $ifhandler->{"disabled"} = 1;
          }
        }
        elsif (/^\s*%define\s/ || /^\s*%global\s/) {
          my @args = split(/\s+/, $_);
          $_ =~ s/[\{\}\"]//g for (@args);
          $args[2] =~ s/\Q$_\E/$definelist->{$_}/g for sort { length($b) <=> length($a) } keys(%{$definelist});
          if ($args[2] && $args[2] !~ /[\(\)\{\}\@\%\"\\]/) {
            $definelist->{"%" . $args[1]}         = $args[2] if $ifhandler->{"disabled"} == 0;
            $definelist->{"%{" . $args[1] . "}"}  = $args[2] if $ifhandler->{"disabled"} == 0;
            $definelist->{"%{?" . $args[1] . "}"} = $args[2] if $ifhandler->{"disabled"} == 0;
          }
          while ($_ =~ /\\$/) {
            $_ = shift @readspec;
            $self->add_to_current_section($_);
          }
        }
        next;
      }

      if (/^%package\b/i) {
        $self->create_section("package", $_);
        $_ =~ s/^(%\w+)/lc($1)/e;
        if ($debug) {
          warn "key: $_ value: $definelist->{$_}\n" for (sort { length($b) <=> length($a) } keys(%{$definelist}));
        }
        for my $xx (sort { length($b) <=> length($a) } keys(%{$definelist})) {
          $_ =~ s/\Q$xx\E/$definelist->{$xx}/;
        }
        $_ =~ s/%\{\?[^\}]*}//;
        if ($debug) {
          warn "after: $_\n";
        }
        $self->{current_package} = $self->set_current_pkg($_);
        next;
      }

      if (/^%description\b/i) {
        $self->create_section("description", $_);
        next;
      }

      if (m/$section_tags_re/oi) {
        my $name = lc($1);
        $_ =~ s/^(%\w+)/lc($1)/e;
        $self->create_section(lc($name) . '-section', $_);
        next;
      }

      if (/^Vendor:/ || /^Distribution:/ || /^Packager:/) {
        next;
      }

      # remove default value of Autoreqprov
      if (/^Autoreqprov\s*:\s*(.*)/i) {
        next if (lc($1) eq "on" || lc($1) eq "yes");
      }

      if (/^Copyright\s*:\s*(.*)\s*$/i) {
        $self->create_tag_section("License", $1);
        next;
      }

      if (/^BuildArchitectures\s*:/i) {
        $_ =~ s/^[^:]+:/BuildArch:/;
      }

      if (/^BuildRoot\s*:/i) {
        $self->create_tag_section("BuildRoot", "%{_tmppath}/%{name}-%{version}-build");
        next;
      }
      if (m/^(Requires\([^:\s]*\))\s*:\s*(.*)/oi) {
        $self->create_tag_section($1, $2);
        next;
      }

      if (m/^(Summary\([^:\s]*\))\s*:\s*(.*)/oi) {
        $self->create_tag_section($self->capitalize_case($1), $2);
        next;
      }
      if (m/$global_tags_re\s*(.*)/oi) {
        $self->create_tag_section($self->capitalize_case($1), $2);
        next;
      }

      if (m/^(Patch\d*):\s*(.*)/oi || m/^(Source\d*):\s*(.*)/oi) {
        $self->create_tag_section($self->capitalize_case($1), $2);
        next;
      }

      if ( $self->current_name() ne 'empty'
        && $self->current_name() ne 'comment'
        && ref($self->current()) ne 'Tag'
        && $self->current_name() ne 'preamble')
      {
        $self->add_to_current_section($_);
      }
      else {
        $self->create_section("line", $_);
      }
    }
  }

  sub fix_release_tag {
    my $self         = shift;
    my $foundrelease = 0;
    for my $section (@{$self->{sections}}) {
      if ($section->name() eq 'Release') {
        $foundrelease = 1;
        if ($section->value() =~ m/^[0-9]*$/) {
          $section->set_value("0");
        }
      }
    }
    return if $foundrelease;
    for my $i (0 .. scalar(@{$self->{sections}}) - 1) {
      my $section = $self->{sections}->[$i];
      if ($section->name() eq 'Version') {
        splice @{$self->{sections}}, $i + 1, 0, (Tag->new("Release", "0", $section->{package}));
        return;
      }
    }

  }

  sub _section_to_ignore {
    my ($section, $lastsection) = @_;

    # a very special case that we see often is %if ... surrounding sections
    return 1 if $lastsection->{lines}->[0] =~ m/%if/;
    return 1 if $section->{lines}->[0]     =~ m/%(post|postun|pre|preun) .*-p /;
    return 0;
  }

  sub set_section_whitespace {
    my $self = shift;

    # 2 empty lines after preamble
    $self->find("preamble")->set_after_lines(2);

    # one line before each section
    my $lastsection = undef;
    for my $section (@{$self->{sections}}) {
      if ($lastsection && $lastsection->name() eq 'preamble') {
        $section->set_before_lines(0);
      }
      elsif ((grep { $section->name() eq $_ } (qw/description package/)) || $section->name() =~ m/-section$/) {

        if (!_section_to_ignore($section, $lastsection)) {
          $lastsection->set_after_lines(0);
          $section->set_before_lines(1);
        }
      }
      $lastsection = $section;
    }
  }

  # make comments a subsection
  sub merge_comments() {
    my $self = shift;

  comments_before:

    my $lastsection = undef;
    for my $section (@{$self->{sections}}) {
      if ($lastsection && $lastsection->name() eq 'comment') {
        if ($lastsection->{after_lines} + $section->{before_lines} == 0) {
          $section->set_comment($lastsection);
          $self->delete_section($lastsection);
          goto comments_before;
        }
      }
      $lastsection = $section;
    }

  }

  sub merge_empty_sections {
    my $self = shift;

  sections_before:

    # first we merge empty with sections before
    my $lastsection;
    for my $section (@{$self->{sections}}) {
      if ($section->name() eq 'empty') {
        if ($lastsection->merge_with_empty_after($section)) {
          $self->delete_section($section);
          goto sections_before;
        }
      }
      $lastsection = $section;
    }

  sections_after:

    # and then try to do the same with sections after (as tags can't be merged)
    $lastsection = undef;
    for my $section (@{$self->{sections}}) {
      if ($lastsection && $lastsection->name() eq 'empty') {
        if ($section->merge_with_empty_before($lastsection)) {
          $self->delete_section($lastsection);
          goto sections_after;
        }
      }
      $lastsection = $section;
    }
  }

  sub split_tag {
    my ($self, $section) = @_;
    my %aa;
    my $value = $section->value();

    # support very special macros only
    my %replacements = (
      'MACRO-VERSION'  => '%{version}',
      'MACRO-RELEASE'  => '%{release}',
      'MACRO-NAME'     => '%{name}',
      'MACRO-FILLUP'   => '%fillup_prereq',
      'MACRO-INSSEREV' => '%insserv_prereq'
    );
    for my $replacement (keys %replacements) {
      $value =~ s,\Q$replacements{$replacement}\E,$replacement,g;
    }
    if ($value =~ /%/ || $value =~ /^\(/) {

      # do not touch lines with macros we don't know
      return undef;
    }

    # replace every comma not in brackets with a space
    # "modalias(foo,bar)" should not be split, but "foo,bar"
    # TODO: find out why /g without while doesn't cut the bill
    while ($value =~ s/^([^(,]*),/$1 /g) { }
    while ($value =~ m{([^<=>\s]+(\s*[<=>]+\s*[^,\s]+)?)}g) {
      $aa{$1} = 1;
    }
    if (scalar keys %aa > 1) {
      my @newtags;
      for my $key (keys %aa) {
        for my $replacement (keys %replacements) {
          $key =~ s,$replacement,$replacements{$replacement},g;
        }
        push(@newtags, Tag->new($section->name(), $key, $section->{package}));
      }
      return \@newtags;
    }
    return undef;
  }

  # put cmake() and pkgconfig() at the end
  sub _sort_tags_helper {
    my ($a, $b) = @_;
    if (($a =~ /^[^#]*\(/) != ($b =~ /^[^#]*\(/)) {
      if ($a =~ /^[^#]*\(/) {
        1;
      }
      else {
        -1;
      }
    }
    else {
      $a cmp $b;
    }
  }

  sub reorder_tag {
    my ($self, $tag) = @_;

    my $switched;

    do {
      $switched = 0;
      my $lastsection;
      for my $i (0 .. scalar(@{$self->{sections}}) - 1) {
        my $section = $self->{sections}->[$i];
        if ($section->name() eq $tag && !$section->{comment}) {
          my $newtags = $self->split_tag($section);
          if ($newtags) {
            splice @{$self->{sections}}, $i, 1, @$newtags;
            $switched = 1;
            last;
          }
          if ($lastsection) {
            if (_sort_tags_helper($section->value(), $lastsection->value()) < 0) {
              $self->{sections}->[$i]     = $lastsection;
              $self->{sections}->[$i - 1] = $section;
              $switched                   = 1;
              $lastsection                = undef;
              next;
            }
          }
          $lastsection = $section;
        }
        else {
          $lastsection = undef;
        }
      }
    } while ($switched);
  }


  # make sure two tags combined together are in proper sorting
  sub reorder_tags {
    my $self = shift;

    for my $tag (qw(BuildRequires Requires Provides Obsoletes Supplements Recommends PreReq Conflicts)) {
      $self->reorder_tag($tag);
    }
  }

  sub replace_licenses {
    my ($self, $mapper) = @_;
    for my $section (@{$self->{sections}}) {
      if ($section->name() eq 'License') {
        $section->set_value($mapper->replace_spdx($section->value()));
      }
    }
  }
}

if ($ARGV[0] eq '--debug') {
  $debug = 1;
  shift @ARGV;
}

my $specfile = shift(@ARGV);
if (!stat($specfile)) {
  die "$specfile is no file";
}


my @specpath = split('/', $specfile);
my $specbase = pop @specpath;
my $specdir  = join('/', @specpath);

if ($specdir eq "") {
  $specdir = ".";
}

my $xdefinelist;
my $seen_name = 0;
open(SPE, '<', "$specfile") || die("open $specfile: $!\n");
while (<SPE>) {
  chomp();
  if (/^%define/ || /^%global/) {
    my @args = split(/\s+/, $_);
    $_ =~ s/[\{\}\"]//g for (@args);
    $args[2] =~ s/\Q$_\E/$xdefinelist->{$_}/ for (sort { length($b) <=> length($a) } keys(%{$xdefinelist}));
    if ($args[2] && $args[2] !~ /[\(\)\{\}\@\%\"\\]/) {
      $xdefinelist->{"%" . $args[1]} = $args[2];
      $xdefinelist->{"%{" . $args[1] . "}"} = $args[2];

    }
  }
  if (/^\s*Name:/) {
    if ($seen_name) {
      next;
    }
    $seen_name    = 1;
    $base_package = $_;
    $base_package =~ s/^\s*Name:\s*(\S*)\s*/$1/;
    if ($debug) {
      warn "DEBUG: base_package = $base_package\n";
    }
    last;
  }
}
close(SPE);

$header_name = $specbase;
$header_name =~ s/\.spec$//;

if (!$base_package) {
  $base_package = $header_name;
  $base_package =~ s/\-.*$//;
}

warn("base_package is $base_package\n") if $debug;

my $parser = Parser->new($base_package);
$parser->read_and_parse_spec($specfile);

$parser->merge_empty_sections();
$parser->merge_comments();
$parser->reorder_tags();

my $mapper = SPDXMapper->new;

#$mapper->internal_test();
#exit(0);
$parser->replace_licenses($mapper);
$parser->set_section_whitespace();
$parser->fix_release_tag();

# make sure we've got an empty changelog at the end
my $section = $parser->find("changelog-section");
$parser->delete_section($section) if $section;
my $lastsection = $parser->current();
$section = $parser->create_section("changelog-section", "%changelog");
if ($lastsection->{after_lines} == 0) {
  $section->set_before_lines(1);
}
else {
  # one is enough
  $lastsection->set_after_lines(1);
}

$parser->print_all();