1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
################################################################
#
# 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
#
################################################################
package Build::Susetags;
use strict;
use warnings;
use Data::Dumper;
sub addpkg {
my ($pkgs, $cur, $order, $cb, $cbdata, @arches) = @_;
if (defined($cur) && (!@arches || grep { /$cur->{'arch'}/ } @arches)) {
if(!$cb || &$cb($cur, $cbdata)) {
my $k = "$cur->{'name'}-$cur->{'version'}-$cur->{'release'}-$cur->{'arch'}";
$pkgs->{$k} = $cur;
# keep order (or should we use Tie::IxHash?)
push @{$order}, $k if defined $order;
}
}
}
sub parse {
# if @arches is empty take all arches
my ($file, $tmap, $order, @arches) = @_;
my $cb;
my $cbdata;
if (ref $order eq 'HASH') {
my $d = $order;
$order = undef;
$cb = $d->{'cb'} if (exists $d->{'cb'});
$cbdata = $d->{'data'} if (exists $d->{'data'});
}
# if @arches is empty take all arches
my @needed = keys %$tmap;
my $r = '(' . join('|', @needed) . '|Pkg):\s*(.*)';
if (!open(F, '<', $file)) {
if (!open(F, '-|', "gzip", "-dc", $file.'.gz')) {
die "$file: $!";
}
}
my $cur;
my $pkgs = {};
while (<F>) {
chomp;
next unless $_ =~ /([\+=])$r/;
my ($multi, $tag, $data) = ($1, $2, $3);
if ($multi eq '+') {
while (<F>) {
chomp;
last if $_ =~ /-$tag/;
push @{$cur->{$tmap->{$tag}}}, $_;
}
} elsif ($tag eq 'Pkg') {
addpkg($pkgs, $cur, $order, $cb, $cbdata, @arches);
$cur = {};
($cur->{'name'}, $cur->{'version'}, $cur->{'release'}, $cur->{'arch'}) = split(' ', $data);
} else {
$cur->{$tmap->{$tag}} = $data;
}
}
addpkg($pkgs, $cur, $order, $cb, $cbdata, @arches);
close(F);
return $pkgs;
}
1;
|
