ARB-SVN-Repository: svn_relocate_2_waltz.pl

#!/usr/bin/perl

use strict;
use warnings;

my $make_patch_cmd = 'svn diff > b4_svn_relocate_2_waltz.patch';
{
  my $psp = $ENV{HOME}.'/bin/patch_store.pl';
  if (-x $psp) { $make_patch_cmd = 'patch_store.pl --keep AUTO'; }
}


sub get_svn_url_rev() {
  my $cmd = 'svn info';
  my ($url,$rev) = (undef,undef);

  open(INFO,$cmd.'|') || die "can't exec '$cmd' (Reason: $?)";
  foreach (<INFO>) {
    chomp;
    if (/^URL:\s/) { $url = $'; }
    if (/^Revision:\s/) { $rev = $'; }
  }
  close(INFO);

  if (not defined $url) { die "could not parse 'URL' from '$cmd'"; }
  if (not defined $rev) { die "could not parse 'Revision' from '$cmd'"; }

  return ($url,$rev);
}

sub convert_URL($) {
  my ($old) = @_;
  if (not $old =~ /\@menuett\.mikro\.biologie\.tu-muenchen\.de\/menuett1\/repository\/ARB\//) {
    die "expected URL '$old'\nto contain 'menuett.mikro.biologie.tu-muenchen.de/menuett1/repository/ARB'";
  }

  my ($prefix,$suffix) = ($`,$');
  my $accept_suffix = 0;
  if ($suffix eq 'trunk') { $accept_suffix = 1; }
  elsif ($suffix =~ /^(branches|tags)\/[^\/]+$/) { $accept_suffix = 1; }

  if ($accept_suffix==0) { die "wont accept url '$old'\ndid you call from root of checkout?"; }

  my $new_part = '@svn.arb-home.de/svn/ARB/';
  return $prefix.$new_part.$suffix;
}

sub main() {
  my ($oldurl,$rev) = get_svn_url_rev();

  # print "rev='$rev'\n";

  if (not $rev =~ /^[0-9]+$/) { die "invalid revision '$rev'"; }

  my $newurl = convert_URL($oldurl);
  print "oldurl='$oldurl'\n";
  print "newurl='$newurl'\n";

  print "creating safety-patch using\n$make_patch_cmd\n";
  system($make_patch_cmd)==0 || die "failed to exec '$make_patch_cmd' (Reason: $?)";

  my $switch_command = "svn switch --relocate -r $rev '$oldurl' '$newurl'";
  print "Running\n$switch_command\n";

  system($switch_command)==0 || die "failed to exec '$switch_command' (Reason: $?)";
}
main();