# no buffer
$| = 1;

$ssprojname = "$ARGV[0]";
$workdir = $ARGV[1];
if (not defined $workdir) {
	use Cwd;
	$workdir = cwd();
}
$mycvsroot = $ARGV[2];
if (not defined $mycvsroot) {$mycvsroot = ":local:c:\\cvsroot";}

$subdir = $ssprojname;
$subdir =~ s%\$\/%%;
$subdir =~ s%\/%\\%g;
if ( $subdir =~ /^([^\\]*)\\/ ) {
	$topdir = $1;
} else {
	$topdir = $subdir;
}

print ("project is $ssprojname" . "\n");

print ("working directory is $workdir" . "\n");

print ("subdir for import is $subdir" . "\n");

print ("top level of import is $topdir" . "\n");

#
# Make an empty tree matching the vss project
#

chdir $workdir;

system("ss cd \"$ssprojname\"");

# this makes this pattern more useable for matching
$ssprojpat = $ssprojname;
$ssprojpat =~ s%\$%\\\$%;
$ssprojpat =~ s%\/%\\/%g;

# goto hellinahandbasket;

system("ss dir -R \"$ssprojname\" -Odirlist");

open(PROJLIST, "< dirlist");

foreach $dirline (<PROJLIST>) {
	if ($dirline =~ s/^$ssprojpat[\/\:]//) {
		chomp $dirline;
		$dirline =~ s/^([^\:]*)\:[\s]*$/\1/;
#		$dirline = lc($dirline);
		print("mkdir \"$subdir\\$dirline\"\n");
		system("mkdir \"$subdir\\$dirline\"");
	}
}

close PROJLIST;

system("ss workfold \"$ssprojname\" \"$workdir\\$subdir\"");

# create a cvs repository
# cvs import the tree
chdir $topdir;
system("cvs -d $mycvsroot import -I \"*.scc\" -m \"Directory structure from VSS\" $topdir fromVSS transfer");
chdir "$workdir";

system("rmdir /s/q \"$topdir\"");

if ($topdir ne $subdir) {
	system("mkdir \"$topdir\"");
	chdir $topdir;
}
system("cvs -f -d $mycvsroot checkout \"$subdir\"");

chdir "$workdir";
system("ss get \"$ssprojname\" -GF -I-Y -R");

chdir $subdir;

# Check that the permissions cvs sets on the directories inside CVSROOT are reasonable

# for every file (ss properties project)
#  make a list

system("ss properties -R \"$ssprojname\" -Osspropdump");

open(FILELIST,"> ssfiledump") or die "output";

open(SS, "< sspropdump");

