Hello World

Overview

File writemodulemd of Package build

#!/usr/bin/perl -w

################################################################
#
# Copyright (c) 2021 SUSE Linux GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# 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 (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

# modulemd writing support

BEGIN {
  unshift @INC, ($::ENV{"BUILD_DIR"} || "/usr/lib/build");
}

use strict;

use Build::Rpm;
use Build::Modulemd;

my $filter_artifacts = 0;

# taken from pungi's multilib definitions
my %multilib = (
  'x86_64' => [ 'i686' ],
);

sub printmd {
  my ($md) = @_;
  print Build::Modulemd::mdtoyaml($md);
}

sub readmds {
  my ($modulemdfile) = @_;
  my $mds;
  if ($modulemdfile =~ /\.pst$/) {
    require Storable;
    $mds = Storable::retrieve($modulemdfile);
    $mds = [ $mds ] if ref($mds) eq 'HASH';
  } elsif ($modulemdfile =~ /\.ya?ml$/) {
    require YAML::XS;
    $YAML::XS::LoadBlessed = $YAML::XS::LoadBlessed = 0;
    $mds = [ YAML::XS::LoadFile($modulemdfile) ];
  } else {
    die("unsupported modulemd file: $modulemdfile\n");
  }
  die("no modulemd data\n") unless @$mds;
  for my $md (@$mds) {
    die("bad modulemd data\n") unless $md && ref($md) eq 'HASH' && $md->{'data'} && $md->{'document'};
    die("unknown modulemd document\n") if $md->{'document'} ne 'modulemd' && $md->{'document'} ne 'modulemd' && $md->{'document'} ne 'modulemd-defaults';
    die("bad modulemd version \n") if $md->{'document'} eq 'modulemd' && $md->{'version'} != 2;
    die("bad modulemd version \n") if $md->{'document'} eq 'modulemd-defaults' && $md->{'version'} != 1;
  }
  return $mds;
}

sub convertdeps {
  my ($d) = @_;
  my $nd = {};
  for my $dd (@$d) {
    my ($n, @v) = split(':', $dd);
    $nd->{$n} = \@v;
  }
  return $nd;
}

sub unifyandsort {
  my %m = map {$_ => 1} @_;
  return [ sort keys %m ];
}

sub sortarray {
  my ($d, @c) = @_;
  if (@c) {
    if (ref($d) eq 'ARRAY') {
      sortarray($_, @c) for @$d;
    } elsif (ref($d) eq 'HASH') {
      my $k = shift @c;
      if ($k eq '*') {
        sortarray($_, @c) for values %$d;
      } else {
        sortarray($d->{$k}, @c) if exists $d->{$k};
      }
    }
  } elsif ($d && ref($d) eq 'ARRAY') {
    @$d = sort @$d;
  }
}

