#!/pro/bin/perl
use strict;
use warnings;
use VCS::SCCS;
my @sccs = glob ("SCCS/s.*") or die "No SCCS source files to convert\n";
-d ".git" and die ".git already exists\n";
system "git init";
# http://www.kernel.org/pub/software/scm/git/docs/gitattributes.html
# could be explored to write checkout hooks that translate SCCS
# keywords to actual content. Would be hard to translate back
sub pr_date
{
my @dt = localtime shift;
sprintf "%s %02d-%02d-%4d %02d:%02d:%02d",
(qw( Sun Mon Tue Wed Thu Fri Sat ))[$dt[6]],
$dt[3], $dt[4] + 1, $dt[5] + 1900,
$dt[2], $dt[1], $dt[0];
} # pr_date
# GFI implementation by Sam Vilain
# fire up GFI
chomp (my $branchname = qx(git symbolic-ref HEAD));
open my $gfi, "|-", qw(git fast-import --quiet);
my $mark;
# use a best guess at user, hostname, etc. FIXME: add authors map :)
use Socket;
use Sys::Hostname;
use Time::Local;
my $domain = $ENV{YPDOMAIN} || (gethostbyname hostname)[0];
my %tzoffset;
my $tzoffset = sub {
my $offset_s = timegm (localtime ($_[0])) - $_[0];
$tzoffset{$offset_s} ||= ( $offset_s >= 0 ? "+" : "-" )
. sprintf "%.4d", abs $offset_s;
};
# Submit in the same sequence as the original
my %sccs;
my %file;
foreach my $f (@sccs) {
my $sccs = VCS::SCCS->new ($f) or die "Cannot convert $f\n";
# GIT supports get-hooks, to translate on retrieval
# But it will be useless as you cannot translate back
$sccs->set_translate ("SCCS");
my $fn = $sccs->file ();
$file{$fn}++;
foreach my $rm (@{$sccs->revision_map ()}) {
my ($rev, $vsn) = @{$rm};
my $delta = $sccs->delta ($rev);
$sccs{pack "NA*", $delta->{stamp}, $fn} = [ $sccs, $rev, ++$mark ];
my $data = scalar $sccs->body ($rev);
print { $gfi } "blob\nmark :", $mark,
"\ndata ", length ($data),
"\n", $data, "\n";
printf STDERR "%-20s %3d %8s %s\r",
$fn, $rev, $vsn, pr_date ($delta->{stamp});
}
print STDERR "\n";
}
foreach my $c (sort keys %sccs) {
my ($sccs, $rev, $mark) = @{$sccs{$c}};
my $fn = $sccs->file ();
my %delta = %{$sccs->delta ($rev)};
my $stamp = pr_date ($delta{stamp});
my $vsn = $delta{version};
printf STDERR "%-20s %3d %6s %s %s %s\n", $fn, $rev, $vsn,
$stamp, $delta{date}, $delta{"time"};
print { $gfi } "commit ", $branchname, "\n";
print { $gfi } "committer ", $delta{committer}, " <",
($delta{committer}, "@", $domain, "> ", $delta{stamp},
" ", $tzoffset->($delta{stamp}), "\n");
# tradition is to save all potentially useful but
# uncategorized metadata as RFC822-style headers in the commit
# message
my $mr = $delta{mr} || ""; $mr =~ s/^-$//;
$mr and $mr = "SCCS-mr: $mr";
$vsn and $vsn = "SCCS-vsn: $vsn";
my $cmnt = $delta{comment} || "";
$cmnt ||= "(no message)";
$cmnt .= "\n";
my $msg = join "\n", $cmnt, grep m/\S/, $mr, $vsn;
print { $gfi } "data ", length ($msg), "\n$msg\n";
my $mode = $delta{flags}{x} ? "755" : "644";
print { $gfi } "M $mode :$mark $fn\n";
print { $gfi } "\n";
}
print { $gfi } "checkpoint\n";
system "git-checkout";