Happy new year :)

Thank you for including the first patch I posted.

Here is a second patch (against the current svn revision) with more changes
& fixes :

* Add 2 new commands :
   - compare-src-bin-packages DIST : compare sources and binaries for DIST
   - compare-src-bin-versions DIST : same as compare-src-bin-versions, but
also run dpkg --compare-versions and display where the package is newer
These new commands compare the binaries listed in "Binary:" for each source,
with the binaries really present in DIST. This allows to keep track of
FTBFS, binary-only and not-for-us packages for a DIST.
* Configure Getopt::Long to use "require_order" so we can pass options to
the apt commands (e.g. `chdist apt-rdepends test --reverse foo` could not
work so far)
* Always create apt.conf in dist_create and stop using "-o options" in the
command line. The result is quite the same, but the command lines are more
simple. Also, apt-rdepends doesn't support "-o options" but supports the
same statements in apt.conf.
* Get default architecture from `dpkg --print-architecture`
* Add a recurs_mkdir sub in dist_create so users can use slashes in DIST
names
* Fix some warnings with "W:" as done with others
* Fix regexp in the list sub : ^\w+$ -> ^\w+ to allow special characters in
the middle of the name


Cheers,

Raphaël Pinson
--- chdist.pl.orig	2008-01-02 15:41:51.000000000 +0100
+++ chdist.pl	2008-01-02 15:58:13.000000000 +0100
@@ -73,6 +73,10 @@
 
 =item compare-bin-versions DIST1 DIST2
 
+=item compare-src-bin-packages DIST : compare sources and binaries for DIST
+
+=item compare-src-bin-versions DIST : same as compare-src-bin-versions, but also run dpkg --compare-versions and display where the package is newer
+
 =item grep-dctrl-packages DIST [...] : run grep-dctrl on *_Packages inside DIST
 
 =item grep-dctrl-sources DIST [...] : run grep-dctrl on *_Sources inside DIST
@@ -91,7 +95,7 @@
 
 =cut
 
-use Getopt::Long;
+use Getopt::Long qw(:config require_order);
 
 my $datadir = $ENV{'HOME'} . '/.chdist';
 
@@ -118,6 +122,9 @@
   compare-versions DIST1 DIST2 : same as compare-packages, but also run
       dpkg --compare-versions and display where the package is newer
   compare-bin-versions DIST1 DIST2
+  compare-src-bin-packages DIST : compare sources and binaries for DIST
+  compare-src-bin-versions DIST : same as compare-src-bin-versions, but also
+      run dpkg --compare-versions and display where the package is newer
   grep-dctrl-packages DIST [...] : run grep-dctrl on *_Packages inside DIST
   grep-dctrl-sources DIST [...] : run grep-dctrl on *_Sources inside DIST
   list : list available DISTs
