r44061 - /scripts/qa/packagecheck.pl
jeremiah-guest at users.alioth.debian.org
jeremiah-guest at users.alioth.debian.org
Sun Sep 13 17:17:30 UTC 2009
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
More information about the Pkg-perl-cvs-commits
mailing list