[SCM] Debian package checker branch, master, updated. 2.5.12-52-g07e7bdc
The following commit has been merged in the master branch:
commit b7ce4c0b8ff48d57d7ea5391eeb4413f6d4e6505
Author: Niels Thykier <niels@thykier.net>
Date: Sat Apr 27 17:45:56 2013 +0200
private/*: Use autodie and replace bareword file handles
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/private/refresh-ftp-master-tags b/private/refresh-ftp-master-tags
index 6e8f43f..56f413f 100755
--- a/private/refresh-ftp-master-tags
+++ b/private/refresh-ftp-master-tags
@@ -20,6 +20,7 @@
use strict;
use warnings;
+use autodie;
# Not a B-D and script is compile tested...
require LWP::Simple;
@@ -32,7 +33,7 @@ BEGIN {
require Cwd;
$ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT = Cwd::cwd();
} else {
- chdir $LINTIAN_ROOT or die "Cannot chdir to $LINTIAN_ROOT: $!\n";
+ chdir($LINTIAN_ROOT);
}
}
@@ -64,9 +65,8 @@ for my $line (@yaml) {
# Print out the fatal and nonfatal tags to our data files.
my $date = strftime('%Y-%m-%d', gmtime);
-open NONFATAL, '>', 'private/build-time-data/ftp-master-nonfatal'
- or die "Cannot create private/build-time-data/ftp-master-nonfatal: $!\n";
-print NONFATAL <<"EOH";
+open(my $nonfatal, '>', 'private/build-time-data/ftp-master-nonfatal');
+print {$nonfatal} <<"EOH";
# This file lists all tags that cause an automatic reject on upload but can
# be overridden (nonfatal tags). It is based on the data file retrieved from
# $YAML_URL
@@ -74,11 +74,10 @@ print NONFATAL <<"EOH";
# Last updated: $date
EOH
-print NONFATAL join("\n", sort(@nonfatal), '');
-close NONFATAL;
-open FATAL, '>', 'private/build-time-data/ftp-master-fatal'
- or die "Cannot create private/build-time-data/ftp-master-fatal: $!\n";
-print FATAL <<"EOH";
+print {$nonfatal} join("\n", sort(@nonfatal), '');
+close($nonfatal);
+open(my $fatal, '>', 'private/build-time-data/ftp-master-fatal');
+print {$fatal} <<"EOH";
# This file lists all tags that cause an automatic reject on upload and cannot
# be overridden. It is based on the data file retrieved from
# $YAML_URL
@@ -86,8 +85,8 @@ print FATAL <<"EOH";
# Last updated: $date
EOH
-print FATAL join("\n", sort(@fatal), '');
-close FATAL;
+print {$fatal} join("\n", sort(@fatal), '');
+close($fatal);
# Local Variables:
# indent-tabs-mode: nil
diff --git a/private/refresh-manual-refs b/private/refresh-manual-refs
index 5f7d646..3a7ab8f 100755
--- a/private/refresh-manual-refs
+++ b/private/refresh-manual-refs
@@ -26,6 +26,7 @@
use strict;
use warnings;
+use autodie;
use File::Basename;
use List::MoreUtils qw(none);
@@ -37,7 +38,7 @@ BEGIN {
require Cwd;
$ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT = Cwd::cwd();
} else {
- chdir $LINTIAN_ROOT or die "Cannot chdir to $LINTIAN_ROOT: $!\n";
+ chdir($LINTIAN_ROOT);
}
}
@@ -151,13 +152,13 @@ sub extract_refs {
my ($fh, $manual, $title, $page, $url, $ref_re, $fields) = @_;
my @linked_pages = ();
- open(PAGE, '<', $page) or die "Couldn't open $page: $!";
+ open(my $page_fd, '<', $page);
# Read until there are 2 newlines. This hack is needed since some lines in
# the Developer's Reference are cut in the middle of <a>...</a>.
local $/ = "\n\n";
- while (<PAGE>) {
+ while (<$page_fd>) {
if (not $title and m/$title_re/) {
$title = 1;
my @out = ( $manual, '', $1, $url );
@@ -191,20 +192,20 @@ sub extract_refs {
$ref{url} = '' if not $url;
my @out = ( $manual, $ref{section}, $ref{title}, $ref{url} );
- print $fh join('::', @out) . "\n";
+ print {$fh} join('::', @out) . "\n";
}
}
- close(PAGE);
+ close($page_fd);
return @linked_pages;
}
# Create a new reference file.
-open(OUT, '>', 'data/output/manual-references.new')
+open(my $ref_fd, '>', 'data/output/manual-references.new')
or die "Cannot create data/output/manual-references.new: $!\n";
my $date = strftime('%Y-%m-%d', localtime);
-print OUT <<"HEADER";
+print {$ref_fd} <<"HEADER";
# Data about titles, sections, and URLs of manuals, used to expand references
# in tag descriptions and add links for HTML output. Each line of this file
# has four fields separated by double colons:
@@ -223,21 +224,20 @@ for my $manual (sort keys %manuals) {
# Extract references from the index.
my @subpages
- = extract_refs(\*OUT, $manual, 0, $index, $url, $ref_re, $fields);
+ = extract_refs($ref_fd, $manual, 0, $index, $url, $ref_re, $fields);
# Extract additional subsection references if not available in the index.
next if not $sub_re;
foreach my $pagename (@subpages) {
my $page = dirname($index) . "/$pagename";
- extract_refs(\*OUT, $manual, 1, $page, $url, $sub_re, $fields);
+ extract_refs($ref_fd, $manual, 1, $page, $url, $sub_re, $fields);
}
}
# Replace the old reference file.
-close OUT or die "Cannot flush data/output/manual-references.new: $!\n";
+close($ref_fd);
rename('data/output/manual-references.new',
- 'data/output/manual-references')
- or die "Cannot rename data/output/manual-references: $!\n";
+ 'data/output/manual-references');
# Local Variables:
# indent-tabs-mode: nil
diff --git a/private/update-coverage b/private/update-coverage
index 370ba41..281c7bd 100755
--- a/private/update-coverage
+++ b/private/update-coverage
@@ -10,6 +10,7 @@
use strict;
use warnings;
+use autodie;
use POSIX qw(strftime);
@@ -19,7 +20,7 @@ BEGIN {
require Cwd;
$ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT = Cwd::cwd();
} else {
- chdir $LINTIAN_ROOT or die "Cannot chdir to $LINTIAN_ROOT: $!\n";
+ chdir($LINTIAN_ROOT);
}
}
@@ -83,9 +84,9 @@ for my $tagfile (glob ('testset/tags.*')) {
my $case = $tagfile;
$case =~ s/.*tags\.//;
$legacy_test{$case} ||= [];
- open (IN, '<', $tagfile) or die "Cannot open $tagfile: $!\n";
+ open(my $tag_fd, '<', $tagfile);
local $_;
- while (<IN>) {
+ while (<$tag_fd>) {
if (/^.: \S+(?: (?:changes|source|udeb))?: (\S+)/) {
my $tag = $1;
if (exists $tags{$tag}) {
@@ -97,7 +98,7 @@ for my $tagfile (glob ('testset/tags.*')) {
}
}
}
- close IN;
+ close($tag_fd);
}
$ltc = $total - scalar keys %tags;
@@ -108,30 +109,30 @@ my $ltcr = $total ? sprintf ' (%.02f%%)', ($ltc / $total) * 100 : '';
my $ctcr = $check_total ? sprintf ' (%.02f%%)', ($ctc / $check_total) * 100 : '';
my $cltcr = $check_total ? sprintf ' (%.02f%%)', ($cltc / $check_total) * 100 : '';
# Open COVERAGE and print out a date stamp.
-open(OUT, '>', 't/COVERAGE') or die "Cannot create t/COVERAGE: $!\n";
-print OUT 'Last generated ', strftime ('%Y-%m-%d', gmtime), "\n";
-print OUT "Coverage (Tags): $tc/$total$tcr, w. legacy tests: $ltc/$total$ltcr\n";
-print OUT "Coverage (Checks): $ctc/$check_total$ctcr, w. legacy tests: $cltc/$check_total$cltcr\n\n";
+open(my $coverage, '>', 't/COVERAGE') or die "Cannot create t/COVERAGE: $!\n";
+print {$coverage} 'Last generated ', strftime ('%Y-%m-%d', gmtime), "\n";
+print {$coverage} "Coverage (Tags): $tc/$total$tcr, w. legacy tests: $ltc/$total$ltcr\n";
+print {$coverage} "Coverage (Checks): $ctc/$check_total$ctcr, w. legacy tests: $cltc/$check_total$cltcr\n\n";
# Whatever is left in the %tags hash are untested. Print them out sorted by
# checks file.
-print OUT "The following tags are not tested by the test suite:\n";
-print_tags(\%tags, \*OUT);
+print {$coverage} "The following tags are not tested by the test suite:\n";
+print_tags(\%tags, $coverage);
# The contents of the %legacy hash are only tested by the legacy test suite.
-print OUT "\nThe following tags are only tested by the legacy test suite:\n";
-print_tags(\%legacy, \*OUT);
+print {$coverage} "\nThe following tags are only tested by the legacy test suite:\n";
+print_tags(\%legacy, $coverage);
# Print out a breakdown of the tags that are only tested by the legacy test
# suite, sorted by legacy test case.
-print OUT "\nBreakdown of remaining tags in legacy test suite by test case:\n";
+print {$coverage} "\nBreakdown of remaining tags in legacy test suite by test case:\n";
for my $package (sort keys %legacy_test) {
- print OUT "\n$package\n";
+ print {$coverage} "\n$package\n";
for my $tag (sort @{ $legacy_test{$package} }) {
- print OUT " $tag\n";
+ print {$coverage} " $tag\n";
}
}
-close OUT;
+close($coverage);
# -----------------------------------
@@ -148,10 +149,10 @@ sub print_tags {
for my $data (@untested) {
my ($file, $tag) = @$data;
if ($file ne $last) {
- print $out "\n";
+ print {$out} "\n";
$last = $file;
}
- print $out "$file $tag\n";
+ print {$out} "$file $tag\n";
}
}
--
Debian package checker
Reply to: