debtransform

#!/usr/bin/perl -w

################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# 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 (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

use strict;
use Digest::MD5;
use Digest::SHA;
use POSIX qw(strftime);

sub usage
{
  die("usage: debtransform [--debug] [--changelog <changelog>] [--release <release number>] <srcdir> <dscfile> <outdir>\n");
}

sub parsedsc {
  my ($fn) = @_;
  my @control;
  local *F;
  open(F, '<', $fn) || die("Error in reading $fn: $!\n");
  @control = <F>;
  close F;
  chomp @control;
  splice(@control, 0, 3) if @control > 3 && $control[0] =~ /^-----BEGIN/;
  my @seq = ();
  my %tag;
  while (@control) {
    my $c = shift @control;
    last if $c eq '';   # new paragraph
    my ($tag, $data) = split(':', $c, 2);
    next unless defined $data;
    push @seq, $tag;
    $tag = uc($tag);
    while (@control && $control[0] =~ /^\s/) {
      $data .= "\n".substr(shift @control, 1);
    }
    $data =~ s/^\s+//s;
    $data =~ s/\s+$//s;
    $tag{$tag} = $data;
  }
  $tag{'__seq'} = \@seq;
  return \%tag;
}

sub writedsc {
  my ($fn, $tags) = @_;
  print "Writing $fn\n";
  open(F, '>', $fn) || die("open $fn: $!\n");
  my @seq = @{$tags->{'__seq'} || []};
  my %seq = map {uc($_) => 1} @seq;
  for (sort keys %$tags) {
    if (! $seq{$_}) {
      # ucfirst will change checksums-sha1 to Checksums-sha1 but the canonical
      # form is Checksums-Sha1, hence the need for the second transformation
      my $camel_tag = ucfirst(lc($_));
      $camel_tag =~ s/-\K(\w)/\U$1/g;
      push @seq, $camel_tag;
    }
  }
  for my $seq (@seq) {
    my $ucseq = uc($seq);
    my $d = $tags->{$ucseq};
    next unless defined $d;
    $d =~ s/\n/\n /sg;
    if ($d =~ /^\n/) {
      print F "$seq:$d\n";
    } else {
      print F "$seq: $d\n";
    }
  }
  print F "\n";
  close F;
}

sub listtar {
  my ($tar, $skipdebiandir) = @_;
  print "Scanning $tar...\n";
  local *F;
  my @c;
  unless(defined($skipdebiandir)) {
    $skipdebiandir = 1;
  }
  open(F, '-|', 'tar', '--numeric-owner', '-tvf', $tar) ||
    die("Execution of tar subprocess failed: $!\n");
  while(<F>) {
    next unless /^([-dlbcp])(.........)\s+\d+\/\d+\s+(\S+) \d\d\d\d-\d\d-\d\d \d\d:\d\d(?::\d\d)? (.*)$/;
    my ($type, $mode, $size, $name) = ($1, $2, $3, $4);
    next if $type eq 'd';
    if ($type eq 'l') {
      next if $skipdebiandir eq 0;
      die("Archive contains a link: $name\n");
    }
    if ($type ne '-') {
      next if $skipdebiandir eq 0;
      die("Archive contains an unexpected type for file \"$name\"\n");
    }
    $name =~ s/^\.\///;
    $name =~ s/^debian\/// if $skipdebiandir eq 1;
    push @c, {'name' => $name, 'size' => $size};
  }
  close(F) || die("tar exited with non-zero status: $!\n");
  return @c;
}

sub dopatch_changelog {
    my ($version_new, @content) = @_;
    my $firstline = $content[0];
    my $version = $firstline;
    $version =~ s/.*\((.*)\).*/$1/g;
    if ($version ne $version_new) {
      print "Found changelog with the last entry version not equal to build package version ($version).\n";
      $firstline =~ s/\(.*\)/($version_new)/g;
      my $date = `date -R`;
      if (defined($ENV{SOURCE_DATE_EPOCH})) {
        $date = strftime("%a, %d %b %Y %T +0000", gmtime($ENV{SOURCE_DATE_EPOCH}));
      }
      chomp($date);
      my @newcontent = ($firstline, "", "  * version number update by debtransform", "", " -- debtransform <build\@opensuse.org>  ".$date, "");
      push(@newcontent, @content);
      print "New entry with updated version number added ($version_new).\n";
      @content = @newcontent;
    }
    return @content;
}

