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 my %ssize = ();
  70
  71 sub add_binaries {
  72         my ($package, $binaries) = @_;
  73         my $bb = [];
  74         my @vbb = split(", ", $binaries);
  75         for my $i (@vbb) {
  76                 $i =~ qr,([0-9a-z-+.]+),;
  77                 push @$bb, $1;
  78                 $csource{$i} = $package;
  79         }
  80         $binaries{$package} = $bb;
  81 }
  82
  83 sub add_bdeps {
  84         my ($package, $bdeps) = @_;
  85         my $bd = [];
  86         my @vbd = split(", ", $bdeps);
  87         for my $i (@vbd) {
  88                 $i =~ qr,([0-9a-z-+.]+),;
  89                 push @$bd, $1;
  90         }
  91         $bdeps{$package} = $bd;
  92 }
  93
  94 my $files_start = 0;
  95
  96 while (<SOURCES>) {
  97         if (/^Package: ([0-9a-z-+.]+)/) {
  98                 $package = $1;
  99                 push @packages, $package;
 100         }
 101         if (/^Binary: (.*)/) {
 102                 add_binaries($package, $1);
 103         }
 104         if (/^Build-Depends: (.*)/) {
 105                 add_bdeps($package, $1);
 106         }
 107         if ($files_start) {
 108                 if (/^ [a-f0-9]+ ([0-9]+)/) {
 109                         $ssize{$package} += $1;
 110                 } else {
 111                         $files_start = 0;
 112                 }
 113         }
 114         if (/^Files:/) {
 115                 $files_start = 1;
 116                 $ssize{$package} = 0;
 117         }
 118 }
 119
 120 close(SOURCES);
 121
 122 my @pp = ();
 123
 124 my @visit = ();
 125
 126 my @vsource = ();
 127
 128 for my $i (keys %essential) {
 129         push @visit, $i;
 130 }
 131 for my $i (@packages) {
 132         if (defined($priority{$i}) and ($priority{$i} eq "required" ||
 133             $priority{$i} eq "standard" || $priority{$i} eq "important")) {
 134                 push @visit, $i;
 135         }
 136 }
 137 push @visit, "build-essential";
 138
 139 while (@visit) {
 140         my $n = pop @visit;
 141         next if grep /^\Q$n\E$/, @pp;
 142         push @pp, $n;
 143         my $source = $csource{$n};
 144         if ($source and !grep /^\Q$source\E$/, @vsource) {
 145                 push @vsource, $source;
 146                 for my $b (@{$bdeps{$source}}) {
 147                         if (!grep /^\Q$b\E$/, @pp && !grep /^\Q$b\E$/, @visit) {
 148                                 push @visit, $b;
 149                         }
 150                 }
 151         }
 152         my $l = $depends{$n};
 153         for my $d (@$l) {
 154                 if (!grep /^\Q$d\E$/, @pp && !grep /^\Q$d\E$/, @visit) {
 155                         push @visit, $d;
 156                 }
 157         }
 158 }
 159
 160 my $tsize = 0;
 161
 162 for my $i (@pp) {
 163         $size{$i} = 0 if (!defined($size{$i}));
 164         print "$size{$i} $i\n";
 165         $tsize += $size{$i};
 166 }
 167
 168 for my $i (@vsource) {
 169         $ssize{$i} = 0 if (!defined($ssize{$i}));
 170         print "$ssize{$i} S:$i\n";
 171         $tsize += $ssize{$i};
 172 }
 173
 174 print "$tsize Total\n";