#!/usr/bin/perl
# (c) Eduard Bloch <blade@debian.org>, 2003
# License: GPL
# Version: $Id: svn-buildpackage 2100 2005-10-13 19:29:24Z par ame ter $

#use Getopt::Long;
use Getopt::Long qw(:config no_ignore_case bundling pass_through);
use File::Basename;
use Cwd;
use SVN::Client;
use LWP::Simple;
#use diagnostics;

$startdir=getcwd;
chomp($tmpfile=`mktemp`);
$scriptname="[svn-buildpackage]";

sub help {
print "
Usage: svn-buildpackage [ OPTIONS... ] [ OPTIONS for dpkg-buildpackage ]
Builds Debian package within the SVN repository. The source code
repository must be in the format created by svn-inject, and this script
must be executed from the work directory (trunk/package).

  -h, --help         Show the help message
  --svn-dont-clean   Don't run debian/rules clean (default: clean first)
  --svn-dont-purge   Don't wipe the build directory (default: purge after build)
  --svn-no-links     Don't use file links (default: use where possible)
  --svn-ignore-new   Don't stop on svn conflicts or new/changed files
  --svn-verbose      More verbose program output
  --svn-builder CMD  Use CMD as build command instead of dpkg-buildpackage
  --svn-override a=b Override some config variable (comma separated list)
  --svn-move         move package files to .. after successful build
  --svn-move-to XYZ  move package files to XYZ, implies --svn-move
  --svn-only-tag     Tags the current trunk directory without building
  --svn-tag          Final build: Export && build && tag && dch -i
  --svn-retag        replace an existing tag directory if found while tagging
  --svn-lintian      Run lintian after the build. s/lintian/linda/ to use linda
  --svn-pkg PACKAGE  Specifies the package name
  --svn-export       Just prepares the build directory and exits
  --svn-reuse        Reuse an existing build directory, copy trunk over it

If the debian directory has the mergeWithUpstream property, svn-buildpackage
will extract .orig.tar.gz file first and add the Debian files to it.

"; exit 1;
}
$quiet="-q";
my $opt_help;
my $opt_verbose;
my $opt_dontclean;
my $opt_dontpurge;
my $opt_reuse;
my $opt_ignnew;
my $opt_tag;
my $opt_only_tag;
my $opt_lintian;
my $opt_linda;
my $opt_nolinks;
my $opt_pretag;
my $opt_prebuild;
my $opt_posttag;
my $opt_postbuild;
my $opt_buildcmd;
my $opt_export;
my $opt_pass_diff;
my @opt_override;
my $opt_move;
my $package;

%options = (
   "h|help"                => \$opt_help,
   "svn-verbose"           => \$opt_verbose,
   "svn-ignore-new|svn-ignore"        => \$opt_ignnew,
   "svn-dont-clean"        => \$opt_dontclean,
   "svn-export"            => \$opt_export,
   "svn-dont-purge"        => \$opt_dontpurge,
   "svn-reuse"             => \$opt_reuse,
   "svn-only-tag"               => \$opt_only_tag,
   "svn-tag-only"               => \$opt_only_tag,
   "svn-tag"               => \$opt_tag,
   "svn-retag"               => \$opt_retag,
   "svn-lintian"           => \$opt_lintian,
   "svn-linda"           => \$opt_linda,
   "svn-no-links"          => \$opt_nolinks,
   "svn-pass-diff"          => \$opt_pass_diff,
   "svn-prebuild=s"             => \$opt_prebuild,
   "svn-postbuild=s"             => \$opt_postbuild,
   "svn-pretag=s"             => \$opt_pretag,
   "svn-posttag=s"             => \$opt_posttag,
   # and for compatibility wit old config directives
   "pre-tag-action=s"      => \$opt_pretag,
   "post-tag-action=s"     => \$opt_posttag,
   "pre-build-action=s"    => \$opt_prebuild,
   "post-build-action=s"   => \$opt_postbuild,
   "svn-move"             => \$opt_move,
   "svn-move-to=s"             => \$opt_move_to,
   "svn-builder=s"             => \$opt_buildcmd,
   "svn-override=s"             => \@opt_override,
   "svn-pkg=s"             => \$package
);

use lib "/usr/share/svn-buildpackage";
use SDCommon;

&help if ($ARGV[0] eq "-h" || $ARGV[0] eq "--help");

SDCommon::init;

