/[public]/apt-installed-status/trunk/apt-installed-status
ViewVC logotype

Diff of /apt-installed-status/trunk/apt-installed-status

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 330 Revision 332
… …
142 142
143############### 143###############
144# OUTPUT DATA # 144# OUTPUT DATA #
145############### 145###############
146 146
147sub print_orphans 147# Go through the list of all packages and call a subroutine on each installed
148{ 148# package.
149 foreach my $package_data (values %installed_packages) { 149# Parameter 1: $sub: Reference to the subroutine to call
150 foreach my $entry (@$package_data) { 150# Each call gets two parameters: the entry and $long
151 if ($entry->{status} eq 'install ok installed') { 151# Parameter 2..: @params: All other parameters
152 if (! @{$entry->{lists}}) { 152# Returns: Nothing
153 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n"; 153# Side effects: Generates output on STDOUT
154 } 154sub iterate_through_packages {
155 } 155 my ($sub, @params) = @_;
156 }
157 }
158}
159
160sub print_all
161{
162 foreach my $package_name (sort keys %installed_packages) { 156 foreach my $package_name (sort keys %installed_packages) {
163 foreach my $entry (@{$installed_packages{$package_name}}) { 157 foreach my $entry (@{$installed_packages{$package_name}}) {
164 if ($entry->{status} eq 'install ok installed') { 158 if ($entry->{status} eq 'install ok installed') {
165 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n"; 159 &$sub($entry, @params)
166 } 160 }
167 } 161 }
168 } 162 }
169} 163}
170 164
165# Print an entry, either with or without its archives
166# Parameter 1: $entry: a hash reference containing keys package, architecture
167# and version (as well as lists if $long is true)
168# Parameter 2: $long: whether to print the archives too
169# Returns: nothing
170# Side effects: Generates output on STDOUT
171sub print_item
172{
173 my ($entry, $long) = @_;
174 if ($long) {
175 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
176 } else {
177 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
178 }
179}
180
181# Print all packages, including archives
182sub print_all
183{
184 iterate_through_packages(\&print_item, 1);
185}
186
187
188# Print only those packages that have no archive associated with them
189sub print_orphans
190{
191 iterate_through_packages(\&print_orphans_item);
192}
193
194# Callback: check whether an entry is an orphan and if so print it
195sub print_orphans_item
196{
197 my ($entry) = @_;
198 if (! @{$entry->{lists}}) {
199 print_item($entry, 0);
200 }
201}
202
203# Print those packages which are only in the specified archives
171sub print_archives_only 204sub print_archives_only
172{ 205{
173 my ($archives,$long) = @_; 206 my ($archives,$long) = @_;
174 my %archives; 207 my %archives;
175 foreach my $archive (split (/,/,$archives)) { 208 foreach my $archive (split (/,/,$archives)) {
176 $archives{$archive} = 1; 209 $archives{$archive} = 1;
177 } 210 }
178 foreach my $package_name (sort keys %installed_packages) { 211 iterate_through_packages(\&print_archives_only_item, \%archives, $long);
179 foreach my $entry (@{$installed_packages{$package_name}}) { 212}
180 if ($entry->{status} eq 'install ok installed') { 213
214# Callback: print an entry if it is only in the specified archives
215sub print_archives_only_item
216{
217 my ($entry,$archives, $long) = @_;
181 my $valid = 1; 218 my $valid = 1;
182 my $nr=0;
183 foreach my $list (@{$entry->{lists}}) { 219 foreach my $list (@{$entry->{lists}}) {
184 $nr++;
185 if (! exists($archives{$list})) { 220 if (! exists($archives->{$list})) {
186 $valid = 0; 221 $valid = 0;
187 last; 222 last;
188 }
189 }
190 if ($valid and $nr) {
191 if ($long) {
192 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
193 } else {
194 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
195 }
196 }
197 } 223 }
198 } 224 }
225 if ($valid and @{$entry->{lists}}) {
226 print_item($entry, $long)
199 } 227 }
200} 228}
201 229
230# Print those packages which are only in the archives specified through a
231# regular expression
202sub print_archives_only_regexp 232sub print_archives_only_regexp
203{ 233{
204 my ($archives_regexp,$long) = @_; 234 my ($archives_regexp,$long) = @_;
205 foreach my $package_name (sort keys %installed_packages) { 235 iterate_through_packages(\&print_archives_only_regexp_item, $archives_regexp, $long);
206 foreach my $entry (@{$installed_packages{$package_name}}) { 236}
207 if ($entry->{status} eq 'install ok installed') { 237
238# Callback: print an entry if it is only in the archives specified through a
239# regular expression
240sub print_archives_only_regexp_item
241{
242 my ($entry, $archives_regexp, $long) = @_;
208 my $valid = 1; 243 my $valid = 1;
209 my $nr=0;
210 foreach my $list (@{$entry->{lists}}) { 244 foreach my $list (@{$entry->{lists}}) {
211 $nr++;
212 if (! ($list =~ /$archives_regexp/)) { 245 if (! ($list =~ /$archives_regexp/)) {
213 $valid = 0; 246 $valid = 0;
214 last; 247 last;
215 }
216 }
217 if ($valid and $nr) {
218 if ($long) {
219 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
220 } else {
221 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
222 }
223 }
224 } 248 }
225 } 249 }
250 if ($valid and @{$entry->{lists}}) {
251 print_item($entry, $long)
252 }
253}
254
255# Print those packages which are not in the specified archives
256sub print_archives_except
257{
258 my ($archives,$long) = @_;
259 my %archives;
260 foreach my $archive (split (/,/,$archives)) {
261 $archives{$archive} = 1;
262 }
263 iterate_through_packages(\&print_archives_except_item, \%archives, $long);
264}
265
266# Callback: print an entry if it is not in the specified archives
267sub print_archives_except_item
268{
269 my ($entry,$archives, $long) = @_;
270 my $valid = 1;
271 foreach my $list (@{$entry->{lists}}) {
272 if (exists($archives->{$list})) {
273 $valid = 0;
274 last;
226 } 275 }
276 }
277 if ($valid and @{$entry->{lists}}) {
278 print_item($entry, $long)
279 }
227} 280}
228 281
282# Print those packages which are not in the archives specified through a
283# regular expression
284sub print_archives_except_regexp
285{
286 my ($archives_regexp,$long) = @_;
287 iterate_through_packages(\&print_archives_except_regexp_item, $archives_regexp, $long);
288}
289
290# Callback: print an entry if it is not in the archives specified through a
291# regular expression
292sub print_archives_except_regexp_item
293{
294 my ($entry, $archives_regexp, $long) = @_;
295 my $valid = 1;
296 foreach my $list (@{$entry->{lists}}) {
297 if ($list =~ /$archives_regexp/) {
298 $valid = 0;
299 last;
300 }
301 }
302 if ($valid and @{$entry->{lists}}) {
303 print_item($entry, $long)
304 }
305}
229 306
230######################### 307#########################
231# COMMAND LINE HANDLING # 308# COMMAND LINE HANDLING #
232######################### 309#########################
233 310
… …
239 print STDERR " -o: orphans: packages that are not in any archive\n"; 316 print STDERR " -o: orphans: packages that are not in any archive\n";
240 print STDERR " -a ARCHS: archives: list all packages that are only in one of the listed\n"; 317 print STDERR " -a ARCHS: archives: list all packages that are only in one of the listed\n";
241 print STDERR " archives (seperated by commas)\n"; 318 print STDERR " archives (seperated by commas)\n";
242 print STDERR " -A ARCHREGEXP: archives: list all packages that are only in archives\n"; 319 print STDERR " -A ARCHREGEXP: archives: list all packages that are only in archives\n";
243 print STDERR " that match the regular expression\n"; 320 print STDERR " that match the regular expression\n";
321 print STDERR " -x ARCHS: except: list all packages that are not in one of the listed\n";
322 print STDERR " archives (seperated by commas)\n";
323 print STDERR " -X ARCHREGEXP: except: list all packages that are not in archives\n";
324 print STDERR " that match the regular expression\n";
244 print STDERR " -l: long: print archives too\n"; 325 print STDERR " -l: long: print archives too\n";
245 326
246 print STDERR "Default: print all packages and sources\n"; 327 print STDERR "Default: print all packages and sources\n";
247} 328}
248 329
… …
259 340
260$Getopt::Std::STANDARD_HELP_VERSION=1; 341$Getopt::Std::STANDARD_HELP_VERSION=1;
261 342
262our $VERSION=$version; 343our $VERSION=$version;
263my %options; 344my %options;
264if (! getopts('hVola:A:',\%options)) 345if (! getopts('hVola:A:x:X:',\%options))
265{ 346{
266 print_help(); 347 print_help();
267 exit 1; 348 exit 1;
268} 349}
269my $long=0; 350my $long=0;
… …
289} 370}
290if ($options{A}) { 371if ($options{A}) {
291 print_archives_only_regexp($options{A},$long); 372 print_archives_only_regexp($options{A},$long);
292 exit 0; 373 exit 0;
293} 374}
375if ($options{x}) {
376 print_archives_except($options{x},$long);
377 exit 0;
378}
379if ($options{X}) {
380 print_archives_except_regexp($options{X},$long);
381 exit 0;
382}
294print_all; 383print_all;
295 384
296 385
297# vim:sw=2:ft=perl:expandtab: 386# vim:sw=2:ft=perl:expandtab:
Legend:
Removed from v.330  
changed lines
  Added in v.332
frodo@frodo.looijaard.name
 ViewVC Help
Powered by ViewVC 1.1.26