sub extracttar {
  my ($tar, $filename, $s) = @_;
  local *F;
  print "Extracting $tar...\n";
  open(F, '-|', 'tar', '-xOf', $tar, $filename) ||
    die("Execution of tar subprocess failed: $!\n");
  my $file = '';
  while ($s > 0) {
    my $l = sysread(F, $file, $s, length($file));
    die("Error while reading from tar subprocess: $!\n") unless $l;
    $s -= $l;
  }
  my @file = split("\n", $file);
  close(F) || warn("tar exited with non-zero status: $!\n");
  return @file;
}

sub dodiff {
  my ($oldname, $newname, $origtarfile, @content) = @_;
  my @oldcontent;
  for my $c (@{$origtarfile->{'content'}}) {
      if ($c->{'name'} eq $newname) {
          @oldcontent = extracttar($origtarfile->{'name'}, $c->{'name'}, $c->{'size'});
      }
  }
  if ($newname eq $origtarfile->{'tardir'}."/debian/changelog") {
    @content = dopatch_changelog($origtarfile->{'version'}, @content);
  }
  return unless @content;
  print DIFF "--- $oldname\n";
  print DIFF "+++ $newname\n";
  if (@oldcontent) {
    print DIFF "\@\@ -1,".scalar(@oldcontent)." +1,".scalar(@content)." \@\@\n";
    print DIFF "-$_\n" for @oldcontent;
  } else {
    print DIFF "\@\@ -0,0 +1,".scalar(@content)." \@\@\n";
  }
  print DIFF "+$_\n" for @content;
}

sub dorelativepath {
  use Cwd qw(cwd);
  use File::Spec;
  my $dir = cwd;

  my ($path_a, $path_b) = @_;

  my $relative_path = File::Spec->abs2rel ($path_a,  $path_b);
  return $relative_path
}

sub dotar {
  my ($tar, $tardir, $origin, $origtarfile, @c) = @_;
  local *F;
  open(F, '-|', 'tar', '-xOf', $tar) || die("tar: $!\n");
  for my $c (@c) {
    my $s = $c->{'size'};
    my $file = '';
    while ($s > 0) {
      my $l = sysread(F, $file, $s, length($file));
      die("tar read error\n") unless $l;
      $s -= $l;
    }
    next if $origin && $origin->{$c->{'name'}} ne $tar;
    my @file = split("\n", $file);
    dodiff("$tardir.orig/debian/$c->{'name'}", "$tardir/debian/$c->{'name'}", $origtarfile, @file);
  }
  close(F);
}

