| 1 |
#!/usr/bin/perl
|
| 2 |
# Find which packages have been changed by tacking a
|
| 3 |
# look at Packages.gz files (well, should be already
|
| 4 |
# de-compressed)
|
| 5 |
#
|
| 6 |
# Javier Fernandez-Sanguino Peña <jfs_at_debian.org>
|
| 7 |
# Distributed under the GNU GPL
|
| 8 |
|
| 9 |
use Getopt::Std;
|
| 10 |
# Options:
|
| 11 |
# -d = debug
|
| 12 |
# -p release = previous release 'release'
|
| 13 |
# -r release = current release 'release'
|
| 14 |
# -m dir = use mirror directory 'dir'
|
| 15 |
# -a arch = use architecture 'arch'
|
| 16 |
getopts('dp:r:m:a:');
|
| 17 |
|
| 18 |
# Debug
|
| 19 |
my $debug = $opt_d || 0;
|
| 20 |
# Releases and path location
|
| 21 |
my $prevrelease = $opt_p || "woody";
|
| 22 |
my $currelease = $opt_r || "sarge";
|
| 23 |
my $mirrordir = $opt_m || "/home/mirrors/debian/debian.org";
|
| 24 |
my $arch = $opt_a || "i386";
|
| 25 |
my @releases = ( $currelease, $prevrelease ) ;
|
| 26 |
my @components = ("main", "contrib", "non-free") ;
|
| 27 |
|
| 28 |
# Initialise
|
| 29 |
my @added, @removed, unchanged;
|
| 30 |
$packchanged=0;
|
| 31 |
my %changed ;
|
| 32 |
|
| 33 |
foreach $releasei (0 .. $#releases ) {
|
| 34 |
my $release = $releases[$releasei];
|
| 35 |
foreach $componenti (0 .. $#components ) {
|
| 36 |
my $component = $components[$componenti];
|
| 37 |
$release{$release}{$component}=$mirrordir."/dists/".$release."/".$component."/binary-".$arch."/Packages";
|
| 38 |
die "Cannot read $release{$release}{$component}" if ! -r $release{$release}{$component};
|
| 39 |
print "Found component '$component' for release '$release' at $release{$release}{$component}\n" if $debug;
|
| 40 |
}
|
| 41 |
}
|
| 42 |
|
| 43 |
|
| 44 |
# Global (ugly)
|
| 45 |
$totalnumbers{$currelease}=0;
|
| 46 |
$totalnumbers{$prevrelease}=0;
|
| 47 |
|
| 48 |
# For each release read all the files and make a *Big* hash
|
| 49 |
|
| 50 |
foreach $file ( keys(%{$release{$prevrelease}}) ) {
|
| 51 |
read_file($prevrelease,$release{$prevrelease}{$file});
|
| 52 |
}
|
| 53 |
foreach $file ( keys(%{$release{$currelease}}) ) {
|
| 54 |
read_file($currelease,$release{$currelease}{$file});
|
| 55 |
}
|
| 56 |
|
| 57 |
# Once this is done compare all the packages found and their description
|
| 58 |
# or version and if they have changed say so.
|
| 59 |
#If the package does not exist add: REMOVED
|
| 60 |
|
| 61 |
foreach $package ( keys(%{$packages{$prevrelease}}) ) {
|
| 62 |
|
| 63 |
if ( defined $packages{$currelease}{$package} ) {
|
| 64 |
my $status=check_packages($packages{$currelease}{$package},$packages{$prevrelease}{$package}) if $packages{$currelease}{$package} ne $packages{$prevrelease}{$package};
|
| 65 |
if ( $status eq "" ) {
|
| 66 |
push @unchanged, $package;
|
| 67 |
} else {
|
| 68 |
$packchanged++;
|
| 69 |
$changed{$package}=$status;
|
| 70 |
}
|
| 71 |
} else {
|
| 72 |
push @removed, $package;
|
| 73 |
}
|
| 74 |
} # of the foreach
|
| 75 |
|
| 76 |
# The other way around (currelease vs prevrelease)
|
| 77 |
|
| 78 |
foreach $package ( keys(%{$packages{$currelease}}) ) {
|
| 79 |
|
| 80 |
if ( ! defined $packages{$prevrelease}{$package} ) {
|
| 81 |
push @added, $package;
|
| 82 |
}
|
| 83 |
} # of the foreach
|
| 84 |
|
| 85 |
# Summary
|
| 86 |
$header="Comparison details from '$prevrelease' to '$currelease'";
|
| 87 |
print $header."\n";
|
| 88 |
print "-" x length($header);
|
| 89 |
print "\n";
|
| 90 |
# Final numbers:
|
| 91 |
foreach $release ( keys(%totalnumbers) ) {
|
| 92 |
print "Total packages for ".$release.": ".$totalnumbers{$release}."\n";
|
| 93 |
} # of the foreach
|
| 94 |
print "Added packages: $#added\n";
|
| 95 |
print "Removed packages: $#removed\n";
|
| 96 |
print "Changed packages: $packchanged\n";
|
| 97 |
print "Unchanged packages (no version update): $#unchanged\n";
|
| 98 |
print "\nDetailed information\n\n";
|
| 99 |
print "\n------------------\n";
|
| 100 |
print "ADDED packages";
|
| 101 |
print "\n------------------\n";
|
| 102 |
foreach my $packi ( 0 .. $#added ) {
|
| 103 |
print $added[$packi]."\n";
|
| 104 |
}
|
| 105 |
print "\n------------------\n";
|
| 106 |
print "REMOVED packages";
|
| 107 |
print "\n------------------\n";
|
| 108 |
foreach my $packi ( 0 .. $#removed ) {
|
| 109 |
print $removed[$packi]."\n";
|
| 110 |
}
|
| 111 |
print "\n------------------\n";
|
| 112 |
print "CHANGED packages";
|
| 113 |
print "\n------------------\n";
|
| 114 |
foreach my $pack ( keys %changed ) {
|
| 115 |
print "$pack -> $changed{$pack}";
|
| 116 |
}
|
| 117 |
print "\n------------------\n";
|
| 118 |
print "UNCHANGED packages";
|
| 119 |
print "\n------------------\n";
|
| 120 |
foreach my $packi ( 0 .. $#unchanged ) {
|
| 121 |
print $unchanged[$packi]."\n";
|
| 122 |
}
|
| 123 |
|
| 124 |
|
| 125 |
exit 0;
|
| 126 |
|
| 127 |
sub check_packages {
|
| 128 |
# Checks two packages text to see if they are the same
|
| 129 |
# and determines what has changed (version, description...)
|
| 130 |
# Description changes should imply version change but not
|
| 131 |
# the other way around. Since description changes refer
|
| 132 |
# to more important changes.
|
| 133 |
my($curpackage,$prevpackage)=@_;
|
| 134 |
my $origversion=retrieve_version($prevpackage);
|
| 135 |
my $newversion=retrieve_version($curpackage);
|
| 136 |
my $return = "";
|
| 137 |
print "Comparing $origversion and $newversion\n" if $debug;
|
| 138 |
# TODO: could use dpkg --compare-versions to determine
|
| 139 |
# if it's an upgrade or a downgrade here....
|
| 140 |
if ( $origversion ne $newversion ) {
|
| 141 |
$origtext=retrieve_text($prevpackage);
|
| 142 |
$newtext=retrieve_text($curpackage);
|
| 143 |
print "Comparing $origtext and $newtext\n" if $debug;
|
| 144 |
if ( $origtext ne $newtext ) {
|
| 145 |
$return ="DESCRIPTION CHANGED ($origversion -> $newversion)\n";
|
| 146 |
} else {
|
| 147 |
# TODO: Could check if the minor version changed only (no upstream release)
|
| 148 |
$return ="CHANGED ($origversion -> $newversion)\n";
|
| 149 |
} # of if origtext newtext
|
| 150 |
} else {
|
| 151 |
$return = "";
|
| 152 |
} # of if origversion newversion
|
| 153 |
return $return;
|
| 154 |
}
|
| 155 |
|
| 156 |
sub retrieve_version {
|
| 157 |
# Retrieves the version info from the text
|
| 158 |
my ($text)=@_;
|
| 159 |
print "Extracting version from $text\n" if $debug;
|
| 160 |
my $retversion="unknown";
|
| 161 |
if ( $text =~ /^.*{(.*?)}$/ ){
|
| 162 |
$retversion=$1;
|
| 163 |
}
|
| 164 |
return $retversion;
|
| 165 |
}
|
| 166 |
sub retrieve_text {
|
| 167 |
# Retrieves the description info from the text
|
| 168 |
my ($origtext)=@_;
|
| 169 |
print "Extracting text from $origtext\n" if $debug;
|
| 170 |
my $rettext="";
|
| 171 |
if ( $origtext =~ /^(.*){.*?}$/ ){
|
| 172 |
$rettext=$1;
|
| 173 |
}
|
| 174 |
return $rettext;
|
| 175 |
}
|
| 176 |
|
| 177 |
sub read_file {
|
| 178 |
# Read in a Package file and retrieves packages for a given release
|
| 179 |
my ($release,$file)=@_;
|
| 180 |
|
| 181 |
open (FILE,"$file") || die ("Cannot open $file: $!");
|
| 182 |
print "Reading $file\n" if $debug;
|
| 183 |
# Finite-state machine
|
| 184 |
# 0 - no package
|
| 185 |
# 1 - package name read
|
| 186 |
# 2 - version read
|
| 187 |
# 3 - package description read
|
| 188 |
my $state=0;
|
| 189 |
my $packagename="";
|
| 190 |
my $description="";
|
| 191 |
while (<FILE>) {
|
| 192 |
chomp;
|
| 193 |
if ( $state == 3 && /^$/ ){
|
| 194 |
$packages{$release}{$packagename}=$description."{".$version."}";
|
| 195 |
print "Found $packagename: $description ($version)\n" if $debug;
|
| 196 |
$totalnumbers{$release}++;
|
| 197 |
$state=0;
|
| 198 |
}
|
| 199 |
if ( /^$/ && $state > 0 ){
|
| 200 |
# Package that does not comply the state-machine
|
| 201 |
$state=0;
|
| 202 |
}
|
| 203 |
if ( $state == 2 && /^Description: (.*)$/ ){
|
| 204 |
$description=$1;
|
| 205 |
$state=3;
|
| 206 |
}
|
| 207 |
if ( $state == 1 && /^Version: (.*)$/ ){
|
| 208 |
$version=$1;
|
| 209 |
$state=2;
|
| 210 |
}
|
| 211 |
if ( $state == 0 && /^Package: (.*)$/ ){
|
| 212 |
$packagename=$1;
|
| 213 |
$state=1;
|
| 214 |
}
|
| 215 |
}
|
| 216 |
close FILE;
|
| 217 |
|
| 218 |
}
|
Parent Directory
| 
Revision Log