if (@ARGV && ($ARGV[0] eq '--filter' || $ARGV[0] eq 'filter')) {
  shift @ARGV;
  my %archfilter;
  while (@ARGV >= 2 && $ARGV[0] eq '--arch') {
    $archfilter{$ARGV[1]} = 1;
    splice(@ARGV, 0, 2);
  }
  die("usage: writemodulemd --filter [--arch <ARCH>] <modulemdfile> <primaryfile>\n") unless @ARGV == 2;
  my ($modulemdfile, $primaryfile) = @ARGV;
  my $mds = readmds($modulemdfile);
  require Build::Rpmmd;
  if ($primaryfile ne '-' && -d $primaryfile) {
    die("$primaryfile/repomd.xml: $!\n") unless -e "$primaryfile/repomd.xml";
    # primaryfile is repomd directory
    my $files = Build::Rpmmd::parse_repomd("$primaryfile/repomd.xml");
    my @primaryfiles = grep {$_->{'type'} eq 'primary' && defined($_->{'location'})} @{$files || []};
    die("no primary files in repodata\n") unless @primaryfiles;
    @primaryfiles = grep {$_->{'location'} =~ /\.xml(?:\.xz|\.gz)?$/} @primaryfiles;
    die("cannot decompress primary file\n") unless @primaryfiles;
    my $loc = $primaryfiles[0]->{'location'};
    $loc =~ s/.*\///;
    $primaryfile .= "/$loc";
  }
  if ($primaryfile ne '-') {
    if ($primaryfile =~ /\.gz$/) {
      open(STDIN, '-|', 'gunzip', '-dc', '--', $primaryfile) || die("$primaryfile: $!\n");
    } elsif ($primaryfile =~ /\.xz$/) {
      open(STDIN, '-|', 'xzdec', '-dc', '--', $primaryfile) || die("$primaryfile: $!\n");
    } else {
      open(STDIN, '<', $primaryfile) || die("$primaryfile: $!\n");
    }
  }
  my %rpms;
  Build::Rpmmd::parse(\*STDIN, sub {
    my ($r) = @_;
    my $evr = ($r->{'epoch'} || 0).":$r->{'version'}-$r->{'release'}";
    $rpms{"$r->{'name'}-$evr.$r->{'arch'}"} = [ $r->{'source'},  $r->{'license'} ];
  }, 'withlicense' => 1);
  my %outmds;
  my %havens;
  my %multiartifacts;
  my %multilicenses;
  for my $md (@$mds) {
    my $mdd = $md->{'data'};
    if ($md->{'document'} eq 'modulemd-defaults') {
      my $ns = "$mdd->{'module'}:$mdd->{'stream'}";
      $outmds{$ns} = $md;
      next;
    }

    # apply rpm name filtering
    if ($mdd->{'artifacts'} && $mdd->{'artifacts'}->{'rpms'} && $mdd->{'filter'} && $mdd->{'filter'}->{'rpms'}) {
      my %filter = map {$_ => 1} @{$mdd->{'filter'}->{'rpms'}};
      my $havebinaryrpms;
      for (splice @{$mdd->{'artifacts'}->{'rpms'}}) {
	if (/\.(?:no)?src$/) {
	  push @{$mdd->{'artifacts'}->{'rpms'}}, $_;
	  next;
	}
	next unless /(.*)-[^-]*-[^-]*\.[^\.]+$/;
	next if $filter{$1};
	my $n = $1;
	$n =~ s/-debug(?:info|source)$//;
	next if $filter{$n};
	push @{$mdd->{'artifacts'}->{'rpms'}}, $_;
	$havebinaryrpms = 1;
      }
      @{$mdd->{'artifacts'}->{'rpms'}} = () unless $havebinaryrpms;
    }

    # check if we have this md in the rpms
    if ($mdd->{'artifacts'}) {
      my %components;
      if ($mdd->{'buildopts'} && $mdd->{'buildopts'}->{'whitelist'}) {
	%components = map {$_ => 1} @{$mdd->{'buildopts'}->{'whitelist'}};
      } elsif ($mdd->{'components'} && $mdd->{'components'}->{'rpms'}) {
	%components = map {$_ => 1} keys %{$mdd->{'components'}->{'rpms'}};
      }
      next unless grep {exists($rpms{$_}) && $components{$rpms{$_}->[0]}} @{$mdd->{'artifacts'}->{'rpms'} || []};
    }

    # filter artifacts and licenses
    if ($filter_artifacts && $mdd->{'artifacts'}) {
      my @have = grep {exists $rpms{$_}} @{$mdd->{'artifacts'}->{'rpms'} || []};
      my %licenses;
      for (@have) {
        $licenses{$rpms{$_}->[1]} = 1 if $rpms{$_} && defined $rpms{$_}->[1];
      }
      if (@have) {
        $mdd->{'artifacts'}->{'rpms'} = \@have;
      } else {
        delete $mdd->{'artifacts'}->{'rpms'};
        delete $mdd->{'artifacts'} unless %{$mdd->{'artifacts'} || {}};
      }
      if (%licenses) {
        $mdd->{'license'}->{'content'} = [ sort keys %licenses ];
      } else {
        delete $mdd->{'license'}->{'content'} if $mdd->{'license'} && $mdd->{'license'}->{'content'};
      }
    }

    if ($mdd->{'components'} && $mdd->{'components'}->{'rpms'} && $mdd->{'artifacts'} && $mdd->{'artifacts'}->{'rpms'}) {
      my %havearch;
      my %havesrc;
      for (@{$mdd->{'artifacts'}->{'rpms'} || []}) {
	next unless /(.*)-[^-]*-[^-]*\.([^\.]+)$/;
	$havearch{$2} = 1;
	$havesrc{$1} = 1 if $2 eq 'src' || $2 eq 'nosrc';
      }
      my %domulti;
      for my $sname (sort keys %havesrc) {
	my $c = $mdd->{'components'}->{'rpms'}->{$sname};
	next unless $c;
	for my $march (@{$c->{'multilib'} || []}) {
	  $domulti{$_}->{$march} = 1 for grep {$havearch{$_}} @{$multilib{$march} || []};
	}
      }
      for my $v (values %domulti) {
        $domulti{'src'}->{$_} = $domulti{'nosrc'}->{$_} = 1 for keys %$v;
      }
      if (%domulti) {
	for (@{$mdd->{'artifacts'}->{'rpms'} || []}) {
	  next unless /.*-[^-]*-[^-]*\.([^\.]+)$/;
          for my $march (sort keys %{$domulti{$1} || {}}) {
            my $label = "$mdd->{'name'}:$mdd->{'stream'}:$mdd->{'version'}:$mdd->{'context'}:$march";
	    push @{$multiartifacts{$label}}, $_;
	    push @{$multilicenses{$label}}, @{$mdd->{'license'}->{'content'}} if $mdd->{'license'} && @{$mdd->{'license'}->{'content'}};
	  }
	}
      }
    }
    next if %archfilter && !$archfilter{$mdd->{'arch'}};

    my $ns = "$mdd->{'name'}:$mdd->{'stream'}";
    $havens{$ns} = 1;
    my $label = "$mdd->{'name'}:$mdd->{'stream'}:$mdd->{'version'}:$mdd->{'context'}:$mdd->{'arch'}";
    my $omd = $outmds{$label};
    if ($omd) {
      # merge with existing entry
      my $omdd = $omd->{'data'};
      ($md, $omd, $mdd, $omdd) = ($omd, $md, $omdd, $mdd) if $omdd->{'version'} > $mdd->{'version'};
      my %sources;
      my %osources;
      if ($mdd->{'artifacts'} && $mdd->{'artifacts'}->{'rpms'}) {
	for (@{$mdd->{'artifacts'}->{'rpms'}}) {
	  $sources{$1} = 1 if /(.*)-[^-]*-[^-]*\.([^\.]+)$/;
	}
      }
      if ($omdd->{'artifacts'} && $omdd->{'artifacts'}->{'rpms'}) {
	for (@{$omdd->{'artifacts'}->{'rpms'}}) {
	  $osources{$1} = 1 if /(.*)-[^-]*-[^-]*\.([^\.]+)$/;
	}
      }
      if ($mdd->{'components'} || $omdd->{'components'}) {
	my $components = $mdd->{'components'}->{'rpms'} || {};
	for my $s (sort keys %{$omdd->{'components'}->{'rpms'} || {}}) {
	  $components->{$s} = $omdd->{'components'}->{'rpms'}->{$s} if !$components->{$s} || (!$sources{$s} && $osources{$s});
	}
	delete $mdd->{'components'}->{'rpms'};
        $mdd->{'components'}->{'rpms'} = $components if %$components;
      }
      if ($mdd->{'artifacts'} || $omdd->{'artifacts'}) {
        my $artifacts = unifyandsort(@{$mdd->{'artifacts'}->{'rpms'} || []}, @{$omdd->{'artifacts'}->{'rpms'} || []});
        delete $mdd->{'artifacts'}->{'rpms'};
        $mdd->{'artifacts'}->{'rpms'} = $artifacts if @$artifacts;
      }
      if ($mdd->{'license'} || $omdd->{'license'}) {
        my $licenses = unifyandsort(@{$mdd->{'license'}->{'content'} || []}, @{$omdd->{'license'}->{'content'} || []});
        delete $mdd->{'license'}->{'content'};
        $mdd->{'license'}->{'content'} = $licenses if @$licenses;
      }
    }
    $outmds{$label} = $md;
  }

  # merge multilib entries
  for my $label (sort keys %multiartifacts) {
    my $md = $outmds{$label};
    next unless $md;
    my $mdd = $md->{'data'};
    my $artifacts = unifyandsort(@{$mdd->{'artifacts'}->{'rpms'} || []}, @{$multiartifacts{$label}});
    $mdd->{'artifacts'}->{'rpms'} = $artifacts;
    if ($multilicenses{$label}) {
      my $licenses = unifyandsort(@{$mdd->{'license'}->{'content'} || []}, @{$multilicenses{$label}});
      $mdd->{'license'}->{'content'} = $licenses;
    }
  }

  # now dump em all
  for (sort keys %outmds) {
    my $md = $outmds{$_};
    if ($md->{'document'} eq 'modulemd-defaults') {
      my $mdd = $md->{'data'};
      my $ns = "$mdd->{'module'}:$mdd->{'stream'}";
      next unless $havens{$ns};
    }
    # normalize some entries
    sortarray($md, 'data', 'profiles', '*', 'rpms');
    sortarray($md, 'data', 'artifacts', 'rpms');
    sortarray($md, 'data', 'license', 'content');
    sortarray($md, 'data', 'buildopts', 'rpms', 'whitelist');
    sortarray($md, 'data', 'filter', 'rpms');
    sortarray($md, 'data', 'api', 'rpms');
    printmd($md);
  }
  exit;
}

