summaryrefslogtreecommitdiffstats
path: root/scripts/Dpkg/Index.pm
blob: 3f898af12d8dc0eee807732360527a12854d04e7 (plain)
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
# Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
# Copyright © 2012-2017 Guillem Jover <guillem@debian.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# 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.  If not, see <https://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

Dpkg::Index - generic index of control information

=head1 DESCRIPTION

This class represent a set of L<Dpkg::Control> objects.

=cut

package Dpkg::Index 3.00;

use strict;
use warnings;

use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Control;

use parent qw(Dpkg::Interface::Storable);

use overload
    '@{}' => sub { return $_[0]->{order} },
    fallback => 1;

=head1 METHODS

=over 4

=item $index = Dpkg::Index->new(%opts)

Creates a new empty index. See set_options() for more details.

=cut

sub new {
    my ($this, %opts) = @_;
    my $class = ref($this) || $this;

    my $self = {
	items => {},
	order => [],
	unique_tuple_key => 1,
	get_key_func => sub { return $_[0]->{Package} },
	type => CTRL_UNKNOWN,
        item_opts => {},
    };
    bless $self, $class;
    $self->set_options(%opts);
    if (exists $opts{load}) {
	$self->load($opts{load});
    }

    return $self;
}

=item $index->set_options(%opts)

The "type" option is checked first to define default values for other
options. Here are the relevant options: "get_key_func" is a function
returning a key for the item passed in parameters, "unique_tuple_key" is
a boolean requesting whether the default key should be the unique tuple
(default to true), "item_opts" is a hash reference that will be passed to
the item constructor in the new_item() method.
The index can only contain one item with a given key.
The "get_key_func" function used depends on the type:

=over

=item *

for CTRL_TMPL_SRC, it is the Source field;

=item *

for CTRL_REPO_SRC and CTRL_DSC it is the Package and Version fields
(concatenated with "_") when "unique_tuple_key" is true (the default), or
otherwise the Package field;

=item *

for CTRL_TMPL_PKG it is simply the Package field;

=item *

for CTRL_REPO_PKG and CTRL_DEB it is the Package, Version and
Architecture fields (concatenated with "_") when "unique_tuple_key" is
true (the default) or otherwise the Package field;

=item *

for CTRL_CHANGELOG it is the Source and the Version fields (concatenated
with an intermediary "_");

=item *

for CTRL_TESTS is an integer index (0-based) corresponding to the Tests or
Test-Command field stanza;

=item *

for CTRL_FILE_CHANGES it is the Source, Version and Architecture fields
(concatenated with "_");

=item *

for CTRL_FILE_VENDOR it is the Vendor field;

=item *

for CTRL_FILE_STATUS it is the Package and Architecture fields (concatenated
with "_");

=item *

otherwise it is the Package field by default.

=back

=cut

