createrepomddeps

#!/usr/bin/perl -w

################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products 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
#
################################################################

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

use strict;
use Data::Dumper;
use Getopt::Long;
use Build ':rpm';
use Build::Rpm;
use Build::Rpmmd;
use Digest::MD5 ();
use File::Path qw(mkpath rmtree);
use File::Basename;

Getopt::Long::Configure("no_ignore_case");

my $opt_dump;
my $opt_old;
my $opt_nosrc;
my $opt_bc;
my $opt_zypp;
my $cachedir = "/var/cache/build";

sub printold {
  my ($pkg, $baseurl, $old_seen) = @_;

  my $arch = $pkg->{'arch'};
  $arch = 'src' if $pkg->{'arch'} eq 'nosrc';
  return if $arch eq 'src' && $opt_nosrc;
  my $evr = $pkg->{'version'}.'-'.$pkg->{'release'};
  $evr = "$pkg->{'epoch'}:$evr" if $pkg->{'epoch'};
  my $loc = $baseurl . $pkg->{'location'};
  if ($old_seen->{$pkg->{'name'}}->{$arch}) {
    my $vv = Build::Rpm::verscmp($old_seen->{$pkg->{'name'}}->{$arch}->{'evr'}, $evr, 0);
    if ($vv >= 0) {
      print "$loc\n";
      return;
    }
    print $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'}."\n";
  }
  $old_seen->{$pkg->{'name'}}->{$arch}->{'evr'} = $evr;
  $old_seen->{$pkg->{'name'}}->{$arch}->{'loc'} = $loc;
}

GetOptions (
  "nosrc"   => \$opt_nosrc,
  "dump"   => \$opt_dump,
  "old"   => \$opt_old,
  "zypp=s"   => \$opt_zypp,
  "cachedir=s"  => \$cachedir,
  ) or exit(1);

$opt_bc = 1 unless $opt_dump || $opt_old;

my $old_seen = {};	# for opt_old
my @packages;		# for opt_dump

for my $url (@ARGV) {
  my $dir;
  my $baseurl = $url;
  if ($opt_zypp) {
    $dir = $opt_zypp;
  } elsif ($url =~ /^(?:ftps?|https?):\/\/([^\/]*)\/?/) {
    my $repoid = Digest::MD5::md5_hex($url);
    $dir = "$cachedir/$repoid/";
    $baseurl .= '/' unless $baseurl =~ /\/$/;
    mkpath("${dir}repodata");
    system($INC[0].'/download', "${dir}repodata", "${baseurl}repodata/repomd.xml");
  } else {
    $dir = $url;
  }
  $dir .= '/' unless $dir =~ /\/$/;
  $baseurl .= '/' unless $baseurl =~ /\/$/;

  if (! -s "${dir}repodata/repomd.xml") {
    die("zypp repo $url is not up to date, please refresh first\n") if $opt_zypp;
    die("repo $url does not contain a repomd.xml file\n");
  }

  my @primaryfiles;
  Build::Rpmmd::parse_repomd("${dir}repodata/repomd.xml", \@primaryfiles);
  @primaryfiles = grep {$_->{'type'} eq 'primary' && defined($_->{'location'})} @primaryfiles;
#  print Dumper(\@primaryfiles);

  for my $f (@primaryfiles) {
    my $u = "$dir$f->{'location'}";
    if ($] > 5.007) {
      require Encode;
      utf8::downgrade($u);
    }
    my $cached;
    if (-e $u) {
      $cached = 1;
      $cached = 0 if exists($f->{'size'}) && $f->{'size'} != (-s _);
      $cached = 0 if !$opt_zypp && !exists($f->{'size'}) && $u !~ /[0-9a-f]{32}-primary/;
    }
    if (!$cached) {
      die("zypp repo $url is not up to date, please refresh first\n") if $opt_zypp;
      if ($url =~ /^(?:ftps?|https?):\/\/([^\/]*)\/?/) {
	if (system("$INC[0]/download", "${dir}repodata/", "${baseurl}repodata/" . basename($u))) {
	  die("download failed\n");
	}
      } else {
	die("inconsistent repodata in $url\n");
      }
    }
    my $fh;
    open($fh, '<', $u) or die "Error opening $u: $!\n";
    if ($u =~ /\.gz$/) {
      use IO::Uncompress::Gunzip qw($GunzipError);
      $fh = new IO::Uncompress::Gunzip $fh or die "Error opening $u: $GunzipError\n";
    }
    Build::Rpmmd::parse($fh, sub {
      if ($opt_dump) {
        $_[0]->{'baseurl'} = $baseurl;
        push @packages, $_[0] if $opt_dump;
      }
      if ($opt_bc) {
        binmode STDOUT, ":utf8";
	Build::writedeps(\*STDOUT, $_[0], $baseurl);
      } elsif ($opt_old) {
	printold($_[0], $baseurl, $old_seen);
      }
    }, 'addselfprovides' => 1);
    close($fh);
  }
}

if ($opt_dump) {
  print Data::Dumper->Dump([\@packages], ['packages']); # caution: excessive memory consumption!
}