Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: bfdf1fce34
Fetching contributors…

Cannot retrieve contributors at this time

executable file 348 lines (296 sloc) 9.541 kB
#!/usr/bin/perl -w
#=======================================================================
# findrev
# File ID: f240c034-f742-11dd-a833-000475e441b9
# Locate a Subversion revision based on used defined criteras.
#
# Character set: UTF-8
# ©opyleft 2007– Øyvind A. Holm <sunny@sunbase.org>
# License: GNU General Public License version 3 or later, see end of
# file for legal stuff.
#=======================================================================
use strict;
use Getopt::Long;
$| = 1;
our $Debug = 0;
our %Opt = (
'after' => "",
'before' => "",
'debug' => 0,
'exec' => "",
'help' => 0,
'ignore-externals' => 0,
'revision' => "",
'verbose' => 0,
'version' => 0,
'want' => 0,
);
our $progname = $0;
$progname =~ s/^.*\/(.*?)$/$1/;
our $VERSION = "0.00";
my $CMD_SVN = "svn";
Getopt::Long::Configure("bundling");
GetOptions(
"after|A=s" => \$Opt{'after'},
"before|B=s" => \$Opt{'before'},
"debug" => \$Opt{'debug'},
"exec|e=s" => \$Opt{'exec'},
"help|h" => \$Opt{'help'},
"ignore-externals" => \$Opt{'ignore-externals'},
"revision|r=s" => \$Opt{'revision'},
"verbose|v+" => \$Opt{'verbose'},
"version" => \$Opt{'version'},
"want|w=s" => \$Opt{'want'},
) || die("$progname: Option error. Use -h for help.\n");
$Opt{'debug'} && ($Debug = 1);
$Opt{'help'} && usage(0);
if ($Opt{'version'}) {
print_version();
exit(0);
}
my ($Start, $End) = (1, "HEAD");
if (length($Opt{'revision'})) {
if ($Opt{'revision'} =~ /^(\d*):(\d*|head)$/i) {
D("regexp good");
length($1) && ($Start = $1);
length($2) && ($End = $2);
} else {
die("$progname: Invalid revision range in --revision (-r) parameter\n");
}
}
D("Start = '$Start', End = '$End'");
if (!length($Opt{'exec'})) {
die("$progname: No --exec (-e) parameter specified. You might want to consult '$progname --help'.\n");
}
my $File;
if ($#ARGV == -1) {
$File = ".";
} elsif ($#ARGV == 0) {
$File = $ARGV[0];
} else {
die("$progname: Only one file or directory name allowed\n");
}
find_revision($Opt{'want'}, $File, $Start, $End, $Opt{'exec'}, $Opt{'before'}, $Opt{'after'});
my $Found = 0;
sub find_revision {
# Scan a specific revision range for the first merge conflict and
# return the revision number
# {{{
my ($Want, $File, $Start, $End, $Exec, $Before, $After) = @_;
D("find_revision('$Want', '$File', '$Start', '$End', '$Exec', '$Before', '$After')");
print("$progname: $File: Scanning revision range r$Start:$End " .
"for return value $Want\n");
my @Array = revisions($File, $Start, $End);
if (!scalar(@Array)) {
print("No revisions found.\n");
return undef;
}
my $rev_count = scalar(@Array);
printf("$rev_count revision%s to check\n", $rev_count == 1 ? "" : "s");
print("(" . join(", ", @Array) . ")\n");
my $min_block = 0;
my ($min_pos, $max_pos) = (0, $rev_count);
my $last_mid = 0;
my $first_fail = 0;
my $last_good = 0;
my $has_checked = 0;
while (1) {
my $mid_pos = int(($min_pos + $max_pos) / 2);
last if ($has_checked && ($mid_pos == $last_mid));
my $Rev = $Array[$mid_pos];
D("max_pos = '$max_pos', scalar(");
printf("==== Checking revision %lu (%lu:%lu, %lu left)...",
$Rev, $Array[$min_pos], $Array[$max_pos-1], $max_pos - $min_pos);
my $exit_code = test_ok($Want, $File, $Rev, $Exec, $Before, $After);
if ($exit_code != $Opt{'want'}) {
print("NOT FOUND (code $exit_code), going up\n");
$min_pos = $mid_pos;
D("min_pos set to '$mid_pos'");
if (!$last_good || ($Rev > $last_good)) {
$last_good = $Rev;
}
} else {
print("FOUND (code $exit_code), going down\n");
$max_pos = $mid_pos;
D("max_pos set to '$mid_pos'");
if (!$first_fail || ($Rev < $first_fail)) {
$first_fail = $Rev;
}
}
$has_checked = 1;
$last_mid = $mid_pos;
}
print($first_fail
? "Found at r$first_fail. "
: "Condition not found. "
);
print($last_good
? "Last revision where the test fails at r$last_good.\n"
: "Condition found in all revisions.\n"
);
# }}}
} # find_revision()
sub revisions {
# Return an array of revision numbers from a specific revision range
# for a version controlled element
# {{{
my ($File, $Start, $End) = @_;
D("revisions('$File', '$Start', '$End')");
my $safe_file = escape_filename($File);
my $Data = "";
my @Revs = ();
my $pipe_cmd = "$CMD_SVN log --xml -r$Start:$End $safe_file\@$End |";
D("opening pipe '$pipe_cmd'");
if (open(PipeFP, $pipe_cmd)) {
$Data = join("", <PipeFP>);
close(PipeFP);
$Data =~ s/<logentry\b.*?\brevision="(\d+)".*?>/push(@Revs, "$1")/egs;
}
if ($Revs[0] eq $Start) {
# splice(@Revs, 0, 1);
}
return(@Revs);
# }}}
} # revisions()
sub mysyst {
# Customised system() {{{
my @Args = @_;
my $system_txt = sprintf("system(\"%s\");", join("\", \"", @Args));
D("$system_txt");
deb_wait();
msg(1, "@_\n");
system(@_);
# }}}
} # mysyst()
sub escape_filename {
# Kludge for handling file names with spaces and characters that
# trigger shell functions
# {{{
my $Name = shift;
# $Name =~ s/\\/\\\\/g;
# $Name =~ s/([ \t;\|!&"'`#\$\(\)<>\*\?])/\\$1/g;
$Name =~ s/'/\\'/g;
$Name = "'$Name'";
return($Name);
# }}}
} # escape_filename()
sub deb_wait {
# Wait until Enter is pressed if $Debug and verbose >= 2 {{{
$Debug || return;
if ($Opt{'verbose'} >= 2) {
print("debug: Press ENTER...");
<STDIN>;
}
# }}}
} # deb_wait()
sub test_ok {
# {{{
my ($Want, $File, $Rev, $Exec, $Before, $After) = @_;
my $Retval;
D("test_ok(Want='$Want', File='$File', Rev='$Rev', Exec='$Exec', Before='$Before', After='$After')");
print("svn update...");
if ($Opt{'ignore-externals'}) {
mysyst($CMD_SVN, "update", "--ignore-externals", "-q", "-r$Rev", $File);
} else {
mysyst($CMD_SVN, "update", "-q", "-r$Rev", $File);
}
if (length($Before)) {
print("execute before:\n");
mysyst($Before);
}
print("run test:\n");
$Retval = mysyst($Exec);
if (length($After)) {
print("execute after:\n");
mysyst($After);
}
D("test_ok() returns '$Retval'");
return($Retval);
# }}}
} # test_ok()
sub print_version {
# Print program version {{{
print("$progname v$VERSION\n");
# }}}
} # print_version()
sub usage {
# Send the help message to stdout {{{
my $Retval = shift;
if ($Opt{'verbose'}) {
print("\n");
print_version();
}
print(<<END);
Usage: $progname [options] [path]
Do a binary search through revisions of a Subversion working copy for
special conditions. A test script/command and script/command before and
after each test can be supplied. The script will search through the
specified revisions (or 1:HEAD if missing) until it finds the first
revision the test script succeeds.
Test script return values:
0 (or a value specified with -w/--want) means that the condition is
true, and it tries a lower revision number next time.
Anything else means the test has failed, and it tries a higher
revision next time.
A path can be specified; the program will operate on this element, and
using the same revision range as the element.
Options:
-A x, --after x
Execute command x after the test has run.
-B x, --before x
Execute command x before the test is run.
-e x, --exec x
Execute command x to check revisions.
-h, --help
Show this help.
--ignore-externals
Don’t update svn externals.
-r x:y, --revision x:y
Limit the search to revision range x:y. Default: 1:HEAD.
-v, --verbose
Increase level of verbosity. Can be repeated.
-w x, --want x
Search for return code x instead of the default 0.
--version
Print version information.
--debug
Print debugging messages.
END
exit($Retval);
# }}}
} # usage()
sub msg {
# Print a status message to stderr based on verbosity level {{{
my ($verbose_level, $Txt) = @_;
if ($Opt{'verbose'} >= $verbose_level) {
print(STDERR "$progname: $Txt\n");
}
# }}}
} # msg()
sub D {
# Print a debugging message {{{
$Debug || return;
my @call_info = caller;
chomp(my $Txt = shift);
my $File = $call_info[1];
$File =~ s#\\#/#g;
$File =~ s#^.*/(.*?)$#$1#;
print(STDERR "$File:$call_info[2] $$ $Txt\n");
return("");
# }}}
} # D()
__END__
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.
# If not, see L<http://www.gnu.org/licenses/>.
# vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :
Jump to Line
Something went wrong with that request. Please try again.