foreach $fileline (<SS>) {
  chomp($fileline);
  $fileline =~ s/\r$//;
  ($field,$value) = split(/:\s*/,$fileline,2);
  next unless defined($value);
  
  if( $field eq "File") {
    $file = $value;
    if( $file =~ /[\000-\031@#]/ ) {
      die "@, #, or unprintable characters not allowed in filename '$file' - sorry, rename it and start over.\n";
    }
  } elsif( $field eq "Type") {
    $type=lc($value);
  } elsif( $field eq "Store only latest version") {
    die "parse error" if(!defined($file)||!defined($type));
    $nohistory = $value;
    $file =~ s/^\s+//;
    print FILELIST "$nohistory $type $file\n";
    undef $file;
    undef $type;
    undef $nohistory;
  }
}

close SS;
close FILELIST;

hellinahandbasket:
chdir "$workdir";
chdir $subdir;

# for every file (ss properties project)

open(FILELIST,"< ssfiledump") or die "output";

foreach $fileline (<FILELIST>) {
	($nohistory, $type, $file) = split(/\s/,$fileline,3);
	chomp $file;
#	print "$type $file";
#	if ($nohistory eq "Yes") { print "(Save only latest)" }
#	print "\n";
#	check first change out of vss
#	check into cvs
	read_history($file,$type,$nohistory);
		
#	for every remaining version (ss history file)
#		if it's a label, tag the file in cvs (if it's there)
#		else
#			if not keep only latest
#				check out this version from vss
#				check this version into cvs
#			else
#				bump cvs version number
#			end if
#		end if
#	end every version
#end every file

}

close FILELIST;

my (%label_comments, %label_warned);

my @linebuffer;

sub read_history # expects open file descriptors CHANGES, LABELS, BRANCHES
{
  my $file = shift;
  my $type = shift;
  my $nohistory = shift;
  my $savedrevs = ($nohistory eq "No");

  my $cmd = "ss history \"$file\"";

  $file =~ s/^$ssprojpat\///i;

#  print LOGFILE "\n\nReading from: $cmd\n";

# print "opening SS with command \"$cmd\"\n";
  open(SS,"$cmd |");

  read_comment(); # ignore everything up to the first data block
  # (previously I verified that it started with "History of $file ..."
  # except that MS word wraps long filenames with spaces so just hang it)
  
  my (@pending_commands);

  ITEM:
  while($_=myread()) {
  
    my ($op,$version,$user,$timestamp,$label,$comment);
  
    if(/^\*{17}/) {
#    if(/^\*{17}( +Version (\d+) +\*{17})?/) {
  
      my ($version,$user,$timestamp,$label,$comment);
      if(/^\*{17}( +Version (\d+) +\*{17})?/) {
        $version = $2;
      }
  
      $_=myread();
      if(/^Label: "(.+)"$/) {
        $label = $1;
        $_=myread();
      }
      ($user,$timestamp) = parse_user_and_timestamp($_);
 
      $_=myread();
      if(/Labeled/) { # this revision isn't really a revision - it's just a label
        if( $label =~ s%[^\w\-]+%_%g && !$label_warned{$label}) {
          print "@, #, /, ', spaces or unprintable characters in label ";
          print "\"$label\" were mapped to _\n";
          $label_warned{$label} = 1;
        }
        if( $label =~ /^([^\w]).*$/ ) {
          $label = "A_$label";
          print "\"A_\" prepended to label starting with $1 \"$label\"\n";
          $label_warned{$label} = 1;
        }
        if( $label =~ /^([\_\-\d]).*$/ ) {
          $label = "A$label";
          print "\"A\" prepended to label starting with $1 \"$label\"\n";
          $label_warned{$label} = 1;
        }
 
#        push @pending_labels,$label;
	push (@pending_commands, "cvs -d $mycvsroot tag -l $label \"$file\"");
        # assume all the comments for a particular label are the same...
        $comment = read_comment();
        $label_comments{$label} = $comment
          if ! defined($label_comments{$label});
        next ITEM;

      }

      # this is a "real" revision - either "Checked in projectname" or "Branched"
  
      $comment = read_comment();

      undef $kflags;
      if ($type eq "binary") {
        $kflags = "-kb ";
      }
      push (@pending_commands, "$comment\n\r\ndate\t$timestamp\;\tauthor $user\;\tstate Exp\;\r");
      $file =~ s%\/%\\%g;
      push @pending_commands, "cvs -d $mycvsroot commit -f -F commentfile \"$file\"";
      if ($version == 1) {
        push @pending_commands, "cvs -d $mycvsroot add $kflags -m \"from VSS\" \"$file\"";
      }
#      print ("pushing command: ss get \"$file\" -GF- -I-Y -v$version\n");
      if ($savedrevs) {
        push @pending_commands, "ss get \"$file\" -GF -I-Y -v$version";
      }

      if ($version == 1) {
        last;
      }

      next ITEM;
  
    } else {
      die "parsing messed up on '$_'\n";    }
  
  }

print "closing SS\n";
  @trash = <SS>; # trying to flush out the rest of SS
  undef @linebuffer;
  close SS;

  $alldone = false;

  while ($alldone == false) {

    $cmd = pop @pending_commands;
    if (not defined $cmd) {last;}

    if ( $cmd =~ /.* commit .*/ ) {
      $comment = pop @pending_commands;
      $comment =~ s/(.)$/\1 \r/mg;
      open (COMMENT, "> commentfile");
# binmode may make the comments look better when I move this to Linux.
      binmode COMMENT;
      print COMMENT "$comment\n";
      close COMMENT;
    }

    print("$cmd\n");
    system("$cmd");

  }

}

sub parse_user_and_timestamp
{
  $_=shift;
  if (m@^History.*@) {
    read_comment();
  }

#   
# VSS gives date as mm/dd/yy, time as hh:mm[am or pm indicator]
# (in the US)

  die "can't parse timestamp $_" unless(m@^User:[\s]*([^\s]+)\s+Date:\s+(\d+)/(\d+)/(\d+)\s+Time:\s+(\d+):(\d+)([ap])@);
  my ($user, $mo, $day, $yr, $hr, $min, $sec) = ($1, $2, $3, $4, $5, $6, 0);

  # gmtime returns and
  # timelocal takes  second, minute,  hour,   day, month,  year
  # in the range      0..59,  0..59, 0..23, 1..31, 0..11, 0..137
  # The two digit year has assumptions made about it such that
  # any time before 2037 (when the 32-bit seconds-since-1970 time
  # will run out) is handled correctly.  i.e. 97 -> 1997, 101 -> 2001

  $hr = $hr % 12;
  if($7 eq 'p') { $hr += 12; }
  $mo = $mo - 1;
  if ( $yr < 38 ) { $yr += 100; }

  use Time::Local;
  $totalsec = timelocal($sec, $min, $hr, $day, $mo, $yr);
  ($sec, $min, $hr, $day, $mo, $yr, $unused) = gmtime($totalsec);

  $mo += 1;
  if ($yr > 99) { $yr -= 100; }
  foreach $timething ($sec, $min, $hr, $day, $mo, $yr) {
    if ($timething !~ /../) {
      $timething = "0" . $timething;
    }
  }
  if ($yr < 34) { $yr += 2000; }
  my $timestamp="$yr.$mo.$day.$hr.$min.$sec";

#******later: how do I handle the local date and time formatting settings?
## Is there a way to figure out what they are, so that I can parse 'em?
## output when "English, Australia" selected: dd/mm/yy hh:mm

  $user=lc($user);
   
  return ($user,$timestamp);
}

sub read_comment
{
  my $comment="";

  while($_=myread()) {
    # SAB 980503 - Comment can be terminated either by a new version
    # banner or by a Label separator...
##  	*****************  Version 28  *****************
##  	User: User1        Date:  3/19/98   Time:  2:16p
##  	Checked in $/Projects/Common/AppUtils
##  	Comment: setup CoffFormat build configuration
##  	
##  	**********************
##  	Label: "demo #1"
##  	User: User2        Date:  3/16/98   Time:  4:23a
##  	Labeled
##  	Label comment: Proposed demo.
##  	
##  	**********************
##  	Label: "demo."
##  	User: User2        Date:  3/13/98   Time:  2:35a
##  	Labeled
##  	Label comment: Project ready for demo.
##  	
##  	*****************  Version 27  *****************
##  	User: User2        Date:  2/17/98   Time: 10:27p
##  	Checked in $/Projects/Common/AppUtils
##  	Comment: Fixed location of output .lib/.bsc files.
##  	

    # if(/^\*{17} +Version (\d+) +\*{17}/) {
    if(/^\*{17}/) {
      $comment =~ s/^(Label comment|Comment): //;
      $comment =~ s/\n\s+$/\n/; # strip trailing blank lines
      pushback($_);
      return $comment;
    }
    $comment .= $_;
  }
  $comment =~ s/^Comment: //;
  return $comment;
}


# functions to read from SS with pushback
# my @linebuffer;

sub myread
{
  my $line;
  $line = pop @linebuffer if(defined(@linebuffer));
  if (! defined($line)) {
    $line = <SS>;
  }
  return $line;
}

sub pushback
{
  push @linebuffer,shift;
}