#!/usr/bin/perl
#
# VSS-to-Subversion migration script
# Original Brett Wooldridge (brettw@riseup.com)
#
# Contributions:
#   Daniel Dragnea
#   Magnus Hyllander 2006-12-05 (http://www.hyllander.org/node/23)
#   Neil Sleightholm v3.xx (http://neilsleightholm.blogspot.com/)
#
#	Version History
#	1.xx	- Original Brett Wooldridge
#	2.xx	- Magnus Hyllander
#   3.00    - Changes by Neil Sleightholm:
#           - Improved generation of atoms to make resume more reliable.
#           - Handle pinned files.
#           - Print migration start/end date and time.
#           - Improve status ('sugar') feedback.
#           - Simplify extract status code.
#           - Supply username and password for admin functions.
#           - Code reformatting.
#           - Added support for cutoff date to allow only newer files to be migrated.
#           - Always dump user names during migration.
#           - Add support for usernames containing spaces.
#           - Exclude additional vss warning message.
#           - Change to UK date format. Add commented out code to allow for european 
#             and US date formats. TODO: Make this a command line option.
#           - Add version number.
#   3.01    - Don't import vss files e.g. files ending .vssscc, .vspscc etc.
#   3.02    - Allow vss project $/ e.g. all of vss.
#   3.03    - Don't import vss files - .vsscc
#   3.04    - Improve handling of cuttoff date if it is not set.
#   3.05    - Changed so that svn url is the root and the vss path is append to it
#             e.g. $/MyPath is imported in to url svn://Import as svn://Import/MyPath
#           - Remove redundant commented out code.
#           - Add support for multiple vss projects on the command line.
#
# Furture enhancements:
#   - Make date format an option or auto-detect.
#   - Cleanup resume files if full migration selected.
#   - Make working username and password parameters.
#   - Optionally read vss projects from a file.
#

my $VERSION = "3.05";

use strict;
use POSIX;

my $DEBUG = 1;

my $RESUME = 0;
my $RESUMEAFTERATOM = '';
my $MIGRATELATEST = 0;
my $DUMPUSERS = 0;
my $FORCEUSER = '';
my $SSREPO = '';
#my $SSPROJ = '';
my $SSHOME = '';
my $SSCMD = '';
my $REPOS = '';
my $CUTOFFDATE = 0;

# This is the username and password used for migration operations
my $USERNAME = 'admin';
my $PASSWORD = '';

my $PHASE = 0;

my @ssprojectlist = ();
my @directorylist = ();
my @filelist = ();
my @histories = ();
my %atomlist;
my @atoms;

my $datestring;

if ($DEBUG == 1)
{
    open(STDERR, "> migrate.log");
}

&parse_args(@ARGV);

&setup();

$datestring = prettydate();
print "Migration started: $datestring\n";
print STDERR "Migration started: $datestring\n";

if ($MIGRATELATEST)
{
    &get_latest_checkpoint();
}
elsif ($RESUME)
{
    &resume();
}

if ($PHASE < 1)
{
    # Repeat for each vss project
    foreach my $proj (@ssprojectlist)
    {
        print "Project: $proj\n";
        &build_directorylist($proj);
    }
}

if ($PHASE < 2)
{
    &build_filelist();
}

if ($PHASE < 3)
{
    &build_histories();
    &dump_users();
}

if ($DUMPUSERS)
{
    &dump_users_and_exit();
}

&build_atoms;

if ($MIGRATELATEST)
{
    print "\nHistory has now been refreshed. You can compare atoms.txt.1 with atoms.txt to\n";
    print "see if new data to be migrated has been checked in to the VSS repository after\n";
    print "the previous run. Also verify that the last line of extract-progress.txt lists\n";
    print "the last atom that was processed. When satisfied, you can process new atoms\n";
    print "with the --resume option.\n\n";
    exit;
}

if ($PHASE < 5)
{
    &create_directories;
    &import_directories;
}

if ($PHASE < 6)
{
    &checkout_directories;
}

&extract_and_import;

if ($DEBUG)
{
    close(DEBUG);
}

$datestring = prettydate();
print "\nMigration complete: $datestring\n\n";
print STDERR "\nMigration complete: $datestring\n\n";

exit;


