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.You are not allowed to attach a file to this page.