bin/wb-edos-builddebcheck

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2008 Ralf Treinen <treinen@debian.org>
   4 # This program is free software: you can redistribute it and/or modify it under
   5 # the terms of the GNU General Public License as published by the Free Software
   6 # Foundation, version 2 of the License.
   7
   8 $debug=0;
   9
  10 # the prefix used to encode source packages
  11 $sourceprefix="source---";
  12
  13 $architecture="";
  14 $binexplain=0;
  15 $edosoptions = "-failures -explain";
  16 while ( $arg = shift @ARGV ) {
  17     if ( $arg eq '-a' || $arg eq '--architecture' ) {
  18         if ($#ARGV == -1) {
  19             die "-a option needs a value";
  20         } else {
  21             $architecture = shift @ARGV;
  22         }
  23     } elsif ( $arg =~ "--binexplain" || $arg =~ "-be" ) {
  24         $binexplain = 1;
  25     } elsif ( $arg =~ /^-.*/ ) {
  26         die "unrecognized option: $arg";
  27     } else {
  28         last;
  29     }
  30 }
  31
  32 if ($#ARGV != 0) {
  33     die "Usage: edos-debbuildcheck [options] Packages Sources"
  34 } else {
  35     $packagefile = $arg;
  36     $sourcesfile = shift(@ARGV);
  37 }
  38
  39 if ($debug) {
  40     print "Arch: $architecture\n";
  41     print "Packages: $packagefile\n";
  42     print "Sources:  $sourcesfile\n";
  43     print "Edos options: $edosoptions\n";
  44 }
  45
  46 $packagearch="";
  47 open(P,$packagefile);
  48 while (<P>) {
  49     next unless /^Architecture/;
  50     next if /^Architecture:\s*all/;
  51     /Architecture:\s*([^\s]*)/;
  52     if ($packagearch eq "") {
  53         $packagearch = $1;
  54     } elsif ( $packagearch ne $1) {
  55         die "Package file contains different architectures: $packagearch, $1";
  56     }
  57 }
  58 close P;
  59
  60 if ( $architecture eq "" ) {
  61     if ( $packagearch eq "" ) {
  62         die "No architecture option given, " .
  63             "and no non-all architecture found in the Packages file";
  64     } else {
  65         $architecture = $packagearch;
  66     }
  67 } else {
  68     if ( $packagearch ne "" & $architecture ne $packagearch) {
  69         die "Architecture option is $architecture ".
  70             "but the package file contains architecture $packagearch";
  71     }
  72 }
  73
  74 open(RESULT,"add-sources.py ".
  75      "--prefix \"$sourceprefix\" < $packagefile $sourcesfile $architecture ".
  76      "| edos-debcheck $edosoptions|");
  77
  78 $sourcestanza=0;
  79 $explanation="";
  80 $binpackage="";
  81
  82 while (<RESULT>) {
  83     if (/^The following constraints cannot be satisfied:/) {
  84         next
  85     } elsif (/^\s+/) {
  86         if ($sourcestanza) {
  87             s/^(\s*)$sourceprefix(.*)(depends on|conflicts with)/$1$2build-$3/o;
  88             s/&gt;/>/;
  89             s/&lt;/</;
  90             print;
  91             if (/depends on ([^\s]*) .*\{.*\}/) {
  92                 push(@binqueue,$1);
  93             }
  94         } else {
  95             $explanation .= $_;
  96         }
  97     } else {
  98         if ($sourcestanza) {
  99             print "\n";
 100             $sourcestanza=0;
 101         }
 102         if ($binpackage ne ""){
 103             $binfailures{$binpackage} = $explanation;
 104             $binpackage="";
 105         }
 106         if (/^$sourceprefix(.*) \(.*\): FAILED/o) {
 107             print "Package: $1\n";
 108             print "Failed-Why:\n";
 109             $sourcestanza=1;
 110         } elsif (/^([^\s]*) .*: FAILED/) {
 111             $binpackage=$1;
 112             $explanation=$_;
 113             $explanation.=<RESULT>;
 114             $sourcestanza=0;
 115         } else {
 116             # we have someting strange here
 117             $sourcestanza=0;
 118         }
 119     }
 120 }
 121
 122 close RESULT;
 123
 124 if ($binexplain) {
 125     while (@binqueue) {
 126         $p=pop(@binqueue);
 127         $v=$binfailures{$p};
 128         next unless defined $v;
 129         $binfailures{$p}="";
 130         print "$v" if $v ne "";
 131         if ($v=~/depends on ([^\s]*) .*\{.*\}/) {
 132             push(@binqueue,$1);
 133         }
 134     }
 135 }
 136