getsvnfiles

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # getsvnfiles
   5 # File ID: 21045066-f743-11dd-9679-000475e441b9
   6 # [Description]
   7 #
   8 # Character set: UTF-8
   9 # ©opyleft 2008– Ø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 use File::Temp;
  18
  19 $| = 1;
  20
  21 our $Debug = 0;
  22
  23 our %Opt = (
  24
  25     'debug' => 0,
  26     'dest' => "",
  27     'dry-run' => 0,
  28     'help' => 0,
  29     'revisions' => "",
  30     'source' => "",
  31     'verbose' => 0,
  32     'version' => 0,
  33
  34 );
  35
  36 our $progname = $0;
  37 $progname =~ s/^.*\/(.*?)$/$1/;
  38 our $VERSION = "0.00";
  39
  40 Getopt::Long::Configure("bundling");
  41 GetOptions(
  42
  43     "debug" => \$Opt{'debug'},
  44     "dest|d=s" => \$Opt{'dest'},
  45     "dry-run" => \$Opt{'dry-run'},
  46     "help|h" => \$Opt{'help'},
  47     "revisions|r=s" => \$Opt{'revisions'},
  48     "source|s=s" => \$Opt{'source'},
  49     "verbose|v+" => \$Opt{'verbose'},
  50     "version" => \$Opt{'version'},
  51
  52 ) || die("$progname: Option error. Use -h for help.\n");
  53
  54 $Opt{'debug'} && ($Debug = 1);
  55 $Opt{'help'} && usage(0);
  56 if ($Opt{'version'}) {
  57     print_version();
  58     exit(0);
  59 }
  60
  61 my $Lh = "[0-9a-fA-F]";
  62 my $v1_templ = "$Lh\{8}-$Lh\{4}-1$Lh\{3}-$Lh\{4}-$Lh\{12}";
  63
  64 my $CMD_SVN = "svn";
  65 my $PROP_PREFIX = "getsvnfiles:";
  66 my %Prop = (
  67     'author' => "${PROP_PREFIX}author",
  68     'date' => "${PROP_PREFIX}date",
  69     'log' => "${PROP_PREFIX}log",
  70     'revision' => "${PROP_PREFIX}revision",
  71     'source' => "${PROP_PREFIX}source",
  72 );
  73
  74 my @Revs = ();
  75 my ($start_rev, $end_rev);
  76
  77 my $missing_args = 0;
  78 for my $chkdef (qw{source dest revisions}) {
  79     length($Opt{$chkdef}) ||
  80         (warn("$progname: --$chkdef option not defined\n"), $missing_args = 1);
  81 }
  82 $missing_args && exit(1);
  83
  84 if ($Opt{'revisions'} =~ /^(\d+):(\d+|head)$/i) {
  85     ($start_rev, $end_rev) = (uc($1), uc($2));
  86 } else {
  87     die("$progname: \"$Opt{'revisions'}\": " .
  88         "Invalid format of --revisions argument\n");
  89 }
  90
  91 if (!-f $Opt{'dest'}) {
  92     die("$progname: $Opt{'dest'}: File does not exist\n");
  93 }
  94
  95 @Revs = revisions($Opt{'source'}, $start_rev, $end_rev);
  96
  97 D(sprintf("\@Revs = '%s'\n", join(", ", @Revs)));
  98
  99 my $tmpfile_logmsg = mktemp("$progname-logmsg-XXXXXX");
 100 my $tmpfile_propset = mktemp("$progname-propset-XXXXXX");
 101 mysyst($CMD_SVN, "update", $Opt{'dest'});
 102 for my $curr_rev (@Revs) {
 103     print(STDERR "======== $progname: Downloading revision $curr_rev ========\n");
 104
 105     if (!$Opt{'dry-run'}) {
 106         my %rev_info = revision_info($Opt{'source'}, $curr_rev);
 107         my $log_msg = log_message($Opt{'source'}, $curr_rev);
 108         if (open(LogMsgFP, ">", $tmpfile_logmsg)) {
 109             print(LogMsgFP prepare_logmsg($log_msg));
 110             chomp(my $uuid = `suuid -t $progname -w eo -c "Commit r$curr_rev of $Opt{'dest'} from $Opt{'source'}"`);
 111             print(LogMsgFP "\n$uuid");
 112             close(LogMsgFP);
 113             if (!defined($uuid) || $uuid !~ /^$v1_templ$/) {
 114                 unlink($tmpfile_logmsg)
 115                     || warn("$progname: $tmpfile_logmsg: Cannot delete temp file: $!\n");
 116                 die("$progname: suuid error, aborting.\n");
 117             }
 118         } else {
 119             die("$progname: $tmpfile_logmsg: Cannot create file: $!\n");
 120         }
 121         if (open(CatFP, "$CMD_SVN cat $Opt{'source'} -r$curr_rev |")) {
 122             if (open(DestFP, ">", $Opt{'dest'})) {
 123                 while (<CatFP>) {
 124                     print(DestFP $_);
 125                 }
 126                 close(DestFP);
 127             } else {
 128                 die("$progname: $Opt{'dest'}: Cannot open file for write: $!\n");
 129             }
 130             close(CatFP);
 131         } else {
 132             die("$progname: Cannot open \"svn cat\" pipe: $!\n");
 133         }
 134         svn_propset($Prop{'source'}, $Opt{'source'}, $Opt{'dest'});
 135         svn_propset($Prop{'revision'}, $curr_rev, $Opt{'dest'});
 136         svn_propset($Prop{'date'}, $rev_info{'date'}, $Opt{'dest'});
 137         svn_propset($Prop{'author'}, $rev_info{'author'}, $Opt{'dest'});
 138         svn_propset($Prop{'log'}, $rev_info{'log'}, $Opt{'dest'});
 139         mysyst($CMD_SVN, "commit", "-F", $tmpfile_logmsg, $Opt{'dest'});
 140     }
 141 }
 142 if (!$Opt{'dry-run'}) {
 143     mysyst($CMD_SVN, "propdel", $Prop{'author'}, $Opt{'dest'});
 144     mysyst($CMD_SVN, "propdel", $Prop{'date'}, $Opt{'dest'});
 145     mysyst($CMD_SVN, "propdel", $Prop{'log'}, $Opt{'dest'});
 146     mysyst($CMD_SVN, "propdel", $Prop{'revision'}, $Opt{'dest'});
 147     mysyst($CMD_SVN, "propdel", $Prop{'source'}, $Opt{'dest'});
 148     my $file_loc = file_location($Opt{'dest'});
 149     if (open(LogMsgFP, ">", $tmpfile_logmsg)) {
 150         print(LogMsgFP
 151             sprintf(
 152                 "%s: %u revision%s between r%s:%s downloaded from\n" .
 153                 "<%s>.\n" .
 154                 "\n" .
 155                 "* %s\n" .
 156                 "  Deleted download properties.\n" .
 157                 "\n" .
 158                 "%s",
 159                 $progname, scalar(@Revs), scalar(@Revs) == 1 ? "" : "s",
 160                 $start_rev, $end_rev, $Opt{'source'},
 161                 file_location($Opt{'dest'}),
 162                 `suuid -t $progname -w eo -c "Delete download properties from $Opt{'dest'}, downloaded from $Opt{'source'}"`
 163             )
 164         );
 165         close(LogMsgFP);
 166     } else {
 167         die("$progname: $tmpfile_logmsg: Cannot open file for write: $!\n");
 168     }
 169
 170     mysyst($CMD_SVN, "commit", "-F", $tmpfile_logmsg, $Opt{'dest'});
 171     unlink($tmpfile_logmsg);
 172 }
 173
 174 sub file_location {
 175     # Find the repository location for a file {{{
 176     my $File = shift;
 177     my $Info = `$CMD_SVN info --xml $File`;
 178     my ($Url, $Root) = ("", "");
 179     $Info =~ /<url>(.*?)<\/url>/s && ($Url = $1);
 180     $Info =~ /<root>(.*?)<\/root>/s && ($Root = $1);
 181     my $Retval = substr($Url, length($Root));
 182     return($Retval);
 183     # }}}
 184 } # file_location()
 185
 186 sub svn_propset {
 187     # Set file property for a file {{{
 188     my ($Propname, $Propval, $Dest) = @_;
 189     D("svn_propset('$Propname', '$Propval', '$Dest');");
 190     if (open(PropFP, ">", $tmpfile_propset)) {
 191         print(PropFP $Propval);
 192         close(PropFP);
 193     } else {
 194         die("$progname: $tmpfile_propset: Cannot create file: $!\n");
 195     }
 196     mysyst($CMD_SVN, "propset", $Propname, "-F", $tmpfile_propset, $Dest);
 197     unlink($tmpfile_propset);
 198     # }}}
 199 } # svn_propset()
 200
 201 sub prepare_logmsg {
 202     # {{{
 203     my $Txt = shift;
 204     $Txt = "# $Txt";
 205     $Txt =~ s/(\n)/$1# /gs;
 206     $Txt =~ s/# $//s;
 207     $Txt =~ s/\n# \n/\n#\n/gs;
 208     $Txt =~ s/\n# \n/\n#\n/gs;
 209     $Txt =~ s/#\n(# ------------------------------------------------------------------------\n)/$1/gs;
 210     $Txt =~ s/^# ------------------------------------------------------------------------\n//s;
 211     $Txt =~ s/# ------------------------------------------------------------------------\n$//s;
 212     return($Txt);
 213     # }}}
 214 } # prepare_logmsg()
 215
 216 sub log_message {
 217     # Return log message for a specific revision {{{
 218     my ($Source, $Rev) = @_;
 219     my $Retval = `$CMD_SVN log -r$Rev $Source`;
 220     return($Retval);
 221     # }}}
 222 } # log_message()
 223
 224 sub revision_info {
 225     # Return raw log message for a specific revision {{{
 226     my ($Source, $Rev) = @_;
 227     my %Retval = ();
 228     my $Xml = `$CMD_SVN log --xml -r$Rev $Source`;
 229     $Xml =~ /<author>(.*?)<\/author>/s && ($Retval{'author'} = xml_to_txt($1));
 230     $Xml =~ /<date>(.*?)<\/date>/s && ($Retval{'date'} = xml_to_txt($1));
 231     $Xml =~ /<msg>(.*?)<\/msg>/s && ($Retval{'log'} = xml_to_txt($1));
 232     # $Retval =~ s/^.*<msg>(.*?)<\/msg>.*$/$1/s;
 233     return(%Retval);
 234     # }}}
 235 } # revision_info()
 236
 237 sub revisions {
 238     # Return an array of revision numbers from a specific revision range
 239     # for a version controlled element
 240     # {{{
 241     my ($File, $Start, $End) = @_;
 242     D("revisions('$File', '$Start', '$End')");
 243     my $safe_file = escape_filename($File);
 244     my $Data = "";
 245     my @Revs = ();
 246
 247     if (open(PipeFP, "$CMD_SVN log --xml -r$Start:$End $safe_file |")) {
 248         $Data = join("", <PipeFP>);
 249         close(PipeFP);
 250         $Data =~ s/<logentry\b.*?\brevision="(\d+)".*?>/push(@Revs, "$1")/egs;
 251     }
 252     return(@Revs);
 253     # }}}
 254 } # revisions()
 255
 256 sub escape_filename {
 257     # Kludge for handling file names with spaces and characters that
 258     # trigger shell functions
 259     # {{{
 260     my $Name = shift;
 261     # $Name =~ s/\\/\\\\/g;
 262     # $Name =~ s/([ \t;\|!&"'`#\$\(\)<>\*\?])/\\$1/g;
 263     $Name =~ s/'/\\'/g;
 264     $Name = "'$Name'";
 265     return($Name);
 266     # }}}
 267 } # escape_filename()
 268
 269 sub xml_to_txt {
 270     # Convert XML data to plain text {{{
 271     my $Txt = shift;
 272     $Txt =~ s/&lt;/</gs;
 273     $Txt =~ s/&gt;/>/gs;
 274     $Txt =~ s/&amp;/&/gs;
 275     return($Txt);
 276     # }}}
 277 } # xml_to_txt()
 278
 279 sub mysyst {
 280     # Customised system() {{{
 281     my @Args = @_;
 282     msg(1, sprintf("%s \"%s\"", $Opt{'dry-run'} ? "Simulating" : "Executing", join(" ", @Args)));
 283     $Opt{'dry-run'} || system(@Args);
 284     # }}}
 285 } # mysyst()
 286
 287 sub deb_wait {
 288     # Wait until Enter is pressed if --debug {{{
 289     $Debug || return;
 290     print(STDERR "debug: Press ENTER...");
 291     <STDIN>;
 292     # }}}
 293 } # deb_wait()
 294
 295 sub print_version {
 296     # Print program version {{{
 297     print("$progname v$VERSION\n");
 298     # }}}
 299 } # print_version()
 300
 301 sub usage {
 302     # Send the help message to stdout {{{
 303     my $Retval = shift;
 304
 305     if ($Opt{'verbose'}) {
 306         print("\n");
 307         print_version();
 308     }
 309     print(<<END);
 310
 311 Usage: $progname [OPTIONS] -s SOURCE -d DEST -r STARTREV:ENDREV
 312
 313 Copy all revisions of a file from a remote repository into a local file
 314 and commit it with the log message from the remote repository. Does not
 315 handle file properties yet.
 316
 317 Options:
 318
 319   -d X, --dest X
 320     Use X as local file destination.
 321   --dry-run
 322     Don’t make any changes, only simulate.
 323   -h, --help
 324     Show this help.
 325   -r X:Y, --revision X:Y
 326     Copy revision range X:Y from remote repository.
 327   -s X, --source X
 328     Source file to download from remote repository.
 329   -v, --verbose
 330     Increase level of verbosity. Can be repeated.
 331   --version
 332     Print version information.
 333   --debug
 334     Print debugging messages.
 335
 336 END
 337     exit($Retval);
 338     # }}}
 339 } # usage()
 340
 341 sub msg {
 342     # Print a status message to stderr based on verbosity level {{{
 343     my ($verbose_level, $Txt) = @_;
 344
 345     if ($Opt{'verbose'} >= $verbose_level) {
 346         print(STDERR "$progname: $Txt\n");
 347     }
 348     # }}}
 349 } # msg()
 350
 351 sub D {
 352     # Print a debugging message {{{
 353     $Debug || return;
 354     my @call_info = caller;
 355     chomp(my $Txt = shift);
 356     my $File = $call_info[1];
 357     $File =~ s#\\#/#g;
 358     $File =~ s#^.*/(.*?)$#$1#;
 359     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 360     return("");
 361     # }}}
 362 } # D()
 363
 364 __END__
 365
 366 # Plain Old Documentation (POD) {{{
 367
 368 =pod
 369
 370 =head1 NAME
 371
 372
 373
 374 =head1 SYNOPSIS
 375
 376  [options] [file [files [...]]]
 377
 378 =head1 DESCRIPTION
 379
 380
 381
 382 =head1 OPTIONS
 383
 384 =over 4
 385
 386 =item B<-h>, B<--help>
 387
 388 Print a brief help summary.
 389
 390 =item B<-v>, B<--verbose>
 391
 392 Increase level of verbosity. Can be repeated.
 393
 394 =item B<--version>
 395
 396 Print version information.
 397
 398 =item B<--debug>
 399
 400 Print debugging messages.
 401
 402 =back
 403
 404 =head1 BUGS
 405
 406
 407
 408 =head1 AUTHOR
 409
 410 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 411
 412 =head1 COPYRIGHT
 413
 414 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 415 This is free software; see the file F<COPYING> for legalese stuff.
 416
 417 =head1 LICENCE
 418
 419 This program is free software: you can redistribute it and/or modify it
 420 under the terms of the GNU General Public License as published by the
 421 Free Software Foundation, either version 2 of the License, or (at your
 422 option) any later version.
 423
 424 This program is distributed in the hope that it will be useful, but
 425 WITHOUT ANY WARRANTY; without even the implied warranty of
 426 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 427 See the GNU General Public License for more details.
 428
 429 You should have received a copy of the GNU General Public License along
 430 with this program.
 431 If not, see L<http://www.gnu.org/licenses/>.
 432
 433 =head1 SEE ALSO
 434
 435 =cut
 436
 437 # }}}
 438
 439 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :