bin/fix-sections
branchdist
changeset 0 98411ab74262
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/fix-sections	Fri Jul 03 15:23:10 2009 +0200
@@ -0,0 +1,97 @@
+#!/usr/bin/perl
+
+use strict;
+
+use IO::File;
+use File::Find;
+use File::Basename;
+
+my $build_dir = "/home/apt/build";
+my $invalid_sections = "unknown";
+my $default_section = "misc";
+my $sign_with = 'me@debrep.vbox.hurz.is.schlittermann.de';
+my $sections = {
+  '^nagios' => 'net',
+  '^exi(acl|grey)$' => 'mail',
+  '^ha-sync$' => 'admin',
+  '^ca-certificates' => 'misc',
+  '^firestart$' => 'admin',
+  '^logbuch$' => 'admin',
+  '^sitecp$' => 'web',
+  '^texmf' => 'tex',
+  '^schlittermann-apt-keys$' => 'net',
+  '^update-serial$' => 'net'
+};
+
+my @tofix;
+-d $build_dir or mkdir $build_dir or die "Can't mkdir [$build_dir]: $!";
+chdir $build_dir or die "Can't chdir [$build_dir]: $!";
+
+#find(\&f, qw(/home/apt/incoming/));
+
+for my $cf (@tofix) {
+  print "Attempting to fix Sections for [$cf] .. ";
+  $cf =~ /^(.+\/)?(.+)_([^-]+)(-(.+))?_(.+).changes$/;
+  my ($p, $v, $r, $a) = ($2, $3, $5, $6);
+
+  my $ra = qx/dpkg --print-architecture/;
+  chomp $ra;
+  unless ($a eq $ra) {
+    warn "skipping foreign arch [$a]\n";
+    next;
+  }
+
+  (my $sf = $cf) =~ s/_[0-9a-z]+\.changes$/.dsc/;
+  system("dpkg-source -x $sf") == 0 or warn "[dpkg-source -x $sf] failed: $?\n";
+  chdir "$p-$v" or warn "Can't chdir [$p-$v]: $!\n";
+  if ("$p-$v" =~ /nagios-plugin-ntp-1.0$/) {
+    chmod 0755, "configure" or warn "Can't chmod 0755, [$p-$v/configure]: $!\n";
+  }
+  {
+    local $/;
+    my $fh = new IO::File "< debian/control" or warn "Can't open [< debian/control]: $!\n";
+    my $c = <$fh>;
+    close $fh or warn "Can't close [$fh]: $!\n";
+    my $s;
+    for (keys %{$sections}) {
+      if ($p =~ /$_/) {
+        $s = $sections->{$_};
+        last;
+      }
+    }
+    $s ||= $default_section;
+    $c =~ s/(\n)?section:\s+$invalid_sections\n/${1}Section: $s\n/i;
+    $fh = new IO::File "> debian/control" or warn "Can't open [> debian/control]: $!\n";
+    print $fh $c;
+    close $fh or warn "Can't close [$fh]: $!\n";
+  }
+    
+  system("dpkg-buildpackage -k$sign_with -rfakeroot") == 0 or warn "[dpkg-buildpackage -k$sign_with -rfakeroot] failed: $?\n";
+  chdir ".." or warn "Can't chdir [..]: $!\n";
+  (my $uf = basename($cf)) =~ s/.changes$/.upload/;
+  -e $uf and { unlink $uf or warn "Can't unlink [$uf]: $!\n" };
+  system("dupload " . basename($cf)) == 0 or warn "[dupload $cf] failed: $?\n";
+
+  print "finished\n";
+}
+
+=pod
+sub f {
+
+  /\.changes$/ or return;
+
+  my $f = $_;
+  my $fh = new IO::File "< $f";
+  warn "Can't open [< $f]: $!\n" unless defined $fh;
+  while (<$fh>) {
+    chomp;
+    my $s;
+    if (/([0-9a-fA-F]{32}) ([0-9]+) ([a-z]+) ([a-z]+) (.+)$/ && ($s = $3) =~ /$invalid_sections/) {
+      push @tofix, $File::Find::name;
+      close $fh or warn "Can't close [$fh]: $!\n";
+      return;
+    }
+  }
+  close $fh or warn "Can't close [$fh]: $!\n"; 
+} 
+=cut