svn-buildpackage 0.8.6 / usr / bin / svn-upgrade

#!/usr/bin/perl

#  Copyright 2003-2006 Eduard Bloch <blade@debian.org>
#  Copyright 2009-2010 Neil Williams <codehelp@debian.org>
#  Copyright 2009 Ryan Niebur <ryanryan52@gmail.com>,
#  Copyright 2008-2009 Jan Hauke Rahm <info@jhr-online.de>
#
#  This package 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.

use Capture::Tiny qw/tee_merged/;
use Getopt::Long qw(:config no_ignore_case bundling);
use File::Basename;
use File::Spec::Functions qw/catfile/;
use Cwd qw/realpath getcwd/;
use File::LibMagic;
use lib (split(/:/, $ENV{SVNBPPERLLIB} || "/usr/share/svn-buildpackage"));
use SDCommon;
use POSIX qw(locale_h);
use Locale::gettext;
#use diagnostics;
use strict;
use warnings;

setlocale(LC_MESSAGES, "");
textdomain("svn-buildpackage");

my $startdir=getcwd;
my $scriptname="[svn-upgrade]";

sub help {
print _g("
Usage: svn-upgrade newsource [ OPTIONS... ]
Upgrade a source code package from an upstream revision. The source code
repository must be in the format created by svn-inject.

  -V, --upstreamversion  STRING    Forces a different upstream version string
  -c, --clean                      generic cleanup of upstream source - remove
                                   debian directory and object files
  --debclean                       run debclean before merging the new upstream source
  -f, --force                      Force execution of certain operations
  -v, --verbose                    More verbose program output
  -r, --replay-conflicting         Special cleanup action: replaces all
                                   conflicting files with upstream versions
  -u, --uscan                      Use uscan to download the new version
  --ignored-files-action STRING    Make files that are ignored due to subversion
                                   ignore patterns to be either 'import'ed or 'skip'ed
  -e, --auto-epoch                 Increase epoch of package version if the new
                                   upstream version is lower than the current

The new source may be a tarball compressed with gzip, bzip2 or xz a
directory with extraced source.
"); exit 1;
}

our $retval = 0;

sub error {
    my $error = shift;
    $retval = 1;
    die $error;
}

my $package;
my $upVersion;
my $origdir;
my $tmpdir;
my $remove = 0;

my $opt_help;
my $opt_replay;
my $opt_force;
my $opt_clean;
my $opt_uscan;
my $upsVersion;
my $epoch;
my $verbose;
my $keep_removed;
my $quiet="-q";
my $opt_noninteractive;
my $opt_ignoreerrors;
my $opt_ignored_files_action;
my $opt_autoepoch;
my $opt_debclean;

my %options = (
   "h|help"                => \$opt_help,
   "V|upstreamversion=s"   => \$upsVersion,
   "upstream-version=s"    => \$upsVersion,
   "c|clean"               => \$opt_clean,
   "f|force"               => \$opt_force,
   "v|verbose"             => \$verbose,
   "r|replay-conflicting"  => \$opt_replay,
   "u|uscan"               => \$opt_uscan,
   "noninteractive"        => \$opt_noninteractive,
   "debclean"              => \$opt_debclean,
   "ignoreerrors"          => \$opt_ignoreerrors,
   "ignored-files-action=s"=> \$opt_ignored_files_action,
   "e|auto-epoch"          => \$opt_autoepoch,
);

#shamelessly copied and slightly modified from svn-bp
my @CONFARGS;
for my $file ($ENV{"HOME"}."/.svn-buildpackage.conf") {

    if(open(RC, $file)) {
        SKIP: while(<RC>) {
            chomp;
            next SKIP if /^#/;
            # drop leading spaces
            s/^\s+//;
            if(/^svn-(uscan|noninteractive|ignoreerrors|verbose|force|clean|replay-conflicting|ignored-files-action|debclean)/) {
                # remove spaces between
                s/^(\S+)\s*=\s*/$1=/;
                #remove leading svn, since update does not have that
                s/^svn-//;
                # convert to options and push to args
                s/^/--/;
                $_=`echo -n $_` if(/[\$`~]/);
                push(@CONFARGS, $_);
            }
        }
        close(RC);
    }
}

if($#CONFARGS>=0) {
   @ARGV=(@CONFARGS, @ARGV);
   print _g("Imported config directives:")."\n\t".join("\n\t", @CONFARGS)."\n";
}


&help unless ( GetOptions(%options));
&help if ($opt_help);

my $mergemode = (`svn proplist debian` =~ /mergeWithUpstream/i);

goto SKIP_VERSION_SCAN if($opt_replay);

my $newsource;
if($#ARGV < 0 && $opt_uscan) {
    my $ret;
    my $uscan_out = tee_merged {
        my @uscan_command = qw/uscan --repack --rename/;
        if(defined($upsVersion)) {
            push @uscan_command, "--download-version";
            push @uscan_command, $upsVersion;
        }
        system(@uscan_command);
        $ret = $? >> 8;
    };
    if($ret == 0) {
        if(length($uscan_out) == 0) {
            my $report_output = tee_merged {
                my @uscan_command = qw/uscan --report/;
                if(defined($upsVersion)) {
                    push @uscan_command, "--download-version";
                    push @uscan_command, $upsVersion;
                }
                system(@uscan_command);
            };
            # can't just take the directory name from uscan, as it may be
            # a repacked .tar.bz or .zip, and uscan will tell us the
            # original name, not the repacked
            my @lines = split("\n", $report_output);
            shift @lines;
            my $second_line = shift @lines;
            $second_line =~ s/Newest version on remote site is ([^ ]+), .*/$1/;
            `head -n1 debian/changelog` =~ /^(\S+)\s*\(((\d+):)?(.+)\)/;
            my $try_this = catfile("..", $1 . "_" . $second_line . ".orig.tar.gz");
            if(-e $try_this) {
                $newsource = $try_this;
            } else {
                error(_g("new upstream version is already downloaded, and it isn't easily locatable"));
            }
        } else {
            my $lastline = pop @{[split("\n", $uscan_out)]};
            $lastline =~ s/.* ([^ ]*\.orig\.[^ ]*)(?: .*|$)/$1/;
            if (!($lastline =~ /\.orig\./)) {
                error(_g("uscan's output didn't give an obvious tarball name. the last line of it's output should include the name of the tarball, which should include .orig."));
            }
            $newsource = $lastline;
            if (! -f $newsource) {
                $newsource = catfile("..", $lastline);
                if (! -f $newsource) {
                    error(_g("couldn't find the downloaded file"));
                }
            }
            $remove = 1;
        }
    } elsif($ret == 1) {
        error(_g("no new upstream version"));
    } else {
        error(sprintf(_g("uscan returned this error code: %s"),$?));
    }
} else {
    &help if($#ARGV < 0);
    $newsource=$ARGV[0];
    &help if(!-r $newsource);
    shift(@ARGV);
}

# don't use abs_path yet, it resolves the symlinks

#$newsource=$startdir."/".$newsource if(! $newsource=~/^\//);


if(-d $newsource) {
    basename($newsource) =~ /([^-]+)-v?(\d.*)/i;

    # provisoric package definition, to be overriden by the config module later
    $package = $1;
    $upsVersion = $2 if(!defined($upsVersion));
}
else {
    basename($newsource) =~/([^-]+)-v?(\d.*)\.(tar|tgz|tbz)/i;

    # provisoric package definition, to be overriden by the config module later
    $package = $1;
    $upsVersion = $2 if(!defined($upsVersion));

    # workaround for debianized tarballs
    if(!(defined($1) && defined($2))) {
        basename($newsource) =~/(.*)_(.*)\.orig.tar.gz/i;
        # provisoric package definition, to be overriden by the config module later
        $package = $1;
        $upsVersion = $2 if(!defined($upsVersion));
    }

}

# no resolve it, we don't need the user-specified filename any longer
$newsource = long_path($newsource);

error _g("Unrecognized upstream version, use -V\n") if(!length($upsVersion));

SKIP_VERSION_SCAN:

undef($quiet) if ($verbose);

$ENV{"SVN_BUILDPACKAGE"} = $SDCommon::version;

SDCommon::exwerror _g("Action for ignored files must be either 'import' or 'skip'!\nAborting!")
    if ($opt_ignored_files_action and !($opt_ignored_files_action eq "import" or $opt_ignored_files_action eq "skip"));
$SDCommon::opt_ignored_files_action = $opt_ignored_files_action;

start_ssh();
withecho("svn", "up");

$SDCommon::opt_verbose=$verbose;
SDCommon::configure;
#$tagVersion=$SDCommon::tagVersion;
$upVersion=$SDCommon::upVersion;
$package  =$SDCommon::package; # XXX Overwrite the $package value!
$epoch    =$SDCommon::epoch;
$SDCommon::opt_noninteractive = 1 if $opt_noninteractive;
$SDCommon::opt_noninteractive = 1 if exists($ENV{DEBIAN_FRONTEND}) && $ENV{DEBIAN_FRONTEND} =~ /^noninteractive$/;
$SDCommon::opt_ignoreerrors = 1 if ($opt_ignoreerrors && $SDCommon::opt_noninteractive);
needs_tagsUrl;
needs_upsTagUrl if !$mergemode;
needs_upsCurrentUrl if !$mergemode;
my $c=\%SDCommon::c;

if($opt_replay) {
   for(split(/\n/,`env LC_ALL=C svn status`)) {
      if(/^C\s+(.*)/) {
         withecho("svn cat ".$$c{"upsCurrentUrl"}."/$1 > $1 && svn resolved $1");
      }
   }
   SDCommon::sd_exit 0;
}

# my private copy of the setting
if($$c{"origDir"}){$origdir=$$c{"origDir"}}else{chomp($origdir=`mktemp -d`)};

withecho("mkdir", "-p", $origdir) if (!-d $origdir);

chomp($tmpdir=`mktemp -d`);
#print "D: ".$$c{"upsTagUrl"}.join(",", values(%c));
my $upsOldVersUrl=$$c{"upsTagUrl"}."/$upVersion";
#print $upsOldVersUrl ; exit 1;
mkdir $tmpdir;

my $cat;
my $justcopy;
my $ext='gz';
# See #560391 for why we can't use dpkg-source --print-format .
my $is30quilt = (-f "debian/source/format") ? `grep \"3.0\" debian/source/format` : undef;

my $filestr = File::LibMagic::MagicFile($newsource);
if ($filestr =~ /gzip/){
   $cat = "zcat \"$newsource\"";
   $justcopy=1;# Always copy. Maintainer should recompress manually, if needed. if ($filestr =~ /max compression/);
}
elsif ($filestr =~ /bzip/){
   $cat = "bzcat \"$newsource\"";
   if (defined $is30quilt)
   {
     $justcopy=1;# Always copy. Maintainer should recompress manually, if needed. if ($filestr =~ /max compression/);
     $ext = 'bz2';
   }
}
elsif ($filestr =~ /xz/i){
   $cat = "xzcat \"$newsource\"";
   if (defined $is30quilt)
   {
     $justcopy=1;# Always copy. Maintainer should recompress manually, if needed. if ($filestr =~ /max compression/);
     $ext = 'xz';
   }
}
elsif ($filestr =~ /tar archive/){
   $cat = "cat $newsource";
}
elsif ($filestr =~ /directory/){
   $cat = " ( cd \"".dirname($newsource)."\" ; tar c \"".basename($newsource)."\" ) ";
}
else {
   error _g("Unknown compression method!\n");
}

my $neworig="$origdir/".$package."_".$upsVersion.".orig.tar.".$ext;

error sprintf(_g("%s exists, aborting...\n"), $neworig)
  if (-e $neworig && realpath($neworig) ne realpath($newsource) && !$opt_force);

# repack the new source file to tarballs/...orig.tar.gz
if(! -f $neworig) {
   # only if correct gzip format, not a directory, see above
   if($justcopy) {
      my $newsource_ = $newsource;
      $newsource_ = readlink($newsource_) if(readlink($newsource_));
      link($newsource_,$neworig) || withecho("cp",$newsource_,$neworig);
   }
   else {
      withecho("$cat | gzip -9 > \"$neworig\"");
   };
}

if($upsVersion eq $upVersion) {
    error _g("Trunk is already at this version.\n");
}

if(insvn($$c{"upsTagUrl"}."/$upsVersion")) {
    my $estring = _g("This version has already been tagged.\n");
    error $estring if(!$opt_force);

}

# FIXME: dircheck hier irgendwo rein
withecho("svn",$quiet,"add",$neworig) if(defined $SDCommon::c{"origUrl"});

if($mergemode) {
   print _g("I: Upstream source not maintained in the repository.\n");
   print _g("I: Assuming that it will be merged at build time.\n");
}
else
{
   if(! insvn($upsOldVersUrl)) {
         error sprintf(_g("
         Could not find the unmodified upstream version in
         %s!
         If you think that %s is the upstream source
         which %s is based on, run:

         svn copy %s %s

         Otherwise, please fix the headline of debian/changelog.\n"),
         $upsOldVersUrl,$$c{upsCurrentUrl}, $$c{trunkUrl}, $$c{upsCurrentUrl},
         $upsOldVersUrl);
   }
}

if($filestr =~ /directory/) {
   withecho("cp","-a", $newsource, "$tmpdir/");
}
elsif ($ext eq "bz2") {
   withecho("tar", "jxf", $neworig, "-C", "$tmpdir");
}
elsif ($ext eq "xz") {
   withecho("tar", "Jxf", $neworig, "-C", "$tmpdir");
}
else {
   withecho("tar", "zxf", $neworig, "-C", "$tmpdir");
}

my $srcdir="$package-$upsVersion";

# fix the FSCKING upstream source that comes without top subdirectory

chdir $tmpdir;
my @filesInside=(<*>);
if($#filesInside > 0) {
   mkdir $srcdir;
   withecho("mv",@filesInside, $srcdir);
}

# create the list of modified files if needed
my @difflist;
if($mergemode) {
   chdir $startdir;
   open(DL, "find -type f | grep -v \"\\.svn\" |") or
       error (sprintf(_g("Failed to exec find -type f | grep -v \"\\.svn\": %s"),$!));
   while(<DL>) {
      push(@difflist, $1) if(/^[^\/]+\/(.+)\n/);
   }
   close(DL);
}

chdir $tmpdir;
system "rm -f *." . $ext;

# if needed, remove uninteressting files from the upstream directory,
# or move the directory to some with the proper name
if(@difflist) {
   withecho "mv * $srcdir-tmp; mkdir $srcdir";
   withecho "cd $srcdir-tmp; tar c ".join(" ", @difflist)." 2>/dev/null | tar x -C ../$srcdir";
}
else {
   # work around identical dir names
   withecho "mv * $srcdir-tmp";
   withecho "mv $srcdir-tmp $srcdir";
}

if(-d "$tmpdir/$srcdir/debian" && !$opt_force) {
   print _g("
Warning: it is generally a bad idea to keep the debian directory in the
upstream source tarball unless you explicitly try to track an upstream source
including Debianisation. Consider using uclean to remove the junk there.
");
}

if($opt_clean) {
   my $dir=Cwd::getcwd;
   chdir "$tmpdir/$srcdir";
   system "make clean";
   system "rm -rf debian";
   chdir $dir;
}

# now we have the new upstream source we need in $tmpdir/$upsVersion
# allow the import to be skipped in mergeWithUpstream mode if the
# upsCurrentUrl is not known
if(defined($$c{"upsCurrentUrl"}) || !$mergemode) {
   # first look for conflicting .svn dirs
   oldSvnDirsCheck "$tmpdir/$srcdir";
   load_dirs($$c{"upsCurrentUrl"}, "$tmpdir/upsCurDir", "$tmpdir/$srcdir");
   print(_g("Integrating new upstream version")."\n");
   withecho("svn", "commit", "-m", "$scriptname new version $package ($upsVersion)", "$tmpdir/upsCurDir");
   print(_g("Tagging new upstream version")."\n");
   withecho("svn", "copy", "-m", "$scriptname Tagging $package ($upsVersion)", $$c{"upsCurrentUrl"},  $$c{"upsTagUrl"}."/$upsVersion");
   chdir $$c{"trunkDir"};
   system("debclean -d") if($opt_debclean);
   if($mergemode) {
      # allow to fail, eg. if upstream dir is there but empty
      withechoNoPrompt("svn","merge", $upsOldVersUrl, $$c{"upsCurrentUrl"}, ".");
   }
   else {
      withecho("svn","merge", $upsOldVersUrl, $$c{"upsCurrentUrl"}, ".");
   }
   withechoNoPrompt "svn up";
}
else {
   chdir $$c{"trunkDir"};
}

open(SVN, "env LC_ALL=C svn status|") or error (sprintf(_g("Failed to run `svn status`: %s"),$!));
my @conflicts = grep(/^C/, <SVN>);
close SVN;
map {s/^..//} @conflicts;
if ($#conflicts != -1) {
   print _g("Files in conflict state:")."\n\n @conflicts\n";
   print _g("Resolve them manually and run \"svn resolved\" on each file
      Or use \"svn-upgrade -r\" to overwrite them with new upstream versions\n");
}
withecho("rm", "-rf", $tmpdir) if(length($tmpdir));
my $dch_extra_opts = "";
if (system ("dpkg --compare-versions $upsVersion gt $upVersion") != 0) {
   print _g("Version mismatch. New version is not greater than current.\n");
   if ($opt_autoepoch) {
      print _g("Increasing epoch as requested.\n");
      $epoch += 1;
   } else {
      error _g("Aborting.") if ($opt_noninteractive);
      # Translators: retain i, e and a as untranslated.
      print _g("(i)gnore, increase (e)poch or (a)bort (default)?\n");
      my $ans = <STDIN>;
      if ($ans =~ /^i/i) {
          print _g("Ignoring.\n");
          $dch_extra_opts = "-b";
      } elsif ($ans =~ /^e/i) {
	 print _g("Increasing epoch as requested.\n");
	 $epoch += 1;
      } else {
	 error _g("Aborting.");
      }
   }
}
$upsVersion = join ':', $epoch, $upsVersion if $epoch;

withecho "debchange $dch_extra_opts -D UNRELEASED -v \"$upsVersion-1\" \"New upstream release\"";
$retval = $? >> 8;
print _g("Done! Last commit pending, please execute manually.\n");

sub which {
    my $name=shift;
    for(split(/:/, $ENV{"PATH"})) {
        return if(-x "$_/$name");
    }
    return "";
}

sub END {
    system("rm", "-rf", $tmpdir) if ($tmpdir && -e $tmpdir);
    if($remove) {
        unlink($newsource);
    }
    printf STDERR (_g("Process ended with code %s\n"), $retval);
    exit($retval);
}