sub dotar_quilt {
  use File::Temp qw(tempdir);
  use File::Basename;

  my $tmpdir = File::Temp->newdir();
  my $tempdirname = $tmpdir->dirname;

  my ($input_file_path, $output_file_path, $origtarfile) = @_;

  my $input_file_path_relative = dorelativepath($input_file_path);
  my $output_file_path_relative = dorelativepath($output_file_path);

  print "Add tar file contents '$input_file_path_relative'\n";
  print "    to debian quilt tar file '$output_file_path_relative'\n";

  my @list = $input_file_path =~ /(.*)((\.tgz$)|(\.tar(?:\.gz|\.bz2|\.xz)?$))/g;
  my $input_file_path_without_ext = $list[0];
  my $ext = $list[1];

  my $decompress_src = "$input_file_path";
  my $input_file_name = basename($input_file_path_without_ext);
  my $decompress_dst = "${tempdirname}/${input_file_name}.tar";

  my $tar_for_concatination_path = $decompress_dst;

  # print "Decompress '$input_file_path_relative' to '$tar_for_concatination_path' for concatenation\n";

  if (($ext eq ".tgz") or ($ext eq ".tar.gz")) {
    (system qq(gzip -dck '$decompress_src' > '$decompress_dst')) == 0 or die "Can not unpack gzip archive '$decompress_src': $!\n";
  } elsif ($ext eq ".tar.xz") {
    (system qq(xz -dck '$decompress_src' > '$decompress_dst')) == 0 or die "Can not unpack xz archive '$decompress_src': $!\n";
  } elsif ($ext eq ".tar.bz2") {
    (system qq(bzip2 -dck '$decompress_src' > '$decompress_dst')) == 0 or die "Can not unpack bzip2 archive '$decompress_src': $!\n";
  } elsif ($ext eq ".tar") {
    system 'cp', $decompress_src, $decompress_dst;
  } else {
    die "Unrecognized archive filename extension: '$ext'\n";
  }

  # Looking for changelog in tar
  my $changelog_path_in_tar = 'debian/changelog';
  my $is_changelog_in_tar = (system qq(tar -tf '$tar_for_concatination_path' '$changelog_path_in_tar' > /dev/null 2>&1)) == 0;

  if ($is_changelog_in_tar){
    print "Found '$changelog_path_in_tar' in '${tar_for_concatination_path}', extract to '$tempdirname'.\n";
    (system 'tar', 'xf', $input_file_path, '--directory', $tempdirname, $changelog_path_in_tar) == 0
      or die "Can not extract file '$changelog_path_in_tar' from tar '$input_file_path': $!\n";

    # Patch changelog
    my $changelog_file_path = "$tempdirname/$changelog_path_in_tar";
    my $changelog_file_path_patched = "${changelog_file_path}.patched";
    open my $in,  '<',  $changelog_file_path         or die "Can't read original changelog file: $!\n";
    open my $out, '>',  $changelog_file_path_patched or die "Can't write patched changelog file: $!\n";

    chomp(my @lines = <$in>);
    my @new_lines = dopatch_changelog($origtarfile->{'version'}, @lines);

    print $out "$_\n" for @new_lines;
    close $out;

    # Replace original changelog with patched
    unlink $changelog_file_path;
    rename $changelog_file_path_patched, $changelog_file_path;

    print "Update tar '$tar_for_concatination_path' due to changelog '$changelog_file_path' patched.\n";
    # Add changelog file to tar relative to tempdirname
    (system 'tar', '-C', $tempdirname, '-uf', $tar_for_concatination_path, $changelog_path_in_tar) == 0
      or die "Can not update tar '$tar_for_concatination_path' with file '$changelog_file_path': $!\n";

    unlink $changelog_file_path;
  }

  system 'tar', '--concatenate', '-f', $output_file_path, $tar_for_concatination_path;

  unlink $tar_for_concatination_path;
}

sub dofile {
  my ($file, $tardir, $dfile, $origtarfile) = @_;
  local *F;
  print "Processing file \"$file\"...\n";
  open(F, '<', $file) || die("Error in reading $file: $!\n");
  my @file = <F>;
  close F;
  chomp(@file);
  dodiff("$tardir.orig/$dfile", "$tardir/$dfile", $origtarfile, @file);
}

sub dofile_quilt {
  use Cwd qw(cwd);
  use File::Spec;
  use File::Basename;
  use File::Temp qw(tempdir);

  my $tmpdir = File::Temp->newdir();
  my $tempdirname = $tmpdir->dirname;

  my $dir = cwd;

  my ($input_file_path, $output_file_path, $rename_file_path, $origtarfile) = @_;

  my $input_file_path_relative = dorelativepath($input_file_path);
  my $output_file_path_relative = dorelativepath($output_file_path);

  my $path_for_logging = $input_file_path_relative;

  # Catch and patch changelog
  if (basename($input_file_path_relative) eq 'debian.changelog') {
    my $input_file_path_patched = "${tempdirname}/debian.changelog.patched";

    open my $in,  '<',  $input_file_path         or die "Can't read original changelog file: $!\n";
    open my $out, '>',  $input_file_path_patched or die "Can't write patched changelog file: $!\n";

    chomp(my @lines = <$in>);
    my @new_lines = dopatch_changelog($origtarfile->{'version'}, @lines);

    print $out "$_\n" for @new_lines;
    close $out;

    $input_file_path = $input_file_path_patched;
    $input_file_path_relative = dorelativepath($input_file_path);
    $path_for_logging = $input_file_path;
  }

  print "Add file '$path_for_logging'\n";
  print "    to debian quilt tar file '$output_file_path_relative'\n";
  print "    with internal path       '$rename_file_path'\n";

  system("tar --transform='flags=r;s|$input_file_path|$rename_file_path|' -Prf $output_file_path $input_file_path");
}

