svn-buildpackage 0.8.4 / usr / bin / svn-inject

#!/usr/bin/perl

#  Copyright 2003-2006 Eduard Bloch <blade@debian.org>
#  Copyright 2005 Steve Kowalik <stevenk@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/>.

=head1 NAME

svn-inject - inject files into a svn repository

=head1 SYNOPSIS

svn-inject [options] <package>.dsc [ <repository URL> ]

=head1 OPTIONS

=over 8

=item B<-h|help>

Print a brief help message, then exit.

=item B<-v|verbose>

Verbose output.

=item B<-q|quiet>

Don't show commands as they are called.

=back


=head1 DESCRIPTION

svn-inject is used specifically for injecting a debian description file
into a subversion repository. It is a part of the svn-buildpackage suite
of tools.

=cut

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

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

my $basedir=getcwd;
my $scriptname="[svn-inject]";

sub help {
  printf _g("
Usage: svn-inject [options] <package>.dsc [ <repository URL> ]
Options:
  -h            print this message
  -v            Make the commands verbose
  -q            Don't show command calls
  -l <digit>    Layout type (1=pkg/function, 2=function/pkg/)
  -t <string>   Directory where you like to store the .orig files
  --add-tar     Keep tarballs in the repository
  -o            Only keep modified files under SVN control (incl. debian/ dir),
                track only parts of upstream branch
  -c <digit>    Checkout the tree after injecting
                (0=don't do, 1=trunk only (default), 2=complete tree)
  -d <string>   Do-Like-OtherPackage feature. Looks at a local working
                directory, removes lastword/trunk from its URL and uses
                the result as base URL
  --no-branches Like -o but never tracking upstream branch
  -s            Save the detected layout configuration (has effect only if a
                checkout is done after the inject)
  --setprops    Set svn-bp props after injecting
  --tag         Create a tag after importing

If the base repository URL is omitted, svn-inject tries to get it from
the current directory. In this case, -c becomes ineffective.

");
  exit 1;
}

#  -T name      2nd level upstream (3rd party packages) tracking mode, whole
#               package is imported as pure upstream source
#

my $initial_run;
my $opt_debug;
my $opt_svnurl;
my $opt_layout=1;
my $opt_quiet;
my $opt_tardir;
my $opt_checkout=1;
my $opt_dolike;
my $opt_addtar;
my $opt_help;
my $opt_verbose;
my $opt_onlychanged;
my $opt_nobranches;
my $opt_savecfg;
#my $opt_trackmode;
my $opt_setprops;
my $opt_tag;

# parse Command line
my %options = (
   "h|help"                => \$opt_help,
   "v|verbose"             => \$opt_verbose,
   "q|quiet"               => \$opt_quiet,
   "t=s"                   => \$opt_tardir,
   "d=s"                   => \$opt_dolike,
   "l=i"                   => \$opt_layout,
   "o"                     => \$opt_onlychanged,
#   "u=s"                   => \$opt_trackmode,
   "add-tar"               => \$opt_addtar,
   "c=i"                   => \$opt_checkout,
   "O|no-branches"         => \$opt_nobranches,
   "s"                     => \$opt_savecfg,
   "set-props|setprops"  => \$opt_setprops,
   "tag"                   => \$opt_tag,
);

my %supported_formats = (
    "1.0" => 1,
    "3.0 (quilt)" => 1,
    "3.0 (native)" => 1,
);

#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-(setprops)/) {
                # 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";
}

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

# Call the help message if there are no options, or if the users asks for it.
&help unless (GetOptions(%options));
&help if ($opt_help);
&help if $#ARGV < 0;

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

$SDCommon::opt_nosave = 1 ;
$SDCommon::opt_nosave = 0 if (defined $opt_savecfg) ;

my $opt_dsc=$ARGV[0];
my $use_this_repo;

sub tmpdirexec {
  my $testfile=`mktemp`;
  chomp $testfile;
  open my $TESTFILE, '>', $testfile
    or die sprintf(_g("Cannot open %s for writing: %s\n"), $testfile, $!);
  print $TESTFILE "#!/bin/sh\necho ok\n";
  close $TESTFILE;
  print _g("Checking if the default \$TMPDIR allows execution...\n") ;
  if (system ("chmod", "+x", "$testfile") == 0 and (`$testfile`) =~ /ok/ ) {
    print _g("Default \$TMPDIR allows execution.\n")
  } else {
    print _g("Default \$TMPDIR does NOT allow execution.\n");
    print _g("All temporary files will be created in the current directory.\n");
    $ENV{"TMPDIR"}=getcwd();
  };
  system ( "rm -f $testfile" );
}

&tmpdirexec;

die _g("-c 2 only works with -t 1\n") if($opt_checkout==2 && $opt_layout!=1);

if($opt_dolike) {
    if (!$opt_svnurl) {
        $opt_svnurl=url($opt_dolike);
        ($opt_svnurl=~s/\/[^\/]+\/trunk$//)
          or die _g("Failed to extract the base URL, maybe not in layout type 2?\n");
    }
    $basedir=long_path(dirname($opt_dolike)) if ! $basedir;
    if(!$opt_tardir && open(my $dl,"$opt_dolike/.svn/deb-layout")) {
        while(<$dl>) {
            if(/^origDir\s*=\s*(.*)/) {
                $opt_tardir=$1;
                last;
            }
        }
    }
    print _g("Got base URL:")." $opt_svnurl\n";
    printf (_g("Working directory goes to %s/\n"), $basedir);
    printf (_g("Tarball to %s/ or so...\n"), $opt_tardir);
    $opt_onlychanged = length(`svn proplist $opt_dolike/debian | grep mergeWithUpstream`) if !$opt_onlychanged;
}
else {

   $opt_svnurl=$ARGV[1];
   $opt_svnurl=~s,/$,,;
   if(! defined($opt_svnurl)) {
      # we use the current directory and its reflection in the repository as
      # base for the package tree
      $use_this_repo=1;
      $opt_svnurl=url(".");
   }

   &printImportDetails;

   if(! ($opt_dsc && $opt_svnurl)) {
      die _g("Need two arguments: <dsc file> <SVN url>\n");
   }
}

start_ssh($opt_svnurl);

die sprintf(_g("Dsc file %s not readable!\n"), $opt_dsc) if (! -r $opt_dsc);

chomp(my $tempdir=`mktemp -d`);

$opt_dsc = long_path($opt_dsc);

my $opt_svnquiet="-q";
my $opt_patchquiet="--silent";
my $opt_tarquiet;

if($opt_verbose) {
   undef $opt_svnquiet;
   $opt_tarquiet="-v";
   undef $opt_patchquiet;
}

if (defined($opt_nobranches)) {
   $opt_onlychanged += $opt_nobranches;
}

#$SDCommon::opt_quiet=$opt_quiet;


open(my $dsc, "<$opt_dsc") || die sprintf(_g("Could not read %s"), $opt_dsc);
my $fromDir=dirname($opt_dsc);

my $dscOrig;
my $upsVersion;

my $package;
my $debVersion;
my $dscDiff;
my $dscFormat;
my $dscDebianTar;
my %dscOtherOrig;

sub printImportDetails ()
{
    return 0 if (!defined $opt_debug);
    my $cwd=getcwd();
    # XXX: debug stuff, remove or disable!
    print (_g("Import details:")."\n \$package: $package\n \$opt_svnurl=$opt_svnurl\n \$opt_layout=$opt_layout\n");
    print (" cwd=" . $cwd. "\n" );
    if ( $cwd =~ /^\/tmp/ ) { system ( "tree $cwd" ) ; };
    print (_g("Press ^C to stop or Enter to continue!"));
    my $dummy=<STDIN>;
    return 0;
}

while(<$dsc>) {
   # NEVER USE abs_path HERE, it resolves the links
   $dscFormat = $1 if (/^Format: (.+)\n/);
   $package=$1 if(/^Source: (.+)\n/);
   $debVersion=$1 if(/^Version: (.+)\n/ && !$debVersion);
   if(/^(\s\w+\s\d+\s+)((.*)_(.*).orig.tar.(gz|bz2|xz))/)
   {
      $dscOrig="$fromDir/$2";
      $upsVersion=$4;
   }
   if (/^(\s\w+\s\d+\s+)((.*)_(.*).orig(?:-([\w-]+)).tar.(gz|bz2|xz))/)
   {
       $dscOtherOrig{$5}="$fromDir/$2";
   }
   $dscDebianTar = "$fromDir/$1" if(/^\s\w+\s\d+\s(.+\.debian\.tar\.(gz|bz2|xz))\n/);
   $dscDiff = "$fromDir/$1" if(/^\s\w+\s\d+\s(.+\.diff.(gz|bz2|xz))\n/);
}
close($dsc);

die sprintf(_g("svn-buildpackage doesn't support Debian source package format %s. Aborting."), $dscFormat)
   unless $supported_formats{$dscFormat};

if($opt_checkout && -d "$basedir/$package") {
   die sprintf(_g("%s/%s already exists, aborting...\n"), $basedir, $package);
}

$dscDiff=long_path($dscDiff) if defined $dscDiff;

if($dscOrig) {
   $opt_tardir=long_path($opt_tardir ? $opt_tardir : "$basedir/tarballs");
   mkdir $opt_tardir if(!-d $opt_tardir);
   my $dscOrig_ = $dscOrig;
   $dscOrig_ = readlink($dscOrig_) if(readlink($dscOrig_));
   my $newfile = catfile($opt_tardir, basename($dscOrig));
   withechoNoPrompt("cp", "-l", $dscOrig_, $newfile) || withecho("cp", $dscOrig_, $newfile);
}

$SDCommon::c{"origDir"}=long_path($opt_tardir);

my %ourfiles;
my $changed_non_debian=0;
# creating the list of relevant files for mergeWithUpstream mode
if($opt_onlychanged) {
   if ($dscDiff) {
       my $ourcat = "zcat";
       $ourcat = "bzcat" if ($dscDiff =~ /bz2/i);
       $ourcat = "xzcat" if ($dscDiff =~ /xz/i);
       open(my $dl, "$ourcat $dscDiff|");
       while(<$dl>) {
	   if(/^\+\+\+\ [^\/]+\/(.+)\n/) {
	       my $file=$1;
	       $ourfiles{$file}=1;
	       $changed_non_debian += ( ! ($file=~/^debian/));
	   }
       }
       close($dl);
   } elsif ($dscDebianTar) {
       open(my $dl, "tar tf $dscDebianTar|"); # Tar detects compression alone
       while(<$dl>) {
	   chomp;
	   print "ourfile: $_\n";
	   $ourfiles{$_}=1;
	   $changed_non_debian += ( ! ($_=~/^debian/));
       }
       close($dl);
   }
}
$changed_non_debian = 0 if($opt_nobranches); # ignore their original versions in upstream branch

chdir $tempdir;

my ($subupsCurrent, $subtrunk, $subupsVersion, $subtags, $subupsTags);

if ($opt_layout == 1) {
    $subupsCurrent="$package/branches/upstream/current";
    $subupsVersion="$package/branches/upstream/$upsVersion";
    $subupsTags="$package/branches/upstream";
    $subtrunk="$package/trunk";
    $subtags="$package/tags";
} else {
    $subupsCurrent="branches/upstream/$package/current";
    if(defined($upsVersion)) {
        $subupsVersion="branches/upstream/$package/$upsVersion";
    }
    $subupsTags="branches/upstream/$package";
    $subtrunk="trunk/$package";
    $subtags="tags/$package";
}

$SDCommon::c{"trunkUrl"} = "$opt_svnurl/$subtrunk";
$SDCommon::c{"tagsUrl"} = "$opt_svnurl/$subtags";
$SDCommon::c{"upsCurrentUrl"}="$opt_svnurl/$subupsCurrent";
$SDCommon::c{"upsTagUrl"}="$opt_svnurl/$subupsTags";

# preparing a package tree that will be inserted into repository later
if($dscOrig) {
   # prepare the upstream source
   withecho "mkdir", "-p", "$subupsTags";
   chdir "$subupsTags";

   # extract the whole package and use its Debian version as upstream version
   my $comp = "-z";
   $comp = "-j" if ($dscOrig =~ /bz2$/i);
   $comp = "-J" if ($dscOrig =~ /xz$/i);
   withecho "tar", $opt_tarquiet, $comp, "-x", "-f", $dscOrig;
   oldSvnDirsCheck ".";

   my @filesInside=(<*>);
   my $folder_needed=0;
   foreach my $file (@filesInside) {
        $folder_needed=1 if -f $file
   }

   if($folder_needed) {
       # my favorite cruft, orig tarballs without the single top level
       # directory. Create an extra directory for them rather then renaming
       # the dir into "current"
       mkdir "current";
   }
   # also, would be nice with a little error checking to see if everything worked.
   withecho("mv",@filesInside, "current");
  
   # Extract supplementary tarballs
   foreach my $component (keys %dscOtherOrig) {
       withecho("rm", "-rf", "current/$component");
       mkdir "$component.svn-bp-tmp";
       chdir "$component.svn-bp-tmp";
       withecho "tar", $opt_tarquiet, "-x", "-f", $dscOtherOrig{$component};
       oldSvnDirsCheck ".";
       @filesInside=(<*>);
       $folder_needed=0;
       foreach my $file (@filesInside) {
	    $folder_needed=1 if -f $file
       }
       
       if($folder_needed) {
	   chdir "..";
	   withecho("mv", "$component.svn-bp-tmp", "current/$component");
       } else {
	   withecho("mv", @filesInside, "../current/$component");
	   chdir "..";
	   rmdir "$component.svn-bp-tmp";
       }
   }
   
   if($opt_onlychanged) {
       chdir "current" || die _g("Internal operation error, unable to create local import directory\n"); # code 42, stop before unlinking anything
       del_unreferenced(".", %ourfiles);
   }

 }
else {
  # native packages are easier
  my $dir = dirname ("$subtrunk") ;
  my $base = basename("$subtrunk")  ;
  withecho "mkdir", "-p", $dir;
  chdir $dir;
  withecho "dpkg-source -x $opt_dsc";
  system "rm -f *.gz *.bz2 *.xz";
  withecho "mv * $base";
}
chdir $tempdir;

# Final tree prepation before commit, preconfiguring already

if($changed_non_debian || !$opt_onlychanged) {

    &printImportDetails;

    # for non-native packages the source is in uptream/current
    if ($dscOrig) {
        my $msg = sprintf(_g("Installing original source of %s (%s)"), $package, $upsVersion);
        withecho ("svn", $opt_svnquiet, "import", "-m", "$scriptname $msg",
            "$subupsTags", $SDCommon::c{"upsTagUrl"} );
    }
    else {
        my $msg = sprintf(_g("Installing original source of %s (%s)"), $package, $debVersion);
        withecho ("svn", $opt_svnquiet, "import", "-m", "$scriptname $msg",
            "$subtrunk", "$opt_svnurl/$subtrunk" );
    } ;

}

# make sure all directories up to that level are created
SDCommon::svnMkdirP ( $SDCommon::c{"tagsUrl"}, $scriptname ) ;

# for non-native: create the trunk copy from the source and modify it
if($dscOrig) {


   if($changed_non_debian>0 || !$opt_onlychanged) {
       my $msg = sprintf(_g("Tagging upstream source version of %s (%s)"), $package, $upsVersion);
       withecho("svn", "-m", "$scriptname $msg", "copy",
           "$opt_svnurl/$subupsCurrent",
           "$opt_svnurl/$subupsVersion", $opt_svnquiet);

       # the destination directory must not exist, but all up to the last level must be there
       SDCommon::svnMkdirP ( dirname("$opt_svnurl/$subtrunk"), $scriptname ) ;
       $msg = sprintf(_g("Forking %s source to Trunk"), $package);
       withecho("svn", "-m", "$scriptname $msg", "copy",
           "$opt_svnurl/$subupsCurrent",
           "$opt_svnurl/$subtrunk", $opt_svnquiet);

   }
   mkdir "unpdir";
   chdir "unpdir";
   if ($dscFormat eq "3.0 (quilt)") {
       withecho "dpkg-source --no-copy --skip-patches -x $opt_dsc";
   } else {
       withecho "dpkg-source -x $opt_dsc";
   }
   system "rm -f *.gz *.bz2 *.xz";
   # now use svn_load_dirs to upgrade the trunk fork to Debian versions.
   # For mergeWithUpstream mode, drop all unchanged files
   my $dirname=<*>;
   chdir $dirname;
   withecho "fakeroot debian/rules clean || debian/rules clean";
   del_unreferenced(".", %ourfiles) if $opt_onlychanged;
   load_dirs( "$opt_svnurl/$subtrunk", "$tempdir/trunk", "$tempdir/unpdir/$dirname");

   if ($opt_onlychanged) {
       withecho "svn", "propset", "mergeWithUpstream", 1, "$tempdir/trunk/debian";
   }

   &printImportDetails;
   my $msg = sprintf(_g("Applying Debian modifications (%s) to trunk"), $debVersion);
   withecho("svn", "commit", "-m", "$scriptname $msg", "$tempdir/trunk");

   if($opt_setprops) {
       withecho("svn", "up", "$tempdir/trunk/debian");
       foreach(qw/trunkUrl tagsUrl upsCurrentUrl upsTagUrl/){
           withecho("svn", "propset", "svn-bp:" . $_, $SDCommon::c{$_}, "$tempdir/trunk/debian");
       }
       my $msg = _g("Setting svn-bp props");
       withecho("svn", "commit", "-m", "$scriptname $msg", "$tempdir/trunk/debian");
   }
}

if ($opt_tag) {
   $|=1;
   printf (_g("Tagging %s (%s)\n"), $package, $debVersion);
   $|=0;
   withecho("svn", $opt_svnquiet, "copy", "-m", "$scriptname Tagging $package ($debVersion)",
            $SDCommon::c{"trunkUrl"}, $SDCommon::c{"tagsUrl"}."/".$debVersion);
}

chdir $basedir;

my $trunkdir;

if($use_this_repo) {
   # FIXME: this doesn't take layout into account, does it?
   $trunkdir = "$package/trunk";
   withecho "svn up";
}
else {
   if($opt_checkout==2) {
      # checkout everything
      if ($opt_layout==1) {
         $trunkdir = "$basedir/$package/trunk";
         printf (_g("Storing copy of your repository tree in %s/%s.\n"), $basedir,$package);
         withecho "svn", "checkout", "$opt_svnurl/$package", "$basedir/$package", $opt_svnquiet;
      }
      elsif ($opt_layout==2) {
         print _g("Full checkout with layout 2 is not supported. Falling back to trunk checkout.");
         $opt_checkout=1;
      }
   };

   if ($opt_checkout==1) {
      my $svnloc = $SDCommon::c{"trunkUrl"};
      $trunkdir = "$basedir/$package";
      printf (_g("Storing trunk copy in %s/%s.\n"), $basedir, $package);
      #withecho("cp", "-a", "$tempdir/trunk",  $trunkdir);
      withecho "svn", "checkout", "$svnloc", "$basedir/$package", $opt_svnquiet ;
   };
}

if($trunkdir){
    if(!chdir $trunkdir) {
        die("chdir to $trunkdir failed");
    }
}

SDCommon::writeCfg ".svn/deb-layout" if($opt_checkout>0);
print _g("Done!\n");
printf (_g("Checked out source is in %s - have fun!\n"), $trunkdir) if($trunkdir);

sub END {
    if ($tempdir && -e $tempdir) {
        printf (_g("Removing tempdir %s.\n"), $tempdir);
        system "rm -rf $tempdir" ;
    }
}

# broken, keeps subdirs
#sub del_unreferenced {
#    (my $dir, my %list) = @_;
#
#    #for(keys %list) {print "goodstuff: $_\n"};
#    for my $file (reverse(sort(`cd $dir ; find`))) { # make sure directories come last on each level
#        chomp($file);
#        substr($file,0,2,"");
#        next if(!length($file));
#        print "del? $file\n";
#        if(!exists $list{$file}) {
#            unlink("$dir/$file");
#            rmdir(basename("$dir/$file")); # will succeed if empty
#        }
#    }
#}

sub del_unreferenced {
    my $dir=Cwd::abs_path(shift);
    my %list = @_;
    chomp(my $tmpdir = `mktemp -d`);
    # get out if %list is empty!
    return 1 if keys(%list) == 0;
    $opt_tarquiet = '' if (not defined $opt_tarquiet);
    # withecho("cp", "-a", "--parents", (keys %ourfiles), "../current2"); sucks, cannot ignore errors "properly"
    # this sucks too
    withecho("cd $dir ; tar $opt_tarquiet -c ".join(' ',keys %list)." 2>/dev/null | tar x $opt_tarquiet -C $tmpdir");
    withecho("rm", "-rf", $dir);
    withecho("mv", $tmpdir, $dir);
}