~fta/drobotik/drobotik.head

#!/usr/bin/perl -w

# Sync PPA branches from the development branches
# (c) 2008-2009, Fabien Tassin <fta@sofaraway.org>

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use Getopt::Std;
use Data::Dumper;

# Defaults
my $conf = {
  'dist'          => `lsb_release -c -s`,
  'alt_dists'     => [ 'intrepid', 'hardy' ], # other than $dist, will be taggued as ~dist
  'who'           => `bzr whoami`,
  'dput_target'   => "ppa", # from ~/.dput.cf
  'iteration_tag' => "ppa", # "xxx" => -0ubuntu1~xxx1
  'ppa_branchtag' => "ppa", # "xxx" => package.head.xxx
  'gpg_key'       => undef,
  'test_suffix'   => "test",
  'build_dir'     => "$ENV{'HOME'}/ppa",
};

# List of conf files to consider, the 1st found wins
my $ppa_confs = [ "$ENV{'HOME'}/.ppabot.conf", "/etc/ppabot.conf" ];
my $ppa_pkgs  = [ "$ENV{'HOME'}/.ppabot-pkgs.conf", "/etc/ppabot-pkgs.conf" ];

my $opt = {};
getopts('d:htrAc:p:', $opt) || &Usage();
&Usage() if $$opt{'h'};

unshift @$ppa_confs, $$opt{'c'} if defined $$opt{'c'};
unshift @$ppa_pkgs,  $$opt{'p'} if defined $$opt{'p'};

for my $ppa_conf (@$ppa_confs) {
  read_conf(\$conf, $ppa_conf, 1), last if -e $ppa_conf;
}

my $key = defined $conf->{'gpg_key'} ? "-k$conf->{'gpg_key'}" : "";
my $bzr_cmds = {
  "ppa"  => [ "bd", "--merge",   "--build-dir=$conf->{'build_dir'}", "--builder=dpkg-buildpackage -rfakeroot -S -sa $key" ],
  "ppa2" => [ "bd", "--merge",   "--build-dir=$conf->{'build_dir'}", "--builder=dpkg-buildpackage -rfakeroot -S -sd $key" ],
  "ppan" => [ "bd", "--native",  "--build-dir=$conf->{'build_dir'}", "--builder=dpkg-buildpackage -rfakeroot -S -sa $key" ],
};

my $pkgs;
for my $ppa_pkg (@$ppa_pkgs) {
  read_conf(\$pkgs, $ppa_pkg, 0), last if -e $ppa_pkg;
}
# Initialize the 'ppa' branch names, if missing
for my $pkg (keys %{$pkgs->{'pkgs'}}) {
  $pkgs->{'pkgs'}{$pkg}{'ppa'} = $pkgs->{'pkgs'}{$pkg}{'branch'} . "." . $conf->{'ppa_branchtag'}
    unless defined $pkgs->{'pkgs'}{$pkg}{'ppa'};
}

die "You must create a ppabot-pkgs.conf file. Abort.\n" unless defined $pkgs;

############################################################################

sub Usage {
  die "Usage: $0 [-d archive] [-c conf] [-p pkgconf] [-t] [-h] [-A] [branch1] [...]\n" .
    "  -h           this help screen\n" .
    "  -c conf      use 'conf' as alternative conf file\n" .
    "  -p pkgconf   use 'pkgconf' as alternative package conf file\n" .
    "  -d archive   push to an alternative archive (default: $conf->{'dput_target'})\n" .
    "  -t           use test branches, if necessary branched off the configured ones\n" .
    "  -A           don't do alternative dists\n" .
    "  -r           revert the last sync\n";
}

chomp($conf->{'who'});
chomp($conf->{'dist'});
my $force_test = 0;
my $revert = 0;
undef $conf->{'alt_dists'} if $$opt{'A'};
$force_test = 1 if $$opt{'t'};
$revert = 1 if $$opt{'r'};
my $dput_dist = defined $$opt{'d'} ? $$opt{'d'} : $conf->{'dput_target'};

