lib/WB/QD.pm

   1 package WB::QD;
   2
   3 use strict;
   4 use IO::Uncompress::AnyInflate qw(anyinflate);
   5 use Dpkg::Version qw(vercmp);
   6
   7 sub readsourcebins {
   8     my $arch = shift;
   9     my $pasfile = shift;
  10     my $SRC = shift;
  11     my $BIN = shift;
  12     my $binary = {};
  13
  14     my $pas = {};
  15     local($/) = "\n";
  16     open(PAS, '<', $pasfile);
  17     while(<PAS>) {
  18         chomp;
  19         s,\s*#.*,,;
  20         next unless $_;
  21         my ($p, $c) = split(/:\s*/);
  22         $pas->{$p} = { arch => [ split(/\s+/, $c) ], mode => substr($c, 0, 1) ne '!' };
  23     }
  24     close PAS;
  25
  26     my $srcs = {};
  27     local($/) = ""; # read in paragraph mode
  28
  29     foreach my $s (@$SRC) {
  30         my $S = new IO::Uncompress::AnyInflate($s) || return "WB::QD::SRC can't open $s";
  31         while(<$S>) {
  32             my $p={};
  33             /^Package:\s*(\S+)$/mi and $p->{'name'} = $1;
  34             /^Version:\s*(\S+)$/mi and $p->{'version'} = $1;
  35             /^Binary:\s*(.*)$/mi and $p->{'binary'} = $1;
  36             /^Architecture:\s*(.+)$/mi and $p->{'arch'} = $1;
  37             /^Priority:\s*(\S+)$/mi and $p->{'priority'} = $1;
  38             /^Section:\s*(\S+)$/mi and $p->{'section'} = $1;
  39             /^Build-Depends:\s*(.*)$/mi and $p->{'depends'} = $1;
  40             /^Build-Conflicts:\s*(.*)$/mi and $p->{'conflicts'} = $1;
  41
  42             next unless $p->{'name'} and $p->{'version'};
  43             next if $p->{'arch'} eq 'all';
  44             # TODO: respect the architecture - or not / we already respect it via P-a-s
  45             delete $p->{'arch'};
  46
  47             # ignore if package already exists with higher version
  48             if ($srcs->{$p->{'name'}}) {
  49                 next if (vercmp($srcs->{$p->{'name'}}->{'version'}, $p->{'version'}) > 0);
  50             }
  51             my @a = split(/,? /, $p->{'binary'}) if $p->{'binary'};
  52             $p->{'binary'} = \@a;
  53             $srcs->{$p->{'name'}} = $p;
  54         }
  55         close $S;
  56     }
  57
  58     foreach my $p (@$BIN) {
  59         my $P = new IO::Uncompress::AnyInflate($p) || return "WB::QD::PKGS can't open $p";
  60         while(<$P>) {
  61             my $p;
  62             /^Version:\s*(\S+)$/mi and $p->{'version'} = $1;
  63             /^Architecture:\s*(\S+)$/mi and $p->{'arch'} = $1;
  64             /^Package:\s*(\S+)$/mi and $p->{'binary'} = $1;
  65             /^Package:\s*(\S+)$/mi and $p->{'source'} = $1;
  66             /^Source:\s*(\S+)$/mi and $p->{'source'} = $1;
  67             /^Source:\s*(\S+)\s+\((\S+)\)$/mi and $p->{'source'} = $1 and $p->{'version'} = $2;
  68             $p->{'version'} =~ /(\S+)\+b([0-9]+)/ and $p->{'version'} = $1 and $p->{'binnmu'} = $2;
  69
  70             next unless $p->{'arch'} eq 'all' || $p->{'arch'} eq ${arch};
  71             $binary->{$p->{'binary'}} = { 'version' => $p->{'version'}, 'arch' => $p->{'arch'}} unless $binary->{$p->{'binary'}} and vercmp($binary->{$p->{'binary'}}->{'version'}, $p->{'version'}) < 0;
  72
  73             #next if $pas->{$p->{'binary'}} && pasignore($pas->{$p->{'binary'}}, $arch);
  74             next if $p->{'arch'} eq 'all';
  75             next unless $srcs->{$p->{'source'}};
  76             $srcs->{$p->{'source'}}->{'compiled'} = 1;
  77             next unless $srcs->{$p->{'source'}}->{'version'} eq $p->{'version'};
  78             $srcs->{$p->{'source'}}->{'installed'} = 1;
  79             next unless $p->{'binnmu'};
  80             next if ($srcs->{$p->{'source'}}->{'binnmu'}) && ($srcs->{$p->{'source'}}->{'binnmu'} > $p->{'binnmu'});
  81             $srcs->{$p->{'source'}}->{'binnmu'} = $p->{'binnmu'};
  82         }
  83         close $P;
  84     }
  85
  86     SRCS:
  87     for my $k (keys %$srcs) {
  88         if ($srcs->{$k}->{'installed'}) {
  89             $srcs->{$k}->{'status'} = 'installed';
  90             delete $srcs->{$k}->{'installed'};
  91         } elsif ($srcs->{$k}->{'compiled'}) {
  92             $srcs->{$k}->{'status'} = 'out-of-date';
  93         } else {
  94             $srcs->{$k}->{'status'} = 'uncompiled';
  95         }
  96         delete $srcs->{$k}->{'compiled'};
  97         $srcs->{$k}->{'status'} = 'installed' if $srcs->{$k}->{'arch'} && $srcs->{$k}->{'arch'} eq 'all';
  98
  99         #my $p = $pas->{$k};
 100         #$p ||= $pas->{'%'.$k};
 101         #$srcs->{$k}->{'status'} = 'not-for-us' if pasignore($p, $arch);
 102         if (pasignore($pas->{'%'.$k}, $arch)) {
 103             $srcs->{$k}->{'status'} = 'not-for-us';
 104             next;
 105         }
 106         for my $bin (@{$srcs->{$k}->{'binary'}}) {
 107             next if pasignore($pas->{$bin}, $arch);
 108             next if $binary->{$bin} and $binary->{$bin}->{'arch'} eq 'all';
 109             next SRCS;
 110         }
 111         $srcs->{$k}->{'status'} = 'not-for-us';
 112     }
 113     $srcs->{'_binary'} = $binary;
 114     local($/) = "\n";
 115
 116     return \$srcs;
 117 }
 118
 119 sub pasignore {
 120     my $p = shift;
 121     my $arch = shift;
 122     if ($p && $p->{'mode'}) {
 123         return 1 unless grep { $_ eq $arch } @{$p->{'arch'}};
 124     }
 125     if ($p && not $p->{'mode'}) {
 126         return 1 if grep /^!$arch$/, @{$p->{'arch'}};
 127     }
 128     return 0;
 129 }
 130
 131 1;