sub setenv {
   ($key, $val) = @_;
   return 0 if(!defined($val));
   print "ENV: $key=$val\n" if $opt_verbose;
   $ENV{$key}=$val;
}

sub setallenv {
   $tagVersion=$SDCommon::tagVersion;
   $upVersion=$SDCommon::upVersion;
   $tagVersionNonEpoch = $tagVersion;
   $tagVersionNonEpoch =~ s/^[^:]*://;

   #this sucks but the config file needs to be processed before the options and there should be reasonable default
   setenv("PACKAGE", defined($package) ? $package : $SDCommon::package);
   setenv("package", defined($package) ? $package : $SDCommon::package);
   setenv "TAG_VERSION", $tagVersion;
   setenv "debian_version", $tagVersion;
   setenv "non_epoch_version", $tagVersionNonEpoch;
   setenv "upstream_version", $upVersion;
   setenv "SVN_BUILDPACKAGE", $SDCommon::version;
   setenv "guess_loc", ( ($package=~/^(lib.)/)?$1:substr($package,0,1))."/$package"."_$upVersion.orig.tar.gz";
}

&setallenv;

for $file ($ENV{"HOME"}."/.svn-buildpackage.conf", ".svn/svn-buildpackage.conf") {
    
    if(open($rc, $file)) {
        SKIP: while(<$rc>) {
            chomp;
            next SKIP if /^#/;
            # drop leading spaces
            s/^\s+//;
            if(/^\w/) {
                # remove spaces between
                s/^(\S+)\s*=\s*/$1=/;
                # convert to options and push to args
                s/^/--/;
                $_=`echo -n $_` if(/[\$`~]/);
                push(@CONFARGS, $_);
            }
        }
        close($rc);
    }
}

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

&help unless ( GetOptions(%options));
&help if ($opt_help);
$quiet="" if ($opt_verbose);
# if opt_only_tag is used, set opt_tag too. Should not hurt because the
# real function of opt_tag at the end of the script is never reached
$opt_tag = 1 if($opt_only_tag);
$opt_move=1 if $opt_move_to;
$destdir=long_path($opt_move_to ? $opt_move_to : "$startdir/..");
$SDCommon::opt_verbose=$opt_verbose;
$package = $SDCommon::package if(!$package);

withecho "fakeroot debian/rules clean || debian/rules clean" if ! ($opt_dontclean || (`svn proplist debian` =~ /mergeWithUpstream/i));
SDCommon::check_uncommited if(!$opt_ignnew);

SDCommon::configure;
needs_tagsUrl if($opt_tag);
$c=\%SDCommon::c;

#some things may have been overriden by user options
&setallenv;


if($opt_buildcmd || $opt_export) {
   @builder = split / /, $opt_buildcmd;
   if($opt_buildcmd=~/;|\||&/) {
      print "I: Looks like a shell construct in the build command, running trough the shell\n";
      #@builder = (join(" ", @builder, @ARGV));
      # become a single command again and let perl run it trough the shell
      $cmd=$opt_buildcmd." ".join(" ", @ARGV);
      @builder = ($cmd);
      undef @ARGV;
   }
}
else {
   push(@builder, "dpkg-buildpackage");
   # a simple "helper". Only executed if no custom command is choosen and
   # no -d switch is there
   {
      if(  (!grep {$_ eq "-d"} @ARGV)
      && (! withechoNoPrompt("dpkg-checkbuilddeps")) )
      {
         die "Insufficient Build-Deps, stop!\n";
      }
   }
}

if(`dpkg-parsechangelog` =~ /(NOT\ RELEASED\ YET)|(UNRELEASED;)/) {
   print STDERR "NOT RELEASED YET tag found - you don't want to release it with it, do you?\n";
   die "Aborting now, set \$FORCETAG to ignore it.\n" if($opt_tag && !$ENV{"FORCETAG"});
}

@opt_override = split(/,|\ |\r|\n/,join(',',@opt_override));
for(@opt_override) {
   $SDCommon::nosave=1;
   if(/(.*)=(.*)/) {
      print "Overriding variable: $1 with $2\n" if $opt_verbose;
      $$c{$1}=$2;
   }
   else {
      print "Warning, unable to parse the override string: $_\n";
   }
}

sub checktag {
   if(insvn($$c{"tagsUrl"}."/$tagVersion")) {
      if($opt_retag) {
         withecho ("svn", "-m", "$scriptname Removing old tag $package-$tagVersion", "rm", $$c{"tagsUrl"}."/$tagVersion");
      }
      else {
         die "Could not create tag copy\n".
         $$c{"tagsUrl"}."/$tagVersion - it
does already exist. Add the --svn-retag option to replace that tag.\n";
      }
   }
}

for(keys %{$c}) {
   $val=$$c{$_};
   setenv $_, $$c{$_};
}

if($opt_only_tag) {
   checktag;
   chdir $$c{"trunkDir"};
   system "$opt_pretag" if($opt_pretag);
   withecho ("svn", "-m", "$scriptname Tagging $package ($tagVersion)", "cp", $$c{"trunkUrl"}, $$c{"tagsUrl"}."/$tagVersion");
   system "$opt_posttag" if($opt_posttag);
   withecho "dch -D UNRELEASED -i \"NOT RELEASED YET\"";
   print "\nI: Done! Last commit pending, please execute manually.\n";
   SDCommon::sd_exit 0;
}

print "D: ",$opt_prebuild if $opt_verbose;

system "$opt_prebuild" if($opt_prebuild);

$$c{"buildArea"}=long_path($startdir."/..")."/build-area" if(!$$c{"buildArea"});

mkdir $$c{"buildArea"} if (! -d $$c{"buildArea"});

$orig = $package."_".$upVersion.".orig.tar.gz";

if ($$c{"origDir"}) {
   $origExpect = $$c{"origDir"}."/$orig";
   if (-f $origExpect) {
      $origfile = long_path($origExpect);
   } elsif ($origExpect =~ /^http/) {
      $origfile = $origExpect;
   }
}
else { $origExpect = "(location unknown)" };

$ba=$$c{"buildArea"};
$bdir="$ba/$package-$upVersion";

if(!$opt_reuse && -e "$bdir") {
   $backupNr=rand;
   print STDERR "$bdir exists, renaming to $bdir.obsolete.$backupNr\n";
   rename("$bdir","$bdir.obsolete.$backupNr");
}

mkdir "$ba" if(! -d "$ba");

if(`svn proplist debian` =~ /mergeWithUpstream/i) {
   print "mergeWithUpstream mode detected, looking for $origExpect\n";
}

# gets the upstream branch out of svn into .orig directory
sub exportToOrigDir {
   # no upstream source export by default and never in mergeWithUpstream mode
   if((!$ENV{"FORCEEXPORT"}) || `svn proplist debian` =~ /mergeWithUpstream/i) {
      return 0;
   }
   needs_upsCurrentUrl;
   $upsVersUrl=$$c{"upsTagUrl"}."/$upVersion";
   defined($$c{"upsCurrentUrl"}) || print STDERR "upsCurrentUrl not set and not located, expect problems...\n";
   withecho("rm", "-rf", "$bdir.orig");
   withecho "svn", "export",$$c{"upsCurrentUrl"},"$bdir.orig";
}

# non-Debian-native package detected, needing some kind of upstream source for
# dpkg-buildpackage (most likely, spew error messages but continue on native
# packages with dashes)
if($tagVersion =~ /-/) {
   my $orig_target="$ba/".$orig;
   my $abs_origfile=long_path($origfile);

   if ($origfile =~ /^(http|ftp)/) { # remote location
      if (-e $orig_target) {
         my @stat = head($origfile);
         if(($stat[1]) != ((stat($orig_target))[7]))
         {
            die "$orig_target exists but differs from $origfile!\nAborting, fix this manually...";
         }
      } else {
         my $http_err_code = getstore($origfile, $orig_target);
         if(!(is_success($http_err_code) && $orig_target)) {
            die "Failed to retrieve $origfile ($http_err_code)";
         }
      }
   }
   elsif($origfile && -e $abs_origfile) { # local
      if($opt_verbose) {
         print "Trying different methods to export the upstream source:\n";
         print " - making hard or symbolic link from $origExpect\n" if (!$opt_nolinks);
         print " - copying the tarball to the expected destination file\n";
      }
      else {
         print "W: $abs_origfile not found, expect problems...\n" if(! -e $abs_origfile);
      }
   
   
      if(-e $orig_target) {
         if(((stat($abs_origfile))[7]) != ((stat($orig_target))[7]))
         {
            die "$orig_target exists but differs from $abs_origfile!\nAborting, fix this manually...";
         }
      }
      else {
         # orig in tarball-dir but not in build-area
         if($opt_nolinks) {
            withechoNoPrompt("cp", long_path($origfile), "$ba/$orig") 
            ||
            exportToOrigDir;
         }
         else {
            link(long_path($origfile),"$ba/".$orig) 
            ||
            symlink(long_path($origfile),"$ba/".$orig)
            ||
            withechoNoPrompt("cp",long_path($origfile),"$ba/$orig")
            ||
            exportToOrigDir;
         }
      }
   }
   else {
      # no orig at all, try exporting
      exportToOrigDir;
   }
}

# contents examination for "cp -l" emulation
print STDERR "Creating file list...\n" if $opt_verbose;
sub collect_names {
    push(@filelist, $_[0]);
}
my $ctx = new SVN::Client;
$ctx->status("", "BASE", \&collect_names, 1, 1, 0, 1);
# open($stat, "svn status -v |");
#open($stat, "svn ls -R |");
#while(<$stat>) {
#    if(/^[^\?].*\d+\s+\d+\s+\S+\s+(.*)\n/) {
#       $_=$1;
#chomp;
for(@filelist) {
       if ($_ ne ".") {
          if(-d $_) {
             push(@dirs,$_); 
             print STDERR "DIR: $_\n" if $opt_verbose;
          } 
          else { 
             push(@files,$_); 
             print STDERR "FILE: $_\n" if $opt_verbose;
          }
          s#/$##;
          push(@stuff, $_);
       }
#    }
}

# sub cpl {
#    ($from, $to) = @_;
#    for(@dirs) {$_="$from/$_"}
#    for(@files){$_="$from/$_"}
#    
#    system "cd $bdir && mkdir -p ".join(' ',@dirs)) +
#          system "cp", "--parents", "-laf", @files), "$bdir/") ;
#       }

if(`svn proplist debian` =~ /mergeWithUpstream/i) {
   print STDERR "I: mergeWithUpstream property set, looking for upstream source tarball...\n";
#   die "E: Could not find the origDir directory, please check the settings!\n" if(! -e $$c{"origDir"});
   die "E: Could not find the upstream source file! (should be $ba/$orig)\n" if(! (-e "$ba/$orig"));
   
   $mod=rand;
   mkdir "$ba/tmp-$mod";
   if($opt_reuse && -d $bdir) {
      print "Reusing old build directory\n" if $opt_verbose;
   }
   else {
      withecho "tar", "zxf", "$ba/$orig", "-C", "$ba/tmp-$mod";
      my @entries = (<$ba/tmp-$mod/*>);
      if (@entries == 1) {
         # The files are stored in the archive under a top directory, we
         # presume
         withecho "mv", (<$ba/tmp-$mod/*>), $bdir;
      }
      else {
         # Otherwise, we put them into a new directory
         withecho "mv", "$ba/tmp-$mod", $bdir;
      }
   }
   if($opt_nolinks || $opt_ignnew) {
      withecho ("svn", "--force", "export", $$c{"trunkDir"},"$bdir");
   }
   else {
      mkdir $bdir;
      #fixme maybe rewrite to withecho
      if( system("mkdir","-p", map { "$bdir/$_" } @dirs) + system ("cp", "--parents", "-laf", @files, $bdir) ) 
      { # cp failed...
         withecho "svn", "--force", "export", $$c{"trunkDir"},"$bdir";
      }
   }
   withecho "rm", "-rf", "$ba/tmp-$mod";
}
else {
   if($opt_nolinks) {
      withecho "svn","--force", "export",$$c{"trunkDir"},"$bdir";
   }
   else {
      mkdir $bdir;
      # stupid autodevtools are confused but... why?
      if(system("mkdir", map { "$bdir/$_" } sort(@dirs)) + system ("cp", "--parents", "-laf", @files, $bdir) )
      #open(tpipe, "| tar c --no-recursion | tar --atime-preserve -x -f- -C $bdir");
      #for(@dirs) {print tpipe "$_\n"}
      #close(tpipe);
      #if(system ("cp", "--parents", "-laf", @files, $bdir))
      { # cp failed...
         system "rm", "-rf", $bdir;
         withecho "svn", "--force", "export",$$c{"trunkDir"},$bdir;
      }
   }
}

# a cludge...
if($opt_pass_diff) {
   $dirname="$package-$upVersion";
   needs_upsCurrentUrl;

   if(`svn status $$c{"trunkDir"}` =~ /(^|\n)(A|M|D)/m) {
      print STDERR "Warning, uncommited changes found, using combinediff to merge them...\n";
      chomp($afile=`mktemp`);
      chomp($bfile=`mktemp`);
      chomp($cfile=`mktemp`);
      withecho "svn diff ".$$c{"upsCurrentUrl"}." ".$$c{"trunkUrl"}." > $afile";
      withecho "cd ".$$c{"trunkDir"}." ; svn diff > $bfile";
      withecho "combinediff $afile $bfile > $cfile";
      open(diffin, "cat $cfile |");
   }
   else {
      open(diffin, "svn diff ".$$c{"upsCurrentUrl"}." ".$$c{"trunkUrl"}." |");
   }
   open(diffout,">$tmpfile");
   # fix some diff junk
   $invalid=1;
   while(<diffin>) {
      s!^--- (\S+).*!--- $dirname.orig/$1!;
      s!^\+\+\+ (\S+).*!+++ $dirname/$1!;
      $invalid=0 if(/^---/);
      $invalid=1 if( (!$invalid) && /^[^+\-\t\ @]/);
      $invalid || print diffout $_;
   }
   close(diffin);
   close(diffout);
   $ENV{"DIFFSRC"}=$tmpfile;
}

chdir $bdir || die "Mh, something is going wrong with builddir $bdir...";

if($opt_export) { print "Build directory exported to $bdir\n"; exit 0;}

if (!withecho(@builder,@ARGV)) {
   system "$opt_postbuild" if($opt_postbuild);
   print STDERR "build command failed in $bdir\nAborting.\n";
   print STDERR "W: build directory not purged!\n";
   print STDERR "W: no lintian/linda checks done!\n" if($opt_lintian);
   print STDERR "W: package not tagged!\n" if($opt_tag);
   SDCommon::sd_exit 1;
}
else {
    
    system "$opt_postbuild" if($opt_postbuild);
    
    # no summary when using custom command
    if(! $opt_buildcmd) {

        chdir "..";
        for $arch (`dpkg --print-architecture`, "source") {
            chomp($arch);
            $chfile="$package"."_$tagVersionNonEpoch"."_$arch.changes";
            last if(open($ch, "<$ba/$chfile"));
        }

        if(open($ch, "<$ba/$chfile")) {
            while(<$ch>) { push(@newfiles, $1) if(/^\s\w+\s\d+\s\S+\s\w+\s(.+)\n/); }
            close($ch);
            push(@newfiles, "$ba/$chfile");

            if($opt_move) {
                $retval=!withechoNoPrompt("mv", @newfiles, $destdir);
            }
            else { $destdir=$ba; }

            # expand the paths in the list and kick non-binary packages

            map { if(/\.deb$/){ $_=" $destdir/$_"; $multi++}else{undef $_}} @newfiles;

            print STDERR `tput smso`, 
            "build command was successful; binaries are in $destdir/. ", 
            "The changes file is:\n $destdir/$chfile\n", 
            `tput rmso`, "Binary package",
            ($multi > 1 ? "s:\n" : ":\n"), 
            @newfiles, "\n";

            print STDERR `tput smso`, 
            "Warning: $package should have an orig tarball but it does not!\n", 
            `tput rmso` if(($upVersion ne $tagVersion) && ($tagVersion =~/-1$/) && !-e "$destdir/$orig");
        }
        elsif($opt_verbose)
        {
            print STDERR "Could not read the .changes file";
        }
    }

   # cleanup
   if(!$opt_dontpurge) {
      withecho "rm", "-rf", $bdir if(length($tagVersion));
      unlink $tmpfile;
      unlink $afile;
      unlink $bfile;
      unlink $cfile;
   }
   
   if($opt_lintian) {
      withecho "lintian", "$destdir/$chfile";
   }

   if($opt_linda) {
      withecho "linda", "$destdir/$chfile";
   }

   if($opt_tag) {
      system "$opt_pretag" if($opt_pretag);
      checktag;
      withecho ("svn", "-m", "$scriptname Tagging $package ($tagVersion)", "cp", $$c{"trunkUrl"}, $$c{"tagsUrl"}."/$tagVersion");
      system "$opt_posttag" if($opt_posttag);
      chdir $$c{"trunkDir"};
      withecho "dch", "-D", "UNRELEASED", "-i", "NOT RELEASED YET";
      print "\nI: Done! Created the next changelog entry, please commit later or revert.\n";
   }
}
SDCommon::sd_exit 0+$retval;
