Attachment 'vss2hg.pl'

Download

   1 #!/usr/bin/perl
   2 #
   3 # VSS-to-Mercurial migration script v1.03 by Andy Duplain (trojanfoe@gmail.com)
   4 #
   5 # Based on the VSS-to-Subversion script by:
   6 # Brett Wooldridge, Daniel Dragnea, Magnus Hyllander and Neil Sleightholm.
   7 # (See: http://neilsleightholm.blogspot.com)
   8 #
   9 # Future updates to this script will be uploaded to:
  10 # http://trojanfoe.googlepages.com/visualsourcesafetomercurialmigrationtool
  11 #
  12 # Typical usage:
  13 #
  14 # C:\> vss2hg.pl --ssrepo=C:\path\to\vssrepo --sshome="C:\Program Files\Microsoft Visual Studio\VSS\win32" $/vssproj1
  15 #
  16 # (specify the full path to both ssrepo and sshome).
  17 #
  18 # This will create a Mercurial repository called 'hgrepo' in the current
  19 # directory - this can then be cloned or copied to its final destination.
  20 #
  21 # Version History
  22 # 1.03  11-Aug-2009 Allow VSS binaries to be invoked on Linux using Wine.
  23 # 1.02	09-Feb-2009 Don't append '+' to comment within build_atoms().
  24 # 1.01  30-Jan-2009 Fix bug in label comment.
  25 # 1.00	29-Jan-2009 Initial
  26 #
  27 
  28 my $VERSION = "1.03";
  29 
  30 use strict;
  31 use POSIX;
  32 use File::Path;
  33 
  34 # Set $USE_WINE to invoke SS.EXE using Wine
  35 my $USE_WINE = 0;
  36 
  37 # Set $US_DATE_FORMAT > 0 if VSS generates dates in US format (MM-DD-YY),
  38 # else 0 if it generates dates in UK format (DD-MM-YY)
  39 my $US_DATE_FORMAT = 1;
  40 
  41 # Adjust for Windows/Linux...
  42 my $WINDOWS = 1;
  43 my $FILESEP = '\\';
  44 
  45 my $DEBUG = 1;
  46 
  47 my $RESUME = 0;
  48 my $RESUMEAFTERATOM = '';
  49 my $MIGRATELATEST = 0;
  50 my $DUMPUSERS = 0;
  51 my $FORCEUSER = '';
  52 my $SSREPO = '';
  53 my $SSPROJ = '';
  54 my $SSHOME = '';
  55 my $SSCMD = '';
  56 my $CUTOFFDATE = 0;
  57 
  58 # This is the username and password used for migration operations
  59 my $USERNAME = 'admin';
  60 my $PASSWORD = 'admin';
  61 
  62 my $PHASE = 0;
  63 
  64 my @directorylist = ();
  65 my @filelist = ();
  66 my @histories = ();
  67 my %atomlist;
  68 my @atoms;
  69 
  70 my $datestring;
  71 
  72 if ($DEBUG == 1)
  73 {
  74     open(STDERR, "> vss2hg.log");
  75 }
  76 
  77 &parse_args(@ARGV);
  78 
  79 &setup();
  80 
  81 $datestring = prettydate();
  82 print "Migration started: $datestring\n";
  83 print STDERR "Migration started: $datestring\n";
  84 
  85 if ($MIGRATELATEST)
  86 {
  87     &get_latest_checkpoint();
  88 }
  89 elsif ($RESUME)
  90 {
  91     &resume();
  92 }
  93 
  94 if ($PHASE < 1)
  95 {
  96     print "Project: $SSPROJ\n";
  97     &build_directorylist($SSPROJ);
  98 }
  99 
 100 if ($PHASE < 2)
 101 {
 102     &build_filelist();
 103 }
 104 
 105 if ($PHASE < 3)
 106 {
 107     &build_histories();
 108     &dump_users();
 109 }
 110 
 111 if ($DUMPUSERS)
 112 {
 113     &dump_users_and_exit();
 114 }
 115 
 116 &build_atoms;
 117 
 118 if ($MIGRATELATEST)
 119 {
 120     print "\nHistory has now been refreshed. You can compare atoms.txt.1 with atoms.txt to\n";
 121     print "see if new data to be migrated has been checked in to the VSS repository after\n";
 122     print "the previous run. Also verify that the last line of extract-progress.txt lists\n";
 123     print "the last atom that was processed. When satisfied, you can process new atoms\n";
 124     print "with the --resume option.\n\n";
 125     exit;
 126 }
 127 
 128 if ($PHASE < 5)
 129 {
 130     &create_directories;
 131 }
 132 
 133 if ($PHASE < 6)
 134 {
 135     ##&checkout_directories;
 136 }
 137 
 138 &extract_and_import;
 139 
 140 if ($DEBUG)
 141 {
 142     close(DEBUG);
 143 }
 144 
 145 $datestring = prettydate();
 146 print "\nMigration complete: $datestring\n\n";
 147 print STDERR "\nMigration complete: $datestring\n\n";
 148 
 149 exit;
 150 
 151 
 152 ##############################################################
 153 # Parse Command-line arguments
 154 #
 155 sub parse_args
 156 {
 157     my $argc = @ARGV;
 158     if ($argc < 1)
 159     {
 160         print "vss2hg.pl: missing command arguments\n";
 161         print "Try 'vss2hg.pl --help' for more information\n\n";
 162         exit -1;
 163     }
 164 
 165     if ($ARGV[0] eq '--help')
 166     {
 167         print "Visual SourceSafe to Mercurial Migration Tool - v$VERSION\n\n";
 168         print "Usage: vss2hg.pl [options] project\n\n";
 169         print "Migrate a Visual SourceSafe project to Mercurial.\n\n";
 170         print "  --resume\t\tresume the migration from last checkpoint\n";
 171         print "\t\t\tlast checkpoint\n";
 172         print "  --ssrepo=<dir>\trepository path, e.g. \\\\share\\vss\n";
 173         print "  --sshome=<dir>\tVSS installation directory\n";
 174         print "  --force-user=<user>\tforce the files to be checked into Mercurial as\n";
 175         print "\t\t\tas user <user>\n";
 176         print "  --cutoff-date=<yyyymmdd>\tminimum date to import\n";
 177         print "  --dumpusers\t\tafter pre-processing the VSS repository, create a\n";
 178         print "\t\t\tusers.txt file which can be used to create comparable\n";
 179         print "\t\t\taccounts in Mercurial.  The migration can be resumed\n";
 180         print "\t\t\twithout penalty by using the --resume option\n\n";
 181         exit -1;
 182     }
 183 
 184     for (my $i = 0; $i < $argc; $i++)
 185     {
 186         my $arg = $ARGV[$i];
 187         if ($arg eq '--resume')
 188         {
 189             $RESUME = 1;
 190         }
 191         elsif ($arg =~ /--migrate-latest/)
 192         {
 193             $MIGRATELATEST = 1;
 194         }
 195         elsif ($arg eq '--dumpusers')
 196         {
 197             $DUMPUSERS = 1;
 198         }
 199         elsif ($arg =~ /--ssrepo=/)
 200         {
 201             $SSREPO = $';
 202         }
 203         elsif ($arg =~ /--sshome=/)
 204         {
 205             $SSHOME = $';
 206         }
 207         elsif ($arg =~ /--force-user=/)
 208         {
 209             $FORCEUSER = $';
 210         }
 211         elsif ($arg =~ /--cutoff-date=/)
 212         {
 213             # Convert parameter from yyyymmdd to a datetime
 214             my $dateparam = $';
 215             $CUTOFFDATE = POSIX::mktime(0, 0, 0, substr($dateparam, 6, 2), substr($dateparam, 4, 2) - 1, substr($dateparam, 0, 4) - 1900, -1, -1, -1);
 216         }
 217 		
 218 		$SSPROJ = $arg;
 219 	}
 220 
 221 	if ($SSPROJ !~ /^\$\/\w+/ && $SSPROJ ne '$/' )
 222 	{
 223 		print "Error: missing or invalid project specification, must be of the form \$/project or \$/\n\n";
 224 		exit -1;
 225 	}
 226 }
 227 
 228 
 229 ##############################################################
 230 # Check environment and setup globals
 231 #
 232 sub setup
 233 {
 234     $SSREPO = @ENV{'SSDIR'} unless length($SSREPO) > 0;
 235     if ($SSREPO eq '' || length($SSREPO) == 0)
 236     {
 237         die "Environment variable SSDIR must point to a SourceSafe repository.";
 238     }
 239     $SSHOME = @ENV{'SS_HOME'} unless length($SSHOME) > 0;
 240     if ($SSHOME eq '' || length($SSHOME) == 0)
 241     {
 242         die "Environment variable SS_HOME must point to where SS.EXE is located.";
 243     }
 244 
 245     $ENV{'SSDIR'} = $SSREPO;
 246     $SSCMD = "$SSHOME";
 247     if ($SSCMD !~ /^\".*/)
 248     {
 249         $SSCMD = "\"$SSCMD\"";
 250     }
 251     if ($USE_WINE > 0)
 252     {
 253         $SSCMD="wine $SSHOME/SS.EXE";
 254     }
 255     else
 256     {
 257         $SSCMD =~ s/\"(.*)\"/\"$1\\SS.EXE\"/;
 258     }
 259 
 260     my $banner = "Visual SourceSafe to Mercurial Migration Tool - v$VERSION\n" .
 261 			     "by Andy Duplain (trojanfoe\@gmail.com)\n" .
 262 				 "Based on the VSS-to-Subversion script by:\n" .
 263 				 "Brett Wooldridge, Daniel Dragnea, Magnus Hyllander and Neil Sleightholm.\n" .
 264 		         "SourceSafe repository: $SSREPO\n" .
 265                  "SourceSafe directory : $SSHOME\n" .
 266 				 "SourceSafe project   : $SSPROJ\n";
 267 
 268     if (0 == $CUTOFFDATE){
 269         $banner .= "History cut off      : not set\n\n";
 270     }else{
 271         $banner .= "History cut off      : " . POSIX::ctime($CUTOFFDATE) . "\n\n";
 272     }
 273     
 274     print "$banner";
 275     if ($DEBUG)
 276     {
 277         print STDERR "$banner";
 278     }
 279 }
 280 
 281 
 282 ##############################################################
 283 # Build project directory hierarchy
 284 #
 285 sub build_directorylist
 286 {
 287     my($proj) = @_;
 288 
 289     if ($DEBUG)
 290     {
 291         print STDERR "\n#############################################################\n";
 292         print STDERR "#              Subroutine: build_directorylist              #\n";
 293         print STDERR "#############################################################\n";
 294     }
 295 
 296     print "Building directory hierarchy...\n";
 297 
 298     my $oldcount = @directorylist;
 299 
 300     recursive_build_directorylist($proj);
 301 
 302     sort(@directorylist);
 303     open(DIRS, "> directories.txt");
 304     foreach my $dir (@directorylist)
 305     {
 306         print DIRS "$dir\n";
 307     }
 308     close(DIRS);
 309 
 310     my $count = @directorylist - $oldcount;
 311     print "\b\b\b:\tdone ($count dirs)\n";
 312 
 313     $PHASE = 1;
 314 }
 315 
 316 sub recursive_build_directorylist
 317 {
 318     my ($proj) = @_;
 319     push @directorylist, $proj;
 320 
 321     my $cmd = $SSCMD . " Dir \"$proj\" -I- -F-";
 322     $_ = `$cmd`;
 323     if ($DEBUG) {
 324         print STDERR "\nDirectory listing of $proj:\n$_";
 325         print "\n$proj";
 326     }
 327 
 328     my @lines;
 329 
 330     if ($WINDOWS > 0) {
 331         @lines = split("\n");
 332     } else {
 333 	@lines = split('\r\n');
 334     }
 335     
 336     foreach my $line (@lines)
 337     {
 338         chomp($line);
 339         if ($line =~ /^\$([^\/][^:]*)$/) {
 340             recursive_build_directorylist("$proj/$1");
 341         }
 342     }
 343 }
 344 
 345 
 346 ##############################################################
 347 # Build a list of files from the list of directories
 348 #
 349 sub build_filelist
 350 {
 351     if ($DEBUG)
 352     {
 353         print STDERR "\n#############################################################\n";
 354         print STDERR "#                Subroutine: build_filelist                 #\n";
 355         print STDERR "#############################################################\n";
 356     }
 357 
 358     my ($proj, $cmd, $i, $j, $count);
 359 
 360     print "Building file list (  0%):            ";
 361 
 362     $count = @directorylist;
 363 
 364     $i = 0;
 365     $j = 0.0;
 366     foreach $proj (@directorylist)
 367     {
 368         ###$* = 1;
 369         $/ = ':';
 370 
 371         $cmd = $SSCMD . " Dir -I- \"$proj\"";
 372         $_ = `$cmd`;
 373 
 374         # what this next expression does is to merge wrapped lines like:
 375         #    $/DeviceAuthority/src/com/eclyptic/networkdevicedomain/deviceinterrogator/excep
 376         #    tion:
 377         # into:
 378         #    $/DeviceAuthority/src/com/eclyptic/networkdevicedomain/deviceinterrogator/exception:
 379         s/\n((\w*\-*\.*\w*\/*)+\:)/$1/g;
 380 
 381         ###$* = 0;
 382         $/ = '';
 383 
 384         my @lines;
 385         
 386         if ($WINDOWS > 0) {
 387             @lines = split("\n");
 388         }
 389         else {
 390 	    @lines = split("\r\n");
 391         }
 392         
 393         LOOP: foreach my $line (@lines)
 394         {
 395             last LOOP if ($line eq '' || length($line) == 0);
 396 
 397             if ($line !~ /(.*)\:/ && $line !~ /^\$.*/ && $line !~ /^([0-9]+) item.*/ && $line !~ /^No items found.*/)
 398             {
 399                 # Pinned files are returned as "file;n" remove ";n"
 400                 my @file = split(/;/,$line);
 401                 # Exclude vss files e.g. files ending .vsscc, .vssscc, .vspscc etc
 402                 if (@file[0] =~ /.*\.\w{2,3}scc$/) 
 403                 {
 404                     print STDERR "Skipping VSS file: $proj/@file[0]\n";
 405                 }
 406                 else
 407                 {
 408                     push(@filelist, "$proj/@file[0]");
 409                     printf("\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b(%3d\%):      %-6d", (($j / $count) * 100), $i);
 410                     if ($DEBUG)
 411                     {
 412                         print STDERR "$proj/@file[0]\n";
 413                     }
 414                     $i++;
 415                 }
 416             }
 417         }
 418         $j++;
 419     }
 420 
 421     open(FILES,">files.txt");
 422     for my $file (@filelist)
 423     {
 424         print FILES "$file\n";
 425     }
 426     close(FILES);
 427 
 428     printf "\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b:             done ($i files)\n";
 429 
 430     $PHASE = 2;
 431 }
 432 
 433 
 434 ##############################################################
 435 # Build complete histories for all of the files in the project
 436 #
 437 sub build_histories
 438 {
 439     if ($DEBUG)
 440     {
 441         print STDERR "\n#############################################################\n";
 442         print STDERR "#                Subroutine: build_histories                #\n";
 443         print STDERR "#############################################################\n";
 444     }
 445 
 446     my ($file, $pad, $padding, $oldname, $shortname, $diff);
 447     my ($i, $count, $versioncount, $tmpname, $cmd);
 448 	my $hist;
 449 
 450     print "Building file histories (  0%): ";
 451 
 452     $count = @filelist;
 453     $i = 0.0;
 454     $diff = 0;
 455     $pad = "                                                     ";
 456     $oldname = '';
 457     $shortname = '';
 458     foreach $file (@filelist)
 459     {
 460         # display sugar
 461         $oldname =~ s/./\b/g;
 462         $shortname = substr($file, rindex($file,'/') + 1);
 463         $diff = length($oldname) - length($shortname);
 464         $padding = ($diff > 0) ? substr($pad, 0, $diff) : '';
 465         print "$oldname";
 466         $tmpname = substr("$shortname$padding", 0, 45);
 467         printf("\b\b\b\b\b\b\b\b(%3d\%): %s", (($i / $count) * 100), $tmpname);
 468         $padding =~ s/./\b/g;
 469         print "$padding";
 470         $oldname = substr($shortname, 0 , 45);
 471 
 472         # real work
 473         $cmd = $SSCMD . " History -I- \"$file\"";
 474         $_ = `$cmd`;
 475 
 476         #print STDERR "$_"; # DEBUG ONLY
 477         &proc_history($file, $_, 0);
 478 
 479         $i++;
 480     }
 481 
 482 	# Get the labels for the top-level project only, but use proc_history() to process
 483 	# the output...
 484 	$cmd = $SSCMD . " History -L -F- \"$SSPROJ\"";
 485 	$_ = `$cmd`;
 486 	&proc_history($SSPROJ, $_, 1);
 487 	
 488 	# If one of the user's had the clock set wrong on their PC then this
 489         # error will be generated later:
 490         #
 491 	# ERROR: Files would be checked in in an unexpected order
 492         #
 493 	# Fix this by adjusting the date to just before the last change (the
 494         # real date has been lost anyway so this will not cause any more damage
 495         # to the histories).
 496 	my $last_file = "";
 497 	my $last_timestamp = 0;
 498 	foreach $hist (@histories)
 499 	{
 500         my ($file, $version, $datetime, $timestamp, $user, $action, $comment) = split(',', $hist, 7);
 501 		if ($file eq $last_file && $timestamp > $last_timestamp)
 502 		{
 503 			$timestamp = $last_timestamp - 1;
 504 			$hist = join(',', $file, $version, "1990-01-01 00:00", $timestamp, $user, $action, $comment);
 505 			print STDERR "Replaced date on $file v$version as it was out-of-order\n";
 506 		}
 507 		else
 508 		{
 509 			$last_file = $file;
 510 			$last_timestamp = $timestamp;
 511 		}
 512     }
 513 		
 514     open(HIST, ">histories.txt");
 515     foreach $hist (@histories)
 516     {
 517         print HIST "$hist\n";
 518     }
 519     close(HIST);
 520 
 521     $oldname =~ s/./\b/g;
 522     $count = @histories;
 523     print "$oldname\b\b\b\b\b\b\b\b\b:        done ($count versions)" . substr($pad, 0, 20) . "\n";
 524 
 525     $PHASE = 3;
 526 }
 527 
 528 ##############################################################
 529 # Process the VSS history of a file.
 530 #
 531 sub proc_history
 532 {
 533     my $file = shift(@_);
 534     my $hist = shift(@_);
 535 	my $support_labels = shift(@_);
 536 
 537     $hist =~ s/Checked in\n/Checked in /g;
 538 
 539     #print "Starting processing of history file\n";
 540 
 541     use constant STATE_FILE    => 0;
 542     use constant STATE_VERSION => 1;
 543     use constant STATE_USER    => 2;
 544     use constant STATE_ACTION  => 3;
 545     use constant STATE_COMMENT => 4;
 546     use constant STATE_FINAL   => 5;
 547 
 548     my $state = STATE_VERSION;
 549 
 550     my $projre = '\$\/';
 551 
 552     my ($version, $junk, $user, $date, $ampm, $month, $day, $year);
 553     my ($hour, $minute, $path, $action, $datetime, $timestamp);
 554 
 555     my $readhist = 0;
 556     my $comment = '';
 557 	my $label = '';
 558 
 559     my @lines;
 560 	
 561     if ($WINDOWS > 0) {
 562         @lines = split("\n", $hist);
 563     }
 564     else {
 565 	@lines = split('\r\n', $hist);
 566     }
 567 	
 568     my $line_count = @lines;
 569     my $i = 0;
 570     my $history_count = 0;
 571 
 572     #print STDERR ">>>> $file\n"; # DEBUG ONLY
 573     foreach my $line (@lines)
 574     {
 575         #print STDERR ">>>> state = $state: $line\n"; # DEBUG ONLY
 576         if ($state == STATE_VERSION && $line =~ /^\*+  Version ([0-9]+)/)
 577         {
 578             $version = $1;
 579             $readhist = 1;
 580             $state = STATE_USER;
 581         }
 582 		elsif ($support_labels && $state == STATE_USER && $line =~ /^Label: "(.*)"/)
 583 		{
 584 			$label = $1;
 585 			# State is still STATE_USER
 586 		}
 587         elsif ($state == STATE_USER && $line =~ /^User: /)
 588         {
 589             # Example: "User: Neil Sleightholm     Date:  9/03/01   Time:  8:15"
 590             # In US Example: "User: Neil Sleightholm     Date:  9/03/01   Time:  8:15p"
 591             
 592             $line =~   m/\w+:\s+(.*?)\s+\w+:\s+(.*?)\s+\w+:\s+(.*):(.*)([ap])/;
 593 
 594             $user = $1;
 595             $date = $2;
 596             $hour = $3;
 597             $minute = $4;
 598             $ampm = $5;
 599 
 600             if ($US_DATE_FORMAT > 0) {
 601                 ($month,$day,$year) = split('/', $date); # US date format
 602                 if ($ampm eq 'p' && $hour != 12) {
 603                    $hour += 12;
 604                 }
 605                 
 606             } else {
 607                 ($day,$month,$year) = split('/', $date); # UK date format
 608             }
 609             $year = ($year < 80) ? 2000 + $year : 1900 + $year;
 610             $datetime = sprintf("%04d-%02d-%02d %02d:%02d",$year,$month,$day,$hour,$minute);
 611             $timestamp = POSIX::mktime(0, $minute, $hour, $day, $month - 1, $year - 1900, -1, -1, -1);
 612             if (!defined($timestamp)) {
 613                 print STDERR "$file:\n";
 614                 print STDERR "$line => $year-$month-$day $hour:$minute => $timestamp\n";
 615                 print "\$timestamp is undef!!!\n";
 616                 exit;
 617             }
 618             $state = STATE_ACTION;
 619         }
 620         elsif ($state == STATE_ACTION)
 621         {
 622             if ($line =~ /^Checked in /)
 623             {
 624                 if ($' =~ /^$projre/)
 625                 {
 626                     $path = $';
 627                     $action = 'checkedin';
 628                     $state = STATE_COMMENT;
 629                 }
 630                 else
 631                 {
 632                     $projre = $';
 633                     $projre =~ s/([\$\/\(\)])/\\$1/g;
 634                     $action = 'checkedin';
 635                     $state = STATE_COMMENT;
 636                 }
 637             }
 638             elsif ($line =~ /^Created/)
 639             {
 640                 $action = 'created';
 641                 $state = STATE_COMMENT;
 642             }
 643             elsif ($line =~ /^Branched/)
 644             {
 645                 $action = 'branched';
 646                 $state = STATE_COMMENT;
 647             }
 648             elsif ($support_labels && $line =~ /^Labeled/)
 649             {
 650                 $action = "labeled $label";
 651                 $state = STATE_COMMENT;
 652             }
 653             elsif ($line =~ / added/)
 654             {
 655                 $path = $`;
 656                 $action = 'added';
 657                 $state = STATE_COMMENT;
 658             }
 659             elsif ($line =~ / deleted/)
 660             {
 661                 $path = $`;
 662                 $action = 'deleted';
 663                 $state = STATE_COMMENT;
 664             }
 665         }
 666         elsif ($state == STATE_COMMENT)
 667         {
 668             if ($line =~ /^Comment\:/ || ($support_labels && $line =~ /^Label comment\:/))
 669             {
 670                 $comment = trim($');
 671             }
 672             elsif (length($comment) > 0 && length($line) > 0)
 673             {
 674                 $comment = $comment . '__NL__' . trim($line);
 675             }
 676             elsif (length($line) == 0)
 677             {
 678                 $state = STATE_FINAL;
 679             }
 680         }
 681 
 682         $i++;
 683         if ($state == STATE_FINAL || $readhist && $i == $line_count)
 684         {
 685             # Ignore history before cuttoff unless no history has been found
 686             if (0 != $CUTOFFDATE && $history_count > 0 && $timestamp < $CUTOFFDATE)
 687             {
 688                 print STDERR "History too old: $history_count, version: $version - " . POSIX::ctime($timestamp); # DEBUG ONLY
 689                 last;
 690             }
 691 
 692             $hist = join(',', $file, $version, $datetime, $timestamp, $user, $action, $comment);
 693             $comment = '';
 694             if ($DEBUG)
 695             {
 696                 print STDERR "$hist\n";
 697             }
 698             push(@histories, $hist);
 699             $readhist = 0;
 700             $state = STATE_VERSION;
 701             # Only 'created', 'checkedin' count as history
 702             if ($action eq 'checkedin' || $action eq 'created')
 703             {
 704                 $history_count++;
 705                 # Ignore history before cuttoff
 706                 if (0 != $CUTOFFDATE && $timestamp < $CUTOFFDATE)
 707                 {
 708                     print STDERR "History too old: $history_count, version: $version - " . POSIX::ctime($timestamp); # DEBUG ONLY
 709                     last;
 710                 }
 711             }
 712         }
 713     }
 714 }
 715 
 716 
 717 ##############################################################
 718 # Remove white space from the beginning and end of a string
 719 #
 720 sub trim
 721 {
 722     my ($a) = @_;
 723     $a =~ s/^\s+//;    # remove whitespace at beginning
 724     $a =~ s/\s+$//;    # remove whitespace at end
 725     #$a =~ s/\s\s+/ /g; # replace multiple whitespace by a single space
 726     return $a;
 727 }
 728 
 729 
 730 ##############################################################
 731 # Dump the users from the repository into users.txt
 732 #
 733 sub dump_users
 734 {
 735     my %USERHASH = ();
 736     my $count = 0;
 737     
 738     print "Building user list:";
 739 
 740     foreach my $hist (@histories)
 741     {
 742         my ($file, $version, $datetime, $timestamp, $user, $action, $comment) = split(',', $hist, 7);
 743         $USERHASH{$user} = 1;
 744     }
 745 
 746     open(USERS, "> users.txt");
 747     foreach my $user (keys %USERHASH)
 748     {
 749         print USERS "$user\n";
 750         $count++;
 751     }
 752     close(USERS);
 753 
 754     print "\t\tdone ($count users)\n";
 755 }
 756 
 757 
 758 ##############################################################
 759 # Dump the users from the repository into users.txt and exit
 760 #
 761 sub dump_users_and_exit
 762 {
 763     &dump_users();
 764     
 765     print "\nUsers.txt file has been created.  Use the list of users in this\n";
 766     print "file to create matching user accounts in Subversion.  Ensure that these\n";
 767     print "accounts initially have NO AUTHENTICATION, otherwise the migration will\n";
 768     print "likely fail.  Alternatively, you can use the --force-user option to\n";
 769     print "create all files with the same username.  Either way, you can resume\n";
 770     print "this migration, picking up from this point, by using the --resume\n";
 771     print "option on the command line.\n\n";
 772     
 773     exit 0;
 774 }
 775 
 776 
 777 ##############################################################
 778 # Group files together that can be commited as an atomic unit,
 779 # i.e. were checked in at the same time by the same user, and
 780 # with the same comment.
 781 #
 782 sub build_atoms
 783 {
 784     if ($DEBUG) {
 785         print STDERR "\n#############################################################\n";
 786         print STDERR "#                  Subroutine: build_atoms                  #\n";
 787         print STDERR "#############################################################\n";
 788     }
 789 
 790     print "Building atoms:   0%";
 791 
 792     %atomlist = ();
 793 
 794     my @userhist = sort sort_hist_by_user_timestamp @histories;
 795 
 796     my ($prevtime,$prevuser,$prevcomment) = (0,'','');
 797     my ($atom_user,$atom_datetime,$atom_timestamp,$atom_comment) = ('','',0,'');
 798     my $histcount = @userhist;
 799     my $i = 0;
 800     my $atom_files = {};
 801     
 802     foreach my $hist (@userhist)
 803     {
 804         # display sugar
 805         $i++;
 806         printf("\b\b\b\b%3d\%", (($i / $histcount) * 100));
 807 
 808         # real work
 809         my ($file,$version,$datetime,$timestamp,$user,$action,$comment) = split(/,/,$hist,7);
 810 
 811         # ignore actions which are not really new versions of the file
 812         next unless ($action eq 'checkedin' || $action eq 'created' || $action eq 'branched' || $action =~ '^labeled ');
 813 
 814         if ($user ne $prevuser || $comment ne $prevcomment || $timestamp - $prevtime >= 120 || exists $$atom_files{$file})
 815         {
 816             if ($prevtime != 0) 
 817             {
 818                 #print STDERR "New atom ($prevuser/$user, $prevcomment/$comment, " . ($timestamp - $prevtime) . ")\n"; # DEBUG ONLY
 819                 my $newatom = join(',',$atom_user,$atom_datetime,$atom_timestamp,$prevtime,$atom_comment);
 820                 while (exists $atomlist{$newatom}) {
 821                     $newatom .= "+";
 822                 }
 823                 $atomlist{$newatom} = $atom_files;
 824                 #print STDERR "$newatom\n"; # DEBUG ONLY
 825                 #for my $f (values %$atom_files) {
 826                 #    print STDERR "  $f\n";
 827                 #}
 828             }
 829             $atom_files = {};
 830         }
 831         if (scalar %$atom_files == 0) 
 832         {
 833             $atom_user = $user;
 834             $atom_timestamp = $timestamp;
 835             $atom_datetime = $datetime;
 836             $atom_comment = $comment;
 837             if (length($atom_comment) == 0) {
 838 				$atom_comment = "No comment provided";
 839             }
 840         }
 841         $$atom_files{$file} = join(',',$file,$version,$action);
 842         $prevtime = $timestamp;
 843         $prevuser = $user;
 844         $prevcomment = $comment;
 845     }
 846     my $newatom = join(',',$atom_user,$atom_datetime,$atom_timestamp,$prevtime,$atom_comment);
 847     #while (exists $atomlist{$newatom}) {
 848     #    $newatom .= "+";
 849     #}
 850     $atomlist{$newatom} = $atom_files;
 851 
 852     # check for conflicting atoms
 853     @atoms = sort sort_atoms_by_timestamp (keys %atomlist);
 854     
 855     my %fileversions = ();
 856     my $error = 0;
 857     $i = 0;
 858     while ($i < $#atoms) 
 859     {
 860         my ($atoma,$atomb) = ($atoms[$i],$atoms[$i+1]);
 861         my ($usera,$datetimea,$timestamp1a,$timestampna,$commenta) = split(/,/,$atoma,5);
 862         my ($userb,$datetimeb,$timestamp1b,$timestampnb,$commentb) = split(/,/,$atomb,5);
 863         # check if atomb overlaps atoma in time
 864         if ($timestamp1a <= $timestamp1b && $timestamp1b <= $timestampna) 
 865         {
 866             my $reversed = 0;
 867             # check if the atoms are updating the same file in the wrong order
 868           CHECK:
 869             for my $filea (values %{$atomlist{$atoma}}) 
 870             {
 871                 my ($fna,$vera,$resta) = split(/,/,$filea,3);
 872                 for my $fileb (values %{$atomlist{$atomb}}) 
 873                 {
 874                     my ($fnb,$verb,$restb) = split(/,/,$fileb,3);
 875                     if ($fna eq $fnb && $vera > $verb) 
 876                     {
 877                         if ($reversed) 
 878                         {
 879                             print STDERR "ERROR: Conflicting atoms, reversing order didn't help:\n$atoma:\n  $filea\n$atomb:\n  $fileb\n";
 880                             print "ERROR: Conflicting atoms\n";
 881                             $error = 1;
 882                             goto DUMP;
 883                         }
 884                         else 
 885                         {
 886                             # Two atoms where checked in at the same time
 887                             print STDERR "Conflicting atoms, trying to reverse order:\n$atoma:\n  $filea\n$atomb:\n  $fileb\n";
 888                             ($atoms[$i],$atoms[$i+1]) = ($atomb,$atoma);
 889                             ($atoma,$atomb) = ($atoms[$i],$atoms[$i+1]);
 890                             $reversed = 1;
 891                             goto CHECK;
 892                         }
 893                     }
 894                 }
 895             }
 896             if ($reversed) {
 897                 print STDERR "Conflict resolved!\n";
 898             }
 899         }
 900 
 901         for my $filea (values %{$atomlist{$atoma}}) 
 902         {
 903            my ($fna,$vera,$resta) = split(/,/,$filea,3);
 904            if (exists $fileversions{$fna}) 
 905            {
 906                 if ($fileversions{$fna} >= $vera) 
 907                 {
 908                     print STDERR "ERROR: Files would be checked in in an unexpected order:\nAtom $i,$atoma\n File: $fna\n  cur: $fileversions{$fna}\n  new: $vera\n";
 909                     print "ERROR: Files would be checked in in an unexpected order\n";
 910                     $error = 1;
 911                     goto DUMP;
 912                 }
 913             }
 914             $fileversions{$fna} = $vera;
 915         }
 916 
 917         $i++;
 918     }
 919     if ($DEBUG) {
 920         print STDERR "Atom and file order verified correctly.\n";
 921     }
 922 
 923   DUMP:
 924     open(ATOMLIST,">atoms.txt");
 925     for ($i = 0; $i <= $#atoms; $i++) 
 926     {
 927         print ATOMLIST "$i,$atoms[$i]\n";
 928         for my $file (values %{$atomlist{$atoms[$i]}}) {
 929             print ATOMLIST "  $file\n";
 930         }
 931     }
 932     close(ATOMLIST);
 933     if ($error) {
 934         exit;
 935     }
 936 
 937     printf("\b\b\b\b\t\tdone (%d atoms)\n", $#atoms + 1);
 938 }
 939 
 940 
 941 #######################################################################
 942 # Sort the history by user and timestamp.
 943 #
 944 sub sort_hist_by_user_timestamp
 945 {
 946     my ($patha,$versiona,$datetimea,$timestampa,$usera,$actiona,$commenta) = split(/,/,$a,7);
 947     my ($pathb,$versionb,$datetimeb,$timestampb,$userb,$actionb,$commentb) = split(/,/,$b,7);
 948     
 949     if ($usera ne $userb) {
 950         return $usera cmp $userb;
 951     }
 952     elsif ($timestampa != $timestampb) {
 953         return $timestampa <=> $timestampb;
 954     }
 955     elsif ($commenta ne $commentb) {
 956         return $commenta cmp $commentb;
 957     }
 958     elsif ($patha ne $pathb) {
 959         return $patha cmp $pathb;
 960     }
 961     return $versiona <=> $versionb;
 962 }
 963 
 964 
 965 #######################################################################
 966 # Sort the atoms by timestamp(s). Sub sort by user and comment.
 967 #
 968 sub sort_atoms_by_timestamp
 969 {
 970     my ($usera,$datetimea,$timestamp1a,$timestampna,$commenta) = split(/,/,$a,5);
 971     my ($userb,$datetimeb,$timestamp1b,$timestampnb,$commentb) = split(/,/,$b,5);
 972     
 973     if ($timestamp1a != $timestamp1b) {
 974         return $timestamp1a <=> $timestamp1b;
 975     }
 976     elsif ($timestampna != $timestampnb) {
 977         return $timestampna <=> $timestampnb;
 978     }
 979     elsif ($usera ne $userb) {
 980         return $usera cmp $userb;
 981     }
 982     return $commenta cmp $commentb;
 983 }
 984 
 985 
 986 #######################################################################
 987 # Get the latest checkpoint so allow resuming after refreshing history.
 988 #
 989 sub get_latest_checkpoint
 990 {
 991     my ($line);
 992     my $i = 0;
 993 
 994     backup("directories.txt",10);
 995     backup("files.txt",10);
 996     backup("histories.txt",10);
 997     backup("atoms.txt",10);
 998 
 999     if (-f "extract_progress.txt")
1000     {
1001         my $lastatom = '';
1002         print "Calculating extract progress:";
1003         open(EXTRACT, "< extract_progress.txt");
1004         while (<EXTRACT>)
1005         {
1006             chop($_);
1007             $lastatom = $_;
1008         }
1009         close(EXTRACT);
1010 
1011         $RESUMEAFTERATOM = $lastatom;
1012         if ($DEBUG)
1013         {
1014             print STDERR "Resume after atom: $RESUMEAFTERATOM\n";
1015         }
1016         print "\tresume after atom $RESUMEAFTERATOM\n";
1017     }
1018 }
1019 
1020 sub backup
1021 {
1022     my ($fn,$maxbups) = @_;
1023 
1024     my $lastfn = $fn . "." . $maxbups;
1025     if (-f $lastfn) 
1026     {
1027         unlink($lastfn);
1028     }
1029     for (my $i=$maxbups-1; $i>=1; $i--) 
1030     {
1031         my $file = $fn . "." . $i;
1032         my $pfile = $fn . "." . ($i+1);
1033         if (-f $file) 
1034         {
1035             link($file,$pfile);
1036             unlink($file);
1037         }
1038     }
1039     if (-f $fn) 
1040     {
1041         link($fn,$fn . ".1");
1042         unlink($fn);
1043     }
1044 }
1045 
1046 ##############################################################
1047 # Resume from previously generated parsed project data
1048 #
1049 sub resume
1050 {
1051     my ($line);
1052     my $i = 0;
1053 
1054     if (-f "directories.txt")
1055     {
1056         print "Loading directories:      ";
1057 
1058         $i = 0;
1059         open(DIRS, "< directories.txt");
1060         while (<DIRS>)
1061         {
1062             $line = $_;
1063             chop($line);
1064             push(@directorylist, $line);
1065             $i++;
1066             printf("\b\b\b\b\b%5d", $i);
1067         }
1068         close(DIRS);
1069         print "\b\b\b\b\b\t\tdone ($i dirs)\n";
1070         $PHASE = 1;
1071     }
1072 
1073     if (-f "files.txt")
1074     {
1075         print "Loading files:       ";
1076 
1077         $i = 0;
1078         open(FILES, "< files.txt");
1079         while (<FILES>)
1080         {
1081             $line = $_;
1082             chop($line);
1083             push(@filelist, $line);
1084             $i++;
1085             printf("\b\b\b\b\b\b%6d", $i);
1086         }
1087         close(FILES);
1088         print "\b\b\b\b\b\b\t\t\tdone ($i files)\n";
1089         $PHASE = 2;
1090     }
1091 
1092     if (-f "histories.txt")
1093     {
1094         print "Loading file histories:       ";
1095         $i = 0;
1096         open(HIST, "< histories.txt");
1097         while (<HIST>)
1098         {
1099             $line = $_;
1100             chop($line);
1101             push(@histories, $line);
1102             $i++;
1103             printf("\b\b\b\b\b\b%6d", $i);
1104         }
1105         close(HIST);
1106         print "\b\b\b\b\b\b\tdone ($i versions)\n";
1107         $PHASE = 3;
1108     }
1109 
1110     if (-f "extract_progress.txt")
1111     {
1112         my $lastatom = '';
1113         print "Calculating extract progress:";
1114         open(EXTRACT, "< extract_progress.txt");
1115         while (<EXTRACT>)
1116         {
1117             chop($_);
1118             $lastatom = $_;
1119         }
1120         close(EXTRACT);
1121 
1122         $RESUMEAFTERATOM = $lastatom;
1123         if ($DEBUG)
1124         {
1125             print STDERR "Resume after atom: $RESUMEAFTERATOM\n";
1126         }
1127         print "\tresume after atom $RESUMEAFTERATOM\n";
1128         $PHASE = 6;
1129     }
1130 }
1131 
1132 
1133 ##############################################################
1134 # Create the directory hierarchy in the local filesystem
1135 #
1136 sub create_directories
1137 {
1138     if ($DEBUG)
1139     {
1140         print STDERR "\n#############################################################\n";
1141         print STDERR "#              Subroutine: create_directories               #\n";
1142         print STDERR "#############################################################\n";
1143     }
1144 
1145     print "Creating local directories: ";
1146     &recursive_delete('hgrepo');
1147 
1148     my $cmd = "hg init hgrepo";
1149     if ($DEBUG)
1150     {
1151         print STDERR "$cmd\n";
1152     }
1153 
1154     `$cmd`;
1155     if ($? != 0) {
1156         print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
1157         exit;
1158     }
1159     print "\tdone\n";
1160 }
1161 
1162 
1163 ##############################################################
1164 # Delete a directory tree and all of its files recursively
1165 #
1166 sub recursive_delete
1167 {
1168     my ($parent) = @_;
1169     my (@dirs, $dir);
1170 
1171     opendir(DIR, $parent);
1172     @dirs = readdir(DIR);
1173     closedir(DIR);
1174     foreach $dir (@dirs)
1175     {
1176         if ($dir ne '.' && $dir ne '..')
1177         {
1178             recursive_delete("$parent/$dir");
1179         }
1180     }
1181 
1182     if (-d $parent)
1183     {
1184         rmdir($parent);
1185     }
1186     elsif (-f $parent)
1187     {
1188         unlink($parent);
1189     }
1190 }
1191 
1192 
1193 ##############################################################
1194 # Make a directory tree and all of its sub dirs recursively
1195 #
1196 sub recursive_mkdir
1197 {
1198     my($tpath) = @_;
1199     my($dir, $accum);
1200 
1201     foreach $dir (split(/\//, $tpath))
1202     {
1203         $accum = "$accum$dir/";
1204         if ($dir ne "")
1205         {
1206             if (! -d "$accum")
1207             {
1208                 mkdir $accum;
1209             }
1210         }
1211     }
1212 }
1213 
1214 
1215 ##############################################################
1216 # Checkout a copy of the directory hierarchy so that we have
1217 # a Subversion local working copy
1218 #
1219 sub checkout_directories
1220 {
1221     if ($DEBUG)
1222     {
1223         print STDERR "\n#############################################################\n";
1224         print STDERR "#             Subroutine: checkout_directories              #\n";
1225         print STDERR "#############################################################\n";
1226     }
1227 
1228     print "Checking out directories: ";
1229 
1230     my $cmd = "svn checkout --username \"$USERNAME\"";
1231 	if (length($PASSWORD) > 0)
1232 	{
1233 		$cmd = $cmd . " --password \"$PASSWORD\"";
1234 	}
1235 	$cmd = $cmd . " --non-interactive hgrepo";
1236     if ($DEBUG)
1237     {
1238         print STDERR "$cmd\n";
1239     }
1240 
1241 #    &recursive_delete('./work');
1242 #    mkdir('./work');
1243     `$cmd`;
1244     if ($? != 0) {
1245         print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
1246         exit;
1247     }
1248     print "\tdone\n";
1249 
1250     $PHASE = 6;
1251 }
1252 
1253 
1254 ##############################################################
1255 # This is the meat.  Extract each version of each file in the
1256 # project from VSS and check it into Mercurial
1257 #
1258 sub extract_and_import
1259 {
1260     if ($DEBUG)
1261     {
1262         print STDERR "\n#############################################################\n";
1263         print STDERR "#              Subroutine: extract_and_import               #\n";
1264         print STDERR "#############################################################\n";
1265     }
1266 
1267     my $padding = "                                                                      ";
1268     my ($cmd, $tmpname, $localpath, $localdir, $out);
1269     my ($pyear,$pmon,$pmday,$phour,$pmin,$num) = (0,0,0,0,0,0);
1270 
1271     my $count = @atoms;
1272     my $startatom = 0;
1273 
1274 	my $projpat = $SSPROJ;
1275 	$projpat =~ s/\//\/\//g;
1276 	$projpat =~ s/\$\//\^\\\$/g;
1277 
1278     print "Extracting and creating:\n";
1279 
1280     open(EXTRACT, ">>extract_progress.txt");
1281 
1282     if ($RESUMEAFTERATOM ne '')
1283     {
1284         my ($atomnr,$atom) = split(/,/,$RESUMEAFTERATOM,2);
1285         if ($atoms[$atomnr] eq $atom) {
1286             $startatom = $atomnr + 1;
1287         }
1288         else {
1289             print STDERR "ERROR! Resume inconsistency: atom $atomnr has changed:\nexp: $atom\ncur: $atoms[$atomnr]\n";
1290             print "ERROR! Resume inconsistency!\n";
1291             exit;
1292         }
1293     }
1294 
1295     chdir('hgrepo');
1296     for (my $i = $startatom; $i <= $#atoms; $i++)
1297     {
1298         my $atom = $atoms[$i];
1299         my $targets = '';
1300 
1301         foreach my $atomfile (values %{$atomlist{$atom}})
1302         {
1303             my ($file,$version,$action) = split(',',$atomfile,3);
1304 
1305 			if ($action =~ /^labeled /)
1306 			{
1307 				# Nothing to extract - just do a 'hg tag'
1308 				$action = $';			
1309 				my ($user,$datetime,$timestamp1,$timestampn,$comment) = split(/,/,$atom,5);
1310 		
1311 				# display sugar
1312 				$tmpname = "Creating Tag $action [$user $datetime]";
1313 				printf("\r$padding\r  (%3d\%): %s", ((($i+1) / $count) * 100), substr("$tmpname", 0, 60));
1314 				
1315 				if ($DEBUG) 
1316 				{
1317 					print STDERR "$tmpname\n";
1318 				}
1319 				if ($FORCEUSER ne '')
1320 				{
1321 					$user = $FORCEUSER;
1322 				}
1323 		
1324 				# Translate character codes from CP437/CP850 to UTF-8 (åäöÅÄÖ)
1325 				#$comment =~ tr/\206\204\224\217\216\231/\254\253\271\197\196\214/;
1326 				#$comment =~ tr/\206\204\224\217\216\231/aaoAAO/;
1327 				#$comment =~ s/</[lt]/g;
1328 				#$comment =~ s/>/[gt]/g;
1329 				#$comment =~ s/"/\\"/g; # quote quotes
1330 				$comment =~ s/__NL__/ /g;
1331 		
1332 				# commit changes as the VSS user (with a blank password)
1333 				$cmd = "hg tag --user \"$user\" --noninteractive --date \"$datetime\" --message \"$comment\" \"$action\" 2>&1";
1334 				$out = `$cmd`;
1335 				if ($DEBUG)
1336 				{
1337 					print STDERR "$cmd\n";
1338 					print STDERR "$out";
1339 				}
1340 				if ($? != 0) 
1341 				{
1342 					print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
1343 					exit;
1344 				}
1345 				next;
1346 			}
1347 			
1348             # display sugar
1349             $tmpname = substr($file, rindex($file,'/') + 1, 50) . ' (v.' . $version . ')';
1350             printf("\r$padding\r  (%3d\%): %s", ((($i+1) / $count) * 100), substr("$tmpname", 0, 60));
1351 
1352 			# extract to the proper directory (less the subversion project name)
1353 			$localpath = substr($file, length($SSPROJ) + 1);
1354                         if ($WINDOWS > 0) {
1355 			    $localpath =~ s/\//\\/g;
1356                         }
1357 			$file =~ /^\$\//;
1358 
1359 			$localdir = $localpath;
1360 			my $slash = rindex($localdir, $FILESEP);
1361 			if ($slash == -1) {
1362 				$localdir = '.';
1363 			}
1364 			else {
1365 				$localdir = substr($localdir,0,$slash);
1366 			}
1367 
1368 			if (! -d $localdir)
1369 			{
1370 				mkpath($localdir);
1371 			}
1372 
1373 			#print STDERR "file = $file\n"; # DEBUG ONLY
1374 			#print STDERR "localpath = $localpath\n"; # DEBUG ONLY
1375 			#print STDERR "localdir = $localdir\n"; # DEBUG ONLY
1376 
1377 			my $fileexists = -f $localpath;
1378 			
1379 			$cmd = $SSCMD . " get -GTM -W -I-Y -GL\"$localdir\" -V$version \"$file\" 2>&1";
1380 			$out = `$cmd`;
1381 
1382 			# get rid of stupid VSS warning messages
1383 			###$* = 1;
1384 			$out =~ s/\n?Project.*rebuilt\.//g;
1385 			$out =~ s/\n?File.*rebuilt\.//g;
1386 			$out =~ s/\n.*was moved out of this project.*rebuilt\.//g;
1387 			$out =~ s/\nContinue anyway.*Y//g;
1388 			###$* = 0;
1389 
1390 			if ($DEBUG) 
1391 			{
1392 				print STDERR "$cmd\n";
1393 				print STDERR "$out";
1394 			}
1395 			
1396 			if ($? != 0) 
1397 			{
1398 				print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
1399 				exit;
1400 			}
1401 			
1402 			if ($out =~ /does not retain old versions of itself/) 
1403 			{
1404 				print STDERR "WARNING: Binary file without history: $file\n";
1405 			}
1406 			elsif (! -f $localpath) 
1407 			{
1408 				print STDERR "ERROR: File not checked out: $file (v.$version)\n";
1409 			}
1410 			else 
1411 			{
1412 				# create list of targets to commit in this atom
1413 				$targets .= "$localpath\n";
1414 
1415 				if (! $fileexists ) 
1416 				{
1417 					$cmd = "hg add \"$localpath\" 2>&1";
1418 					$out = `$cmd`;
1419 					if ($DEBUG) 
1420 					{
1421 						print STDERR "$cmd\n";
1422 						print STDERR "$out";
1423 					}
1424 					if ($? != 0) 
1425 					{
1426 						print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
1427 						exit;
1428 					}
1429 				}
1430 			}
1431 		}
1432     
1433         if ($targets ne '')
1434         {
1435             my ($user,$datetime,$timestamp1,$timestampn,$comment) = split(/,/,$atom,5);
1436     
1437             # display sugar
1438             $tmpname = "Commit atom $i [$user $datetime]";
1439             printf("\r$padding\r  (%3d\%): %s", ((($i+1) / $count) * 100), substr("$tmpname", 0, 60));
1440             
1441             if ($DEBUG) 
1442             {
1443                 print STDERR "$tmpname\n";
1444             }
1445             if ($FORCEUSER ne '')
1446             {
1447                 $user = $FORCEUSER;
1448             }
1449     
1450             # Translate character codes from CP437/CP850 to UTF-8 (åäöÅÄÖ)
1451             #$comment =~ tr/\206\204\224\217\216\231/\254\253\271\197\196\214/;
1452             #$comment =~ tr/\206\204\224\217\216\231/aaoAAO/;
1453             #$comment =~ s/</[lt]/g;
1454             #$comment =~ s/>/[gt]/g;
1455             #$comment =~ s/"/\\"/g; # quote quotes
1456             $comment =~ s/__NL__/\n/g;
1457     
1458             open(MESSAGE,">___message");
1459             print MESSAGE "$comment\n";
1460             close(MESSAGE);
1461             
1462             # commit changes as the VSS user (with a blank password)
1463             $cmd = "hg commit --user \"$user\" --noninteractive --date \"$datetime\" --logfile ___message 2>&1";
1464             $out = `$cmd`;
1465             if ($DEBUG)
1466             {
1467                 print STDERR "$cmd\n";
1468                 print STDERR "$out";
1469             }
1470             if ($? != 0) 
1471             {
1472                 print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
1473                 exit;
1474             }
1475     
1476             # Clean up
1477             unlink("___message");
1478         }
1479             
1480         print EXTRACT "$i,$atom\n";
1481     }
1482     close(EXTRACT);
1483     printf("\r$padding\r                                done (%d atoms)\n", $#atoms + 1);
1484 }
1485 
1486 
1487 ##############################################################
1488 # Get a formatted date time
1489 #
1490 sub prettydate
1491 {
1492     my ($sec, $min, $hrs, $day, $month, $year) = (localtime)[0,1,2,3,4,5];
1493     return(sprintf("%04d-%02d-%02d %02d:%02d:%02d\n", $year+1900, $month+1, $day, $hrs, $min, $sec));
1494 }

Attached Files

To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.
  • [get | view] (2009-12-03 19:31:50, 40.5 KB) [[attachment:vss2hg.pl]]
 All files | Selected Files: delete move to page

You are not allowed to attach a file to this page.