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