if (@ARGV && ($ARGV[0] eq '--convert' || $ARGV[0] eq 'convert')) {
  shift @ARGV;
  die("usage: writemodulemd --convert <modulemdfile>\n") unless @ARGV;
  my @mds;
  for my $modulemdfile (@ARGV) {
    push @mds, @{readmds($modulemdfile)};
  }
  printmd($_) for @mds;
  exit;
}

if (@ARGV && ($ARGV[0] eq '--converttopst' || $ARGV[0] eq 'converttopst')) {
  shift @ARGV;
  die("usage: writemodulemd --converttopst <modulemdfile>\n") unless @ARGV;
  my @mds;
  for my $modulemdfile (@ARGV) {
    push @mds, @{readmds($modulemdfile)};
  }
  require Storable;
  Storable::nstore_fd(\@mds, \*STDOUT);
  exit
}

my $disturl;
(undef, $disturl) = splice(@ARGV, 0, 2) if @ARGV >= 2 && $ARGV[0] eq '--disturl';
die("usage: writemodulemd [--disturl <disturl] <modulemdfile> <rpmmanifestfile>\n") unless @ARGV == 2;
my ($modulemdfile, $manifestfile) = @ARGV;

my $mds = readmds($modulemdfile);

my @mds_good = grep {$_->{'document'} eq 'modulemd'} @$mds;
die("need exactly one modulemd document\n") unless @mds_good == 1;
my $md = $mds_good[0];

