findrev

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # findrev
   5 # File ID: f240c034-f742-11dd-a833-000475e441b9
   6 # Locate a Subversion revision based on used defined criteras.
   7 #
   8 # Character set: UTF-8
   9 # ©opyleft 2007– Øyvind A. Holm <sunny@sunbase.org>
  10 # License: GNU General Public License version 2 or later, see end of
  11 # file for legal stuff.
  12 #=======================================================================
  13
  14 use strict;
  15 use warnings;
  16 use Getopt::Long;
  17
  18 $| = 1;
  19
  20 our $Debug = 0;
  21
  22 our %Opt = (
  23
  24     'after' => "",
  25     'before' => "",
  26     'debug' => 0,
  27     'exec' => "",
  28     'help' => 0,
  29     'ignore-externals' => 0,
  30     'revision' => "",
  31     'verbose' => 0,
  32     'version' => 0,
  33     'want' => 0,
  34
  35 );
  36
  37 our $progname = $0;
  38 $progname =~ s/^.*\/(.*?)$/$1/;
  39 our $VERSION = "0.00";
  40
  41 my $CMD_SVN = "svn";
  42
  43 Getopt::Long::Configure("bundling");
  44 GetOptions(
  45
  46     "after|A=s" => \$Opt{'after'},
  47     "before|B=s" => \$Opt{'before'},
  48     "debug" => \$Opt{'debug'},
  49     "exec|e=s" => \$Opt{'exec'},
  50     "help|h" => \$Opt{'help'},
  51     "ignore-externals" => \$Opt{'ignore-externals'},
  52     "revision|r=s" => \$Opt{'revision'},
  53     "verbose|v+" => \$Opt{'verbose'},
  54     "version" => \$Opt{'version'},
  55     "want|w=s" => \$Opt{'want'},
  56
  57 ) || die("$progname: Option error. Use -h for help.\n");
  58
  59 $Opt{'debug'} && ($Debug = 1);
  60 $Opt{'help'} && usage(0);
  61 if ($Opt{'version'}) {
  62     print_version();
  63     exit(0);
  64 }
  65
  66 my ($Start, $End) = (1, "HEAD");
  67
  68 if (length($Opt{'revision'})) {
  69     if ($Opt{'revision'} =~ /^(\d*):(\d*|head)$/i) {
  70         D("regexp good");
  71         length($1) && ($Start = $1);
  72         length($2) && ($End = $2);
  73     } else {
  74         die("$progname: Invalid revision range in --revision (-r) parameter\n");
  75     }
  76 }
  77
  78 D("Start = '$Start', End = '$End'");
  79
  80 if (!length($Opt{'exec'})) {
  81     die("$progname: No --exec (-e) parameter specified. You might want to consult '$progname --help'.\n");
  82 }
  83
  84 my $File;
  85
  86 if ($#ARGV == -1) {
  87     $File = ".";
  88 } elsif ($#ARGV == 0) {
  89     $File = $ARGV[0];
  90 } else {
  91     die("$progname: Only one file or directory name allowed\n");
  92 }
  93
  94 find_revision($Opt{'want'}, $File, $Start, $End, $Opt{'exec'}, $Opt{'before'}, $Opt{'after'});
  95
  96 my $Found = 0;
  97
  98 sub find_revision {
  99     # Scan a specific revision range for the first merge conflict and
 100     # return the revision number
 101     # {{{
 102     my ($Want, $File, $Start, $End, $Exec, $Before, $After) = @_;
 103
 104     D("find_revision('$Want', '$File', '$Start', '$End', '$Exec', '$Before', '$After')");
 105     print("$progname: $File: Scanning revision range r$Start:$End " .
 106           "for return value $Want\n");
 107     my @Array = revisions($File, $Start, $End);
 108     if (!scalar(@Array)) {
 109         print("No revisions found.\n");
 110         return undef;
 111     }
 112
 113     my $rev_count = scalar(@Array);
 114     printf("$rev_count revision%s to check\n", $rev_count == 1 ? "" : "s");
 115     print("(" . join(", ", @Array) . ")\n");
 116
 117     my $min_block = 0;
 118     my ($min_pos, $max_pos) = (0, $rev_count);
 119
 120     my $last_mid = 0;
 121     my $first_fail = 0;
 122     my $last_good = 0;
 123     my $has_checked = 0;
 124
 125     while (1) {
 126         my $mid_pos = int(($min_pos + $max_pos) / 2);
 127         last if ($has_checked && ($mid_pos == $last_mid));
 128         my $Rev = $Array[$mid_pos];
 129         D("max_pos = '$max_pos', scalar(");
 130         printf("==== Checking revision %lu (%lu:%lu, %lu left)...",
 131             $Rev, $Array[$min_pos], $Array[$max_pos-1], $max_pos - $min_pos);
 132         my $exit_code = test_ok($Want, $File, $Rev, $Exec, $Before, $After);
 133         if ($exit_code != $Opt{'want'}) {
 134             print("NOT FOUND (code $exit_code), going up\n");
 135             $min_pos = $mid_pos;
 136             D("min_pos set to '$mid_pos'");
 137             if (!$last_good || ($Rev > $last_good)) {
 138                 $last_good = $Rev;
 139             }
 140         } else {
 141             print("FOUND (code $exit_code), going down\n");
 142             $max_pos = $mid_pos;
 143             D("max_pos set to '$mid_pos'");
 144             if (!$first_fail || ($Rev < $first_fail)) {
 145                 $first_fail = $Rev;
 146             }
 147         }
 148         $has_checked = 1;
 149         $last_mid = $mid_pos;
 150     }
 151     print($first_fail
 152         ? "Found at r$first_fail. "
 153         : "Condition not found. "
 154     );
 155     print($last_good
 156         ? "Last revision where the test fails at r$last_good.\n"
 157         : "Condition found in all revisions.\n"
 158     );
 159
 160     # }}}
 161 } # find_revision()
 162
 163 sub revisions {
 164     # Return an array of revision numbers from a specific revision range
 165     # for a version controlled element
 166     # {{{
 167     my ($File, $Start, $End) = @_;
 168     D("revisions('$File', '$Start', '$End')");
 169     my $safe_file = escape_filename($File);
 170     my $Data = "";
 171     my @Revs = ();
 172
 173     my $pipe_cmd = "$CMD_SVN log --xml -r$Start:$End $safe_file\@$End |";
 174     D("opening pipe '$pipe_cmd'");
 175     if (open(PipeFP, $pipe_cmd)) {
 176         $Data = join("", <PipeFP>);
 177         close(PipeFP);
 178         $Data =~ s/<logentry\b.*?\brevision="(\d+)".*?>/push(@Revs, "$1")/egs;
 179     }
 180     if ($Revs[0] eq $Start) {
 181         # splice(@Revs, 0, 1);
 182     }
 183     return(@Revs);
 184     # }}}
 185 } # revisions()
 186
 187 sub mysyst {
 188     # Customised system() {{{
 189     my @Args = @_;
 190     my $system_txt = sprintf("system(\"%s\");", join("\", \"", @Args));
 191     D("$system_txt");
 192     deb_wait();
 193     msg(1, "@_\n");
 194     system(@_);
 195     # }}}
 196 } # mysyst()
 197
 198 sub escape_filename {
 199     # Kludge for handling file names with spaces and characters that
 200     # trigger shell functions
 201     # {{{
 202     my $Name = shift;
 203     # $Name =~ s/\\/\\\\/g;
 204     # $Name =~ s/([ \t;\|!&"'`#\$\(\)<>\*\?])/\\$1/g;
 205     $Name =~ s/'/\\'/g;
 206     $Name = "'$Name'";
 207     return($Name);
 208     # }}}
 209 } # escape_filename()
 210
 211 sub deb_wait {
 212     # Wait until Enter is pressed if $Debug and verbose >= 2 {{{
 213     $Debug || return;
 214     if ($Opt{'verbose'} >= 2) {
 215         print("debug: Press ENTER...");
 216         <STDIN>;
 217     }
 218     # }}}
 219 } # deb_wait()
 220
 221 sub test_ok {
 222     # {{{
 223     my ($Want, $File, $Rev, $Exec, $Before, $After) = @_;
 224     my $Retval;
 225
 226     D("test_ok(Want='$Want', File='$File', Rev='$Rev', Exec='$Exec', Before='$Before', After='$After')");
 227     print("svn update...");
 228     if ($Opt{'ignore-externals'}) {
 229         mysyst($CMD_SVN, "update", "--ignore-externals", "-q", "-r$Rev", $File);
 230     } else {
 231         mysyst($CMD_SVN, "update", "-q", "-r$Rev", $File);
 232     }
 233     if (length($Before)) {
 234         print("execute before:\n");
 235         mysyst($Before);
 236     }
 237     print("run test:\n");
 238     $Retval = mysyst($Exec);
 239     if (length($After)) {
 240         print("execute after:\n");
 241         mysyst($After);
 242     }
 243     D("test_ok() returns '$Retval'");
 244     return($Retval);
 245     # }}}
 246 } # test_ok()
 247
 248 sub print_version {
 249     # Print program version {{{
 250     print("$progname v$VERSION\n");
 251     # }}}
 252 } # print_version()
 253
 254 sub usage {
 255     # Send the help message to stdout {{{
 256     my $Retval = shift;
 257
 258     if ($Opt{'verbose'}) {
 259         print("\n");
 260         print_version();
 261     }
 262     print(<<END);
 263
 264 Usage: $progname [options] [path]
 265
 266 Do a binary search through revisions of a Subversion working copy for
 267 special conditions. A test script/command and script/command before and
 268 after each test can be supplied. The script will search through the
 269 specified revisions (or 1:HEAD if missing) until it finds the first
 270 revision the test script succeeds.
 271
 272 Test script return values:
 273   0 (or a value specified with -w/--want) means that the condition is
 274     true, and it tries a lower revision number next time.
 275   Anything else means the test has failed, and it tries a higher
 276     revision next time.
 277
 278 A path can be specified; the program will operate on this element, and
 279 using the same revision range as the element.
 280
 281 Options:
 282
 283   -A x, --after x
 284     Execute command x after the test has run.
 285   -B x, --before x
 286     Execute command x before the test is run.
 287   -e x, --exec x
 288     Execute command x to check revisions.
 289   -h, --help
 290     Show this help.
 291   --ignore-externals
 292     Don’t update svn externals.
 293   -r x:y, --revision x:y
 294     Limit the search to revision range x:y. Default: 1:HEAD.
 295   -v, --verbose
 296     Increase level of verbosity. Can be repeated.
 297   -w x, --want x
 298     Search for return code x instead of the default 0.
 299   --version
 300     Print version information.
 301   --debug
 302     Print debugging messages.
 303
 304 END
 305     exit($Retval);
 306     # }}}
 307 } # usage()
 308
 309 sub msg {
 310     # Print a status message to stderr based on verbosity level {{{
 311     my ($verbose_level, $Txt) = @_;
 312
 313     if ($Opt{'verbose'} >= $verbose_level) {
 314         print(STDERR "$progname: $Txt\n");
 315     }
 316     # }}}
 317 } # msg()
 318
 319 sub D {
 320     # Print a debugging message {{{
 321     $Debug || return;
 322     my @call_info = caller;
 323     chomp(my $Txt = shift);
 324     my $File = $call_info[1];
 325     $File =~ s#\\#/#g;
 326     $File =~ s#^.*/(.*?)$#$1#;
 327     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 328     return("");
 329     # }}}
 330 } # D()
 331
 332 __END__
 333
 334 # This program is free software: you can redistribute it and/or modify
 335 # it under the terms of the GNU General Public License as published by
 336 # the Free Software Foundation, either version 2 of the License, or (at
 337 # your option) any later version.
 338 #
 339 # This program is distributed in the hope that it will be useful, but
 340 # WITHOUT ANY WARRANTY; without even the implied warranty of
 341 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 342 # See the GNU General Public License for more details.
 343 #
 344 # You should have received a copy of the GNU General Public License
 345 # along with this program.
 346 # If not, see L<http://www.gnu.org/licenses/>.
 347
 348 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :