r44061 - /scripts/qa/packagecheck.pl

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

Author: jeremiah-guest
Date: Sun Sep 13 17:17:23 2009
New Revision: 44061

URL: http://svn.debian.org/wsvn/?sc=1&rev=44061
Log:
Added code to determine which type of VCS we are using, git or svn.

Modified:
    scripts/qa/packagecheck.pl

Modified: scripts/qa/packagecheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/packagecheck.pl?rev=44061&op=diff
==============================================================================
--- scripts/qa/packagecheck.pl (original)
+++ scripts/qa/packagecheck.pl Sun Sep 13 17:17:23 2009
@@ -61,11 +61,13 @@
 use Pod::Usage;
 use Cwd;
 use Carp qw(croak);
-use IPC::System::Simple qw(system capture);
+use IPC::System::Simple qw(system capture runx);
 use Perl6::Slurp;
+use Git;
 
 my $fullpath;      # a variable use to hold path information
 my $control_file;  # The control file of our package
+my %config;        # hash holding configuration options
 
 # Options
 my (
@@ -124,27 +126,24 @@
 =cut
 
 sub append_control {
-  my ($replacement, $package, $control_ref) = @_;
+  my ($replacement, $ctrl_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;
-  }
+  # Should I write to a temporary file, instead of re-writing the control file?
+
+  map {
+   if ($_  =~ /^Vcs-Svn/) {  # Append Vcs-Svn line to control file after 'Standards' line
+      print {$fh} map {
+	if ($_ =~ /Standards/) { $_ .= "@$replacement \n"; }
+	else { $_; } 
+      } @$ctrl_ref;
+    }
+    if ($_  =~ /^Vcs-Browser/) { # Append Vcs-Browser line to control file after 'Vcs-Svn' line
+      print {$fh} map {
+	if ($_ =~ /Vcs-Svn/) { $_ .= "@$replacement \n"; }
+	else { $_; }
+      } @$ctrl_ref;
+    }
+ } @$replacement;
   close $fh;
 }
 
@@ -156,37 +155,60 @@
 =cut
 
 sub testvcs {
-  my ($working_dir, $control) = @_;
-  my @control_file = slurp $control;
-  my $control_ref = \@control_file;
-  my @fields_to_check = qw ( Vcs-Svn Vcs-Browser wsvn );
-  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;
+  my $replacements =
+    [
+     [ 'Vcs-Svn:', 'svn://svn.debian.org/pkg-perl/trunk/$package/'],
+     [ 'Vcs-Browser:', 'http://svn.debian.org/viewsvn/pkg-perl/trunk/$package/' ],
+    ];
+
+  map {
+    # we need to re-read the file to pick up changes
+    my @file = slurp $control_file;
+    my $control_ref = \@file;
+    my $field = $replacements->[$_][0];
+    if (grep /^$field/, @file) { print "Found \"$field\" field.\n"; }
+    else {
+      print "Did not find $field, appending.\n";
+      append_control($replacements->[$_], $control_ref);
+    }
+    undef $control_ref;
+  } 0..(@$replacements - 1);
 }
 
 # Process options
 if ($current) {  # look for checked-out packages in the current dir
   sanity_check("$current");
   $fullpath = build_path($current);
-  if (!$automatic) {
-    print "Running svn up in $fullpath . . .\n";
-    my @svnrev = capture("svn up $fullpath");
-    print "SVN: $svnrev[-1]";
-  }
-  print "Checking for uncommitted modifications to directory . . .\n";
-  my @svnmods = capture("svn st $fullpath");
-  if ($svnmods[-1]) {
-    print map { $_ } @svnmods;
-    die "Exiting. $fullpath appears to have uncommitted modifications.\n";
-  }
-  else {
-    print "It appears directory is clean.\n";
+  if (!$automatic) { 
+    # test for which VCS we're using, git or svn. Maybe should be factored out to a sub
+    if (capture([0..128], "ls $fullpath.svn")) {
+      $config{'vcs'} = "svn";                        # svn is our VCS
+      print "Running svn up in $fullpath . . .\n";   # we use svn if we find it
+      my @svnrev = capture("svn up $fullpath");
+      print "SVN: $svnrev[-1]";
+      print "Checking for uncommitted modifications to directory . . .\n";
+      my @svnmods = capture("svn st $fullpath");
+      if ($svnmods[-1]) {
+	print map { $_ } @svnmods;
+	die "Exiting. $fullpath appears to have uncommitted modifications.\n";
+      }
+      else {
+	print "It appears directory is clean.\n";
+      }
+    }
+    else { # No subversion, let's try git
+      my $gitrepo;
+      eval {$gitrepo = Git->repository (Directory => "$fullpath.git"); };
+      if ($@) { # if we cannot find a git repo, we die
+	die "Errors with Version Control System";
+      }
+      $config{'vcs'} = "git";                        # git is our VCS
+      $config{'git_version'} = $gitrepo->version();
+      print "Git version: $config{'git_version'}\n";
+    }
   }
   $control_file = "$fullpath/debian/control";
-  testvcs($current, $control_file)  # check for version control URLs
+  testvcs($current, $control_file);  # check control file for correct URLs
 }
 
 =back