r42747 - /scripts/qa/packagecheck.pl
jeremiah-guest at users.alioth.debian.org
jeremiah-guest at users.alioth.debian.org
Tue Aug 25 12:55:19 UTC 2009
Author: jeremiah-guest
Date: Tue Aug 25 12:55:10 2009
New Revision: 42747
URL: http://svn.debian.org/wsvn/?sc=1&rev=42747
Log:
Added the first checks for the testvcs function
Modified:
scripts/qa/packagecheck.pl
Modified: scripts/qa/packagecheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/packagecheck.pl?rev=42747&op=diff
==============================================================================
--- scripts/qa/packagecheck.pl (original)
+++ scripts/qa/packagecheck.pl Tue Aug 25 12:55:10 2009
@@ -52,10 +52,12 @@
use Getopt::Long;
use Pod::Usage;
use Cwd;
+use Carp qw(croak);
use IPC::System::Simple qw(system capture);
use Perl6::Slurp;
my $fullpath; # a variable use to hold path information
+my $control_file; # The control file of our package
# Options
my (
@@ -107,36 +109,58 @@
}
}
+=item append_control
+
+Append missing files to debian/control files in the correct locations
+
+=cut
+
+sub append_control {
+ my ($replacement, $package, $control_ref) = @_;
+ open my $fh, '>', $control_file or croak "Cannot open $control_file: $!\n";
+
+ if ($replacement =~ /Vcs-Svn/) {
+ $replacement = "Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/$package/\n";
+ print ${fh} map {
+ if ($_ =~ /Standards/) { # This should always be true. (Should probably bail out if not.)
+ $_ .= $replacement; # Append Vcs-Svn line to control file after 'Standards' line
+ }
+ else { $_; }
+ } @$control_ref;
+ }
+ if ($replacement =~ /Vcs-Browser/) {
+ $replacement = "Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/$package/\n";
+ print ${fh} map {
+ if ($_ =~ /Vcs-Svn/) {
+ $_ .= $replacement; # Append Vcs-Browser line to control file after 'Vcs-Svn' line
+ }
+ else { $_; }
+ } @$control_ref;
+ }
+ close $fh;
+}
+
=item testvcs
-Test for presence of Vcs-Svn fields in control file, if not present insert
-correct field name and URL.
+Test for presence of Version Control System fields in control file, if not present
+append correct field name and URLs to debian/control file.
=cut
sub testvcs {
- my $working_dir = shift;
- $fullpath = build_path($working_dir);
- my @control_file = slurp "$fullpath/debian/control";
- if (grep /^Vcs-Svn/, @control_file) { print "Found SVN field.\n"; }
- else {
- use Fatal qw( open close );
- print "Adding missing Vcs-Svn field to $working_dir . . .\n";
- open my $fh, '>', "$fullpath/debian/control";
- print {$fh} map {
- my $line = $_;
- if ($line =~ /Standards/) {
- $line .= "Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/$working_dir/\n";
- }
- else { $line; }
- } @control_file;
- close $fh;
- }
+ my ($working_dir, $control) = @_;
+ my @control_file = slurp $control;
+ my $control_ref = \@control_file;
+ my @fields_to_check = qw ( Vcs-Svn Vcs-Browser );
+ map { # interate over each field to check, append if not found
+ my $field = $_;
+ if (grep /^$field/, @control_file) { print "Found $field\n"; }
+ else { append_control($field, $working_dir, $control); }
+ } @fields_to_check;
}
-
# Process options
-if ($current) { # check for checked out packages in the current dir
+if ($current) { # check for checked-out packages in the current dir
sanity_check("$current");
$fullpath = build_path($current);
if (!$automatic) {
@@ -153,7 +177,8 @@
else {
print "It appears directory is clean.\n";
}
- testvcs($current)
+ $control_file = "$fullpath/debian/control";
+ testvcs($current, $control_file) # check for version control URLs
}
More information about the Pkg-perl-cvs-commits
mailing list