splice @{$pkgs->{'order'}}, 0, $#{$pkgs->{'order'}} + 1, @ARGV if $#ARGV >= 0;

my $rpkgs = {};
map { $$rpkgs{$_} = 1 } @{$pkgs->{'order'}};

# Create PPA branches for the main distribution if they are missing
for my $pkg (@{$pkgs->{'order'}}) {
  die "No branch $pkgs->{'pkgs'}{$pkg}{'branch'} found in the current directory. " .
    "You may have to branch/clone it there. Stop.\n"
      unless -d "$pkgs->{'pkgs'}{$pkg}{'branch'}/.bzr";
  die "Project $pkg is not configured. stop.\n" unless defined $pkgs->{'pkgs'}{$pkg};
  my $ppa = $pkgs->{'pkgs'}{$pkg}{'ppa'};
  if (! -d $ppa) {
    print "*INFO* no $ppa branch found. Creating it..\n";
    `bzr branch $pkgs->{'pkgs'}{$pkg}{'branch'} $ppa`;
  }
}

# Create PPA branches for alternative distributions if they are missing
if ($#{$conf->{'alt_dists'}} >= 0) {
  for my $d (@{$conf->{'alt_dists'}}) {
    next if $d eq $conf->{'dist'};
    for my $pkg (@{$pkgs->{'order'}}) {
      die "Project $pkg is not configured. stop.\n" unless defined $pkgs->{'pkgs'}{$pkg};
      my $ppa = $pkgs->{'pkgs'}{$pkg}{'ppa'};
      if (! -d "$ppa.$d") {
        print "*INFO* no $ppa.$d branch found. Creating it..\n";
        `bzr branch $ppa "$ppa.$d"`;
      }
    }
  }
}

if ($force_test) {
  for my $pkg (@{$pkgs->{'order'}}) {
    die "Project $pkg is not configured. stop.\n" unless defined $pkgs->{'pkgs'}{$pkg};
    my $branch = $pkgs->{'pkgs'}{$pkg}{'branch'};
    my $ppa = $pkgs->{'pkgs'}{$pkg}{'ppa'};
    if (! -d "$branch.$conf->{'test_suffix'}") {
      print "*INFO* no $branch.$conf->{'test_suffix'} branch found. Creating it..\n";
      `bzr branch $branch "$branch.$conf->{'test_suffix'}"`;
      $pkgs->{'pkgs'}{$pkg}{'branch'} = "$branch.$conf->{'test_suffix'}";
    }
    if (! -d "$ppa.$conf->{'test_suffix'}") {
      print "*INFO* no $ppa.$conf->{'test_suffix'} branch found. Creating it..\n";
      `bzr branch $ppa "$ppa.$conf->{'test_suffix'}"`;
      $pkgs->{'pkgs'}{$pkg}{'ppa'} = "$ppa.$conf->{'test_suffix'}";
    }
  }
}

my $versions = {};
my $cids = {};
my $date = `date -R`;
chomp($date);
my $dput = [];

for my $pkg (keys %{$pkgs->{'pkgs'}}) {
  next unless defined $pkgs->{'pkgs'}{$pkg};
  if (defined $$rpkgs{$pkg} && !$revert) {
    check_committed($pkgs->{'pkgs'}{$pkg}{'branch'});
    check_committed($pkgs->{'pkgs'}{$pkg}{'ppa'});
  }
  $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} = get_pkg_version($pkgs->{'pkgs'}{$pkg}{'branch'});
  $$versions{$pkgs->{'pkgs'}{$pkg}{'ppa'}}    = get_pkg_version($pkgs->{'pkgs'}{$pkg}{'ppa'});
  do_revert($pkgs->{'pkgs'}{$pkg}{'ppa'}, $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}}, undef) if $revert && defined $$rpkgs{$pkg};
  # check the alternative branches too
  if ($#{$conf->{'alt_dists'}} >= 0) {
    for my $d (@{$conf->{'alt_dists'}}) {
      next if $d eq $conf->{'dist'};
      $pkgs->{'pkgs'}{$pkg}{"ppa.$d"} = $pkgs->{'pkgs'}{$pkg}{"ppa"} . ".$d";
      next unless -d $pkgs->{'pkgs'}{$pkg}{"ppa.$d"};
      check_committed($pkgs->{'pkgs'}{$pkg}{"ppa.$d"}) if defined $$rpkgs{$pkg} && !$revert;
      $$versions{$pkgs->{'pkgs'}{$pkg}{"ppa.$d"}} = get_pkg_version($pkgs->{'pkgs'}{$pkg}{"ppa.$d"});
      do_revert($pkgs->{'pkgs'}{$pkg}{"ppa.$d"}, $$versions{$pkgs->{'pkgs'}{$pkg}{'ppa'}}, $$versions{$pkgs->{'pkgs'}{$pkg}{"ppa.$d"}}) if $revert && defined $$rpkgs{$pkg};
    }
  }
}

exit 0 if $revert;

for my $pkg (@{$pkgs->{'order'}}) {
  next unless defined $pkgs->{'pkgs'}{$pkg};
  do_pkg($pkg);
}

print "\n\n# Please double check the results then issue:\ncd $conf->{'build_dir'}; " .
  "dput $dput_dist \\\n	" . (join " \\\n	", @$dput) . "\n" if $#$dput >= 0;

# End

sub check_committed {
  my $branch = shift;

  print "* check_committed($branch)\n";
  chdir($branch) || die "Can't chdir to $branch: $!\n";
  system("bzr", "diff") == 0 || die "Branch $branch must be committed before we can continue. Stop";
  system("bzr", "pull") unless $branch =~ m/ppa($|\.\S+$)/;
  my $id = `bzr revno`;
  chomp($id);
  $$cids{$branch} = $id;
  chdir("..");
}

sub get_pkg_version {
  my $pkg = shift;

  open(FILE, "$pkg/debian/changelog") || do {
    warn "Can't open $pkg/debian/changelog: $!\n";
    return "~";
  };
  my $line = <FILE>;
  $line =~ m,^\S+ \((\S+)\) \S+; urgency=\S+,;
  close FILE;
  return $1;
}

sub do_revert {
  my $branch  = shift;
  my $vbranch = shift;
  my $vppa    = shift;

  print "do_revert($branch)\n";
  $vbranch =~ s,([\~\+]),\\$1,g;
  if (!defined $vppa || $vppa =~ m/^$vbranch\~/) {
    chdir($branch) || die "Can't chdir to $branch: $!\n";
    print "*INFO* do revert $branch\n";
    system("bzr", "uncommit", "--force") == 0 || die "Branch $branch cannot be uncommitted. Stop";
    system("bzr", "revert") == 0 || die "Branch $branch cannot be reverted. Stop";
    chdir("..");
  }
  else {
    print "*INFO* not reverting $branch: $vppa !~ m/^$vbranch\~/\n";
  }
}

sub do_merges {
  my $pkg      = shift;
  my $target   = shift;
  my $new_orig = shift;
  my $native   = shift;

  do_merge($pkg, $target, $new_orig, $native, $conf->{'dist'});
  if ($#$conf->{'alt_dists'} >= 0) {
    for my $d (@$conf->{'alt_dists'}) {
      next if $d eq $conf->{'dist'};
      do_merge($pkg, $target, 0, $native, $d);
    }
  }
}