sub set_options {
    my ($self, %opts) = @_;

    # Default values based on type
    if (exists $opts{type}) {
        my $t = $opts{type};
        if ($t == CTRL_TMPL_PKG) {
	    $self->{get_key_func} = sub { return $_[0]->{Package}; };
        } elsif ($t == CTRL_TMPL_SRC) {
	    $self->{get_key_func} = sub { return $_[0]->{Source}; };
        } elsif ($t == CTRL_CHANGELOG) {
	    $self->{get_key_func} = sub {
		return $_[0]->{Source} . '_' . $_[0]->{Version};
	    };
        } elsif ($t == CTRL_COPYRIGHT_HEADER) {
            # This is a bit pointless, because the value will almost always
            # be the same, but guarantees that we use a known field.
            $self->{get_key_func} = sub { return $_[0]->{Format}; };
        } elsif ($t == CTRL_COPYRIGHT_FILES) {
            $self->{get_key_func} = sub { return $_[0]->{Files}; };
        } elsif ($t == CTRL_COPYRIGHT_LICENSE) {
            $self->{get_key_func} = sub { return $_[0]->{License}; };
        } elsif ($t == CTRL_TESTS) {
            $self->{get_key_func} = sub {
                return scalar @{$self->{order}};
            };
        } elsif ($t == CTRL_REPO_SRC or $t == CTRL_DSC) {
            if ($opts{unique_tuple_key} // $self->{unique_tuple_key}) {
                $self->{get_key_func} = sub {
                    return $_[0]->{Package} . '_' . $_[0]->{Version};
                };
            } else {
                $self->{get_key_func} = sub {
                    return $_[0]->{Package};
                };
            }
        } elsif ($t == CTRL_REPO_PKG or $t == CTRL_DEB) {
            if ($opts{unique_tuple_key} // $self->{unique_tuple_key}) {
                $self->{get_key_func} = sub {
                    return $_[0]->{Package} . '_' . $_[0]->{Version} . '_' .
                           $_[0]->{Architecture};
                };
            } else {
                $self->{get_key_func} = sub {
                    return $_[0]->{Package};
                };
            }
        } elsif ($t == CTRL_FILE_CHANGES) {
	    $self->{get_key_func} = sub {
		return $_[0]->{Source} . '_' . $_[0]->{Version} . '_' .
		       $_[0]->{Architecture};
	    };
        } elsif ($t == CTRL_FILE_VENDOR) {
	    $self->{get_key_func} = sub { return $_[0]->{Vendor}; };
        } elsif ($t == CTRL_FILE_STATUS) {
	    $self->{get_key_func} = sub {
		return $_[0]->{Package} . '_' . $_[0]->{Architecture};
	    };
        }
    }

    # Options set by the user override default values
    $self->{$_} = $opts{$_} foreach keys %opts;
}

=item $index->get_type()

Returns the type of control information stored. See the type parameter
set during new().

=cut

sub get_type {
    my $self = shift;
    return $self->{type};
}

=item $index->add($item, [$key])

Add a new item in the index. If the $key parameter is omitted, the key
will be generated with the get_key_func function (see set_options() for
details).

=cut

sub add {
    my ($self, $item, $key) = @_;

    $key //= $self->{get_key_func}($item);
    if (not exists $self->{items}{$key}) {
	push @{$self->{order}}, $key;
    }
    $self->{items}{$key} = $item;
}

=item $index->parse($fh, $desc)

Reads the filehandle and creates all items parsed. When called multiple
times, the parsed stanzas are accumulated.

Returns the number of items parsed.

=cut

sub parse {
    my ($self, $fh, $desc) = @_;
    my $item = $self->new_item();
    my $i = 0;
    while ($item->parse($fh, $desc)) {
	$self->add($item);
	$item = $self->new_item();
	$i++;
    }
    return $i;
}

=item $index->load($file)

Reads the file and creates all items parsed. Returns the number of items
parsed. Handles compressed files transparently based on their extensions.

=item $item = $index->new_item()

Creates a new item. Mainly useful for derived objects that would want
to override this method to return something else than a L<Dpkg::Control>
object.

=cut

sub new_item {
    my $self = shift;
    return Dpkg::Control->new(%{$self->{item_opts}}, type => $self->{type});
}

=item $item = $index->get_by_key($key)

Returns the item identified by $key or undef.

=cut

sub get_by_key {
    my ($self, $key) = @_;
    return $self->{items}{$key} if exists $self->{items}{$key};
    return;
}

=item @keys = $index->get_keys(%criteria)

Returns the keys of items that matches all the criteria. The key of the
%criteria hash is a field name and the value is either a regex that needs
to match the field value, or a reference to a function that must return
true and that receives the field value as single parameter, or a scalar
that must be equal to the field value.

=cut