##############################################################
# Parse Command-line arguments
#
sub parse_args
{
    my $argc = @ARGV;
    if ($argc < 1)
    {
        print "migrate: missing command arguments\n";
        print "Try 'migrate --help' for more information\n\n";
        exit -1;
    }

    if ($ARGV[0] eq '--help')
    {
        print "Visual SourceSafe to Subversion Migration Tool - v$VERSION\n\n";
        print "Usage: migrate [options] project [project [project]]\n\n";
        print "Migrate a Visual SourceSafe project to Subversion.\n\n";
        print "  --resume\t\tresume the migration from last checkpoint\n";
        print "  --migrate-latest\trefresh history and atoms, and resume after\n";
        print "\t\t\tlast checkpoint\n";
        print "  --ssrepo=<dir>\trepository path, e.g. \\\\share\\vss\n";
        print "  --sshome=<dir>\tVSS installation directory\n";
        print "  --repos=<url>\t\tbase URL for the Subversion repository\n";
        print "\t\t\tNote: VSS project will be appended to this\n";
        print "  --force-user=<user>\tforce the files to be checked into Subversion as\n";
        print "\t\t\tas user <user>\n";
        print "  --cutoff-date=<yyyymmdd>\tminimum date to import\n";
        print "  --dumpusers\t\tafter pre-processing the VSS repository, create a\n";
        print "\t\t\tusers.txt file which can be used to create comparable\n";
        print "\t\t\taccounts in Subversion.  The migration can be resumed\n";
        print "\t\t\twithout penalty by using the --resume option\n\n";
        exit -1;
    }

    for (my $i = 0; $i < $argc; $i++)
    {
        my $arg = $ARGV[$i];
        if ($arg eq '--resume')
        {
            $RESUME = 1;
        }
        elsif ($arg =~ /--migrate-latest/)
        {
            $MIGRATELATEST = 1;
        }
        elsif ($arg eq '--dumpusers')
        {
            $DUMPUSERS = 1;
        }
        elsif ($arg =~ /--ssrepo=/)
        {
            $SSREPO = $';
        }
        elsif ($arg =~ /--sshome=/)
        {
            $SSHOME = $';
        }
        elsif ($arg =~ /--repos=/)
        {
            $REPOS = $';
        }
        elsif ($arg =~ /--force-user=/)
        {
            $FORCEUSER = $';
        }
        elsif ($arg =~ /--cutoff-date=/)
        {
            # Convert parameter from yyyymmdd to a datetime
            my $dateparam = $';
            $CUTOFFDATE = POSIX::mktime(0, 0, 0, substr($dateparam, 6, 2), substr($dateparam, 4, 2) - 1, substr($dateparam, 0, 4) - 1900, -1, -1, -1);
        }
        else
        {
            push @ssprojectlist, $arg;
        }
    }

    foreach my $proj (@ssprojectlist)
    {
        if ($proj !~ /^\$\/\w+/ && $proj ne '$/' )
        {
            print "Error: missing or invalid project specification, must be of the form \$/project or \$/\n\n";
            exit -1;
        }
    }
}


##############################################################
# Check environment and setup globals
#
sub setup
{
    $SSREPO = @ENV{'SSDIR'} unless length($SSREPO) > 0;
    if ($SSREPO eq '' || length($SSREPO) == 0)
    {
        die "Environment variable SSDIR must point to a SourceSafe repository.";
    }
    $SSHOME = @ENV{'SS_HOME'} unless length($SSHOME) > 0;
    if ($SSHOME eq '' || length($SSHOME) == 0)
    {
        die "Environment variable SS_HOME must point to where SS.EXE is located.";
    }
    $REPOS = @ENV{'SVN_ROOT'} unless length($REPOS) > 0;

    $ENV{'SSDIR'} = $SSREPO;
    $SSCMD = "$SSHOME";
    if ($SSCMD !~ /^\".*/)
    {
        $SSCMD = "\"$SSCMD\"";
    }
    $SSCMD =~ s/\"(.*)\"/\"$1\\ss.exe\"/;

    my $banner = "Visual SourceSafe to Subversion Migration Tool - v$VERSION\n" .
                 "Original by Brett Wooldridge (brettw\@riseup.com)\n" .
                 "Modified by Magnus Hyllander 2006-12-05\n" .
                 "Modified by Neil Sleightholm v3.xx\n\n" .
                 "SourceSafe repository: $SSREPO\n" .
                 "SourceSafe directory : $SSHOME\n" .
                 "Subversion repository: $REPOS\n";
    foreach my $proj (@ssprojectlist)
    {
        $banner .= "SourceSafe project   : $proj\n";
    }
    if (0 == $CUTOFFDATE){
        $banner .= "History cut off      : not set\n\n";
    }else{
        $banner .= "History cut off      : " . POSIX::ctime($CUTOFFDATE) . "\n\n";
    }
    
    print "$banner";
    if ($DEBUG)
    {
        print STDERR "$banner";
    }
}


##############################################################
# Build project directory hierarchy
#
sub build_directorylist
{
    my($proj) = @_;

    if ($DEBUG)
    {
        print STDERR "\n#############################################################\n";
        print STDERR "#              Subroutine: build_directorylist              #\n";
        print STDERR "#############################################################\n";
    }

    print "Building directory hierarchy...";

    my $oldcount = @directorylist;

    recursive_build_directorylist($proj);

    sort(@directorylist);
    open(DIRS, "> directories.txt");
    foreach my $dir (@directorylist)
    {
        print DIRS "$dir\n";
    }
    close(DIRS);

    my $count = @directorylist - $oldcount;
    print "\b\b\b:\tdone ($count dirs)\n";

    $PHASE = 1;
}

sub recursive_build_directorylist
{
    my ($proj) = @_;
    push @directorylist, $proj;

    my $cmd = $SSCMD . " Dir \"$proj\" -I- -F-";
    $_ = `$cmd`;
    if ($DEBUG) {
        print STDERR "\nDirectory listing of $proj:\n$_";
    }
    my @lines = split('\n');
    foreach my $line (@lines)
    {
        chomp($line);
        if ($line =~ /^\$([^\/][^:]+)$/) {
            recursive_build_directorylist("$proj/$1");
        }
    }
}


##############################################################
# Build a list of files from the list of directories
#
sub build_filelist
{
    if ($DEBUG)
    {
        print STDERR "\n#############################################################\n";
        print STDERR "#                Subroutine: build_filelist                 #\n";
        print STDERR "#############################################################\n";
    }

    my ($proj, $cmd, $i, $j, $count);

    print "Building file list (  0%):            ";

    $count = @directorylist;

    $i = 0;
    $j = 0.0;
    foreach $proj (@directorylist)
    {
        $* = 1;
        $/ = ':';

        $cmd = $SSCMD . " Dir -I- \"$proj\"";
        $_ = `$cmd`;

        # what this next expression does is to merge wrapped lines like:
        #    $/DeviceAuthority/src/com/eclyptic/networkdevicedomain/deviceinterrogator/excep
        #    tion:
        # into:
        #    $/DeviceAuthority/src/com/eclyptic/networkdevicedomain/deviceinterrogator/exception:
        s/\n((\w*\-*\.*\w*\/*)+\:)/$1/g;

        $* = 0;
        $/ = '';
        my @lines = split('\n');
        LOOP: foreach my $line (@lines)
        {
            last LOOP if ($line eq '' || length($line) == 0);

            if ($line !~ /(.*)\:/ && $line !~ /^\$.*/ && $line !~ /^([0-9]+) item.*/ && $line !~ /^No items found.*/)
            {
                # Pinned files are returned as "file;n" remove ";n"
                my @file = split(/;/,$line);
                # Exclude vss files e.g. files ending .vsscc, .vssscc, .vspscc etc
                if (@file[0] =~ /.*\.\w{2,3}scc$/) 
                {
                    print STDERR "Skipping VSS file: $proj/@file[0]\n";
                }
                else
                {
                    push(@filelist, "$proj/@file[0]");
                    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);
                    if ($DEBUG)
                    {
                        print STDERR "$proj/@file[0]\n";
                    }
                    $i++;
                }
            }
        }
        $j++;
    }

    open(FILES,">files.txt");
    for my $file (@filelist)
    {
        print FILES "$file\n";
    }
    close(FILES);

    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";

    $PHASE = 2;
}


