view release on metacpan or  search on metacpan

lib/Dpkg/Source/Package/V1.pm  view on Meta::CPAN

        $expectprefix .= '.orig';

        if ($self->{options}{no_overwrite_dir} and -e $newdirectory) {
            error(g_('unpack target exists: %s'), $newdirectory);
        } else {
            erasedir($newdirectory);
        }
        if (-e $expectprefix) {
            rename($expectprefix, "$newdirectory.tmp-keep")
                or syserr(g_("unable to rename '%s' to '%s'"), $expectprefix,
                          "$newdirectory.tmp-keep");
        }

        info(g_('unpacking %s'), $tarfile);
        my $tar = Dpkg::Source::Archive->new(
            filename => File::Spec->catfile($self->{basedir}, $tarfile),
        );
        $tar->extract($expectprefix);

        if ($sourcestyle =~ /u/) {
            # -su: keep .orig directory unpacked.
            if (-e "$newdirectory.tmp-keep") {
                error(g_('unable to keep orig directory (already exists)'));
            }
            system('cp', '-RPp', '--', $expectprefix, "$newdirectory.tmp-keep");
            subprocerr("cp $expectprefix to $newdirectory.tmp-keep") if $?;
        }

        rename($expectprefix, $newdirectory)
            or syserr(g_('failed to rename newly-extracted %s to %s'),
                      $expectprefix, $newdirectory);

        # Rename the copied .orig directory.
        if (-e "$newdirectory.tmp-keep") {
            rename("$newdirectory.tmp-keep", $expectprefix)
                or syserr(g_('failed to rename saved %s to %s'),
                          "$newdirectory.tmp-keep", $expectprefix);
        }
    }

    if ($difffile and not $self->{options}{skip_debianization}) {
        my $patch = File::Spec->catfile($self->{basedir}, $difffile);
        info(g_('applying %s'), $difffile);
        my $patch_obj = Dpkg::Source::Patch->new(filename => $patch);
        my $analysis = $patch_obj->apply($newdirectory,
            force_timestamp => 1,
        );
        my @files = grep { ! m{^\Q$newdirectory\E/debian/} }
                    sort keys %{$analysis->{filepatched}};
        info(g_('upstream files that have been modified: %s'),
             "\n " . join("\n ", @files)) if scalar @files;

        # As the diff might not represent executable permissions, we need to
        # make sure debian/rules is executable if it exists. Otherwise the
        # debian-rules build driver will take care of the warnings.
        my $rules = File::Spec->catfile($newdirectory, 'debian', 'rules');
        my @s = lstat $rules;
        if (not scalar @s) {
            syserr(g_('cannot stat %s'), $rules) if $! != ENOENT;
        } elsif (-f _) {
            chmod $s[2] | 0o111, $rules
                or syserr(g_('cannot make %s executable'), $rules);
        } else {
            warning(g_('%s is not a plain file'), $rules);
        }
    }
}

sub can_build {
    my ($self, $dir) = @_;

    # As long as we can use gzip, we can do it as we have native packages as
    # fallback.
    return (0, g_('only supports gzip compression'))
        unless $self->{options}{compression} eq 'gzip';
    return 1;
}