sub get_keys {
    my ($self, %crit) = @_;
    my @selected = @{$self->{order}};
    foreach my $s_crit (keys %crit) { # search criteria
	if (ref($crit{$s_crit}) eq 'Regexp') {
	    @selected = grep {
		exists $self->{items}{$_}{$s_crit} and
		       $self->{items}{$_}{$s_crit} =~ $crit{$s_crit}
	    } @selected;
	} elsif (ref($crit{$s_crit}) eq 'CODE') {
	    @selected = grep {
		$crit{$s_crit}->($self->{items}{$_}{$s_crit});
	    } @selected;
	} else {
	    @selected = grep {
		exists $self->{items}{$_}{$s_crit} and
		       $self->{items}{$_}{$s_crit} eq $crit{$s_crit}
	    } @selected;
	}
    }
    return @selected;
}

=item @items = $index->get(%criteria)

Returns all the items that matches all the criteria.

=cut

sub get {
    my ($self, %crit) = @_;
    return map { $self->{items}{$_} } $self->get_keys(%crit);
}

=item $index->remove_by_key($key)

Remove the item identified by the given key.

=cut

sub remove_by_key {
    my ($self, $key) = @_;
    @{$self->{order}} = grep { $_ ne $key } @{$self->{order}};
    return delete $self->{items}{$key};
}

=item @items = $index->remove(%criteria)

Returns and removes all the items that matches all the criteria.

=cut

sub remove {
    my ($self, %crit) = @_;
    my @keys = $self->get_keys(%crit);
    my (%keys, @ret);
    foreach my $key (@keys) {
	$keys{$key} = 1;
	push @ret, $self->{items}{$key} if defined wantarray;
	delete $self->{items}{$key};
    }
    @{$self->{order}} = grep { not exists $keys{$_} } @{$self->{order}};
    return @ret;
}

=item $index->merge($other_index, %opts)

Merge the entries of the other index. While merging, the keys of the merged
index are used, they are not re-computed (unless you have set the options
"keep_keys" to "0"). It's your responsibility to ensure that they have been
computed with the same function.

=cut

sub merge {
    my ($self, $other, %opts) = @_;
    $opts{keep_keys} //= 1;
    foreach my $key ($other->get_keys()) {
	$self->add($other->get_by_key($key), $opts{keep_keys} ? $key : undef);
    }
}

=item $index->sort(\&sortfunc)

Sort the index with the given sort function. If no function is given, an
alphabetic sort is done based on the keys. The sort function receives the
items themselves as parameters and not the keys.

=cut

sub sort {
    my ($self, $func) = @_;
    if (defined $func) {
	@{$self->{order}} = sort {
	    $func->($self->{items}{$a}, $self->{items}{$b})
	} @{$self->{order}};
    } else {
	@{$self->{order}} = sort @{$self->{order}};
    }
}

=item $str = $index->output([$fh])

=item "$index"

Get a string representation of the index. The L<Dpkg::Control> objects are
output in the order which they have been read or added except if the order
have been changed with sort().

Print the string representation of the index to a filehandle if $fh has
been passed.

=cut

sub output {
    my ($self, $fh) = @_;
    my $str = '';
    foreach my $key ($self->get_keys()) {
	if (defined $fh) {
	    print { $fh } $self->get_by_key($key) . "\n";
	}
	if (defined wantarray) {
	    $str .= $self->get_by_key($key) . "\n";
	}
    }
    return $str;
}

=item $index->save($file)

Writes the content of the index in a file. Auto-compresses files
based on their extensions.

=back

=head1 CHANGES

=head2 Version 3.00 (dpkg 1.21.2)

Change behavior: The CTRL_TESTS key now defaults to a stanza index.

=head2 Version 2.01 (dpkg 1.20.6)

New option: Add new "item_opts" option.

=head2 Version 2.00 (dpkg 1.20.0)

Change behavior: The "unique_tuple_key" option now defaults to true.

=head2 Version 1.01 (dpkg 1.19.0)

New option: Add new "unique_tuple_key" option to $index->set_options() to set
better default "get_key_func" options, which will become the default behavior
in 1.20.x.

=head2 Version 1.00 (dpkg 1.15.6)

Mark the module as public.

=cut

1;