Initial Polish translation of sections file.

[deb/packages.git] / bin / extract_files

diff --git a/bin/extract_files b/bin/extract_files
index 2d4dbdcd4ab64e1f90d0d0a052aa46f826760419..a94fba06bd87d5a3161fdde213935392cb6d086f 100755 (executable)
--- a/bin/extract_files
+++ b/bin/extract_files
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 #
 # Script to extract files from Debian packages
-# Copyright 2004 Frank Lichtenheld
+# Copyright 2004-2007 Frank Lichtenheld <frank@lichtenheld.de>
 #
 # based on a shell script which was
 # Copyright 2003 Noel Köthe
@@ -19,7 +19,7 @@
 #
 #    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
+#    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 use strict;
 use warnings;
@@ -72,7 +72,15 @@ my %opthash = (
               'help' => \$help,
               );
 
-my (%src_packages, %bin_packages, %cache, %stats);
+my (%src_packages, %bin_packages, %cache);
+
+my %stats = (
+    src_pkgs => 0,
+    src_cache => 0,
+    already_extracted => 0,
+    bin_pkgs => 0,
+    bin_cache => 0,
+    );
 
 Getopt::Long::config('no_getopt_compat', 'no_auto_abbrev');
 
@@ -122,30 +130,31 @@ sub add_log {
     $$log .= localtime().": @_\n";
 }
 
