debsort.pl

   1 #!/usr/bin/env perl
   2 #
   3 #   Copyright 2014 Thadeu Lima de Souza Cascardo <cascardo@cascardo.info>
   4 #
   5 #   This program is free software: you can redistribute it and/or modify
   6 #   it under the terms of the GNU General Public License as published by
   7 #   the Free Software Foundation, either version 3 of the License, or
   8 #   (at your option) any later version.
   9 #
  10 #   This program is distributed in the hope that it will be useful,
  11 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 #   GNU General Public License for more details.
  14 #
  15 #   You should have received a copy of the GNU General Public License
  16 #   along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17 #
  18
  19 use strict;
  20 use warnings;
  21
  22 open(PACKAGES, "<Packages");
  23
  24 my @packages = ();
  25 my %depends = ();
  26 my %priority = ();
  27 my %essential = ();
  28 my %size = ();
  29
  30 sub add_depends {
  31         my ($package, $depends) = @_;
  32         my $deps = [];
  33         my @vdeps = split(",", $depends);
  34         for my $i (@vdeps) {
  35                 $i =~ qr,([0-9a-z-+.]+),;
  36                 push @$deps, $1;
  37         }
  38         $depends{$package} = $deps;
  39 }
  40
  41 my $package;
  42 while (<PACKAGES>) {
  43         if (/^Package: ([0-9a-z-+.]+)/) {
  44                 $package = $1;
  45                 push @packages, $package;
  46         }
  47         if (/^Depends: (.*)/) {
  48                 add_depends($package, $1);
  49         }
  50         if (/^Priority: (.*)/) {
  51                 $priority{$package} = $1;
  52         }
  53         if (/^Essential: yes/) {
  54                 $essential{$package} = "yes";
  55         }
  56         if (/^Size: (.*)/) {
  57                 $size{$package} = $1;
  58         }
  59 }
  60
  61 close(PACKAGES);
  62
  63 open(SOURCES, "<Sources");
  64
  65 my @sources = ();
  66 my %binaries = ();
  67 my %csource = ();
  68 my %bdeps = ();
  69
  70 sub add_binaries {
  71         my ($package, $binaries) = @_;
  72         my $bb = [];
  73         my @vbb = split(", ", $binaries);
  74         for my $i (@vbb) {
  75                 $i =~ qr,([0-9a-z-+.]+),;
  76                 push @$bb, $1;
  77                 $csource{$i} = $package;
  78         }
  79         $binaries{$package} = $bb;
  80 }
  81
  82 sub add_bdeps {
  83         my ($package, $bdeps) = @_;
  84         my $bd = [];
  85         my @vbd = split(", ", $bdeps);
  86         for my $i (@vbd) {
  87                 $i =~ qr,([0-9a-z-+.]+),;
  88                 push @$bd, $1;
  89         }
  90         $bdeps{$package} = $bd;
  91 }
  92
  93
  94 while (<SOURCES>) {
  95         if (/^Package: ([0-9a-z-+.]+)/) {
  96                 $package = $1;
  97                 push @packages, $package;
  98         }
  99         if (/^Binary: (.*)/) {
 100                 add_binaries($package, $1);
 101         }
 102         if (/^Build-Depends: (.*)/) {
 103                 add_bdeps($package, $1);
 104         }
 105 }
 106
 107 close(SOURCES);
 108
 109 my @pp = ();
 110
 111 my @visit = ();
 112
 113 my @vsource = ();
 114
 115 for my $i (keys %essential) {
 116         push @visit, $i;
 117 }
 118 push @visit, "build-essential";
 119
 120 while (@visit) {
 121         my $n = pop @visit;
 122         next if grep /^$n$/, @pp;
 123         push @pp, $n;
 124         my $source = $csource{$n};
 125         if ($source and !grep /^$source$/, @vsource) {
 126                 push @vsource, $source;
 127                 for my $b (@{$bdeps{$source}}) {
 128                         if (!grep /^$b$/, @pp && !grep /^$b$/, @visit) {
 129                                 push @visit, $b;
 130                         }
 131                 }
 132         }
 133         my $l = $depends{$n};
 134         for my $d (@$l) {
 135                 if (!grep /^$d$/, @pp && !grep /^$d$/, @visit) {
 136                         push @visit, $d;
 137                 }
 138         }
 139 }
 140
 141 my $tsize = 0;
 142 for my $i (@pp) {
 143         $size{$i} = 0 if (!defined($size{$i}));
 144         print "$size{$i} $i\n";
 145         $tsize += $size{$i};
 146 }
 147
 148 print "$tsize Total\n";