bin/fix-sections
branchrsync
changeset 29 677e250ac544
parent 28 8efaf6179ee8
child 30 0cf878dc81be
--- a/bin/fix-sections	Mon Sep 19 16:13:57 2011 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,97 +0,0 @@
-#!/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