sub do_merge {
  my $pkg      = shift;
  my $target   = shift;
  my $new_orig = shift;
  my $native   = shift;
  my $ldist    = shift;

  my $ppa = $pkgs->{'pkgs'}{$pkg}{'ppa'};
  my $ppaname = 'ppa';
  if ($ldist ne $conf->{'dist'}) {
    $ppa .= ".$ldist";
    $ppaname .= ".$ldist";
    $target .= "~$ldist";
  }
  print "\$ cd $ppa\n";
  chdir($ppa) || die "Can't chdir to $ppa: $!\n";
  print "\$ bzr merge ../$pkgs->{'pkgs'}{$pkg}{'branch'}\n";
  system("bzr", "merge", "../$pkgs->{'pkgs'}{$pkg}{'branch'}");
  my $lines = `bzr st`;
  print "\$ bzr st\n$lines";
  if ($lines eq '') {
    print "    => nothing to do\n";
    print "    => ppa = $$versions{$ppa}\n";
    if ($$versions{$ppa} =~ m/\~$conf->{'iteration_tag'}\d+(|\~$ldist)$/) {
      chdir("..");
      return;
    }
    $new_orig = 1 if $ldist eq $conf->{'dist'};
  }
  my $conflicts = {};
  my @ls = split /\n/, $lines;
  for my $line (@ls) {
    $$conflicts{$1} = 1 if $line =~ m/Text conflict in (\S+)/;
  }
  $$versions{$ppa} = $target;

  # Update debian/changelog
  print "\$ bzr revert debian/changelog\n";
  system("bzr", "revert", "debian/changelog");
  print "\$ cp ../$pkgs->{'pkgs'}{$pkg}{'branch'}/debian/changelog debian/changelog\n";
  `cp ../$pkgs->{'pkgs'}{$pkg}{'branch'}/debian/changelog debian/changelog`;
  print "\$ sed -i -e '1s/(.*) [^;]*/($target) $ldist/' debian/changelog\n";
  `sed -i -e '1s/(.*) [^;]*/($target) $ldist/' debian/changelog`;
  print "\$ sed -i -e '1,/^ -- /s/^ -- .*/ -- $conf->{'who'}  $date/' debian/changelog\n";
  `sed -i -e '1,/^ -- /s/^ -- .*/ -- $conf->{'who'}  $date/' debian/changelog`;
  if (defined $$conflicts{'debian/changelog'}) {
    print "\$ bzr resolve debian/changelog\n";
    system("bzr", "resolve", "debian/changelog");
  }

  # Update debian/control
  print "\$ bzr revert debian/control\n";
  system("bzr", "revert", "debian/control");
  print "\$ cp ../$pkgs->{'pkgs'}{$pkg}{'branch'}/debian/control debian/control\n";
  `cp ../$pkgs->{'pkgs'}{$pkg}{'branch'}/debian/control debian/control`;
  my $dodeps = 1;
  for my $p (@$pkgs->{'nodeps'}) {
    $dodeps = 0, last if $p eq $pkg;
  }
  if ($dodeps) {
    for my $dep (keys %{$pkgs->{'deps'}}) {
      next unless defined $pkgs->{'deps'}{$dep} && defined $pkgs->{'pkgs'}{$pkgs->{'deps'}{$dep}};
      my $vers = $$versions{$pkgs->{'pkgs'}{$pkgs->{'deps'}{$dep}}{$ppaname}};
      if (defined $vers) {
        print "\$ sed -i -e '1,/^Package: /s/\\(${dep}\\)[^,]*/\\1 (>= $vers)/' debian/control\n";
        `sed -i -e '1,/^Package: /s/\\($dep\\)[^,]*/\\1 (>= $vers)/' debian/control`;
      }
      else {
        print "# not updating dep for $dep, version is missing\n";
      } 
    }
  }
  if (defined $$conflicts{'debian/control'}) {
    print "\$ bzr resolve debian/control\n";
    system("bzr", "resolve", "debian/control");
  }
  # `ls -l debian/control.~*~ debian/changelog.~*~`;
  print "\$ bzr diff\n";
  system("bzr", "diff");
  print "\$ bzr commit -m \"* RELEASE $target to $ldist/ppa\\n  - merge with $pkgs->{'pkgs'}{$pkg}{'branch'} #" . $$cids{$pkgs->{'pkgs'}{$pkg}{'branch'}} . "\"\n";
  system("bzr", "commit", "-m", "* RELEASE $target to $ldist/ppa\n  - merge with $pkgs->{'pkgs'}{$pkg}{'branch'} \#" . $$cids{$pkgs->{'pkgs'}{$pkg}{'branch'}});
  if ($native) {
    my $cmd = [ "bzr", @{$$bzr_cmds{'ppan'}} ];
    print "\$ " . (join ' ', @$cmd) . " (ppan)\n";
    system(@$cmd);
  }
  else {
    my $cmd = [ "bzr", @{$$bzr_cmds{$new_orig ? "ppa" : "ppa2"}} ];
    print "\$ " . (join ' ', @$cmd) . " (" . ($new_orig ? "ppa" : "ppa2") . ")\n";
    system(@$cmd);
  }
  chdir("..");
  print "    => committed $target in $pkgs->{'pkgs'}{$pkg}{$ppaname}\n";
  push @$dput, "${pkg}_${target}_source.changes";
}