+sub touch {
+    my $filename = shift;
+    sysopen(H, $filename, O_WRONLY|O_NONBLOCK|O_CREAT) or return undef;
+    close(H);
+    return 1;
+}
+
 ##################################################
 # PACKAGE HANDLING (UNPACKING/CLEANUP)
 
 sub unpack_srcpkg {
-    my ( $dscname, $log ) = @_;
+    my ( $pkgname, $dscname, $log ) = @_;
 
     chdir( $TEMPDIR ) or do_error( "couldn't change working directory to $TEMPDIR" );
 
-    add_log( $log, "dpkg-source -sn -x $dscname"  );
-
-    my $out = qx/dpkg-source -sn -x "$dscname" 2>&1/;
-    my ($dir) = ($out =~ /(\S+)$/mo);
-
-    add_log( $log, "dpkg-source output: ", $out );
+    add_log( $log, "dpkg-source -sn -x $dscname $pkgname+source"  );
 
-#Bug#246802
-#    system("dpkg-source", "-x", $dscname ) == 0
-#      or do {
-#          do_warning( "couldn't unpack $dscname" );
-#          add_log( $log, "couldn't unpack $dscname" );
-#          return;
-#      };
+    system("dpkg-source", "-sn", "-x", $dscname, "$pkgname+source" ) == 0
+       or do {
+           do_warning( "couldn't unpack $dscname: $!" );
+           add_log( $log, "couldn't unpack $dscname: $!" );
+           return;
+       };
 
-    return $dir;
+    return "$pkgname+source";
 }
 
 sub unpack_binpkg {
@@ -225,8 +234,8 @@ sub to_update {
 
     if ($config_data->{structure} == PKGPOOL) {
        my $dir = "$target/".pkg_pool_directory( $pkg_data );
-       if (!$force && -d $dir && -f "$dir/log") {
-           (system( "touch", "$dir/log" ) == 0)
+       if (!$force && -f "$dir/log") {
+           (utime(undef,undef,"$dir/log") == 1)
                or do_warning( "touch of $dir/log failed" );
            return 0;
        } else {
@@ -282,7 +291,7 @@ sub extract_copyright_to_pkgpool {
                my $pkg2 = $1;
                if ($pkg_data->{bin_list}{$pkg2}) {
                    add_log( $log, "symlink points to $pkg2, make symlink to copyright file" );
-                   (system("ln", "-s", "$pkg2.copyright", $tgt ) == 0)
+                   (symlink( "$pkg2.copyright", $tgt ) == 1 )
                        or add_log( $log, "symlink creation failed" );
                } else {
                    add_log( $log, "symlink points to $pkg2, don't know what to do with that" );
@@ -296,11 +305,11 @@ sub extract_copyright_to_pkgpool {
            add_log( $log, "copyright file $tgt still doesn't exist" );
            if (-e $src_tgt) {
                add_log( $log, "copyright file of the source package exists, make symlink" );
-               (system("ln", "-s", "copyright", $tgt ) == 0)
+               (symlink( "copyright", $tgt ) == 1 )
                    or add_log( $log, "symlink generation failed" );
            } else {
                add_log( $log, "give up on $bin_pkg" );
-               (system( "touch", "$tgt.ERROR" ) == 0)
+               touch("$tgt.ERROR")
                    or add_log( $log, "even the touch of $tgt.ERROR failed :(" );
            }
        }
@@ -315,7 +324,7 @@ sub extract_copyright_to_pkgpool {
                              keys %{$pkg_data->{bin_list}})) {
            if (-e "$target_dir/$bin_pkg.copyright") {
                add_log( $log, "copyright file $target_dir/$bin_pkg.copyright seems like a good guess to me, make a symlink" );
-               (system("ln", "-s", "$bin_pkg.copyright", $src_tgt ) == 0)
+               (symlink( "$bin_pkg.copyright", $src_tgt ) == 1 )
                    or do {
                        add_log( $log, "symlink generation failed" );
                        next;
@@ -325,7 +334,7 @@ sub extract_copyright_to_pkgpool {
        }
        unless (-e $src_tgt) {
            add_log( $log, "give up" );
-           (system( "touch", "$src_tgt.ERROR" ) == 0) or
+           touch("$src_tgt.ERROR") or
                add_log( $log, "even the touch of $src_tgt.ERROR failed :(" );
        }
     }
@@ -369,7 +378,7 @@ sub manage_current_link {
     unless (-l $current_link) {
        add_log( $log, "create new current link" );
        (chdir( $parent_dir ) and
-        not system( 'ln', '-s', $dirname, 'current' )) or
+        (symlink( $dirname, 'current' ) == 1 )) or
         add_log( $log, "creating new current link failed: $!" );
     } else {
        my $old_target = readlink( $current_link );
@@ -380,7 +389,7 @@ sub manage_current_link {
                     "old_version=$old_version; overwriting current link" );
            (chdir( $parent_dir ) and
             unlink( 'current' ) and
-            not system( 'ln', '-s', $dirname, 'current' )) or
+            (symlink( $dirname, 'current' ) == 1 )) or
             add_log( $log, "overwriting current link failed: $!" );
        } else {
            add_log( $log,
@@ -401,7 +410,7 @@ sub extract_files {
        return;
     }
 
-    if (my $source_dir = unpack_srcpkg( $pkg_data->{dsc}, \$log )) {
+    if (my $source_dir = unpack_srcpkg( $pkg_data->{src_name}, $pkg_data->{dsc}, \$log )) {
 
        $source_dir = "$TEMPDIR/$source_dir";
 
@@ -529,7 +538,7 @@ sub read_dsc {
        dsc => $dscname,
     };
 
-    unless( $pkg_data->{src_name} && $pkg_data->{src_version}
+    unless( $pkg_data->{src_name} && defined($pkg_data->{src_version})
        && $pkg_data->{dsc} ) {
        use Data::Dumper;
        do_error( "something fishy happened.\n", Dumper( $pkg_data ) );
@@ -555,6 +564,10 @@ sub read_deb {
        }
     }
     $cache{$debname} ||= qx/dpkg-deb --info "$debname" control/;
+    unless ( $cache{$debname} ) {
+       do_warning( "extracting control information of file $debname failed" );
+       return;
+    }
     my $control = $cache{$debname};
 
     unless ( $raw_data = $parser->parse_mem( $control,
@@ -598,7 +611,7 @@ sub collect_deb {
     return unless $pkg_data;
 
     if (exists $bin_packages{$pkg_data->{bin_name}}{$pkg_data->{bin_version}}{$pkg_data->{bin_arch}}) {
-       do_warning( "duplicated package $pkg_data->{bin_name}, version {$pkg_data->{bin_version}{$pkg_data->{bin_arch}}" );
+       do_warning( "duplicated package $pkg_data->{bin_name}, version $pkg_data->{bin_version}, arch $pkg_data->{bin_arch}" );
        return;
     } else {
        $bin_packages{$pkg_data->{bin_name}}{$pkg_data->{bin_version}}{$pkg_data->{bin_arch}} = $pkg_data;