##############################################################
# Build complete histories for all of the files in the project
#
sub build_histories
{
    if ($DEBUG)
    {
        print STDERR "\n#############################################################\n";
        print STDERR "#                Subroutine: build_histories                #\n";
        print STDERR "#############################################################\n";
    }

    my ($file, $pad, $padding, $oldname, $shortname, $diff);
    my ($i, $count, $versioncount, $tmpname, $cmd);

    print "Building file histories (  0%): ";

    $count = @filelist;
    $i = 0.0;
    $diff = 0;
    $pad = "                                                     ";
    $oldname = '';
    $shortname = '';
    foreach $file (@filelist)
    {
        # display sugar
        $oldname =~ s/./\b/g;
        $shortname = substr($file, rindex($file,'/') + 1);
        $diff = length($oldname) - length($shortname);
        $padding = ($diff > 0) ? substr($pad, 0, $diff) : '';
        print "$oldname";
        $tmpname = substr("$shortname$padding", 0, 45);
        printf("\b\b\b\b\b\b\b\b(%3d\%): %s", (($i / $count) * 100), $tmpname);
        $padding =~ s/./\b/g;
        print "$padding";
        $oldname = substr($shortname, 0 , 45);

        # real work
        $cmd = $SSCMD . " History -I- \"$file\"";
        $_ = `$cmd`;

        #print STDERR "$_"; # DEBUG ONLY
        &proc_history($file, $_);

        $i++;
    }

    open(HIST, ">histories.txt");
    foreach my $hist (@histories)
    {
        print HIST "$hist\n";
    }
    close(HIST);

    $oldname =~ s/./\b/g;
    $count = @histories;
    print "$oldname\b\b\b\b\b\b\b\b\b:        done ($count versions)" . substr($pad, 0, 20) . "\n";

    $PHASE = 3;
}

