The following commit has been merged in the master branch:
commit 8e9df75625168c0a7631fdbd5f5e27f05cd56b95
Author: Guillem Jover <guil...@debian.org>
Date: Wed Jun 17 03:32:25 2009 +0200
dpkg-name: Rewrite in perl
diff --git a/debian/changelog b/debian/changelog
index 6ca21c8..226a21c 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,6 +4,7 @@ dpkg (1.15.3) UNRELEASED; urgency=low
* Unset TAR_OPTIONS when extracting .deb archives. Closes: #530860
* Use default compressor values in dpkg-source from Dpkg::Source::Compressor.
* Fix dpkg-scanpackages to properly detect spurious overrides.
+ * Rewrite dpkg-name in perl.
[ Raphael Hertzog ]
* Unset TAR_OPTIONS when creating/extracting tar archives for source
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index f0fcdd3..61e33ab 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -34,7 +34,7 @@ EXTRA_DIST = \
dpkg-genchanges.pl \
dpkg-gencontrol.pl \
dpkg-gensymbols.pl \
- dpkg-name.sh \
+ dpkg-name.pl \
dpkg-parsechangelog.pl \
dpkg-scanpackages.pl \
dpkg-scansources.pl \
@@ -129,19 +129,12 @@ do_perl_subst = sed -e
"s:^\#![:space:]*/usr/bin/perl:\#!$(PERL):" \
-e
"s:\$$admindir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$admindir=\"$(admindir)\":"
\
-e
"s:\$$version[[:space:]]*=[[:space:]]*['\"][^'\"]*[\"']:\$$version=\"$(PACKAGE_VERSION)\":"
-do_shell_subst = sed -e "s:version=\"[^\"]*\":version=\"$(PACKAGE_VERSION)\":"
-
%: %.pl Makefile
@test -d `dirname $...@` || $(mkdir_p) `dirname $...@`
$(do_perl_subst) <$< >$@
chmod +x $@
-%: %.sh Makefile
- @test -d `dirname $...@` || $(mkdir_p) `dirname $...@`
- $(do_shell_subst) <$< >$@
- chmod +x $@
-
# Automake has its own install-info rule, gah
all-local: install-info-stamp
diff --git a/scripts/dpkg-name.pl b/scripts/dpkg-name.pl
new file mode 100755
index 0000000..3dbd164
--- /dev/null
+++ b/scripts/dpkg-name.pl
@@ -0,0 +1,256 @@
+#!/usr/bin/perl
+#
+# dpkg-name
+#
+# Copyright © 1995,1996 Erick Branderhorst <brand...@debian.org>.
+# Copyright © 2009 Guillem Jover <guil...@debian.org>.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+
+use warnings;
+use strict;
+
+use File::Basename;
+use File::Path;
+
+use Dpkg;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Cdata;
+use Dpkg::Arch qw(get_host_arch);
+
+textdomain("dpkg-dev");
+
+my %options = (
+ subdir => 0,
+ destdir => "",
+ createdir => 0,
+ overwrite => 0,
+ symlink => 0,
+ architecture => 1,
+);
+
+sub version()
+{
+ printf(_g("Debian %s version %s.\n"), $progname, $version);
+}
+
+sub usage()
+{
+ printf(_g("Usage: %s [<option>...] <file>...\n"), $progname);
+
+ print(_g("
+Options:
+ -a, --no-architecture no architecture part in filename.
+ -o, --overwrite overwrite if file exists.
+ -k, --symlink don't create a new file, but a symlink.
+ -s, --subdir [dir] move file into subdir (use with care).
+ -c, --create-dir create target dir if not there (use with care).
+ -h, --help show this help message.
+ -v, --version show the version.
+
+file.deb changes to <package>_<version>_<architecture>.<package_type>
+according to the 'underscores convention'.
+"));
+}
+
+sub fileexists($)
+{
+ my ($filename) = @_;
+
+ if (-f $filename) {
+ return 1;
+ } else {
+ warning(_g("cannot find '%s'"), $filename);
+ return 0;
+ }
+}
+
+sub filesame($$)
+{
+ my ($a, $b) = @_;
+ my @sta = stat($a);
+ my @stb = stat($b);
+
+ # Same device and inode numbers.
+ return (@sta and @stb and $sta[0] == $stb[0] and $sta[1] == $stb[1]);
+}
+
+sub getfields($)
+{
+ my ($filename) = @_;
+
+ # Read the fields
+ open(CDATA, '-|', "dpkg-deb", "-f", "--", $filename) ||
+ syserr(_g("cannot open %s"), $filename);
+ my $fields = parsecdata(\*CDATA,
+ sprintf(_g("binary control file %s"), $filename));
+ close(CDATA);
+
+ return $fields;
+}
+
+sub getarch($$)
+{
+ my ($filename, $fields) = @_;
+
+ my $arch = $fields->{Architecture};
+ if (!$fields->{Architecture} and !$options{architecture}) {
+ $arch = get_host_arch();
+ warning(g_("assuming architecture '%s' for '%s'"), $arch, $filename);
+ }
+
+ return $arch;
+}
+
+sub getname($$$)
+{
+ my ($filename, $fields, $arch) = @_;
+
+ my $pkg = $fields->{Package};
+ (my $version = $fields->{Version}) =~ s/.*://;
+ my $revision = $fields->{Revision} || $fields->{Package_Revision};
+ if ($revision) {
+ $version .= "-$revision";
+ }
+
+ my $type = $fields->{'Package-Type'} || 'deb';
+
+ my $tname;
+ if ($options{architecture}) {
+ $tname = "$pkg\_$version\_$arch.$type";
+ } else {
+ $tname = "$pkg\_$version.$type";
+ }
+ (my $name = $tname) =~ s/ //g;
+ if ($tname ne $name) { # control fields have spaces
+ warning("bad package control information for '%s'", $filename);
+ }
+ return $name;
+}
+
+sub getdir($$$)
+{
+ my ($filename, $fields, $arch) = @_;
+ my $dir;
+
+ if (!$options{destdir}) {
+ $dir = dirname($filename);
+ if ($options{subdir}) {
+ my $section = $fields->{Section};
+ if (!$section) {
+ $section = "no-section";
+ warning("assuming section '%s' for '%s'", $section, $filename);
+ }
+ if ($section ne "non-free" and $section ne "contrib" and
+ $section ne "no-section") {
+ $dir = "unstable/binary-$arch/$section";
+ } else {
+ $dir = "$section/binary-$arch";
+ }
+ }
+ } else {
+ $dir = $options{destdir};
+ }
+
+ return $dir;
+}
+
+sub move($)
+{
+ my ($filename) = @_;
+
+ if (fileexists($filename)) {
+ my $fields = getfields($filename);
+
+ unless (exists $fields->{Package}) {
+ warning("no Package field found in '%s', skipping it", $filename);
+ return;
+ }
+
+ my $arch = getarch($filename, $fields);
+
+ my $name = getname($filename, $fields, $arch);
+
+ my $dir = getdir($filename, $fields, $arch);
+ if (! -d $dir) {
+ if ($options{createdir}) {
+ if (mkpath($dir)) {
+ info("created directory '%s'", $dir);
+ } else {
+ error("failed creating directory '%s'", $dir);
+ }
+ } else {
+ error("no such dir '%s', try --create-dir (-c) option", $dir);
+ }
+ }
+
+ my $newname = "$dir/$name";
+
+ my @command;
+ if ($options{symlink}) {
+ @command = ("ln", "-s", "--");
+ } else {
+ @command = ("mv", "--");
+ }
+
+ if (filesame($newname, $filename)) {
+ warning("skipping '%s'", $filename);
+ } elsif (-f $newname and !$options{overwrite}) {
+ warning("cannot move '%s' to existing file", $filename);
+ } elsif (system(@command, $filename, $newname) == 0) {
+ info("moved '%s' to '%s'", basename($filename), $newname);
+ } else {
+ error("mkdir can be used to create directory");
+ }
+ }
+}
+
+...@argv || usageerr(_g("need at least a filename"));
+
+while (@ARGV) {
+ $_ = shift(@ARGV);
+ if (m/^-[h?]|--help$/) {
+ usage();
+ exit(0);
+ } elsif (m/^-v|--version$/) {
+ version();
+ exit(0);
+ } elsif (m/^-c|--create-dir$/) {
+ $options{createdir} = 1;
+ } elsif (m/^-s|--subdir$/) {
+ $options{subdir} = 1;
+ if (-d $ARGV[0]) {
+ $options{destdir} = shift(@ARGV);
+ }
+ } elsif (m/^-o|--overwrite$/) {
+ $options{overwite} = 1;
+ } elsif (m/^-k|--symlink$/) {
+ $options{symlink} = 1;
+ } elsif (m/^-a|--no-architecture$/) {
+ $options{architecture} = 0;
+ } elsif (m/^--$/) {
+ foreach (@ARGV) {
+ move($_);
+ }
+ exit 0;
+ } else {
+ move($_);
+ }
+}
+
+0;
+
diff --git a/scripts/dpkg-name.sh b/scripts/dpkg-name.sh
deleted file mode 100755
index e3cddd0..0000000
--- a/scripts/dpkg-name.sh
+++ /dev/null
@@ -1,207 +0,0 @@
-#!/bin/sh
-
-set -e
-
-# Time-stamp: <96/05/03 13:59:41 root>
-prog="$(basename "${0}")"
-version="1.2.3"; # This line modified by Makefile
-purpose="rename Debian packages to full package names"
-
-license () {
-echo "# ${prog} ${version} -- ${purpose}
-# Copyright © 1995,1996 Erick Branderhorst <brand...@debian.org>.
-
-# This is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by the
-# Free Software Foundation; either version 2, or (at your option) any
-# later version.
-
-# This 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 file
-# /usr/share/common-licenses/GPL for more details."
-}
-
-stderr () {
- echo "${prog}: $@" 1>&2;
-}
-
-show_version () {
- echo "${prog} version ${version} -- ${purpose}";
-}
-
-usage () {
- echo "Usage: ${prog} <file>...
-
-${purpose}
-file.deb changes to <package>_<version>_<architecture>.<package_type>
-according to the ``underscores convention''.
-
-Options:
- -a, --no-architecture no architecture part in filename.
- -o, --overwrite overwrite if file exists.
- -k, --symlink don't create a new file, but a symlink.
- -s, --subdir [dir] move file into subdir (Use with care).
- -c, --create-dir create target dir if not there (Use with care).
- -h, --help show this help message.
- -v, --version show the version.
- -l, --license show license."
-}
-
-fileexists () {
- if [ -f "$1" ];
- then
- return 0;
- else
- stderr "can't find \`"$1"'";
- return 1;
- fi
-}
-
-getname () {
- if p=`dpkg-deb -f -- "$1" package`;
- then
- v=`dpkg-deb -f -- "$1" version | sed s,.*:,,`;
- r=`dpkg-deb -f -- "$1" revision`;
- if [ -z "$r" ];
- then
- r=`dpkg-deb -f -- "$1" package_revision`;
- fi
-
- if [ -n "$r" ];
- then
- v=$v-$r;
- fi
-
- a=`dpkg-deb -f -- "$1" architecture`;
- a=`echo $a|sed -e 's/ *//g'`;
- if [ -z "$a" ] && [ -n "$noarchitecture" ]; # arch field empty,
or ignored
- then
- a=`dpkg --print-architecture`;
- stderr "assuming architecture \`"$a"' for \`"$1"'";
- fi
- t=`dpkg-deb -f -- "$1" package-type`
- if [ -z "$t" ];
- then
- t=deb
- fi
- if [ -z "$noarchitecture" ];
- then
- tname=$p\_$v\_$a.$t;
- else
- tname=$p\_$v.$t
- fi
-
- name=`echo $tname|sed -e 's/ //g'`
- if [ "$tname" != "$name" ]; # control fields have spaces
- then
- stderr "bad package control information for \`"$1"'"
- fi
- return 0;
- fi
-}
-
-getdir () {
- if [ -z "$destinationdir" ];
- then
- dir=`dirname "$1"`;
- if [ -n "$subdir" ];
- then
- s=`dpkg-deb -f -- "$1" section`;
- if [ -z "$s" ];
- then
- s="no-section";
- stderr "assuming section \`"no-section"' for
\`"$1"'";
- fi
- if [ "$s" != "non-free" ] && [ "$s" != "contrib" ] && [
"$s" != "no-section" ];
- then
- dir=`echo unstable/binary-$a/$s`;
- else
- dir=`echo $s/binary-$a`;
- fi
- fi
- else
- dir=$destinationdir;
- fi
-}
-
-move () {
- if fileexists "$arg";
- then
- getname "$arg";
- getdir "$arg";
- if [ ! -d "$dir" ];
- then
- if [ -n "$createdir" ];
- then
- if `mkdir -p $dir`;
- then
- stderr "created directory \`$dir'";
- else
- stderr "failed creating directory \`$dir'";
- exit 1;
- fi
- else
- stderr "no such dir \`$dir'";
- stderr "try --create-dir (-c) option";
- exit 1;
- fi
- fi
- newname=`echo $dir/$name`;
- if [ x$symlink = x1 ];
- then
- command="ln -s --"
- else
- command="mv --"
- fi
- if [ $newname -ef "$1" ]; # same device and inode numbers
- then
- stderr "skipping \`"$1"'";
- elif [ -f $newname ] && [ -z "$overwrite" ];
- then
- stderr "can't move \`"$1"' to existing file";
- elif `$command "$1" $newname`;
- then
- echo "moved \``basename "$1"`' to \`$newname'";
- else
- stderr "mkdir can be used to create directory";
- exit 1;
- fi
- fi
-}
-
-if [ $# = 0 ]; then usage; exit 0; fi
-for arg
-do
- if [ -n "$subdirset" ];
- then
- subdirset=0;
- subdir=1;
- if [ -d $arg ];
- then
- destinationdir=$arg;
- continue
- fi
- fi
- case "$arg" in
- --version|-v) show_version; exit 0;;
- --help|-[h?]) usage; exit 0;;
- --licen[cs]e|-l) license; exit 0;;
- --create-dir|-c) createdir=1;;
- --subdir|-s) subdirset=1;;
- --overwrite|-o) overwrite=1 ;;
- --symlink|-k) symlink=1 ;;
- --no-architecture|-a) noarchitecture=1 ;;
- --) shift;
- for arg
- do
- move "$arg";
- done; exit 0;;
- *) move "$arg";;
- esac
-done
-exit 0;
-
-# Local variables:
-# tab-width: 2
-# End:
diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in
index 4be1a14..ff904ef 100644
--- a/scripts/po/POTFILES.in
+++ b/scripts/po/POTFILES.in
@@ -7,6 +7,7 @@ scripts/dpkg-distaddfile.pl
scripts/dpkg-genchanges.pl
scripts/dpkg-gencontrol.pl
scripts/dpkg-gensymbols.pl
+scripts/dpkg-name.pl
scripts/dpkg-parsechangelog.pl
scripts/dpkg-scanpackages.pl
scripts/dpkg-scansources.pl
--
dpkg's main repository
--
To UNSUBSCRIBE, email to debian-dpkg-cvs-requ...@lists.debian.org
with a subject of "unsubscribe". Trouble? Contact listmas...@lists.debian.org
