createdirdeps

   1 #!/usr/bin/perl -w
   2
   3 ################################################################
   4 #
   5 # Copyright (c) 1995-2014 SUSE Linux Products GmbH
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License version 2 or 3 as
   9 # published by the Free Software Foundation.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program (see the file COPYING); if not, write to the
  18 # Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
  20 #
  21 ################################################################
  22
  23 BEGIN {
  24   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
  25 }
  26
  27 use Build;
  28 use Getopt::Long;
  29
  30 use strict;
  31
  32 Getopt::Long::Configure("no_ignore_case");
  33
  34 my $oldfile;
  35
  36 GetOptions ("oldfile=s" => \$oldfile) or exit(1);
  37
  38 sub queryfromfilename {
  39   my ($fn) = @_;
  40   $fn =~ s/.*\///;
  41   return {'name' => $1, 'arch' => $2} if $fn =~ /^(.*)-[^-]+-[^-]+\.([^\. ]+)\.rpm$/;
  42   return {'name' => $1, 'arch' => $2} if $fn =~ /^([^_]*)_(?:[^_]*)_([^_]*)\.deb$/;
  43   return {'name' => $1, 'arch' => $2} if $fn =~ /^(.*)-[^-]+-[^-]+-([^-]+)\.pkg\.tar\.[gx]z$/;
  44   return undef;
  45 }
  46
  47
  48 ######################################################################
  49
  50 my %old;
  51 if (defined($oldfile) && open(F, '<', $oldfile)) {
  52   while (<F>) {
  53     chomp;
  54     $old{$1} = $_ if /^([PRrsCOI]:[^ ]+): /;
  55   }
  56   close F;
  57 }
  58
  59 my %seen;
  60
  61 for my $dir (@ARGV) {
  62   my $cmd = "find '$dir' -follow -type f \\( -name \"*.rpm\" -o -name \"*.deb\" -o -name \"*.pkg.tar.gz\" -o -name \"*.pkg.tar.xz\" \\) -a ! -name \"*src.rpm\" -printf '\%T@/\%s/\%i \%p\\n'";
  63   open(F, '-|', $cmd) or next;
  64   while (<F>) {
  65     chomp;
  66     next unless /^([\d\.]+\/\d+\/\d+) (.*)$/;
  67     my $id = $1;
  68     my $path = $2;
  69     # newer find version add a fraction part to %T@, strip it
  70     $id =~ s/^(\d+)\.\d+/$1/;
  71     next if $path =~ /\.(?:patch|delta)\.rpm$/; # not good for building...
  72     if (%old) {
  73       my $q = queryfromfilename($path);
  74       if ($q && defined($q->{'name'}) && defined($q->{'arch'})) {
  75         my $idx = "$q->{'name'}.$q->{'arch'}-$id";
  76         if ($old{"I:$idx"} && $old{"P:$idx"}) {
  77           # reuse old data
  78           next if $seen{$idx};
  79           $seen{$idx} = 1;
  80           print "F:$idx: $path\n";
  81           for (qw{P R r s C O I}) {
  82             print $old{"$_:$idx"}."\n" if $old{"$_:$idx"};
  83           }
  84           next;
  85         }
  86       }
  87     }
  88     my $q = Build::query($path, 'addselfprovides' => 1, 'conflicts' => 1, 'evra' => 1, 'buildtime' => 1, 'weakdeps' => 1);
  89     next unless $q && defined($q->{'name'}) && defined($q->{'arch'}) && defined($q->{'version'});
  90     my $idx = "$q->{'name'}.$q->{'arch'}-$id";
  91     next if $seen{$idx};
  92     $seen{$idx} = 1;
  93     $q->{'id'} = $id;
  94     $q->{'location'} = $path;
  95     Build::writedeps(\*STDOUT, $q);
  96   }
  97   close F;
  98 }
  99