##############################################################
# Process the VSS history of a file.
#
sub proc_history
{
    my $file = shift(@_);
    my $hist = shift(@_);

    $hist =~ s/Checked in\n/Checked in /g;

    #print "Starting processing of history file\n";

    use constant STATE_FILE    => 0;
    use constant STATE_VERSION => 1;
    use constant STATE_USER    => 2;
    use constant STATE_ACTION  => 3;
    use constant STATE_COMMENT => 4;
    use constant STATE_FINAL   => 5;

    my $state = STATE_VERSION;

    my $projre = '\$\/';

    my ($version, $junk, $user, $date, $time, $month, $day, $year);
    my ($hour, $minute, $path, $action, $datetime, $timestamp);

    my $readhist = 0;
    my $comment = '';
    my @lines = split('\n', $hist);
    my $line_count = @lines;
    my $i = 0;
    my $history_count = 0;

    #print STDERR ">>>> $file\n"; # DEBUG ONLY
    foreach my $line (@lines)
    {
        #print STDERR ">>>> state = $state: $line\n"; # DEBUG ONLY
        if ($state == STATE_VERSION && $line =~ /^\*+  Version ([0-9]+)/)
        {
            $version = $1;
            $readhist = 1;
            $state = STATE_USER;
        }
        elsif ($state == STATE_USER && $line =~ /^User: /)
        {
            # Example: "User: Neil Sleightholm     Date:  9/03/01   Time:  8:15"
            $line =~ m/\w+:\s+(.*?)\s+\w+:\s+(.*?)\s+\w+:(.*)/;
            $user = $1;
            $date = $2;
            $time = $3;

            #($year,$month,$day) = split('-', $date); # yyyy-mm-dd date format
            #($month,$day,$year) = split('/', $date); # US date format
            ($day,$month,$year) = split('/', $date); # UK date format
            ($hour,$minute) = split(':', $time);
            $year = ($year < 80) ? 2000 + $year : 1900 + $year;
            $datetime = sprintf("%04d-%02d-%02d %02d:%02d",$year,$month,$day,$hour,$minute);
            $timestamp = POSIX::mktime(0, $minute, $hour, $day, $month - 1, $year - 1900, -1, -1, -1);
            if (!defined($timestamp)) {
                print STDERR "$file:\n";
                print STDERR "$line => $year-$month-$day $hour:$minute => $timestamp\n";
                print "\$timestamp is undef!!!\n";
                exit;
            }
            $state = STATE_ACTION;
        }
        elsif ($state == STATE_ACTION)
        {
            if ($line =~ /^Checked in /)
            {
                if ($' =~ /^$projre/)
                {
                    $path = $';
                    $action = 'checkedin';
                    $state = STATE_COMMENT;
                }
                else
                {
                    $projre = $';
                    $projre =~ s/([\$\/\(\)])/\\$1/g;
                    $action = 'checkedin';
                    $state = STATE_COMMENT;
                }
            }
            elsif ($line =~ /^Created/)
            {
                $action = 'created';
                $state = STATE_COMMENT;
            }
            elsif ($line =~ /^Branched/)
            {
                $action = 'branched';
                $state = STATE_COMMENT;
            }
            elsif ($line =~ /^Labeled/)
            {
                $action = 'labeled';
                $state = STATE_COMMENT;
            }
            elsif ($line =~ / added/)
            {
                $path = $`;
                $action = 'added';
                $state = STATE_COMMENT;
            }
            elsif ($line =~ / deleted/)
            {
                $path = $`;
                $action = 'deleted';
                $state = STATE_COMMENT;
            }
        }
        elsif ($state == STATE_COMMENT)
        {
            if ($line =~ /^Comment\:/)
            {
                $comment = trim($');
            }
            elsif (length($comment) > 0 && length($line) > 0)
            {
                $comment = $comment . '__NL__' . trim($line);
            }
            elsif (length($line) == 0)
            {
                $state = STATE_FINAL;
            }
        }

        $i++;
        if ($state == STATE_FINAL || $readhist && $i == $line_count)
        {
            # Ignore history before cuttoff unless no history has been found
            if (0 != $CUTOFFDATE && $history_count > 0 && $timestamp < $CUTOFFDATE)
            {
                print STDERR "History too old: $history_count, version: $version - " . POSIX::ctime($timestamp); # DEBUG ONLY
                last;
            }

            $hist = join(',', $file, $version, $datetime, $timestamp, $user, $action, $comment);
            $comment = '';
            if ($DEBUG)
            {
                print STDERR "$hist\n";
            }
            push(@histories, $hist);
            $readhist = 0;
            $state = STATE_VERSION;
            # Only 'created' and 'checkedin' count as history
            if ($action eq 'checkedin' || $action eq 'created')
            {
                $history_count++;
                # Ignore history before cuttoff
                if (0 != $CUTOFFDATE && $timestamp < $CUTOFFDATE)
                {
                    print STDERR "History too old: $history_count, version: $version - " . POSIX::ctime($timestamp); # DEBUG ONLY
                    last;
                }
            }
        }
    }
}


##############################################################
# Remove white space from the beginning and end of a string
#
sub trim
{
    my ($a) = @_;
    $a =~ s/^\s+//;    # remove whitespace at beginning
    $a =~ s/\s+$//;    # remove whitespace at end
    #$a =~ s/\s\s+/ /g; # replace multiple whitespace by a single space
    return $a;
}


##############################################################
# Dump the users from the repository into users.txt
#
sub dump_users
{
    my %USERHASH = ();
    my $count = 0;
    
    print "Building user list:";

    foreach my $hist (@histories)
    {
        my ($file, $version, $datetime, $timestamp, $user, $action, $comment) = split(',', $hist, 7);
        $USERHASH{$user} = 1;
    }

    open(USERS, "> users.txt");
    foreach my $user (keys %USERHASH)
    {
        print USERS "$user\n";
        $count++;
    }
    close(USERS);

    print "\t\tdone ($count users)\n";
}


##############################################################
# Dump the users from the repository into users.txt and exit
#
sub dump_users_and_exit
{
    &dump_users();
    
    print "\nUsers.txt file has been created.  Use the list of users in this\n";
    print "file to create matching user accounts in Subversion.  Ensure that these\n";
    print "accounts initially have NO AUTHENTICATION, otherwise the migration will\n";
    print "likely fail.  Alternatively, you can use the --force-user option to\n";
    print "create all files with the same username.  Either way, you can resume\n";
    print "this migration, picking up from this point, by using the --resume\n";
    print "option on the command line.\n\n";
    
    exit 0;
}


##############################################################
# Group files together that can be commited as an atomic unit,
# i.e. were checked in at the same time by the same user, and
# with the same comment.
#
sub build_atoms
{
    if ($DEBUG) {
        print STDERR "\n#############################################################\n";
        print STDERR "#                  Subroutine: build_atoms                  #\n";
        print STDERR "#############################################################\n";
    }

    print "Building atoms:   0%";

    %atomlist = ();

    my @userhist = sort sort_hist_by_user_timestamp @histories;

    my ($prevtime,$prevuser,$prevcomment) = (0,'','');
    my ($atom_user,$atom_datetime,$atom_timestamp,$atom_comment) = ('','',0,'');
    my $histcount = @userhist;
    my $i = 0;
    my $atom_files = {};
    
    foreach my $hist (@userhist)
    {
        # display sugar
        $i++;
        printf("\b\b\b\b%3d\%", (($i / $histcount) * 100));

        # real work
        my ($file,$version,$datetime,$timestamp,$user,$action,$comment) = split(/,/,$hist,7);

        # ignore actions which are not really new versions of the file
        next unless ($action eq 'checkedin' || $action eq 'created' || $action eq 'branched');

        if ($user ne $prevuser || $comment ne $prevcomment || $timestamp - $prevtime >= 120 || exists $$atom_files{$file})
        {
            if ($prevtime != 0) 
            {
                #print STDERR "New atom ($prevuser/$user, $prevcomment/$comment, " . ($timestamp - $prevtime) . ")\n"; # DEBUG ONLY
                my $newatom = join(',',$atom_user,$atom_datetime,$atom_timestamp,$prevtime,$atom_comment);
                while (exists $atomlist{$newatom}) {
                    $newatom .= "+";
                }
                $atomlist{$newatom} = $atom_files;
                #print STDERR "$newatom\n"; # DEBUG ONLY
                #for my $f (values %$atom_files) {
                #    print STDERR "  $f\n";
                #}
            }
            $atom_files = {};
        }
        if (scalar %$atom_files == 0) 
        {
            $atom_user = $user;
            $atom_timestamp = $timestamp;
            $atom_datetime = $datetime;
            $atom_comment = $comment;
            if ($atom_comment ne '') {
                $atom_comment .= '__NL__';
            }
            $atom_comment .= "[VSS $datetime]";
        }
        $$atom_files{$file} = join(',',$file,$version,$action);
        $prevtime = $timestamp;
        $prevuser = $user;
        $prevcomment = $comment;
    }
    my $newatom = join(',',$atom_user,$atom_datetime,$atom_timestamp,$prevtime,$atom_comment);
    while (exists $atomlist{$newatom}) {
        $newatom .= "+";
    }
    $atomlist{$newatom} = $atom_files;

    # check for conflicting atoms
    @atoms = sort sort_atoms_by_timestamp (keys %atomlist);
    
    my %fileversions = ();
    my $error = 0;
    $i = 0;
    while ($i < $#atoms) 
    {
        my ($atoma,$atomb) = ($atoms[$i],$atoms[$i+1]);
        my ($usera,$datetimea,$timestamp1a,$timestampna,$commenta) = split(/,/,$atoma,5);
        my ($userb,$datetimeb,$timestamp1b,$timestampnb,$commentb) = split(/,/,$atomb,5);
        # check if atomb overlaps atoma in time
        if ($timestamp1a <= $timestamp1b && $timestamp1b <= $timestampna) 
        {
            my $reversed = 0;
            # check if the atoms are updating the same file in the wrong order
          CHECK:
            for my $filea (values %{$atomlist{$atoma}}) 
            {
                my ($fna,$vera,$resta) = split(/,/,$filea,3);
                for my $fileb (values %{$atomlist{$atomb}}) 
                {
                    my ($fnb,$verb,$restb) = split(/,/,$fileb,3);
                    if ($fna eq $fnb && $vera > $verb) 
                    {
                        if ($reversed) 
                        {
                            print STDERR "ERROR: Conflicting atoms, reversing order didn't help:\n$atoma:\n  $filea\n$atomb:\n  $fileb\n";
                            print "ERROR: Conflicting atoms\n";
                            $error = 1;
                            goto DUMP;
                        }
                        else 
                        {
                            # Two atoms where checked in at the same time
                            print STDERR "Conflicting atoms, trying to reverse order:\n$atoma:\n  $filea\n$atomb:\n  $fileb\n";
                            ($atoms[$i],$atoms[$i+1]) = ($atomb,$atoma);
                            ($atoma,$atomb) = ($atoms[$i],$atoms[$i+1]);
                            $reversed = 1;
                            goto CHECK;
                        }
                    }
                }
            }
            if ($reversed) {
                print STDERR "Conflict resolved!\n";
            }
        }

        for my $filea (values %{$atomlist{$atoma}}) 
        {
           my ($fna,$vera,$resta) = split(/,/,$filea,3);
           if (exists $fileversions{$fna}) 
           {
                if ($fileversions{$fna} >= $vera) 
                {
                    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";
                    print "ERROR: Files would be checked in in an unexpected order\n";
                    $error = 1;
                    goto DUMP;
                }
            }
            $fileversions{$fna} = $vera;
        }

        $i++;
    }
    if ($DEBUG) {
        print STDERR "Atom and file order verified correctly.\n";
    }

  DUMP:
    open(ATOMLIST,">atoms.txt");
    for ($i = 0; $i <= $#atoms; $i++) 
    {
        print ATOMLIST "$i,$atoms[$i]\n";
        for my $file (values %{$atomlist{$atoms[$i]}}) {
            print ATOMLIST "  $file\n";
        }
    }
    close(ATOMLIST);
    if ($error) {
        exit;
    }

    printf("\b\b\b\b\t\tdone (%d atoms)\n", $#atoms + 1);
}


#######################################################################
# Sort the history by user and timestamp.
#
sub sort_hist_by_user_timestamp
{
    my ($patha,$versiona,$datetimea,$timestampa,$usera,$actiona,$commenta) = split(/,/,$a,7);
    my ($pathb,$versionb,$datetimeb,$timestampb,$userb,$actionb,$commentb) = split(/,/,$b,7);
    
    if ($usera ne $userb) {
        return $usera cmp $userb;
    }
    elsif ($timestampa != $timestampb) {
        return $timestampa <=> $timestampb;
    }
    elsif ($commenta ne $commentb) {
        return $commenta cmp $commentb;
    }
    elsif ($patha ne $pathb) {
        return $patha cmp $pathb;
    }
    return $versiona <=> $versionb;
}


#######################################################################
# Sort the atoms by timestamp(s). Sub sort by user and comment.
#
sub sort_atoms_by_timestamp
{
    my ($usera,$datetimea,$timestamp1a,$timestampna,$commenta) = split(/,/,$a,5);
    my ($userb,$datetimeb,$timestamp1b,$timestampnb,$commentb) = split(/,/,$b,5);
    
    if ($timestamp1a != $timestamp1b) {
        return $timestamp1a <=> $timestamp1b;
    }
    elsif ($timestampna != $timestampnb) {
        return $timestampna <=> $timestampnb;
    }
    elsif ($usera ne $userb) {
        return $usera cmp $userb;
    }
    return $commenta cmp $commentb;
}


#######################################################################
# Get the latest checkpoint so allow resuming after refreshing history.
#
sub get_latest_checkpoint
{
    my ($line);
    my $i = 0;

    backup("directories.txt",10);
    backup("files.txt",10);
    backup("histories.txt",10);
    backup("atoms.txt",10);

    if (-f "extract_progress.txt")
    {
        my $lastatom = '';
        print "Calculating extract progress:";
        open(EXTRACT, "< extract_progress.txt");
        while (<EXTRACT>)
        {
            chop($_);
            $lastatom = $_;
        }
        close(EXTRACT);

        $RESUMEAFTERATOM = $lastatom;
        if ($DEBUG)
        {
            print STDERR "Resume after atom: $RESUMEAFTERATOM\n";
        }
        print "\tresume after atom $RESUMEAFTERATOM\n";
    }
}

sub backup
{
    my ($fn,$maxbups) = @_;

    my $lastfn = $fn . "." . $maxbups;
    if (-f $lastfn) 
    {
        unlink($lastfn);
    }
    for (my $i=$maxbups-1; $i>=1; $i--) 
    {
        my $file = $fn . "." . $i;
        my $pfile = $fn . "." . ($i+1);
        if (-f $file) 
        {
            link($file,$pfile);
            unlink($file);
        }
    }
    if (-f $fn) 
    {
        link($fn,$fn . ".1");
        unlink($fn);
    }
}

##############################################################
# Resume from previously generated parsed project data
#
sub resume
{
    my ($line);
    my $i = 0;

    if (-f "directories.txt")
    {
        print "Loading directories:      ";

        $i = 0;
        open(DIRS, "< directories.txt");
        while (<DIRS>)
        {
            $line = $_;
            chop($line);
            push(@directorylist, $line);
            $i++;
            printf("\b\b\b\b\b%5d", $i);
        }
        close(DIRS);
        print "\b\b\b\b\b\t\tdone ($i dirs)\n";
        $PHASE = 1;
    }

    if (-f "files.txt")
    {
        print "Loading files:       ";

        $i = 0;
        open(FILES, "< files.txt");
        while (<FILES>)
        {
            $line = $_;
            chop($line);
            push(@filelist, $line);
            $i++;
            printf("\b\b\b\b\b\b%6d", $i);
        }
        close(FILES);
        print "\b\b\b\b\b\b\t\t\tdone ($i files)\n";
        $PHASE = 2;
    }

    if (-f "histories.txt")
    {
        print "Loading file histories:       ";
        $i = 0;
        open(HIST, "< histories.txt");
        while (<HIST>)
        {
            $line = $_;
            chop($line);
            push(@histories, $line);
            $i++;
            printf("\b\b\b\b\b\b%6d", $i);
        }
        close(HIST);
        print "\b\b\b\b\b\b\tdone ($i versions)\n";
        $PHASE = 3;
    }

    if (-f "extract_progress.txt")
    {
        my $lastatom = '';
        print "Calculating extract progress:";
        open(EXTRACT, "< extract_progress.txt");
        while (<EXTRACT>)
        {
            chop($_);
            $lastatom = $_;
        }
        close(EXTRACT);

        $RESUMEAFTERATOM = $lastatom;
        if ($DEBUG)
        {
            print STDERR "Resume after atom: $RESUMEAFTERATOM\n";
        }
        print "\tresume after atom $RESUMEAFTERATOM\n";
        $PHASE = 6;
    }
}


##############################################################
# Create the directory hierarchy in the local filesystem
#
sub create_directories
{
    if ($DEBUG)
    {
        print STDERR "\n#############################################################\n";
        print STDERR "#              Subroutine: create_directories               #\n";
        print STDERR "#############################################################\n";
    }

    print "Creating local directories: ";
    &recursive_delete('./work');
    mkdir('./work');

    foreach my $dir (@directorylist)
    {
        if ($dir =~ /^\$\//)
        {
            my $rawdir = "./work/$'";
            recursive_mkdir($rawdir);
            if ($DEBUG)
            {
                print STDERR "Creating project dir '$rawdir'\n";
            }
        }
    }
    print "\tdone\n";
}


##############################################################
# Delete a directory tree and all of its files recursively
#
sub recursive_delete
{
    my ($parent) = @_;
    my (@dirs, $dir);

    opendir(DIR, $parent);
    @dirs = readdir(DIR);
    closedir(DIR);
    foreach $dir (@dirs)
    {
        if ($dir ne '.' && $dir ne '..')
        {
            recursive_delete("$parent/$dir");
        }
    }

    if (-d $parent)
    {
        rmdir($parent);
    }
    elsif (-f $parent)
    {
        unlink($parent);
    }
}


##############################################################
# Make a directory tree and all of its sub dirs recursively
#
sub recursive_mkdir
{
    my($tpath) = @_;
    my($dir, $accum);

    foreach $dir (split(/\//, $tpath))
    {
        $accum = "$accum$dir/";
        if ($dir ne "")
        {
            if (! -d "$accum")
            {
                mkdir $accum;
            }
        }
    }
}


##############################################################
# Import a directory hierarchy into Subversion
#
sub import_directories
{
    if ($DEBUG)
    {
        print STDERR "\n#############################################################\n";
        print STDERR "#              Subroutine: import_directories               #\n";
        print STDERR "#############################################################\n";
    }

    print "Importing directories: ";

    my $cmd = "svn import --username \"$USERNAME\" --password \"$PASSWORD\" --message \"Initial import from VSS\" . \"$REPOS\"";
    if ($DEBUG)
    {
        print STDERR "$cmd\n";
    }

    chdir('./work');
    `$cmd`;
    chdir('..');

    print "\t\tdone\n";

    $PHASE = 5;
}


##############################################################
# Checkout a copy of the directory hierarchy so that we have
# a Subversion local working copy
#
sub checkout_directories
{
    if ($DEBUG)
    {
        print STDERR "\n#############################################################\n";
        print STDERR "#             Subroutine: checkout_directories              #\n";
        print STDERR "#############################################################\n";
    }

    print "Checking out directories: ";

    my $cmd = "svn checkout --username \"$USERNAME\" --password \"$PASSWORD\" --non-interactive \"$REPOS\" \"./work\"";
    if ($DEBUG)
    {
        print STDERR "$cmd\n";
    }

    &recursive_delete('./work');
    mkdir('./work');
    `$cmd`;
    if ($? != 0) {
        print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
        exit;
    }
    print "\tdone\n";

    $PHASE = 6;
}


##############################################################
# This is the meat.  Extract each version of each file in the
# project from VSS and check it into Subversion
#
sub extract_and_import
{
    if ($DEBUG)
    {
        print STDERR "\n#############################################################\n";
        print STDERR "#              Subroutine: extract_and_import               #\n";
        print STDERR "#############################################################\n";
    }

    my $padding = "                                                                      ";
    my ($cmd, $tmpname, $localpath, $localdir, $out);
    my ($pyear,$pmon,$pmday,$phour,$pmin,$num) = (0,0,0,0,0,0);

    my $count = @atoms;
    my $startatom = 0;

    print "Extracting and creating:\n";

    open(EXTRACT, ">>extract_progress.txt");

    if ($RESUMEAFTERATOM ne '')
    {
        my ($atomnr,$atom) = split(/,/,$RESUMEAFTERATOM,2);
        if ($atoms[$atomnr] eq $atom) {
            $startatom = $atomnr + 1;
        }
        else {
            print STDERR "ERROR! Resume inconsistency: atom $atomnr has changed:\nexp: $atom\ncur: $atoms[$atomnr]\n";
            print "ERROR! Resume inconsistency!\n";
            exit;
        }
    }

    chdir('./work/');
    for (my $i = $startatom; $i <= $#atoms; $i++)
    {
        my $atom = $atoms[$i];
        my $targets = '';

        foreach my $atomfile (values %{$atomlist{$atom}})
        {
            my ($file,$version,$action) = split(',',$atomfile,3);

            # display sugar
            $tmpname = substr($file, rindex($file,'/') + 1, 50) . ' (v.' . $version . ')';
            printf("\r$padding\r  (%3d\%): %s", ((($i+1) / $count) * 100), substr("$tmpname", 0, 60));

            # extract the file from VSS
            if ($file =~ /^\$\//) # strip $/ from the start
            {
                # extract to the proper directory
                $localpath = $';
                $localpath =~ s/\//\\/g;

                $localdir = $localpath;
                my $slash = rindex($localdir, '\\');
                if ($slash == -1) {
                    $localdir = '.';
                }
                else {
                    $localdir = substr($localdir,0,$slash);
                }
    
                #print STDERR "file = $file\n"; # DEBUG ONLY
                #print STDERR "localpath = $localpath\n"; # DEBUG ONLY
                #print STDERR "localdir = $localdir\n"; # DEBUG ONLY
    
                my $fileexists = -f $localpath;
                
                $cmd = $SSCMD . " get -GTM -W -I-Y -GL\"$localdir\" -V$version \"$file\" 2>&1";
                $out = `$cmd`;
    
                # get rid of stupid VSS warning messages
                $* = 1;
                $out =~ s/\n?Project.*rebuilt\.//g;
                $out =~ s/\n?File.*rebuilt\.//g;
                $out =~ s/\n.*was moved out of this project.*rebuilt\.//g;
                $out =~ s/\nContinue anyway.*Y//g;
                $* = 0;
    
                if ($DEBUG) 
                {
                    print STDERR "$cmd\n";
                    print STDERR "$out";
                }
                
                if ($? != 0) 
                {
                    print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
                    exit;
                }
                
                if ($out =~ /does not retain old versions of itself/) 
                {
                    print STDERR "WARNING: Binary file without history: $file\n";
                }
                elsif (! -f $localpath) 
                {
                    print STDERR "ERROR: File not checked out: $file (v.$version)\n";
                }
                else 
                {
                    # create list of targets to commit in this atom
                    $targets .= "$localpath\n";
    
                    if (! $fileexists ) 
                    {
                        $cmd = "svn add \"$localpath\" 2>&1";
                        $out = `$cmd`;
                        if ($DEBUG) 
                        {
                            print STDERR "$cmd\n";
                            print STDERR "$out";
                        }
                        if ($? != 0) 
                        {
                            print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
                            exit;
                        }
                    }
                }
            }
        }
    
        if ($targets ne '')
        {
            my ($user,$datetime,$timestamp1,$timestampn,$comment) = split(/,/,$atom,5);
    
            # display sugar
            $tmpname = "Commit atom $i [$user $datetime]";
            printf("\r$padding\r  (%3d\%): %s", ((($i+1) / $count) * 100), substr("$tmpname", 0, 60));
            
            if ($DEBUG) 
            {
                print STDERR "$tmpname\n";
            }
            if ($FORCEUSER ne '')
            {
                $user = $FORCEUSER;
            }
    
            # Translate character codes from CP437/CP850 to UTF-8 (åäöÅÄÖ)
            #$comment =~ tr/\206\204\224\217\216\231/\254\253\271\197\196\214/;
            #$comment =~ tr/\206\204\224\217\216\231/aaoAAO/;
            #$comment =~ s/</[lt]/g;
            #$comment =~ s/>/[gt]/g;
            #$comment =~ s/"/\\"/g; # quote quotes
            $comment =~ s/__NL__/\n/g;
    
            open(TARGETS,">___targets");
            print TARGETS $targets;
            close(TARGETS);
            
            open(MESSAGE,">___message");
            print MESSAGE "$comment\n";
            close(MESSAGE);
            
            # commit changes as the VSS user (with a blank password)
            $cmd = "svn commit --username \"$user\" --password \"\" --non-interactive --non-recursive --file ___message --targets ___targets 2>&1";
            $out = `$cmd`;
            if ($DEBUG)
            {
                print STDERR "$cmd\n";
                print STDERR "$out";
            }
            if ($? != 0) 
            {
                print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
                exit;
            }
    
            # Clean up
            unlink("___targets");
            unlink("___message");
    
            # set the SVN commit date to the original VSS check-in date
            my ($gsec,$gmin,$ghour,$gmday,$gmon,$gyear,$gwday,$gyday,$gisdst) = gmtime($timestamp1);
            $gyear += 1900;
            $gmon++;
            if ($gyear==$pyear && $gmon==$pmon && $gmday==$pmday && $ghour==$phour && $gmin==$pmin) 
            {
                $num += 100;
            }
            else 
            {
                $num = 0;
            }
            my $svntime = sprintf("%04d-%02d-%02dT%02d:%02d:00.%06dZ",$gyear,$gmon,$gmday,$ghour,$gmin,$num);
    
            $cmd = "svn propset --username \"$USERNAME\" --password \"$PASSWORD\" --revprop -r HEAD svn:date $svntime \"$REPOS\" 2>&1";
            $out = `$cmd`;
            if ($DEBUG)
            {
                print STDERR "$cmd\n";
                print STDERR "$out";
            }
            if ($? != 0) 
            {
                print STDERR "FAILED: $cmd => " . $? >> 8 . "\n";
                exit;
            }
            
            ($pyear,$pmon,$pmday,$phour,$pmin) = ($gyear,$gmon,$gmday,$ghour,$gmin);
        }
            
        print EXTRACT "$i,$atom\n";
    }
    close(EXTRACT);
    printf("\r$padding\r                                done (%d atoms)\n", $#atoms + 1);
}


##############################################################
# Get a formatted date time
#
sub prettydate
{
    my ($sec, $min, $hrs, $day, $month, $year) = (localtime)[0,1,2,3,4,5];
    return(sprintf("%04d-%02d-%02d %02d:%02d:%02d\n", $year+1900, $month+1, $day, $hrs, $min, $sec));
}