sub doseries {
  my ($series, $tardir) = @_;
  my $dir = $series;
  $dir =~ s/[^\/]+$//;
  $dir =~ s/\/+$//;
  $dir = '.' if $dir eq '';
  local *F;
  open(F, '<', $series) || die("$series: $!\n");
  my @series = <F>;
  close F;
  chomp(@series);
  print "Processing series file \"$series\"...\n";
  for my $patch (@series) {
    $patch =~ s/(^|\s+)#.*//;
    next if $patch =~ /^\s*$/;
    my $level = 1;
    $level = $1 if $patch =~ /\s.*-p\s*(\d+)/;
    $patch =~ s/\s.*//;
    print "Processing patch $dir/$patch...\n";
    open(F, '<', "$dir/$patch") || die("Error in reading $dir/$patch: $!\n");
    while(<F>) {
      chomp;
      if ((/^--- ./ || /^\+\+\+ ./) && !/^... \/dev\/null/) {
	my $start = substr($_, 0, 4);
	$_ = substr($_, 4);
	my $l = $level;
	while ($l > 0) {
	  last unless s/.*?\///;
	  $l--;
	}
	if ($start eq '--- ') {
	  print DIFF "$start$tardir.orig/$_\n";
	} else {
	  print DIFF "$start$tardir/$_\n";
	}
	next;
      }
      print DIFF "$_\n";
    }
    close F;
  }
}

sub doseries_quilt {
  use File::Basename;
  use File::Temp qw(tempfile);

  my ($series, $tardir, $quilt_debian_file, $origtarfile) = @_;
  my $dir = $series;
  $dir =~ s/[^\/]+$//;
  $dir =~ s/\/+$//;
  $dir = '.' if $dir eq '';
  local *F;
  open(F, '<', $series) || die("$series: $!\n");
  my @series = <F>;
  close F;
  chomp(@series);

  my $series_relative = dorelativepath($series);

  my $tmp_patches = new File::Temp( UNLINK => 1 );
  open(tmp_patches,'>',$tmp_patches) or die $!;

  print "Processing series file \"$series_relative\"...\n";
  for my $patch (@series) {
    $patch =~ s/(^|\s+)#.*//;
    next if $patch =~ /^\s*$/;
    my $level = 1;
    $level = $1 if $patch =~ /\s.*-p\s*(\d+)/;
    $patch =~ s/\s.*//;
    my $patch_relative = dorelativepath($patch);
    print "Processing patch $patch_relative...\n";
    my $patch_name = basename($patch);
    dofile_quilt("$dir/$patch", $quilt_debian_file, "debian/patches/$patch_name", $origtarfile);
    print tmp_patches "$patch_name\n";
  }

  close($tmp_patches);
  dofile_quilt($tmp_patches, $quilt_debian_file, "debian/patches/series", $origtarfile);
}

sub addfile {
  my ($file, $algorithm) = @_;
  my $base = $file;
  $base =~ s/.*\///;
  local *F;
  open(F, '<', $file) || die("Error in reading $file: $!\n");
  my $size = -s F;
  my $ctx;
  if ($algorithm =~ /^MD5/) {
    $ctx = Digest::MD5->new;
  } elsif ($algorithm =~ /^SHA/) {
    $ctx = Digest::SHA->new($algorithm);
  } else {
    die("Unknown digest $algorithm\n");
  }
  $ctx->addfile(*F);
  close F;
  my $md5 = $ctx->hexdigest();
  return "$md5 $size $base";
}

sub is_quilt {
  my ($format) = @_;
  return $format =~ /3\.0 \(quilt\)/;
}

print "** Started: debtransform @ARGV\n";

my $debug = 0;
my $changelog;
my $release;

while (@ARGV > 3) {
  if ($ARGV[0] eq '--debug') {
    shift @ARGV;
    $debug = 1;
  } elsif ($ARGV[0] eq '--changelog') {
    shift @ARGV;
    $changelog = shift @ARGV;
  } elsif ($ARGV[0] eq '--release') {
    shift @ARGV;
    $release = shift @ARGV;
  } else {
    usage();
  }
}

if( @ARGV != 3 ) {
  usage();
}

my $dir = $ARGV[0];
my $dsc = $ARGV[1];
my $out = $ARGV[2];