sub do_pkg {
  my $pkg = shift;

  my $target;
  print "* Doing $pkg from $pkgs->{'pkgs'}{$pkg}{'branch'} to $pkgs->{'pkgs'}{$pkg}{'ppa'}\n";
  print "  - compare $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} and $$versions{$pkgs->{'pkgs'}{$pkg}{'ppa'}}\n";
  my $isnative = $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} =~ m/-/ ? 0 : 1;
  my ($base_branch, $iter_branch, $base_ppa, $iter_ppa);
  if ($isnative) {
    ($base_branch, $iter_branch) = $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} =~ m/^(\S+)(~.*|$)/;
    ($base_ppa, $iter_ppa) = $$versions{$pkgs->{'pkgs'}{$pkg}{'ppa'}} =~ m/^(\S+?)(~.*|$)/;
  }
  else {
    ($base_branch, $iter_branch) = $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} =~ m/^(\S+)-(\S+)/;
    ($base_ppa, $iter_ppa) = $$versions{$pkgs->{'pkgs'}{$pkg}{'ppa'}} =~ m/^(\S+)-(\S+)/;
  }
  if ($isnative) {
    $iter_ppa =~ s/\~$conf->{'iteration_tag'}(\d+)/$1/;
    my $id = $1;
    print "    => need to check the branches :P\n";
    $id = 0 if $base_branch ne $base_ppa;
    $target =  $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} . "~$conf->{'iteration_tag'}" . ($id + 1);
    do_merges($pkg, $target, 0, 1);
  }
  elsif ($base_branch ne $base_ppa) {
    print "    => upstream version differs ($base_branch vs $base_ppa): continue\n";
    $target =  $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} . "~$conf->{'iteration_tag'}" . 1;
    do_merges($pkg, $target, 1, 0);
  }
  else {
    $iter_ppa =~ s/(\S+)\~$conf->{'iteration_tag'}(\d+)/$1/;
    my ($iter_ppa2, $id) = ($1, $2);
    if (defined $iter_ppa2 && $iter_branch ne $iter_ppa2) {
      print "    => same upstream version but ubuntu version differs " . 
            "($iter_branch vs $iter_ppa2): continue\n";
      $target =  $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} . "~$conf->{'iteration_tag'}" . 1;
      do_merges($pkg, $target, 0, 0);
    }
    else {
      $id = 0 unless defined $id;
      print "    => need to check the branches :P\n";
      $target =  $$versions{$pkgs->{'pkgs'}{$pkg}{'branch'}} . "~$conf->{'iteration_tag'}" . ($id + 1);
      do_merges($pkg, $target, 0, 0);
    }
  }
}

sub read_conf {
  my $conf   = shift;
  my $file   = shift;
  my $strict = shift;

  local $/ = undef;
  open(CONF, "$file") || die "Can't open $file: $!\n";
  my $data = <CONF>;
  close CONF;
  my $newconf = eval $data;
  die "Syntax error in $file? You can check your syntax with 'perl -c $file'\n" unless defined $newconf;

  for my $key (keys %$newconf) {
    if ($strict && !defined $$$conf{$key}) {
      warn "Unrecognized conf '$key' found in $file: ignored\n";
      next; 
    }
    $$$conf{$key} = $$newconf{$key};
  }
}