legacy/vss2svn.pl

   1 #!perl
   2
   3 # vss2svn.pl, Copyright (C) 2004 by Toby Johnson.
   4 #
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 # http://www.gnu.org/copyleft/gpl.html
  15
  16
  17 use warnings;
  18 use strict;
  19
  20 use Cwd;
  21 use DBD::SQLite;
  22 use DBI;
  23 use Data::Dumper;
  24 use Encode;
  25 use File::Path;
  26 use Getopt::Long;
  27 use Pod::Usage;
  28 use SVN::Client;
  29 use SVN::Core;
  30 use SVN::Wc;
  31 use Text::Wrap;
  32 use Time::ParseDate;
  33 use URI::URL;
  34 use Win32::TieRegistry (Delimiter => '/');
  35 use Win32;
  36
  37 our(%gCfg, $VSS, $SVNClient, $SNAPTIME, $SUBSTMAP, $COMMENT, $REVISION, $STATE_CHANGED);
  38
  39 sub first(&@);
  40 sub PrintMsg; # defined later
  41
  42 &Vss2Svn::VSS::Initialize;
  43
  44 &Regionalize;
  45 &Initialize;
  46 &GiveStartupMessage;
  47 &SetupLogfile;
  48
  49 &CreateDatabase;
  50
  51 &GetProjectTree;
  52 &BuildHistory;
  53 &GiveSchemaAuthMessage unless $gCfg{noprompt};
  54
  55 # the SVNClient seems to need to be somewhere in the working copy in order to work
  56 chdir $gCfg{workdir} or die "Could not change to directory $gCfg{workdir}";
  57
  58 if ($gCfg{globalCiCount} < 0) {
  59         &CheckoutSvnWC;
  60 }
  61 &ApplySvnActions;
  62 &ImportSvnHistory;
  63
  64 &CloseDatabase;
  65 PrintMsg "\n\n**** VSS MIGRATION COMPLETED SUCCESSFULLY!! ****\n";
  66
  67 close STDERR;
  68 open STDERR, ">&THE_REAL_STDERR"; # yes, we're about to exit, but leaving
  69                                   # STDERR dangling always makes me nervous!
  70
  71 $gCfg{hooray} = 1; # to suppress Win32::TieRegistry global destruction errors
  72 exit(0);
  73
  74
  75 ###############################################################################
  76 #  GiveStartupMessage
  77 ###############################################################################
  78 sub GiveStartupMessage {
  79     my $setrevprop = $gCfg{setrevprop} ? 'yes' : 'no';
  80
  81     print <<"EOMSG";
  82
  83          ss.exe Found: $VSS->{_ssexe}
  84
  85           VSS Project: $gCfg{vssproject}
  86        Subversion URL: $gCfg{svnrepo}
  87
  88     Local Date Format: $Vss2Svn::VSS::gCfg{dateString}
  89     Local Time Format: $Vss2Svn::VSS::gCfg{timeString}
  90  Time Bias To Get GMT: $gCfg{timebias} minutes
  91    Bias to use in DST: $gCfg{dstbias} minutes
  92
  93      Set SVN revprops: $setrevprop
  94 EOMSG
  95
  96     return if $gCfg{noprompt};
  97
  98     print "Continue with these settings? [Y/n]";
  99     my $reply = <STDIN>;
 100     exit(1) if ($reply =~ m/\S/ && $reply !~ m/^y/i);
 101 }
 102
 103 ###############################################################################
 104 #  SetupLogfile
 105 ###############################################################################
 106 sub SetupLogfile {
 107     # redirect STDERR to logfile
 108     open THE_REAL_STDERR, ">&STDERR";
 109     $gCfg{logfile} = "$gCfg{workbase}/logfile.txt";
 110     open STDERR, ">>$gCfg{logfile}"
 111         or die "Couldn't open logfile $gCfg{workbase}/logfile.txt";
 112
 113     # the svn client program outputs to STDOUT; redirect to STDERR instead
 114     open STDOUT, ">&STDERR";
 115
 116     select THE_REAL_STDERR;
 117     $| = 1;
 118     select STDOUT;
 119
 120     # since we redirected STDERR, make sure user sees die() messages!
 121     $SIG{__DIE__} = \&MyDie;
 122     $SIG{__WARN__} = \&PrintMsg if $gCfg{debug};
 123 }
 124
 125 ###############################################################################
 126 #  GetProjectTree
 127 ###############################################################################
 128 sub GetProjectTree {
 129     my $tree;
 130     if (!defined $gCfg{restart} || (defined $gCfg{restart} && defined $gCfg{update})) {
 131         my $msg = (defined $gCfg{update}) ? "UPDATED" : "INITIAL";
 132         PrintMsg "\n\n**** BUILDING $msg STRUCTURES; PLEASE WAIT... ****\n\n";
 133
 134         # grab the project tree from the DIR listing
 135         $tree = $VSS->project_tree($gCfg{vssproject},1,1,
 136                                    ("endlabel" => $gCfg{snaplabel}, "endtime" => $SNAPTIME))
 137             or die "Couldn't create project tree for $gCfg{vssproject}";
 138
 139         my $projsth = $gCfg{dbh}->prepare("INSERT INTO treetable (tag, type, file, version)"
 140                                           . " VALUES('update', 'project', ?, 0)")
 141             or die "Could not execute DBD::SQLite command";
 142         my $filesth = $gCfg{dbh}->prepare("INSERT INTO treetable (tag, type, file, version)"
 143                                           . " VALUES('update', 'file', ?, ?)")
 144             or die "Could not execute DBD::SQLite command";
 145
 146         # insert the project tree structure into the database in one transaction
 147         my $ac = $gCfg{dbh}->{AutoCommit};
 148         my $re = $gCfg{dbh}->{RaiseError};
 149
 150         $gCfg{dbh}->{AutoCommit} = 0;
 151         $gCfg{dbh}->{RaiseError} = 1;
 152         eval {
 153             &WalkTree($tree, $gCfg{vssproject}, $projsth, $filesth);
 154             &PruneVssExcludes;
 155             # we must compare the update vs the old snapshot to add/remove files and directories
 156             if (defined $gCfg{update}) {
 157                 PrintMsg "\n\n**** Comparing trees... ****\n\n";
 158                 &CompareTrees;
 159             }
 160             $gCfg{dbh}->do("DELETE FROM treetable WHERE tag='current'");
 161             $gCfg{dbh}->do("UPDATE treetable SET tag='current' WHERE tag='update'");
 162
 163             # remember to add the new projects later
 164             if ($gCfg{globalCiCount} < 0) {
 165                 PrintMsg "\n\n**** Enqueueing projects... ****\n\n";
 166                 &EnqueueSvnProjects;
 167             }
 168             $gCfg{dbh}->commit;
 169         };
 170         if ($@) {
 171             PrintMsg "Transaction aborted because $@";
 172             eval { $gCfg{dbh}->rollback };
 173             die "Transaction failed!";
 174         }
 175         $projsth->finish();
 176         $filesth->finish();
 177
 178         $gCfg{dbh}->{AutoCommit} = $ac;
 179         $gCfg{dbh}->{RaiseError} = $re;
 180     }
 181 }
 182
 183 ###############################################################################
 184 #  PruneVssExcludes
 185 ###############################################################################
 186 sub PruneVssExcludes {
 187
 188     return unless defined $gCfg{vssexclude};
 189     return if defined $gCfg{restart};
 190
 191     # By this point, we already have the entire "naked" directory structure
 192     # in the database and we prune off any branches that match exclude.
 193
 194     my $prunesth = $gCfg{dbh}->prepare("DELETE FROM treetable WHERE tag='update' AND file LIKE ?")
 195         or die "Could not execute DBD::SQLite command";
 196
 197 EXCLUDE:
 198     foreach my $exclude ( sort @{ $gCfg{vssexclude} }) {
 199         # by sorting, we get parents before their subdirectories, to give more
 200         # meaningful warning messages
 201
 202         $exclude =~ s/^\s*(.*?)\s*$/$1/;
 203         $exclude =~ s:^$gCfg{vssprojmatch}/?::;
 204
 205         if ($exclude =~ m:^\$/:) {
 206             PrintMsg "**WARNING: Exclude path \"$exclude\" is not underneath "
 207                 . "$gCfg{vssproject}; ignoring...\n";
 208             next EXCLUDE;
 209         } elsif ($exclude =~ m:^$:) {
 210             PrintMsg "**WARNING: Exclude path \"$exclude\" is entire project of "
 211                 . "$gCfg{vssproject}; ignoring...\n";
 212             next EXCLUDE;
 213         }
 214
 215         # so we are in the project at least
 216         $exclude = $gCfg{vssproject} . "/" . $exclude;
 217         my $esc = $gCfg{dbh}->get_info(14); # get the SQL escape char
 218
 219         # this RE is for the `file' column
 220         my $pathsqlre = $exclude;
 221         $pathsqlre =~ s/([_%])/$esc$1/g; # quote any SQL re that happens to be in the path
 222         $pathsqlre .= "%"; # append the real SQL re that we are looking for
 223         $prunesth->execute($pathsqlre) or die "Could not execute DBD::SQLite command";
 224     }
 225     $prunesth->finish();
 226
 227 }  #  End PruneVssExcludes
 228
 229 ###############################################################################
 230 #  CompareTrees
 231 ###############################################################################
 232 sub CompareTrees {
 233
 234     my $deletedFileList = [];
 235     my $deletedProjectList = [];
 236     my $esc = $gCfg{dbh}->get_info(14); # get the SQL escape char
 237
 238     # look for deleted projects first
 239     # remember these, since we may have to delete files, too
 240     my $sth = $gCfg{dbh}->prepare("SELECT file FROM treetable WHERE tag='current' AND type='project' "
 241                                   . "AND file NOT IN (SELECT file FROM treetable WHERE tag='update' AND type='project') ORDER BY file");
 242
 243     $sth->execute();
 244     while (my $row = $sth->fetchrow_hashref()) {
 245         push @{$deletedProjectList}, $row->{file};
 246     }
 247     $sth->finish();
 248
 249     # look for added projects
 250     # just go ahead and add these items
 251     $sth = $gCfg{dbh}->prepare("SELECT file FROM treetable WHERE tag='update' AND type='project' "
 252                                . "AND file NOT IN (SELECT file FROM treetable WHERE tag='current' AND type='project') ORDER BY file");
 253
 254     my $insactionsth = $gCfg{dbh}->prepare("INSERT INTO svnaction (type, action, global_count, file) VALUES('project', 'add', 0, ?)");
 255
 256     $sth->execute();
 257     while (my $row = $sth->fetchrow_hashref()) {
 258         $insactionsth->execute($row->{file});
 259     }
 260     $sth->finish();
 261     $insactionsth->finish();
 262
 263     # look for deleted files
 264     $sth = $gCfg{dbh}->prepare("SELECT file FROM treetable WHERE tag='current' AND type='file' "
 265                                . "AND file NOT IN (SELECT file FROM treetable WHERE tag='update' AND type='file') ORDER BY file");
 266
 267     $sth->execute();
 268     while (my $row = $sth->fetchrow_hashref()) {
 269         push @{$deletedFileList}, $row->{file};
 270     }
 271     $sth->finish();
 272
 273     # cull the deleted projects containing subdirectories and files
 274     if (scalar @{$deletedProjectList} > 0) {
 275
 276         # mark references as complete in the database
 277         my $delprojsth = $gCfg{dbh}->prepare("UPDATE history SET deleted = 1 WHERE file LIKE ?");
 278         my $delcpsth = $gCfg{dbh}->prepare("DELETE FROM checkpoint WHERE file LIKE ?");
 279
 280         # mark further action for SVNClient to take
 281         my $delactionsth = $gCfg{dbh}->prepare("INSERT INTO svnaction (type, action, global_count, file) VALUES('project', 'delete', 0, ?)");
 282         my $elem;
 283         while (defined ($elem = shift @{$deletedProjectList})) {
 284             # this RE is for subdirs and files in the lists
 285             my $pathre = quotemeta($elem) . "\/.*";
 286
 287             # this RE is for the `file' column in the checkpoint relation
 288             my $pathsqlre = $elem;
 289             $pathsqlre =~ s/([_%])/$esc$1/g; # quote any SQL re that happens to be in the path
 290             $pathsqlre .= "/%"; # append the real SQL re that we are looking for
 291
 292             # remove subdirectories of this directory from deleted projects list
 293             my $newList = [];
 294             foreach my $newElem (@{$deletedProjectList}) {
 295                 if (!($newElem =~ m/$pathre/)) {
 296                     push @{$newList}, $newElem;
 297                 }
 298             }
 299             $deletedProjectList = $newList;
 300
 301             # remove files in this directory from the deleted files list
 302             $newList = [];
 303             foreach my $newElem (@{$deletedFileList}) {
 304                 if (!($newElem =~ m/$pathre/)) {
 305                     push @{$newList}, $newElem;
 306                 }
 307             }
 308             $deletedFileList = $newList;
 309
 310             $delactionsth->execute($elem);
 311             $delprojsth->execute($pathsqlre);
 312             $delcpsth->execute($pathsqlre);
 313         }
 314         $delactionsth->finish();
 315         $delprojsth->finish();
 316         $delcpsth->finish();
 317     }
 318
 319     if (scalar @{$deletedFileList} > 0) {
 320         # mark references as complete in the database
 321         my $delprojsth = $gCfg{dbh}->prepare("UPDATE history SET deleted = 1 WHERE file = ?");
 322         my $delcpsth = $gCfg{dbh}->prepare("DELETE FROM checkpoint WHERE file = ?");
 323
 324         # mark further action for SVNClient to take
 325         my $delactionsth = $gCfg{dbh}->prepare("INSERT INTO svnaction (type, action, global_count, file) VALUES('file', 'delete', 0, ?)");
 326         my $elem;
 327         while (defined ($elem = shift @{$deletedFileList})) {
 328             $delactionsth->execute($elem);
 329             $delprojsth->execute($elem);
 330             $delcpsth->execute($elem);
 331         }
 332     }
 333 }
 334
 335 ###############################################################################
 336 #  BuildHistory
 337 ###############################################################################
 338 sub BuildHistory {
 339     PrintMsg "\n\n**** BUILDING VSS HISTORY ****\n\n";
 340
 341     # There are two distinct groups in this list that qualify for new history:
 342     # 1) Files in the treetable that have old history that are getting updated
 343     #    (according to the version in treetable).  These files have already been checkpointed.
 344     # 2) New files in the treetable with no previous history.  These files have not been checkpointed.
 345     my $limsize = 512;
 346     my $cmd;
 347
 348     if (!defined $gCfg{update} || $gCfg{update} eq "fast") {
 349         $cmd = "SELECT a.file, b.histversion, a.version AS version "
 350         . "   FROM (SELECT file, version FROM treetable WHERE tag='current' AND type='file' AND version > 0) AS a, "
 351         . "        (SELECT file, MAX(version) AS histversion FROM history WHERE deleted = 0 GROUP BY file) AS b "
 352         . "   WHERE a.file = b.file AND a.version <> b.histversion"
 353         . " UNION "
 354         . "SELECT file, 0 AS histversion, version "
 355         . "   FROM (SELECT file, version FROM treetable WHERE tag='current' AND type='file' AND version > 0) "
 356         . "   WHERE file NOT IN (SELECT file FROM checkpoint) "
 357         . "ORDER BY file LIMIT $limsize";
 358     } elsif (defined $gCfg{update} && $gCfg{update} eq "complete") {
 359         $cmd = "SELECT a.file, b.histversion, a.version AS version "
 360         . "   FROM (SELECT file, version FROM treetable WHERE tag='current' AND type='file' AND version > 0) AS a, "
 361         . "        (SELECT file, MAX(version) AS histversion FROM history WHERE deleted = 0 GROUP BY file) AS b "
 362         . "   WHERE a.file = b.file"
 363         . " UNION "
 364         . "SELECT file, 0 AS histversion, version "
 365         . "   FROM (SELECT file, version FROM treetable WHERE tag='current' AND type='file' AND version > 0) "
 366         . "   WHERE file NOT IN (SELECT file FROM checkpoint) "
 367         . "ORDER BY file LIMIT $limsize";
 368     }
 369
 370     # get all new files in the tree
 371     my $fplsth = $gCfg{dbh}->prepare($cmd)
 372         or die "Could not execute DBD::SQLite command";
 373
 374     PrintMsg "\n\n**** IMPORTING FILE HISTORIES ****\n\n";
 375
 376     # creates new checkpoint for a file, meaning that history has been added
 377     my $cptsth = $gCfg{dbh}->prepare("INSERT OR IGNORE INTO checkpoint (file, checked) VALUES (?, 1)")
 378         or die "Could not execute DBD::SQLite command";
 379
 380     # query for recovered file
 381     my $recsth;
 382
 383     if (defined $gCfg{update}) {
 384         # this checks to see if it was deleted in history at all
 385         $recsth = $gCfg{dbh}->prepare("SELECT file FROM history WHERE file = ? AND deleted = 1")
 386             or die "Could not execute DBD::SQLite command";
 387     }
 388
 389     # create the command to insert history here
 390     my $inshistcmd = "INSERT INTO history (tstamp, file, version, user, comment, global_count, retrieved, deleted)"
 391         . " VALUES (?, ?, ?, ?, ?, ?, 0, 0)";
 392     my $inshiststh = $gCfg{dbh}->prepare($inshistcmd)
 393         or die "Could not execute DBD::SQLite command";
 394
 395   BIGLOOP:
 396     while (1) {
 397         # copy the query results so we can start tranactions
 398         $fplsth->execute() or die "Could not execute DBD::SQLite command";
 399         my $filelst = [];
 400         while (my $fprow = $fplsth->fetchrow_hashref()) {
 401             push @{$filelst}, {file => $fprow->{file}, version => $fprow->{version}, histversion => $fprow->{histversion}};
 402         }
 403         $fplsth->finish();
 404
 405         # exit the loop if there were no files to add
 406         if ((scalar @{$filelst}) == 0) {
 407             last BIGLOOP;
 408         }
 409
 410         my $ac = $gCfg{dbh}->{AutoCommit};
 411         my $re = $gCfg{dbh}->{RaiseError};
 412
 413         foreach my $fpr (@{$filelst}) {
 414             my $foo = \%{$fpr};
 415             my $filepath = $foo->{file};
 416
 417             my %versionInfo = ("endversion" => $foo->{version}, "beginversion" => $foo->{histversion});
 418
 419             my $deletedInHistory = 0;
 420             if (defined $recsth && $versionInfo{beginversion} == 0) {
 421                 $recsth->execute($filepath) or die "Could not execute DBD::SQLite command";
 422                 my $tmp;
 423                 $recsth->bind_columns(\$tmp);
 424                 while ($recsth->fetch()) {
 425                     $deletedInHistory = 1;
 426                 }
 427             }
 428
 429             $gCfg{dbh}->{AutoCommit} = 0;
 430             $gCfg{dbh}->{RaiseError} = 1;
 431             eval {
 432                 &AddFileHistory($filepath, $inshiststh, $deletedInHistory, %versionInfo);
 433                 $cptsth->execute($filepath);
 434                 $gCfg{dbh}->do("DELETE FROM agenda WHERE iorder = 0"); # flag scheduler
 435                 $gCfg{dbh}->commit;
 436             };
 437             if ($@) {
 438                 PrintMsg "Transaction aborted because $@";
 439                 eval { $gCfg{dbh}->rollback };
 440                 die "Transaction failed!";
 441             }
 442             $gCfg{dbh}->{AutoCommit} = $ac; # commit side effect
 443             $gCfg{dbh}->{RaiseError} = $re;
 444         }
 445     }
 446     $cptsth->finish();
 447     $recsth->finish() if defined $recsth;
 448     $inshiststh->finish();
 449
 450     PrintMsg "\n\n**** DONE BUILDING VSS HISTORY ****\n\n";
 451 }
 452
 453 ###############################################################################
 454 #  WalkTree
 455 ###############################################################################
 456 sub WalkTree {
 457     my($branch, $project, $projsth, $filesth) = @_;
 458
 459     my($key, $val, $newproj);
 460     my @branches = ();
 461
 462     foreach $key (sort keys %$branch) {
 463         $val = $branch->{$key};
 464
 465         if (ref($val) eq 'HASH') {
 466             # subproject; create a new branch of the tree
 467
 468             push @branches, {branch => $val, project => "$key"};
 469
 470         } elsif (!ref $val) {
 471             # a scalar, i.e. regular file
 472
 473             my $filepath = &CreateFilepath($project, $key);
 474
 475             # save it away
 476             $filesth->execute($filepath, $val);
 477         }
 478     }
 479
 480     foreach my $subbranch (@branches) {
 481         # save the project away and keep looking
 482         ($newproj = "$project/$subbranch->{project}") =~ s://:/:;
 483
 484         $projsth->execute($newproj);
 485
 486         &WalkTree($subbranch->{branch}, $newproj, $projsth, $filesth);
 487     }
 488 }
 489
 490 ###############################################################################
 491 #  CreateFilepath
 492 ###############################################################################
 493 sub CreateFilepath {
 494     my($project, $file) = @_;
 495     (my $filepath = "$project/$file") =~ s://:/:;
 496
 497     # SS.exe uses a semicolon to indicate a "pinned" file
 498     $filepath =~ s/;(.*)//;
 499
 500     return $filepath;
 501 }
 502
 503 ###############################################################################
 504 #  AddFileHistory
 505 ###############################################################################
 506 sub AddFileHistory {
 507     my($filepath, $inshiststh, $deletedInHistory, %versionInfo) = @_;
 508
 509     warn "AddFileHistory: filepath: " . $filepath . " deletedInHistory: " . $deletedInHistory
 510         . " start: " . $versionInfo{"beginversion"} . " end: " . $versionInfo{"endversion"};
 511
 512     # build the revision history for this file
 513     my $historypath = $filepath;
 514
 515     if (defined $SUBSTMAP->{$filepath}) {
 516         $historypath = $SUBSTMAP->{$filepath};
 517     }
 518
 519     my $keepLabel = !(defined $gCfg{nolabel});
 520     my ($filehist, $qhiststh);
 521     my $redoHistory = !($versionInfo{"endversion"} > $versionInfo{"beginversion"});
 522
 523     if ($redoHistory) {
 524         warn "History rolled back for " . $filepath . ": start:" . $versionInfo{"beginversion"} . " end:" . $versionInfo{"endversion"};
 525
 526         # file has been rolled back, pinned, or replaced by a totally different file with the same name
 527         # we need to look at entire history with the last case
 528
 529         # we must also invalidate at least the "future" versions
 530         my $delsth = $gCfg{dbh}->prepare("UPDATE history SET deleted = 1 WHERE file = ? AND version > ?");
 531         $delsth->execute($filepath, $versionInfo{"endversion"});
 532         $delsth->finish();
 533         $versionInfo{"beginversion"} = 0;
 534         $qhiststh = $gCfg{dbh}->prepare("SELECT MAX(global_count) AS global_count FROM history WHERE tstamp = ? AND file = ? AND version = ? AND user = ? AND comment = ? AND deleted = 0 GROUP BY file");
 535     } elsif ($deletedInHistory) {
 536         warn "Deleted history for " . $filepath . ": start:" . $versionInfo{"beginversion"} . " end:" . $versionInfo{"endversion"};
 537         # if the file has been deleted in history, it could have one or more deleted
 538         # revisions that may be made active, including being recovered
 539         $qhiststh = $gCfg{dbh}->prepare("SELECT MAX(global_count) AS global_count FROM history WHERE tstamp = ? AND file = ? AND version = ? AND user = ? AND comment = ? AND deleted = 1 GROUP BY file");
 540     }
 541     # otherwise, the file is new or updating
 542
 543     ++$versionInfo{"beginversion"}; # fix off by one before getting history
 544     $filehist = $VSS->file_history($historypath, $keepLabel, %versionInfo);
 545     die "Internal error while reading VSS file history for $filepath"
 546         if !defined $filehist;
 547
 548     PrintMsg "   $filepath\n";
 549
 550     # this is in case we just rolled back or pinned
 551     # read the history in reverse and find the first place we were there
 552     my $revversion;
 553     if ($redoHistory || $deletedInHistory) {
 554         my $revfilehist = [];
 555         foreach my $foo (@$filehist) {
 556             unshift @{$revfilehist}, $foo;
 557         }
 558         my $scheduledCopy = 0;
 559         my $fixsth = $gCfg{dbh}->prepare("UPDATE history SET deleted = 0 WHERE global_count = ?");
 560         my $fix2sth = $gCfg{dbh}->prepare("UPDATE history SET deleted = 1 WHERE tstamp = ? AND file = ? AND version = ? AND user = ? AND comment = ?");
 561         my $currhiststh = $gCfg{dbh}->prepare("SELECT file FROM history WHERE file = ? AND deleted = 0");
 562         my ($chrow, $fileInCurrentHistory);
 563         $fileInCurrentHistory = 0;
 564         $currhiststh->execute($filepath);
 565         while ($chrow = $currhiststh->fetchrow_hashref()) {
 566             $fileInCurrentHistory = 1;
 567         }
 568         $currhiststh->finish();
 569       REVWALK:
 570         foreach my $rev (@$revfilehist) {
 571             $rev->{comment} = "" unless defined $rev->{comment};
 572             warn "Looking for: tstamp " . $rev->{tstamp} . " " . $filepath . " " . $rev->{version} . " " . $rev->{user} . " " . $rev->{comment};
 573             warn "tstamp undefined" unless defined $rev->{tstamp};
 574             warn "filepath undefined" unless defined $filepath;
 575             warn "version undefined" unless defined $rev->{version};
 576             warn "user undefined" unless defined $rev->{user};
 577             warn "comment undefined" unless defined $rev->{comment};
 578
 579             $qhiststh->execute($rev->{tstamp}, $filepath, $rev->{version}, $rev->{user}, $rev->{comment});
 580             my ($qrow, $gc, $revision);
 581             while ($qrow = $qhiststh->fetchrow_hashref()) {
 582                 $gc = $qrow->{global_count};
 583             }
 584             if (defined $gc && !$scheduledCopy) {
 585                 warn "Found global_count: " . $gc;
 586
 587                 $revversion = $rev->{version};
 588                 my ($undelactionsth, $checkpointsth);
 589
 590                 # if the file is not there, it must be copied there
 591                 # otherwise if the file is there, it must be rolled back
 592                 warn "fileInCurrentHistory: " . $fileInCurrentHistory;
 593                 if ($fileInCurrentHistory) {
 594                     $undelactionsth = $gCfg{dbh}->prepare("INSERT INTO svnaction (type, action, global_count, file, args) VALUES('file', 'merge', 0, ?, ?)");
 595                 } else {
 596                     $undelactionsth = $gCfg{dbh}->prepare("INSERT INTO svnaction (type, action, global_count, file, args) VALUES('file', 'copy', 0, ?, ?)");
 597                     $checkpointsth =  $gCfg{dbh}->prepare("INSERT OR IGNORE INTO checkpoint (file, checked) VALUES(?, 3)");
 598                 }
 599
 600                 # get the destination target
 601                 my $dst_target = $filepath;
 602                 $dst_target =~ m/^(.*\/)(.*)/;
 603                 my($path, $file) = ($1, $2);
 604                 $path =~ s/$gCfg{vssprojmatch}//;
 605                 $path =~ s/\/$//; # remove trailing slash
 606                 $dst_target = "$path/$file";
 607                 $dst_target = "." . $dst_target if ($dst_target =~ m/^\//);
 608
 609                 # get the source URL
 610                 my $src_target = $gCfg{svnrepo};
 611                 $src_target =~ s/\/$//; # remove trailing slash
 612                 $src_target .= "$path/$file";
 613
 614                 my $url = URI::URL->new($src_target);
 615                 $src_target = $url->as_string;
 616
 617                 # get the revision number
 618                 my $retactsth = $gCfg{dbh}->prepare("SELECT b.revision FROM agenda AS a, commitpoint AS b WHERE a.global_count = ? AND a.number = b.number");
 619                 $retactsth->execute($gc);
 620                 while ($qrow = $retactsth->fetchrow_hashref()) {
 621                     $revision = $qrow->{revision};
 622                 }
 623                 $retactsth->finish();
 624
 625                 # stuff it into args
 626                 warn "src_target: " . $src_target if defined $src_target;
 627                 warn "revision: " . $revision;
 628                 warn "dst_target: " . $dst_target;
 629                 my $tmpAry;
 630                 my $encodedDstTarget = Encode::encode('utf8', $dst_target);
 631                 if ($fileInCurrentHistory) {
 632                     $tmpAry = [$encodedDstTarget, 'BASE', $encodedDstTarget, $revision, $encodedDstTarget, 0, 0, 1, 0];
 633                 } else {
 634                     $tmpAry = [$src_target, $revision, $encodedDstTarget];
 635                 }
 636                 my $args = Data::Dumper->Dump([$tmpAry], [qw(*myargs)]);
 637                 warn "args: " . $args;
 638                 $undelactionsth->execute($filepath, $args);
 639                 $undelactionsth->finish();
 640                 $checkpointsth->execute($filepath) if defined $checkpointsth;
 641                 $checkpointsth->finish() if defined $checkpointsth;
 642                 $scheduledCopy = 1;
 643             }
 644             # fix up the database
 645             if (defined $gc && $deletedInHistory) {
 646                 # mark the history as current, as long as we have a match
 647                 $fixsth->execute($gc);
 648             } elsif ($redoHistory && !$scheduledCopy) {
 649                 # invalidate history, since we didn't have a match
 650                 $fix2sth->execute($rev->{tstamp}, $filepath, $rev->{version}, $rev->{user}, $rev->{comment});
 651             }
 652
 653         }
 654         $qhiststh->finish();
 655         $fixsth->finish();
 656         $fix2sth->finish();
 657     }
 658
 659 REV:
 660     foreach my $rev (@$filehist) {
 661         next REV if (defined $revversion && $rev->{version} <= $revversion);
 662
 663         $rev->{comment} = "" unless defined $rev->{comment};
 664         $rev->{filepath} = $filepath;
 665         $rev->{retrieved} = 0;
 666         $rev->{deleted} = 0;
 667
 668         $inshiststh->execute($rev->{tstamp}, $rev->{filepath}, $rev->{version}, $rev->{user},
 669                              $rev->{comment}, ($rev->{globalCount} = ++$gCfg{globalCount}));
 670         warn $inshiststh->dump_results;
 671     }
 672
 673 } # End AddFileHistory
 674
 675 ###############################################################################
 676 #  GiveSchemaAuthMessage
 677 ###############################################################################
 678 sub GiveSchemaAuthMessage {
 679    my ($svnuser,$svnpw) = split(/:/, $gCfg{svnlogin}, -1);
 680    print THE_REAL_STDERR <<"EOTXT";
 681
 682
 683 ATTENTION REQUIRED:
 684
 685 EOTXT
 686
 687   if ($gCfg{svnrepo} =~ m/^http:/) {
 688       print THE_REAL_STDERR <<"EOTXT";
 689
 690   The user '$svnuser' must be able to authenticate to
 691   the repository '$gCfg{svnrepo}'.
 692
 693   Usually, this is done by adding the user '$svnuser' to the correct
 694   AuthUserFile (for Apache 2) for the Location of the subversion
 695   repository on the HTTP server.
 696
 697   This is a basic authentication file, where each username is followed
 698   by ':' then the hashed password for that user.  A blank password
 699   is permissible.
 700
 701   See <http://svnbook.red-bean.com/en/1.1/ch06s04.html#svn-ch-6-sect-4.3.1> for
 702   more information.
 703
 704 EOTXT
 705
 706   } elsif ($gCfg{svnrepo} =~ m/^https:/) {
 707       print THE_REAL_STDERR <<"EOTXT";
 708
 709   The user '$svnuser' must be able to authenticate to
 710   the repository '$gCfg{svnrepo}'.
 711
 712   Some configuration may be required to manage client certificate
 713   files for the user '$svnuser'. The client certificate file location may
 714   have to be added to %APPDATA%\\Subversion\\servers
 715
 716   See <http://svnbook.red-bean.com/en/1.1/ch06s04.html#svn-ch-6-sect-4.3.2> for
 717   more information.
 718
 719 EOTXT
 720
 721   } elsif ($gCfg{svnrepo} =~ m/^svn:/) {
 722    print THE_REAL_STDERR <<"EOTXT";
 723
 724   The user '$svnuser' must be able to authenticate to
 725   the repository '$gCfg{svnrepo}'.
 726
 727   This is done by adding the user '$svnuser' to the repository's conf/svnserve.conf
 728   file.  The user name is followed by '=', then the password.
 729
 730   See <http://svnbook.red-bean.com/en/1.1/ch06s03.html#svn-ch-6-sect-3.2> for
 731   more information.
 732
 733 EOTXT
 734   } elsif ($gCfg{svnrepo} =~ m/^svn\+(\w+):/) {
 735       print THE_REAL_STDERR <<"EOTXT";
 736
 737   The user '$svnuser' must be able to authenticate to
 738   the repository '$gCfg{svnrepo}'.
 739
 740   You are tunneling authentication over the '$1' protocol.
 741
 742   This is done by adding the user '$svnuser' to the repository's conf/svnserve.conf
 743   file.  The user name is followed by '=' then the password.
 744
 745   You may have to perform some other kind of authentication caching for
 746   the '$1' tunnel.
 747
 748   See <http://svnbook.red-bean.com/en/1.1/ch06s03.html#svn-ch-6-sect-3.4> for
 749   more information.
 750
 751 EOTXT
 752  } elsif ($gCfg{svnrepo} =~ m/^file:/) {
 753       print THE_REAL_STDERR <<"EOTXT";
 754
 755   For this repository no authentication is available.
 756   Do NOT pass the --svnlogin parameter to this script.
 757
 758   You will only need write permission for the repository's database files.
 759
 760 EOTXT
 761  } else {
 762       print THE_REAL_STDERR <<"EOTXT";
 763
 764   I have no idea on how to help you authenticate the user '$svnuser' over
 765   the schema for the repository '$gCfg{svnrepo}'.
 766
 767   Good luck, sport!
 768
 769 EOTXT
 770  }
 771
 772   if ($gCfg{setrevprop}) {
 773       print THE_REAL_STDERR <<"EOTXT";
 774   Since you are setting revision properties, now would be a good time
 775   to check and see that the user '$svnuser' can set the "svn:date" and
 776   "svn:author" properties for the repository '$gCfg{svnrepo}'.
 777
 778   This requires that the "pre-revprop-change" hook script be set.
 779   See <http://svnbook.red-bean.com/en/1.1/svn-book.html#svn-ch-5-sect-2.1> for
 780   more information.
 781
 782 EOTXT
 783   }
 784
 785   print THE_REAL_STDERR "\n\nPRESS ENTER TO CONTINUE (or enter [q] to quit and start over)...";
 786
 787     my $rep = <STDIN>;
 788
 789     if ($rep =~ /^q/i) {
 790        print THE_REAL_STDERR "\n\nQuitting...\n";
 791        exit(0);
 792     }
 793 }
 794
 795 ###############################################################################
 796 #  EnqueueSvnProjects
 797 ###############################################################################
 798 sub EnqueueSvnProjects {
 799     my $insactionsth = $gCfg{dbh}->prepare("INSERT INTO svnaction (type, action, global_count, file) VALUES ('project', 'add', 0, ?)");
 800
 801     my $pplsth = $gCfg{dbh}->prepare("SELECT file FROM treetable WHERE tag = 'current' AND type = 'project' ORDER BY file");
 802
 803     $pplsth->execute();
 804     while (my $row = $pplsth->fetchrow_hashref()) {
 805         PrintMsg "        " . $row->{file} . "...\n";
 806         $insactionsth->execute($row->{file});
 807     }
 808     $pplsth->finish();
 809     $insactionsth->finish();
 810 }
 811
 812 ###############################################################################
 813 #  CheckoutSvnWC
 814 ###############################################################################
 815 sub CheckoutSvnWC {
 816     PrintMsg "\n\n**** SETTING UP SUBVERSION DIRECTORIES ****\n\n";
 817
 818     PrintMsg "   Checking out working copy...\n";
 819     # pull down the working copy
 820     $SVNClient->checkout($gCfg{svnrepo}, Encode::encode('utf8', Cwd::getcwd()), 'HEAD', 1);
 821 }
 822
 823 ###############################################################################
 824 #  CreateAddedProjectsList
 825 ###############################################################################
 826 sub CreateAddedProjectsList {
 827     my $svnprojects = [];
 828
 829     # create the projects to be added
 830     my $pplsth = $gCfg{dbh}->prepare("SELECT file FROM svnaction WHERE type='project' AND action='add' AND global_count=0 ORDER BY file");
 831     $pplsth->execute();
 832     while (my $row = $pplsth->fetchrow_hashref()) {
 833         my $dosProject = $row->{file};
 834         $dosProject =~ s:^$gCfg{vssprojmatch}::;
 835         $dosProject =~ s:^/::;
 836         push @{$svnprojects}, Encode::encode('utf8', $dosProject);
 837     }
 838     $pplsth->finish();
 839     return $svnprojects;
 840 }
 841
 842 ###############################################################################
 843 #  CreateDeletedList
 844 ###############################################################################
 845 sub CreateDeletedList {
 846     my $projpathRoot = $gCfg{workdir};
 847     $projpathRoot =~ s/\\/\//g;
 848     my $svnprojects = [];
 849
 850     # delete the files/projects needing deleteion
 851     my $pplsth = $gCfg{dbh}->prepare("SELECT file FROM svnaction WHERE action='delete' AND global_count=0 ORDER BY file");
 852     $pplsth->execute();
 853     while (my $row = $pplsth->fetchrow_hashref()) {
 854         my $dosProject = $row->{file};
 855         $dosProject =~ s:^$gCfg{vssprojmatch}::;
 856         $dosProject = '/' . $dosProject unless $dosProject =~ m/^\//;
 857         push @{$svnprojects}, Encode::encode('utf8', $projpathRoot . $dosProject);
 858     }
 859     $pplsth->finish();
 860
 861     return $svnprojects;
 862 }
 863
 864 ###############################################################################
 865 #  CreateCopiedList
 866 ###############################################################################
 867 sub CreateCopiedList {
 868     my $projpathRoot = $gCfg{workdir};
 869     $projpathRoot =~ s/\\/\//g;
 870     my $svnprojects = [];
 871
 872     # copy the files from
 873     my $pplsth = $gCfg{dbh}->prepare("SELECT args FROM svnaction WHERE action='copy' AND global_count=0 ORDER BY file");
 874     $pplsth->execute();
 875     while (my $row = $pplsth->fetchrow_hashref()) {
 876         my $args = $row->{args};
 877         push @{$svnprojects}, $args;
 878     }
 879     $pplsth->finish();
 880
 881     return $svnprojects;
 882 }
 883
 884 ###############################################################################
 885 #  CreateMergedList
 886 ###############################################################################
 887 sub CreateMergedList {
 888     my $projpathRoot = $gCfg{workdir};
 889     $projpathRoot =~ s/\\/\//g;
 890     my $svnprojects = [];
 891
 892     # copy the files from
 893     my $pplsth = $gCfg{dbh}->prepare("SELECT args FROM svnaction WHERE action='merge' AND global_count=0 ORDER BY file");
 894     $pplsth->execute();
 895     while (my $row = $pplsth->fetchrow_hashref()) {
 896         my $args = $row->{args};
 897         push @{$svnprojects}, $args;
 898     }
 899     $pplsth->finish();
 900
 901     return $svnprojects;
 902 }
 903
 904 ###############################################################################
 905 #  ApplySvnActions
 906 ###############################################################################
 907 sub ApplySvnActions {
 908     PrintMsg "\n\n**** APPLYING SUBVERSION ACTIONS ****\n\n";
 909
 910     $STATE_CHANGED = 0;
 911     my $ac = $gCfg{dbh}->{AutoCommit};
 912     my $re = $gCfg{dbh}->{RaiseError};
 913
 914     $gCfg{dbh}->{AutoCommit} = 0;
 915     $gCfg{dbh}->{RaiseError} = 1;
 916
 917     eval {
 918         $SVNClient->notify(\&wc_changed);
 919         my $svnprojects = &CreateAddedProjectsList;
 920
 921         if (scalar @{$svnprojects} > 0) {
 922             PrintMsg "   Importing project directories into subversion working copy...\n";
 923             File::Path::mkpath($svnprojects, 1);
 924
 925             foreach my $proj (@{$svnprojects}) {
 926                 $SVNClient->add($proj, 0);
 927             }
 928         }
 929
 930         $svnprojects = &CreateDeletedList;
 931         if (scalar @{$svnprojects} > 0) {
 932             PrintMsg "   Deleting from subversion working copy...\n";
 933             $SVNClient->delete($svnprojects, 1);
 934         }
 935
 936         $svnprojects = &CreateCopiedList;
 937         my $copiedMsg = "";
 938         if (scalar @{$svnprojects} > 0) {
 939             PrintMsg "   Copying historical versions from repository...\n";
 940
 941             foreach my $proj (@{$svnprojects}) {
 942                 my @myargs;
 943                 eval($proj); # reads into "myargs"
 944                 $SVNClient->copy($myargs[0], $myargs[1], $myargs[2]);
 945                 $copiedMsg .= $myargs[0] . ", revision " . $myargs[1] . ", was recovered.\n";
 946             }
 947         }
 948
 949         $svnprojects = &CreateMergedList;
 950         if (scalar @{$svnprojects} > 0) {
 951             PrintMsg "   Merging historical versions from repository...\n";
 952
 953             foreach my $proj (@{$svnprojects}) {
 954                 my @myargs;
 955                 eval($proj); # reads into "myargs"
 956                 $SVNClient->merge($myargs[0], $myargs[1], $myargs[2], $myargs[3],
 957                                   $myargs[4], $myargs[5], $myargs[6], $myargs[7], $myargs[8]);
 958                 $copiedMsg .= $myargs[0] . ", revision " . $myargs[3] . ", was recovered.\n";
 959             }
 960         }
 961
 962         if ($STATE_CHANGED) {
 963             my $coderef;
 964             $SVNClient->notify($coderef);
 965
 966             # write this into the agenda, even though it's "unscheduled"
 967             my $tmpCommitNumber = &GetScheduleCount;
 968             my $iorder = &GetIorder;
 969
 970             $tmpCommitNumber = 0 unless (defined $tmpCommitNumber);
 971             $iorder = 0 unless (defined $iorder);
 972             ++$iorder;
 973
 974             my $asth = $gCfg{dbh}->prepare("INSERT INTO agenda ( number, global_count, iorder ) VALUES ( ?, 0, ? )");
 975             $asth->execute(++$tmpCommitNumber, $iorder++);
 976             $asth->finish;
 977
 978             # commit it
 979             PrintMsg "   Committing `" . $gCfg{workdir} . "'...\n";
 980
 981             my $msg = ($gCfg{globalCiCount} < 0) ? "Initial " : "";
 982             my $eventMsg = "";
 983             if (defined $SNAPTIME) {
 984                 $eventMsg .= " at ";
 985                 my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($SNAPTIME);
 986                 ++$mon;
 987                 $year += 1900;
 988                 $eventMsg .= sprintf("%4.4i-%2.2i-%2.2iT%2.2i:%2.2i:%2.2iZ", $year, $mon, $mday, $hour, $min, $sec);
 989             } elsif (defined $gCfg{snaplabel}) {
 990                 $eventMsg .= " at label `" . $gCfg{snaplabel} . "'";
 991             }
 992             my $finalMsg = $msg . "Import of " . $gCfg{vssproject} . $eventMsg . "\n";
 993             $finalMsg .= $copiedMsg;
 994             $COMMENT = Encode::encode('utf8', $finalMsg);
 995             $SVNClient->log_msg(\&log_comments);
 996             my ($commit_val) = $SVNClient->commit(Encode::encode('utf8', $gCfg{workdir}), 0);
 997
 998             my $ciRevision;
 999             if (!defined $commit_val || $commit_val->revision() == $SVN::Core::INVALID_REVNUM) {
1000                 $ciRevision = GetSvnInfo(Cwd::getcwd());
1001                 if (!defined $ciRevision) {
1002                     die "GetSvnInfo failed, bailing";
1003                 }
1004             } else {
1005                 $ciRevision = $commit_val->revision();
1006             }
1007
1008             # update the database now that we have commited
1009             my $updsth = $gCfg{dbh}->prepare("UPDATE ciCount SET number = ?");
1010             $updsth->execute(++$gCfg{globalCiCount});
1011             $updsth->finish;
1012         }
1013
1014         $gCfg{dbh}->do("DELETE FROM svnaction WHERE global_count=0");
1015         $gCfg{dbh}->commit;
1016     };
1017     if ($@) {
1018         PrintMsg "Transaction aborted because $@";
1019         eval { $gCfg{dbh}->rollback };
1020         die "Transaction failed!";
1021     }
1022
1023     $gCfg{dbh}->{AutoCommit} = $ac;
1024     $gCfg{dbh}->{RaiseError} = $re;
1025 }
1026
1027 ###############################################################################
1028 #  ScheduleCommits
1029 ###############################################################################
1030 sub ScheduleCommits {
1031     # this is the flag to tell us if scheduling has completed
1032     my $sth = $gCfg{dbh}->prepare("SELECT number FROM agenda WHERE iorder = 0")
1033         or die "Could not execute DBD::SQLite command";
1034     $sth->execute
1035         or die "Could not execute DBD::SQLite command";
1036
1037     my $tmp;
1038     my $beenScheduled = 0;
1039     $sth->bind_columns(\$tmp);
1040     while ($sth->fetch()) {
1041         $beenScheduled = 1;
1042     }
1043     $sth->finish();
1044
1045     if (!$beenScheduled) {
1046
1047         # schedule the rows
1048         PrintMsg "   Scheduling ...";
1049
1050         my ($row, $prevRow);
1051         my $tmpCommitNumber = &GetScheduleCount; # prevRow not set up, but we are are 1 based
1052         my $seenThisRev = {};
1053         my $iorder = &GetIorder;
1054
1055         $tmpCommitNumber = 0 unless (defined $tmpCommitNumber);
1056         $iorder = 0 unless (defined $iorder);
1057         ++$iorder;
1058
1059         my $asth = $gCfg{dbh}->prepare("INSERT INTO agenda ( number, global_count, iorder ) VALUES ( ?, ?, ? )")
1060             or die "Could not execute DBD::SQLite command";
1061
1062         # timestamp and file fields are formatted to enable sorting numerically
1063         # we check the old copy of the agenda first, to make sure we aren't in it
1064         $sth = $gCfg{dbh}->prepare("SELECT * FROM history WHERE deleted = 0 "
1065                                    . " AND global_count NOT IN (SELECT global_count FROM agenda)"
1066                                    . " ORDER BY tstamp, file, version")
1067             or die "Could not execute DBD::SQLite command";
1068
1069         $sth->execute
1070             or die "Could not execute DBD::SQLite command";
1071
1072         while ($row = $sth->fetchrow_hashref) {
1073             $row->{comment} = ''
1074                 if (!exists $row->{comment} || !defined $row->{comment});
1075
1076             if (defined $prevRow->{tstamp}
1077                 && ($row->{tstamp} < ($prevRow->{tstamp} + 43200)) # 12 hour window
1078                 && ($row->{user} eq $prevRow->{user})
1079                 && ($row->{comment} eq $prevRow->{comment})
1080                 && (!defined $seenThisRev->{$row->{file}})) {
1081                 # date, user and comment are same; this will be multi-item commit
1082             } else {
1083                 ++$tmpCommitNumber;
1084                 $seenThisRev = {};
1085             }
1086
1087             $seenThisRev->{$row->{file}} = 1;
1088             $asth->execute($tmpCommitNumber, $row->{global_count}, $iorder++)
1089                 or die "Could not execute DBD::SQLite command";
1090             $prevRow = $row;
1091         }
1092         # finished scheduling
1093         $asth->execute(0, 0, 0) or die "Could not execute DBD::SQLite command";
1094         $asth->finish;
1095         $sth->finish;
1096         PrintMsg "done -- $tmpCommitNumber revisions to commit\n";
1097     }
1098 }
1099
1100 ###############################################################################
1101 #  GetScheduleCount
1102 ###############################################################################
1103 sub GetScheduleCount {
1104     my $sth = $gCfg{dbh}->prepare("SELECT MAX(number) FROM agenda")
1105         or die "Could not execute DBD::SQLite command";
1106
1107     $sth->execute
1108         or die "Could not execute DBD::SQLite command";
1109
1110     my ($tmpCount, $count);
1111     $sth->bind_columns(\$tmpCount);
1112     while ($sth->fetch()) {
1113         $count = $tmpCount;
1114     }
1115     $sth->finish();
1116     return $count;
1117 }
1118
1119 ###############################################################################
1120 #  GetIorder
1121 ###############################################################################
1122 sub GetIorder {
1123     my $sth = $gCfg{dbh}->prepare("SELECT MAX(iorder) FROM agenda")
1124         or die "Could not execute DBD::SQLite command";
1125
1126     $sth->execute
1127         or die "Could not execute DBD::SQLite command";
1128
1129     my ($tmpCount, $count);
1130     $sth->bind_columns(\$tmpCount);
1131     while ($sth->fetch()) {
1132         $count = $tmpCount;
1133     }
1134     $sth->finish();
1135     return $count;
1136 }
1137
1138 ###############################################################################
1139 #  ImportSvnHistory
1140 ###############################################################################
1141 sub ImportSvnHistory {
1142     # we will walk the history table in date/time order, GETting from VSS
1143     # as we go. VSS doesn't allow atomic multi-item commits, so we'll detect
1144     # these assuming if the user and comment are the same from one item to the
1145     # next, they were part of the "same" action.
1146
1147     my($row, $upd, $commitinfo);
1148
1149     PrintMsg "\n\n**** MIGRATING VSS HISTORY TO SUBVERSION ****\n\n";
1150
1151     # a unique record
1152     my $xsth = $gCfg{dbh}->prepare("SELECT * FROM history WHERE global_count = ?")
1153         or die "Could not execute DBD::SQLite command";
1154
1155     # use checkpoint as next stage of when to add/update files for subversion
1156     my $qckpsth = $gCfg{dbh}->prepare("SELECT checked FROM checkpoint WHERE file = ?")
1157         or die "Could not execute DBD::SQLite command";
1158
1159     # use to set added/add commited states
1160     my $donesth = $gCfg{dbh}->prepare("UPDATE checkpoint SET checked = ? WHERE file = ?")
1161         or die "Could not execute DBD::SQLite command";
1162
1163     # add a commitpoint for a number
1164     my $acpsth = $gCfg{dbh}->prepare("INSERT INTO commitpoint (number, revision, stage) VALUES (?, -1, 0)")
1165         or die "Could not execute DBD::SQLite command";
1166
1167     # query for commitpoint
1168     my $qcpsth = $gCfg{dbh}->prepare("SELECT stage, revision FROM commitpoint WHERE number = ?")
1169         or die "Could not execute DBD::SQLite command";
1170
1171     # set the commitpoint to stage 1 for a number
1172     my $s1cpsth = $gCfg{dbh}->prepare("UPDATE commitpoint SET stage = 1, revision = ? WHERE number = ?")
1173         or die "Could not execute DBD::SQLite command";
1174
1175     # set the commitpoint to stage 2 for a number
1176     my $s2cpsth = $gCfg{dbh}->prepare("UPDATE commitpoint SET stage = 2 WHERE number = ?")
1177         or die "Could not execute DBD::SQLite command";
1178
1179     # set the commitpoint to stage 3 for a number
1180     my $s3cpsth = $gCfg{dbh}->prepare("UPDATE commitpoint SET stage = 3 WHERE number = ?")
1181         or die "Could not execute DBD::SQLite command";
1182
1183     # set file retrieval state
1184     my $fretsth = $gCfg{dbh}->prepare("UPDATE history SET retrieved = 1 WHERE global_count = ?")
1185         or die "Could not execute DBD::SQLite command";
1186
1187     &ScheduleCommits;
1188     my $tmpCommitNumber = &GetScheduleCount;
1189
1190     my $agendasth = $gCfg{dbh}->prepare("SELECT global_count FROM agenda WHERE number = ? ORDER BY iorder DESC")
1191         or die "Could not execute DBD::SQLite command";
1192
1193     my $gCiCountsth = $gCfg{dbh}->prepare("UPDATE ciCount SET number = ?")
1194         or die "Could not execute DBD::SQLite command";
1195
1196     # walk down the agenda, getting from VSS and commiting
1197     for (my $rev = $gCfg{globalCiCount}+1; $rev <= $tmpCommitNumber; $rev++, $gCfg{globalCiCount}++) {
1198         warn "Revision $rev now being committed";
1199
1200         # checkout all the files at this point in the agenda from VSS
1201         my $agendaitem;
1202         my $agendarow;
1203         my $agendalist = [];
1204         my $committedFiles = {};
1205         my $addedSvnFiles = [];
1206         my $committedDosFiles = [];
1207         my $comment = "";
1208         my $tstamp = 0;
1209         my $vssname = "";
1210         my $fileCount = 0;
1211
1212         # build the list of file snapshots for this revision
1213         $agendasth->execute($rev)
1214             or die "Could not execute DBD::SQLite command";
1215         while ($agendarow = $agendasth->fetchrow_hashref) {
1216             push @{$agendalist}, $agendarow->{global_count};
1217         }
1218
1219       AGENDAITEM:
1220         while (defined ($agendaitem = pop @{$agendalist})) {
1221             my $tmpNum = $agendaitem + 0;
1222             warn "global_count item $tmpNum being fetched";
1223
1224             $xsth->execute($tmpNum)
1225                 or die "Could not execute DBD::SQLite command";
1226
1227             my $tmpRow = {};
1228             while ($row = $xsth->fetchrow_hashref) {
1229                 # make a copy
1230                 while ( my ($key, $value) = each(%{$row})) {
1231                     $tmpRow->{$key} = $value . '';
1232                 }
1233
1234                 # print a localtime formatted version, so at least the user can check
1235                 # versus the VSS entries
1236                 my ($min,$hour,$mday,$mon,$year);
1237                 (undef,$min,$hour,$mday,$mon,$year) = localtime($tmpRow->{tstamp});
1238                 ++$mon;
1239                 $year += 1900;
1240                 $tmpRow->{localdatetime} = sprintf("%4.4i-%2.2i-%2.2i %2.2i:%2.2i", $year, $mon, $mday, $hour, $min);
1241                 $tmpRow->{comment} = ''
1242                     if (!exists $row->{comment} || !defined $row->{comment});
1243             }
1244             $row = $tmpRow;
1245
1246             # we could be here because there were no directories to add or something
1247             next AGENDAITEM unless (defined $row->{file});
1248
1249             # see if we have been added to wc or repository
1250             $qckpsth->execute($row->{file}) or die "Could not execute DBD::SQLite command";
1251
1252             $upd = 0;
1253             while (my $rowx = $qckpsth->fetchrow_hashref()) {
1254                 $upd = $rowx->{checked} - 1; # added history to db, but not to wc or repo
1255             }
1256
1257             $commitinfo = &GetVssRevision($row, $upd, $rev, $qcpsth, $fretsth, $committedDosFiles, $addedSvnFiles);
1258             $committedFiles->{$row->{file}} = 1;
1259             my $shouldskip = (defined $commitinfo && defined $commitinfo->{skipped});
1260             my $skipMsg = $shouldskip ? "skipped" : "";
1261             PrintMsg "   ($rev)File $row->{file}, $row->{localdatetime}..." . $skipMsg . "\n";
1262             $comment = $row->{comment};
1263             $comment .= "\n\n$gCfg{comment}" if defined $gCfg{comment};
1264             $tstamp = $row->{tstamp};
1265             $vssname = lc($row->{user});
1266             ++$fileCount;
1267
1268             # roll these skipped files back
1269             if ($shouldskip) {
1270                 --$fileCount;
1271                 delete $committedFiles->{$row->{file}};
1272                 undef $commitinfo;
1273             }
1274         }
1275
1276         # commit the files
1277         if (scalar @{$committedDosFiles} > 0) {
1278             &AddSvnFiles($addedSvnFiles, $donesth);
1279             &CommitSvn($committedDosFiles, $comment, $rev, $qcpsth, $acpsth, $s1cpsth);
1280         }
1281
1282         # now we are really at "revision $rev"
1283         # adjust the date/time, author
1284         if ($fileCount > 0) {
1285             foreach my $k (keys %{$committedFiles}) {
1286                 $donesth->execute(3, $k) or die "Could not execute DBD::SQLite command";
1287             }
1288
1289             if ($gCfg{setrevprop}) {
1290                 &SetSvnDates($tstamp, $rev, $qcpsth, $s2cpsth);
1291                 &SetSvnAuthor($vssname, $rev, $qcpsth, $s3cpsth);
1292             }
1293         }
1294
1295         # we are finished with this revision
1296         $gCiCountsth->execute($rev) or die "Could not execute DBD::SQLite command";
1297
1298         # clear the pool
1299         my $pool = $SVNClient->pool();
1300         $pool->clear();
1301     }
1302     $xsth->finish;
1303     $acpsth->finish;
1304     $qcpsth->finish;
1305     $s1cpsth->finish;
1306     $s2cpsth->finish;
1307     $s3cpsth->finish;
1308     $qckpsth->finish;
1309     $donesth->finish;
1310     $fretsth->finish;
1311     $agendasth->finish;
1312     $gCiCountsth->finish;
1313 }
1314
1315 ###############################################################################
1316 #  GetVssRevision
1317 ###############################################################################
1318 sub GetVssRevision {
1319     my($row, $upd, $commitNum, $qcpsth, $fretsth, $committedDosFiles, $addedSvnFiles) = @_;
1320
1321     $qcpsth->execute($commitNum) or die "Could not execute DBD::SQLite command";
1322
1323     my $rc = 0;
1324     my $stage = 0;
1325     while (my $row = $qcpsth->fetchrow_hashref()) {
1326         $rc++;
1327         $stage = $row->{stage};
1328     }
1329
1330     # we have definitely checked this in, skip it
1331     if ($rc == 1 && $stage >= 1) {
1332         warn "GetVssRevision:  $row->{file} checked in\n";
1333         return undef;
1334     }
1335
1336     # Gets a version of a file from VSS and adds it to SVN
1337     # $row is the row hash ref from the history SQLite table
1338     # $upd is true if this is an update rather than add
1339
1340     my $vsspath = $row->{file};
1341     my $realpath = $vsspath;
1342
1343     if (defined $SUBSTMAP->{$vsspath}) {
1344         $vsspath = $SUBSTMAP->{$vsspath};
1345     }
1346
1347     $realpath =~ m/^(.*\/)(.*)/
1348         or die "Mangled VSS file path information", join("\n", %$row);
1349     my($path, $file) = ($1, $2);
1350
1351     $path =~ s/$gCfg{vssprojmatch}//
1352         or die "Mangled VSS file path information", join("\n", %$row);
1353     $path =~ s/\/$//; # remove trailing slash
1354
1355     (my $dospath = "$gCfg{workdir}/$path") =~ s/\//\\/g; # use backslashes
1356     $dospath =~ s/\\$//; # remove trailing backslash if $path was empty
1357     $dospath =~ s/\\\\/\\/g; # replace double backslashes with single
1358
1359     my $cmd = "GET -GTM -W -GL\"$dospath\" -V$row->{version} \"$vsspath\"";
1360
1361     # get it if we haven't already gotten it yet or it's not there
1362     my $cofile = $dospath . "\\" . $file;
1363     if (!(-e $cofile) || $row->{retrieved} == 0) {
1364         if (-e $cofile) {
1365             unlink $cofile; # delete it
1366         }
1367         $VSS->ss($cmd)
1368             or die "Could not issue ss.exe command";
1369         if (-e $cofile) {
1370             $fretsth->execute($row->{global_count}) or die "Could not execute DBD::SQLite command";
1371         } else {
1372             if ($VSS->{ss_output} =~ m/^(File|Project) \S+.* does not retain old versions of itself/) {
1373                 # only the latest version of this file is being stored, just skip it
1374                 warn "GetVssRevision:  $row->{file}, version $row->{version} is only stored in latest version\n";
1375                 return { skipped => 1 };
1376             } else {
1377                 die "ss.exe failed to retrieve $cofile";
1378             }
1379         }
1380     }
1381
1382     if (!$upd) {
1383         my $tmpfile = "$path/$file";
1384         $tmpfile =~ s/^\///; # remove leading slash
1385         unshift @{$addedSvnFiles}, {file => $tmpfile, path => $realpath};
1386     }
1387
1388     my $commitinfo =
1389     { file => $file,
1390       user => $row->{user},
1391       dospath => $dospath,};
1392
1393     unshift @{$committedDosFiles}, Encode::encode('utf8', $commitinfo->{dospath} . "\\" . $commitinfo->{file});
1394
1395     return $commitinfo;
1396 }
1397
1398 ###############################################################################
1399 #  AddSvnFiles
1400 ###############################################################################
1401 sub AddSvnFiles {
1402     my($addedSvnFiles, $donesth) = @_;
1403
1404     foreach my $file (@{$addedSvnFiles}) {
1405         $SVNClient->add(Encode::encode('utf8', $file->{file}), 0);
1406         $donesth->execute(2, $file->{path}) or die "Could not execute DBD::SQLite command";
1407     }
1408 }
1409
1410 ###############################################################################
1411 #  CommitSvn
1412 ###############################################################################
1413 sub CommitSvn {
1414     my($committedDosFiles, $comment, $commitNum, $qcpsth, $acpsth, $s1cpsth) = @_;
1415
1416     $qcpsth->execute($commitNum) or die "Could not execute DBD::SQLite command";
1417
1418     my $rc = 0;
1419     my $stage = 0;
1420     my $revpoint = -1;
1421     while (my $row = $qcpsth->fetchrow_hashref()) {
1422         $rc++;
1423         $stage = $row->{stage};
1424         $revpoint = $row->{revision};
1425     }
1426
1427     if ($rc == 1 && $stage >= 1) {
1428         # history completed without a hitch
1429         # skip it
1430         PrintMsg "   (ALREADY COMMITTED)\n";
1431     } elsif (($rc == 0 || $rc == 1) && $stage < 1) {
1432         $COMMENT = Encode::encode('utf8', $comment);
1433
1434         PrintMsg $rc ? "   (RESTARTING COMMIT)\n" : "   (COMMITTING SVN...)\n";
1435
1436         # add the commitpoint
1437         if ($rc == 0) {
1438             $acpsth->execute($commitNum)
1439                 or die "Could not execute DBD::SQLite command";
1440             warn $acpsth->dump_results;
1441         }
1442
1443         $SVNClient->log_msg(\&log_comments);
1444         my ($commit_val) = $SVNClient->commit($committedDosFiles, 1);
1445
1446         my $ciRevision;
1447         if (!defined $commit_val || $commit_val->revision() == $SVN::Core::INVALID_REVNUM) {
1448             $ciRevision = GetSvnInfo(@{$committedDosFiles}[0]);
1449             if (!defined $ciRevision) {
1450                 die "GetSvnInfo failed, bailing";
1451             }
1452         } else {
1453             $ciRevision = $commit_val->revision();
1454         }
1455
1456         # set the commitpoint to stage 1
1457         $s1cpsth->execute($ciRevision, $commitNum)
1458             or die "Could not execute DBD::SQLite command";
1459         warn $s1cpsth->dump_results;
1460     } else {
1461         # error
1462         die "Illegal commitpoint value $rc:$stage";
1463     }
1464
1465 }  #End CommitSvn
1466
1467 ###############################################################################
1468 #  GetSvnInfo
1469 #    return the revision number for a file in the working copy
1470 ###############################################################################
1471 sub GetSvnInfo {
1472     my($target) = @_;
1473     my $ret;
1474     warn "GetSvnInfo called";
1475     # this code only needs to exist until SVN::Client->info gets implemented
1476     undef $REVISION;
1477     undef $ret;
1478     $target =~ s/\\\\/\\/g; # replace double backslashes with single
1479     $target =~ s/\\/\//g; # replace singles with forward slash
1480     $SVNClient->log(Encode::encode('utf8', $target), 'BASE', 'BASE', 0, 0, \&get_version);
1481     if (defined $REVISION) {
1482         $ret = $REVISION;
1483     }
1484     return $ret;
1485 }
1486
1487 # callback for GetSvnInfo
1488 sub get_version {
1489     my ($changed_paths,$revision,$author,$date,$message,$pool) = @_;
1490     if (!defined $REVISION) {
1491         $REVISION = $revision;
1492     }
1493 }
1494
1495 ###############################################################################
1496 #  SetSvnDates
1497 ###############################################################################
1498 sub SetSvnDates {
1499     my($tstamp, $commitNum, $qcpsth, $s2cpsth) = @_;
1500
1501     my $propRev = -1;
1502
1503     # see if we have checkpointed this date
1504     $qcpsth->execute($commitNum) or die "Could not execute DBD::SQLite command";
1505
1506     my $rc = 0;
1507     my $stage = 0;
1508     while (my $row = $qcpsth->fetchrow_hashref()) {
1509         $rc++;
1510         $stage = $row->{stage};
1511         $propRev = $row->{revision};
1512     }
1513
1514     if ($rc == 1 && $stage >= 2) {
1515         warn "Date already set for revision $propRev, skipping";
1516     } elsif ($rc == 1 && $stage == 1) {
1517         my ($min,$hour,$mday,$mon,$year);
1518         (undef,$min,$hour,$mday,$mon,$year) = gmtime($tstamp);
1519         ++$mon;
1520         $year += 1900;
1521         my $svn_date = sprintf("%4.4i-%2.2i-%2.2iT%2.2i:%2.2i:00.000000Z", $year, $mon, $mday, $hour, $min);
1522         my $encDate =  Encode::encode('utf8', $svn_date); # probably unnecessary
1523
1524         $SVNClient->revprop_set('svn:date', $encDate, $gCfg{svnrepo}, $propRev, 0);
1525
1526         # set the commitpoint to stage 2
1527         $s2cpsth->execute($commitNum)
1528             or die "Could not execute DBD::SQLite command";
1529         warn $s2cpsth->dump_results;
1530
1531     } else {
1532         die "Wrong state $rc:$stage in SetSvnDates";
1533     }
1534
1535 }  #End SetSvnDates
1536
1537 ###############################################################################
1538 #  SetSvnAuthor
1539 ###############################################################################
1540 sub SetSvnAuthor {
1541     my($author, $commitNum, $qcpsth, $s3cpsth) = @_;
1542
1543     my $propRev = -1;
1544
1545     # see if we have checkpointed this author
1546     $qcpsth->execute($commitNum) or die "Could not execute DBD::SQLite command";
1547
1548     my $rc = 0;
1549     my $stage = 0;
1550     while (my $row = $qcpsth->fetchrow_hashref()) {
1551         $rc++;
1552         $stage = $row->{stage};
1553         $propRev = $row->{revision};
1554     }
1555
1556     if ($rc == 1 && $stage == 3) {
1557         warn "Author already set for revision $propRev, skipping";
1558     } elsif ($rc == 1 && ($stage == 1 || $stage == 2)) {
1559         my $encAuthor =  Encode::encode('utf8', $author);
1560
1561         $SVNClient->revprop_set('svn:author', $encAuthor, $gCfg{svnrepo}, $propRev, 0);
1562
1563         # set the commitpoint to stage 3
1564         $s3cpsth->execute($commitNum)
1565             or die "Could not execute DBD::SQLite command";
1566         warn $s3cpsth->dump_results;
1567
1568     } else {
1569         die "Wrong state $rc:$stage in SetSvnAuthor";
1570     }
1571
1572 }  #End SetSvnAuthor
1573
1574 ###############################################################################
1575 #  PrintMsg
1576 ###############################################################################
1577 sub PrintMsg {
1578     # print to logfile (redirected STDERR) and screen (STDOUT)
1579     print STDERR @_;
1580     print THE_REAL_STDERR @_;
1581 }  #End PrintMsg
1582
1583 ###############################################################################
1584 #  MyDie
1585 ###############################################################################
1586 sub MyDie {
1587     # any die() is trapped by $SIG{__DIE__} to ensure user sees fatal errors
1588     exit(255) if $gCfg{died}; # don't die 2x if fatal error in global cleanup
1589     exit(0) if $gCfg{hooray};
1590
1591     warn @_;
1592     print THE_REAL_STDERR "\n", @_;
1593
1594     (my $logfile = $gCfg{logfile}) =~ s:/:\\:g;
1595
1596     my ($vsserr, $svnerr) = ('') x 2;
1597
1598     if ((defined $VSS) && (defined $VSS->{ss_error})) {
1599         $vsserr = "\nLAST VSS COMMAND:\n$VSS->{ss_error}\n\n(You may find "
1600             . "more info on this error at the following website:\n"
1601             . "http://msdn.microsoft.com/library/default.asp?url=/library/"
1602             . "en-us/guides/html/vsorierrormessages.asp )";
1603     }
1604
1605     print THE_REAL_STDERR <<"EOERR";
1606
1607 ******************************FATAL ERROR********************************
1608 *************************************************************************
1609
1610 A fatal error has occured. The output from the last VSS or SVN command is
1611 below, if available.
1612
1613 See $logfile for more information.
1614 $vsserr$svnerr
1615 EOERR
1616     $gCfg{died} = 1;
1617     exit(255);
1618 }  #End MyDie
1619
1620 ###############################################################################
1621 #  Initialize
1622 ###############################################################################
1623 sub Initialize {
1624     GetOptions(\%gCfg,'vssproject=s','vssexclude=s@','svnrepo=s','comment=s',
1625                'vsslogin=s','norevprop','noprompt','nolabel','timebias=i','dstbias=i',
1626                'iconv=s','restart','svnlogin=s','snaptime=s','snaplabel=s','substfile=s',
1627                'update:s','debug','help',);
1628
1629     &GiveHelp(undef, 1) if defined $gCfg{help};
1630
1631     defined $gCfg{vssproject} or GiveHelp("must specify --vssproject\n");
1632     defined $gCfg{svnrepo} or GiveHelp("must specify --svnrepo\n");
1633     defined $ENV{SSDIR} or GiveHelp("\$SSDIR not defined\n");
1634
1635     my $url = URI::URL->new($gCfg{svnrepo});
1636     $gCfg{svnrepo} = $url->as_string;
1637
1638     GiveHelp("VSS project must start with '\$/'") unless $gCfg{vssproject} =~ m:^\$\/:;
1639     $gCfg{vssproject} =~ s:\\:/:g; # flip all '\\' to '/'
1640     $gCfg{vssproject} =~ s:/+:/:g; # replace all '//' with '/'
1641
1642     $gCfg{vssproject} =~ s:(\$/.*)/$:$1:;
1643     $gCfg{vssprojmatch} = quotemeta( $gCfg{vssproject} );
1644
1645     @{ $gCfg{vssexclude} } = split(',', join(',' ,@{ $gCfg{vssexclude} } ))
1646         if defined $gCfg{vssexclude};
1647
1648     my $vss_args = {
1649         interactive => 'Y',
1650         timebias    => $gCfg{timebias},
1651         dstbias     => $gCfg{dstbias},
1652     };
1653
1654     # seting dates/authors is the default, unless --norevprop is entered
1655     $gCfg{setrevprop} = !defined $gCfg{norevprop};
1656
1657     if (defined $gCfg{vsslogin}) {
1658         @{ $vss_args }{'user', 'passwd'} = split(':', $gCfg{vsslogin});
1659         warn "\nATTENTION: about to issue VSS login command; if program\n"
1660             . "hangs here, you have specified an invalid VSS username\n"
1661             . "or password. (Press CTRL+Break to kill hung script)\n\n";
1662     }
1663
1664     $VSS = Vss2Svn::VSS->new($ENV{SSDIR}, $gCfg{vssproject}, $vss_args);
1665     $VSS->{_debug} = 1;
1666
1667     my %svnClientOpts = ();
1668     if (defined $gCfg{svnlogin}) {
1669         $svnClientOpts{auth} = [SVN::Client::get_simple_prompt_provider(\&simple_prompt, 0)];
1670     }
1671
1672     $SVNClient = new SVN::Client(%svnClientOpts);
1673
1674     $gCfg{globalCiCount} = -1;
1675     $gCfg{globalCount} = 1;
1676
1677     $SUBSTMAP = {};
1678     if (defined $gCfg{substfile}) {
1679         open(SUBSTFILE, $gCfg{substfile})
1680             or die "Could not open substitution file: $gCfg{substfile}";
1681         my @subst_data=<SUBSTFILE>;
1682         close SUBSTFILE;
1683
1684         foreach my $substline (@subst_data) {
1685             chop($substline);
1686             my ($fname, $subst) = split(/:/, $substline);
1687             $SUBSTMAP->{$fname} = $subst;
1688         }
1689     }
1690
1691     # users should define when they want to update so it can be restarted if necessary
1692     if (defined $gCfg{update} && (!defined $gCfg{snaptime} && !defined $gCfg{snaplabel})) {
1693         die "--update must be used with either --snaptime or --snaplabel";
1694     } elsif (defined $gCfg{update}) {
1695         if ($gCfg{update} eq "") {
1696             $gCfg{update} = "fast";
1697         }
1698         if (!($gCfg{update} eq "fast" || $gCfg{update} eq "complete")) {
1699             die "--update must be one of [fast|complete]";
1700         }
1701         $gCfg{restart} = 1;
1702     }
1703
1704     # check --snaptime and --snaplabel
1705     if (defined $gCfg{snaptime} && defined $gCfg{snaplabel}) {
1706         die "--snaptime and --snaplabel are mutually exclusive";
1707     } elsif (defined $gCfg{snaplabel}) {
1708         # nothing special to do here
1709     } elsif (defined $gCfg{snaptime}) {
1710         # get the time
1711         my $tmpMatch = $gCfg{snaptime};
1712         $tmpMatch =~ m/(\d\d\d\d)-(\d\d)-(\d\d)T(\d\d):(\d\d)(Z?)/
1713             or die "Mangled date/time: '" . $gCfg{snaptime} . "'";
1714         my ($year, $month, $date, $hour, $minute, $zulu) = ($1, $2, $3, $4, $5, $6);
1715         my $datestring = sprintf("%04d/%02d/%02d %02d:%02d",
1716                                  $year, $month, $date, $hour, $minute);
1717         my %options = (NO_RELATIVE => 1);
1718         $options{GMT} = 1 if (defined $zulu && $zulu eq "Z");
1719
1720         $SNAPTIME = parsedate($datestring, %options);
1721         if (!defined $SNAPTIME) {
1722             die "Mangled date/time: '" . $gCfg{snaptime} . "'";
1723         }
1724     } else {
1725         # --snaptime defaults to now
1726         $SNAPTIME = time();
1727     }
1728
1729     $gCfg{workbase} = cwd() . "/_vss2svn";
1730
1731     if (!defined $gCfg{restart}) {
1732         print "\nCleaning up any previous vss2svn runs...\n\n";
1733         File::Path::rmtree($gCfg{workbase}, 0, 0);
1734         mkdir $gCfg{workbase} or die "Couldn't create $gCfg{workbase} (does "
1735             . "another program have a lock on this directory or its files?)";
1736
1737         $gCfg{workdir} = "$gCfg{workbase}/work";
1738         mkdir $gCfg{workdir} or die "Couldn't create $gCfg{workdir}";
1739
1740         $gCfg{tmpfiledir} = "$gCfg{workbase}/tmpfile";
1741         mkdir $gCfg{tmpfiledir} or die "Couldn't create $gCfg{tmpfiledir}";
1742
1743         $gCfg{dbdir} = "$gCfg{workbase}/db";
1744         mkdir $gCfg{dbdir} or die "Couldn't create $gCfg{dbdir}";
1745     } else {
1746         $gCfg{workdir} = "$gCfg{workbase}/work";
1747         $gCfg{tmpfiledir} = "$gCfg{workbase}/tmpfile";
1748         $gCfg{dbdir} = "$gCfg{workbase}/db";
1749     }
1750     $VSS->{use_tempfiles} = "$gCfg{tmpfiledir}";
1751 }
1752
1753 # callback for authentication
1754 sub simple_prompt {
1755     my ($cred,$realm,$default_username,$may_save,$pool) = @_;
1756
1757     my ($svnuser,$svnpw) = split(/:/, $gCfg{svnlogin}, -1);
1758     $cred->username($svnuser);
1759     $cred->password($svnpw);
1760 }
1761
1762 # callback for comments
1763 sub log_comments {
1764     my ($msg,$tmpFile,$commit_ary,$pool) = @_;
1765     $$msg = $COMMENT;
1766 }
1767
1768 # callback for notifications
1769 sub wc_changed {
1770     my ($path,$type,$node,$mimeType,$state,$revision) = @_;
1771 #   warn "wc_changed: " . $path . " " . $type . " " . $node . " " . $mimeType . " " . $state . " " . $revision;
1772     if ($type == $SVN::Wc::Notify::Action::add
1773         || $type == $SVN::Wc::Notify::Action::copy
1774         || $type == $SVN::Wc::Notify::Action::delete
1775         || $state == $SVN::Wc::Notify::State::changed) {
1776         $STATE_CHANGED = 1;
1777     }
1778 }
1779
1780 ###############################################################################
1781 #  Regionalize
1782 ###############################################################################
1783 sub Regionalize {
1784     my $bias = $Registry->{'HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/'
1785                                .'Control/TimeZoneInformation/ActiveTimeBias'} || 0;
1786
1787     my $dstbias = $Registry->{'HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/'
1788                                   . 'Control/TimeZoneInformation/DaylightBias'} || 0;
1789
1790     {
1791         use integer; # forces Perl to interpret two's-complement correctly
1792         $gCfg{timebias} = hex($bias) + 0;
1793         $gCfg{dstbias} = hex($dstbias) + 0;
1794     }
1795
1796     # close the keys
1797     undef $bias;
1798     undef $dstbias;
1799 }
1800
1801 ###############################################################################
1802 #  CreateDatabase
1803 ###############################################################################
1804 sub CreateDatabase {
1805     $gCfg{dbh} = DBI->connect("dbi:SQLite(RaiseError=>1,AutoCommit=>1)"
1806                               . ":dbname=$gCfg{dbdir}/vss2svn.db","","");
1807
1808     if (!defined $gCfg{restart}) {
1809         PrintMsg "\n\n**** Creating database... ****\n\n";
1810
1811         my $hist =  "CREATE TABLE history("
1812             . "tstamp    long NOT NULL,"
1813             . "file    varchar(1024)  NOT NULL,"
1814             . "version long           NOT NULL,"
1815             . "user    varchar(256)   NOT NULL,"
1816             . "comment blob           NOT NULL,"
1817             . "global_count    long   NOT NULL,"
1818             . "retrieved integer      NOT NULL,"
1819             . "deleted integer      NOT NULL)";
1820                 my $tree = "CREATE TABLE treetable("
1821                         . "tag VARCHAR(8) NOT NULL,"
1822                         . "type VARCHAR(8) NOT NULL,"
1823                         . "file    varchar(1024)  NOT NULL,"
1824                         . "version long           NOT NULL)";
1825                 my $agenda = "CREATE TABLE agenda("
1826                         . "number long NOT NULL,"
1827                         . "global_count long NOT NULL,"
1828                         . "iorder integer NOT NULL)";
1829                 my $checkpt = "CREATE TABLE checkpoint("
1830                         . "file varchar(1024) NOT NULL PRIMARY KEY,"
1831                         . "checked integer NOT NULL)";
1832                 my $commitpt = "CREATE TABLE commitpoint("
1833                         . "number integer NOT NULL PRIMARY KEY,"
1834                         . "revision integer NOT NULL,"
1835                         . "stage integer NOT NULL)";
1836                 my $svnaction = "CREATE TABLE svnaction("
1837                         . "type VARCHAR(8) NOT NULL,"
1838                         . "file varchar(1024) NOT NULL,"
1839                         . "action VARCHAR(8) NOT NULL,"
1840                         . "global_count long NOT NULL,"
1841                         . "args blob)";
1842
1843                 # fire up a transaction to make all the database tables
1844                 # and to set the persistent checkin count
1845
1846         my $ac = $gCfg{dbh}->{AutoCommit};
1847         my $re = $gCfg{dbh}->{RaiseError};
1848
1849         $gCfg{dbh}->{AutoCommit} = 0;
1850         $gCfg{dbh}->{RaiseError} = 1;
1851
1852         eval {
1853                         $gCfg{dbh}->do($hist);
1854                         $gCfg{dbh}->do($tree);
1855
1856                         $gCfg{dbh}->do($agenda);
1857                         $gCfg{dbh}->do($checkpt);
1858
1859                         $gCfg{dbh}->do($commitpt);
1860                         $gCfg{dbh}->do($svnaction);
1861
1862                         $gCfg{dbh}->do("CREATE TABLE ciCount(number integer NOT NULL)");
1863                         $gCfg{dbh}->do("INSERT INTO ciCount (number) VALUES (-1)");
1864
1865             $gCfg{dbh}->commit;
1866                 };
1867         if ($@) {
1868             PrintMsg "Transaction aborted because $@";
1869             eval { $gCfg{dbh}->rollback };
1870             die "Transaction failed!";
1871         }
1872         $gCfg{dbh}->{AutoCommit} = $ac;
1873         $gCfg{dbh}->{RaiseError} = $re;
1874     } else {
1875                 # read the persistent values from the database
1876         &ResetGlobalCiCountFromDatabase;
1877         &ResetGlobalCountFromDatabase;
1878     }
1879 }  #End CreateDatabase
1880
1881 ###############################################################################
1882 #  DumpDatabase
1883 ###############################################################################
1884 sub DumpDatabase {
1885
1886     my $sth = $gCfg{dbh}->prepare("SELECT * FROM history")
1887         or die "Could not execute DBD::SQLite command";
1888     $sth->execute
1889         or die "Could not execute DBD::SQLite command";
1890
1891     PrintMsg "HISTORY:\n";
1892     while (my $row = $sth->fetchrow_hashref) {
1893         PrintMsg "tstamp: " . $row->{tstamp}
1894         . " file: " . $row->{file} . " version: " . $row->{version}
1895         . " user: " . $row->{user} . " comment: " . $row->{comment}
1896         . " global_count: " . $row->{global_count} . " retrieved: " . $row->{retrieved}
1897         . " deleted: " . $row->{deleted} . "\n";
1898     }
1899     $sth->finish();
1900
1901     $sth =  $gCfg{dbh}->prepare("SELECT * FROM treetable")
1902         or die "Could not execute DBD::SQLite command";
1903     $sth->execute
1904         or die "Could not execute DBD::SQLite command";
1905
1906     PrintMsg "TREETABLE:\n";
1907     while (my $row = $sth->fetchrow_hashref) {
1908         PrintMsg "tag: " . $row->{tag} . " type: " . $row->{type} . " file: " . $row->{file} . " version: " . $row->{version} . "\n";
1909     }
1910     $sth->finish();
1911
1912     $sth =  $gCfg{dbh}->prepare("SELECT * FROM agenda")
1913         or die "Could not execute DBD::SQLite command";
1914     $sth->execute
1915         or die "Could not execute DBD::SQLite command";
1916
1917     PrintMsg "AGENDA:\n";
1918     while (my $row = $sth->fetchrow_hashref) {
1919         PrintMsg "number: " . $row->{number} . " global_count: " . $row->{global_count} . " iorder: " . $row->{iorder} . "\n";
1920     }
1921     $sth->finish();
1922
1923     $sth =  $gCfg{dbh}->prepare("SELECT * FROM checkpoint")
1924         or die "Could not execute DBD::SQLite command";
1925     $sth->execute
1926         or die "Could not execute DBD::SQLite command";
1927
1928     PrintMsg "CHECKPOINT:\n";
1929     while (my $row = $sth->fetchrow_hashref) {
1930         PrintMsg "file: " . $row->{file} . " checked: " . $row->{checked} . "\n";
1931     }
1932     $sth->finish();
1933
1934     $sth =  $gCfg{dbh}->prepare("SELECT * FROM commitpoint")
1935         or die "Could not execute DBD::SQLite command";
1936     $sth->execute
1937         or die "Could not execute DBD::SQLite command";
1938
1939     PrintMsg "COMMITPOINT:\n";
1940     while (my $row = $sth->fetchrow_hashref) {
1941         PrintMsg "number: " . $row->{number} . " revision: " . $row->{revision}
1942         . " stage: " . $row->{stage} . "\n";
1943     }
1944     $sth->finish();
1945
1946     PrintMsg "CICOUNT:\n";
1947     $sth =  $gCfg{dbh}->prepare("SELECT * FROM ciCount");
1948     while (my $row = $sth->fetchrow_hashref) {
1949         PrintMsg "number: " . $row->{number} . "\n";
1950     }
1951     $sth->finish();
1952
1953     $sth =  $gCfg{dbh}->prepare("SELECT * FROM svnaction")
1954         or die "Could not execute DBD::SQLite command";
1955     $sth->execute
1956         or die "Could not execute DBD::SQLite command";
1957
1958     PrintMsg "SVNACTION:\n";
1959     while (my $row = $sth->fetchrow_hashref) {
1960         PrintMsg "file: " . $row->{file} . " type: " . $row->{type} . " action: " . $row->{action}
1961                 . " global_count: " . $row->{global_count} . "\n";
1962     }
1963     $sth->finish();
1964
1965 }  #End DumpDatabase
1966
1967 ###############################################################################
1968 #  ResetGlobalCountFromDatabase
1969 ###############################################################################
1970 sub ResetGlobalCountFromDatabase {
1971     # reset the global_count to the correct value from the database
1972     my $cmd = "SELECT MAX(global_count) FROM history";
1973     my $sth = $gCfg{dbh}->prepare($cmd)
1974         or die "Could not execute DBD::SQLite command";
1975     $sth->execute
1976         or die "Could not execute DBD::SQLite command";
1977
1978     my $tmpCount;
1979     $sth->bind_columns(\$tmpCount);
1980     while ($sth->fetch()) {
1981         $gCfg{globalCount} = $tmpCount;
1982     }
1983     $sth->finish();
1984 }  #End
1985
1986 ###############################################################################
1987 #  ResetGlobalCiCountFromDatabase
1988 ###############################################################################
1989 sub ResetGlobalCiCountFromDatabase {
1990     # reset the globalCiCount to the correct value from the database
1991     my $cmd = "SELECT number FROM ciCount";
1992     my $sth = $gCfg{dbh}->prepare($cmd)
1993         or die "Could not execute DBD::SQLite command";
1994     $sth->execute
1995         or die "Could not execute DBD::SQLite command";
1996
1997     my $tmpCount;
1998     $sth->bind_columns(\$tmpCount);
1999     while ($sth->fetch()) {
2000         $gCfg{globalCiCount} = $tmpCount;
2001     }
2002     $sth->finish();
2003 }  #End
2004
2005 ###############################################################################
2006 #  CloseDatabase
2007 ###############################################################################
2008 sub CloseDatabase {
2009     $gCfg{dbh}->disconnect;
2010 }  #End CloseDatabase
2011
2012 ###############################################################################
2013 #  GiveHelp
2014 ###############################################################################
2015 sub GiveHelp {
2016     my($msg, $verbose) = @_;
2017     $msg .= "\n" if defined $msg;
2018
2019     $msg .= "USE --help TO VIEW FULL HELP INFORMATION\n" unless $verbose;
2020
2021     if ($0 =~ /exe$/) {
2022         &GiveExeHelp($msg, $verbose); # will be created by .exe build script
2023     }
2024
2025     pod2usage(
2026               {
2027                 -message => $msg,
2028                 -verbose => $verbose,
2029                 -exitval => $verbose, # if user requested --help, go to STDOUT
2030               }
2031              );
2032
2033 }  #End GiveHelp
2034
2035
2036
2037 sub first(&@) {
2038     my $code = shift;
2039     &$code && return $_ for @_;
2040     return undef;
2041 }
2042
2043
2044
2045
2046 ###############################################################################
2047 #                           package Vss2Svn                                   #
2048 ###############################################################################
2049
2050 package Vss2Svn;
2051
2052 require 5.005_62;
2053 use strict;
2054 use warnings;
2055
2056 use File::Path;
2057 use File::Copy;
2058 use Text::Wrap;
2059
2060 use Carp;
2061
2062 our $VERSION = '1.00';
2063
2064 ###############################################################################
2065 #  set_user
2066 ###############################################################################
2067 sub set_user {
2068     my($self, $user, $passwd) = @_;
2069
2070     $self->{user} = $user;
2071
2072     {
2073         no warnings 'uninitialized'; # we want to undef passwd if none passed
2074         $self->{passwd} = $passwd unless $passwd eq '';
2075     }
2076
2077 }  # End set_user
2078
2079 ###############################################################################
2080 #  check_for_exe
2081 ###############################################################################
2082 sub check_for_exe {
2083     my($self, $exe, $desc) = @_;
2084
2085     foreach my $dir (split ';', ".;$ENV{PATH}") {
2086         $dir =~ s/"//g;
2087         if (-f "$dir\\$exe") {
2088             return "$dir\\$exe";
2089         }
2090     }
2091
2092     my $msg = fill('', '', <<"EOMSG");
2093 Could not find executable '$exe' in your \%PATH\%. Ensure $desc is properly
2094 installed on this computer, and manually add the directory in which '$exe' is
2095 located to your path if necessary.
2096
2097 \%PATH\% currently contains:
2098 EOMSG
2099
2100     croak "$msg\n$ENV{PATH}";
2101 }  # End check_for_exe
2102
2103
2104 1;
2105
2106 ###############################################################################
2107 #                        package Vss2Svn::VSS                                 #
2108 ###############################################################################
2109
2110 package Vss2Svn::VSS;
2111
2112 require 5.005_62;
2113 use strict;
2114 use warnings;
2115
2116 use base 'Vss2Svn';
2117 use File::Path;
2118 use File::Copy;
2119 use Win32::TieRegistry (Delimiter => '/');
2120 use Time::ParseDate;
2121
2122 use Cwd;
2123 use Cwd 'chdir';
2124
2125 sub first(&@);
2126
2127 use Carp;
2128 our $VERSION = '1.05';
2129
2130 our(%gCfg, %gErrMatch, %gHistLineMatch, @gDevPatterns);
2131
2132 ###############################################################################
2133 #   new
2134 ###############################################################################
2135 sub new {
2136     my($class, $db, $project, $args) = @_;
2137
2138     if (!defined $db) {
2139         croak "Must specify VSS database path";
2140     }
2141
2142     $db =~ s/[\/\\]?(srcsafe.ini)?$//i;
2143
2144     if (defined $project && $project ne ''
2145         && $project ne '$' && $project !~ /^\$\//) {
2146         croak "Project path must be absolute (begin with \$/)";
2147     }
2148
2149     $project = first {defined} $project, '\$/';
2150     $args = first {defined} $args, {};
2151
2152     my $self = bless
2153         {
2154             database             => $db,
2155             interactive          => 0,
2156             user                 => undef,
2157             passwd               => undef,
2158             silent               => undef,
2159             verbose              => undef,
2160             paginate             => 0,
2161             ss_output            => undef,
2162             ss_error             => undef,
2163             get_readonly         => 1,
2164             get_compare          => 1,
2165             get_eol_type         => 0,
2166             use_tempfiles        => 0,
2167             timebias             => 0,
2168             dstbias              => 0,
2169             _tempdir             => undef,
2170             _debug               => 0,
2171             _whoami              => undef,
2172             %$args,
2173         }, $class;
2174
2175     $self->{_ssexe} = $self->check_for_exe("ss.exe",
2176         "the Microsoft Visual SourceSafe client");
2177
2178     # test to ensure 'ss' command is available
2179     $self->ss("WHOAMI", -2) or
2180         croak "Could not run VSS 'ss' command: ensure it is in your PATH";
2181
2182     $self->{_whoami} = $self->{ss_output};
2183     $self->{_whoami} =~ s/\s*$//;
2184     $self->{_whoami} =~ s/^.*\n//;
2185
2186     if ($self->{ss_output} =~ /changing project/im ||
2187          !$self->_check_ss_inifile) {
2188         croak "FATAL ERROR: You must not set the Force_Dir or Force_Prj VSS\n"
2189             . "variables when running SourceSync. These variables can be\n"
2190             . "cleared by unchecking the two \"Assume...\" boxes in SourceSafe\n"
2191             . "Explorer under Tools -> Options -> Command Line Options.\n ";
2192     }
2193
2194     if ($project eq '') {
2195         $self->ss('PROJECT', -2);
2196
2197         $project = $self->{ss_output};
2198         $project =~ s/^Current project is *//i;
2199         $project .= '/' unless $project =~ m/\/$/;
2200
2201         $self->{project} = $project;
2202     } else {
2203         $self->set_project($project);
2204     }
2205
2206     # used in Daylight Savings Time offset calculations
2207     $self->{_is_dst_now} = (localtime)[8];
2208
2209     return $self;
2210
2211 }  #End new
2212
2213 ###############################################################################
2214 #  _check_ss_inifile
2215 ###############################################################################
2216 sub _check_ss_inifile {
2217     my($self) = @_;
2218
2219     my $user = lc($self->{_whoami});
2220     my $path = "$self->{database}/users/$user/ss.ini";
2221
2222     open SSINI, $path or croak "Could not open user init file $path";
2223     my $success = 1;
2224
2225 LINE:
2226     while (<SSINI>) {
2227         if (m/Force_/i) {
2228             $success = 0;
2229             last LINE;
2230         }
2231     }
2232
2233     close SSINI;
2234     return $success;
2235
2236 }  # End _check_ss_inifile
2237
2238 ###############################################################################
2239 #  set_project
2240 ###############################################################################
2241 sub set_project {
2242     my($self, $project) = @_;
2243
2244     $project .= '/' unless $project =~ m/\/$/;
2245
2246     $self->ss("CP \"$project\"", -2) or
2247         croak "Could not set current project to $project:\n"
2248             . "  $self->{ss_output}\n ";
2249
2250     $self->{project} = $project;
2251
2252 }  # End set_project
2253
2254 ###############################################################################
2255 #  format_time_version
2256 ###############################################################################
2257 sub format_time_version {
2258     my ($self, $time) = @_;
2259     my ($minute, $hour, $date, $month, $year, $meridian);
2260     (undef, $minute, $hour, $date, $month, $year) = localtime($time);
2261     $month++;
2262     $year %= 100;
2263     $meridian = ($hour < 12) ? "a" : "p";
2264     $hour = (($hour % 12) == 0) ? 12 : ($hour % 12);
2265     my $ret = sprintf("%02d/%02d/%02d;%d:%02d%s", $month, $date, $year, $hour,
2266                       $minute, $meridian);
2267     return $ret;
2268 }
2269
2270 ###############################################################################
2271 #  compute_biases
2272 ###############################################################################
2273 sub compute_biases {
2274     my ($self, $basis) = @_;
2275
2276     if ($self->{timebias} != 0) {
2277         my $bias = $self->{timebias};
2278         my $was_dst_then = (localtime $basis)[8];
2279
2280         if ($self->{_is_dst_now} && ! $was_dst_then) {
2281             $bias -= $self->{dstbias};
2282         } elsif (! $self->{_is_dst_now} && $was_dst_then) {
2283             $bias += $self->{dstbias};
2284         }
2285
2286         # add '+' to front so parsedate adds # of minutes
2287         $bias =~ s/^(\d+)/+ $1/;
2288         $basis = parsedate("$bias minutes", NOW => $basis);
2289     }
2290     return $basis;
2291 }
2292
2293 ###############################################################################
2294 #  format_version_string
2295 ###############################################################################
2296 sub format_version_string {
2297     my($self, %versionHash) = @_;
2298     my $cmd = "";
2299
2300     if (defined $versionHash{"endlabel"}) {
2301         $cmd .= ' "-VL' . $versionHash{"endlabel"};
2302         if (defined $versionHash{"beginlabel"}) {
2303             $cmd .= '~' . $versionHash{"beginlabel"};
2304         }
2305         $cmd .= '"';
2306     } elsif (defined $versionHash{"endtime"}) {
2307         my $ld = $self->format_time_version($versionHash{"endtime"});
2308         $cmd .= ' -Vd' . $ld;
2309         if (defined $versionHash{"begintime"}) {
2310             my $bd = $self->format_time_version($versionHash{"begintime"});
2311             $cmd .= '~' . $bd;
2312         }
2313     } elsif (defined $versionHash{"endversion"}) {
2314         $cmd .= ' -V' . $versionHash{"endversion"};
2315         if (defined $versionHash{"beginversion"}) {
2316             $cmd .= '~' . $versionHash{"beginversion"};
2317         }
2318     }
2319     return $cmd;
2320 }
2321
2322 ###############################################################################
2323 #  project_tree
2324 ###############################################################################
2325 sub project_tree {
2326     my($self, $project, $recursive, $remove_dev, %versionHash) = @_;
2327
2328     # returns a nested-hash "tree" of all subprojects and files below the given
2329     # project; the "leaves" of regular files are the value "1" or the version number.
2330     # if one of the version options is defined
2331
2332     $project = $self->full_path($project);
2333     $recursive = 1 unless defined $recursive;
2334     $remove_dev = 0 unless defined $remove_dev;
2335
2336     if ($self->filetype($project) < 0) { # projects are type 0
2337         carp "project_tree(): '$project' is not a valid project";
2338         return undef;
2339     }
2340
2341     my $cmd = "DIR \"$project\"";
2342     $cmd .= ($recursive)? ' -R' : ' -R-';
2343     $cmd .= $self->format_version_string(%versionHash);
2344
2345     # versions get pasted on the ends of projects and files
2346     my $versionPasting = (defined $versionHash{"endlabel"} || defined $versionHash{"endtime"} || defined $versionHash{"endversion"});
2347
2348     $self->ss($cmd, -2) or return undef;
2349
2350     # It would be nice if Microsoft made it easy for scripts to pick useful
2351     # information out of the project 'DIR' listings, but unfortunately that's
2352     # not the case. It appears that project listings always follow blank
2353     # lines, and begin with the full project path with a colon appended.
2354     # Within a listing, subprojects come first and begin with a dollar sign,
2355     # then files are listed alphabetically. If there are no items in a project,
2356     # it prints out a message saying so. And at the end of it all, you get
2357     # a statement like "7 item(s)".
2358
2359     my %tree = ();
2360     my $branch_ref = \%tree;
2361
2362     my $seen_blank_line = 0;
2363     my($current_project);
2364     my $match_project = quotemeta($project);
2365
2366 LINE:
2367     foreach my $line (split "\n", $self->{ss_output}) {
2368         if ($self->{_debug}) {
2369             warn "\nDEBUG:<$line>\n";
2370         }
2371         $line =~ s/\s+$//;
2372
2373         if ($line eq '') {
2374             if ($seen_blank_line) {
2375                 carp "project_tree(): an internal error has occured -- 1";
2376                 return undef;
2377             }
2378
2379             $seen_blank_line = 1;
2380             next LINE;
2381         } elsif ($line =~ m/^(File|Project) \S+.* has been destroyed, and cannot be rebuilt\.$/) {
2382             next LINE;
2383         } elsif ($line =~ m/^Continue anyway\?\(Y\/N\)Y$/) {
2384             next LINE;
2385         }
2386
2387         $seen_blank_line = 0;
2388
2389         if ($line =~ m/^\d+\s+item\(s\)$/i) {
2390             # this is a count of # of items found; ignore
2391             next LINE;
2392
2393         } elsif ($line =~ m/^No items found under/i) {
2394             # extraneous info
2395             next LINE;
2396
2397         } elsif ($line =~ m/^(\$\/.*):$/) {
2398             # this is the beginning of a project's listing
2399             $current_project = $1;
2400             # make current project relative to initial
2401             $current_project =~ s/^$match_project\/?//i;
2402             $current_project =~ s/^\$\///; # take off initial $/ if still there
2403             $current_project =~ s/;\d+$// if $versionPasting;
2404
2405             $branch_ref = \%tree;
2406
2407             if ($current_project ne '') {
2408                 # get a reference to the end branch of subprojects
2409                 my @ssplit = split /\//, $current_project;
2410                 my @localmap = map {$branch_ref = $branch_ref->{$_}} @ssplit;
2411                 ($branch_ref) = reverse(@localmap);
2412             }
2413
2414             if (!defined $branch_ref) {
2415                 carp "project_tree(): an internal error has occured -- 2";
2416                 return undef;
2417             }
2418
2419             next LINE;
2420         } elsif ($line =~ m/^\$(.*)/) {
2421             # this is a subproject; create empty hash if not already there
2422             if (!defined $current_project) {
2423                 carp "project_tree(): an internal error has occured -- 3";
2424                 return undef;
2425             }
2426             my $subproject = $1;
2427             $subproject =~ s/;\d+$// if $versionPasting;
2428
2429             $branch_ref->{$subproject} = {} unless defined($branch_ref->{$subproject});
2430         } else {
2431             # just a regular file
2432             if (!defined $current_project) {
2433                 carp "project_tree(): an internal error has occured -- 4";
2434                 return undef;
2435             }
2436
2437             if ($remove_dev) {
2438                 foreach my $pattern (@gDevPatterns) {
2439                     next LINE if $line =~ m/$pattern/i;
2440                 }
2441             }
2442             my $version;
2443             $line =~ s/;(\d+)$// if $versionPasting;
2444             $version = $1 if $versionPasting;
2445
2446             $branch_ref->{$line} = !(defined $version) ? 1 : $version;
2447         }
2448
2449     }
2450
2451     return \%tree;
2452
2453 }  # End project_tree
2454
2455 ###############################################################################
2456 #  file_history
2457 ###############################################################################
2458 sub file_history {
2459     my($self, $file, $keepLabel, %versionHash) = @_;
2460     # returns an array ref of hash refs from earliest to most recent;
2461     # each hash has the following items:
2462     #    version: version (revision) number
2463     #    user   : name of user who committed change
2464     #    date   : date in YYYY-MM-DD format
2465     #    time   : time in HH:MM (24h) format
2466     #    comment: checkin comment
2467     #    tstamp : time in time_t format
2468
2469     $file = $self->full_path($file);
2470
2471     my $cmd = "HISTORY \"$file\"";
2472     my $tmpfile = '';
2473
2474     $cmd .= $self->format_version_string(%versionHash);
2475
2476     $self->ss($cmd, -2) or return undef;
2477
2478     my $hist = [];
2479     my $labeltext = {};
2480
2481     my $last = 0; # what type was the last line read?
2482     # 0=start;1=version line;2=user/date/time;3="Created";
2483     # 4=comment, 5=label, 6=initial label before version
2484
2485     my $last_version = -1;
2486
2487     my$rev = {}; # hash of info for the lastent revision
2488     my($year,$month,$day,$hour,$min,$ampm,$comment,$version);
2489
2490 HISTLINE:
2491     foreach my $line (split "\n", $self->{ss_output}) {
2492         if ($self->{_debug}) {
2493             warn "\nDEBUG:($last)<$line>\n";
2494         }
2495
2496         if ($last == 0) {
2497             $comment = '';
2498             if ($line =~ m/$gHistLineMatch{version}/) {
2499
2500                 if ($last_version == 0 ||
2501                     (($last_version != -1) && ($1 != ($last_version - 1)))) {
2502
2503                     # each version should be one less than the last
2504                     print "file_history(): internal consistency failure";
2505                     return undef;
2506                 }
2507
2508                 $last = 1;
2509                 $rev->{version} = $version = $1;
2510                 if (!defined $labeltext->{$1}) {
2511                     $labeltext->{$1} = [];
2512                 }
2513             } elsif ($line =~ m/$gHistLineMatch{labelheader}/) {
2514                 $last = 6;
2515                 if (!defined $labeltext->{"UNKNOWN"}) {
2516                     $labeltext->{"UNKNOWN"} = [];
2517                 }
2518                 unshift @{$labeltext->{"UNKNOWN"}}, $line;
2519             }
2520
2521             next HISTLINE;
2522         } # if $last == 0
2523
2524         if ($last == 1) {
2525             if ($line =~ m/$gHistLineMatch{userdttm}/) {
2526                 $last = 2;
2527                 $comment = '';
2528
2529                 if ($gCfg{dateFormat} == 1) {
2530                     # DD-MM-YY
2531                     ($rev->{user}, $day, $month, $year, $hour, $min, $ampm)
2532                         = ($1, $2, $3, $4, $5, $6, $7);
2533                 } elsif ($gCfg{dateFormat} == 2) {
2534                     # YY-MM-DD
2535                     ($rev->{user}, $year, $month, $day, $hour, $min, $ampm)
2536                         = ($1, $2, $3, $4, $5, $6, $7);
2537                 } else {
2538                     # MM-DD-YY
2539                     ($rev->{user}, $month, $day, $year, $hour, $min, $ampm)
2540                         = ($1, $2, $3, $4, $5, $6, $7);
2541                 }
2542
2543                 $year = ($year > 79)? "19$year" : "20$year";
2544
2545                 if ($ampm =~ /p/i && $hour < 12) {
2546                     $hour += 12;
2547                 } elsif ($ampm =~ /a/i && $hour == 12) {
2548                     $hour = 0;
2549                 }
2550
2551                 if ($self->{timebias} != 0) {
2552                     my $basis = parsedate("$year/$month/$day $hour:$min");
2553
2554                     my $epoch_secs = $self->compute_biases($basis);
2555
2556                     (undef,$min,$hour,$day,$month,$year)
2557                         = localtime($epoch_secs);
2558
2559                     $month++;
2560                     $year += 1900; #no, not a Y2K bug; $year = 100 in 2000
2561                 }
2562
2563                 my $tmpDate = sprintf("%4.4i-%2.2i-%2.2i", $year, $month, $day);
2564                 $rev->{date} = $tmpDate;
2565                 $rev->{time} = sprintf("%2.2i:%2.2i", $hour, $min);
2566                 $tmpDate =~ s/-/\//g;
2567                 $tmpDate .= " " . $rev->{time};
2568                 $rev->{tstamp} = parsedate($tmpDate, (NO_RELATIVE => 1, GMT => 1, WHOLE => 1));
2569             } elsif ($line =~ m/$gHistLineMatch{label}/) {
2570                 # this is an inherited Label; ignore it
2571
2572             } else {
2573                 # user, date, and time should always come after header line
2574                 print "file_history(): internal consistency failure";
2575                 return undef;
2576             }
2577
2578             next HISTLINE;
2579         } # if $last == 1
2580
2581         if ($last == 2) {
2582             if ($line =~ s/$gHistLineMatch{comment}//) {
2583                 $last = 4;
2584                 $comment = $line;
2585                 $comment .= "\n";
2586                 next HISTLINE;
2587             } elsif ($line =~ m/$gHistLineMatch{created}/) {
2588                 $last = 3;
2589                 $comment = $line;
2590                 $comment .= "\n";
2591                 next HISTLINE;
2592             } elsif ($line =~ m/^$/) {
2593                 $last = 4;
2594             }
2595
2596         }
2597
2598         if ($last == 3) {
2599             if ($line =~ s/$gHistLineMatch{comment}//) {
2600                 $last = 4;
2601                 $comment = $line;
2602                 $comment .= "\n";
2603                 next HISTLINE;
2604             }
2605         }
2606
2607         if ($last == 4) {
2608             if ($line =~ m/$gHistLineMatch{version}/) {
2609                 $last = 1;
2610                 $version = $1;
2611                 if (!defined $labeltext->{$version}) {
2612                     $labeltext->{$version} = [];
2613                 }
2614
2615                 $comment =~ s/\s+$//;
2616                 $comment =~ s/^\s+//;
2617                 $rev->{comment} = $comment;
2618
2619                 my $tmplabel;
2620                 if ($keepLabel) {
2621                     while (defined ($tmplabel = pop @{$labeltext->{$version+1}})) {
2622                         $rev->{comment} .= "\n$tmplabel";
2623                     }
2624                 }
2625                 unshift @$hist, $rev;
2626
2627                 $rev = {};
2628                 $rev->{version} = $version;
2629             } elsif ($line =~ m/$gHistLineMatch{labelheader}/) {
2630                 $last = 5;
2631                 if (!defined $labeltext->{$version-1}) {
2632                     $labeltext->{$version-1} = [];
2633                 }
2634                 unshift @{$labeltext->{$version-1}}, $line;
2635             } else {
2636                 $comment .= $line;
2637                 $comment .= "\n";
2638             }
2639
2640             next HISTLINE;
2641         }
2642
2643         if ($last == 5) {
2644             if ($line =~ m/$gHistLineMatch{version}/) {
2645                 $last = 1;
2646                 $version = $1;
2647
2648                 $comment =~ s/\s+$//;
2649                 $comment =~ s/^\s+//;
2650                 $rev->{comment} = $comment;
2651
2652                 my $tmplabel;
2653                 if ($keepLabel) {
2654                     while (defined ($tmplabel = pop @{$labeltext->{$version+1}})) {
2655                         $rev->{comment} .= "\n$tmplabel";
2656                     }
2657                 }
2658                 unshift @$hist, $rev;
2659
2660                 $rev = {};
2661                 $rev->{version} = $version;
2662             } else {
2663                 unshift @{$labeltext->{$version-1}}, $line;
2664             }
2665         }
2666
2667         if ($last == 6) {
2668             if ($line =~ m/$gHistLineMatch{version}/) {
2669                 $last = 1;
2670                 $version = $1;
2671
2672                 if (!defined $labeltext->{$version}) {
2673                     $labeltext->{$version} = [];
2674                 }
2675                 my $tmplabel;
2676                 while (defined ($tmplabel = pop @{$labeltext->{"UNKNOWN"}})) {
2677                     unshift @{$labeltext->{$version}}, $tmplabel;
2678                 }
2679                 undef $labeltext->{"UNKNOWN"};
2680
2681                 $rev = {};
2682                 $rev->{version} = $version;
2683             } else {
2684                 unshift @{$labeltext->{"UNKNOWN"}}, $line;
2685             }
2686         }
2687
2688     }
2689
2690     $comment =~ s/\s+$//;
2691     $comment =~ s/^\s+//;
2692     $rev->{comment} = $comment;
2693
2694     if ($last == 4 || $last == 3) {
2695         my $tmplabel;
2696         if ($keepLabel) {
2697             while (defined ($tmplabel = pop @{$labeltext->{$version}})) {
2698                 $rev->{comment} .= "\n$tmplabel";
2699             }
2700         }
2701     }
2702
2703     unshift @$hist, $rev;
2704     return $hist;
2705 }
2706
2707 ###############################################################################
2708 #  filetype
2709 ###############################################################################
2710 sub filetype {
2711     # -1: error
2712     #  0: project
2713     #  1: text
2714     #  2: binary
2715
2716     my($self, $file) = @_;
2717     return -1 unless defined $file;
2718
2719     # special cases
2720     return 0 if $file eq '\$/';
2721     return -1 unless $file =~ m:^\$\/:;
2722
2723     $file =~ s:\\:/:g; # flip all '\\' to '/'
2724
2725     # VSS has no decent way of determining whether an item is a project or
2726     # a file, so we do this in a somewhat roundabout way
2727
2728     $file =~ s/[\/\\]$//;
2729
2730     my $bare = $file;
2731     $bare =~ s/.*[\/\\]//;
2732     $bare = quotemeta($bare);
2733
2734     $self->ss("PROPERTIES \"$file\" -R-", -3) or return -1;
2735
2736     my $match_isproject = "^Project:.*$bare\\s*\$";
2737     my $match_notfound = "$bare\\s*is not an existing filename or project";
2738
2739     if ($self->{ss_output} =~ m/$match_isproject/mi) {
2740         return 0;
2741     } elsif ($self->{ss_output} =~ m/$match_notfound/mi) {
2742         return -1;
2743      } else {
2744         $self->ss("FILETYPE \"$file\"", -3) or return -1;
2745
2746         if ($self->{ss_output} =~ m/^$bare\s*Text/mi) {
2747             return 1;
2748         } else {
2749             return 2;
2750         }
2751
2752     }
2753
2754 }  # End filetype
2755
2756 ###############################################################################
2757 #  full_path
2758 ###############################################################################
2759 sub full_path {
2760     # returns the full VSS path to a given project file.
2761
2762     my($self, $file) = @_;
2763
2764     # kill leading and trailing whitespace
2765     $file =~ s/^\s+//;
2766     $file =~ s/\s+$//;
2767
2768     # append the project part, unless it's already a project
2769     $file = "$self->{project}/$file" unless $file =~ m/^\$/;
2770     $file =~ s:\\:/:g; # flip all '\\' to '/'
2771     $file =~ s:/+:/:g; # replace all '//' with '/'
2772     $file =~ s:(\$/.*)/$:$1:; # remove any trailing slashes
2773
2774     return $file;
2775 }  # End full_path
2776
2777 ###############################################################################
2778 #  ss
2779 ###############################################################################
2780 sub ss {
2781     my($self, $cmd, $silent) = @_;
2782
2783     # SS command-line tool access.
2784
2785     # silent values:
2786     #  0: print everything
2787     #  1: print program output only
2788     #  2: print err msgs only
2789     #  3: print nothing
2790     # -n: use 'n' only if 'silent' attribute not set
2791
2792     if (defined($silent) && $silent < 0) {
2793         $silent = first {defined} $self->{silent}, $silent;
2794     } else {
2795         $silent = first {defined} $silent, $self->{silent}, 0;
2796     }
2797
2798     $silent = abs($silent);
2799
2800     $cmd =~ s/^\s+//;
2801     $cmd =~ s/\s+$//;
2802
2803     (my $cmd_word = lc($cmd)) =~ s/^(ss(\.exe)?\s+)?(\S+).*/$3/i;
2804
2805     $cmd = "\"$self->{_ssexe}\" $cmd" unless ($cmd =~ m/^ss(\.exe)?\s/i);
2806
2807     if ($self->{interactive} =~ m/^y/i) {
2808         $cmd = "$cmd -I-Y";
2809     } elsif ($self->{interactive} =~ m/^n/i) {
2810         $cmd = "$cmd -I-N";
2811     } elsif (!$self->{interactive}) {
2812         $cmd = "$cmd -I-"
2813     }
2814
2815     my $disp_cmd = $cmd;
2816
2817     if (defined $self->{user} && $cmd !~ /\s-Y/i) {
2818         if (defined $self->{passwd}) {
2819             $disp_cmd = "$cmd -Y$self->{user},******";
2820             $cmd = "$cmd -Y$self->{user},$self->{passwd}";
2821         } else {
2822             $disp_cmd = $cmd = "$cmd -Y$self->{user}";
2823         }
2824     }
2825
2826     my($rv, $output);
2827
2828     warn "DEBUG: $disp_cmd\n\n" if $self->{_debug};
2829
2830     $ENV{SSDIR} = $self->{database};
2831
2832     if ($self->{use_tempfiles} &&
2833         $cmd_word =~ /^(dir|filetype|history|properties)$/) {
2834         my $tmpfile = "$self->{use_tempfiles}/${cmd_word}_cmd.txt";
2835         unlink $tmpfile;
2836         $cmd = "$cmd \"-O\&$tmpfile\"";
2837         system $cmd;
2838
2839         if (open SS_OUTPUT, "$tmpfile") {
2840             local $/;
2841             $output = scalar <SS_OUTPUT>;
2842             close SS_OUTPUT;
2843             unlink $tmpfile;
2844         } else {
2845             warn "Can't open '$cmd_word' tempfile $tmpfile";
2846             undef $output;
2847         }
2848
2849     } else {
2850         open SS_OUTPUT, '-|', "$cmd 2>&1";
2851
2852         while (<SS_OUTPUT>) {
2853             $output .= $_;
2854         }
2855
2856         close SS_OUTPUT;
2857         $output =~ s/\s+$// if defined $output;
2858     }
2859
2860     if ($silent <= 1) {
2861         if ($self->{paginate}) {
2862             my $linecount = 1;
2863
2864             foreach my $line (split "\n", $output) {
2865                 print "$line\n";
2866
2867                 unless ($linecount++ % $self->{paginate}) {
2868                     print "Hit ENTER to continue...\r";
2869                     <STDIN>;
2870
2871                     print "                        \r";
2872
2873                 }
2874
2875             }
2876
2877         } else {
2878             print "$output\n";
2879         }
2880
2881     }
2882
2883     my $ev = $? >> 8;
2884
2885     # SourceSafe returns 1 to indicate warnings, such as no results returned
2886     # from a 'DIR'. We don't want to consider these an error.
2887     my $success = !($ev > 1);
2888
2889     if ($success) {
2890         # This is interesting. If a command only partially fails (such as GET-ing
2891         # multiple files), that's apparently considered a success. So we have to
2892         # try to fix that.
2893         my $base_cmd = uc($cmd);
2894         $base_cmd =~ s/^(ss\s*)?(\w+).*/$2/i;
2895
2896         my $err_match;
2897
2898         if (defined($err_match = $gErrMatch{$base_cmd}) &&
2899                         $output =~ m/$err_match/m) {
2900             $success = 0;
2901         }
2902
2903     }
2904
2905     if ($success) {
2906         $self->{ss_error} = undef;
2907     } else {
2908         $self->{ss_error} = "$disp_cmd\n$output";
2909     }
2910
2911     if (!$success && ($silent == 0 || $silent == 2)) {
2912
2913         carp "\nERROR in Vss2Svn::VSS-\>ss\n"
2914             . "Command was: $disp_cmd\n   "
2915             . "(Error $ev) $output\n ";
2916         warn "\n";
2917
2918     }
2919
2920     $self->{ss_output} = $output;
2921     return $success;
2922
2923 }  # End ss
2924
2925 ###############################################################################
2926 #  _msg
2927 ###############################################################################
2928 sub _msg {
2929     my $self = shift;
2930     print @_ unless $self->{silent};
2931 }  # End _msg
2932
2933 ###############################################################################
2934 #  _vm  -- "verbose message"
2935 ###############################################################################
2936 sub _vm {
2937     my $self = shift;
2938     print @_ if $self->{verbose};
2939 }  # End _vm
2940
2941 ###############################################################################
2942 #  Initialize
2943 ###############################################################################
2944 sub Initialize {
2945     my $dateFormat = $Registry->{'HKEY_CURRENT_USER/Control Panel/'
2946                              . 'International/iDate'} || 0;
2947     my $dateSep = $Registry->{'HKEY_CURRENT_USER/Control Panel/'
2948                              . 'International/sDate'} || '/';
2949     my $timeSep = $Registry->{'HKEY_CURRENT_USER/Control Panel/'
2950                              . 'International/sTime'} || ':';
2951     $gCfg{dateFormat} = $dateFormat . "";
2952
2953     if ($dateFormat == 1) {
2954         $gCfg{dateString} = "DD${dateSep}MM${dateSep}YY";
2955     } elsif ($dateFormat == 2) {
2956         $gCfg{dateString} = "YY${dateSep}MM${dateSep}DD";
2957     } else {
2958         $gCfg{dateString} = "MM${dateSep}DD${dateSep}YY";
2959     }
2960
2961     $gCfg{timeString} = "HH${timeSep}MM";
2962
2963     # see ss method for explanation of this
2964     %gErrMatch = (
2965                     GET    => 'is not an existing filename or project',
2966                     CREATE => 'Cannot change project to',
2967                     CP     => 'Cannot change project to',
2968                  );
2969
2970     %gHistLineMatch = (
2971         version    => qr/^\*+\s*Version\s+(\d+)\s*\*+\s*$/,
2972         userdttm   => qr/^User:\s+(.*?)\s+
2973                           Date:\s+(\d+)$dateSep(\d+)$dateSep(\d+)\s+
2974                           Time:\s+(\d+)$timeSep(\d+)([ap]*)\s*$/x,
2975         comment    => qr/^Comment:\s*/,
2976         created    => qr/^Created$/,
2977         labelheader    => qr/^\*+$/,
2978         label      => qr/^Label:/,
2979     );
2980
2981     # patterns to match development files that project_tree will ignore
2982     @gDevPatterns = (
2983                         qr/\.vspscc$/,
2984                         qr/\.vssscc$/,
2985                         qr/^vssver\.scc$/,
2986                     );
2987
2988     # close the keys
2989     undef $dateFormat;
2990     undef $dateSep;
2991     undef $timeSep;
2992
2993 }  # End Initialize
2994
2995 sub first(&@) {
2996     my $code = shift;
2997     &$code && return $_ for @_;
2998     return undef;
2999 }
3000
3001 package main;
3002
3003 ## EXE PRECOMPILE HERE
3004
3005 1;
3006
3007 __END__
3008 =pod
3009
3010 =head1 LICENSE
3011
3012 vss2svn.pl, Copyright (C) 2004 by Toby Johnson.
3013
3014 This program is free software; you can redistribute it and/or
3015 modify it under the terms of the GNU General Public License
3016 as published by the Free Software Foundation; either version 2
3017 of the License, or (at your option) any later version.
3018
3019 This program is distributed in the hope that it will be useful,
3020 but WITHOUT ANY WARRANTY; without even the implied warranty of
3021 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
3022 GNU General Public License for more details.
3023 L<http://www.gnu.org/copyleft/gpl.html>
3024
3025 =head1 SYNOPSIS
3026
3027 vss2svn.pl S<--vssproject $/vss/project> S<--svnrepo http://svn/repo/url>
3028
3029 =over 4
3030
3031 =item --vssproject:
3032
3033 full path to VSS project you want to migrate
3034
3035 =item --svnrepo:
3036
3037 URL to target Subversion repository
3038
3039 =back
3040
3041 =head1 OPTIONS
3042
3043 =over 4
3044
3045 =item --vssexclude <EXCLUDE_PROJECTS>:
3046
3047 Exclude the given projects from the migration. To list multiple projects,
3048 separate with commas or use multiple --vssexclude commands.
3049
3050 Each project can be given as an absolute path (beginning with $/) or
3051 relative to --vssproject.
3052
3053 =item --comment "MESSAGE":
3054
3055 add MESSAGE to end of every migrated comment
3056
3057 =item --norevprop:
3058
3059 By default, vss2svn sets the "svn:date" and "svn:author"
3060 revision properties on all commits to reflect the original
3061 VSS commit date and author so that the original commit dates/authors
3062 (and not today's date/svnlogin) show up in your new repository.
3063
3064 Using this flag turns off the default behavior.
3065
3066 The default behavior requires the "pre-revprop-change" hook script to be set; see
3067 L<http://svnbook.red-bean.com/en/1.1/svn-book.html#svn-ch-5-sect-2.1>.
3068
3069 See README.TXT for more information on setting "svn:date".
3070
3071 =item --vsslogin "USER:PASSWD":
3072
3073 Set VSS username and password, separated by a colon.
3074 B<WARNING --> if the username/password combo you provide is
3075 incorrect, this program will hang as ss.exe prompts you for
3076 a username! (This is an unavoidable Microsoft bug).
3077
3078 =item --svnlogin "USER:PASSWD":
3079
3080 The username and password vss2svn uses to authenticate to the target subversion repository.
3081
3082 =item --timebias <OFFSET_MINUTES>:
3083
3084 This script will examine your current Windows regional settings
3085 by default in order to determine the number of minutes it should
3086 add to your local time to get to GMT (for example, if you are
3087 in Eastern Daylight Time [-0400], this should be 240). Use this
3088 argument to override this value only if times are converted
3089 incorrectly.
3090
3091 =item --dstbias <OFFSET_MINUTES>:
3092
3093 This script will examine your current Windows regional settings
3094 by default in order to determine the number of minutes it should
3095 add to convert from a time during Daylight Savings Time to a time
3096 during Standard Time. Use this argument to override this value
3097 only if times are converted incorrectly. This will ordinarily be
3098 -60 in regions that use DST and 0 otherwise.
3099
3100 =item --noprompt:
3101
3102 Don't prompt to confirm settings or to create usernames after
3103 the first stage.
3104
3105 =item --nolabel:
3106
3107 Don't include labels in comments.
3108
3109 =item --restart:
3110
3111 Add this flag to the rest of the commandline arguments if the migration session dies.
3112
3113 =item --update [value]:
3114
3115 Implies --restart.  Refreshes the database since the oldest item in the database.
3116 until the time specified by --snaptime or --snaplabel.
3117
3118 The --update flag may take an optional argument, either "fast" or "complete", depending on how file history
3119 is to be processed.  If none is given, it defaults to "fast".
3120
3121 The behavior of "fast" is to only examine file history if a file's version number is not equal to the version
3122 number that was stored in history on the last run.  That is, if a file has been rolled back, pinned, or modified.
3123
3124 However, there may be exceptions to this rule, such as when a file is removed and replaced with a file
3125 with the same history depth.  The "complete" history examines the history of each and every file.
3126
3127 =item --substfile <file>:
3128
3129 Adds `FILE:SUBSTITUTION' pairs contained in the file to try and work around
3130 files that have been checked in to VSS that cannot be checked out without
3131 using wildcarding inside VSS.
3132
3133 =item --snaptime <time>:
3134
3135 Defaults to time(). Use this to specify when to capture the particular structure of the VSS project.
3136 Local time is specified in the format "yyyy-mm-ddThh:mm". GMT time is specified in the format "yyyy-mm-ddThh:mmZ".
3137
3138 Mutually exclusive of --snaplabel.
3139
3140 =item --snaplabel <label>:
3141
3142 Use this to specify a label to capture the particular structure of the VSS project.
3143
3144 Mutually exclusive of --snaptime.
3145
3146 =item --debug:
3147
3148 Print all program output to screen as well as logfile.
3149
3150 =back
3151