die("$out is not a directory\n") unless -d $out;

my $tags = parsedsc($dsc);

opendir(D, $dir) || die("Could not open $dir: $!\n");
my @dir = grep {$_ ne '.' && $_ ne '..'} readdir(D);
closedir(D);
my %dir = map {$_ => 1} @dir;

my $tarfile = $tags->{'DEBTRANSFORM-TAR'};
my @debtarfiles;
if ($tags->{'DEBTRANSFORM-FILES-TAR'}) {
  @debtarfiles = split(' ', $tags->{'DEBTRANSFORM-FILES-TAR'});
}

if (!$tarfile || !@debtarfiles) {
  my @tars = grep {/\.tgz$|\.tar(?:\.gz|\.bz2|\.xz)?$/} @dir;
  my @debtars = grep {/^debian\.tar(?:\.gz|\.bz2|\.xz)?$/} @tars;
  if (!$tarfile) {
    print "No DEBTRANSFORM-TAR line in the .dsc file.\n";
    print "Attempting automatic discovery of a suitable source archive.\n";
    @tars = grep {!/^debian\.tar(?:\.gz|\.bz2|\.xz)?$/} @tars;
    if (@debtarfiles) {
      my %debtarfiles = map {$_ => 1} @debtarfiles;
      @tars = grep {!$debtarfiles{$_}} @tars;
    }
    die("None of the files looks like a usable source tarball.\n") unless @tars;
    die("Too many files looking like a usable source tarball (would not know which to pick): @tars\n") if @tars > 1;
    $tarfile = $tars[0];
    print "Source archive chosen for transformation: $tarfile\n";
  }
  if (!exists($tags->{'DEBTRANSFORM-FILES-TAR'})) {
    print "No DEBTRANSFORM-FILES-TAR line in the .dsc file.\n";
    print "Attempting automatic discovery of a debian archive.\n";
  }
  if (@debtars && !exists($tags->{'DEBTRANSFORM-FILES-TAR'})) {
    die("package contains more than one debian archive\n") if @debtars > 1;
    @debtarfiles = ($debtars[0]);
    print "Debian archive chosen for transformation: $debtars[0]\n";
  }
}

my $name = $tags->{'SOURCE'};
die("dsc file contains no Source: line\n") unless defined($name);
my $version = $tags->{'VERSION'};
die("dsc file contains no Version: line\n") unless defined($version);
my $format = $tags->{"FORMAT"};
die("dsc file contains no Format: line\n") unless defined($format);

if (is_quilt($format)) {
  # debtransform generates source package in 3.0 (non-native) format
  print "Transforming into source package '$format' format\n";
}
else {
  # debtransform generates source package in 1.0 (non-native) format
  print "Transforming into source package 1.0 (non-native) format\n";
}

# non-native sources should always contain Debian revision
if ($version !~ /-/) {
	$version = $version . "-1";
	print "Added Debian revision to Version field, which is now \"$version\".\n";
}

# for 1.0 all source archives should be transformed into weak gzip files
# (https://wiki.debian.org/Projects/DebSrc3.0)
my $tmptar;
if ($tarfile =~ /\.tar\.bz2/) {
    my $old = $tarfile;
    $tarfile =~ s/\.tar\.bz2/\.tar\.gz/;
    $tmptar = "$out/$tarfile";
    print "converting $dir/$old to $tarfile\n";
    system( ( "debtransformbz2", "$dir/$old", "$tmptar" )) == 0 || die("cannot transform .tar.bz2 to .tar.gz");
}
if ($tarfile =~ /\.tar\.xz/) {
    my $old = $tarfile;
    $tarfile =~ s/\.tar\.xz/\.tar\.gz/;
    $tmptar = "$out/$tarfile";
    print "converting $dir/$old to $tarfile\n";
    system( ( "debtransformxz", "$dir/$old", "$tmptar" )) == 0 || die("cannot transform .tar.xz to .tar.gz");
}
if ($tarfile =~ /\.zip/) {
    my $old = $tarfile;
    $tarfile =~ s/\.zip/\.tar\.gz/;
    $tmptar = "$out/$tarfile";
    print "converting $dir/$old to $tarfile\n";
    system( ( "debtransformzip", "$dir/$old", "$tmptar" )) == 0 || die("cannot transform .zip to .tar.gz");
}
if ($tarfile =~ /\.tgz$/) {
    my $old = $tarfile;
    $tarfile =~ s/\.tgz/\.tar.gz/;
    $tmptar = "$out/$tarfile";
    print "renaming $dir/$old to $tarfile\n";
    system ( ("mv",  "$dir/$old",  "$tmptar" ) ) == 0 || die("cannot rename .tgz to .tar.gz");
}

