#!/usr/bin/env perl
# cvs2arch 0.0.24
# Copyright(c) 2003 by wave++ "Yuri D'Elia" <wavexx@users.sf.net>
# Distributed under GNU GPL version 2, WITHOUT ANY WARRANTY.
#   convert a SIMPLE cvs three (without branches -- follows head) into a
#   full-featured arch project. Please send suggestions and/or bug reports!
#
# required software:
#   * cvsps >= 2.0
#   * tla
#
# bugs/limitations:
#   * the checked out copy will be MODIFIED by cvsps.
#   * errors during the conversions will lead to an unfinished conversions.
#   there's no way (actually) to complete these but manually.
#   * many checks are just there to prevent "stupid" errors.
#   * cvs2arch is not meant to be fast. In fact, it may be _really_ slow.
#   * cvs repositories containing binary data MAY not be handled correctly.
#   * creation dates/owners are "lost" across conversion. They are inserted
#   back in the archive log. As a suggestion, you should tag sources in your
#   CVS repository as much as you can, as tags gets restored (not yet...).
#   * an useless (empty) import is done to make the tla interface consistent.
#   * files in the WHOLE CVS HISTORY must adhere to tla naming conventions.
#   dot files are ignored for this purposed (.cvsignore). This may be improved.
#   An unadherent file will cause the script to stop prematurely.
#   * renames are just discarded. Don't ask about them. If you edited the CVS
#   repository manually to handle renames, well, you just lost the ability
#   to do a clean conversion.
#   * the human date is still in GMT.
#   * funky/invalid tags by cvsps still needs to be managed.
#
# usage:
#   cvs2arch <cvs-dir> <arch-name> <arch-dir>
#     cvs-dir: a checked-out copy of the project being converted (you must
#              already have a default archive up & running BEFORE running this).
#     arch-name: a fully-qualified new project name
#                (to be supplied to archive-setup).
#     arch-dir: a new directory for the arch project.

# Here we begin
use warnings;
use strict;
use File::Basename;
use File::Path;
use POSIX qw{strftime};
my $prgName = basename $0;

#
# Constants
#
my $ACT_ADD = 0;
my $ACT_DEL = 1;
my $ACT_UP = 2;

# Naming conventions
my $NM_SKIP = qr/(^\.|\/\.)/;

# Cvs tag prefix
my $CVS_TPRFX = "cvs-";


#
# Basic functions
#

# Failure function
sub fail
{
  print STDERR "$prgName: " . (join " ", @_) . "\n";
  exit 1;
}

# Parse a file member
# ([action-file-hash], line-list)
sub parseMembers(\%@)
{
  my ($files, @lines) = @_;
  foreach(@lines)
  {
    my ($file, $irev, $frev) = /^\s*([^:\s]+):([^-\s]+)->([^-\s]+)\s*$/;
    tail("unrecognized patchset member output")
      if(!$file || !$irev || !$frev);

    # skip files that don't adhere to naming conventions
    next if($file =~ /$NM_SKIP/);

    # push data into the hash
    $files->{$file} =
    {
      irev => $irev,
      frev => $frev,
      act => ($irev eq "INITIAL"? $ACT_ADD:
          ($frev eq "DEAD"? $ACT_DEL: $ACT_UP))
    };
  }
}

