[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

[SCM] Debian package checker branch, master, updated. 2.5.13-51-g7510809



The following commit has been merged in the master branch:
commit 7510809adbca26b9366a66c9fc7f75520c130739
Author: Niels Thykier <niels@thykier.net>
Date:   Sat Jun 29 14:51:11 2013 +0200

    coll/scripts: Avoid creating empty "scripts" file
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/collection/scripts b/collection/scripts
index 310fe3c..710a042 100755
--- a/collection/scripts
+++ b/collection/scripts
@@ -32,8 +32,7 @@ use Lintian::Util qw(strip);
 sub collect {
 my ($pkg, $type, $dir) = @_;
 my $info = Lintian::Collect->new ($pkg, $type, $dir);
-
-open(my $scripts_fd, '>', "$dir/scripts");
+my $scripts_fd; # We lazily open this FD.
 
 foreach my $file ($info->sorted_index) {
     next unless $file->is_regular_file;
@@ -45,6 +44,11 @@ foreach my $file ($info->sorted_index) {
                                       # #!#!#!
     my $copy_path = $scriptpath;
     $scriptpath =~ s/^\#.*//; # remove comments
+
+    if (!defined($scripts_fd)) {
+        open($scripts_fd, '>', "$dir/scripts");
+    }
+
     if ($scriptpath eq '') {
         print {$scripts_fd} "$copy_path $file\n";
     } else {
@@ -57,7 +61,7 @@ foreach my $file ($info->sorted_index) {
         print {$scripts_fd} $env . "$scriptpath $file\n";
     }
 }
-close($scripts_fd);
+close($scripts_fd) if defined($scripts_fd);
 
 open(my $ctrl_fd, '>', "$dir/control-scripts");
 
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index af0dd9e..c62e7a9 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -303,24 +303,25 @@ Needs-Info requirements for using I<scripts>: scripts
 sub scripts {
     my ($self) = @_;
     return $self->{scripts} if exists $self->{scripts};
-    my $scrf = $self->lab_data_path ('scripts');
+    my $scrf = $self->lab_data_path('scripts');
     my %scripts;
-    local $_;
-    open(my $fd, '<', $scrf);
-    while ( my $line = <$fd> ) {
-        my (%file, $name);
-        chomp ($line);
-
-        $line =~ m/^(env )?(\S*) (.*)$/o
-            or fail("bad line in scripts file: $_");
-        ($file{calls_env}, $file{interpreter}, $name) = ($1, $2, $3);
-
-        $name =~ s,^\./,,o;
-        $name =~ s,/+$,,o;
-        $file{name} = $name;
-        $scripts{$name} = \%file;
+    if ( -f $scrf ) {
+        open(my $fd, '<', $scrf);
+        while ( my $line = <$fd> ) {
+            my (%file, $name);
+            chomp ($line);
+
+            $line =~ m/^(env )?(\S*) (.*)$/o
+                or fail("bad line in scripts file: $line");
+            ($file{calls_env}, $file{interpreter}, $name) = ($1, $2, $3);
+
+            $name =~ s,^\./,,o;
+            $name =~ s,/+$,,o;
+            $file{name} = $name;
+            $scripts{$name} = \%file;
+        }
+        close($fd);
     }
-    close($fd);
     $self->{scripts} = \%scripts;
 
     return $self->{scripts};

-- 
Debian package checker


Reply to: