+2007-04-11 Guillem Jover <guillem@debian.org>
+
+ * scripts/dpkg-parsechangelog.pl: Use static and warnings. Declare
+ variables with 'my'.
+ * scripts/dpkg-scansources.pl: Likewise.
+ * scripts/controllib.pl: Likewise. Globals with 'our'.
+ * scripts/822-date.pl: Likewise.
+ * scripts/dpkg-architecture.pl: Likewise.
+ * scripts/dpkg-checkbuilddeps.pl: Likewise.
+ * scripts/dpkg-distaddfile.pl: Likewise.
+ * scripts/dpkg-genchanges.pl: Likewise.
+ * scripts/dpkg-gencontrol.pl: Likewise.
+ * scripts/dpkg-shlibdeps.pl: Likewise.
+ * scripts/dpkg-source.pl: Likewise.
+ * scripts/controllib.pl (parsecdata): Use 'my' instead of 'local'.
+ (subprocerr): Likewise.
+ (debian_arch_fix): Likewise.
+ * scripts/dpkg-architecture.pl (debian_to_gnu): Likewise.
+ (gnu_to_debian): Likewise.
+ * scripts/controllib.pl (getfowner): Remove redundant closures of
+ STDIN.
+
2007-04-11 Guillem Jover <guillem@debian.org>
* scripts/controllib.pl (@pkg_dep_fields): Reorder fields by
1.14.0
------
- * All perl scripts using strict and warnings, I've a patch already for this,
- just needs some review.
-
* Support udeb natively:
- Add field Package-Type and friends.
- Generate proper Packages files. (#383916)
* Do not bail out in dpkg when building without start-stop-daemon support,
by checking if the macro value is true instead of it being defined.
Thanks to Mark Rosenstand.
- * Make some perl scripts use static and warnings, to ease catching errors.
+ * Make all perl scripts use strict and warnings, to ease catching errors.
* Add a missing newline to a warning message in dpkg. Closes: #390914
Thanks to Ian Jackson.
* Fix typo in variable name in dpkg-source which was causing it to not
use strict;
use warnings;
-my $dpkglibdir = "."; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
push(@INC, $dpkglibdir);
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
# -v<version>
# changes since <version>
-$dpkglibdir= ".";
-$version= '1.3.0'; # This line modified by Makefile
+use strict;
+use warnings;
-$controlfile= 'debian/control';
-$changelogfile= 'debian/changelog';
-$fileslistfile= 'debian/files';
+our $progname;
+our $version = '1.3.0'; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
push(@INC,$dpkglibdir);
require 'controllib.pl';
+our %f;
+
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
-$progname= "parsechangelog/$progname";
-
-$since='';
+my $controlfile = 'debian/control';
+my $changelogfile = 'debian/changelog';
+my $fileslistfile = 'debian/files';
+my $since = '';
+my %mapkv = (); # XXX: for future use
my @changelog_fields = qw(Source Version Distribution Urgency Maintainer
Date Closes Changes);
+$progname = "parsechangelog/$progname";
+
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
}
}
-%mapkv=(); # for future use
-$i=1;grep($urgencies{$_}=$i++,
- qw(low medium high critical emergency));
+my %urgencies;
+my $i = 1;
+grep($urgencies{$_} = $i++, qw(low medium high critical emergency));
-$expect='first heading';
+my $expect = 'first heading';
+my $blanklines;
while (<STDIN>) {
s/\s*\n$//;
} else {
&clerror(sprintf(_g("found start of entry where expected %s"), $expect));
}
- $rhs= $'; $rhs =~ s/^\s+//;
- undef %kvdone;
- for $kv (split(/\s*,\s*/,$rhs)) {
+ my $rhs = $';
+ $rhs =~ s/^\s+//;
+ my %kvdone;
+ for my $kv (split(/\s*,\s*/, $rhs)) {
$kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
&clerror(sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
- $k=(uc substr($1,0,1)).(lc substr($1,1)); $v=$2;
+ my $k = (uc substr($1, 0, 1)).(lc substr($1, 1));
+ my $v = $2;
$kvdone{$k}++ && &clwarn(sprintf(_g("repeated key-value %s"), $k));
if ($k eq 'Urgency') {
$v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
&clerror(_g("badly formatted urgency value"));
- $newurg= lc $1;
- $newurgn= $urgencies{lc $1}; $newcomment= $2;
+
+ my $newurg = lc $1;
+ my $oldurg;
+ my $newurgn = $urgencies{lc $1};
+ my $oldurgn;
+ my $newcomment = $2;
+ my $oldcomment;
+
$newurgn ||
&clwarn(sprintf(_g("unknown urgency value %s - comparing very low"), $newurg));
if (defined($f{'Urgency'})) {
$f{'Changes'} =~ s/\n$//;
$f{'Changes'} =~ s/^/\n/;
+my @closes;
+
while ($f{'Changes'} =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig) {
push(@closes, $& =~ /\#?\s?(\d+)/g);
}
#!/usr/bin/perl
+use strict;
+use warnings;
+
use English;
+use POSIX qw(:errno_h);
+
+our $dpkglibdir;
-$dpkglibdir= "."; # This line modified by Makefile
push(@INC,$dpkglibdir);
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
-# Global variables:
-# $v - value parameter to function
-# $sourcepackage - name of sourcepackage
-# %fi - map of fields values. keys are of the form "S# key"
-# where S is source (L is changelog, C is control)
-# and # is an index
-# %p2i - map from datafile+packagename to index in controlfile
-# (used if multiple packages can be listed). Key is
-# "S key" where S is the source and key is the packagename
-# %substvar - map with substitution variables
+our $sourcepackage; # - name of sourcepackage
+our %f; # - fields ???
+our %fi; # - map of fields values. keys are of the form "S# key"
+ # where S is source (L is changelog, C is control)
+ # and # is an index
+our %fieldimps;
+our %p2i; # - map from datafile+packagename to index in controlfile
+ # (used if multiple packages can be listed). Key is
+ # "S key" where S is the source and key is the packagename
+
+my $maxsubsts = 50;
+our %substvar; # - map with substitution variables
-$parsechangelog= 'dpkg-parsechangelog';
+my $parsechangelog = 'dpkg-parsechangelog';
-@pkg_dep_fields = qw(Pre-Depends Depends Recommends Suggests Enhances
- Conflicts Replaces Provides);
-@src_dep_fields = qw(Build-Depends Build-Depends-Indep
- Build-Conflicts Build-Conflicts-Indep);
+our @pkg_dep_fields = qw(Pre-Depends Depends Recommends Suggests Enhances
+ Conflicts Replaces Provides);
+our @src_dep_fields = qw(Build-Depends Build-Depends-Indep
+ Build-Conflicts Build-Conflicts-Indep);
-$maxsubsts=50;
-$warnable_error= 1;
-$quiet_warnings = 0;
+our $warnable_error = 1;
+our $quiet_warnings = 0;
+
+our $version;
+our $progname = $0;
+$progname = $& if $progname =~ m,[^/]+$,;
-$progname= $0; $progname= $& if $progname =~ m,[^/]+$,;
sub getfowner
{
- $getlogin = getlogin();
+ my $getlogin = getlogin();
if (!defined($getlogin)) {
open(SAVEIN, "<&STDIN");
- close(STDIN);
open(STDIN, "<&STDERR");
$getlogin = getlogin();
}
if (!defined($getlogin)) {
open(SAVEIN, "<&STDIN");
- close(STDIN);
open(STDIN, "<&STDOUT");
$getlogin = getlogin();
close(SAVEIN);
}
+ my @fowner;
if (defined($ENV{'LOGNAME'})) {
@fowner = getpwnam($ENV{'LOGNAME'});
if (!@fowner) {
sub debian_arch_fix
{
- local ($os, $cpu) = @_;
+ my ($os, $cpu) = @_;
if ($os eq "linux") {
return $cpu;
sub substvars {
my ($v) = @_;
- my ($lhs,$vn,$rhs,$count);
- $count=0;
+ my $lhs;
+ my $vn;
+ my $rhs = '';
+ my $count = 0;
+
while ($v =~ m/\$\{([-:0-9a-z]+)\}/i) {
# If we have consumed more from the leftover data, then
# reset the recursive counter.
sub outputclose {
my ($varlistfile) = @_;
- for $f (keys %f) { $substvar{"F:$f"}= $f{$f}; }
+ for my $f (keys %f) {
+ $substvar{"F:$f"} = $f{$f};
+ }
&parsesubstvars($varlistfile) if (defined($varlistfile));
- for $f (sort sort_field_by_importance keys %f) {
- $v= $f{$f};
+ for my $f (sort sort_field_by_importance keys %f) {
+ my $v = $f{$f};
if (defined($varlistfile)) {
$v= &substvars($v);
}
sprintf(_g("control file %s"), $controlfile));
$indices >= 2 || &error(_g("control file must have at least one binary package part"));
- for ($i=1;$i<$indices;$i++) {
+ for (my $i = 1; $i < $indices; $i++) {
defined($fi{"C$i Package"}) ||
&error(sprintf(_g("per-package paragraph %d in control ".
"info file is missing Package line"),
$seen_arch=1;
next;
} elsif ($arch =~ /^!/) {
+ my $not_arch;
($not_arch = $arch) =~ s/^!//;
if (debian_arch_is($host_arch, $not_arch)) {
sub parsechangelog {
my ($changelogfile, $changelogformat, $since) = @_;
- defined($c=open(CDATA,"-|")) || &syserr(_g("fork for parse changelog"));
+ defined(my $c = open(CDATA, "-|")) || syserr(_g("fork for parse changelog"));
if ($c) {
binmode(CDATA);
parsecdata(\*CDATA, 'L', 0, _g("parsed version of changelog"));
$? && subprocerr(_g("parse changelog"));
} else {
binmode(STDOUT);
- @al=($parsechangelog);
+ my @al = ($parsechangelog);
push(@al,"-l$changelogfile");
push(@al, "-F$changelogformat") if defined($changelogformat);
push(@al, "-v$since") if defined($since);
$substvar{'source:Upstream-Version'} = $fi{"L Version"};
$substvar{'source:Upstream-Version'} =~ s/-[^-]*$//;
+ # FIXME: this needs all progs using controllib to set $version as 'our'.
# We expect the calling program to set $version.
$substvar{"dpkg:Version"} = $version;
$substvar{"dpkg:Upstream-Version"} = $version;
return $md5sum;
}
+# XXX: Should not be a global!!
+my $whatmsg;
+
sub parsecdata {
- local ($cdata, $source, $many, $whatmsg) = @_;
+ my ($cdata, $source, $many);
+ ($cdata, $source, $many, $whatmsg) = @_;
+
# many=0: ordinary control data like output from dpkg-parsechangelog
# many=1: many paragraphs like in source control file
# many=-1: single paragraph of control data optionally signed
- local ($index,$cf,$paraborder);
- $index=''; $cf=''; $paraborder=1;
+
+ my $index = '';
+ my $cf = '';
+ my $paraborder = 1;
+
while (<$cdata>) {
s/\s*\n$//;
next if (m/^$/ and $paraborder);
next if (m/^#/);
$paraborder=0;
if (m/^(\S+)\s*:\s*(.*)$/) {
- $cf=$1; $v=$2;
+ $cf = $1;
+ my $v = $2;
$cf= &capit($cf);
$fi{"$source$index $cf"}= $v;
$fi{"o:$source$index $cf"}= $1;
}
sub subprocerr {
- local ($p) = @_;
+ my ($p) = @_;
require POSIX;
if (POSIX::WIFEXITED($?)) {
die sprintf(_g("%s: failure: %s gave error exit status %s"),
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-$version="1.0.0"; # This line modified by Makefile
+use strict;
+use warnings;
+
+our $progname;
+our $version = "1.0.0"; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
-$dpkglibdir = ".";
push(@INC,$dpkglibdir);
require 'controllib.pl';
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
-$pkgdatadir = "..";
+my $pkgdatadir = "..";
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
"), $progname;
}
+my (@cpu, @os);
+my (%cputable, %ostable);
+my (%cputable_re, %ostable_re);
+
sub read_cputable {
open CPUTABLE, "$pkgdatadir/cputable"
or &syserr(_g("unable to open cputable"));
}
sub debian_to_gnu {
- local ($arch) = @_;
- local ($os, $cpu) = &split_debian($arch);
+ my ($arch) = @_;
+ my ($os, $cpu) = split_debian($arch);
return undef unless exists($cputable{$cpu}) && exists($ostable{$os});
return join("-", $cputable{$cpu}, $ostable{$os});
}
sub gnu_to_debian {
- local ($gnu) = @_;
- local ($cpu, $os);
- local ($a);
+ my ($gnu) = @_;
+ my ($cpu, $os);
- local ($gnu_cpu, $gnu_os) = &split_gnu($gnu);
- foreach $_cpu (@cpu) {
+ my ($gnu_cpu, $gnu_os) = split_gnu($gnu);
+ foreach my $_cpu (@cpu) {
if ($gnu_cpu =~ /^$cputable_re{$_cpu}$/) {
$cpu = $_cpu;
last;
}
}
- foreach $_os (@os) {
+ foreach my $_os (@os) {
if ($gnu_os =~ /^(.*-)?$ostable_re{$_os}$/) {
$os = $_os;
last;
# Check for -L
if (grep { m/^-L$/ } @ARGV) {
- foreach $os (@os) {
- foreach $cpu (@cpu) {
+ foreach my $os (@os) {
+ foreach my $cpu (@cpu) {
print debian_arch_fix($os, $cpu)."\n";
}
}
# Set default values:
-chomp ($deb_build_arch = `dpkg --print-architecture`);
+chomp (my $deb_build_arch = `dpkg --print-architecture`);
&syserr("dpkg --print-architecture failed") if $?>>8;
-$deb_build_gnu_type = &debian_to_gnu($deb_build_arch);
+my $deb_build_gnu_type = debian_to_gnu($deb_build_arch);
# Default host: Current gcc.
-$gcc = `\${CC:-gcc} -dumpmachine`;
+my $gcc = `\${CC:-gcc} -dumpmachine`;
if ($?>>8) {
warning(_g("Couldn't determine gcc system type, falling back to default (native compilation)"));
$gcc = '';
chomp $gcc;
}
+my $deb_host_arch = undef;
+my $deb_host_gnu_type;
+
if ($gcc ne '') {
$deb_host_arch = &gnu_to_debian($gcc);
unless (defined $deb_host_arch) {
}
-$req_host_arch = '';
-$req_host_gnu_type = '';
-$req_build_gnu_type = '';
-$req_eq_arch = '';
-$req_is_arch = '';
-$action='l';
-$force=0;
+my $req_host_arch = '';
+my $req_host_gnu_type = '';
+my $req_build_gnu_type = '';
+my $req_eq_arch = '';
+my $req_is_arch = '';
+my $req_variable_to_print;
+my $action = 'l';
+my $force = 0;
while (@ARGV) {
$_=shift(@ARGV);
}
if ($req_host_gnu_type ne '' && $req_host_arch ne '') {
- $dfl_host_gnu_type = &debian_to_gnu ($req_host_arch);
+ my $dfl_host_gnu_type = debian_to_gnu($req_host_arch);
warning(sprintf(_g("Default GNU system type %s for Debian arch %s does not match specified GNU system type %s"), $dfl_host_gnu_type, $req_host_arch, $req_host_gnu_type)) if $dfl_host_gnu_type ne $req_host_gnu_type;
}
warning(sprintf(_g("Specified GNU system type %s does not match gcc system type %s."), $deb_host_gnu_type, $gcc)) if !($req_is_arch or $req_eq_arch) && ($gcc ne '') && ($gcc ne $deb_host_gnu_type);
# Split the Debian and GNU names
-($deb_host_arch_os, $deb_host_arch_cpu) = &split_debian($deb_host_arch);
-($deb_build_arch_os, $deb_build_arch_cpu) = &split_debian($deb_build_arch);
-($deb_host_gnu_cpu, $deb_host_gnu_system) = &split_gnu($deb_host_gnu_type);
-($deb_build_gnu_cpu, $deb_build_gnu_system) = &split_gnu($deb_build_gnu_type);
+my ($deb_host_arch_os, $deb_host_arch_cpu) = split_debian($deb_host_arch);
+my ($deb_build_arch_os, $deb_build_arch_cpu) = split_debian($deb_build_arch);
+my ($deb_host_gnu_cpu, $deb_host_gnu_system) = split_gnu($deb_host_gnu_type);
+my ($deb_build_gnu_cpu, $deb_build_gnu_system) = split_gnu($deb_build_gnu_type);
-%env = ();
+my %env = ();
if (!$force) {
$deb_build_arch = $ENV{DEB_BUILD_ARCH} if (exists $ENV{DEB_BUILD_ARCH});
$deb_build_arch_os = $ENV{DEB_BUILD_ARCH_OS} if (exists $ENV{DEB_BUILD_ARCH_OS});
$deb_host_gnu_type = $ENV{DEB_HOST_GNU_TYPE} if (exists $ENV{DEB_HOST_GNU_TYPE});
}
-@ordered = qw(DEB_BUILD_ARCH DEB_BUILD_ARCH_OS DEB_BUILD_ARCH_CPU
- DEB_BUILD_GNU_CPU DEB_BUILD_GNU_SYSTEM DEB_BUILD_GNU_TYPE
- DEB_HOST_ARCH DEB_HOST_ARCH_OS DEB_HOST_ARCH_CPU
- DEB_HOST_GNU_CPU DEB_HOST_GNU_SYSTEM DEB_HOST_GNU_TYPE);
+my @ordered = qw(DEB_BUILD_ARCH DEB_BUILD_ARCH_OS DEB_BUILD_ARCH_CPU
+ DEB_BUILD_GNU_CPU DEB_BUILD_GNU_SYSTEM DEB_BUILD_GNU_TYPE
+ DEB_HOST_ARCH DEB_HOST_ARCH_OS DEB_HOST_ARCH_CPU
+ DEB_HOST_GNU_CPU DEB_HOST_GNU_SYSTEM DEB_HOST_GNU_TYPE);
$env{'DEB_BUILD_ARCH'}=$deb_build_arch;
$env{'DEB_BUILD_ARCH_OS'}=$deb_build_arch_os;
$env{'DEB_HOST_GNU_TYPE'}=$deb_host_gnu_type;
if ($action eq 'l') {
- foreach $k (@ordered) {
+ foreach my $k (@ordered) {
print "$k=$env{$k}\n";
}
} elsif ($action eq 's') {
- foreach $k (@ordered) {
+ foreach my $k (@ordered) {
print "$k=$env{$k}; ";
}
print "export ".join(" ",@ordered)."\n";
#!/usr/bin/perl
# GPL copyright 2001 by Joey Hess <joeyh@debian.org>
-#use strict;
+use strict;
+use warnings;
+
+our $progname;
+our $dpkglibdir = "/usr/lib/dpkg"; # This line modified by Makefile
+
use Getopt::Long;
-my $dpkglibdir="/usr/lib/dpkg";
my $admindir = "/var/lib/dpkg";
push(@INC,$dpkglibdir);
require 'controllib.pl';
+our %fi;
+
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
#!/usr/bin/perl
-$dpkglibdir= ".";
-$version= '1.3.0'; # This line modified by Makefile
+use strict;
+use warnings;
+
+our $progname;
+our $version = '1.3.0'; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
use POSIX;
use POSIX qw(:errno_h :signal_h);
-$fileslistfile= 'debian/files';
-
push(@INC,$dpkglibdir);
require 'controllib.pl';
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
+my $fileslistfile = 'debian/files';
+
+
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
}
@ARGV==3 || &usageerr(_g("need exactly a filename, section and priority"));
-($file,$section,$priority)= @ARGV;
+my ($file, $section, $priority) = @ARGV;
($file =~ m/\s/ || $section =~ m/\s/ || $priority =~ m/\s/) &&
&error(_g("filename, section and priority may contain no whitespace"));
#!/usr/bin/perl
-$dpkglibdir= "."; # This line modified by Makefile
-$version= '1.3.0'; # This line modified by Makefile
-
-$controlfile= 'debian/control';
-$changelogfile= 'debian/changelog';
-$fileslistfile= 'debian/files';
-$varlistfile= 'debian/substvars';
-$uploadfilesdir= '..';
-$sourcestyle= 'i';
-$quiet= 0;
-
-# Other global variables used:
-# %f2p - file to package map
-# %p2f - package to file map
-# has entries for both "packagename" and "packagename architecture"
-# %p2ver - package to version map
-# %f2sec - file to section map
-# %f2pri - file to priority map
-# %sourcedefault - default values as taken from source (used for Section,
-# Priority and Maintainer)
-# $changedby - person who created this package (as listed in changelog)
+use strict;
+use warnings;
+
+our $progname;
+our $version = '1.3.0'; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
use POSIX;
use POSIX qw(:errno_h :signal_h);
push(@INC,$dpkglibdir);
require 'controllib.pl';
+our (%f, %fi);
+our %p2i;
+our %fieldimps;
+our %substvar;
+our $sourcepackage;
+our $host_arch;
+
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
Distribution Urgency Maintainer Changed-By
Description Closes Changes Files);
+my $controlfile = 'debian/control';
+my $changelogfile = 'debian/changelog';
+my $changelogformat;
+my $fileslistfile = 'debian/files';
+my $varlistfile = 'debian/substvars';
+my $uploadfilesdir = '..';
+my $sourcestyle = 'i';
+my $quiet = 0;
+
+my %f2p; # - file to package map
+my %p2f; # - package to file map, has entries for both "packagename"
+ # and "packagename architecture"
+my %p2ver; # - package to version map
+my %p2arch;
+my %f2sec; # - file to section map
+my %f2seccf;
+my %f2pri; # - file to priority map
+my %f2pricf;
+my %sourcedefault; # - default values as taken from source (used for Section,
+ # Priority and Maintainer)
+
+my @descriptions;
+my @sourcefiles;
+my @fileslistfiles;
+
+my %md5sum; # - md5sum to file map
+my %remove; # - fields to remove
+my %override;
+my %archadded;
+my @archvalues;
+my $dsc;
+my $changesdescription;
+my $sourceonly;
+my $binaryonly;
+my $archspecific;
+my $forcemaint;
+my $forcechangedby;
+my $since;
+
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
}
for $_ (keys %fi) {
- $v= $fi{$_};
+ my $v = $fi{$_};
+
if (s/^C //) {
if (m/^Source$/) {
setsourcepackage($v);
elsif (m/|^X[BS]+-|^Standards-Version$/i) { }
else { &unknown(_g('general section of control info file')); }
} elsif (s/^C(\d+) //) {
+ my $i = $1;
+ my $p = $fi{"C$i Package"};
+ my $a = $fi{"C$i Architecture"};
my $host_arch = get_host_arch();
- $i=$1; $p=$fi{"C$i Package"}; $a=$fi{"C$i Architecture"};
+
if (!defined($p2f{$p}) && not $sourceonly) {
if ((debian_arch_eq('all', $a) && !$archspecific) ||
debian_arch_is($host_arch, $a) ||
next;
}
} else {
+ my $f = $p2f{$p};
$p2arch{$p}=$a;
- $f=$p2f{$p};
+
if (m/^Description$/) {
$v=$` if $v =~ m/\n/;
if ($f =~ m/\.udeb$/) {
}
}
-for $p (keys %p2f) {
+for my $p (keys %p2f) {
my ($pp, $aa) = (split / /, $p);
defined($p2i{"C $pp"}) ||
warning(sprintf(_g("package %s listed in files list but not in control info"), $pp));
}
-for $p (keys %p2f) {
- $f= $p2f{$p};
- $sec = $f2seccf{$f};
+for my $p (keys %p2f) {
+ my $f = $p2f{$p};
+
+ my $sec = $f2seccf{$f};
$sec = $sourcedefault{'Section'} if !defined($sec);
if (!defined($sec)) {
$sec = '-';
$sec eq $f2sec{$f} || &error(sprintf(_g("package %s has section %s in ".
"control file but %s in files list"),
$p, $sec, $f2sec{$f}));
- $pri = $f2pricf{$f};
+ my $pri = $f2pricf{$f};
$pri = $sourcedefault{'Priority'} if !defined($pri);
if (!defined($pri)) {
$pri = '-';
&init_substvars;
init_substvar_arch();
+my $origsrcmsg;
+
if (!$binaryonly) {
- $sec= $sourcedefault{'Section'};
+ my $sec = $sourcedefault{'Section'};
if (!defined($sec)) {
$sec = '-';
warning(_g("missing Section for source files"));
}
- $pri= $sourcedefault{'Priority'};
+ my $pri = $sourcedefault{'Priority'};
if (!defined($pri)) {
$pri = '-';
warning(_g("missing Priority for source files"));
}
- ($sversion = $substvar{'source:Version'}) =~ s/^\d+://;
+ (my $sversion = $substvar{'source:Version'}) =~ s/^\d+://;
$dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
open(CDATA,"< $dsc") || &error(sprintf(_g("cannot open .dsc file %s: %s"), $dsc, $!));
push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
- $files= $fi{'S Files'};
- for $file (split(/\n /,$files)) {
+ my $files = $fi{'S Files'};
+ for my $file (split(/\n /, $files)) {
next if $file eq '';
$file =~ m/^([0-9a-f]{32})[ \t]+\d+[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
|| &error(sprintf(_g("Files field contains bad line \`%s'"), $file));
($md5sum{$2},$file) = ($1,$2);
push(@sourcefiles,$file);
}
- for $f (@sourcefiles) { $f2sec{$f}= $sec; $f2pri{$f}= $pri; }
-
+ for my $f (@sourcefiles) {
+ $f2sec{$f} = $sec;
+ $f2pri{$f} = $pri;
+ }
+
if (($sourcestyle =~ m/i/ && $sversion !~ m/-(0|1|0\.1)$/ ||
$sourcestyle =~ m/d/) &&
grep(m/\.diff\.gz$/,@sourcefiles)) {
$f{'Format'}= $substvar{'Format'};
if (!defined($f{'Date'})) {
- chop($date822=`date -R`); $? && subprocerr("date -R");
+ chop(my $date822 = `date -R`);
+ $? && subprocerr("date -R");
$f{'Date'}= $date822;
}
$f{'Description'}= "\n ".join("\n ",sort @descriptions);
$f{'Files'}= '';
-for $f (@sourcefiles,@fileslistfiles) {
+
+my %filedone;
+
+for my $f (@sourcefiles, @fileslistfiles) {
next if ($archspecific && debian_arch_eq('all', $p2arch{$f2p{$f}}));
next if $filedone{$f}++;
- $uf= "$uploadfilesdir/$f";
+ my $uf = "$uploadfilesdir/$f";
open(STDIN,"< $uf") || &syserr(sprintf(_g("cannot open upload file %s for reading"), $uf));
- (@s=stat(STDIN)) || &syserr(sprintf(_g("cannot fstat upload file %s"), $uf));
- $size= $s[7]; $size || warning(sprintf(_g("upload file %s is empty"), $uf));
- $md5sum=`md5sum`; $? && subprocerr(sprintf(_g("md5sum upload file %s"), $uf));
+ (my @s = stat(STDIN)) || syserr(sprintf(_g("cannot fstat upload file %s"), $uf));
+ my $size = $s[7];
+ $size || warn(sprintf(_g("upload file %s is empty"), $uf));
+ my $md5sum = `md5sum`;
+ $? && subprocerr(sprintf(_g("md5sum upload file %s"), $uf));
$md5sum =~ m/^([0-9a-f]{32})\s*-?\s*$/i ||
&failure(sprintf(_g("md5sum upload file %s gave strange output \`%s'"), $uf, $md5sum));
$md5sum= $1;
$f{'Maintainer'} = $forcemaint if defined($forcemaint);
$f{'Changed-By'} = $forcechangedby if defined($forcechangedby);
-for $f (qw(Version Distribution Maintainer Changes)) {
+for my $f (qw(Version Distribution Maintainer Changes)) {
defined($f{$f}) || &error(sprintf(_g("missing information for critical output field %s"), $f));
}
-for $f (qw(Urgency)) {
+for my $f (qw(Urgency)) {
defined($f{$f}) || warning(sprintf(_g("missing information for output field %s"), $f));
}
-for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
-for $f (keys %remove) { delete $f{&capit($f)}; }
+for my $f (keys %override) {
+ $f{capit($f)} = $override{$f};
+}
+for my $f (keys %remove) {
+ delete $f{capit($f)};
+}
set_field_importance(@changes_fields);
outputclose();
#!/usr/bin/perl
-$dpkglibdir= "."; # This line modified by Makefile
-$version= '1.3.0'; # This line modified by Makefile
+use strict;
+use warnings;
-$controlfile= 'debian/control';
-$changelogfile= 'debian/changelog';
-$fileslistfile= 'debian/files';
-$varlistfile= 'debian/substvars';
-$packagebuilddir= 'debian/tmp';
+our $dpkglibdir = "."; # This line modified by Makefile
+our $version = '1.3.0'; # This line modified by Makefile
use POSIX;
use POSIX qw(:errno_h);
push(@INC,$dpkglibdir);
require 'controllib.pl';
+our $progname;
+our %substvar;
+our (%f, %fi);
+our %fieldimps;
+our %p2i;
+our @pkg_dep_fields;
+our $sourcepackage;
+our $host_arch;
+
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
Bugs Maintainer Installed-Size), @pkg_dep_fields,
qw(Section Priority Description));
+my $controlfile = 'debian/control';
+my $changelogfile = 'debian/changelog';
+my $changelogformat;
+my $fileslistfile = 'debian/files';
+my $varlistfile = 'debian/substvars';
+my $packagebuilddir = 'debian/tmp';
+
+my $sourceversion;
+my $forceversion;
+my $forcefilename;
+my $stdout;
+my %remove;
+my %override;
+my (%spvalue, %spdefault);
+my $oppackage;
+
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
parsesubstvars($varlistfile);
parsecontrolfile($controlfile);
+my $myindex;
+
if (defined($oppackage)) {
defined($p2i{"C $oppackage"}) || &error(sprintf(_g("package %s not in control info"), $oppackage));
$myindex= $p2i{"C $oppackage"};
} else {
- @packages= grep(m/^C /,keys %p2i);
+ my @packages = grep(m/^C /, keys %p2i);
@packages==1 ||
&error(sprintf(_g("must specify package since control info has many (%s)"), "@packages"));
$myindex=1;
my %pkg_dep_fields = map { $_ => 1 } @pkg_dep_fields;
for $_ (keys %fi) {
- $v= $fi{$_};
+ my $v = $fi{$_};
+
if (s/^C //) {
#print STDERR "G key >$_< value >$v<\n";
if (m/^(Origin|Bugs|Maintainer)$/) {
} elsif (debian_arch_is($host_arch, $v)) {
$f{$_} = $host_arch;
} else {
- @archlist= split(/\s+/,$v);
+ my @archlist = split(/\s+/, $v);
my @invalid_archs = grep m/[^\w-]/, @archlist;
warning(sprintf(ngettext(
"`%s' is not a legal architecture string.",
init_substvar_arch();
for $_ (keys %fi) {
- $v= $fi{$_};
+ my $v = $fi{$_};
+
if (s/^C //) {
} elsif (s/^C$myindex //) {
if (m/^(Package|Description|Essential|Optional)$/) {
}
-for $f (qw(Section Priority)) {
+for my $f (qw(Section Priority)) {
$spvalue{$f} = $spdefault{$f} unless defined($spvalue{$f});
$f{$f} = $spvalue{$f} if defined($spvalue{$f});
}
-for $f (qw(Package Version)) {
+for my $f (qw(Package Version)) {
defined($f{$f}) || &error(sprintf(_g("missing information for output field %s"), $f));
}
-for $f (qw(Maintainer Description Architecture)) {
+for my $f (qw(Maintainer Description Architecture)) {
defined($f{$f}) || warning(sprintf(_g("missing information for output field %s"), $f));
}
$oppackage= $f{'Package'};
-$verdiff = $f{'Version'} ne $substvar{'source:Version'} or
- $f{'Version'} ne $sourceversion;
+my $verdiff = $f{'Version'} ne $substvar{'source:Version'} ||
+ $f{'Version'} ne $sourceversion;
if ($oppackage ne $sourcepackage || $verdiff) {
$f{'Source'}= $sourcepackage;
$f{'Source'}.= " ($substvar{'source:Version'})" if $verdiff;
}
if (!defined($substvar{'Installed-Size'})) {
- defined($c= open(DU,"-|")) || &syserr(_g("fork for du"));
+ defined(my $c = open(DU, "-|")) || syserr(_g("fork for du"));
if (!$c) {
chdir("$packagebuilddir") || &syserr(sprintf(_g("chdir for du to \`%s'"), $packagebuilddir));
exec("du","-k","-s",".") or &syserr(_g("exec du"));
}
- $duo=''; while (<DU>) { $duo.=$_; }
+ my $duo = '';
+ while (<DU>) {
+ $duo .= $_;
+ }
close(DU); $? && &subprocerr(sprintf(_g("du in \`%s'"), $packagebuilddir));
$duo =~ m/^(\d+)\s+\.$/ || &failure(sprintf(_g("du gave unexpected output \`%s'"), $duo));
$substvar{'Installed-Size'}= $1;
$f{'Installed-Size'}= $substvar{'Installed-Size'};
}
-for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
-for $f (keys %remove) { delete $f{&capit($f)}; }
+for my $f (keys %override) {
+ $f{capit($f)} = $override{$f};
+}
+for my $f (keys %remove) {
+ delete $f{capit($f)};
+}
$fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
} elsif ($! != ENOENT) {
&syserr(_g("read old files list file"));
}
-$sversion=$f{'Version'};
+my $sversion = $f{'Version'};
$sversion =~ s/^\d+://;
$forcefilename=sprintf("%s_%s_%s.deb", $oppackage,$sversion,$f{'Architecture'})
unless ($forcefilename);
close(Y) || &syserr(_g("close new files list file"));
rename("$fileslistfile.new",$fileslistfile) || &syserr(_g("install new files list file"));
+my $cf;
if (!$stdout) {
$cf= "$packagebuilddir/DEBIAN/control";
$cf= "./$cf" if $cf =~ m/^\s/;
}
sub spfileslistvalue {
- $r= $spvalue{$_[0]};
+ my $r = $spvalue{$_[0]};
$r = '-' if !defined($r);
return $r;
}
#!/usr/bin/perl
-$dpkglibdir= "/usr/lib/dpkg";
-$version= '1.3.0'; # This line modified by Makefile
+use strict;
+use warnings;
-$format='debian';
-$changelogfile='debian/changelog';
-@parserpath= ("/usr/local/lib/dpkg/parsechangelog",
- "$dpkglibdir/parsechangelog");
+our $progname;
+our $version = '1.3.0'; # This line modified by Makefile
+our $dpkglibdir = "/usr/lib/dpkg"; # This line modified by Makefile
use POSIX;
use POSIX qw(:errno_h);
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
+my $format ='debian';
+my $changelogfile = 'debian/changelog';
+my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
+ "$dpkglibdir/parsechangelog");
+
+my $libdir; # XXX: Not used!?
+my $force;
+
+
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
"), $progname;
}
-@ap=();
+my @ap = ();
while (@ARGV) {
last unless $ARGV[0] =~ m/^-/;
$_= shift(@ARGV);
close(P); $? && &subprocerr(sprintf(_g("tail of %s"), $changelogfile));
}
+my ($pa, $pf);
-for $pd (@parserpath) {
+for my $pd (@parserpath) {
$pa= "$pd/$format";
if (!stat("$pa")) {
$! == ENOENT || &syserr(sprintf(_g("failed to check for format parser %s"), $pa));
-#!/usr/bin/perl -w
-use strict;
-
+#!/usr/bin/perl
+#
# $Id$
-
+#
# Copyright 1999 Roderick Schertler
# Copyright 2002 Wichert Akkerman <wakkerma@debian.org>
#
# Proc::WaitStat modules.
+use strict;
+use warnings;
+
my $dpkglibdir= "."; # This line modified by Makefile
push(@INC,$dpkglibdir);
require 'dpkg-gettext.pl';
# dpkg-shlibdeps
# $Id$
-my $dpkglibdir="/usr/lib/dpkg";
+use strict;
+use warnings;
+
+our $progname;
+our $version = "1.4.1.19"; # This line modified by Makefile
+our $dpkglibdir = "/usr/lib/dpkg";
my $admindir = "/var/lib/dpkg";
-my $version="1.4.1.19"; # This line modified by Makefile
use English;
use POSIX qw(:errno_h :signal_h);
#! /usr/bin/perl
-my $dpkglibdir = ".";
-my $version = "1.3.0"; # This line modified by Makefile
+use strict;
+use warnings;
+
+our $progname;
+our $version = "1.3.0"; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
my @filesinarchive;
my %dirincluded;
my %notfileobject;
my $fn;
+my $ur;
+
+my $varlistfile;
+my $controlfile;
+my $changelogfile;
+my $changelogformat;
-$diff_ignore_default_regexp = '
+my $diff_ignore_regexp = '';
+my $diff_ignore_default_regexp = '
# Ignore general backup files
(?:^|/).*~$|
# Ignore emacs recovery files
$diff_ignore_default_regexp =~ s/^#.*$//mg;
$diff_ignore_default_regexp =~ s/\n//sg;
-$sourcestyle = 'X';
-$min_dscformat = 1;
-$max_dscformat = 2;
-$def_dscformat = "1.0"; # default format for -b
+my $sourcestyle = 'X';
+my $min_dscformat = 1;
+my $max_dscformat = 2;
+my $def_dscformat = "1.0"; # default format for -b
+
+my $expectprefix;
+
+# Packages
+my %remove;
+my %override;
+
+# Files
+my %md5sum;
+my %size;
+my %type; # used by checktype
+my %filepatched; # used by checkdiff
+my %dirtocreate; # used by checkdiff
+
+my @tar_ignore;
use POSIX;
use Fcntl qw (:mode);
use File::Temp qw (tempfile);
use Cwd;
-use strict 'refs';
-
push (@INC, $dpkglibdir);
require 'controllib.pl';
+our (%f, %fi, %fieldimps);
+our $sourcepackage;
+our $warnable_error;
+our $quiet_warnings;
+our %substvar;
+our @src_dep_fields;
+
require 'dpkg-gettext.pl';
textdomain("dpkg-dev");
}
+my $opmode;
+
while (@ARGV && $ARGV[0] =~ m/^-/) {
$_=shift(@ARGV);
if (m/^-b$/) {
@ARGV || &usageerr(_g("-b needs a directory"));
@ARGV<=2 || &usageerr(_g("-b takes at most a directory and an orig source argument"));
- $dir= shift(@ARGV);
+ my $dir = shift(@ARGV);
$dir= "./$dir" unless $dir =~ m:^/:; $dir =~ s,/*$,,;
stat($dir) || &error(sprintf(_g("cannot stat directory %s: %s"), $dir, $!));
-d $dir || &error(sprintf(_g("directory argument %s is not a directory"), $dir));
$f{"Format"}=$def_dscformat;
&init_substvars;
- $archspecific=0;
+ my @sourcearch;
+ my $archspecific = 0; # XXX: Not used?!
+ my %packageadded;
+ my @binarypackages;
+
for $_ (keys %fi) {
- $v= $fi{$_};
+ my $v = $fi{$_};
+
if (s/^C //) {
if (m/^Source$/i) {
setsourcepackage($v);
elsif (m/^(Section|Priority|Files|Bugs)$/i || m/^X[BC]+-/i) { }
else { &unknown(_g('general section of control info file')); }
} elsif (s/^C(\d+) //) {
- $i=$1; $p=$fi{"C$i Package"};
+ my $i = $1;
+ my $p = $fi{"C$i Package"};
push(@binarypackages,$p) unless $packageadded{$p}++;
if (m/^Architecture$/) {
if (debian_arch_eq($v, 'any')) {
@sourcearch= ('any');
}
} else {
- if (grep($sourcearch[0] eq $_, 'any','all')) {
+ if (@sourcearch && grep($sourcearch[0] eq $_, 'any', 'all')) {
@sourcearch= ('any');
} else {
- for $a (split(/\s+/, $v)) {
+ my %archadded;
+
+ for my $a (split(/\s+/, $v)) {
&error(sprintf(_g("`%s' is not a legal architecture string"), $a))
unless $a =~ /^[\w-]+$/;
&error(sprintf(_g("architecture %s only allowed on its own".
}
$f{'Binary'}= join(', ',@binarypackages);
- for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
+ for my $f (keys %override) {
+ $f{capit($f)} = $override{$f};
+ }
- for $f (qw(Version)) {
+ for my $f (qw(Version)) {
defined($f{$f}) || &error(sprintf(_g("missing information for critical output field %s"), $f));
}
- for $f (qw(Maintainer Architecture Standards-Version)) {
+ for my $f (qw(Maintainer Architecture Standards-Version)) {
defined($f{$f}) ||
warning(sprintf(_g("missing information for output field %s"), $f));
}
defined($sourcepackage) || &error(_g("unable to determine source package name !"));
$f{'Source'}= $sourcepackage;
- for $f (keys %remove) { delete $f{&capit($f)}; }
+ for my $f (keys %remove) {
+ delete $f{capit($f)};
+ }
- $version= $f{'Version'};
- $version =~ s/^\d+://; $upstreamversion= $version; $upstreamversion =~ s/-[^-]*$//;
- $basenamerev= $sourcepackage.'_'.$version;
- $basename= $sourcepackage.'_'.$upstreamversion;
- $basedirname= $basename;
+ my $version = $f{'Version'};
+ $version =~ s/^\d+://;
+ my $upstreamversion = $version;
+ $upstreamversion =~ s/-[^-]*$//;
+ my $basenamerev = $sourcepackage.'_'.$version;
+ my $basename = $sourcepackage.'_'.$upstreamversion;
+ my $basedirname = $basename;
$basedirname =~ s/_/-/;
- $origdir= "$dir.orig";
- $origtargz= "$basename.orig.tar.gz";
+ my $origdir = "$dir.orig";
+ my $origtargz = "$basename.orig.tar.gz";
if (@ARGV) {
- $origarg= shift(@ARGV);
+ my $origarg = shift(@ARGV);
if (length($origarg)) {
stat($origarg) || &error(sprintf(_g("cannot stat orig argument %s: %s"), $origarg, $!));
if (-d _) {
$sourcestyle =~ y/aA/nn/;
}
}
- $dirbase= $dir; $dirbase =~ s,/?$,,; $dirbase =~ s,[^/]+$,,; $dirname= $&;
+
+ my $dirbase = $dir;
+ $dirbase =~ s,/?$,,;
+ $dirbase =~ s,[^/]+$,,;
+ my $dirname = $&;
$dirname eq $basedirname ||
warning(sprintf(_g("source directory '%s' is not <sourcepackage>" .
"-<upstreamversion> '%s'"), $dir, $basedirname));
+ my $tarname;
+ my $tardirname;
+ my $tardirbase;
+ my $origdirname;
+
if ($sourcestyle ne 'n') {
- $origdirbase= $origdir; $origdirbase =~ s,/?$,,;
+ my $origdirbase = $origdir;
+ $origdirbase =~ s,/?$,,;
$origdirbase =~ s,[^/]+$,,; $origdirname= $&;
$origdirname eq "$basedirname.orig" ||
my ($ntfh, $newtar) = tempfile( "$tarname.new.XXXXXX",
DIR => &getcwd, UNLINK => 0 );
&forkgzipwrite($newtar);
- defined($c2= fork) || &syserr(_g("fork for tar"));
+ defined(my $c2 = fork) || syserr(_g("fork for tar"));
if (!$c2) {
chdir($tardirbase) || &syserr(sprintf(_g("chdir to above (orig) source %s"), $tardirbase));
open(STDOUT,">&GZIP") || &syserr(_g("reopen gzip for tar"));
}
$expectprefix= $origdir; $expectprefix =~ s,^\./,,;
- $expectprefix_dirname = $origdirname;
+ my $expectprefix_dirname = $origdirname;
# tar checking is disabled, there are too many broken tar archives out there
# which we can still handle anyway.
# checktarsane($origtargz,$expectprefix);
DIR => &getcwd, UNLINK => 0 );
&forkgzipwrite($newdiffgz);
- defined($c2= open(FIND,"-|")) || &syserr(_g("fork for find"));
+ defined(my $c2 = open(FIND, "-|")) || syserr(_g("fork for find"));
if (!$c2) {
chdir($dir) || &syserr(sprintf(_g("chdir to %s for find"), $dir));
exec('find','.','-print0') or &syserr(_g("exec find"));
if (-l _) {
$type{$fn}= 'symlink';
checktype($origdir, $fn, '-l') || next;
- defined($n= readlink("$dir/$fn")) ||
+ defined(my $n = readlink("$dir/$fn")) ||
&syserr(sprintf(_g("cannot read link %s"), "$dir/$fn"));
- defined($n2= readlink("$origdir/$fn")) ||
+ defined(my $n2 = readlink("$origdir/$fn")) ||
&syserr(sprintf(_g("cannot read orig link %s"), "$origdir/$fn"));
$n eq $n2 || &unrepdiff2(sprintf(_g("symlink to %s"), $n2),
sprintf(_g("symlink to %s"), $n));
} elsif (-f _) {
+ my $ofnread;
+
$type{$fn}= 'plain file';
if (!lstat("$origdir/$fn")) {
$! == ENOENT || &syserr(sprintf(_g("cannot stat orig file %s"), "$origdir/$fn"));
_g("plain file"));
next;
}
- defined($c3= open(DIFFGEN,"-|")) || &syserr(_g("fork for diff"));
+ defined(my $c3 = open(DIFFGEN, "-|")) || syserr(_g("fork for diff"));
if (!$c3) {
$ENV{'LC_ALL'}= 'C';
$ENV{'LANG'}= 'C';
'-L',"$basedirname/$fn",
'--',"$ofnread","$dir/$fn") or &syserr(_g("exec diff"));
}
- $difflinefound= 0;
+ my $difflinefound = 0;
$/= "\n";
while (<DIFFGEN>) {
if (m/^binary/i) {
print(GZIP $_) || &syserr(_g("failed to write to gzip"));
}
close(DIFFGEN); $/= "\0";
+ my $es;
if (WIFEXITED($?) && (($es=WEXITSTATUS($?))==0 || $es==1)) {
if ($es==1 && !$difflinefound) {
&unrepdiff(_g("diff gave 1 but no diff lines found"));
@ARGV>=1 || &usageerr(_g("-x needs at least one argument, the .dsc"));
@ARGV<=2 || &usageerr(_g("-x takes no more than two arguments"));
- $dsc= shift(@ARGV);
+ my $dsc = shift(@ARGV);
$dsc= "./$dsc" unless $dsc =~ m:^/:;
! -d $dsc
|| &usageerr(_g("-x needs the .dsc file as first argument, not a directory"));
- $dscdir= $dsc; $dscdir= "./$dscdir" unless $dsc =~ m,^/|^\./,;
+ my $dscdir = $dsc;
+ $dscdir = "./$dscdir" unless $dsc =~ m,^/|^\./,;
$dscdir =~ s,/[^/]+$,,;
+
+ my $newdirectory;
if (@ARGV) {
$newdirectory= shift(@ARGV);
! -e $newdirectory || &error(sprintf(_g("unpack target exists: %s"), $newdirectory));
parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
close(CDATA);
- for $f (qw(Source Version Files)) {
+ for my $f (qw(Source Version Files)) {
defined($fi{"S $f"}) ||
&error(sprintf(_g("missing critical source control field %s"), $f));
}
$dscformat=$fi{'S Format'};
}
- $sourcepackage = $fi{'S Source'};
+ $sourcepackage = $fi{'S Source'}; # XXX: should use setsourcepackage??
checkpackagename( $sourcepackage );
- $version= $fi{'S Version'};
+ my $version = $fi{'S Version'};
+ my $baseversion;
+ my $revision;
+
checkversion( $version );
$version =~ s/^\d+://;
if ($version =~ m/-([^-]+)$/) {
$baseversion= $version; $revision= '';
}
- $files = $fi{'S Files'};
+ my $files = $fi{'S Files'};
my @tarfiles;
my $difffile;
my $debianfile;
my %seen;
- for $file (split(/\n /,$files)) {
+ for my $file (split(/\n /, $files)) {
next if $file eq '';
$file =~ m/^([0-9a-f]{32})[ \t]+(\d+)[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
|| &error(sprintf(_g("Files field contains bad line `%s'"), $file));
if ($sourcestyle =~ /p/) {
stat("$dscdir/$tarfile") ||
&syserr(sprintf(_g("failed to stat `%s' to see if need to copy"), "$dscdir/$tarfile"));
- ($dsctardev,$dsctarino) = stat _;
+
+ my ($dsctardev, $dsctarino) = stat _;
+ my ($dumptardev, $dumptarino);
+
if (!stat($tarfile)) {
$! == ENOENT || &syserr(sprintf(_g("failed to check destination `%s'".
" to see if need to copy"), $tarfile));
push @patches, map "$newdirectory/debian/patches/$_", sort @p;
}
- for $dircreate (keys %dirtocreate) {
- $dircreatem= "";
- for $dircreatep (split("/", $dircreate)) {
+ for my $dircreate (keys %dirtocreate) {
+ my $dircreatem = "";
+ for my $dircreatep (split("/", $dircreate)) {
$dircreatem .= $dircreatep . "/";
if (!lstat($dircreatem)) {
$! == ENOENT || &syserr(sprintf(_g("cannot stat %s"), $dircreatem));
open DIFF, $patch or &error(sprintf(_g("can't open diff `%s'"), $patch));
}
- defined($c2= fork) || &syserr(_g("fork for patch"));
+ defined(my $c2 = fork) || syserr(_g("fork for patch"));
if (!$c2) {
open(STDIN,"<&DIFF") || &syserr(_g("reopen gzip for patch"));
chdir($newdirectory) || &syserr(sprintf(_g("chdir to %s for patch"), $newdirectory));
my $now = time;
for $fn (keys %filepatched) {
- $ftr= "$newdirectory/".substr($fn,length($expectprefix)+1);
+ my $ftr = "$newdirectory/" . substr($fn, length($expectprefix) + 1);
utime($now, $now, $ftr) || &syserr(sprintf(_g("cannot change timestamp for %s"), $ftr));
$ftr.= ".dpkg-orig";
unlink($ftr) || &syserr(sprintf(_g("remove patch backup file %s"), $ftr));
}
- if (!(@s= lstat("$newdirectory/debian/rules"))) {
+ if (!(my @s = lstat("$newdirectory/debian/rules"))) {
$! == ENOENT || &syserr(sprintf(_g("cannot stat %s"), "$newdirectory/debian/rules"));
warning(sprintf(_g("%s does not exist"), "$newdirectory/debian/rules"));
} elsif (-f _) {
warning(sprintf(_g("%s is not a plain file"), "$newdirectory/debian/rules"));
}
- $execmode= 0777 & ~umask;
- (@s= stat('.')) || &syserr(_g("cannot stat `.'"));
- $dirmode= $execmode | ($s[2] & 02000);
- $plainmode= $execmode & ~0111;
- $fifomode= ($plainmode & 0222) | (($plainmode & 0222) << 1);
+ my $execmode = 0777 & ~umask;
+ (my @s = stat('.')) || syserr(_g("cannot stat `.'"));
+ my $dirmode = $execmode | ($s[2] & 02000);
+ my $plainmode = $execmode & ~0111;
+ my $fifomode = ($plainmode & 0222) | (($plainmode & 0222) << 1);
+
for $fn (@filesinarchive) {
$fn=~ s,^$expectprefix,$newdirectory,;
- (@s= lstat($fn)) || &syserr(sprintf(_g("cannot stat extracted object `%s'"), $fn));
- $mode= $s[2];
+ (my @s = lstat($fn)) || syserr(sprintf(_g("cannot stat extracted object `%s'"), $fn));
+ my $mode = $s[2];
+ my $newmode;
+
if (-d _) {
$newmode= $dirmode;
} elsif (-f _) {
&failure(sprintf(_g("rm -rf failed to remove `%s'"), $dir));
}
-use strict 'vars';
-
sub checktarcpio {
my ($tarfileread, $wpfx) = @_;
%notfileobject = map { s/^$tarsubst/$wpfx/; $_=>1 } (keys %notfileobject);
}
-no strict 'vars';
-
# check diff for sanity, find directories to create as a side effect
sub checkdiff
{
or &error(sprintf(_g("line after --- isn't as expected in diff `%s' (line %d)"), $diff, $.));
}
- $dirname = $fn;
+ my $dirname = $fn;
if ($dirname =~ s,/[^/]+$,, && !defined($dirincluded{$dirname})) {
$dirtocreate{$dirname} = 1;
}
sub extracttar {
my ($tarfileread,$dirchdir,$newtopdir) = @_;
&forkgzipread("$tarfileread");
- defined($c2= fork) || &syserr(_g("fork for tar -xkf -"));
+ defined(my $c2 = fork) || syserr(_g("fork for tar -xkf -"));
if (!$c2) {
open(STDIN,"<&GZIP") || &syserr(_g("reopen gzip for tar -xkf -"));
&cpiostderr;
&reapgzip;
opendir(D,"$dirchdir") || &syserr(sprintf(_g("Unable to open dir %s"), $dirchdir));
- @dirchdirfiles = grep($_ ne "." && $_ ne "..",readdir(D));
+ my @dirchdirfiles = grep($_ ne "." && $_ ne "..", readdir(D));
closedir(D) || &syserr(sprintf(_g("Unable to close dir %s"), $dirchdir));
if (@dirchdirfiles==1 && -d "$dirchdir/$dirchdirfiles[0]") {
rename("$dirchdir/$dirchdirfiles[0]", "$dirchdir/$newtopdir") ||
if (!lstat("$dir/$fn")) {
&unrepdiff2(_g("nonexistent"),$type{$fn});
} else {
- $v= eval("$_[0] _ ? 2 : 1"); $v || &internerr(sprintf(_g("checktype %s (%s)"), "$@", $_[0]));
+ my $v = eval("$type _ ? 2 : 1");
+ $v || internerr(sprintf(_g("checktype %s (%s)"), "$@", $type));
return 1 if $v == 2;
&unrepdiff2(_g("something else"),$type{$fn});
}
$ur++;
}
+# FIXME: Local to *gzip* funcs
+my $cgz;
+my $gzipsigpipeok;
+
sub forkgzipwrite {
open(GZIPFILE,"> $_[0]") || &syserr(sprintf(_g("create file %s"), $_[0]));
pipe(GZIPREAD,GZIP) || &syserr(_g("pipe for gzip"));
$added_files{$filename}++ &&
&internerr( sprintf(_g("tried to add file `%s' twice"), $filename));
stat($filename) || &syserr(sprintf(_g("could not stat output file `%s'"), $filename));
- $size= (stat _)[7];
+ my $size = (stat _)[7];
my $md5sum= `md5sum <$filename`;
$? && &subprocerr("md5sum $filename");
$md5sum = readmd5sum( $md5sum );
projects / dpkg / commitdiff