# Parse a block of cvsps lines containing patchset information
# ([patch-set-list], line-list)
sub parsePS(\@@)
{
  my $line;
  my ($patchSets, @lines) = @_;
  my %newPS;
  my $tagType;

  # basic headers
  ($newPS{cvsps}) = ($lines[0] =~ /^PatchSet (\d+)\s*$/);
  ($newPS{date}) = ($lines[1] =~ /^Date: (.+)$/);
  ($newPS{author}) = ($lines[2] =~ /^Author: (.+)$/);
  ($newPS{tag}, $tagType) = ($lines[4] =~ /^Tag: (\S+)(?:\s*|\s+\*\*(\w+)\*\*)$/);
  fail("bad or unrecognized patchset format")
    if(!$newPS{cvsps} || !$newPS{date} || !$newPS{author} || !$newPS{tag} ||
        $lines[5] !~ /^Log:\s*$/);

  # undefine tag when needed
  undef $newPS{tag} if($newPS{tag} eq "(none)");

  # log message
  my $msg;
  for(6 ... $#lines)
  {
    $line = $_;
    last if($lines[$line] =~ /^$/);
    $msg .= " " . $lines[$line];
  }
  $newPS{msg} = $msg if($msg and $msg eq "*** empty log message ***");

  # file members
  my %files;
  until($lines[++$line] =~ /^Members:\s*$/) {};
  parseMembers(%files, @lines[$line + 1 ... $#lines]);
  $newPS{files} = \%files;

  # add the patch set (if there are still valid files)
  push @$patchSets, \%newPS if(%files);
}

# Request a particular file in cvs
# (cvsDir, file, revision) -> buffer
sub cvsReq($$$)
{
  my ($cvsDir, $file, $rev) = @_;
  return qx{cd "$cvsDir" && cvs up -p -r "$rev" "$file" 2>/dev/null};
}

# Create a file (creating hierarchy) on a tree
# (dir, file, buffer)
sub createFile($$$)
{
  my ($dir, $file, $buffer) = @_;
  my $path = "$dir/$file";
  fail("file \"$path\" already exists") if(-f "$path");
  mkpath(dirname $path);
  open FD, ">$path" or fail("unable to create \"$path\"");
  print FD $buffer;
  close FD;
}

# Overwrites a file on a tree
# (dir, file, buffer)
sub recreateFile($$$)
{
  my ($dir, $file, $buffer) = @_;
  my $path = "$dir/$file";
  fail("inexistent file \"$path\"") if(!-f "$path");
  open FD, ">$path" or fail("unable to overwrite \"$path\"");
  print FD $buffer;
  close FD;
}

# Remove a file (pruning hierarchy) on a tree
# (dir, file)
sub removeFile($$)
{
  my ($dir, $file) = @_;
  my $path = "$dir/$file";

  # not the fastest way but...
  do
  {
    # unlink the first time (a file)...
    unlink $path or die if(-f $path);

    # then rmdir until failure (non-empty directory)
    rmdir $path or last if(-d $path);

    $path = dirname $path;
  }
}

# Updates the arch directory accordingly to a patchSet
# (cvs-dir, arch-dir, patch-set)
sub archSync($$\%)
{
  my ($cvsDir, $archDir, $patchSet) = @_;
  my $files = $patchSet->{files};
  my $buf;

  while(my ($file, $data) = each %$files)
  {
    if($data->{act} == $ACT_DEL) {
      removeFile($archDir, $file);
    }
    else
    {
      $buf = cvsReq($cvsDir, $file, $data->{frev});
      $data->{act} == $ACT_ADD?
        createFile($archDir, $file, $buf):
        recreateFile($archDir, $file, $buf);
    }
  }
}

# Split an arch project name
# (arch-name) -> (category, branch, version)
sub prjSplit($)
{
  split /--/, shift;
}

# Adds a name tag to the current tree
# (arch-dir, tag-name)
sub archTag($$$)
{
  my ($archDir, $archName, $tag) = @_;
  my ($cat, $branch, $ver) = prjSplit($archName);

  # TODO: tla tag seems broken. What's the fastest way to retreive
  # the lastead revision? tla revisions | tail -1?
}

# Generate an intelligent patch log out of CVS informations.
# (patch-set) -> buffer
sub archLog(\%)
{
  my ($patchSet) = @_;

  # generates summary and log out of msg
  my $summary;
  my $log;

  if(length($patchSet->{msg}) <= 70)
  {
    # the message is short enough to be placed on the summary line
    $summary = $patchSet->{msg};
    $log = "";
  }
  else
  {
    # ellipses on the subject and place the full output on log
    $summary = (substr $patchSet->{msg}, 0, 67) . "...";
    $log = $patchSet->{msg} . '\n';
  }

  # tag informations as keywords
  my @keywords;
  push @keywords, $patchSet->{tag} if($patchSet->{tag});

  # basic informations
  push @keywords, "cvs2arch";
  my $author = $patchSet->{author};
  my ($dYear, $dMonth, $dDay, $dH, $dM, $dS) =
    ($patchSet->{date} =~ /^(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)$/);
  my $stdDate = "$dYear-$dMonth-$dDay $dH:$dM:$dS GMT";

  # time should be converted to local time..
  my $date = strftime("%a %b %e %H:%M:%S GMT %Y",
      $dS, $dM, $dH, $dDay, $dMonth, $dYear - 1900);

  "Creator: $author\nDate: $date\nStandard-date :$stdDate\n" .
    "Summary: $summary\nKeywords: " . (join ", ", @keywords) . "\n\n$log";
}

# Commit back the tree to the tla archive
# (arch-dir, patch-set)
sub archCi($\%)
{
  my ($archDir, $patchSet) = @_;
  my $files = $patchSet->{files};

  # create a log file
  my $log = qx{cd '$archDir' && tla make-log};
  chop $log;
  recreateFile("", $log, archLog(%$patchSet));

  # commit!
  fail("errors occured while committing to arch tree")
    if(system("cd '$archDir' && tla commit"));
}


#
# Real work
#

# Argument parsing and validation
if(!@ARGV)
{
  print "$prgName usage:\n" .
    "  $0 <cvs-dir> <arch-prj-name> <arch-dir>\n";
  exit;
}

# TODO: perform more checks.
my ($cvsDir, $archName, $archDir) = @ARGV;
fail("<cvs-dir> must be a working checked-out copy of a CVS project to convert")
  if(!$cvsDir || !-f "$cvsDir/CVS/Root");
fail("<arch-name> isn't a valid arch project name")
  if(!$archName || $archName !~ /^\S+--\S+--\d+\.\d+$/);
fail("<arch-dir> should not exists and be a valid path name")
  if(!$archDir || -d $archDir);

# Extract all the relevant informations out of $cvsDir using cvsps output
my $buf = qx(cd "$cvsDir" && cvsps -q -b HEAD);
my @patchSets;

# Call parsePS for each patchSet
foreach(split /(?:\n|^)-{21}\n/, $buf) {
  parsePS(@patchSets, (split /\n/)) if(!/^\s*$/);
}

# PatchSets are parsed, setup archDir and perform an initial empty import
# so we can use only commit later. TODO: maybe copying cvsps ouput before
# doing the import could be an idea.
mkdir $archDir;
system qq
{
  cd '$archDir' && \\
  tla archive-setup '$archName' && \\
  tla init-tree '$archName' && \\
  tla tagging-method names && \\
  tla import
} and
fatal("errors occured while setting up the arch project");

# Loop through patchsets
my $n = 1;
foreach my $patchSet(@patchSets)
{
  print "=== PatchSet $n/" . ($#patchSets + 1) . " ===\n";

  archSync($cvsDir, $archDir, %$patchSet);
  if($patchSet->{tag})
  {
    print "== Tagging PS $n as `$patchSet->{tag}' ==\n";
    archTag($archDir, $archName, $patchSet->{tag})
  }
  archCi($archDir, %$patchSet);

  print "\n";
  ++$n;
}