if (($tags->{'DEBTRANSFORM-RELEASE'} || $tags->{'OBS-DCH-RELEASE'}) && $release) {
    # the tag DEBTRANSFORM-RELEASE in .dsc file instructs
    # to append OBS build number to package version. The
    # number is passed in "release" command line parameter.
    # On OBS, release is incremented automatically
    # (same as for RPMs)
    $version = $version . "+" . $release;
}
if ($version ne $tags->{VERSION}) {
    $tags->{VERSION} = $version;
    print "Modifying dsc Version field to \"$tags->{VERSION}\"\n";
}

# no epoch in filename
if ($version =~ s/^\d+://) {
  print "Stripped epoch from $version for filenames.\n";
}

my $quilt_debian_file = "$out/${name}_${version}.debian.tar";
unlink($quilt_debian_file) if -e $quilt_debian_file;

my @files;
my @checksums_sha1;
my @checksums_sha256;
my $v = $version;
# version without Debian revision
$v =~ s/-[^-]*$//;
$tarfile =~ /.*(\.tar.*?)$/;
my $ntarfile = "${name}_$v.orig$1";
if( $tmptar ) {
  print "Moving $dir/$tarfile to $out/$ntarfile\n";
  link("$tmptar", "$out/$ntarfile") || die("link: $!\n");
  unlink("$tmptar");
} else {
  print "Hardlinking $dir/$tarfile to $out/$ntarfile\n";
  link("$dir/$tarfile", "$out/$ntarfile") || die("link: $!\n");
}
push @files, addfile("$out/$ntarfile", "MD5");
push @checksums_sha1, addfile("$out/$ntarfile", "SHA1");
push @checksums_sha256, addfile("$out/$ntarfile", "SHA256");
print "files @files\n";

my $tarpath = "$out/$ntarfile";
my $tardir = $tarfile;
$tardir =~ s/\.orig\.tar/\.tar/;
$tardir =~ s/\.tar.*?$//;
my @tarfilecontent = listtar($tarpath, 0);
my $origtarfile = {'name' => $tarpath, 'content' => \@tarfilecontent, 'version' => $tags->{'VERSION'}, 'tardir' => $tardir};

# Since we are generating a unitary diff, we must re-set Format:.
if (not is_quilt($format)){
  print "Generating $out/${name}_$version.diff\n";
  $tags->{"FORMAT"} = "1.0";
}

if (not is_quilt($format)) {
  open(DIFF, '>', "$out/${name}_$version.diff") || die("Cannot open $out/${name}_$version.diff for write: $!\n");
}

undef $changelog if $dir{'debian.changelog'};

my %debtarorigin;
my %debtarcontent;
for my $debtarfile (@debtarfiles) {
  my @c = listtar("$dir/$debtarfile");
  $debtarcontent{$debtarfile} = \@c;
  for (@c) {
    die("\"$_->{'name'}\" exists in both the debian archive as well as the package source directory.\n") if $dir{"debian.$_->{'name'}"};
    undef $changelog if $_->{'name'} eq 'changelog';
    $debtarorigin{$_->{'name'}} = "$dir/$debtarfile";
  }
}

if (not is_quilt($format)){
  dofile($changelog, $tardir, 'debian/changelog', $origtarfile) if defined $changelog;
} else {
  dofile_quilt($changelog, $quilt_debian_file, 'debian/changelog', $origtarfile) if defined $changelog
}

if ($tags->{'DEBTRANSFORM-FILES'}) {
  for my $file (split(' ', $tags->{'DEBTRANSFORM-FILES'})) {
    if (not is_quilt($format)){
      dofile("$dir/$file", $tardir, $file, $origtarfile);
    } else {
      dofile_quilt("$dir/$file", $quilt_debian_file, $file, $origtarfile);
    }
  }
}