@@ -186,7 +193,7 @@
 sub aptopts {
   # Build apt options
   my ($dist) = @_;
-  my $opts = "-o Dir=$datadir/$dist -o Dir::State::status=$datadir/$dist/var/lib/dpkg/status";
+  my $opts = "";
   if ($arch) {
      print "W: Forcing arch $arch for this command only.\n";
      $opts .= " -o Apt::Architecture=$arch";
@@ -270,6 +277,18 @@
 }
 
 
+sub recurs_mkdir {
+  my ($dir) = @_;
+  my @temp = split /\//, $dir;
+  my $createdir = "";
+  foreach $piece (@temp) {
+     $createdir .= "/$piece";
+     if (! -d $createdir) {
+        mkdir($createdir);
+     }
+  }
+}
+
 sub dist_create {
   my ($dist, $method, $version, @sections) = @_;
   my $dir  = $datadir . '/' . $dist;
@@ -284,12 +303,7 @@
   }
   mkdir($dir);
   foreach $d (('/etc/apt', '/var/lib/apt/lists/partial', '/var/lib/dpkg', '/var/cache/apt/archives/partial')) {
-    my @temp = split /\//, $d;
-    my $tres = $dir;
-    foreach my $piece (@temp) {
-      $tres .= "/$piece";
-      mkdir($tres);
-    }
+     recurs_mkdir("$dir/$d");
   }
 
   # Create sources.list
@@ -320,16 +334,19 @@
   # Create dpkg status
   open(FH, ">$dir/var/lib/dpkg/status");
   close FH; #empty file
-  if ($arch) {
-     # Create apt.conf if arch option given
-     open(FH, ">$dir/etc/apt/apt.conf");
-     print FH <<EOF;
+  # Create apt.conf
+  $arch ||= `dpkg --print-architecture`;
+  chomp $arch;
+  open(FH, ">$dir/etc/apt/apt.conf");
+  print FH <<EOF;
 Apt {
    Architecture "$arch";
 }
+
+Dir "$dir";
+Dir::State::status "$dir/var/lib/dpkg/status";
 EOF
   close FH;
-  }
   print "Now edit $dir/etc/apt/sources.list\n";
   print "Then run chdist apt-get $dist update\n";
   print "And enjoy.\n";
@@ -380,7 +397,7 @@
         my $parsed_file = parseFile($file);
         foreach my $package ( keys(%{$parsed_file}) ) {
            if ( $packages{$dist}{$package} ) {
-              warn "Package $package is alread listed for $dist. Not overriding.\n";
+              warn "W: Package $package is already listed for $dist. Not overriding.\n";
            } else {
               $packages{$dist}{$package} = $parsed_file->{$package};
            }
@@ -443,6 +460,107 @@
 }
 
 
+sub compare_src_bin {
+   my ($dist, $do_compare) = @_;
+
+   $do_compare = 0 if $do_compare eq 'false';
+
+   dist_check($dist);
+
+
+   # Get all packages
+   my %packages;
+   my @parse_types = ('Sources', 'Packages');
+   my @comp_types  = ('Sources_Bin', 'Packages');
+
+   foreach my $type (@parse_types) {
+      my $files = get_distfiles($dist, $type);
+      my @files = @$files;
+      foreach my $file ( @files ) {
+         my $parsed_file = parseFile($file);
+         foreach my $package ( keys(%{$parsed_file}) ) {
+            if ( $packages{$dist}{$package} ) {
+               warn "W: Package $package is already listed for $dist. Not overriding.\n";
+            } else {
+               $packages{$type}{$package} = $parsed_file->{$package};
+            }
+         }
+      }
+   }
+
+   # Build 'Sources_Bin' hash
+   foreach my $package ( keys( %{$packages{Sources}} ) ) {
+      my $package_h = \%{$packages{Sources}{$package}};
+      if ( $package_h->{'Binary'} ) {
+         my @binaries = split(", ", $package_h->{'Binary'});
+         my $version  = $package_h->{'Version'};
+         foreach my $binary (@binaries) {
+            if ( $packages{Sources_Bin}{$binary} ) {
+               # TODO: replace if new version is newer (use dpkg --compare-version?)
+               warn "There is already a version for binary $binary. Not replacing.\n";
+            } else {
+               $packages{Sources_Bin}{$binary}{Version} = $version;
+            }
+         }
+      } else {
+         warn "Source $package has no binaries!\n";
+      }
+   }
+
+   # Get entire list of packages
+   my @all_packages = uniq sort ( map { keys(%{$packages{$_}}) } @comp_types );
+
+  foreach my $package (@all_packages) {
+     my $line = "$package ";
+     my $status = "";
+     my $details;
+
+     foreach my $type (@comp_types) {
+        if ( $packages{$type}{$package} ) {
+           $line .= "$packages{$type}{$package}{'Version'} ";
+        } else {
+           $line .= "UNAVAIL ";
+           $status = "not_in_$type";
+        }
+     }
+
+     my @versions = map { $packages{$_}{$package}{'Version'} } @comp_types;
+     # Escaped versions
+     my @esc_vers = @versions;
+     foreach my $vers (@esc_vers) {
+        $vers =~ s|\+|\\\+|;
+     }
+
+     # Do compare
+     if ($do_compare) {
+        if ($#comp_types != 1) {
+           die "E: Can only compare versions if there are two types.\n";
+        }
+        if (!$status) {
+          if ($versions[0] eq $versions[1]) {
+            $status = "same_version";
+          } else {
+            $test = compare_versions($versions[0], $versions[1]);
+            if ($test eq 'true') {
+               $status = "newer_in_$comp_types[1]";
+               if ( $versions[1] =~ m|^$esc_vers[0]| ) {
+                  $details = " local_changes_in_$comp_types[1]";
+               }
+            } else {
+               $status = "newer_in_$comp_types[0]";
+               if ( $versions[0] =~ m|^$esc_vers[1]| ) {
+                  $details = " local_changes_in_$comp_types[0]";
+               }
+            }
+          }
+        }
+        $line .= " $status $details";
+     }
+
+     print "$line\n";
+  }
+}
+
 sub grep_file {
   my (@argv, $file) = @_;
   $dist = shift @argv;
@@ -455,7 +573,7 @@
 sub list {
   opendir(DIR, $datadir) or die "can't open dir $datadir: $!";
   while (defined($file = readdir(DIR))) {
-     if ( (-d "$datadir/$file") && ($file =~ m|^\w+$|) ) {
+     if ( (-d "$datadir/$file") && ($file =~ m|^\w+|) ) {
         print "$file\n";
      }
   }
@@ -488,7 +606,7 @@
 	    # Reset %tmp
 	    %tmp = ();
 	 } else {
-            warn "No Package field found. Not committing data.\n";
+            warn "W: No Package field found. Not committing data.\n";
 	 }
       } elsif ( $line =~ m|^[a-zA-Z]| ) {
          # Gather data
@@ -547,6 +665,12 @@
 elsif ($command eq 'grep-dctrl-sources') {
   grep_file(@ARGV, 'Sources');
 }
+elsif ($command eq 'compare-src-bin-packages') {
+  compare_src_bin(@ARGV, 0);
+}
+elsif ($command eq 'compare-src-bin-versions') {
+  compare_src_bin(@ARGV, 1);
+}
 elsif ($command eq 'list') {
   list;
 }

Reply via email to