| OLD | NEW |
|---|
| (Empty) |
| 1 # Copyright © 2009 Raphaël Hertzog <hertzog@debian.org> | |
| 2 # | |
| 3 # This program is free software; you can redistribute it and/or modify | |
| 4 # it under the terms of the GNU General Public License as published by | |
| 5 # the Free Software Foundation; either version 2 of the License, or | |
| 6 # (at your option) any later version. | |
| 7 # | |
| 8 # This program is distributed in the hope that it will be useful, | |
| 9 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 11 # GNU General Public License for more details. | |
| 12 # | |
| 13 # You should have received a copy of the GNU General Public License | |
| 14 # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
| 15 | |
| 16 package Dpkg::Index; | |
| 17 | |
| 18 use strict; | |
| 19 use warnings; | |
| 20 | |
| 21 our $VERSION = '1.00'; | |
| 22 | |
| 23 use Dpkg::Gettext; | |
| 24 use Dpkg::ErrorHandling; | |
| 25 use Dpkg::Control; | |
| 26 use Dpkg::Compression::FileHandle; | |
| 27 | |
| 28 use parent qw(Dpkg::Interface::Storable); | |
| 29 | |
| 30 use overload | |
| 31 '@{}' => sub { return $_[0]->{order} }, | |
| 32 fallback => 1; | |
| 33 | |
| 34 =encoding utf8 | |
| 35 | |
| 36 =head1 NAME | |
| 37 | |
| 38 Dpkg::Index - generic index of control information | |
| 39 | |
| 40 =head1 DESCRIPTION | |
| 41 | |
| 42 This object represent a set of Dpkg::Control objects. | |
| 43 | |
| 44 =head1 FUNCTIONS | |
| 45 | |
| 46 =over 4 | |
| 47 | |
| 48 =item my $index = Dpkg::Index->new(%opts) | |
| 49 | |
| 50 Creates a new empty index. See set_options() for more details. | |
| 51 | |
| 52 =cut | |
| 53 | |
| 54 sub new { | |
| 55 my ($this, %opts) = @_; | |
| 56 my $class = ref($this) || $this; | |
| 57 | |
| 58 my $self = { | |
| 59 items => {}, | |
| 60 order => [], | |
| 61 get_key_func => sub { return $_[0]->{Package} }, | |
| 62 type => CTRL_UNKNOWN, | |
| 63 }; | |
| 64 bless $self, $class; | |
| 65 $self->set_options(%opts); | |
| 66 if (exists $opts{load}) { | |
| 67 $self->load($opts{load}); | |
| 68 } | |
| 69 | |
| 70 return $self; | |
| 71 } | |
| 72 | |
| 73 =item $index->set_options(%opts) | |
| 74 | |
| 75 The "type" option is checked first to define default values for other | |
| 76 options. Here are the relevant options: "get_key_func" is a function | |
| 77 returning a key for the item passed in parameters. The index can only | |
| 78 contain one item with a given key. The function used depend on the | |
| 79 type: for CTRL_INFO_PKG, CTRL_INDEX_SRC, CTRL_INDEX_PKG and CTRL_PKG_DEB | |
| 80 it's simply the Package field; for CTRL_PKG_SRC and CTRL_INFO_SRC, it's | |
| 81 the Source field; for CTRL_CHANGELOG it's the Source and the Version | |
| 82 fields (concatenated with an intermediary "_"); for CTRL_FILE_CHANGES it's | |
| 83 the Source, Version and Architecture fields (concatenated with "_"); | |
| 84 for CTRL_FILE_VENDOR it's the Vendor field; for CTRL_FILE_STATUS it's the | |
| 85 Package and Architecture fields (concatenated with "_"). Otherwise it's | |
| 86 the Package field by default. | |
| 87 | |
| 88 =cut | |
| 89 | |
| 90 sub set_options { | |
| 91 my ($self, %opts) = @_; | |
| 92 | |
| 93 # Default values based on type | |
| 94 if (exists $opts{type}) { | |
| 95 my $t = $opts{type}; | |
| 96 if ($t == CTRL_INFO_PKG or $t == CTRL_INDEX_SRC or | |
| 97 $t == CTRL_INDEX_PKG or $t == CTRL_PKG_DEB) { | |
| 98 $self->{get_key_func} = sub { return $_[0]->{Package}; }; | |
| 99 } elsif ($t == CTRL_PKG_SRC or $t == CTRL_INFO_SRC) { | |
| 100 $self->{get_key_func} = sub { return $_[0]->{Source}; }; | |
| 101 } elsif ($t == CTRL_CHANGELOG) { | |
| 102 $self->{get_key_func} = sub { | |
| 103 return $_[0]->{Source} . '_' . $_[0]->{Version}; | |
| 104 }; | |
| 105 } elsif ($t == CTRL_FILE_CHANGES) { | |
| 106 $self->{get_key_func} = sub { | |
| 107 return $_[0]->{Source} . '_' . $_[0]->{Version} . '_' . | |
| 108 $_[0]->{Architecture}; | |
| 109 }; | |
| 110 } elsif ($t == CTRL_FILE_VENDOR) { | |
| 111 $self->{get_key_func} = sub { return $_[0]->{Vendor}; }; | |
| 112 } elsif ($t == CTRL_FILE_STATUS) { | |
| 113 $self->{get_key_func} = sub { | |
| 114 return $_[0]->{Package} . '_' . $_[0]->{Architecture}; | |
| 115 }; | |
| 116 } | |
| 117 } | |
| 118 | |
| 119 # Options set by the user override default values | |
| 120 $self->{$_} = $opts{$_} foreach keys %opts; | |
| 121 } | |
| 122 | |
| 123 =item $index->get_type() | |
| 124 | |
| 125 Returns the type of control information stored. See the type parameter | |
| 126 set during new(). | |
| 127 | |
| 128 =cut | |
| 129 | |
| 130 sub get_type { | |
| 131 my ($self) = @_; | |
| 132 return $self->{type}; | |
| 133 } | |
| 134 | |
| 135 =item $index->add($item, [$key]) | |
| 136 | |
| 137 Add a new item in the index. If the $key parameter is omitted, the key | |
| 138 will be generated with the get_key_func function (see set_options() for | |
| 139 details). | |
| 140 | |
| 141 =cut | |
| 142 | |
| 143 sub add { | |
| 144 my ($self, $item, $key) = @_; | |
| 145 unless (defined $key) { | |
| 146 $key = $self->{get_key_func}($item); | |
| 147 } | |
| 148 if (not exists $self->{items}{$key}) { | |
| 149 push @{$self->{order}}, $key; | |
| 150 } | |
| 151 $self->{items}{$key} = $item; | |
| 152 } | |
| 153 | |
| 154 =item $index->load($file) | |
| 155 | |
| 156 Reads the file and creates all items parsed. Returns the number of items | |
| 157 parsed. Handles compressed files transparently based on their extensions. | |
| 158 | |
| 159 =item $index->parse($fh, $desc) | |
| 160 | |
| 161 Reads the filehandle and creates all items parsed. Returns the number of | |
| 162 items parsed. | |
| 163 | |
| 164 =cut | |
| 165 | |
| 166 sub parse { | |
| 167 my ($self, $fh, $desc) = @_; | |
| 168 my $item = $self->new_item(); | |
| 169 my $i = 0; | |
| 170 while ($item->parse($fh, $desc)) { | |
| 171 $self->add($item); | |
| 172 $item = $self->new_item(); | |
| 173 $i++; | |
| 174 } | |
| 175 return $i; | |
| 176 } | |
| 177 | |
| 178 =item $index->save($file) | |
| 179 | |
| 180 Writes the content of the index in a file. Auto-compresses files | |
| 181 based on their extensions. | |
| 182 | |
| 183 =item my $item = $index->new_item() | |
| 184 | |
| 185 Creates a new item. Mainly useful for derived objects that would want | |
| 186 to override this method to return something else than a Dpkg::Control | |
| 187 object. | |
| 188 | |
| 189 =cut | |
| 190 | |
| 191 sub new_item { | |
| 192 my ($self) = @_; | |
| 193 return Dpkg::Control->new(type => $self->{type}); | |
| 194 } | |
| 195 | |
| 196 =item my $item = $index->get_by_key($key) | |
| 197 | |
| 198 Returns the item identified by $key or undef. | |
| 199 | |
| 200 =cut | |
| 201 | |
| 202 sub get_by_key { | |
| 203 my ($self, $key) = @_; | |
| 204 return $self->{items}{$key} if exists $self->{items}{$key}; | |
| 205 return; | |
| 206 } | |
| 207 | |
| 208 =item my @keys = $index->get_keys(%criteria) | |
| 209 | |
| 210 Returns the keys of items that matches all the criteria. The key of the | |
| 211 %criteria hash is a field name and the value is either a regex that needs | |
| 212 to match the field value, or a reference to a function that must return | |
| 213 true and that receives the field value as single parameter, or a scalar | |
| 214 that must be equal to the field value. | |
| 215 | |
| 216 =cut | |
| 217 | |
| 218 sub get_keys { | |
| 219 my ($self, %crit) = @_; | |
| 220 my @selected = @{$self->{order}}; | |
| 221 foreach my $s_crit (keys %crit) { # search criteria | |
| 222 if (ref($crit{$s_crit}) eq 'Regexp') { | |
| 223 @selected = grep { | |
| 224 $self->{items}{$_}{$s_crit} =~ $crit{$s_crit} | |
| 225 } @selected; | |
| 226 } elsif (ref($crit{$s_crit}) eq 'CODE') { | |
| 227 @selected = grep { | |
| 228 &{$crit{$s_crit}}($self->{items}{$_}{$s_crit}); | |
| 229 } @selected; | |
| 230 } else { | |
| 231 @selected = grep { | |
| 232 $self->{items}{$_}{$s_crit} eq $crit{$s_crit} | |
| 233 } @selected; | |
| 234 } | |
| 235 } | |
| 236 return @selected; | |
| 237 } | |
| 238 | |
| 239 =item my @items = $index->get(%criteria) | |
| 240 | |
| 241 Returns all the items that matches all the criteria. | |
| 242 | |
| 243 =cut | |
| 244 | |
| 245 sub get { | |
| 246 my ($self, %crit) = @_; | |
| 247 return map { $self->{items}{$_} } $self->get_keys(%crit); | |
| 248 } | |
| 249 | |
| 250 =item $index->remove_by_key($key) | |
| 251 | |
| 252 Remove the item identified by the given key. | |
| 253 | |
| 254 =cut | |
| 255 | |
| 256 sub remove_by_key { | |
| 257 my ($self, $key) = @_; | |
| 258 @{$self->{order}} = grep { $_ ne $key } @{$self->{order}}; | |
| 259 return delete $self->{items}{$key}; | |
| 260 } | |
| 261 | |
| 262 =item my @items = $index->remove(%criteria) | |
| 263 | |
| 264 Returns and removes all the items that matches all the criteria. | |
| 265 | |
| 266 =cut | |
| 267 | |
| 268 sub remove { | |
| 269 my ($self, %crit) = @_; | |
| 270 my @keys = $self->get_keys(%crit); | |
| 271 my (%keys, @ret); | |
| 272 foreach my $key (@keys) { | |
| 273 $keys{$key} = 1; | |
| 274 push @ret, $self->{items}{$key} if defined wantarray; | |
| 275 delete $self->{items}{$key}; | |
| 276 } | |
| 277 @{$self->{order}} = grep { not exists $keys{$_} } @{$self->{order}}; | |
| 278 return @ret; | |
| 279 } | |
| 280 | |
| 281 =item $index->merge($other_index, %opts) | |
| 282 | |
| 283 Merge the entries of the other index. While merging, the keys of the merged | |
| 284 index are used, they are not re-computed (unless you have set the options | |
| 285 "keep_keys" to "0"). It's your responsibility to ensure that they have been | |
| 286 computed with the same function. | |
| 287 | |
| 288 =cut | |
| 289 | |
| 290 sub merge { | |
| 291 my ($self, $other, %opts) = @_; | |
| 292 $opts{keep_keys} = 1 unless exists $opts{keep_keys}; | |
| 293 foreach my $key ($other->get_keys()) { | |
| 294 $self->add($other->get_by_key($key), $opts{keep_keys} ? $key : undef); | |
| 295 } | |
| 296 } | |
| 297 | |
| 298 =item $index->sort(\&sortfunc) | |
| 299 | |
| 300 Sort the index with the given sort function. If no function is given, an | |
| 301 alphabetic sort is done based on the keys. The sort function receives the | |
| 302 items themselves as parameters and not the keys. | |
| 303 | |
| 304 =cut | |
| 305 | |
| 306 sub sort { | |
| 307 my ($self, $func) = @_; | |
| 308 if (defined $func) { | |
| 309 @{$self->{order}} = sort { | |
| 310 &$func($self->{items}{$a}, $self->{items}{$b}) | |
| 311 } @{$self->{order}}; | |
| 312 } else { | |
| 313 @{$self->{order}} = sort @{$self->{order}}; | |
| 314 } | |
| 315 } | |
| 316 | |
| 317 =item my $str = $index->output() | |
| 318 | |
| 319 =item "$index" | |
| 320 | |
| 321 Get a string representation of the index. The Dpkg::Control objects are | |
| 322 output in the order which they have been read or added except if the order | |
| 323 hae been changed with sort(). | |
| 324 | |
| 325 =item $index->output($fh) | |
| 326 | |
| 327 Print the string representation of the index to a filehandle. | |
| 328 | |
| 329 =cut | |
| 330 | |
| 331 sub output { | |
| 332 my ($self, $fh) = @_; | |
| 333 my $str = ''; | |
| 334 foreach my $key ($self->get_keys()) { | |
| 335 if (defined $fh) { | |
| 336 print { $fh } $self->get_by_key($key) . "\n"; | |
| 337 } | |
| 338 if (defined wantarray) { | |
| 339 $str .= $self->get_by_key($key) . "\n"; | |
| 340 } | |
| 341 } | |
| 342 return $str; | |
| 343 } | |
| 344 | |
| 345 =back | |
| 346 | |
| 347 =head1 AUTHOR | |
| 348 | |
| 349 Raphaël Hertzog <hertzog@debian.org>. | |
| 350 | |
| 351 =cut | |
| 352 | |
| 353 1; | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2425693003:
Revert of Linux build: Use sysroot when calculating dependencies (Closed)