for my $debtarfile (@debtarfiles) {
  if (not is_quilt($format)) {
    dotar("$dir/$debtarfile", $tardir, \%debtarorigin, $origtarfile, @{$debtarcontent{$debtarfile} });
  } else {
    dotar_quilt("$dir/$debtarfile", $quilt_debian_file, $origtarfile)
  }
}

for my $file (grep {/^debian\./} @dir) {
  next if $file eq 'debian.series';
  next if $file =~ /\.tar$/;
  next if $file =~ /\.tar\./;
  if (not is_quilt($format)){
    dofile("$dir/$file", $tardir, 'debian/'.substr($file, 7), $origtarfile);
  } else {
    my $in_tar_path = 'debian/'.substr($file, 7);
    dofile_quilt("$dir/$file", $quilt_debian_file, $in_tar_path, $origtarfile);
  }
}

if (not is_quilt($format)){
  if ($tags->{'DEBTRANSFORM-SERIES'}) {
    doseries("$dir/$tags->{'DEBTRANSFORM-SERIES'}", $tardir);
  } elsif ($dir{"debian.series"}) {
    doseries("$dir/debian.series", $tardir);
  } elsif ($dir{"patches.series"}) {
    doseries("$dir/patches.series", $tardir);
  }
} else {
  if ($tags->{'DEBTRANSFORM-SERIES'}) {
    doseries_quilt("$dir/$tags->{'DEBTRANSFORM-SERIES'}", $tardir, $quilt_debian_file, $origtarfile);
  } elsif ($dir{"debian.series"}) {
    doseries_quilt("$dir/debian.series", $tardir, $quilt_debian_file, $origtarfile);
  } elsif ($dir{"patches.series"}) {
    doseries_quilt("$dir/patches.series", $tardir, $quilt_debian_file, $origtarfile);
  }

}

if (not is_quilt($format)) {
  close(DIFF);
}

# Add file which indicate dpkg-source 3.0 (quilt) format
if (is_quilt($format)) {
  open my $fh, '>', "$dir/debian_source_format";
  print {$fh} $format . "\n";
  close $fh;
  dofile_quilt("$dir/debian_source_format", $quilt_debian_file, 'debian/source/format', $origtarfile);
  unlink "$dir/debian_source_format";
}

if (not is_quilt($format)){
  if (! -s "$out/${name}_$version.diff") {
    unlink("$out/${name}_$version.diff");
  } else {
    system('gzip', '-n9', "$out/${name}_$version.diff");
    if (-f "$out/${name}_$version.diff.gz") {
      push @files, addfile("$out/${name}_$version.diff.gz", "MD5");
      push @checksums_sha1, addfile("$out/${name}_$version.diff.gz", "SHA1");
      push @checksums_sha256, addfile("$out/${name}_$version.diff.gz", "SHA256");
    } else {
      push @files, addfile("$out/${name}_$version.diff", "MD5");
      push @checksums_sha1, addfile("$out/${name}_$version.diff", "SHA1");
      push @checksums_sha256, addfile("$out/${name}_$version.diff", "SHA256");
    }
  }
} else {
  system('gzip', '-n9', $quilt_debian_file);
  push @files, addfile("${quilt_debian_file}.gz", "MD5");
  push @checksums_sha1, addfile("${quilt_debian_file}.gz", "SHA1");
  push @checksums_sha256, addfile("${quilt_debian_file}.gz", "SHA256");
}


$tags->{'CHECKSUMS-SHA1'} = "\n".join("\n", @checksums_sha1);
$tags->{'CHECKSUMS-SHA256'} = "\n".join("\n", @checksums_sha256);
$tags->{'FILES'} = "\n".join("\n", @files);
delete $tags->{'DEBTRANSFORM-SERIES'};
delete $tags->{'DEBTRANSFORM-TAR'};
delete $tags->{'DEBTRANSFORM-FILES-TAR'};
delete $tags->{'DEBTRANSFORM-FILES'};
delete $tags->{'DEBTRANSFORM-RELEASE'};
delete $tags->{'OBS-DCH-RELEASE'};
writedsc("$out/${name}_$version.dsc", $tags);

if( $debug ) {
  print `ls -la $out`;
  print `cat $out/${name}_$version.dsc`;
  print `zcat $out/${name}_$version.diff.gz`;
}

exit(0);