4 use IO::Uncompress::AnyInflate qw(anyinflate);
5 use Dpkg::Version (); # import nothing
6 if ( defined $Dpkg::Version::VERSION ) {
7 *vercmp = \&Dpkg::Version::version_compare;
9 *vercmp = \&Dpkg::Version::vercmp;
11 use Dpkg::Arch qw(debarch_is);
23 open(my $pasf, '<', $pasfile);
28 my ($p, $c) = split(/:\s*/);
29 $pas->{$p} = { arch => [ split(/\s+/, $c) ], mode => substr($c, 0, 1) ne '!' };
34 local($/) = ""; # read in paragraph mode
36 foreach my $s (@$SRC) {
37 my $S = new IO::Uncompress::AnyInflate($s) || return "WB::QD::SRC can't open $s";
40 /^Package:\s*(\S+)$/mi and $p->{'name'} = $1;
41 /^Version:\s*(\S+)$/mi and $p->{'version'} = $1;
42 /^Binary:\s*(.*)$/mi and $p->{'binary'} = $1;
43 /^Architecture:\s*(.+)$/mi and $p->{'arch'} = $1;
44 /^Priority:\s*(\S+)$/mi and $p->{'priority'} = $1;
45 /^Section:\s*(\S+)$/mi and $p->{'section'} = $1;
46 /^Build-Depends:\s*(.*)$/mi and $p->{'depends'} = $1;
47 /^Build-Conflicts:\s*(.*)$/mi and $p->{'conflicts'} = $1;
49 next unless $p->{'name'} and $p->{'version'};
50 foreach my $tarch (split(/\s+/, $p->{'arch'})) {
51 $p->{'for-us'} = 1 if debarch_is($arch, $tarch);
54 # ignore if package already exists with higher version
55 if ($srcs->{$p->{'name'}}) {
56 next if (vercmp($srcs->{$p->{'name'}}->{'version'}, $p->{'version'}) > 0);
59 $p->{'binary'} = [ split(/,? /, $p->{'binary'}) ];
61 $srcs->{$p->{'name'}} = $p;
66 foreach my $p (@$BIN) {
67 my $P = new IO::Uncompress::AnyInflate($p) || return "WB::QD::PKGS can't open $p";
70 /^Version:\s*(\S+)$/mi and $p->{'version'} = $1;
71 /^Version:\s*(\S+)\+b([0-9]+)$/mi and $p->{'version'} = $1 and $p->{'binnmu'} = $2;
72 /^Architecture:\s*(\S+)$/mi and $p->{'arch'} = $1;
73 /^Package:\s*(\S+)$/mi and $p->{'binary'} = $1;
74 /^Package:\s*(\S+)$/mi and $p->{'source'} = $1;
75 /^Source:\s*(\S+)$/mi and $p->{'source'} = $1;
76 /^Source:\s*(\S+)\s+\((\S+)\)$/mi and $p->{'source'} = $1 and $p->{'version'} = $2;
78 # consider packages as non-existant if it's all but outdated
79 # arch:all and ver(binary) < ver(source) => skip
80 next if $p->{'arch'} eq 'all' && $srcs->{$p->{'source'}} && $srcs->{$p->{'source'}}->{'version'} && vercmp($srcs->{$p->{'source'}}->{'version'}, $p->{'version'}) > 0;
81 # not for the current architecture or arch:all => skip
82 next unless $p->{'arch'} eq 'all' || $p->{'arch'} eq ${arch};
83 # register the binary if there isn't a newer one in the hash yet
84 $binary->{$p->{'binary'}} = { 'version' => $p->{'version'}, 'arch' => $p->{'arch'}}
85 unless $binary->{$p->{'binary'}} and vercmp($binary->{$p->{'binary'}}->{'version'}, $p->{'version'}) < 0;
87 #next if $pas->{$p->{'binary'}} && pasignore($pas->{$p->{'binary'}}, $arch);
89 # only continue if it's arch-specific...
90 next if $p->{'arch'} eq 'all';
92 # annotate the source package if present, continue otherwise
93 next unless $srcs->{$p->{'source'}};
95 $srcs->{$p->{'source'}}->{'compiled'} = 1;
98 next unless $srcs->{$p->{'source'}}->{'version'} eq $p->{'version'};
99 $srcs->{$p->{'source'}}->{'installed'} = 1;
101 next unless $p->{'binnmu'};
102 next if ($srcs->{$p->{'source'}}->{'binnmu'}) && ($srcs->{$p->{'source'}}->{'binnmu'} > $p->{'binnmu'});
103 $srcs->{$p->{'source'}}->{'binnmu'} = $p->{'binnmu'};
109 for my $k (keys %$srcs) {
110 if ($srcs->{$k}->{'installed'}) {
111 $srcs->{$k}->{'status'} = 'installed';
112 delete $srcs->{$k}->{'installed'};
113 } elsif ($srcs->{$k}->{'compiled'}) {
114 $srcs->{$k}->{'status'} = 'out-of-date';
116 $srcs->{$k}->{'status'} = 'uncompiled';
118 delete $srcs->{$k}->{'compiled'};
119 $srcs->{$k}->{'status'} = 'installed' if $srcs->{$k}->{'arch'} && $srcs->{$k}->{'arch'} eq 'all';
121 if (!$srcs->{$k}->{'for-us'} && $srcs->{$k}->{'status'} ne 'installed') {
122 $srcs->{$k}->{'status'} = 'arch-not-in-arch-list';
124 delete $srcs->{$k}->{'for-us'};
126 if ($srcs->{$k}->{'arch'} eq 'all') {
127 $srcs->{$k}->{'status'} = 'arch-all-only';
128 delete $srcs->{$k}->{'arch'};
131 delete $srcs->{$k}->{'arch'};
133 if (pasignore($pas->{'%'.$k}, $arch)) {
134 $srcs->{$k}->{'status'} = 'packages-arch-specific';
137 for my $bin (@{$srcs->{$k}->{'binary'}}) {
138 $srcs->{$k}->{'pas'} = 1 if pasignore($pas->{$bin}, $arch);
139 next if pasignore($pas->{$bin}, $arch);
140 next if $binary->{$bin} and $binary->{$bin}->{'arch'} eq 'all';
143 if ($srcs->{$k}->{'pas'}) {
144 $srcs->{$k}->{'status'} = 'packages-arch-specific';
146 $srcs->{$k}->{'status'} = 'overwritten-by-arch-all';
148 delete $srcs->{$k}->{'pas'};
150 $srcs->{'_binary'} = $binary;
159 if ($p && $p->{'mode'}) {
160 return 1 unless grep { $_ eq $arch } @{$p->{'arch'}};
162 if ($p && not $p->{'mode'}) {
163 return 1 if grep /^!$arch$/, @{$p->{'arch'}};