r42747 - /scripts/qa/packagecheck.pl

[jeremiah-guest at users.alioth.debian.org]

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
 }