sub do_build {
    my ($self, $dir) = @_;
    my $sourcestyle = $self->{options}{sourcestyle};
    my @argv = @{$self->{options}{ARGV}};
    my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}};
    my $diff_ignore_regex = $self->{options}{diff_ignore_regex};

    if (scalar(@argv) > 1) {
        usageerr(g_('-b takes at most a directory and an orig source ' .
                    'argument (with v1.0 source package)'));
    }

    $sourcestyle =~ y/X/a/;
    unless ($sourcestyle =~ m/[akpursnAKPUR]/) {
        usageerr(g_('source handling style -s%s not allowed with -b'),
                 $sourcestyle);
    }

    my $sourcepackage = $self->{fields}{'Source'};
    my $basenamerev = $self->get_basename(1);
    my $basename = $self->get_basename();
    my $basedirname = $self->get_basedirname();

    # Try to find a .orig tarball for the package.
    my $origdir = "$dir.orig";
    my $origtargz = $self->get_basename() . '.orig.tar.gz';
    if (-e $origtargz) {
        unless (-f $origtargz) {
            error(g_("packed orig '%s' exists but is not a plain file"), $origtargz);
        }
    } else {
        $origtargz = undef;
    }

    if (@argv) {
        # We have a second-argument <orig-dir> or <orig-targz>, check what it
        # is to decide the mode to use.
        my $origarg = shift(@argv);
        if (length($origarg)) {
            stat($origarg)
                or syserr(g_('cannot stat orig argument %s'), $origarg);
            if (-d _) {
                $origdir = File::Spec->catdir($origarg);

lib/Dpkg/Source/Package/V1.pm  view on Meta::CPAN

    }

    my ($tarname, $tardirname, $tardirbase);
    my $tarsign;
    if ($sourcestyle ne 'n') {
        my ($origdirname, $origdirbase) = fileparse($origdir);

        if ($origdirname ne "$basedirname.orig") {
            warning(g_('.orig directory name %s is not <package>' .
                       '-<upstreamversion> (wanted %s)'),
                    $origdirname, "$basedirname.orig");
        }
        $tardirbase = $origdirbase;
        $tardirname = $origdirname;

        $tarname = $origtargz || "$basename.orig.tar.gz";
        $tarsign = "$tarname.asc";
        unless ($tarname =~ /\Q$basename\E\.orig\.tar\.gz/) {
            warning(g_('.orig.tar name %s is not <package>_<upstreamversion>' .
                       '.orig.tar (wanted %s)'),
                    $tarname, "$basename.orig.tar.gz");
        }
    }

    if ($sourcestyle eq 'n') {
        # Initialize ARGV to ensure we have no error.
        $self->{options}{ARGV} = [];
        Dpkg::Source::Package::V3::Native::do_build($self, $dir);
    } elsif ($sourcestyle =~ m/[urUR]/) {
        if (stat($tarname)) {
            unless ($sourcestyle =~ m/[UR]/) {
                error(g_("tarfile '%s' already exists, not overwriting, " .
                         'giving up; use -sU or -sR to override'), $tarname);
            }
        } elsif ($! != ENOENT) {
            syserr(g_("unable to check for existence of '%s'"), $tarname);
        }

        info(g_('building %s in %s'),
             $sourcepackage, $tarname);

        my $newtar = File::Temp->new(
            TEMPLATE => "$tarname.new.XXXXXX",
            DIR => getcwd(),
            UNLINK => 0,
        );
        my $tar = Dpkg::Source::Archive->new(
            filename => $newtar,
            compression => compression_guess_from_filename($tarname),
            compression_level => $self->{options}{comp_level},
        );
        $tar->create(
            options => \@tar_ignore,
            chdir => $tardirbase,
        );
        $tar->add_directory($tardirname);
        $tar->finish();
        rename($newtar, $tarname)
            or syserr(g_("unable to rename '%s' (newly created) to '%s'"),
                      $newtar, $tarname);
        chmod(0o666 &~ umask(), $tarname)
            or syserr(g_("unable to change permission of '%s'"), $tarname);
    } else {
        info(g_('building %s using existing %s'),
             $sourcepackage, $tarname);
    }

    if ($tarname) {
        $self->add_file($tarname);
        if (-e "$tarname.sig" and not -e "$tarname.asc") {
            $self->armor_original_tarball_signature("$tarname.sig", "$tarname.asc");
        }
    }
    if ($tarsign and -e $tarsign) {
        $self->check_original_tarball_signature($dir, $tarsign);

        info(g_('building %s using existing %s'), $sourcepackage, $tarsign);
        $self->add_file($tarsign);
    } else {
        my $key = $self->get_upstream_signing_key($dir);
        if (-e $key) {
            warning(g_('upstream signing key but no upstream tarball signature'));
        }
    }

    if ($sourcestyle =~ m/[kpKP]/) {
        if (stat($origdir)) {
            unless ($sourcestyle =~ m/[KP]/) {
                error(g_("orig directory '%s' already exists, not overwriting, ".
                         'giving up; use -sA, -sK or -sP to override'),
                      $origdir);
            }
            erasedir($origdir);
        } elsif ($! != ENOENT) {
            syserr(g_("unable to check for existence of orig directory '%s'"),
                    $origdir);
        }

        my $tar = Dpkg::Source::Archive->new(filename => $origtargz);
        $tar->extract($origdir);
    }

    # Unrepresentable changes.
    my $ur;
    if ($sourcestyle =~ m/[kpursKPUR]/) {
        my $diffname = "$basenamerev.diff.gz";
        info(g_('building %s in %s'),
             $sourcepackage, $diffname);
        my $newdiffgz = File::Temp->new(
            TEMPLATE => "$diffname.new.XXXXXX",
            DIR => getcwd(),
            UNLINK => 0,
        );
        push_exit_handler(sub { unlink($newdiffgz) });
        my $diff = Dpkg::Source::Patch->new(
            filename => $newdiffgz,
            compression => 'gzip',
            compression_level => $self->{options}{comp_level},
        );
        $diff->create();
        $diff->add_diff_directory($origdir, $dir,
            basedirname => $basedirname,
            diff_ignore_regex => $diff_ignore_regex,
            # Force empty set of options to drop the default -p option.
            options => [],
        );

        $diff->finish() || $ur++;
        pop_exit_handler();

        my $analysis = $diff->analyze($origdir);
        my @files = grep { ! m{^debian/} }
                    map { s{^[^/]+/+}{}r }
                    sort keys %{$analysis->{filepatched}};
        if (scalar @files) {
            warning(g_('the diff modifies the following upstream files: %s'),
                    "\n " . join("\n ", @files));
            info(g_("use the '3.0 (quilt)' format to have separate and " .
                    'documented changes to upstream files, see dpkg-source(1)'));
            error(g_('aborting due to --abort-on-upstream-changes'))
                if $self->{options}{abort_on_upstream_changes};
        }

        rename($newdiffgz, $diffname)
            or syserr(g_("unable to rename '%s' (newly created) to '%s'"),
                      $newdiffgz, $diffname);
        chmod(0o666 &~ umask(), $diffname)
            or syserr(g_("unable to change permission of '%s'"), $diffname);

        $self->add_file($diffname);
    }

    if ($sourcestyle =~ m/[prPR]/) {
        erasedir($origdir);
    }

    if ($ur) {
        errormsg(g_('unrepresentable changes to source'));
        exit(1);
    }
}

=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut

1;