my $mdd = $md->{'data'};
# convert deps if needed (to be removed)
for my $d (@{$mdd->{'dependencies'} || []}) {
  $d->{'requires'} = convertdeps($d->{'requires'}) if ref($d->{'requires'}) eq 'ARRAY';
  $d->{'buildrequires'} = convertdeps($d->{'buildrequires'}) if ref($d->{'buildrequires'}) eq 'ARRAY';
}
delete $mdd->{'artifacts'};
delete $mdd->{'license'}->{'content'} if $mdd->{'license'} && $mdd->{'license'}->{'content'};
if ($manifestfile ne '-') {
  open(STDIN, '<', $manifestfile) || die("$manifestfile: $!\n");
}
my %licenses;
my %sources;
while (<STDIN>) {
  chomp;
  my $r = Build::Rpm::query($_, 'evra' => 1, 'license' => 1);
  next if $r->{'name'} eq 'empty-modulemd-hack';
  $sources{$r->{'name'}} = 1 if $r->{'arch'} eq 'src' || $r->{'arch'} eq 'nosrc';
  $r->{'epoch'} ||= 0;
  my $nevra = "$r->{'name'}-$r->{'epoch'}:$r->{'version'}-$r->{'release'}.$r->{'arch'}";
  my $license = $r->{'license'};
  $licenses{$license} = 1 if $license;
  push @{$mdd->{'artifacts'}->{'rpms'}}, $nevra;
}
$mdd->{'license'}->{'content'} = [ sort keys %licenses ] if %licenses;
if ($disturl && %sources && $mdd->{'components'} && $mdd->{'components'}->{'rpms'}) {
  for my $s (sort keys %sources) {
    my $c = $mdd->{'components'}->{'rpms'}->{$s};
    $c->{'ref'} = $disturl if $c;
  }
}
printmd($_) for @$mds;
Places